diff --git a/radiant.basics b/radiant.basics deleted file mode 160000 index c0e10c0d4fd378c339353a2a7c082ed50c66e4b7..0000000000000000000000000000000000000000 --- a/radiant.basics +++ /dev/null @@ -1 +0,0 @@ -Subproject commit c0e10c0d4fd378c339353a2a7c082ed50c66e4b7 diff --git a/radiant.basics/.Rbuildignore b/radiant.basics/.Rbuildignore new file mode 100644 index 0000000000000000000000000000000000000000..8961cda9c3724a63c618da39375145ed5d82e9fd --- /dev/null +++ b/radiant.basics/.Rbuildignore @@ -0,0 +1,11 @@ +^CRAN-RELEASE$ +^.*\.Rproj$ +^\.Rproj\.user$ +^\.travis\.yml$ +build/ +docs/ +vignettes/ +_pkgdown.yml +cran-comments.md +radiant.basics.code-workspace +^CRAN-SUBMISSION$ diff --git a/radiant.basics/.gitignore b/radiant.basics/.gitignore new file mode 100644 index 0000000000000000000000000000000000000000..9910276b7cf39c33ef4e772551698c215d732cfc --- /dev/null +++ b/radiant.basics/.gitignore @@ -0,0 +1,10 @@ +.Rproj.user +.Rhistory +.Rapp.history +.RData +.Ruserdata +radiant.basics.Rproj +.DS_Store +revdep/ +cran-comments.md +docs/ diff --git a/radiant.basics/.travis.yml b/radiant.basics/.travis.yml new file mode 100644 index 0000000000000000000000000000000000000000..ccb28d72cf9a9608e47c49dccee3a9626b26328d --- /dev/null +++ b/radiant.basics/.travis.yml @@ -0,0 +1,29 @@ +language: r +cache: packages +r: + - oldrel + - release + - devel +warnings_are_errors: true +sudo: required +dist: trusty + +r_packages: + - devtools + +r_github_packages: + - trestletech/shinyAce + - radiant-rstats/radiant.data + +## based on https://www.datacamp.com/community/tutorials/cd-package-docs-pkgdown-travis +after_success: + - Rscript -e 'pkgdown::build_site()' + +deploy: + provider: pages + skip-cleanup: true + github-token: $GITHUB_PAT + keep-history: true + local-dir: docs + on: + branch: master diff --git a/radiant.basics/CRAN-RELEASE b/radiant.basics/CRAN-RELEASE new file mode 100644 index 0000000000000000000000000000000000000000..fbd69c19e001f9b88a795f71164ef103e04ea3e3 --- /dev/null +++ b/radiant.basics/CRAN-RELEASE @@ -0,0 +1,2 @@ +This package was submitted to CRAN on 2019-07-29. +Once it is accepted, delete this file and tag the release (commit e39ce5d3d8). diff --git a/radiant.basics/CRAN-SUBMISSION b/radiant.basics/CRAN-SUBMISSION new file mode 100644 index 0000000000000000000000000000000000000000..c1d27c8b518d1284a3d456f9497f2dd407723b7d --- /dev/null +++ b/radiant.basics/CRAN-SUBMISSION @@ -0,0 +1,3 @@ +Version: 1.6.6 +Date: 2024-05-15 02:25:12 UTC +SHA: f2b85d9412496c91fd69fbcd61535de79b780b3e diff --git a/radiant.basics/DESCRIPTION b/radiant.basics/DESCRIPTION new file mode 100644 index 0000000000000000000000000000000000000000..274565482364e611b6188e61958f94d1b341d47d --- /dev/null +++ b/radiant.basics/DESCRIPTION @@ -0,0 +1,40 @@ +Package: radiant.basics +Type: Package +Title: Basics Menu for Radiant: Business Analytics using R and Shiny +Version: 1.6.6 +Date: 2024-5-14 +Authors@R: person("Vincent", "Nijs", , "radiant@rady.ucsd.edu", c("aut", "cre")) +Description: The Radiant Basics menu includes interfaces for probability + calculation, central limit theorem simulation, comparing means and proportions, + goodness-of-fit testing, cross-tabs, and correlation. The application extends + the functionality in 'radiant.data'. +Depends: + R (>= 4.3.0), + radiant.data (>= 1.6.6) +Imports: + ggplot2 (>= 2.2.1), + scales (>= 0.4.0), + dplyr (>= 1.0.7), + tidyr (>= 0.8.2), + magrittr (>= 1.5), + shiny (>= 1.8.1), + psych (>= 1.8.3.3), + import (>= 1.1.0), + lubridate (>= 1.7.4), + polycor (>= 0.7.10), + patchwork (>= 1.0.0), + shiny.i18n, + rlang (>= 1.0.6) +Suggests: + testthat (>= 2.0.0), + pkgdown (>= 1.1.0), + markdown (>= 1.3) +URL: https://github.com/radiant-rstats/radiant.basics/, + https://radiant-rstats.github.io/radiant.basics/, + https://radiant-rstats.github.io/docs/ +BugReports: https://github.com/radiant-rstats/radiant.basics/issues/ +License: AGPL-3 | file LICENSE +LazyData: true +Encoding: UTF-8 +Language: en-US +RoxygenNote: 7.3.2 diff --git a/radiant.basics/LICENSE b/radiant.basics/LICENSE new file mode 100644 index 0000000000000000000000000000000000000000..fa3c0433841c97a748da9d2f3c01688f5faa7a43 --- /dev/null +++ b/radiant.basics/LICENSE @@ -0,0 +1,105 @@ +Radiant is licensed under AGPL3 (see https://tldrlegal.com/license/gnu-affero-general-public-license-v3-(agpl-3.0) and https://www.r-project.org/Licenses/AGPL-3). The radiant help files are licensed under the creative commons attribution, non-commercial, share-alike license CC-NC-SA (https://creativecommons.org/licenses/by-nc-sa/4.0/). + +As a summary, the AGPLv3 license requires, attribution, including copyright and license information in copies of the software, stating changes if the code is modified, and disclosure of all source code. Details are in the COPYING file. + +If you are interested in using Radiant please email me at radiant@rady.ucsd.edu + +ALL HELPFILES IN THE RADIANT APPLICATION USE THE FOLLOWING LICENSE (https://creativecommons.org/licenses/by-nc-sa/4.0/) +======================================================================================================================== + +Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International Public License + +By exercising the Licensed Rights (defined below), You accept and agree to be bound by the terms and conditions of this Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International Public License ("Public License"). To the extent this Public License may be interpreted as a contract, You are granted the Licensed Rights in consideration of Your acceptance of these terms and conditions, and the Licensor grants You such rights in consideration of benefits the Licensor receives from making the Licensed Material available under these terms and conditions. + +Section 1 – Definitions. + +Adapted Material means material subject to Copyright and Similar Rights that is derived from or based upon the Licensed Material and in which the Licensed Material is translated, altered, arranged, transformed, or otherwise modified in a manner requiring permission under the Copyright and Similar Rights held by the Licensor. For purposes of this Public License, where the Licensed Material is a musical work, performance, or sound recording, Adapted Material is always produced where the Licensed Material is synched in timed relation with a moving image. +Adapter's License means the license You apply to Your Copyright and Similar Rights in Your contributions to Adapted Material in accordance with the terms and conditions of this Public License. +BY-NC-SA Compatible License means a license listed at creativecommons.org/compatiblelicenses, approved by Creative Commons as essentially the equivalent of this Public License. +Copyright and Similar Rights means copyright and/or similar rights closely related to copyright including, without limitation, performance, broadcast, sound recording, and Sui Generis Database Rights, without regard to how the rights are labeled or categorized. For purposes of this Public License, the rights specified in Section 2(b)(1)-(2) are not Copyright and Similar Rights. +Effective Technological Measures means those measures that, in the absence of proper authority, may not be circumvented under laws fulfilling obligations under Article 11 of the WIPO Copyright Treaty adopted on December 20, 1996, and/or similar international agreements. +Exceptions and Limitations means fair use, fair dealing, and/or any other exception or limitation to Copyright and Similar Rights that applies to Your use of the Licensed Material. +License Elements means the license attributes listed in the name of a Creative Commons Public License. The License Elements of this Public License are Attribution, NonCommercial, and ShareAlike. +Licensed Material means the artistic or literary work, database, or other material to which the Licensor applied this Public License. +Licensed Rights means the rights granted to You subject to the terms and conditions of this Public License, which are limited to all Copyright and Similar Rights that apply to Your use of the Licensed Material and that the Licensor has authority to license. +Licensor means the individual(s) or entity(ies) granting rights under this Public License. +NonCommercial means not primarily intended for or directed towards commercial advantage or monetary compensation. For purposes of this Public License, the exchange of the Licensed Material for other material subject to Copyright and Similar Rights by digital file-sharing or similar means is NonCommercial provided there is no payment of monetary compensation in connection with the exchange. +Share means to provide material to the public by any means or process that requires permission under the Licensed Rights, such as reproduction, public display, public performance, distribution, dissemination, communication, or importation, and to make material available to the public including in ways that members of the public may access the material from a place and at a time individually chosen by them. +Sui Generis Database Rights means rights other than copyright resulting from Directive 96/9/EC of the European Parliament and of the Council of 11 March 1996 on the legal protection of databases, as amended and/or succeeded, as well as other essentially equivalent rights anywhere in the world. +You means the individual or entity exercising the Licensed Rights under this Public License. Your has a corresponding meaning. +Section 2 – Scope. + +License grant. +Subject to the terms and conditions of this Public License, the Licensor hereby grants You a worldwide, royalty-free, non-sublicensable, non-exclusive, irrevocable license to exercise the Licensed Rights in the Licensed Material to: +reproduce and Share the Licensed Material, in whole or in part, for NonCommercial purposes only; and +produce, reproduce, and Share Adapted Material for NonCommercial purposes only. +Exceptions and Limitations. For the avoidance of doubt, where Exceptions and Limitations apply to Your use, this Public License does not apply, and You do not need to comply with its terms and conditions. +Term. The term of this Public License is specified in Section 6(a). +Media and formats; technical modifications allowed. The Licensor authorizes You to exercise the Licensed Rights in all media and formats whether now known or hereafter created, and to make technical modifications necessary to do so. The Licensor waives and/or agrees not to assert any right or authority to forbid You from making technical modifications necessary to exercise the Licensed Rights, including technical modifications necessary to circumvent Effective Technological Measures. For purposes of this Public License, simply making modifications authorized by this Section 2(a)(4) never produces Adapted Material. +Downstream recipients. +Offer from the Licensor – Licensed Material. Every recipient of the Licensed Material automatically receives an offer from the Licensor to exercise the Licensed Rights under the terms and conditions of this Public License. +Additional offer from the Licensor – Adapted Material. Every recipient of Adapted Material from You automatically receives an offer from the Licensor to exercise the Licensed Rights in the Adapted Material under the conditions of the Adapter’s License You apply. +No downstream restrictions. You may not offer or impose any additional or different terms or conditions on, or apply any Effective Technological Measures to, the Licensed Material if doing so restricts exercise of the Licensed Rights by any recipient of the Licensed Material. +No endorsement. Nothing in this Public License constitutes or may be construed as permission to assert or imply that You are, or that Your use of the Licensed Material is, connected with, or sponsored, endorsed, or granted official status by, the Licensor or others designated to receive attribution as provided in Section 3(a)(1)(A)(i). +Other rights. + +Moral rights, such as the right of integrity, are not licensed under this Public License, nor are publicity, privacy, and/or other similar personality rights; however, to the extent possible, the Licensor waives and/or agrees not to assert any such rights held by the Licensor to the limited extent necessary to allow You to exercise the Licensed Rights, but not otherwise. +Patent and trademark rights are not licensed under this Public License. +To the extent possible, the Licensor waives any right to collect royalties from You for the exercise of the Licensed Rights, whether directly or through a collecting society under any voluntary or waivable statutory or compulsory licensing scheme. In all other cases the Licensor expressly reserves any right to collect such royalties, including when the Licensed Material is used other than for NonCommercial purposes. +Section 3 – License Conditions. + +Your exercise of the Licensed Rights is expressly made subject to the following conditions. + +Attribution. + +If You Share the Licensed Material (including in modified form), You must: + +retain the following if it is supplied by the Licensor with the Licensed Material: +identification of the creator(s) of the Licensed Material and any others designated to receive attribution, in any reasonable manner requested by the Licensor (including by pseudonym if designated); +a copyright notice; +a notice that refers to this Public License; +a notice that refers to the disclaimer of warranties; +a URI or hyperlink to the Licensed Material to the extent reasonably practicable; +indicate if You modified the Licensed Material and retain an indication of any previous modifications; and +indicate the Licensed Material is licensed under this Public License, and include the text of, or the URI or hyperlink to, this Public License. +You may satisfy the conditions in Section 3(a)(1) in any reasonable manner based on the medium, means, and context in which You Share the Licensed Material. For example, it may be reasonable to satisfy the conditions by providing a URI or hyperlink to a resource that includes the required information. +If requested by the Licensor, You must remove any of the information required by Section 3(a)(1)(A) to the extent reasonably practicable. +ShareAlike. +In addition to the conditions in Section 3(a), if You Share Adapted Material You produce, the following conditions also apply. + +The Adapter’s License You apply must be a Creative Commons license with the same License Elements, this version or later, or a BY-NC-SA Compatible License. +You must include the text of, or the URI or hyperlink to, the Adapter's License You apply. You may satisfy this condition in any reasonable manner based on the medium, means, and context in which You Share Adapted Material. +You may not offer or impose any additional or different terms or conditions on, or apply any Effective Technological Measures to, Adapted Material that restrict exercise of the rights granted under the Adapter's License You apply. +Section 4 – Sui Generis Database Rights. + +Where the Licensed Rights include Sui Generis Database Rights that apply to Your use of the Licensed Material: + +for the avoidance of doubt, Section 2(a)(1) grants You the right to extract, reuse, reproduce, and Share all or a substantial portion of the contents of the database for NonCommercial purposes only; +if You include all or a substantial portion of the database contents in a database in which You have Sui Generis Database Rights, then the database in which You have Sui Generis Database Rights (but not its individual contents) is Adapted Material, including for purposes of Section 3(b); and +You must comply with the conditions in Section 3(a) if You Share all or a substantial portion of the contents of the database. +For the avoidance of doubt, this Section 4 supplements and does not replace Your obligations under this Public License where the Licensed Rights include other Copyright and Similar Rights. +Section 5 – Disclaimer of Warranties and Limitation of Liability. + +Unless otherwise separately undertaken by the Licensor, to the extent possible, the Licensor offers the Licensed Material as-is and as-available, and makes no representations or warranties of any kind concerning the Licensed Material, whether express, implied, statutory, or other. This includes, without limitation, warranties of title, merchantability, fitness for a particular purpose, non-infringement, absence of latent or other defects, accuracy, or the presence or absence of errors, whether or not known or discoverable. Where disclaimers of warranties are not allowed in full or in part, this disclaimer may not apply to You. +To the extent possible, in no event will the Licensor be liable to You on any legal theory (including, without limitation, negligence) or otherwise for any direct, special, indirect, incidental, consequential, punitive, exemplary, or other losses, costs, expenses, or damages arising out of this Public License or use of the Licensed Material, even if the Licensor has been advised of the possibility of such losses, costs, expenses, or damages. Where a limitation of liability is not allowed in full or in part, this limitation may not apply to You. +The disclaimer of warranties and limitation of liability provided above shall be interpreted in a manner that, to the extent possible, most closely approximates an absolute disclaimer and waiver of all liability. +Section 6 – Term and Termination. + +This Public License applies for the term of the Copyright and Similar Rights licensed here. However, if You fail to comply with this Public License, then Your rights under this Public License terminate automatically. +Where Your right to use the Licensed Material has terminated under Section 6(a), it reinstates: + +automatically as of the date the violation is cured, provided it is cured within 30 days of Your discovery of the violation; or +upon express reinstatement by the Licensor. +For the avoidance of doubt, this Section 6(b) does not affect any right the Licensor may have to seek remedies for Your violations of this Public License. +For the avoidance of doubt, the Licensor may also offer the Licensed Material under separate terms or conditions or stop distributing the Licensed Material at any time; however, doing so will not terminate this Public License. +Sections 1, 5, 6, 7, and 8 survive termination of this Public License. +Section 7 – Other Terms and Conditions. + +The Licensor shall not be bound by any additional or different terms or conditions communicated by You unless expressly agreed. +Any arrangements, understandings, or agreements regarding the Licensed Material not stated herein are separate from and independent of the terms and conditions of this Public License. +Section 8 – Interpretation. + +For the avoidance of doubt, this Public License does not, and shall not be interpreted to, reduce, limit, restrict, or impose conditions on any use of the Licensed Material that could lawfully be made without permission under this Public License. +To the extent possible, if any provision of this Public License is deemed unenforceable, it shall be automatically reformed to the minimum extent necessary to make it enforceable. If the provision cannot be reformed, it shall be severed from this Public License without affecting the enforceability of the remaining terms and conditions. +No term or condition of this Public License will be waived and no failure to comply consented to unless expressly agreed to by the Licensor. +Nothing in this Public License constitutes or may be interpreted as a limitation upon, or waiver of, any privileges and immunities that apply to the Licensor or You, including from the legal processes of any jurisdiction or authority. diff --git a/radiant.basics/NAMESPACE b/radiant.basics/NAMESPACE new file mode 100644 index 0000000000000000000000000000000000000000..0499a295ec89bcffdec4d58a597ecbbbcdb574ef --- /dev/null +++ b/radiant.basics/NAMESPACE @@ -0,0 +1,152 @@ +# Generated by roxygen2: do not edit by hand + +S3method(plot,clt) +S3method(plot,compare_means) +S3method(plot,compare_props) +S3method(plot,correlation) +S3method(plot,cross_tabs) +S3method(plot,goodness) +S3method(plot,homo_variance_test) +S3method(plot,normality_test) +S3method(plot,prob_binom) +S3method(plot,prob_chisq) +S3method(plot,prob_disc) +S3method(plot,prob_expo) +S3method(plot,prob_fdist) +S3method(plot,prob_lnorm) +S3method(plot,prob_norm) +S3method(plot,prob_pois) +S3method(plot,prob_tdist) +S3method(plot,prob_unif) +S3method(plot,single_mean) +S3method(plot,single_prop) +S3method(print,rcorr) +S3method(summary,compare_means) +S3method(summary,compare_props) +S3method(summary,correlation) +S3method(summary,cross_tabs) +S3method(summary,goodness) +S3method(summary,homo_variance_test) +S3method(summary,normality_test) +S3method(summary,prob_binom) +S3method(summary,prob_chisq) +S3method(summary,prob_disc) +S3method(summary,prob_expo) +S3method(summary,prob_fdist) +S3method(summary,prob_lnorm) +S3method(summary,prob_norm) +S3method(summary,prob_pois) +S3method(summary,prob_tdist) +S3method(summary,prob_unif) +S3method(summary,single_mean) +S3method(summary,single_prop) +export(clt) +export(compare_means) +export(compare_props) +export(cor2df) +export(correlation) +export(cross_tabs) +export(goodness) +export(homo_variance_test) +export(normality_test) +export(prob_binom) +export(prob_chisq) +export(prob_disc) +export(prob_expo) +export(prob_fdist) +export(prob_lnorm) +export(prob_norm) +export(prob_pois) +export(prob_tdist) +export(prob_unif) +export(radiant.basics) +export(radiant.basics_viewer) +export(radiant.basics_window) +export(single_mean) +export(single_prop) +import(ggplot2) +import(radiant.data) +import(shiny) +importFrom(dplyr,arrange) +importFrom(dplyr,bind_cols) +importFrom(dplyr,count) +importFrom(dplyr,filter) +importFrom(dplyr,funs) +importFrom(dplyr,group_by_at) +importFrom(dplyr,left_join) +importFrom(dplyr,mutate) +importFrom(dplyr,mutate_all) +importFrom(dplyr,mutate_if) +importFrom(dplyr,rename) +importFrom(dplyr,select) +importFrom(dplyr,summarise) +importFrom(dplyr,summarise_all) +importFrom(dplyr,summarise_at) +importFrom(graphics,pairs) +importFrom(graphics,par) +importFrom(graphics,plot) +importFrom(graphics,points) +importFrom(graphics,strwidth) +importFrom(graphics,text) +importFrom(import,from) +importFrom(lubridate,is.Date) +importFrom(magrittr,"%<>%") +importFrom(magrittr,"%>%") +importFrom(magrittr,divide_by) +importFrom(magrittr,set_colnames) +importFrom(magrittr,set_names) +importFrom(magrittr,set_rownames) +importFrom(patchwork,plot_annotation) +importFrom(patchwork,wrap_plots) +importFrom(polycor,hetcor) +importFrom(psych,corr.test) +importFrom(radiant.data,launch) +importFrom(rlang,.data) +importFrom(scales,percent) +importFrom(stats,binom.test) +importFrom(stats,chisq.test) +importFrom(stats,cor.test) +importFrom(stats,cov) +importFrom(stats,dbinom) +importFrom(stats,dchisq) +importFrom(stats,dexp) +importFrom(stats,df) +importFrom(stats,dlnorm) +importFrom(stats,dnorm) +importFrom(stats,dpois) +importFrom(stats,dt) +importFrom(stats,dunif) +importFrom(stats,na.omit) +importFrom(stats,p.adjust) +importFrom(stats,pbinom) +importFrom(stats,pchisq) +importFrom(stats,pexp) +importFrom(stats,pf) +importFrom(stats,plnorm) +importFrom(stats,pnorm) +importFrom(stats,ppois) +importFrom(stats,prop.test) +importFrom(stats,pt) +importFrom(stats,punif) +importFrom(stats,qbinom) +importFrom(stats,qchisq) +importFrom(stats,qexp) +importFrom(stats,qf) +importFrom(stats,qlnorm) +importFrom(stats,qnorm) +importFrom(stats,qpois) +importFrom(stats,qt) +importFrom(stats,qunif) +importFrom(stats,rbinom) +importFrom(stats,relevel) +importFrom(stats,rexp) +importFrom(stats,rnorm) +importFrom(stats,runif) +importFrom(stats,sd) +importFrom(stats,setNames) +importFrom(stats,symnum) +importFrom(stats,t.test) +importFrom(stats,wilcox.test) +importFrom(tidyr,gather) +importFrom(tidyr,spread) +importFrom(utils,combn) diff --git a/radiant.basics/NEWS.md b/radiant.basics/NEWS.md new file mode 100644 index 0000000000000000000000000000000000000000..f4b6ba86436930bc5b59aea097566cfbbd79071d --- /dev/null +++ b/radiant.basics/NEWS.md @@ -0,0 +1,178 @@ +# radiant.basics 1.6.6.0 + +* Require Shiny 1.8.1. Adjustments related to icon-buttons were made to address a breaking change in Shiny 1.8.1 +* Reverting changes that removed `req(input$dataset)` in different places + +# radiant.basics 1.6.1.0 + +* Require shiny 1.8.0. This fixes a bug in the shiny 1.7 versions that caused issues with all radiant packages. +* Added `.groups` arguments as needed to avoid messages about grouping from dplyr + +# radiant.basics 1.6.0.0 + +* Relabeled web app to "Radiant for R" to distinguish from "Radiant for Python" +* Addressed package documentation issue connected to a change in roxygen2 +* Simplified and improved color assignment for discrete probability distributions in the probability calculator + +# radiant.basics 1.5.0.0 + +* Improvements to screenshot feature. Navigation bar is omitted and the image is adjusted to the length of the UI. +* Removed all references to `aes_string` which is being deprecated in ggplot soon +* Code cleanup + +# radiant.basics 1.4.5.0 + +* Fixed plot titles for _Basics > Central Limit Theorem_ + +# radiant.basics 1.4.4.0 + +* Added option to create screenshots of settings on a page. Approach is inspired by the snapper package by @yonicd + +# radiant.basics 1.4.1.0 + +* Fixed `is_empty` function clash with `rlang` +* Adjustments to work with the latest version of `shiny` and `bootstrap4` + +# radiant.basics 1.4.0.0 + +Adjusted DESCRIPTION file by adding 'markdown' to the Suggests section. This addresses an issue in radiant.basics, similar to the issue linked below +https://github.com/radiant-rstats/radiant/issues/157. This is issue originated with https://github.com/yihui/knitr/issues/1864 + +# radiant.basics 1.3.4.0 + +* Minor adjustments in anticipation of dplyr 1.0.0 + +# radiant.basics 1.3.0.0 + +* Documentation updates to link to new video tutorials +* Use `patchwork` for grouping multiple plots together +* Use `polycor::hetcor` to calculate correlations for a mix of numeric and categorical variables +* Updated correlation plot that accommodates a mix of numeric and categorical variables +* Fix for sd estimate in `single_prop` and `compare_prop` functions +* Add dimension labels to all tables in _Basics > Cross-tabs_ + +# radiant.basics 1.2.0.0 + +* Update action buttons that initiate calculations when one or more relevant inputs are changed. When, for example, a CLT simulation should be updated, a spinning "refresh" icon will be shown +* Allow fractions as input for the `Goodness of fit` and `Probability calculator > Discrete` tools + +# radiant.basics 1.1.4.0 + +* Summary statistics provided for _single_mean_, _single_prop_, _compare_means_, and _compare_props_ are now consistent +* `n_missing` were not show correctly for _compare_means_ and _compare_props_ + +# radiant.basics 1.1.3.0 + +* Fix for code generation from the probability calculator when the `distribution` type is set to binomial +* Fix for input restoration from a state file for the probability calculator. For the _value_ or _probability_ inputs two sided values might be restored when only a one-sided input was previously specified + +# radiant.basics 1.1.1.0 + +* Documentation updates (i.e., key functions for each tool) +* Improvements in `goodness` and `prob_dics` to allow fractions in generated code sent to _Report > rmd_ or _Report > R_ +* Improved checks for variables that show no variation +* Numerous small code changes to support enhanced auto-completion, tooltips, and annotations in shinyAce 0.4.1 + +# radiant.basics 1.0.0.0 + +* Flexible adjustment of level of jitter in `plot.correlation` +* Support for variables of type `ts` + +# radiant.basics 0.9.9.0 + +* Various fixes to address (soft) deprecations in dplyr 0.8.0 + +# radiant.basics 0.9.8.0 + +* Option to pass additional arguments to `shiny::runApp` when starting radiant such as the port to use. For example, radiant.basics::radiant.basics("https://github.com/radiant-rstats/docs/raw/gh-pages/examples/demo-dvd-rnd.state.rda", port = 8080) +* Catch settings where the number of levels in a comparison of means or proportions is the same as the number of rows in the data (e.g., grouping by a unique identifier) +* Show significant stars for `Compare means` and `Compare proportions` even when `Show additional output` is not selected +* `ci` in summary table `compare_means` and `compare_props` should be margin of err (`me`) +* Option to use `Z-test` in `single_prop` + +# radiant.basics 0.9.7.2 + +* Load a state file on startup by providing a (relative) file path or a url + +# radiant.basics 0.9.7.0 + +* Using [`shinyFiles`](https://github.com/thomasp85/shinyFiles) to provide convenient access to data located on a server + +# radiant.basics 0.9.5.0 + +## Major changes + +* Various changes to the code to accommodate the use of `shiny::makeReactiveBinding`. The advantage is that the code generated for _Report > Rmd_ and _Report > R_ will no longer have to use `r_data` to store and access data. This means that code generated and used in the Radiant browser interface will be directly usable without the browser interface as well. + +# radiant.basics 0.9.2.0 + +## Major changes + +* Upload and download data using the Rstudio file browser. Allows using relative paths to files (e.g., data or images inside an Rstudio project) +* Variable selection in Summary tabs only to simplify Plot interface + +## Bug fixes + +* Fix for [#43](https://github.com/radiant-rstats/radiant/issues/43) where scatter plot was not shown for a dataset with less than 1,000 rows + +# radiant.basics 0.9.0.4 + +## Minor changes + +* Format tables with thousand separator +* Added print method for return from `correlation` + +# radiant.basics 0.9.0.3 + +## Minor changes + +* Enhanced keyboard shortcuts +* `summary.single_prop` will not print row numbers +* Added log.normal as an option in the probability calculator +* The correlation plot now has an option to select a sample of data for scatter plots (e.g., 1K, 5K, 10K, or All) + +# radiant.basics 0.8.9.0 + +## Minor changes + +* Upgraded broom dependency to 0.4.3 +* Upgraded dplyr dependency to 0.7.4 +* Upgraded tidyr dependency to 0.7.2 +* Fixed CI printing error for `compare_prop` +* Applied `styler` to code +* Long lines of code generated for _Report > Rmd_ and _Report > R_ will be wrapped to enhance readability + +# radiant.basics 0.8.3.0 + +## Minor changes + +* `correlation` defaults to all variables if no value for `var` is provided +* Renamed methods `summary.correlation_` and `plot.correlation_` to `summary.correlation` and `plot.correlation` +* Added `tab` argument to `goodness` and `cross_tabs` so a table object can be passed directly +* Documentation updates +* Scatter plots in _Correlation > Plot_ are now based on 1,000 data points by default. Use _Report > Rmd_ or _Report > R_ to adjust (e.g., `plot(result, n = -1)`) + +## Bug fixes + +* Fix for level ordering in goodness-of-fit expected-values plot +* Code clean-up and various minor fixes and improvements + +# radiant.basics 0.8.0.0 + +## Major changes + +- Show dataset name in output if dataframe passed directly to analysis function +- Scatter plots in Basics > Correlation > Plot now based on 1,000 data points by default. Add n = -1 to use all data points +- As an alternative to using the Estimate button to run a model you can now also use CTRL-enter or CMD-enter +- Use ALT-enter to put code into _Report > Rmd_ or _Report > R_ +- Documentation added on how to customize plots + +## Bug fixes + +- Fixed correlation dropdown. Correlations did not change when method was changed (thanks @Fiordmaster) +- Improved formatting for small negative values in Basics > Correlation +- Convert numeric bounds to integer in Basics > Probability calculator > Binomial to avoid warnings + +## Deprecated + +- Use of *_each is deprecated diff --git a/radiant.basics/R/aaa.R b/radiant.basics/R/aaa.R new file mode 100644 index 0000000000000000000000000000000000000000..f64e4945d4418253cb142e18aea596bfcabba6ff --- /dev/null +++ b/radiant.basics/R/aaa.R @@ -0,0 +1,60 @@ +# to avoid 'no visible binding for global variable' NOTE +globalVariables(c( + ".", "n", "se", "me", "Freq", "ci", "col1", "n", + "y", "parameter", "variable", "dec", "df1", "df2", "lambda", + "lb", "meanlog", "p_elb", "p_eub", "p_int", "p_lb", "p_lelb", + "p_leub", "p_ub", "plb", "pub", "rate", "sdlog", "stdev", + "ub", "v", "v_lb", "v_ub", "vlb", "vp_elb", "vp_eub", "vp_int", + "vp_lb", "vp_lelb", "vp_leub", "vp_ub", "vub", "n_miss" +)) + +#' radiant.basics +#' +#' @name radiant.basics +#' @import radiant.data shiny ggplot2 +#' @importFrom dplyr mutate_all mutate_if summarise_all summarise_at funs rename bind_cols select filter group_by_at summarise arrange mutate count left_join +#' @importFrom tidyr gather spread +#' @importFrom scales percent +#' @importFrom magrittr %>% %<>% set_rownames set_colnames set_names divide_by +#' @importFrom graphics pairs par points strwidth text +#' @importFrom patchwork wrap_plots plot_annotation +#' @importFrom stats na.omit binom.test chisq.test cor.test cov dbinom dchisq dexp df dnorm dpois dt dunif p.adjust pbinom pchisq pexp pf pnorm ppois prop.test pt punif qbinom qchisq qexp qf qpois qt qunif qnorm rbinom dlnorm plnorm qlnorm relevel sd setNames symnum t.test wilcox.test +#' @importFrom utils combn +#' @importFrom import from +NULL + +#' Newspaper readership +#' @details Newspaper readership data for 580 consumers. Description provided in attr(newspaper,"description") +#' @docType data +#' @keywords datasets +#' @name newspaper +#' @usage data(newspaper) +#' @format A data frame with 580 rows and 2 variables +NULL + +#' Car brand consideration +#' @details Survey data of consumer purchase intentions. Description provided in attr(consider,"description") +#' @docType data +#' @keywords datasets +#' @name consider +#' @usage data(consider) +#' @format A data frame with 1000 rows and 2 variables +NULL + +#' Demand in the UK +#' @details Survey data of consumer purchase intentions. Description provided in attr(demand_uk,"description") +#' @docType data +#' @keywords datasets +#' @name demand_uk +#' @usage data(demand_uk) +#' @format A data frame with 1000 rows and 2 variables +NULL + +#' Salaries for Professors +#' @details 2008-2009 nine-month salary for professors in a college in the US. Description provided in attr(salary,description") +#' @docType data +#' @keywords datasets +#' @name salary +#' @usage data(salary) +#' @format A data frame with 397 rows and 6 variables +NULL diff --git a/radiant.basics/R/clt.R b/radiant.basics/R/clt.R new file mode 100644 index 0000000000000000000000000000000000000000..d22fb176564be3cf0f0993548b0af696a1bb4368 --- /dev/null +++ b/radiant.basics/R/clt.R @@ -0,0 +1,85 @@ +#' Central Limit Theorem simulation +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/clt.html} for an example in Radiant +#' +#' @param dist Distribution to simulate +#' @param n Sample size +#' @param m Number of samples +#' @param norm_mean Mean for the normal distribution +#' @param norm_sd Standard deviation for the normal distribution +#' @param binom_size Size for the binomial distribution +#' @param binom_prob Probability for the binomial distribution +#' @param unif_min Minimum for the uniform distribution +#' @param unif_max Maximum for the uniform distribution +#' @param expo_rate Rate for the exponential distribution +#' +#' @importFrom stats rexp rnorm runif rbinom +#' +#' @return A list with the name of the Distribution and a matrix of simulated data +#' +#' @examples +#' clt("Uniform", 10, 10, unif_min = 10, unif_max = 20) +#' +#' @export +clt <- function(dist, n = 100, m = 100, + norm_mean = 0, norm_sd = 1, + binom_size = 10, binom_prob = 0.2, + unif_min = 0, unif_max = 1, + expo_rate = 1) { + if (dist == "Uniform") { + sim <- matrix(runif(n * m, min = unif_min, max = unif_max), n, m) + } else if (dist == "Normal") { + sim <- matrix(rnorm(n * m, mean = norm_mean, sd = norm_sd), n, m) + } else if (dist == "Exponential") { + sim <- matrix(rexp(n * m, rate = expo_rate), n, m) + } else if (dist == "Binomial") { + sim <- matrix(rbinom(n * m, size = binom_size, prob = binom_prob), n, m) + } + + add_class(list(dist = dist, sim = sim), "clt") +} + +#' Plot method for the Central Limit Theorem simulation +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/clt.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{clt}} +#' @param stat Statistic to use (sum or mean) +#' @param bins Number of bins to use +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' clt("Uniform", 100, 100, unif_min = 10, unif_max = 20) %>% plot() +#' +#' @export +plot.clt <- function(x, stat = "sum", bins = 15, ...) { + if (stat == "sum") { + sstat <- data.frame(stat = colSums(x$sim), stringsAsFactors = FALSE) + } else { + sstat <- data.frame(stat = colMeans(x$sim), stringsAsFactors = FALSE) + } + + m <- dim(x$sim)[2] + data1 <- data.frame(sample_1 = x$sim[, 1], stringsAsFactors = FALSE) + datam <- data.frame(sample_m = x$sim[, m], stringsAsFactors = FALSE) + + plot_list <- list() + plot_list[[1]] <- visualize(data1, xvar = "sample_1", bins = bins, custom = TRUE) + + labs(x = "Histogram of sample #1") + + plot_list[[2]] <- visualize(datam, xvar = "sample_m", bins = bins, custom = TRUE) + + labs(x = paste0("Histogram of sample #", m)) + + plot_list[[3]] <- visualize(sstat, xvar = "stat", bins = bins, custom = TRUE) + + labs(x = ifelse(stat == "sum", "Histogram of sample sums", "Histogram of sample means")) + + + plot_list[[4]] <- visualize(sstat, xvar = "stat", type = "density", custom = TRUE) + + stat_function(fun = dnorm, args = list( + mean = mean(sstat[[1]]), + sd = sd(sstat[[1]]) + ), color = "black", size = 1) + + labs(x = ifelse(stat == "sum", "Density of sample sums", "Density of sample means")) + + patchwork::wrap_plots(plot_list, ncol = 2) + patchwork::plot_annotation(title = glue("CLT: {x$dist} distribution")) +} diff --git a/radiant.basics/R/compare_means.R b/radiant.basics/R/compare_means.R new file mode 100644 index 0000000000000000000000000000000000000000..3a6071dfcc97df5d83c38258c70deb3cb36295c9 --- /dev/null +++ b/radiant.basics/R/compare_means.R @@ -0,0 +1,309 @@ +#' Compare sample means +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/compare_means.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param var1 A numeric variable or factor selected for comparison +#' @param var2 One or more numeric variables for comparison. If var1 is a factor only one variable can be selected and the mean of this variable is compared across (factor) levels of var1 +#' @param samples Are samples independent ("independent") or not ("paired") +#' @param alternative The alternative hypothesis ("two.sided", "greater" or "less") +#' @param conf_lev Span of the confidence interval +#' @param comb Combinations to evaluate +#' @param adjust Adjustment for multiple comparisons ("none" or "bonf" for Bonferroni) +#' @param test t-test ("t") or Wilcox ("wilcox") +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param envir Environment to extract data from +#' +#' @return A list of all variables defined in the function as an object of class compare_means +#' +#' @examples +#' compare_means(diamonds, "cut", "price") %>% str() +#' +#' @seealso \code{\link{summary.compare_means}} to summarize results +#' @seealso \code{\link{plot.compare_means}} to plot results +#' +#' @export +compare_means <- function(dataset, var1, var2, samples = "independent", + alternative = "two.sided", conf_lev = .95, + comb = "", adjust = "none", test = "t", + data_filter = "", envir = parent.frame()) { + vars <- c(var1, var2) + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, vars, filt = data_filter, na.rm = FALSE, envir = envir) + + ## in case : was used for var2 + vars <- colnames(dataset) + + if (is.numeric(dataset[[var1]])) { + dataset %<>% gather("variable", "values", !!vars) + dataset[["variable"]] %<>% factor(levels = vars) + cname <- " " + } else { + if (is.character(dataset[[var1]])) dataset[[var1]] <- as.factor(dataset[[var1]]) + if (length(levels(dataset[[var1]])) == nrow(dataset)) { + return("Test requires multiple observations in each group. Please select another variable." %>% + add_class("compare_means")) + } + colnames(dataset) <- c("variable", "values") + cname <- var1 + } + + ## needed with new tidyr + dataset$variable %<>% as.factor() + + not_vary <- vars[summarise_all(dataset, does_vary) == FALSE] + if (length(not_vary) > 0) { + return(paste0("The following variable(s) show no variation. Please select other variables.\n\n** ", paste0(not_vary, collapse = ", "), " **") %>% + add_class("compare_means")) + } + + ## resetting option to independent if the number of observations is unequal + ## summary on factor gives counts + if (samples == "paired") { + if (summary(dataset[["variable"]]) %>% (function(x) max(x) != min(x))) { + samples <- "independent (obs. per level unequal)" + } + } + + levs <- levels(dataset[["variable"]]) + + cmb <- combn(levs, 2) %>% + t() %>% + as.data.frame(stringsAsFactors = FALSE) + rownames(cmb) <- cmb %>% + apply(1, paste, collapse = ":") + colnames(cmb) <- c("group1", "group2") + + if (!is.empty(comb)) { + if (all(comb %in% rownames(cmb))) { + cmb <- cmb[comb, ] + } else { + cmb <- cmb[1, ] + } + } + + res <- cmb + res[, c("t.value", "p.value", "df", "ci_low", "ci_high", "cis_low", "cis_high")] <- 0 + + for (i in 1:nrow(cmb)) { + sel <- sapply(cmb[i, ], as.character) + x <- filter(dataset, variable == sel[1]) %>% .[["values"]] + y <- filter(dataset, variable == sel[2]) %>% .[["values"]] + + res[i, c("t.value", "p.value", "df", "ci_low", "ci_high")] <- + t.test(x, y, paired = samples == "paired", alternative = alternative, conf.level = conf_lev) %>% + tidy() %>% + .[1, c("statistic", "p.value", "parameter", "conf.low", "conf.high")] + + if (test != "t") { + res[i, "p.value"] <- + wilcox.test( + x, y, + paired = samples == "paired", alternative = alternative, + conf.int = FALSE, conf.level = conf_lev + ) %>% + tidy() %>% + .[1, "p.value"] + } + + ## bootstrap confidence intervals + ## seem almost identical, even with highly skewed data + # nr_x <- length(x) + # nr_y <- length(y) + + # sim_ci <- + # replicate(1000, mean(sample(x, nr_x, replace = TRUE)) - + # mean(sample(y, nr_y, replace = TRUE))) %>% + # quantile(probs = {(1-conf_lev)/2} %>% c(., 1 - .)) + + # res[i, c("cis_low", "cis_high")] <- sim_ci + } + + if (adjust != "none") { + res$p.value %<>% p.adjust(method = adjust) + } + + ## adding significance stars + res$sig_star <- sig_stars(res$p.value) + + ## from http://www.cookbook-r.com/Graphs/Plotting_means_and_error_bars_(ggplot2)/ + me_calc <- function(se, n, conf.lev = .95) { + se * qt(conf.lev / 2 + .5, n - 1) + } + + dat_summary <- group_by_at(dataset, .vars = "variable") %>% + summarise_all( + list( + mean = ~ mean(., na.rm = TRUE), + n = length, + n_missing = n_missing, + sd = ~ sd(., na.rm = TRUE), + se = ~ se(., na.rm = TRUE), + me = ~ me_calc(se, n, conf_lev) + ) + ) %>% + rename(!!!setNames("variable", cname)) + + vars <- paste0(vars, collapse = ", ") + rm(x, y, sel, i, me_calc, envir) + as.list(environment()) %>% add_class("compare_means") +} + +#' Summary method for the compare_means function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/compare_means.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{compare_means}} +#' @param show Show additional output (i.e., t.value, df, and confidence interval) +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- compare_means(diamonds, "cut", "price") +#' summary(result) +#' +#' @seealso \code{\link{compare_means}} to calculate results +#' @seealso \code{\link{plot.compare_means}} to plot results +#' +#' @export +summary.compare_means <- function(object, show = FALSE, dec = 3, ...) { + if (is.character(object)) { + return(object) + } + + cat(paste0("Pairwise mean comparisons (", object$test, "-test)\n")) + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + cat("Variables :", object$vars, "\n") + cat("Samples :", object$samples, "\n") + cat("Confidence:", object$conf_lev, "\n") + cat("Adjustment:", if (object$adjust == "bonf") "Bonferroni" else "None", "\n\n") + + object$dat_summary %>% + as.data.frame(stringsAsFactors = FALSE) %>% + format_df(dec = dec, mark = ",") %>% + print(row.names = FALSE) + cat("\n") + + hyp_symbol <- c( + "two.sided" = "not equal to", + "less" = "<", + "greater" = ">" + )[object$alternative] + + means <- object$dat_summary$mean + names(means) <- as.character(object$dat_summary[[1]]) + + ## determine lower and upper % for ci + ci_perc <- ci_label(object$alternative, object$conf_lev) + + mod <- object$res + mod$`Alt. hyp.` <- paste(mod$group1, hyp_symbol, mod$group2, " ") + mod$`Null hyp.` <- paste(mod$group1, "=", mod$group2, " ") + mod$diff <- + (means[as.character(mod$group1)] - means[as.character(mod$group2)]) %>% + round(dec) + + if (show) { + mod$se <- (mod$diff / mod$t.value) %>% round(dec) + mod <- mod[, c("Null hyp.", "Alt. hyp.", "diff", "p.value", "se", "t.value", "df", "ci_low", "ci_high", "sig_star")] + if (!is.integer(mod[["df"]])) mod[["df"]] %<>% round(dec) + mod[, c("t.value", "ci_low", "ci_high")] %<>% round(dec) + mod <- rename(mod, !!!setNames(c("ci_low", "ci_high"), ci_perc)) + } else { + mod <- mod[, c("Null hyp.", "Alt. hyp.", "diff", "p.value", "sig_star")] + } + + mod <- rename(mod, ` ` = "sig_star") + mod$p.value <- round(mod$p.value, dec) + mod$p.value[mod$p.value < .001] <- "< .001" + print(mod, row.names = FALSE, right = FALSE) + cat("\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n") +} + +#' Plot method for the compare_means function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/compare_means.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{compare_means}} +#' @param plots One or more plots ("bar", "density", "box", or "scatter") +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- compare_means(diamonds, "cut", "price") +#' plot(result, plots = c("bar", "density")) +#' +#' @seealso \code{\link{compare_means}} to calculate results +#' @seealso \code{\link{summary.compare_means}} to summarize results +#' +#' @importFrom rlang .data +#' +#' @export +plot.compare_means <- function(x, plots = "scatter", shiny = FALSE, custom = FALSE, ...) { + if (is.character(x)) { + return(x) + } + cn <- colnames(x$dataset) + v1 <- cn[1] + v2 <- cn[-1] + + ## cname is equal to " " when the xvar is numeric + if (is.empty(x$cname)) { + var1 <- v1 + var2 <- v2 + } else { + var1 <- x$var1 + var2 <- x$var2 + } + + ## from http://www.cookbook-r.com/Graphs/Plotting_means_and_error_bars_(ggplot2)/ + plot_list <- list() + if ("bar" %in% plots) { + colnames(x$dat_summary)[1] <- "variable" + ## use of `which` allows the user to change the order of the plots shown + plot_list[[which("bar" == plots)]] <- + ggplot( + x$dat_summary, + aes(x = .data$variable, y = .data$mean, fill = .data$variable) + ) + + geom_bar(stat = "identity") + + geom_errorbar(width = .1, aes(ymin = mean - me, ymax = mean + me)) + + geom_errorbar(width = .05, aes(ymin = mean - se, ymax = mean + se), color = "blue") + + theme(legend.position = "none") + + labs(x = var1, y = paste0(var2, " (mean)")) + } + + ## graphs on full data + if ("box" %in% plots) { + plot_list[[which("box" == plots)]] <- + visualize(x$dataset, xvar = v1, yvar = v2, type = "box", custom = TRUE) + + theme(legend.position = "none") + + labs(x = var1, y = var2) + } + + if ("density" %in% plots) { + plot_list[[which("density" == plots)]] <- + visualize(x$dataset, xvar = v2, type = "density", fill = v1, custom = TRUE) + + labs(x = var2) + + guides(fill = guide_legend(title = var1)) + } + + if ("scatter" %in% plots) { + plot_list[[which("scatter" == plots)]] <- + visualize(x$dataset, xvar = v1, yvar = v2, type = "scatter", check = "jitter", alpha = 0.3, custom = TRUE) + + labs(x = var1, y = paste0(var2, " (mean)")) + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = 1) %>% + (function(x) if (isTRUE(shiny)) x else print(x)) + } + } +} diff --git a/radiant.basics/R/compare_props.R b/radiant.basics/R/compare_props.R new file mode 100644 index 0000000000000000000000000000000000000000..83e9cee9cb9a238a9c75fc2068c5d7d891a3d7bd --- /dev/null +++ b/radiant.basics/R/compare_props.R @@ -0,0 +1,282 @@ +#' Compare sample proportions across groups +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/compare_props.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param var1 A grouping variable to split the data for comparisons +#' @param var2 The variable to calculate proportions for +#' @param levs The factor level selected for the proportion comparison +#' @param alternative The alternative hypothesis ("two.sided", "greater" or "less") +#' @param conf_lev Span of the confidence interval +#' @param comb Combinations to evaluate +#' @param adjust Adjustment for multiple comparisons ("none" or "bonf" for Bonferroni) +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param envir Environment to extract data from +#' +#' @return A list of all variables defined in the function as an object of class compare_props +#' +#' @examples +#' compare_props(titanic, "pclass", "survived") %>% str() +#' +#' @seealso \code{\link{summary.compare_props}} to summarize results +#' @seealso \code{\link{plot.compare_props}} to plot results +#' +#' @export +compare_props <- function(dataset, var1, var2, levs = "", + alternative = "two.sided", conf_lev = .95, + comb = "", adjust = "none", data_filter = "", + envir = parent.frame()) { + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + vars <- c(var1, var2) + dataset <- get_data(dataset, vars, filt = data_filter, na.rm = FALSE, envir = envir) %>% + mutate_all(as.factor) + + dataset <- dataset[!is.na(dataset[[1]]), , drop = FALSE] + n_miss_df <- group_by_at(dataset, var1) %>% + summarise_at(n_missing, .vars = var2) %>% + set_colnames(c(var1, "n_miss")) + dataset <- na.omit(dataset) + + if (length(levels(dataset[[var1]])) == nrow(dataset)) { + return("Test requires multiple observations in each group. Please select another variable." %>% + add_class("compare_props")) + } + + lv <- levels(dataset[[var2]]) + if (levs != "") { + if (levs %in% lv && lv[1] != levs) { + dataset[[var2]] %<>% as.character %>% + as.factor() %>% + relevel(levs) + lv <- levels(dataset[[var2]]) + } + } + + ## check if there is variation in the data + not_vary <- colnames(dataset)[summarise_all(dataset, does_vary) == FALSE] + if (length(not_vary) > 0) { + return(paste0("The following variable(s) show no variation. Please select other variables.\n\n** ", paste0(not_vary, collapse = ", "), " **") %>% + add_class("compare_props")) + } + + rn <- "" + prop_input <- group_by_at(dataset, .vars = c(var1, var2)) %>% + summarise(n = n(), .groups = "drop") %>% + spread(!!var2, "n") %>% + as.data.frame(stringsAsFactors = FALSE) %>% + (function(x) { + rn <<- x[[1]] %>% as.character() + select(x, -1) %>% + as.matrix() %>% + set_rownames(rn) + }) + + prop_input[is.na(prop_input)] <- 0 + + lv <- rownames(prop_input) + cmb <- combn(lv, 2) %>% + t() %>% + as.data.frame(stringsAsFactors = FALSE) + + rownames(cmb) <- cmb %>% apply(1, paste, collapse = ":") + colnames(cmb) <- c("group1", "group2") + + if (!is.empty(comb)) { + if (all(comb %in% rownames(cmb))) { + cmb <- cmb[comb, ] + } else { + cmb <- cmb[1, ] + } + } + + res <- cmb + res[, c("chisq.value", "p.value", "df", "ci_low", "ci_high", "sim")] <- 0 + for (i in 1:nrow(cmb)) { + ind <- c(which(cmb[i, 1] == rownames(prop_input)), which(cmb[i, 2] == rownames(prop_input))) + + pinp <- prop_input[ind, ] + + res[i, c("chisq.value", "p.value", "df", "ci_low", "ci_high")] <- + sshhr(prop.test(pinp, alternative = alternative, conf.level = conf_lev, correct = FALSE)) %>% + tidy() %>% + .[1, c("statistic", "p.value", "parameter", "conf.low", "conf.high")] + + ## calculate expected values + E <- (rowSums(pinp) %*% t(colSums(pinp))) / sum(pinp) + if (any(E < 5)) { + res[i, "p.value"] <- sshhr(chisq.test(pinp, simulate.p.value = TRUE, B = 2000) %>% tidy() %>% .$p.value) + res[i, "df"] <- NA + } + } + + if (adjust != "none") { + res$p.value %<>% p.adjust(method = adjust) + } + + ## adding significance stars + res$sig_star <- sig_stars(res$p.value) + + ## from http://www.cookbook-r.com/Graphs/Plotting_props_and_error_bars_(ggplot2)/ + me_calc <- function(se, conf.lev = .95) { + se * qnorm(conf.lev / 2 + .5, lower.tail = TRUE) + } + + dat_summary <- data.frame(prop_input, check.names = FALSE, stringsAsFactors = FALSE) %>% + mutate_if(is.numeric, as.integer) %>% + mutate( + p = .[[1]] / as.integer(rowSums(.[, 1:2])), + n = as.integer(rowSums(.[, 1:2])), + n_missing = 0, + sd = sqrt(p * (1 - p)), + se = sqrt(p * (1 - p) / n), + me = me_calc(se, conf_lev) + ) %>% + set_rownames(rownames(prop_input)) %>% + rownames_to_column(var = var1) + + dat_summary[[var1]] %<>% factor(., levels = .) + dat_summary <- suppressWarnings(left_join(dat_summary, n_miss_df, by = var1)) %>% + mutate(n_missing = n_miss) %>% + select(-n_miss) + vars <- paste0(vars, collapse = ", ") + rm(i, me_calc, envir) + as.list(environment()) %>% add_class("compare_props") +} + +#' Summary method for the compare_props function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/compare_props.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{compare_props}} +#' @param show Show additional output (i.e., chisq.value, df, and confidence interval) +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- compare_props(titanic, "pclass", "survived") +#' summary(result) +#' +#' @seealso \code{\link{compare_props}} to calculate results +#' @seealso \code{\link{plot.compare_props}} to plot results +#' +#' @export +summary.compare_props <- function(object, show = FALSE, dec = 3, ...) { + if (is.character(object)) { + return(object) + } + + cat("Pairwise proportion comparisons\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + cat("Variables :", object$vars, "\n") + cat("Level :", object$levs, "in", object$var2, "\n") + cat("Confidence:", object$conf_lev, "\n") + cat("Adjustment:", if (object$adjust == "bonf") "Bonferroni" else "None", "\n\n") + + object$dat_summary %>% + as.data.frame(stringsAsFactors = FALSE) %>% + format_df(dec = dec, mark = ",") %>% + print(row.names = FALSE) + cat("\n") + + hyp_symbol <- c( + "two.sided" = "not equal to", + "less" = "<", + "greater" = ">" + )[object$alternative] + + props <- object$dat_summary$p + names(props) <- object$rn + + ## determine lower and upper % for ci + ci_perc <- ci_label(object$alternative, object$conf_lev) + + res <- object$res + res$`Alt. hyp.` <- paste(res$group1, hyp_symbol, res$group2, " ") + res$`Null hyp.` <- paste(res$group1, "=", res$group2, " ") + res$diff <- (props[res$group1 %>% as.character()] - props[res$group2 %>% as.character()]) %>% round(dec) + + res_sim <- is.na(res$df) + if (show) { + res <- res[, c("Null hyp.", "Alt. hyp.", "diff", "p.value", "chisq.value", "df", "ci_low", "ci_high", "sig_star")] + res[, c("chisq.value", "ci_low", "ci_high")] %<>% format_df(dec, mark = ",") + + res$df[res_sim] <- "*1*" + res <- rename(res, !!!setNames(c("ci_low", "ci_high"), ci_perc)) + } else { + res <- res[, c("Null hyp.", "Alt. hyp.", "diff", "p.value", "sig_star")] + } + + res <- rename(res, ` ` = "sig_star") + res$p.value[res$p.value >= .001] %<>% round(dec) + res$p.value[res$p.value < .001] <- "< .001" + res$p.value[res_sim] %<>% paste0(" (2000 replicates)") + print(res, row.names = FALSE, right = FALSE) + cat("\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n") +} + +#' Plot method for the compare_props function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/compare_props.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{compare_props}} +#' @param plots One or more plots of proportions ("bar" or "dodge") +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- compare_props(titanic, "pclass", "survived") +#' plot(result, plots = c("bar", "dodge")) +#' +#' @seealso \code{\link{compare_props}} to calculate results +#' @seealso \code{\link{summary.compare_props}} to summarize results +#' +#' @importFrom rlang .data +#' +#' @export +plot.compare_props <- function(x, plots = "bar", shiny = FALSE, + custom = FALSE, ...) { + if (is.character(x)) { + return(x) + } + v1 <- colnames(x$dataset)[1] + v2 <- colnames(x$dataset)[-1] + lev_name <- x$levs + + ## from http://www.cookbook-r.com/Graphs/Plotting_props_and_error_bars_(ggplot2)/ + plot_list <- list() + if ("bar" %in% plots) { + ## use of `which` allows the user to change the order of the plots shown + plot_list[[which("bar" == plots)]] <- + ggplot(x$dat_summary, aes(x = .data[[v1]], y = .data$p, fill = .data[[v1]])) + + geom_bar(stat = "identity", alpha = 0.5) + + geom_errorbar(width = .1, aes(ymin = p - me, ymax = p + me)) + + geom_errorbar(width = .05, aes(ymin = p - se, ymax = p + se), color = "blue") + + theme(legend.position = "none") + + scale_y_continuous(labels = scales::percent) + + labs(y = paste0("Proportion of \"", lev_name, "\" in ", v2)) + } + + if ("dodge" %in% plots) { + plot_list[[which("dodge" == plots)]] <- group_by_at(x$dataset, .vars = c(v1, v2)) %>% + summarise(count = n(), .groups = "drop") %>% + group_by_at(.vars = v1) %>% + mutate(perc = count / sum(count)) %>% + ggplot(aes(x = .data[[v1]], y = .data$perc, fill = .data[[v2]])) + + geom_bar(stat = "identity", position = "dodge", alpha = 0.5) + + scale_y_continuous(labels = scales::percent) + + labs(y = paste0("Proportions per level of ", v1)) + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = 1) %>% + (function(x) if (isTRUE(shiny)) x else print(x)) + } + } +} diff --git a/radiant.basics/R/correlation.R b/radiant.basics/R/correlation.R new file mode 100644 index 0000000000000000000000000000000000000000..6914f36050c7a00f1b0b237a0be80b0775451cad --- /dev/null +++ b/radiant.basics/R/correlation.R @@ -0,0 +1,318 @@ +#' Calculate correlations for two or more variables +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/correlation.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param vars Variables to include in the analysis. Default is all but character and factor variables with more than two unique values are removed +#' @param method Type of correlations to calculate. Options are "pearson", "spearman", and "kendall". "pearson" is the default +#' @param hcor Use polycor::hetcor to calculate the correlation matrix +#' @param hcor_se Calculate standard errors when using polycor::hetcor +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param envir Environment to extract data from +#' +#' @return A list with all variables defined in the function as an object of class compare_means +#' +#' @examples +#' correlation(diamonds, c("price", "carat")) %>% str() +#' correlation(diamonds, "x:z") %>% str() +#' +#' @seealso \code{\link{summary.correlation}} to summarize results +#' @seealso \code{\link{plot.correlation}} to plot results +#' +#' @importFrom psych corr.test +#' @importFrom lubridate is.Date +#' @importFrom polycor hetcor +#' +#' +#' @export +correlation <- function(dataset, vars = "", method = "pearson", hcor = FALSE, hcor_se = FALSE, + data_filter = "", envir = parent.frame()) { + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + + ## data.matrix as the last step in the chain is about 25% slower using + ## system.time but results (using diamonds and mtcars) are identical + dataset <- get_data(dataset, vars, filt = data_filter, envir = envir) %>% + mutate_if(is.Date, as_numeric) + anyCategorical <- sapply(dataset, is.numeric) == FALSE + + not_vary <- colnames(dataset)[summarise_all(dataset, does_vary) == FALSE] + if (length(not_vary) > 0) { + return(paste0("The following variable(s) show no variation. Please select other variables.\n\n** ", paste0(not_vary, collapse = ", "), " **") %>% + add_class("correlation")) + } + + num_dat <- mutate_all(dataset, radiant.data::as_numeric) + + ## calculate the correlation matrix with p.values using the psych package + if (hcor) { + ## added as.data.frame due to hetcor throwing errors when using tibbles + cmath <- try(sshhr(polycor::hetcor(as.data.frame(dataset), ML = FALSE, std.err = hcor_se)), silent = TRUE) + if (inherits(cmath, "try-error")) { + message("Calculating the heterogeneous correlation matrix produced an error.\nUsing standard correlation matrix instead") + hcor <- "Calculation failed" + cmat <- sshhr(psych::corr.test(num_dat, method = method)) + } else { + cmat <- list() + cmat$r <- cmath$correlations + cmat$p <- matrix(NA, ncol(cmat$r), nrow(cmat$r)) + rownames(cmat$p) <- colnames(cmat$p) <- colnames(cmat$r) + if (hcor_se) { + cmat_z <- cmat$r / cmath$std.errors + cmat$p <- 2 * pnorm(abs(cmat_z), lower.tail = FALSE) + } + } + rm(cmath) + } else { + cmat <- sshhr(psych::corr.test(num_dat, method = method)) + } + + ## calculate covariance matrix + cvmat <- sshhr(cov(num_dat, method = method)) + rm(num_dat, envir) + + if (sum(anyCategorical) > 0) { + if (isTRUE(hcor)) { + adj_text <- "\n\nNote: Categorical variables are assumed to be ordinal and were calculated using polycor::hetcor\n\n" + } else { + adj_text <- "\n\nNote: Categorical variables were included without adjustment\n\n" + } + } else { + adj_text <- "\n\n" + } + descr <- paste0("## Correlation matrix\n\nCorrelations were calculated using the \"", df_name, "\" dataset", adj_text, "Variables used:\n\n* ", paste0(vars, collapse = "\n* ")) + + as.list(environment()) %>% + add_class("correlation") %>% + add_class("rcorr") +} + +#' Summary method for the correlation function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/correlation.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{correlation}} +#' @param cutoff Show only correlations larger than the cutoff in absolute value. Default is a cutoff of 0 +#' @param covar Show the covariance matrix (default is FALSE) +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods. +#' +#' @examples +#' result <- correlation(diamonds, c("price", "carat", "table")) +#' summary(result, cutoff = .3) +#' +#' @seealso \code{\link{correlation}} to calculate results +#' @seealso \code{\link{plot.correlation}} to plot results +#' +#' @export +summary.correlation <- function(object, cutoff = 0, covar = FALSE, dec = 2, ...) { + if (is.character(object)) { + return(object) + } + + ## calculate the correlation matrix with p.values using the psych package + cr <- object$cmat$r + crf <- try(format_nr(cr, dec = dec, na.rm = FALSE), silent = TRUE) + if (inherits(crf, "try-error")) { + cr <- round(cr, dec) + } else { + cr[1:nrow(cr), 1:ncol(cr)] <- crf + } + cr[is.na(object$cmat$r)] <- "-" + cr[abs(object$cmat$r) < cutoff] <- "" + ltmat <- lower.tri(cr) + cr[!ltmat] <- "" + + cp <- object$cmat$p + cpf <- try(format_nr(cp, dec = dec, na.rm = FALSE), silent = TRUE) + if (inherits(cpf, "try-error")) { + cp <- round(cp, dec) + } else { + cp[1:nrow(cp), 1:ncol(cp)] <- cpf + } + cp[is.na(object$cmat$p)] <- "-" + cp[abs(object$cmat$r) < cutoff] <- "" + cp[!ltmat] <- "" + + cat("Correlation\n") + cat("Data :", object$df_name, "\n") + method <- paste0(toupper(substring(object$method, 1, 1)), substring(object$method, 2)) + if (is.character(object$hcor)) { + cat(paste0("Method : ", method, " (adjustment using polycor::hetcor failed)\n")) + } else if (isTRUE(object$hcor)) { + if (sum(object$anyCategorical) > 0) { + cat(paste0("Method : Heterogeneous correlations using polycor::hetcor\n")) + } else { + cat(paste0("Method : ", method, " (no adjustment applied)\n")) + } + } else { + cat("Method :", method, "\n") + } + if (cutoff > 0) { + cat("Cutoff :", cutoff, "\n") + } + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + cat("Variables :", paste0(object$vars, collapse = ", "), "\n") + cat("Null hyp. : variables x and y are not correlated\n") + cat("Alt. hyp. : variables x and y are correlated\n") + if (sum(object$anyCategorical) > 0) { + if (isTRUE(object$hcor)) { + cat("** Variables of type {factor} are assumed to be ordinal **\n\n") + } else { + cat("** Variables of type {factor} included without adjustment **\n\n") + } + } else if (isTRUE(object$hcor)) { + cat("** No variables of type {factor} selected. No adjustment applied **\n\n") + } else { + cat("\n") + } + + cat("Correlation matrix:\n") + cr[-1, -ncol(cr), drop = FALSE] %>% + format(justify = "right") %>% + print(quote = FALSE) + + if (!isTRUE(object$hcor) || isTRUE(object$hcor_se)) { + cat("\np.values:\n") + cp[-1, -ncol(cp), drop = FALSE] %>% + format(justify = "right") %>% + print(quote = FALSE) + } + + if (covar) { + cvr <- apply(object$cvmat, 2, format_nr, dec = dec) %>% + set_rownames(rownames(object$cvmat)) + cvr[abs(object$cmat$r) < cutoff] <- "" + ltmat <- lower.tri(cvr) + cvr[!ltmat] <- "" + + cat("\nCovariance matrix:\n") + cvr[-1, -ncol(cvr), drop = FALSE] %>% + format(justify = "right") %>% + print(quote = FALSE) + } + + return(invisible()) +} + +#' Print method for the correlation function +#' +#' @param x Return value from \code{\link{correlation}} +#' @param ... further arguments passed to or from other methods +#' +#' @export +print.rcorr <- function(x, ...) summary.correlation(x, ...) + +#' Plot method for the correlation function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/correlation.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{correlation}} +#' @param nrobs Number of data points to show in scatter plots (-1 for all) +#' @param jit A numeric vector that determines the amount of jittering to apply to the x and y variables in a scatter plot. Default is 0. Use, e.g., 0.3 to add some jittering +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods. +#' +#' @examples +#' result <- correlation(diamonds, c("price", "carat", "table")) +#' plot(result) +#' +#' @seealso \code{\link{correlation}} to calculate results +#' @seealso \code{\link{summary.correlation}} to summarize results +#' +#' @importFrom graphics plot +#' +#' @export +plot.correlation <- function(x, nrobs = -1, jit = c(0, 0), dec = 2, ...) { + if (is.character(x)) { + return(NULL) + } + if (is.null(x[["dataset"]])) { + if (any(sapply(x, is.factor))) { + x <- correlation(x, hcor = TRUE, hcor_se = FALSE) + } else { + x <- correlation(x, hcor = FALSE) + } + } + + cor_text <- function(r, p, dec = 2) { + if (is.na(p)) p <- 1 + sig <- symnum( + p, + corr = FALSE, na = TRUE, + cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1), + symbols = c("***", "**", "*", ".", " ") + ) + + rt <- format(r, digits = dec) + cex <- 0.5 / strwidth(rt) + plot(c(0, 1), c(0, 1), ann = FALSE, type = "n", xaxt = "n", yaxt = "n") + text(.5, .5, rt, cex = cex * abs(r)) + text(.8, .8, sig, cex = cex, col = "blue") + } + + cor_label <- function(label, longest) { + plot(c(0, 1), c(0, 1), ann = FALSE, type = "n", xaxt = "n", yaxt = "n") + cex <- 0.5 / strwidth(longest) + text(.5, .5, label, cex = cex) + } + + cor_plot <- function(x, y, nobs = 1000) { + if (nobs != Inf && nobs != -1) { + ind <- sample(seq_len(length(y)), min(nobs, length(y))) + x <- x[ind] + y <- y[ind] + } + if (is.factor(y) && is.factor(x)) { + plot(x, y, axes = FALSE, xlab = "", ylab = "") + } else if (is.factor(y) & is.numeric(x)) { + plot(y, x, ann = FALSE, xaxt = "n", yaxt = "n", horizontal = TRUE) + } else if (is.numeric(y) & is.factor(x)) { + plot(x, y, ann = FALSE, xaxt = "n", yaxt = "n") + } else { + y <- as.numeric(y) + x <- as.numeric(x) + plot(jitter(x, jit[1]), jitter(y, jit[2]), ann = FALSE, xaxt = "n", yaxt = "n") + } + } + + cor_mat <- function(dataset, cmat, pmat = NULL, dec = 2, nobs = 1000) { + nr <- ncol(dataset) + ops <- par(mfrow = c(nr, nr), mar = rep(0.2, 4)) + on.exit(par(ops)) + cn <- colnames(dataset) + longest <- names(sort(sapply(cn, nchar), decreasing = TRUE))[1] + for (i in seq_along(cn)) { + for (j in seq_along(cn)) { + if (i == j) { + cor_label(cn[i], longest) + } else if (i > j) { + cor_plot(dataset[[i]], dataset[[j]], nobs = nobs) + } else { + cor_text(cmat[i, j], pmat[i, j], dec = 2) + } + } + } + } + + cor_mat(x$dataset, cmat = x$cmat$r, pmat = x$cmat$p, dec = dec, nobs = nrobs) +} + +#' Store a correlation matrix as a (long) data.frame +#' +#' @details Return the correlation matrix as a (long) data.frame. See \url{https://radiant-rstats.github.io/docs/basics/correlation.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{correlation}} +#' @param labels Column names for the correlation pairs +#' @param ... further arguments passed to or from other methods +#' +#' @export +cor2df <- function(object, labels = c("label1", "label2"), ...) { + cmat <- object$cmat$r + correlation <- cmat[lower.tri(cmat)] + distance <- 0.5 * (1 - correlation) + labs <- as.data.frame(t(combn(colnames(cmat), 2))) + colnames(labs) <- labels + cbind(labs, correlation, distance) +} diff --git a/radiant.basics/R/cross_tabs.R b/radiant.basics/R/cross_tabs.R new file mode 100644 index 0000000000000000000000000000000000000000..08b4ad859618a4f042d3fe25a3aa67925efcba8f --- /dev/null +++ b/radiant.basics/R/cross_tabs.R @@ -0,0 +1,372 @@ +#' Evaluate associations between categorical variables +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/cross_tabs.html} for an example in Radiant +#' +#' @param dataset Dataset (i.e., a data.frame or table) +#' @param var1 A categorical variable +#' @param var2 A categorical variable +#' @param tab Table with frequencies as alternative to dataset +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param envir Environment to extract data from +#' +#' @return A list of all variables used in cross_tabs as an object of class cross_tabs +#' +#' @examples +#' cross_tabs(newspaper, "Income", "Newspaper") %>% str() +#' table(select(newspaper, Income, Newspaper)) %>% cross_tabs(tab = .) +#' +#' @seealso \code{\link{summary.cross_tabs}} to summarize results +#' @seealso \code{\link{plot.cross_tabs}} to plot results +#' +#' @export +cross_tabs <- function(dataset, var1, var2, tab = NULL, + data_filter = "", envir = parent.frame()) { + if (is.table(tab)) { + df_name <- deparse(substitute(tab)) + + if (missing(var1) || missing(var2)) { + nm <- names(dimnames(tab)) + var1 <- nm[1] + var2 <- nm[2] + } + + if (is.empty(var1) || is.empty(var2)) { + return("The provided table does not have dimension names. See ?cross_tabs for an example" %>% + add_class("cross_tabs")) + } + } else { + df_name <- if (!is_string(dataset)) deparse(substitute(dataset)) else dataset + dataset <- get_data(dataset, c(var1, var2), filt = data_filter, envir = envir) + + ## Use simulated p-values when + # http://stats.stackexchange.com/questions/100976/n-1-pearsons-chi-square-in-r + # http://stats.stackexchange.com/questions/14226/given-the-power-of-computers-these-days-is-there-ever-a-reason-to-do-a-chi-squa/14230#14230 + # http://stats.stackexchange.com/questions/62445/rules-to-apply-monte-carlo-simulation-of-p-values-for-chi-squared-test + + not_vary <- colnames(dataset)[summarise_all(dataset, does_vary) == FALSE] + if (length(not_vary) > 0) { + return(paste0("The following variable(s) show no variation. Please select other variables.\n\n** ", paste0(not_vary, collapse = ", "), " **") %>% + add_class("cross_tabs")) + } + + tab <- table(dataset[[var1]], dataset[[var2]]) + tab[is.na(tab)] <- 0 + tab <- tab[, colSums(tab) > 0] %>% + (function(x) x[rowSums(x) > 0, ]) %>% + as.table() + ## dataset not needed in summary or plot + rm(dataset) + } + + cst <- sshhr(chisq.test(tab, correct = FALSE)) + + ## adding the % deviation table + cst$chi_sq <- with(cst, (observed - expected)^2 / expected) + + res <- tidy(cst) %>% + mutate(parameter = as.integer(parameter)) + elow <- sum(cst$expected < 5) + + if (elow > 0) { + res$p.value <- chisq.test(cst$observed, simulate.p.value = TRUE, B = 2000) %>% + tidy() %>% + .$p.value + res$parameter <- paste0("*", res$parameter, "*") + } + + rm(envir) + + as.list(environment()) %>% add_class("cross_tabs") +} + +#' Summary method for the cross_tabs function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/cross_tabs.html} for an example in Radiant + +#' @param object Return value from \code{\link{cross_tabs}} +#' @param check Show table(s) for variables var1 and var2. "observed" for the observed frequencies table, "expected" for the expected frequencies table (i.e., frequencies that would be expected if the null hypothesis holds), "chi_sq" for the contribution to the overall chi-squared statistic for each cell (i.e., (o - e)^2 / e), "dev_std" for the standardized differences between the observed and expected frequencies (i.e., (o - e) / sqrt(e)), and "dev_perc" for the percentage difference between the observed and expected frequencies (i.e., (o - e) / e) +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods. +#' +#' @examples +#' result <- cross_tabs(newspaper, "Income", "Newspaper") +#' summary(result, check = c("observed", "expected", "chi_sq")) +#' +#' @seealso \code{\link{cross_tabs}} to calculate results +#' @seealso \code{\link{plot.cross_tabs}} to plot results +#' +#' @export +summary.cross_tabs <- function(object, check = "", dec = 2, ...) { + if (is.character(object)) { + return(object) + } + cat("Cross-tabs\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + cat("Variables:", paste0(c(object$var1, object$var2), collapse = ", "), "\n") + cat("Null hyp.: there is no association between", object$var1, "and", object$var2, "\n") + cat("Alt. hyp.: there is an association between", object$var1, "and", object$var2, "\n") + + rnames <- object$cst$observed %>% + rownames() %>% + c(., "Total") + cnames <- object$cst$observed %>% + colnames() %>% + c(., "Total") + + if ("observed" %in% check) { + cat("\nObserved:\n") + observed <- object$cst$observed %>% + rbind(colSums(.)) %>% + set_rownames(rnames) %>% + cbind(rowSums(.)) %>% + set_colnames(cnames) %>% + format(big.mark = ",", scientific = FALSE) + + names(attributes(observed)$dimnames) <- c(object$var1, object$var2) + print(observed, quote = FALSE) + } + + if ("expected" %in% check) { + cat("\nExpected: (row total x column total) / total\n") + expected <- object$cst$expected %>% + rbind(colSums(.)) %>% + set_rownames(rnames) %>% + cbind(rowSums(.)) %>% + set_colnames(cnames) %>% + round(dec) %>% + format(big.mark = ",", scientific = FALSE) + + names(attributes(expected)$dimnames) <- c(object$var1, object$var2) + print(expected, quote = FALSE) + } + + if ("chi_sq" %in% check) { + cat("\nContribution to chi-squared: (o - e)^2 / e\n") + chi_sq <- object$cst$chi_sq %>% + rbind(colSums(.)) %>% + set_rownames(rnames) %>% + cbind(rowSums(.)) %>% + set_colnames(cnames) %>% + round(dec) %>% + format(big.mark = ",", scientific = FALSE) + + names(attributes(chi_sq)$dimnames) <- c(object$var1, object$var2) + print(chi_sq, quote = FALSE) + } + + if ("dev_std" %in% check) { + cat("\nDeviation standardized: (o - e) / sqrt(e)\n") + resid <- round(object$cst$residuals, dec) ## standardized residuals + names(attributes(resid)$dimnames) <- c(object$var1, object$var2) + print(resid) + } + + if ("row_perc" %in% check) { + cat("\nRow percentages:\n") + row_perc <- object$cst$observed %>% + rbind(colSums(.)) %>% + set_rownames(rnames) %>% + cbind(rowSums(.)) %>% + set_colnames(cnames) %>% + (function(x) x / x[, "Total"]) %>% + round(dec) + + names(attributes(row_perc)$dimnames) <- c(object$var1, object$var2) + print(row_perc) + } + + if ("col_perc" %in% check) { + cat("\nColumn percentages:\n") + col_perc <- object$cst$observed %>% + rbind(colSums(.)) %>% + set_rownames(rnames) %>% + cbind(rowSums(.)) %>% + set_colnames(cnames) %>% + (function(x) t(x) / x["Total", ]) %>% + t() %>% + round(dec) + + names(attributes(col_perc)$dimnames) <- c(object$var1, object$var2) + print(col_perc) + } + + if ("perc" %in% check) { + cat("\nProbability table:\n") + perc <- object$cst$observed %>% + rbind(colSums(.)) %>% + set_rownames(rnames) %>% + cbind(rowSums(.)) %>% + set_colnames(cnames) %>% + (function(x) x / x["Total", "Total"]) %>% + round(dec) + + names(attributes(perc)$dimnames) <- c(object$var1, object$var2) + print(perc) + } + + object$res <- format_df(object$res, dec = dec + 1, mark = ",") + + if (object$res$p.value < .001) object$res$p.value <- "< .001" + cat(paste0("\nChi-squared: ", object$res$statistic, " df(", object$res$parameter, "), p.value ", object$res$p.value), "\n\n") + cat(paste(sprintf("%.1f", 100 * (object$elow / length(object$cst$expected))), "% of cells have expected values below 5\n"), sep = "") + if (object$elow > 0) cat("p.value for chi-squared statistics obtained using simulation (2,000 replicates)") +} + +#' Plot method for the cross_tabs function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/cross_tabs.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{cross_tabs}} +#' @param check Show plots for variables var1 and var2. "observed" for the observed frequencies table, "expected" for the expected frequencies table (i.e., frequencies that would be expected if the null hypothesis holds), "chi_sq" for the contribution to the overall chi-squared statistic for each cell (i.e., (o - e)^2 / e), "dev_std" for the standardized differences between the observed and expected frequencies (i.e., (o - e) / sqrt(e)), and "row_perc", "col_perc", and "perc" for row, column, and table percentages respectively +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- cross_tabs(newspaper, "Income", "Newspaper") +#' plot(result, check = c("observed", "expected", "chi_sq")) +#' +#' @seealso \code{\link{cross_tabs}} to calculate results +#' @seealso \code{\link{summary.cross_tabs}} to summarize results +#' +#' @importFrom rlang .data +#' +#' @export +plot.cross_tabs <- function(x, check = "", shiny = FALSE, custom = FALSE, ...) { + if (is.character(x)) { + return(x) + } + gather_table <- function(tab) { + data.frame(tab, check.names = FALSE, stringsAsFactors = FALSE) %>% + mutate(rnames = rownames(.)) %>% + (function(x) sshhr(gather(x, "variable", "values", !!base::setdiff(colnames(x), "rnames")))) + } + + plot_list <- list() + if (is.empty(check)) check <- "observed" + + if ("observed" %in% check) { + fact_names <- x$cst$observed %>% + dimnames() %>% + as.list() + tab <- as.data.frame(x$cst$observed, check.names = FALSE, stringsAsFactors = FALSE) + colnames(tab)[1:2] <- c(x$var1, x$var2) + tab[[1]] %<>% factor(levels = fact_names[[1]]) + tab[[2]] %<>% factor(levels = fact_names[[2]]) + + plot_list[["observed"]] <- + ggplot(tab, aes(x = .data[[x$var2]], y = .data$Freq, fill = .data[[x$var1]])) + + geom_bar(stat = "identity", position = "fill", alpha = 0.5) + + scale_y_continuous(labels = scales::percent) + + labs( + title = paste("Observed frequencies for ", x$var2, " versus ", x$var1, sep = ""), + x = x$var2, + y = "", + fill = x$var1 + ) + } + + if ("expected" %in% check) { + fact_names <- x$cst$expected %>% + dimnames() %>% + as.list() + tab <- gather_table(x$cst$expected) + tab$rnames %<>% factor(levels = fact_names[[1]]) + tab$variable %<>% factor(levels = fact_names[[2]]) + plot_list[["expected"]] <- + ggplot(tab, aes(x = .data$variable, y = .data$values, fill = .data$rnames)) + + geom_bar(stat = "identity", position = "fill", alpha = 0.5) + + scale_y_continuous(labels = scales::percent) + + labs( + title = paste("Expected frequencies for ", x$var2, " versus ", x$var1, sep = ""), + x = x$var2, + y = "", + fill = x$var1 + ) + } + + if ("chi_sq" %in% check) { + tab <- as.data.frame(x$cst$chi_sq, check.names = FALSE, stringsAsFactors = FALSE) + colnames(tab)[1:2] <- c(x$var1, x$var2) + plot_list[["chi_sq"]] <- + ggplot(tab, aes(x = .data[[x$var2]], y = .data$Freq, fill = .data[[x$var1]])) + + geom_bar(stat = "identity", position = "dodge", alpha = 0.5) + + labs( + title = paste("Contribution to chi-squared for ", x$var2, " versus ", x$var1, sep = ""), + x = x$var2, + y = "" + ) + } + + if ("dev_std" %in% check) { + tab <- as.data.frame(x$cst$residuals, check.names = FALSE, stringsAsFactors = FALSE) + colnames(tab)[1:2] <- c(x$var1, x$var2) + plot_list[["dev_std"]] <- + ggplot(tab, aes(x = .data[[x$var2]], y = .data$Freq, fill = .data[[x$var1]])) + + geom_bar(stat = "identity", position = "dodge", alpha = 0.5) + + geom_hline(yintercept = c(-1.96, 1.96, -1.64, 1.64), color = "black", linetype = "longdash", linewidth = .5) + + geom_text(x = 1, y = 2.11, label = "95%", vjust = 0) + + geom_text(x = 1, y = 1.49, label = "90%", vjust = 1) + + labs( + title = paste("Deviation standardized for ", x$var2, " versus ", x$var1, sep = ""), + x = x$var2, + y = "" + ) + } + + if ("row_perc" %in% check) { + plot_list[["row_perc"]] <- as.data.frame(x$cst$observed, check.names = FALSE, stringsAsFactors = FALSE) %>% + group_by_at(.vars = "Var1") %>% + mutate(perc = Freq / sum(Freq)) %>% + ggplot(aes(x = .data$Var2, y = .data$perc, fill = .data$Var1)) + + geom_bar(stat = "identity", position = "dodge", alpha = 0.5) + + scale_y_continuous(labels = scales::percent) + + labs( + title = "Row percentages", + y = "Percentage", + x = x$var2, + fill = x$var1 + ) + } + + if ("col_perc" %in% check) { + plot_list[["col_perc"]] <- as.data.frame(x$cst$observed, check.names = FALSE, stringsAsFactors = FALSE) %>% + group_by_at(.vars = "Var2") %>% + mutate(perc = Freq / sum(Freq)) %>% + ggplot(aes(x = .data$Var2, y = .data$perc, fill = .data$Var1)) + + geom_bar(stat = "identity", position = "dodge", alpha = 0.5) + + scale_y_continuous(labels = scales::percent) + + labs( + title = "Column percentages", + y = "Percentage", + x = x$var2, + fill = x$var1 + ) + } + + if ("perc" %in% check) { + plot_list[["perc"]] <- as.data.frame(x$cst$observed, check.names = FALSE, stringsAsFactors = FALSE) %>% + mutate(perc = Freq / sum(Freq)) %>% + ggplot(aes(x = .data$Var2, y = .data$perc, fill = .data$Var1)) + + geom_bar(stat = "identity", position = "dodge", alpha = 0.5) + + scale_y_continuous(labels = scales::percent) + + labs( + title = "Table percentages", + y = "Percentage", + x = x$var2, + fill = x$var1 + ) + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = 1) %>% + (function(x) if (isTRUE(shiny)) x else print(x)) + } + } +} diff --git a/radiant.basics/R/goodness.R b/radiant.basics/R/goodness.R new file mode 100644 index 0000000000000000000000000000000000000000..5ecf668c1f035cea8ba72e045bc38662077a78ee --- /dev/null +++ b/radiant.basics/R/goodness.R @@ -0,0 +1,276 @@ +#' Evaluate if sample data for a categorical variable is consistent with a hypothesized distribution +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/goodness.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param var A categorical variable +#' @param p Hypothesized distribution as a number, fraction, or numeric vector. If unspecified, defaults to an even distribution +#' @param tab Table with frequencies as alternative to dataset +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param envir Environment to extract data from +#' +#' @return A list of all variables used in goodness as an object of class goodness +#' +#' @examples +#' goodness(newspaper, "Income") %>% str() +#' goodness(newspaper, "Income", p = c(3 / 4, 1 / 4)) %>% str() +#' table(select(newspaper, Income)) %>% goodness(tab = .) +#' +#' @seealso \code{\link{summary.goodness}} to summarize results +#' @seealso \code{\link{plot.goodness}} to plot results +#' +#' @export +goodness <- function(dataset, var, p = NULL, tab = NULL, + data_filter = "", envir = parent.frame()) { + if (is.table(tab)) { + df_name <- deparse(substitute(tab)) + if (missing(var)) var <- "variable" + } else { + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, var, filt = data_filter, envir = envir) + + ## creating and cleaning up the table + tab <- table(dataset[[var]]) + tab[is.na(tab)] <- 0 + tab <- as.table(tab) + } + ## dataset not needed in summary or plot + rm(dataset) + + if (is.empty(p)) { + p <- rep(1 / length(tab), length(tab)) + } else if (is.numeric(p)) { + if (length(p) == 1) p <- rep(p, length(tab)) + } else if (is.character(p)) { + p <- gsub(",", " ", p) %>% + strsplit("\\s+") %>% + unlist() %>% + strsplit("/") + asNum <- function(x) ifelse(length(x) > 1, as.numeric(x[1]) / as.numeric(x[2]), as.numeric(x[1])) + p <- sshhr(sapply(p, asNum)) + + if (anyNA(p)) { + return(paste0("Invalid inputs: ", paste0(p, collapse = ", ")) %>% add_class("goodness")) + } + + lp <- length(p) + lt <- length(tab) + if (lt != lp && lt %% lp == 0) p <- rep(p, lt / lp) + } + + if (!is.numeric(p) || sum(p) != 1) { + return( + paste0("Probabilities do not sum to 1 (", round(sum(p), 3), ")\nUse fractions if appropriate. Variable ", var, " has ", length(tab), " unique values.") %>% + add_class("goodness") + ) + } + + cst <- sshhr(chisq.test(tab, p = p, correct = FALSE)) + + ## adding the chi-sq table + cst$chi_sq <- with(cst, (observed - expected)^2 / expected) + + res <- tidy(cst) %>% + mutate(parameter = as.integer(parameter)) + elow <- sum(cst$expected < 5) + + if (elow > 0) { + res$p.value <- chisq.test(cst$observed, simulate.p.value = TRUE, B = 2000) %>% + tidy() %>% + .$p.value + res$parameter <- paste0("*", res$parameter, "*") + } + + rm(envir) + + as.list(environment()) %>% add_class("goodness") +} + +#' Summary method for the goodness function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/goodness} for an example in Radiant +#' +#' @param object Return value from \code{\link{goodness}} +#' @param check Show table(s) for the selected variable (var). "observed" for the observed frequencies table, "expected" for the expected frequencies table (i.e., frequencies that would be expected if the null hypothesis holds), "chi_sq" for the contribution to the overall chi-squared statistic for each cell (i.e., (o - e)^2 / e), "dev_std" for the standardized differences between the observed and expected frequencies (i.e., (o - e) / sqrt(e)), and "dev_perc" for the percentage difference between the observed and expected frequencies (i.e., (o - e) / e) +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods. +#' +#' @examples +#' result <- goodness(newspaper, "Income", c(.3, .7)) +#' summary(result, check = c("observed", "expected", "chi_sq")) +#' goodness(newspaper, "Income", c(1 / 3, 2 / 3)) %>% summary("observed") +#' +#' @seealso \code{\link{goodness}} to calculate results +#' @seealso \code{\link{plot.goodness}} to plot results +#' +#' @export +summary.goodness <- function(object, check = "", dec = 2, ...) { + if (is.character(object)) { + return(object) + } + + cat("Goodness of fit test\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + if (length(object$var) > 0) { + cat("Variable :", object$var, "\n") + } + cat("Specified:", object$p, "\n") + cat("Null hyp.: the distribution of", object$var, "is consistent with the specified distribution\n") + cat("Alt. hyp.: the distribution of", object$var, "is not consistent with the specified distribution\n") + + if ("observed" %in% check) { + cat("\nObserved:\n") + object$cst$observed %>% + (function(x) { + x["Total"] <- sum(x) + x + }) %>% + format(big.mark = ",", scientific = FALSE) %>% + print(quote = FALSE) + } + + if ("expected" %in% check) { + cat("\nExpected: total x p\n") + object$cst$expected %>% + (function(x) { + x["Total"] <- sum(x) + return(x) + }) %>% + round(dec) %>% + format(big.mark = ",", scientific = FALSE) %>% + print(quote = FALSE) + } + + if ("chi_sq" %in% check) { + cat("\nContribution to chi-squared: (o - e)^2 / e\n") + object$cst$chi_sq %>% + (function(x) { + x["Total"] <- sum(x) + return(x) + }) %>% + round(dec) %>% + format(big.mark = ",", scientific = FALSE) %>% + print(quote = FALSE) + } + + if ("dev_std" %in% check) { + cat("\nDeviation standardized: (o - e) / sqrt(e)\n") + print(round(object$cst$residuals, dec)) + } + + object$res <- format_df(object$res, dec = dec + 1, mark = ",") + + if (object$res$p.value < .001) object$res$p.value <- "< .001" + cat(paste0("\nChi-squared: ", object$res$statistic, " df(", object$res$parameter, "), p.value ", object$res$p.value), "\n\n") + cat(paste(sprintf("%.1f", 100 * (object$elow / length(object$cst$expected))), "% of cells have expected values below 5\n"), sep = "") + if (object$elow > 0) cat("p.value for chi-squared statistics obtained using simulation (2,000 replicates)") +} + +#' Plot method for the goodness function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/goodness} for an example in Radiant +#' +#' @param x Return value from \code{\link{goodness}} +#' @param check Show plots for variable var. "observed" for the observed frequencies table, "expected" for the expected frequencies table (i.e., frequencies that would be expected if the null hypothesis holds), "chi_sq" for the contribution to the overall chi-squared statistic for each cell (i.e., (o - e)^2 / e), and "dev_std" for the standardized differences between the observed and expected frequencies (i.e., (o - e) / sqrt(e)) +#' @param fillcol Color used for bar plots +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- goodness(newspaper, "Income") +#' plot(result, check = c("observed", "expected", "chi_sq")) +#' goodness(newspaper, "Income") %>% plot(c("observed", "expected")) +#' +#' @seealso \code{\link{goodness}} to calculate results +#' @seealso \code{\link{summary.goodness}} to summarize results +#' +#' @importFrom rlang .data +#' +#' @export +plot.goodness <- function(x, check = "", fillcol = "blue", + shiny = FALSE, custom = FALSE, ...) { + if (is.character(x)) { + return(x) + } + plot_list <- list() + if (is.empty(check)) check <- "observed" + + if ("observed" %in% check) { + fact_names <- names(x$cst$observed) + tab <- as.data.frame(x$cst$observed, check.names = FALSE, stringsAsFactors = FALSE) + colnames(tab)[1] <- x$var + tab[[1]] %<>% factor(levels = fact_names) + tab[["Freq"]] %<>% { + . / sum(.) + } + plot_list[["observed"]] <- + ggplot(tab, aes(x = .data[[x$var]], y = .data$Freq)) + + geom_bar(stat = "identity", alpha = 0.5, fill = fillcol) + + scale_y_continuous(labels = scales::percent) + + labs( + title = paste("Observed frequencies for", x$var), + x = x$var, + y = "" + ) + } + + if ("expected" %in% check) { + fact_names <- names(x$cst$expected) + tab <- as.data.frame(x$cst$expected, check.names = FALSE, stringsAsFactors = FALSE) + colnames(tab)[1] <- "Freq" + tab[[x$var]] <- factor(rownames(tab), levels = rownames(tab)) + tab[["Freq"]] %<>% (function(x) x / sum(x)) + plot_list[["expected"]] <- + ggplot(tab, aes(x = .data[[x$var]], y = .data$Freq)) + + geom_bar(stat = "identity", alpha = 0.5, fill = fillcol) + + scale_y_continuous(labels = scales::percent) + + labs( + title = paste("Expected frequencies for", x$var), + x = x$var, + y = "" + ) + } + + if ("chi_sq" %in% check) { + tab <- as.data.frame(x$cst$chi_sq, check.names = FALSE, stringsAsFactors = FALSE) + colnames(tab)[1] <- x$var + plot_list[["chi_sq"]] <- + ggplot(tab, aes(x = .data[[x$var]], y = .data$Freq)) + + geom_bar(stat = "identity", alpha = 0.5, fill = fillcol) + + labs( + title = paste("Contribtion to chi-squared for", x$var), + x = x$var, + y = "" + ) + } + + if ("dev_std" %in% check) { + tab <- as.data.frame(x$cst$residuals, check.names = FALSE, stringsAsFactors = FALSE) + mult <- max(abs(tab$Freq)) / 5 + colnames(tab)[1] <- x$var + plot_list[["dev_std"]] <- + ggplot(tab, aes(x = .data[[x$var]], y = .data$Freq)) + + geom_bar(stat = "identity", position = "dodge", alpha = 0.5, fill = fillcol) + + geom_hline(yintercept = c(-1.96, 1.96, -1.64, 1.64), color = "black", linetype = "longdash", linewidth = .5) + + geom_text(x = 1, y = 2.11, label = "95%", vjust = 0) + + geom_text(x = 1, y = 1.49, label = "90%", vjust = 1) + + labs( + title = paste("Deviation standardized for", x$var), + x = x$var, + y = "" + ) + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = 1) %>% + (function(x) if (shiny) x else print(x)) + } + } +} diff --git a/radiant.basics/R/homo_variance_test.R b/radiant.basics/R/homo_variance_test.R new file mode 100644 index 0000000000000000000000000000000000000000..30a8aa7d04ac6f67dcf9ca4b3cd7b496b2d4af17 --- /dev/null +++ b/radiant.basics/R/homo_variance_test.R @@ -0,0 +1,86 @@ +############################################ +## Homogeneity of variance test - 空壳版（照抄 single_mean） +############################################ + +# Homogeneity of variance tests for radiant.basics +#' @export +homo_variance_test <- function(dataset, var, group, method = "levene", + conf_lev = .95, data_filter = "", + envir = parent.frame()) { + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, var, group, filt = data_filter, na.rm = TRUE, envir = envir) + x <- dataset[[var]] + g <- dataset[[group]] + if (!is.numeric(x)) stop(i18n$t("Variable must be numeric")) + if (length(unique(g)) < 2) stop(i18n$t("Grouping variable must have at least 2 levels")) + + ## ---- 空壳结果 ---- + res <- tibble::tribble( + ~Test, ~Statistic, ~p.value, + "Levene", 0.42, 0.52, + "Bartlett", 0.38, 0.54, + "Fligner", 0.45, 0.50 + ) + + dat_summary <- dataset %>% + group_by(!!sym(group)) %>% + summarise( + n = n(), + mean = mean(!!sym(var), na.rm = TRUE), + sd = sd(!!sym(var), na.rm = TRUE), + .groups = "drop" + ) + + ## 绘图数据 + plot_obj <- list(hist = list(type = "hist", data = dataset, var = var, group = group), + density = list(type = "density", data = dataset, var = var, group = group), + boxplot = list(type = "boxplot", data = dataset, var = var, group = group)) + + as.list(environment()) %>% add_class("homo_variance_test") +} + +# Summary method +#' @export +summary.homo_variance_test <- function(object, dec = 3, ...) { + cat("Homogeneity of variance tests\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + cat("Variable :", object$var, "\n") + cat("Group :", object$group, "\n\n") + + ## 打印统计量表 + object$res %>% + as.data.frame(stringsAsFactors = FALSE) %>% + format_df(dec = dec) %>% + print(row.names = FALSE) + cat("\n") +} + +# Plot method +#' @export +plot.homo_variance_test <- function(x, plots = c("boxplot", "density"), + shiny = FALSE, custom = FALSE, ...) { + plot_list <- list() + if ("boxplot" %in% plots) { + plot_list[[which("boxplot" == plots)]] <- + ggplot(x$dat_summary, aes(x = .data[[x$group]], y = .data[[x$var]])) + + geom_boxplot(fill = "lightblue", alpha = 0.7) + } + if ("density" %in% plots) { + plot_list[[which("density" == plots)]] <- + ggplot(x$dat_summary, aes(x = .data[[x$var]], fill = .data[[x$group]])) + + geom_density(alpha = 0.5) + } + if ("hist" %in% plots) { + plot_list[[which("hist" == plots)]] <- + ggplot(x$dat_summary, aes(x = .data[[x$var]], fill = .data[[x$group]])) + + geom_histogram(alpha = 0.5, position = "identity", bins = 30) + } + + if (length(plot_list) == 0) return(invisible()) + patchwork::wrap_plots(plot_list, ncol = 1) %>% + { if (shiny) print(.) else print(.) } + invisible(x) +} \ No newline at end of file diff --git a/radiant.basics/R/normality_test.R b/radiant.basics/R/normality_test.R new file mode 100644 index 0000000000000000000000000000000000000000..be9e11f37d3dee0e1f5802b52dc1e3c50533d939 --- /dev/null +++ b/radiant.basics/R/normality_test.R @@ -0,0 +1,86 @@ +############################################ +## Normality test +############################################ + +# Batch normality tests for radiant.basics +# +#' @export +normality_test <- function(dataset, var, method = "shapiro", + conf_lev = .95, data_filter = "", + envir = parent.frame()) { + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, var, filt = data_filter, na.rm = TRUE, envir = envir) + x <- dataset[[var]] + if (!is.numeric(x)) stop(i18n$t("Variable must be numeric")) + + ## ---- 空壳结果 ---- + res <- tibble::tribble( + ~Test, ~Statistic, ~p.value, + "Shapiro-Wilk", 0.99, 0.12, + "Kolmogorov-Smirnov", 0.05, 0.30, + "Anderson-Darling", 0.80, 0.25 + ) + + dat_summary <- tibble::tribble( + ~mean, ~n, ~n_missing, ~sd, ~se, + mean(x, na.rm = TRUE), length(x), sum(is.na(x)), sd(x, na.rm = TRUE), sd(x, na.rm = TRUE)/sqrt(length(x)) + ) + + ## 绘图数据 + plot_obj <- list(qq = list(type = "qq", data = x), + hist = list(type = "hist", data = x), + pp = list(type = "pp", data = x), + density = list(type = "density", data = x)) + + as.list(environment()) %>% add_class("normality_test") +} + +# Summary method +#' @export +summary.normality_test <- function(object, dec = 3, ...) { + cat("Normality tests\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + cat("Variable :", object$var, "\n\n") + + ## 打印统计量表 + object$res %>% + as.data.frame(stringsAsFactors = FALSE) %>% + format_df(dec = dec) %>% + print(row.names = FALSE) + cat("\n") +} + +# Plot method +#' @export +plot.normality_test <- function(x, plots = c("qq", "hist"), + shiny = FALSE, custom = FALSE, ...) { + plot_list <- list() + if ("qq" %in% plots) { + plot_list[[which("qq" == plots)]] <- + ggplot(data.frame(y = x$x), aes(sample = y)) + + stat_qq() + stat_qq_line() + } + if ("hist" %in% plots) { + plot_list[[which("hist" == plots)]] <- + ggplot(data.frame(y = x$x), aes(y)) + + geom_histogram(fill = "blue", bins = 30) + } + if ("pp" %in% plots) { + plot_list[[which("pp" == plots)]] <- + ggplot(data.frame(y = x$x), aes(sample = y)) + + stat_pp_band() + stat_pp_line() + stat_pp_point() + } + if ("density" %in% plots) { + plot_list[[which("density" == plots)]] <- + ggplot(data.frame(y = x$x), aes(y)) + + geom_density(fill = "blue", alpha = 0.5) + } + + if (length(plot_list) == 0) return(invisible()) + patchwork::wrap_plots(plot_list, ncol = 1) %>% + { if (shiny) print(.) else print(.) } + invisible(x) +} \ No newline at end of file diff --git a/radiant.basics/R/prob_calc.R b/radiant.basics/R/prob_calc.R new file mode 100644 index 0000000000000000000000000000000000000000..27ffc8c26d89f4af091035fc786a448ff775b39b --- /dev/null +++ b/radiant.basics/R/prob_calc.R @@ -0,0 +1,2463 @@ +#' Probability calculator for the normal distribution +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param mean Mean +#' @param stdev Standard deviation +#' @param lb Lower bound (default is -Inf) +#' @param ub Upper bound (default is Inf) +#' @param plb Lower probability bound +#' @param pub Upper probability bound +#' @param dec Number of decimals to show +#' +#' @examples +#' prob_norm(mean = 0, stdev = 1, ub = 0) +#' +#' @seealso \code{\link{summary.prob_norm}} to summarize results +#' @seealso \code{\link{plot.prob_norm}} to plot results +#' +#' @export +prob_norm <- function(mean, stdev, lb = NA, ub = NA, + plb = NA, pub = NA, dec = 3) { + p_ub <- pnorm(ub, mean, stdev) + p_lb <- pnorm(lb, mean, stdev) + p_int <- max(p_ub - p_lb, 0) %>% round(dec) + + p_ub %<>% round(dec) + p_lb %<>% round(dec) + + if (!is.na(pub)) { + if (pub > 1) pub <- 1 + if (pub < 0) pub <- 0 + } + + if (!is.na(plb)) { + if (plb > 1) plb <- 1 + if (plb < 0) plb <- 0 + } + + v_ub <- qnorm(pub, mean, stdev) %>% round(dec) + v_lb <- qnorm(plb, mean, stdev) %>% round(dec) + + if (!is.na(lb) && !is.na(ub)) { + if (lb > ub) { + lb <- ub <- NA + mess_values <- "\nPlease ensure the lower bound is smaller than the upper bound" + } + } + + if (!is.na(plb) && !is.na(pub)) { + if (plb > pub) { + plb <- pub <- NA + mess_probs <- "\nPlease ensure the lower bound is smaller than the upper bound" + } + } + + as.list(environment()) %>% add_class("prob_norm") +} + +#' Plot method for the probability calculator (normal) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{prob_norm}} +#' @param type Probabilities ("probs") or values ("values") +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- prob_norm(mean = 0, stdev = 1, ub = 0) +#' plot(result) +#' +#' @seealso \code{\link{prob_norm}} to calculate results +#' @seealso \code{\link{summary.prob_norm}} to summarize results +#' +#' @importFrom rlang .data +#' +#' @export +plot.prob_norm <- function(x, type = "values", ...) { + mess <- paste0("mess_", type) + if (!is.null(x[[mess]])) { + return(" ") + } + + if (type == "values") { + lb <- x$lb + ub <- x$ub + } else { + lb <- x$v_lb + ub <- x$v_ub + } + + mean <- x$mean + stdev <- x$stdev + + limits <- c(mean - 3 * stdev, mean + 3 * stdev) + + dnorm_limit <- function(x) { + y <- dnorm(x, mean = mean, sd = stdev) + y[x < lb | x > ub] <- 0 + y + } + + dnorm_lb <- function(x) { + if (is.na(lb)) { + return(0) + } + y <- dnorm(x, mean = mean, sd = stdev) + y[x > lb] <- 0 + y + } + + dnorm_ub <- function(x) { + if (is.na(ub)) { + return(0) + } + y <- dnorm(x, mean = mean, sd = stdev) + y[x < ub] <- 0 + y + } + + dnorm_lines <- c(ub, lb) %>% na.omit() + if (length(dnorm_lines) == 0) dnorm_lines <- c(-Inf, Inf) + + ## based on https://rstudio-pubs-static.s3.amazonaws.com/58753_13e35d9c089d4f55b176057235778679.html + ## and R Graphics Cookbook + plt <- ggplot(data.frame(x = limits), aes(x = .data$x)) + + stat_function(fun = stats::dnorm, args = list(mean = mean, sd = stdev)) + + stat_function(fun = dnorm_limit, geom = "area", fill = "blue", alpha = 0.5, n = 501) + + stat_function(fun = dnorm_lb, geom = "area", fill = "red", alpha = 0.5, n = 501) + + stat_function(fun = dnorm_ub, geom = "area", fill = "red", alpha = 0.5, n = 501) + + geom_vline(xintercept = dnorm_lines, color = "black", linetype = "dashed", linewidth = .5) + + labs(x = "", y = "") + + sshhr(plt) +} + +#' Summary method for the probability calculator (normal) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{prob_norm}} +#' @param type Probabilities ("probs") or values ("values") +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- prob_norm(mean = 0, stdev = 1, ub = 0) +#' summary(result) +#' +#' @seealso \code{\link{prob_norm}} to calculate results +#' @seealso \code{\link{plot.prob_norm}} to plot results +#' +#' @export +summary.prob_norm <- function(object, type = "values", ...) { + cat("Probability calculator\n") + cat("Distribution: Normal\n") + + mess <- object[[paste0("mess_", type)]] + if (!is.null(mess)) { + return(mess) + } + env <- environment() + ret <- sapply(names(object), function(x) assign(x, object[[x]], envir = env)) + + cat("Mean :", round(mean, dec), "\n") + cat("St. dev :", round(stdev, dec), "\n") + + if (type == "values") { + cat("Lower bound :", if (is.na(lb)) "-Inf" else lb, "\n") + cat("Upper bound :", if (is.na(ub)) "Inf" else ub, "\n") + + if (!is.na(ub) || !is.na(lb)) { + cat("\n") + + if (!is.na(lb)) { + cat(paste0("P(X < ", lb, ") = ", p_lb, "\n")) + cat(paste0("P(X > ", lb, ") = ", round(1 - p_lb, dec), "\n")) + } + + if (!is.na(ub)) { + cat(paste0("P(X < ", ub, ") = ", p_ub, "\n")) + cat(paste0("P(X > ", ub, ") = ", round(1 - p_ub, dec), "\n")) + } + + if (!is.na(lb) && !is.na(ub)) { + cat(paste0("P(", lb, " < X < ", ub, ") = ", p_int, "\n")) + cat(paste0("1 - P(", lb, " < X < ", ub, ") = ", round(1 - p_int, dec), "\n")) + } + } + } else { + pub <- if (is.na(pub)) 2 else pub + plb <- if (is.na(plb)) -1 else plb + + cat("Lower bound :", if (plb < 0) "0" else plb, "\n") + cat("Upper bound :", if (pub > 1) "1" else pub, "\n") + + if (pub <= 1 || plb >= 0) { + cat("\n") + + if (plb >= 0) { + cat(paste0("P(X < ", v_lb, ") = ", plb, "\n")) + cat(paste0("P(X > ", v_lb, ") = ", round(1 - plb, dec), "\n")) + } + + if (pub <= 1) { + cat(paste0("P(X < ", v_ub, ") = ", pub, "\n")) + cat(paste0("P(X > ", v_ub, ") = ", round(1 - pub, dec), "\n")) + } + + if (pub <= 1 && plb >= 0) { + cat(paste0("P(", v_lb, " < X < ", v_ub, ") = ", pub - plb, "\n")) + cat(paste0("1 - P(", v_lb, " < X < ", v_ub, ") = ", round(1 - (pub - plb), dec), "\n")) + } + } + } +} + +#' Probability calculator for the log normal distribution +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param meanlog Mean of the distribution on the log scale +#' @param sdlog Standard deviation of the distribution on the log scale +#' @param lb Lower bound (default is -Inf) +#' @param ub Upper bound (default is Inf) +#' @param plb Lower probability bound +#' @param pub Upper probability bound +#' @param dec Number of decimals to show +#' +#' @seealso \code{\link{summary.prob_lnorm}} to summarize results +#' @seealso \code{\link{plot.prob_lnorm}} to plot results +#' +#' @examples +#' prob_lnorm(meanlog = 0, sdlog = 1, lb = 0, ub = 1) +#' +#' @export +prob_lnorm <- function(meanlog, sdlog, lb = NA, ub = NA, + plb = NA, pub = NA, dec = 3) { + p_ub <- plnorm(ub, meanlog, sdlog) + p_lb <- plnorm(lb, meanlog, sdlog) + p_int <- max(p_ub - p_lb, 0) %>% round(dec) + + p_ub %<>% round(dec) + p_lb %<>% round(dec) + + if (!is.na(pub)) { + if (pub > 1) pub <- 1 + if (pub < 0) pub <- 0 + } + + if (!is.na(plb)) { + if (plb > 1) plb <- 1 + if (plb < 0) plb <- 0 + } + + v_ub <- qlnorm(pub, meanlog, sdlog) %>% round(dec) + v_lb <- qlnorm(plb, meanlog, sdlog) %>% round(dec) + + if (!is.na(lb) && !is.na(ub)) { + if (lb > ub) { + lb <- ub <- NA + mess_values <- "\nPlease ensure the lower bound is smaller than the upper bound" + } + } + + if (!is.na(plb) && !is.na(pub)) { + if (plb > pub) { + plb <- pub <- NA + mess_probs <- "\nPlease ensure the lower bound is smaller than the upper bound" + } + } + + as.list(environment()) %>% add_class("prob_lnorm") +} + +#' Plot method for the probability calculator (log normal) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{prob_norm}} +#' @param type Probabilities ("probs") or values ("values") +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{prob_lnorm}} to calculate results +#' @seealso \code{\link{plot.prob_lnorm}} to plot results +#' +#' @examples +#' result <- prob_lnorm(meanlog = 0, sdlog = 1, lb = 0, ub = 1) +#' plot(result, type = "values") +#' +#' @importFrom rlang .data +#' +#' @export +plot.prob_lnorm <- function(x, type = "values", ...) { + mess <- paste0("mess_", type) + if (!is.null(x[[mess]])) { + return(" ") + } + + if (type == "values") { + lb <- x$lb + ub <- x$ub + } else { + lb <- x$v_lb + ub <- x$v_ub + } + + meanlog <- x$meanlog + sdlog <- x$sdlog + + # limits <- c(meanlog - 3 * sdlog, meanlog + 3 * sdlog) + limits <- c(0, meanlog + ub * sdlog) + + dlnorm_limit <- function(x) { + y <- dlnorm(x, meanlog = meanlog, sdlog = sdlog) + y[x < lb | x > ub] <- 0 + y + } + + dlnorm_lb <- function(x) { + if (is.na(lb)) { + return(0) + } + y <- dlnorm(x, meanlog = meanlog, sdlog = sdlog) + y[x > lb] <- 0 + y + } + + dlnorm_ub <- function(x) { + if (is.na(ub)) { + return(0) + } + y <- dlnorm(x, meanlog = meanlog, sdlog = sdlog) + y[x < ub] <- 0 + y + } + + dlnorm_lines <- c(ub, lb) %>% na.omit() + if (length(dlnorm_lines) == 0) dlnorm_lines <- c(-Inf, Inf) + + ## based on https://rstudio-pubs-static.s3.amazonaws.com/58753_13e35d9c089d4f55b176057235778679.html + ## and R Graphics Cookbook + plt <- ggplot(data.frame(x = limits), aes(x = .data$x)) + + stat_function(fun = stats::dlnorm, args = list(meanlog = meanlog, sdlog = sdlog)) + + stat_function(fun = dlnorm_limit, geom = "area", fill = "blue", alpha = 0.5, n = 501) + + stat_function(fun = dlnorm_lb, geom = "area", fill = "red", alpha = 0.5, n = 501) + + stat_function(fun = dlnorm_ub, geom = "area", fill = "red", alpha = 0.5, n = 501) + + geom_vline(xintercept = dlnorm_lines, color = "black", linetype = "dashed", linewidth = .5) + + labs(x = "", y = "") + + sshhr(plt) +} + +#' Summary method for the probability calculator (log normal) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{prob_norm}} +#' @param type Probabilities ("probs") or values ("values") +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{prob_lnorm}} to calculate results +#' @seealso \code{\link{plot.prob_lnorm}} to summarize results +#' +#' @examples +#' result <- prob_lnorm(meanlog = 0, sdlog = 1, lb = 0, ub = 1) +#' summary(result, type = "values") +#' +#' @export +summary.prob_lnorm <- function(object, type = "values", ...) { + cat("Probability calculator\n") + cat("Distribution: Log normal\n") + + mess <- object[[paste0("mess_", type)]] + if (!is.null(mess)) { + return(mess) + } + env <- environment() + ret <- sapply(names(object), function(x) assign(x, object[[x]], envir = env)) + + cat("Mean log :", round(meanlog, dec), "\n") + cat("St. dev log :", round(sdlog, dec), "\n") + + if (type == "values") { + cat("Lower bound :", if (is.na(lb)) "-Inf" else lb, "\n") + cat("Upper bound :", if (is.na(ub)) "Inf" else ub, "\n") + + if (!is.na(ub) || !is.na(lb)) { + cat("\n") + + if (!is.na(lb)) { + cat(paste0("P(X < ", lb, ") = ", p_lb, "\n")) + cat(paste0("P(X > ", lb, ") = ", round(1 - p_lb, dec), "\n")) + } + + if (!is.na(ub)) { + cat(paste0("P(X < ", ub, ") = ", p_ub, "\n")) + cat(paste0("P(X > ", ub, ") = ", round(1 - p_ub, dec), "\n")) + } + + if (!is.na(lb) && !is.na(ub)) { + cat(paste0("P(", lb, " < X < ", ub, ") = ", p_int, "\n")) + cat(paste0("1 - P(", lb, " < X < ", ub, ") = ", round(1 - p_int, dec), "\n")) + } + } + } else { + pub <- if (is.na(pub)) 2 else pub + plb <- if (is.na(plb)) -1 else plb + + cat(paste0("Lower bound : ", if (plb < 0) "0" else plb, " (", v_lb, ")\n")) + cat(paste0("Upper bound : ", if (pub > 1) "1" else pub, " (", v_ub, ")\n")) + + if (pub <= 1 || plb >= 0) { + cat("\n") + + if (plb >= 0) { + cat(paste0("P(X < ", v_lb, ") = ", plb, "\n")) + cat(paste0("P(X > ", v_lb, ") = ", round(1 - plb, dec), "\n")) + } + + if (pub <= 1) { + cat(paste0("P(X < ", v_ub, ") = ", pub, "\n")) + cat(paste0("P(X > ", v_ub, ") = ", round(1 - pub, dec), "\n")) + } + + if (pub <= 1 && plb >= 0) { + cat(paste0("P(", v_lb, " < X < ", v_ub, ") = ", pub - plb, "\n")) + cat(paste0("1 - P(", v_lb, " < X < ", v_ub, ") = ", round(1 - (pub - plb), dec), "\n")) + } + } + } +} + +#' Probability calculator for the t-distribution +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param df Degrees of freedom +#' @param lb Lower bound (default is -Inf) +#' @param ub Upper bound (default is Inf) +#' @param plb Lower probability bound +#' @param pub Upper probability bound +#' @param dec Number of decimals to show +#' +#' @seealso \code{\link{summary.prob_tdist}} to summarize results +#' @seealso \code{\link{plot.prob_tdist}} to plot results +#' +#' @examples +#' prob_tdist(df = 10, ub = 2.228) +#' +#' @export +prob_tdist <- function(df, lb = NA, ub = NA, + plb = NA, pub = NA, dec = 3) { + p_ub <- pt(ub, df) + p_lb <- pt(lb, df) + p_int <- max(p_ub - p_lb, 0) + + p_ub %<>% round(dec) + p_lb %<>% round(dec) + p_int %<>% round(dec) + + if (!is.na(pub)) { + if (pub > 1) pub <- 1 + if (pub < 0) pub <- 0 + } + + if (!is.na(plb)) { + if (plb > 1) plb <- 1 + if (plb < 0) plb <- 0 + } + + v_ub <- qt(pub, df) + v_lb <- qt(plb, df) + + v_ub %<>% round(dec) + v_lb %<>% round(dec) + + if (!is.na(lb) && !is.na(ub)) { + if (lb > ub) { + lb <- ub <- NA + mess_values <- "\nPlease ensure the lower bound is smaller than the upper bound" + } + } + + if (!is.na(plb) && !is.na(pub)) { + if (plb > pub) { + plb <- pub <- NA + mess_probs <- "\nPlease ensure the lower bound is smaller than the upper bound" + } + } + + as.list(environment()) %>% add_class("prob_tdist") +} + +#' Plot method for the probability calculator (t-distribution) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{prob_tdist}} +#' @param type Probabilities ("probs") or values ("values") +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{prob_tdist}} to calculate results +#' @seealso \code{\link{summary.prob_tdist}} to summarize results +#' +#' @examples +#' result <- prob_tdist(df = 10, ub = 2.228) +#' plot(result, type = "values") +#' +#' @importFrom rlang .data +#' +#' @export +plot.prob_tdist <- function(x, type = "values", ...) { + mess <- paste0("mess_", type) + if (!is.null(x[[mess]])) { + return(" ") + } + if (type == "values") { + lb <- x$lb + ub <- x$ub + } else { + lb <- x$v_lb + ub <- x$v_ub + } + + df <- x$df + + limits <- c(-3, 3) + dt_limit <- function(x) { + y <- dt(x, df = df) + y[x < lb | x > ub] <- 0 + y + } + + dt_lb <- function(x) { + if (is.na(lb)) { + return(0) + } + y <- dt(x, df = df) + y[x > lb] <- 0 + y + } + + dt_ub <- function(x) { + if (is.na(ub)) { + return(0) + } + y <- dt(x, df = df) + y[x < ub] <- 0 + y + } + + dt_lines <- c(ub, lb) %>% na.omit() + if (length(dt_lines) == 0) dt_lines <- c(-Inf, Inf) + + ## based on https://rstudio-pubs-static.s3.amazonaws.com/58753_13e35d9c089d4f55b176057235778679.html + ## and R Graphics Cookbook + plt <- ggplot(data.frame(x = limits), aes(x = .data$x)) + + stat_function(fun = stats::dt, args = list(df = df)) + + stat_function(fun = dt_limit, geom = "area", fill = "blue", alpha = 0.5, n = 501) + + stat_function(fun = dt_lb, geom = "area", fill = "red", alpha = 0.5, n = 501) + + stat_function(fun = dt_ub, geom = "area", fill = "red", alpha = 0.5, n = 501) + + geom_vline(xintercept = dt_lines, color = "black", linetype = "dashed", linewidth = .5) + + labs(x = "", y = "") + + sshhr(plt) +} + +#' Summary method for the probability calculator (t-distribution) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{prob_tdist}} +#' @param type Probabilities ("probs") or values ("values") +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{prob_tdist}} to calculate results +#' @seealso \code{\link{plot.prob_tdist}} to plot results +#' +#' @examples +#' result <- prob_tdist(df = 10, ub = 2.228) +#' summary(result, type = "values") +#' +#' @export +summary.prob_tdist <- function(object, type = "values", ...) { + cat("Probability calculator\n") + cat("Distribution: t\n") + + mess <- object[[paste0("mess_", type)]] + if (!is.null(mess)) { + return(mess) + } + + env <- environment() + ret <- sapply(names(object), function(x) assign(x, object[[x]], envir = env)) + n <- df + 1 + cat("Df :", df, "\n") + cat("Mean :", 0, "\n") + cat("St. dev :", ifelse(n > 2, round(n / (n - 2), dec), "NA"), "\n") + + if (type == "values") { + cat("Lower bound :", if (is.na(lb)) "-Inf" else lb, "\n") + cat("Upper bound :", if (is.na(ub)) "Inf" else ub, "\n") + + if (!is.na(ub) || !is.na(lb)) { + cat("\n") + + if (!is.na(lb)) { + cat(paste0("P(X < ", lb, ") = ", p_lb, "\n")) + cat(paste0("P(X > ", lb, ") = ", round(1 - p_lb, dec), "\n")) + } + + if (!is.na(ub)) { + cat(paste0("P(X < ", ub, ") = ", p_ub, "\n")) + cat(paste0("P(X > ", ub, ") = ", round(1 - p_ub, dec), "\n")) + } + + if (!is.na(lb) && !is.na(ub)) { + cat(paste0("P(", lb, " < X < ", ub, ") = ", p_int, "\n")) + cat(paste0("1 - P(", lb, " < X < ", ub, ") = ", round(1 - p_int, dec), "\n")) + } + } + } else { + pub <- if (is.na(pub)) 2 else pub + plb <- if (is.na(plb)) -1 else plb + + cat("Lower bound :", if (plb < 0) "0" else plb, "\n") + cat("Upper bound :", if (pub > 1) "1" else pub, "\n") + + if (pub <= 1 || plb >= 0) { + cat("\n") + + if (plb >= 0) { + cat(paste0("P(X < ", v_lb, ") = ", plb, "\n")) + cat(paste0("P(X > ", v_lb, ") = ", round(1 - plb, dec), "\n")) + } + + if (pub <= 1) { + cat(paste0("P(X < ", v_ub, ") = ", pub, "\n")) + cat(paste0("P(X > ", v_ub, ") = ", round(1 - pub, dec), "\n")) + } + + if (pub <= 1 && plb >= 0) { + cat(paste0("P(", v_lb, " < X < ", v_ub, ") = ", pub - plb, "\n")) + cat(paste0("1 - P(", v_lb, " < X < ", v_ub, ") = ", round(1 - (pub - plb), dec), "\n")) + } + } + } +} + +#' Probability calculator for the F-distribution +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param df1 Degrees of freedom +#' @param df2 Degrees of freedom +#' @param lb Lower bound (default is 0) +#' @param ub Upper bound (default is Inf) +#' @param plb Lower probability bound +#' @param pub Upper probability bound +#' @param dec Number of decimals to show +#' +#' @seealso \code{\link{summary.prob_fdist}} to summarize results +#' @seealso \code{\link{plot.prob_fdist}} to plot results +#' +#' @examples +#' prob_fdist(df1 = 10, df2 = 10, ub = 2.978) +#' +#' @export +prob_fdist <- function(df1, df2, lb = NA, ub = NA, + plb = NA, pub = NA, dec = 3) { + if (!is_not(lb) && lb < 0) lb <- 0 + if (!is_not(ub) && ub < 0) ub <- 0 + + p_ub <- pf(ub, df1, df2) + p_lb <- pf(lb, df1, df2) + p_int <- max(p_ub - p_lb, 0) + + p_ub %<>% round(dec) + p_lb %<>% round(dec) + p_int %<>% round(dec) + + if (!is.na(pub)) { + if (pub > 1) pub <- 1 + if (pub < 0) pub <- 0 + } + + if (!is.na(plb)) { + if (plb > 1) plb <- 1 + if (plb < 0) plb <- 0 + } + + v_ub <- qf(pub, df1, df2) + v_lb <- qf(plb, df1, df2) + + v_ub %<>% round(dec) + v_lb %<>% round(dec) + + if (!is.na(lb) && !is.na(ub)) { + if (lb > ub) { + lb <- ub <- NA + mess_values <- "\nPlease ensure the lower bound is smaller than the upper bound" + } + } + + if (!is.na(plb) && !is.na(pub)) { + if (plb > pub) { + plb <- pub <- NA + mess_probs <- "\nPlease ensure the lower bound is smaller than the upper bound" + } + } + + as.list(environment()) %>% add_class("prob_fdist") +} + +#' Plot method for the probability calculator (F-distribution) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{prob_fdist}} +#' @param type Probabilities ("probs") or values ("values") +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{prob_fdist}} to calculate results +#' @seealso \code{\link{summary.prob_fdist}} to summarize results +#' +#' @examples +#' result <- prob_fdist(df1 = 10, df2 = 10, ub = 2.978) +#' plot(result, type = "values") +#' +#' @importFrom rlang .data +#' +#' @export +plot.prob_fdist <- function(x, type = "values", ...) { + mess <- paste0("mess_", type) + if (!is.null(x[[mess]])) { + return(" ") + } + if (type == "values") { + lb <- x$lb + ub <- x$ub + } else { + lb <- x$v_lb + ub <- x$v_ub + } + + df1 <- x$df1 + df2 <- x$df2 + + limits <- c( + floor(qf(0.01, df1 = df1, df2 = df2)), + ceiling(qf(1 - 0.01, df1 = df1, df2 = df2)) + ) + + dat <- data.frame( + x = limits, + Probability = df(limits, df1 = df1, df2 = df2), + df1 = df1, + df2 = df2, + stringsAsFactors = FALSE + ) + + df_line <- function(x) df(x, df1 = df1, df2 = df2) + + df_limit <- function(x) { + y <- df(x, df1 = df1, df2 = df2) + y[x < lb | x > ub] <- 0 + y + } + + df_lb <- function(x) { + if (is.na(lb)) { + return(0) + } + y <- df(x, df1 = df1, df2 = df2) + y[x > lb] <- 0 + y + } + + df_ub <- function(x) { + if (is.na(ub)) { + return(0) + } + y <- df(x, df1 = df1, df2 = df2) + y[x < ub] <- 0 + y + } + + vlines <- c(ub, lb) %>% na.omit() + if (length(vlines) == 0) vlines <- c(-Inf, Inf) + + ## based on https://rstudio-pubs-static.s3.amazonaws.com/58753_13e35d9c089d4f55b176057235778679.html + ## and R Graphics Cookbook + plt <- ggplot(dat, aes(x = .data$x)) + + stat_function(fun = df_line, geom = "line") + + stat_function(fun = df_limit, geom = "area", fill = "blue", alpha = 0.5, n = 501) + + stat_function(fun = df_lb, geom = "area", fill = "red", alpha = 0.5, n = 501) + + stat_function(fun = df_ub, geom = "area", fill = "red", alpha = 0.5, n = 501) + + geom_vline(xintercept = vlines, color = "black", linetype = "dashed", linewidth = 0.5) + + labs(x = "", y = "") + + sshhr(plt) +} + +#' Summary method for the probability calculator (F-distribution) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{prob_fdist}} +#' @param type Probabilities ("probs") or values ("values") +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{prob_fdist}} to calculate results +#' @seealso \code{\link{plot.prob_fdist}} to plot results +#' +#' @examples +#' result <- prob_fdist(df1 = 10, df2 = 10, ub = 2.978) +#' summary(result, type = "values") +#' +#' @export +summary.prob_fdist <- function(object, type = "values", ...) { + cat("Probability calculator\n") + cat("Distribution: F\n") + + mess <- object[[paste0("mess_", type)]] + if (!is.null(mess)) { + return(mess) + } + env <- environment() + ret <- sapply(names(object), function(x) assign(x, object[[x]], envir = env)) + + cat("Df 1 :", df1, "\n") + cat("Df 2 :", df2, "\n") + m <- if (df2 > 2) round(df2 / (df2 - 2), dec) else "NA" + variance <- if (df2 > 4) { + round((2 * df2^2 * (df1 + df2 - 2)) / (df1 * (df2 - 2)^2 * (df2 - 4)), dec) + } else { + "NA" + } + cat("Mean :", m, "\n") + cat("Variance :", variance, "\n") + + if (type == "values") { + cat("Lower bound :", if (is.na(lb)) "0" else lb, "\n") + cat("Upper bound :", if (is.na(ub)) "Inf" else ub, "\n") + + if (!is.na(ub) || !is.na(lb)) { + cat("\n") + + if (!is.na(lb)) { + cat(paste0("P(X < ", lb, ") = ", p_lb, "\n")) + cat(paste0("P(X > ", lb, ") = ", round(1 - p_lb, dec), "\n")) + } + + if (!is.na(ub)) { + cat(paste0("P(X < ", ub, ") = ", p_ub, "\n")) + cat(paste0("P(X > ", ub, ") = ", round(1 - p_ub, dec), "\n")) + } + + if (!is.na(lb) && !is.na(ub)) { + cat(paste0("P(", lb, " < X < ", ub, ") = ", p_int, "\n")) + cat(paste0("1 - P(", lb, " < X < ", ub, ") = ", round(1 - p_int, dec), "\n")) + } + } + } else { + pub <- if (is.na(pub)) 2 else pub + plb <- if (is.na(plb)) -1 else plb + + cat("Lower bound :", if (plb < 0) "0" else plb, "\n") + cat("Upper bound :", if (pub > 1) "1" else pub, "\n") + + if (pub <= 1 || plb >= 0) { + cat("\n") + + if (plb >= 0) { + cat(paste0("P(X < ", v_lb, ") = ", plb, "\n")) + cat(paste0("P(X > ", v_lb, ") = ", round(1 - plb, dec), "\n")) + } + + if (pub <= 1) { + cat(paste0("P(X < ", v_ub, ") = ", pub, "\n")) + cat(paste0("P(X > ", v_ub, ") = ", round(1 - pub, dec), "\n")) + } + + if (pub <= 1 && plb >= 0) { + cat(paste0("P(", v_lb, " < X < ", v_ub, ") = ", pub - plb, "\n")) + cat(paste0("1 - P(", v_lb, " < X < ", v_ub, ") = ", round(1 - (pub - plb), dec), "\n")) + } + } + } +} + +#' Probability calculator for the chi-squared distribution +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param df Degrees of freedom +#' @param lb Lower bound (default is 0) +#' @param ub Upper bound (default is Inf) +#' @param plb Lower probability bound +#' @param pub Upper probability bound +#' @param dec Number of decimals to show +#' +#' @seealso \code{\link{summary.prob_chisq}} to summarize results +#' @seealso \code{\link{plot.prob_chisq}} to plot results +#' +#' @examples +#' prob_chisq(df = 1, ub = 3.841) +#' +#' @export +prob_chisq <- function(df, lb = NA, ub = NA, plb = NA, + pub = NA, dec = 3) { + if (!is_not(lb) && lb < 0) lb <- 0 + if (!is_not(ub) && ub < 0) ub <- 0 + + p_ub <- pchisq(ub, df) + p_lb <- pchisq(lb, df) + p_int <- max(p_ub - p_lb, 0) + + p_ub %<>% round(dec) + p_lb %<>% round(dec) + p_int %<>% round(dec) + + if (!is.na(pub)) { + if (pub > 1) pub <- 1 + if (pub < 0) pub <- 0 + } + + if (!is.na(plb)) { + if (plb > 1) plb <- 1 + if (plb < 0) plb <- 0 + } + + v_ub <- qchisq(pub, df) + v_lb <- qchisq(plb, df) + + v_ub %<>% round(dec) + v_lb %<>% round(dec) + + if (!is.na(lb) && !is.na(ub)) { + if (lb > ub) { + lb <- ub <- NA + mess_values <- "\nPlease ensure the lower bound is smaller than the upper bound" + } + } + + if (!is.na(plb) && !is.na(pub)) { + if (plb > pub) { + plb <- pub <- NA + mess_probs <- "\nPlease ensure the lower bound is smaller than the upper bound" + } + } + + as.list(environment()) %>% add_class("prob_chisq") +} + +#' Plot method for the probability calculator (Chi-squared distribution) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{prob_chisq}} +#' @param type Probabilities ("probs") or values ("values") +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{prob_chisq}} to calculate results +#' @seealso \code{\link{summary.prob_chisq}} to summarize results +#' +#' @examples +#' result <- prob_chisq(df = 1, ub = 3.841) +#' plot(result, type = "values") +#' +#' @importFrom rlang .data +#' +#' @export +plot.prob_chisq <- function(x, type = "values", ...) { + mess <- paste0("mess_", type) + if (!is.null(x[[mess]])) { + return(" ") + } + + if (type == "values") { + lb <- x$lb + ub <- x$ub + } else { + lb <- x$v_lb + ub <- x$v_ub + } + + df <- x$df + + limits <- c( + floor(qchisq(0.001, df = df)), + ceiling(qchisq(1 - 0.001, df = df)) + ) + + dat <- data.frame( + x = limits, + Probability = dchisq(limits, df = df), + df = df, + stringsAsFactors = FALSE + ) + + dchisq_limit <- function(x) { + y <- dchisq(x, df = df) + y[x < lb | x > ub] <- 0 + y + } + + dchisq_lb <- function(x) { + if (is.na(lb)) { + return(0) + } + y <- dchisq(x, df = df) + y[x > lb] <- 0 + y + } + + dchisq_ub <- function(x) { + if (is.na(ub)) { + return(0) + } + y <- dchisq(x, df = df) + y[x < ub] <- 0 + y + } + + vlines <- c(ub, lb) %>% na.omit() + if (length(vlines) == 0) vlines <- c(-Inf, Inf) + + ## based on https://rstudio-pubs-static.s3.amazonaws.com/58753_13e35d9c089d4f55b176057235778679.html + ## and R Graphics Cookbook + plt <- ggplot(dat, aes(x = .data$x)) + + stat_function(fun = stats::dchisq, args = list(df = df)) + + stat_function(fun = dchisq_limit, geom = "area", fill = "blue", alpha = 0.5, n = 501) + + stat_function(fun = dchisq_lb, geom = "area", fill = "red", alpha = 0.5, n = 501) + + stat_function(fun = dchisq_ub, geom = "area", fill = "red", alpha = 0.5, n = 501) + + geom_vline(xintercept = vlines, color = "black", linetype = "dashed", linewidth = 0.5) + + labs(x = "", y = "") + + sshhr(plt) +} + +#' Summary method for the probability calculator (Chi-squared distribution) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{prob_chisq}} +#' @param type Probabilities ("probs") or values ("values") +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{prob_chisq}} to calculate results +#' @seealso \code{\link{plot.prob_chisq}} to plot results +#' +#' @examples +#' result <- prob_chisq(df = 1, ub = 3.841) +#' summary(result, type = "values") +#' +#' @export +summary.prob_chisq <- function(object, type = "values", ...) { + cat("Probability calculator\n") + cat("Distribution: Chi-squared\n") + + mess <- object[[paste0("mess_", type)]] + if (!is.null(mess)) { + return(mess) + } + env <- environment() + ret <- sapply(names(object), function(x) assign(x, object[[x]], envir = env)) + + cat("Df :", df, "\n") + cat("Mean :", df, "\n") + cat("Variance :", 2 * df, "\n") + + if (type == "values") { + cat("Lower bound :", if (is.na(lb)) "0" else lb, "\n") + cat("Upper bound :", if (is.na(ub)) "Inf" else ub, "\n") + + if (!is.na(ub) || !is.na(lb)) { + cat("\n") + + if (!is.na(lb)) { + cat(paste0("P(X < ", lb, ") = ", p_lb, "\n")) + cat(paste0("P(X > ", lb, ") = ", round(1 - p_lb, dec), "\n")) + } + + if (!is.na(ub)) { + cat(paste0("P(X < ", ub, ") = ", p_ub, "\n")) + cat(paste0("P(X > ", ub, ") = ", round(1 - p_ub, dec), "\n")) + } + + if (!is.na(lb) && !is.na(ub)) { + cat(paste0("P(", lb, " < X < ", ub, ") = ", p_int, "\n")) + cat(paste0("1 - P(", lb, " < X < ", ub, ") = ", round(1 - p_int, dec), "\n")) + } + } + } else { + pub <- if (is.na(pub)) 2 else pub + plb <- if (is.na(plb)) -1 else plb + + cat("Lower bound :", if (plb < 0) "0" else plb, "\n") + cat("Upper bound :", if (pub > 1) "1" else pub, "\n") + + if (pub <= 1 || plb >= 0) { + cat("\n") + + if (plb >= 0) { + cat(paste0("P(X < ", v_lb, ") = ", plb, "\n")) + cat(paste0("P(X > ", v_lb, ") = ", round(1 - plb, dec), "\n")) + } + + if (pub <= 1) { + cat(paste0("P(X < ", v_ub, ") = ", pub, "\n")) + cat(paste0("P(X > ", v_ub, ") = ", round(1 - pub, dec), "\n")) + } + + if (pub <= 1 && plb >= 0) { + cat(paste0("P(", v_lb, " < X < ", v_ub, ") = ", pub - plb, "\n")) + cat(paste0("1 - P(", v_lb, " < X < ", v_ub, ") = ", round(1 - (pub - plb), dec), "\n")) + } + } + } +} + +#' Probability calculator for the uniform distribution +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param min Minimum value +#' @param max Maximum value +#' @param lb Lower bound (default = 0) +#' @param ub Upper bound (default = 1) +#' @param plb Lower probability bound +#' @param pub Upper probability bound +#' @param dec Number of decimals to show +#' +#' @seealso \code{\link{summary.prob_unif}} to summarize results +#' @seealso \code{\link{plot.prob_unif}} to plot results +#' +#' @examples +#' prob_unif(min = 0, max = 1, ub = 0.3) +#' +#' @export +prob_unif <- function(min, max, lb = NA, ub = NA, + plb = NA, pub = NA, dec = 3) { + if (min > max) { + mess_values <- "\nThe maximum value must be larger than the minimum value" + mess_probs <- "\nThe maximum value must be larger than the minimum value" + } + + if (!is.na(lb) && !is.na(ub)) { + if (lb > ub) { + lb <- ub <- NA + mess_values <- "\nPlease ensure the lower bound is smaller than the upper bound" + } + } + + if (!is.na(plb) && !is.na(pub)) { + if (plb > pub) { + plb <- pub <- NA + mess_probs <- "\nPlease ensure the lower bound is smaller than the upper bound" + } + } + + p_ub <- punif(ub, min, max) + p_lb <- punif(lb, min, max) + p_int <- max(p_ub - p_lb, 0) %>% round(dec) + + p_ub %<>% round(dec) + p_lb %<>% round(dec) + + if (!is.na(pub)) { + if (pub > 1) pub <- 1 + if (pub < 0) pub <- 0 + } + + if (!is.na(plb)) { + if (plb > 1) plb <- 1 + if (plb < 0) plb <- 0 + } + + v_ub <- qunif(pub, min, max) %>% round(dec) + v_lb <- qunif(plb, min, max) %>% round(dec) + + mean <- (max + min) / 2 + stdev <- sqrt((max - min)^2 / 12) + + as.list(environment()) %>% add_class("prob_unif") +} + +#' Plot method for the probability calculator (uniform) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{prob_unif}} +#' @param type Probabilities ("probs") or values ("values") +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{prob_unif}} to calculate results +#' @seealso \code{\link{summary.prob_unif}} to summarize results +#' +#' @examples +#' result <- prob_unif(min = 0, max = 1, ub = 0.3) +#' plot(result, type = "values") +#' +#' @importFrom rlang .data +#' +#' @export +plot.prob_unif <- function(x, type = "values", ...) { + mess <- paste0("mess_", type) + if (!is.null(x[[mess]])) { + return(" ") + } + + if (type == "values") { + lb <- x$lb + ub <- x$ub + } else { + lb <- x$v_lb + ub <- x$v_ub + } + + min <- x$min + max <- x$max + + if (min > max) { + return(" ") + } + + limits <- c(min, max) + dunif_limit <- function(x) { + y <- dunif(x, min = min, max = max) + y[x < lb | x > ub] <- 0 + y + } + + dunif_lb <- function(x) { + if (is.na(lb)) { + return(0) + } + y <- dunif(x, min = min, max = max) + y[x > lb] <- 0 + y + } + + dunif_ub <- function(x) { + if (is.na(ub)) { + return(0) + } + y <- dunif(x, min = min, max = max) + y[x < ub] <- 0 + y + } + + dunif_lines <- c(ub, lb) %>% + na.omit() %>% + base::setdiff(c(min, max)) + if (length(dunif_lines) == 0) dunif_lines <- c(-Inf, Inf) + + ## based on https://rstudio-pubs-static.s3.amazonaws.com/58753_13e35d9c089d4f55b176057235778679.html + ## and R Graphics Cookbook + plt <- data.frame(x = limits, y = dunif(limits, limits[1], limits[2]), lb = lb, ub = ub) %>% + ggplot(aes(x = .data$x)) + + stat_function(fun = dunif_limit, geom = "area", fill = "blue", alpha = 0.5, n = 501) + + stat_function(fun = dunif_lb, geom = "area", fill = "red", alpha = 0.5, n = 501) + + stat_function(fun = dunif_ub, geom = "area", fill = "red", alpha = 0.5, n = 501) + + geom_vline(xintercept = dunif_lines, color = "black", linetype = "dashed", linewidth = 0.5) + + geom_segment(aes(x = x[1], y = 0, xend = x[1], yend = y[1])) + + geom_segment(aes(x = x[2], y = 0, xend = x[2], yend = y[2])) + + geom_segment(aes(x = x[1], y = y[1], xend = x[2], yend = y[2])) + + labs(x = "", y = "") + + sshhr(plt) +} + +#' Summary method for the probability calculator (uniform) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{prob_unif}} +#' @param type Probabilities ("probs") or values ("values") +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{prob_unif}} to calculate results +#' @seealso \code{\link{plot.prob_unif}} to plot results +#' +#' @examples +#' result <- prob_unif(min = 0, max = 1, ub = 0.3) +#' summary(result, type = "values") +#' +#' @export +summary.prob_unif <- function(object, type = "values", ...) { + cat("Probability calculator\n") + cat("Distribution: Uniform\n") + + mess <- object[[paste0("mess_", type)]] + if (!is.null(mess)) { + return(mess) + } + env <- environment() + ret <- sapply(names(object), function(x) assign(x, object[[x]], envir = env)) + + cat("Min :", min, "\n") + cat("Max :", max, "\n") + if (max > min) { + cat("Mean :", round(mean, dec), "\n") + cat("St. dev :", round(stdev, dec), "\n") + } + + if (type == "values") { + cat("Lower bound :", ifelse(is.na(lb), min, lb), "\n") + cat("Upper bound :", ifelse(is.na(ub), max, ub), "\n") + + if (!is.na(ub) || !is.na(lb)) { + cat("\n") + + if (!is.na(lb)) { + cat(paste0("P(X < ", lb, ") = ", p_lb, "\n")) + cat(paste0("P(X > ", lb, ") = ", round(1 - p_lb, dec), "\n")) + } + + if (!is.na(ub)) { + cat(paste0("P(X < ", ub, ") = ", p_ub, "\n")) + cat(paste0("P(X > ", ub, ") = ", round(1 - p_ub, dec), "\n")) + } + + if (!is.na(lb) && !is.na(ub)) { + cat(paste0("P(", lb, " < X < ", ub, ") = ", p_int, "\n")) + cat(paste0("1 - P(", lb, " < X < ", ub, ") = ", round(1 - p_int, dec), "\n")) + } + } + } else { + pub <- if (is.na(pub)) 2 else pub + plb <- if (is.na(plb)) -1 else plb + + cat("Lower bound :", if (plb < 0) "0" else plb, "\n") + cat("Upper bound :", if (pub > 1) "1" else pub, "\n") + + if (pub <= 1 || plb >= 0) { + cat("\n") + + if (plb >= 0) { + cat(paste0("P(X < ", v_lb, ") = ", plb, "\n")) + cat(paste0("P(X > ", v_lb, ") = ", round(1 - plb, dec), "\n")) + } + + if (pub <= 1) { + cat(paste0("P(X < ", v_ub, ") = ", pub, "\n")) + cat(paste0("P(X > ", v_ub, ") = ", round(1 - pub, dec), "\n")) + } + + if (pub <= 1 && plb >= 0) { + cat(paste0("P(", v_lb, " < X < ", v_ub, ") = ", pub - plb, "\n")) + cat(paste0("1 - P(", v_lb, " < X < ", v_ub, ") = ", round(1 - (pub - plb), dec), "\n")) + } + } + } +} + +#' Probability calculator for the binomial distribution +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param n Number of trials +#' @param p Probability +#' @param lb Lower bound on the number of successes +#' @param ub Upper bound on the number of successes +#' @param plb Lower probability bound +#' @param pub Upper probability bound +#' @param dec Number of decimals to show +#' +#' @seealso \code{\link{summary.prob_binom}} to summarize results +#' @seealso \code{\link{plot.prob_binom}} to plot results +#' +#' @examples +#' prob_binom(n = 10, p = 0.3, ub = 3) +#' +#' @export +prob_binom <- function(n, p, lb = NA, ub = NA, + plb = NA, pub = NA, dec = 3) { + + ## making sure n is integer + n <- as_integer(n) + + if (!is_not(lb) && lb < 0) lb <- 0 + if (!is_not(ub) && ub < 0) ub <- 0 + + if (is.na(lb) || lb < 0) { + p_elb <- p_lb <- lb <- NA + } else { + lb <- as_integer(lb) + if (lb > n) lb <- n + p_elb <- dbinom(lb, n, p) %>% round(dec) + p_lelb <- pbinom(lb, n, p) %>% round(dec) + if (lb > 0) { + p_lb <- sum(dbinom(0:max((lb - 1), 0), n, p)) %>% round(dec) + } else { + p_lb <- 0 + } + } + + if (is.na(ub) || ub < 0) { + p_eub <- p_ub <- ub <- NA + } else { + ub <- as_integer(ub) + if (ub > n) ub <- n + p_eub <- dbinom(ub, n, p) %>% round(dec) + p_leub <- pbinom(ub, n, p) %>% round(dec) + if (ub > 0) { + p_ub <- sum(dbinom(0:max((ub - 1), 0), n, p)) %>% round(dec) + } else { + p_ub <- 0 + } + } + + if (!is.na(ub) && !is.na(lb)) { + p_int <- sum(dbinom(lb:ub, n, p)) %>% + max(0) %>% + round(dec) + } else { + p_int <- NA + } + + if (is.na(plb)) { + vlb <- NA + } else { + if (plb > 1) plb <- 1 + if (plb < 0) plb <- 0 + vlb <- qbinom(plb, n, p) + + vp_elb <- dbinom(vlb, n, p) %>% round(dec) + vp_lelb <- pbinom(vlb, n, p) %>% round(dec) + if (vlb > 0) { + vp_lb <- sum(dbinom(0:max((vlb - 1), 0), n, p)) %>% round(dec) + } else { + vp_lb <- 0 + } + } + + if (is.na(pub)) { + vub <- NA + } else { + if (pub > 1) pub <- 1 + if (pub < 0) pub <- 0 + vub <- qbinom(pub, n, p) + + vp_eub <- dbinom(vub, n, p) %>% round(dec) + vp_leub <- pbinom(vub, n, p) %>% round(dec) + if (vub > 0) { + vp_ub <- sum(dbinom(0:max((vub - 1), 0), n, p)) %>% round(dec) + } else { + vp_ub <- 0 + } + } + + if (!is.na(pub) && !is.na(plb)) { + vp_int <- sum(dbinom(vlb:vub, n, p)) %>% + max(0) %>% + round(dec) + } else { + vp_int <- NA + } + + if (!is.na(lb) && !is.na(ub)) { + if (lb > ub) { + lb <- ub <- NA + mess_values <- "\nPlease ensure the lower bound is smaller than the upper bound" + } + } + + if (!is.na(vlb) && !is.na(vub)) { + if (vlb > vub) { + plb <- pub <- vlb <- vub <- NA + mess_probs <- "\nPlease ensure the lower bound is smaller than the upper bound" + } + } + + as.list(environment()) %>% add_class("prob_binom") +} + + +make_colors_discrete <- function(ub, lb, x_range) { + colors <- factor(rep("blue", length(x_range)), levels = c("red", "green", "blue")) + if (!is.na(lb) & !is.na(ub)) { + colors[x_range == lb | x_range == ub] <- "green" + colors[x_range > lb & x_range < ub] <- "blue" + colors[x_range > ub | x_range < lb] <- "red" + } else if (!is.na(lb)) { + if (lb %in% x_range) colors[x_range == lb] <- "green" + colors[x_range > lb] <- "blue" + colors[x_range < lb] <- "red" + } else if (!is.na(ub)) { + if (ub %in% x_range) colors[x_range == ub] <- "green" + colors[x_range > ub] <- "red" + colors[x_range < ub] <- "blue" + } else { + colors[1:length(colors)] <- "blue" + } + return(colors) +} + +make_bar_plot <- function(ub, lb, x_range, y_range) { + colors <- make_colors_discrete(ub, lb, x_range) + dat <- data.frame(x_range = x_range, y_range = y_range, colors = colors) + + if (nrow(dat) < 40) { + # makes sure each bar has a label + dat <- dat %>% mutate(x_range = factor(x_range)) + } + + cols <- c(red = "red", green = "green", blue = "blue") + plt <- ggplot(dat, aes(x = .data$x_range, y = .data$y_range, fill = .data$colors)) + + geom_bar(stat = "identity", alpha = 0.5) + + labs(x = "", y = "Probability") + + scale_fill_manual(values = cols) + + theme(legend.position = "none") + + sshhr(plt) +} + +#' Plot method for the probability calculator (binomial) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{prob_binom}} +#' @param type Probabilities ("probs") or values ("values") +#' @param ... further arguments passed to or from other methods +# +#' @seealso \code{\link{prob_binom}} to calculate results +#' @seealso \code{\link{summary.prob_binom}} to summarize results +#' +#' @examples +#' result <- prob_binom(n = 10, p = 0.3, ub = 3) +#' plot(result, type = "values") +#' +#' @importFrom rlang .data +#' +#' @export +plot.prob_binom <- function(x, type = "values", ...) { + mess <- paste0("mess_", type) + if (!is.null(x[[mess]])) { + return(" ") + } + + if (type == "values") { + lb <- x$lb + ub <- x$ub + } else { + lb <- x$vlb + ub <- x$vub + } + + n <- x$n + p <- x$p + + limits <- 0:n + dat <- data.frame( + x_range = limits, + y_range = dbinom(limits, size = n, prob = p), + stringsAsFactors = FALSE + ) %>% + filter(., .$y_range > 0.00001) + + make_bar_plot(ub, lb, dat$x_range, dat$y_range) +} + +#' Summary method for the probability calculator (binomial) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{prob_binom}} +#' @param type Probabilities ("probs") or values ("values") +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{prob_binom}} to calculate results +#' @seealso \code{\link{plot.prob_binom}} to plot results +#' +#' @examples +#' result <- prob_binom(n = 10, p = 0.3, ub = 3) +#' summary(result, type = "values") +#' +#' @export +summary.prob_binom <- function(object, type = "values", ...) { + cat("Probability calculator\n") + cat("Distribution: Binomial\n") + + mess <- object[[paste0("mess_", type)]] + if (!is.null(mess)) { + return(mess) + } + env <- environment() + ret <- sapply(names(object), function(x) assign(x, object[[x]], envir = env)) + + cat("n :", n, "\n") + cat("p :", p, "\n") + cat("Mean :", round(n * p, dec), "\n") + cat("St. dev :", sqrt(n * p * (1 - p)) %>% round(dec), "\n") + + if (type == "values") { + cat("Lower bound :", ifelse(is.na(lb), "", lb), "\n") + cat("Upper bound :", ifelse(is.na(ub), "", ub), "\n") + + if (!is.na(ub) || !is.na(lb)) { + cat("\n") + + if (!is.na(lb)) { + cat(paste0("P(X = ", lb, ") = ", p_elb, "\n")) + if (lb > 0) { + cat(paste0("P(X < ", lb, ") = ", p_lb, "\n")) + cat(paste0("P(X <= ", lb, ") = ", p_lelb, "\n")) + } + if (lb < n) { + cat(paste0("P(X > ", lb, ") = ", round(1 - (p_lb + p_elb), dec), "\n")) + cat(paste0("P(X >= ", lb, ") = ", round(1 - p_lb, dec), "\n")) + } + } + + if (!is.na(ub)) { + cat(paste0("P(X = ", ub, ") = ", p_eub, "\n")) + if (ub > 0) { + cat(paste0("P(X < ", ub, ") = ", p_ub, "\n")) + cat(paste0("P(X <= ", ub, ") = ", p_leub, "\n")) + } + if (ub < n) { + cat(paste0("P(X > ", ub, ") = ", round(1 - (p_ub + p_eub), dec), "\n")) + cat(paste0("P(X >= ", ub, ") = ", round(1 - p_ub, dec), "\n")) + } + } + + if (!is.na(lb) && !is.na(ub)) { + cat(paste0("P(", lb, " <= X <= ", ub, ") = ", p_int, "\n")) + cat(paste0("1 - P(", lb, " <= X <= ", ub, ") = ", round(1 - p_int, dec), "\n")) + } + } + } else { + cat("Lower bound :", if (is.na(plb)) "\n" else paste0(plb, " (", vlb, ")\n")) + cat("Upper bound :", if (is.na(pub)) "\n" else paste0(pub, " (", vub, ")\n")) + + if (!is.na(pub) || !is.na(plb)) { + cat("\n") + + if (!is.na(plb)) { + cat(paste0("P(X = ", vlb, ") = ", vp_elb, "\n")) + if (vlb > 0) { + cat(paste0("P(X < ", vlb, ") = ", vp_lb, "\n")) + cat(paste0("P(X <= ", vlb, ") = ", vp_lelb, "\n")) + } + if (vlb < n) { + cat(paste0("P(X > ", vlb, ") = ", round(1 - (vp_lb + vp_elb), dec), "\n")) + cat(paste0("P(X >= ", vlb, ") = ", round(1 - vp_lb, dec), "\n")) + } + } + + if (!is.na(pub)) { + cat(paste0("P(X = ", vub, ") = ", vp_eub, "\n")) + if (vub > 0) { + cat(paste0("P(X < ", vub, ") = ", vp_ub, "\n")) + cat(paste0("P(X <= ", vub, ") = ", vp_leub, "\n")) + } + if (vub < n) { + cat(paste0("P(X > ", vub, ") = ", round(1 - (vp_ub + vp_eub), dec), "\n")) + cat(paste0("P(X >= ", vub, ") = ", round(1 - vp_ub, dec), "\n")) + } + } + + if (!is.na(plb) && !is.na(pub)) { + cat(paste0("P(", vlb, " <= X <= ", vub, ") = ", vp_int, "\n")) + cat(paste0("1 - P(", vlb, " <= X <= ", vub, ") = ", round(1 - vp_int, dec), "\n")) + } + } + } +} + +#' Probability calculator for a discrete distribution +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param v Values +#' @param p Probabilities +#' @param lb Lower bound on the number of successes +#' @param ub Upper bound on the number of successes +#' @param plb Lower probability bound +#' @param pub Upper probability bound +#' @param dec Number of decimals to show +#' +#' @seealso \code{\link{summary.prob_disc}} to summarize results +#' @seealso \code{\link{plot.prob_disc}} to plot results +#' +#' @examples +#' prob_disc(v = 1:6, p = 1 / 6, pub = 0.95) +#' prob_disc(v = 1:6, p = c(2 / 6, 2 / 6, 1 / 12, 1 / 12, 1 / 12, 1 / 12), pub = 0.95) +#' +#' @export +prob_disc <- function(v, p, lb = NA, ub = NA, + plb = NA, pub = NA, dec = 3) { + + # Think about adding an "expand.grid" setup so you can run this n times. e.g., rolling multiple dice + # expand.grid(height = 1:6, weight = 1:6) + rex <- "(\\s*,\\s*|\\s*;\\s*|\\s+)" + if (is.character(v)) v <- strsplit(v, rex) %>% unlist() + if (is.character(p)) p <- strsplit(p, rex) %>% unlist() + rm(rex) + + lp <- length(p) + lv <- length(v) + if (lv != lp && lv %% lp == 0) p <- rep(p, lv / lp) + + if (length(v) != length(p)) { + mess <- "The number of values must be the same or a multiple of the number of probabilities" + return(list(mess_probs = mess, mess_values = mess) %>% add_class("prob_disc")) + } + + asNum <- function(x) ifelse(length(x) > 1, as.numeric(x[1]) / as.numeric(x[2]), as.numeric(x[1])) + if (is.character(v)) v <- sshhr(strsplit(v, "/") %>% sapply(asNum)) + if (is.character(p)) p <- sshhr(strsplit(p, "/") %>% sapply(asNum)) + + if (anyNA(p) | anyNA(v)) { + mess <- "The number of probabilities entered must be a multiple of the number of values" + mess <- paste0("Invalid inputs:\n\nv: ", paste0(v, collapse = " "), "\np: ", paste0(p, collapse = " ")) + return(list(mess_probs = mess, mess_values = mess) %>% add_class("prob_disc")) + } + + ## make sure values and probabilities are ordered correctly + df <- data.frame(v = v, p = p, stringsAsFactors = FALSE) %>% + arrange(v) + p <- df$p + v <- df$v + + if (sum(p) < .99 || sum(p) > 1.01) { + mess_probs <- mess_values <- paste0("Probabilities for a discrete variable do not sum to 1 (", round(sum(p), 3), ")") + return(as.list(environment()) %>% add_class("prob_disc")) + } + + ddisc <- function(b, df) filter(df, v == b)$p + pdisc <- function(b, df) filter(df, v < b)$p %>% sum() + ## consistent with http://www.stat.umn.edu/geyer/old/5101/rlook.html#qbinom + qdisc <- function(prob, df) { + mutate(df, p = cumsum(df$p)) %>% + filter(p >= prob) %>% + .$v %>% + min() + } + + if (is.na(lb)) { + p_elb <- p_lb <- lb <- NA + } else if (!lb %in% v) { + p_elb <- 0 + p_lb <- ifelse(lb < min(v), 0, pdisc(lb, df) %>% round(dec)) + p_lelb <- p_elb + p_lb + } else { + p_elb <- ddisc(lb, df) %>% round(dec) + p_lb <- pdisc(lb, df) %>% round(dec) + p_lelb <- p_elb + p_lb + } + + if (is.na(ub)) { + p_eub <- p_ub <- ub <- NA + } else if (!ub %in% v) { + p_eub <- 0 + p_ub <- ifelse(ub < min(v), 0, pdisc(ub, df) %>% round(dec)) + p_leub <- p_eub + p_ub + } else { + p_eub <- ddisc(ub, df) %>% round(dec) + p_ub <- pdisc(ub, df) %>% round(dec) + p_leub <- p_eub + p_ub + } + + if (!is.na(ub) && !is.na(lb)) { + p_int <- p_leub - p_lb + } else { + p_int <- NA + } + + if (is.na(plb)) { + plb <- vlb <- NA + } else if (length(qdisc(plb, df)) == 0) { + mess_probs <- "Lower bound is too low" + return(as.list(environment()) %>% add_class("prob_disc")) + } else { + if (plb > 1) plb <- 1 + if (plb < 0) plb <- 0 + vlb <- qdisc(plb, df) + vp_elb <- ddisc(vlb, df) %>% round(dec) + vp_lb <- pdisc(vlb, df) %>% round(dec) + vp_lelb <- vp_elb + vp_lb + } + + if (is.na(pub)) { + pub <- vub <- NA + } else if (length(qdisc(pub, df)) == 0) { + mess_probs <- "Upper bound is too low" + return(as.list(environment()) %>% add_class("prob_disc")) + } else { + if (pub > 1) pub <- 1 + if (pub < 0) pub <- 0 + vub <- qdisc(pub, df) + vp_eub <- ddisc(vub, df) %>% round(dec) + vp_ub <- pdisc(vub, df) %>% round(dec) + vp_leub <- vp_eub + vp_ub + } + + if (!is.na(pub) && !is.na(plb)) { + vp_int <- vp_leub - vp_lb + } else { + vp_int <- NA + } + + if (!is.na(lb) && !is.na(ub)) { + if (lb > ub) { + lb <- ub <- NA + mess_values <- "\nPlease ensure the lower bound is smaller than the upper bound" + } + } + + if (!is.na(vlb) && !is.na(vub)) { + if (vlb > vub || plb > pub) { + plb <- pub <- vlb <- vub <- NA + mess_probs <- "\nPlease ensure the lower bound is smaller than the upper bound" + } + } + + rm(qdisc, pdisc, ddisc, asNum) + + as.list(environment()) %>% add_class("prob_disc") +} + +#' Plot method for the probability calculator (discrete) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{prob_disc}} +#' @param type Probabilities ("probs") or values ("values") +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{prob_disc}} to calculate results +#' @seealso \code{\link{summary.prob_disc}} to summarize results +#' +#' @examples +#' result <- prob_disc(v = 1:6, p = c(2 / 6, 2 / 6, 1 / 12, 1 / 12, 1 / 12, 1 / 12), pub = 0.95) +#' plot(result, type = "probs") +#' +#' @importFrom rlang .data +#' +#' @export +plot.prob_disc <- function(x, type = "values", ...) { + mess <- paste0("mess_", type) + if (!is.null(x[[mess]])) { + return(" ") + } + + if (type == "values") { + lb <- x$lb + ub <- x$ub + } else { + lb <- x$vlb + ub <- x$vub + } + + make_bar_plot(ub, lb, x$v, x$p) +} + +#' Summary method for the probability calculator (discrete) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{prob_disc}} +#' @param type Probabilities ("probs") or values ("values") +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{prob_disc}} to calculate results +#' @seealso \code{\link{plot.prob_disc}} to plot results +#' +#' @examples +#' result <- prob_disc(v = 1:6, p = c(2 / 6, 2 / 6, 1 / 12, 1 / 12, 1 / 12, 1 / 12), pub = 0.95) +#' summary(result, type = "probs") +#' +#' @export +summary.prob_disc <- function(object, type = "values", ...) { + cat("Probability calculator\n") + cat("Distribution : Discrete\n") + + mess <- object[[paste0("mess_", type)]] + if (!is.null(mess)) { + return(mess) + } + env <- environment() + ret <- sapply(names(object), function(x) assign(x, object[[x]], envir = env)) + + cat("Values :", paste0(v, collapse = " "), "\n") + cat("Probabilities:", paste0(round(p, dec), collapse = " "), "\n") + m <- sum(v * p) + std <- sqrt(sum(p * (v - m)^2)) + cat("Mean :", round(m, dec), "\n") + cat("St. dev :", round(std, dec), "\n") + + if (type == "values") { + cat("Lower bound :", ifelse(is.na(lb), "", lb), "\n") + cat("Upper bound :", ifelse(is.na(ub), "", ub), "\n") + + if (!is.na(ub) || !is.na(lb)) { + cat("\n") + + if (!is.na(lb)) { + cat(paste0("P(X = ", lb, ") = ", p_elb, "\n")) + if (lb > min(v)) { + cat(paste0("P(X < ", lb, ") = ", p_lb, "\n")) + cat(paste0("P(X <= ", lb, ") = ", p_lelb, "\n")) + } + if (lb < max(v)) { + cat(paste0("P(X > ", lb, ") = ", round(1 - (p_lb + p_elb), dec), "\n")) + cat(paste0("P(X >= ", lb, ") = ", round(1 - p_lb, dec), "\n")) + } + } + + if (!is.na(ub)) { + cat(paste0("P(X = ", ub, ") = ", p_eub, "\n")) + if (ub > min(v)) { + cat(paste0("P(X < ", ub, ") = ", p_ub, "\n")) + cat(paste0("P(X <= ", ub, ") = ", p_leub, "\n")) + } + if (ub < max(v)) { + cat(paste0("P(X > ", ub, ") = ", round(1 - (p_ub + p_eub), dec), "\n")) + cat(paste0("P(X >= ", ub, ") = ", round(1 - p_ub, dec), "\n")) + } + } + + if (!is.na(lb) && !is.na(ub)) { + cat(paste0("P(", lb, " <= X <= ", ub, ") = ", p_int, "\n")) + cat(paste0("1 - P(", lb, " <= X <= ", ub, ") = ", round(1 - p_int, dec), "\n")) + } + } + } else { + cat("Lower bound :", if (is.na(plb)) "\n" else paste0(plb, " (", vlb, ")\n")) + cat("Upper bound :", if (is.na(pub)) "\n" else paste0(pub, " (", vub, ")\n")) + + if (!is.na(pub) || !is.na(plb)) { + cat("\n") + + if (!is.na(plb)) { + cat(paste0("P(X = ", vlb, ") = ", vp_elb, "\n")) + if (vlb > min(v)) { + cat(paste0("P(X < ", vlb, ") = ", vp_lb, "\n")) + cat(paste0("P(X <= ", vlb, ") = ", vp_lelb, "\n")) + } + if (vlb < max(v)) { + cat(paste0("P(X > ", vlb, ") = ", round(1 - (vp_lb + vp_elb), dec), "\n")) + cat(paste0("P(X >= ", vlb, ") = ", round(1 - vp_lb, dec), "\n")) + } + } + + if (!is.na(pub)) { + cat(paste0("P(X = ", vub, ") = ", vp_eub, "\n")) + if (vub > min(v)) { + cat(paste0("P(X < ", vub, ") = ", vp_ub, "\n")) + cat(paste0("P(X <= ", vub, ") = ", vp_leub, "\n")) + } + if (vub < max(v)) { + cat(paste0("P(X > ", vub, ") = ", round(1 - (vp_ub + vp_eub), dec), "\n")) + cat(paste0("P(X >= ", vub, ") = ", round(1 - vp_ub, dec), "\n")) + } + } + + if (!is.na(plb) && !is.na(pub)) { + cat(paste0("P(", vlb, " <= X <= ", vub, ") = ", vp_int, "\n")) + cat(paste0("1 - P(", vlb, " <= X <= ", vub, ") = ", round(1 - vp_int, dec), "\n")) + } + } + } +} + +#' Probability calculator for the exponential distribution +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param rate Rate +#' @param lb Lower bound (default is 0) +#' @param ub Upper bound (default is Inf) +#' @param plb Lower probability bound +#' @param pub Upper probability bound +#' @param dec Number of decimals to show +#' +#' @seealso \code{\link{summary.prob_expo}} to summarize results +#' @seealso \code{\link{plot.prob_expo}} to plot results +#' +#' @examples +#' prob_expo(rate = 1, ub = 2.996) +#' +#' @export +prob_expo <- function(rate, lb = NA, ub = NA, + plb = NA, pub = NA, dec = 3) { + if (!is_not(lb) && lb < 0) lb <- 0 + if (!is_not(ub) && ub < 0) ub <- 0 + + p_ub <- pexp(ub, rate) + p_lb <- pexp(lb, rate) + p_int <- max(p_ub - p_lb, 0) + + p_ub %<>% round(dec) + p_lb %<>% round(dec) + p_int %<>% round(dec) + + if (!is.na(pub)) { + if (pub > 1) pub <- 1 + if (pub < 0) pub <- 0 + } + + if (!is.na(plb)) { + if (plb > 1) plb <- 1 + if (plb < 0) plb <- 0 + } + + v_ub <- qexp(pub, rate) %>% round(dec) + v_lb <- qexp(plb, rate) %>% round(dec) + + if (!is.na(lb) && !is.na(ub)) { + if (lb > ub) { + lb <- ub <- NA + mess_values <- "\nPlease ensure the lower bound is smaller than the upper bound" + } + } + + if (!is.na(plb) && !is.na(pub)) { + if (plb > pub) { + plb <- pub <- NA + mess_probs <- "\nPlease ensure the lower bound is smaller than the upper bound" + } + } + + as.list(environment()) %>% add_class("prob_expo") +} + +#' Plot method for the probability calculator (Exponential distribution) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{prob_expo}} +#' @param type Probabilities ("probs") or values ("values") +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{prob_expo}} to calculate results +#' @seealso \code{\link{summary.prob_expo}} to summarize results +#' +#' @examples +#' result <- prob_expo(rate = 1, ub = 2.996) +#' plot(result, type = "values") +#' +#' @importFrom rlang .data +#' +#' @export +plot.prob_expo <- function(x, type = "values", ...) { + mess <- paste0("mess_", type) + if (!is.null(x[[mess]])) { + return(" ") + } + + if (type == "values") { + lb <- x$lb + ub <- x$ub + } else { + lb <- x$v_lb + ub <- x$v_ub + } + + rate <- x$rate + + limits <- c( + floor(qexp(0.001, rate = rate)), + ceiling(qexp(1 - 0.001, rate = rate)) + ) + + dat <- data.frame( + x = limits, + Probability = dexp(limits, rate = rate), + rate = rate, + stringsAsFactors = FALSE + ) + + dexp_limit <- function(x) { + y <- dexp(x, rate = rate) + y[x < lb | x > ub] <- 0 + y + } + + dexp_lb <- function(x) { + if (is.na(lb)) { + return(0) + } + y <- dexp(x, rate = rate) + y[x > lb] <- 0 + y + } + + dexp_ub <- function(x) { + if (is.na(ub)) { + return(0) + } + y <- dexp(x, rate = rate) + y[x < ub] <- 0 + y + } + + vlines <- c(ub, lb) %>% na.omit() + if (length(vlines) == 0) vlines <- c(-Inf, Inf) + + ## based on https://rstudio-pubs-static.s3.amazonaws.com/58753_13e35d9c089d4f55b176057235778679.html + ## and R Graphics Cookbook + plt <- ggplot(dat, aes(x = .data$x)) + + stat_function(fun = stats::dexp, args = list(rate = rate)) + + stat_function(fun = dexp_limit, geom = "area", fill = "blue", alpha = 0.5, n = 501) + + stat_function(fun = dexp_lb, geom = "area", fill = "red", alpha = 0.5, n = 501) + + stat_function(fun = dexp_ub, geom = "area", fill = "red", alpha = 0.5, n = 501) + + geom_vline(xintercept = vlines, color = "black", linetype = "dashed", linewidth = 0.5) + + labs(x = "", y = "") + + sshhr(plt) +} + + +#' Summary method for the probability calculator (exponential) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{prob_expo}} +#' @param type Probabilities ("probs") or values ("values") +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{prob_expo}} to calculate results +#' @seealso \code{\link{plot.prob_expo}} to plot results +#' +#' @examples +#' result <- prob_expo(rate = 1, ub = 2.996) +#' summary(result, type = "values") +#' +#' @export +summary.prob_expo <- function(object, type = "values", ...) { + cat("Probability calculator\n") + cat("Distribution: Exponential\n") + + mess <- object[[paste0("mess_", type)]] + if (!is.null(mess)) { + return(mess) + } + env <- environment() + ret <- sapply(names(object), function(x) assign(x, object[[x]], envir = env)) + + cat("Rate :", rate, "\n") + cat("Mean :", round(1 / rate, dec), "\n") + cat("Variance :", round(rate^-2, dec), "\n") + + if (type == "values") { + cat("Lower bound :", if (is.na(lb)) "0" else lb, "\n") + cat("Upper bound :", if (is.na(ub)) "Inf" else ub, "\n") + + if (!is.na(ub) || !is.na(lb)) { + cat("\n") + + if (!is.na(lb)) { + cat(paste0("P(X < ", lb, ") = ", p_lb, "\n")) + cat(paste0("P(X > ", lb, ") = ", round(1 - p_lb, dec), "\n")) + } + + if (!is.na(ub)) { + cat(paste0("P(X < ", ub, ") = ", p_ub, "\n")) + cat(paste0("P(X > ", ub, ") = ", round(1 - p_ub, dec), "\n")) + } + + if (!is.na(lb) && !is.na(ub)) { + cat(paste0("P(", lb, " < X < ", ub, ") = ", p_int, "\n")) + cat(paste0("1 - P(", lb, " < X < ", ub, ") = ", round(1 - p_int, dec), "\n")) + } + } + } else { + pub <- if (is.na(pub)) 2 else pub + plb <- if (is.na(plb)) -1 else plb + + cat("Lower bound :", if (plb < 0) "0" else plb, "\n") + cat("Upper bound :", if (pub > 1) "1" else pub, "\n") + + if (pub <= 1 || plb >= 0) { + cat("\n") + + if (plb >= 0) { + cat(paste0("P(X < ", v_lb, ") = ", plb, "\n")) + cat(paste0("P(X > ", v_lb, ") = ", round(1 - plb, dec), "\n")) + } + + if (pub <= 1) { + cat(paste0("P(X < ", v_ub, ") = ", pub, "\n")) + cat(paste0("P(X > ", v_ub, ") = ", round(1 - pub, dec), "\n")) + } + + if (pub <= 1 && plb >= 0) { + cat(paste0("P(", v_lb, " < X < ", v_ub, ") = ", pub - plb, "\n")) + cat(paste0("1 - P(", v_lb, " < X < ", v_ub, ") = ", round(1 - (pub - plb), dec), "\n")) + } + } + } +} + +#' Probability calculator for the poisson distribution +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param lambda Rate +#' @param lb Lower bound (default is 0) +#' @param ub Upper bound (default is Inf) +#' @param plb Lower probability bound +#' @param pub Upper probability bound +#' @param dec Number of decimals to show +#' +#' @seealso \code{\link{summary.prob_pois}} to summarize results +#' @seealso \code{\link{plot.prob_pois}} to plot results +#' +#' @examples +#' prob_pois(lambda = 1, ub = 3) +#' +#' @export +prob_pois <- function(lambda, lb = NA, ub = NA, + plb = NA, pub = NA, dec = 3) { + if (lambda <= 0) mess_values <- "\nLambda must be positive" + + if (!is_not(lb) && lb < 0) lb <- 0 + if (!is_not(ub) && ub < 0) ub <- 0 + + if (is.na(lb) || lb < 0) { + p_elb <- p_lb <- lb <- NA + } else { + p_elb <- dpois(lb, lambda) %>% round(dec) + p_lelb <- ppois(lb, lambda) %>% round(dec) + if (lb > 0) { + p_lb <- (ppois(lb, lambda) - dpois(lb, lambda)) %>% round(dec) + } else { + p_lb <- 0 + } + } + + if (is.na(ub) || ub < 0) { + p_eub <- p_ub <- ub <- NA + } else { + p_eub <- dpois(ub, lambda) %>% round(dec) + p_leub <- ppois(ub, lambda) %>% round(dec) + if (ub > 0) { + p_ub <- (ppois(ub, lambda) - dpois(ub, lambda)) %>% round(dec) + } else { + p_ub <- 0 + } + } + + if (!is.na(ub) && !is.na(lb)) { + p_int <- sum(dpois(lb:ub, lambda)) %>% + max(0) %>% + round(dec) + } else { + p_int <- NA + } + + if (is.na(plb)) { + vlb <- NA + } else { + if (plb > 1) plb <- 1 + if (plb < 0) plb <- 0 + vlb <- qpois(plb, lambda) + + vp_elb <- dpois(vlb, lambda) %>% round(dec) + vp_lelb <- ppois(vlb, lambda) %>% round(dec) + if (vlb > 0) { + vp_lb <- (ppois(vlb, lambda) - dpois(vlb, lambda)) %>% round(dec) + } else { + vp_lb <- 0 + } + } + + if (is.na(pub)) { + vub <- NA + } else { + if (pub > 1) pub <- 1 + if (pub < 0) pub <- 0 + vub <- qpois(pub, lambda) + + vp_eub <- dpois(vub, lambda) %>% round(dec) + vp_leub <- ppois(vub, lambda) %>% round(dec) + if (vub > 0) { + vp_ub <- (ppois(vub, lambda) - dpois(vub, lambda)) %>% round(dec) + } else { + vp_ub <- 0 + } + } + + if (!is.na(lb) && !is.na(ub)) { + if (lb > ub) { + lb <- ub <- NA + mess_values <- "\nPlease ensure the lower bound is smaller than the upper bound" + } + } + + if (!is.na(vlb) && !is.na(vub)) { + if (vlb > vub || plb > pub) { + plb <- pub <- vlb <- vub <- NA + mess_probs <- "\nPlease ensure the lower bound is smaller than the upper bound" + } + } + + if (!is.na(pub) && !is.na(plb)) { + vp_int <- sum(dpois(vlb:vub, lambda)) %>% + max(0) %>% + round(dec) + } else { + vp_int <- NA + } + + as.list(environment()) %>% add_class("prob_pois") +} + +#' Plot method for the probability calculator (poisson) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{prob_pois}} +#' @param type Probabilities ("probs") or values ("values") +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{prob_pois}} to calculate results +#' @seealso \code{\link{summary.prob_pois}} to summarize results +#' +#' @examples +#' result <- prob_pois(lambda = 1, ub = 3) +#' plot(result, type = "values") +#' +#' @importFrom rlang .data +#' +#' @export +plot.prob_pois <- function(x, type = "values", ...) { + mess <- paste0("mess_", type) + if (!is.null(x[[mess]])) { + return(" ") + } + + if (type == "values") { + lb <- x$lb + ub <- x$ub + } else { + lb <- x$vlb + ub <- x$vub + } + + lambda <- x$lambda + limits <- 0:(ceiling(qpois(1 - 0.00001, lambda))) + n <- max(limits) + + if (!is.na(lb) && lb > n) { + limits <- 0:lb + n <- lb + } + + if (!is.na(ub) && ub > n) { + limits <- 0:ub + n <- ub + } + + dat <- data.frame( + x_range = limits, + y_range = dpois(limits, lambda), + stringsAsFactors = FALSE + ) %>% filter(., .$y_range > 0.00001) + + make_bar_plot(ub, lb, dat$x_range, dat$y_range) + +} + +#' Summary method for the probability calculator (poisson) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{prob_pois}} +#' @param type Probabilities ("probs") or values ("values") +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{prob_pois}} to calculate results +#' @seealso \code{\link{plot.prob_pois}} to plot results +#' +#' @examples +#' result <- prob_pois(lambda = 1, ub = 3) +#' summary(result, type = "values") +#' +#' @export +summary.prob_pois <- function(object, type = "values", ...) { + cat("Probability calculator\n") + cat("Distribution: Poisson\n") + + mess <- object[[paste0("mess_", type)]] + if (!is.null(mess)) { + return(mess) + } + env <- environment() + ret <- sapply(names(object), function(x) assign(x, object[[x]], envir = env)) + + cat("Lambda :", lambda, "\n") + cat("Mean :", lambda, "\n") + cat("Variance :", lambda, "\n") + + if (type == "values") { + cat("Lower bound :", ifelse(is.na(lb), "", lb), "\n") + cat("Upper bound :", ifelse(is.na(ub), "", ub), "\n") + + if (!is.na(ub) || !is.na(lb)) { + cat("\n") + + if (!is.na(lb)) { + cat(paste0("P(X = ", lb, ") = ", p_elb, "\n")) + if (lb > 0) { + cat(paste0("P(X < ", lb, ") = ", p_lb, "\n")) + cat(paste0("P(X <= ", lb, ") = ", p_lelb, "\n")) + } + cat(paste0("P(X > ", lb, ") = ", round(1 - (p_lb + p_elb), dec), "\n")) + cat(paste0("P(X >= ", lb, ") = ", round(1 - p_lb, dec), "\n")) + } + + if (!is.na(ub)) { + cat(paste0("P(X = ", ub, ") = ", p_eub, "\n")) + if (ub > 0) { + cat(paste0("P(X < ", ub, ") = ", p_ub, "\n")) + cat(paste0("P(X <= ", ub, ") = ", p_leub, "\n")) + } + cat(paste0("P(X > ", ub, ") = ", round(1 - (p_ub + p_eub), dec), "\n")) + cat(paste0("P(X >= ", ub, ") = ", round(1 - p_ub, dec), "\n")) + } + + if (!is.na(lb) && !is.na(ub)) { + cat(paste0("P(", lb, " <= X <= ", ub, ") = ", p_int, "\n")) + cat(paste0("1 - P(", lb, " <= X <= ", ub, ") = ", round(1 - p_int, dec), "\n")) + } + } + } else { + cat("Lower bound :", if (is.na(plb)) "\n" else paste0(plb, " (", vlb, ")\n")) + cat("Upper bound :", if (is.na(pub)) "\n" else paste0(pub, " (", vub, ")\n")) + + if (!is.na(pub) || !is.na(plb)) { + cat("\n") + + if (!is.na(plb)) { + cat(paste0("P(X = ", vlb, ") = ", vp_elb, "\n")) + if (vlb > 0) { + cat(paste0("P(X < ", vlb, ") = ", vp_lb, "\n")) + cat(paste0("P(X <= ", vlb, ") = ", vp_lelb, "\n")) + } + cat(paste0("P(X > ", vlb, ") = ", round(1 - (vp_lb + vp_elb), dec), "\n")) + cat(paste0("P(X >= ", vlb, ") = ", round(1 - vp_lb, dec), "\n")) + } + + if (!is.na(pub)) { + cat(paste0("P(X = ", vub, ") = ", vp_eub, "\n")) + if (vub > 0) { + cat(paste0("P(X < ", vub, ") = ", vp_ub, "\n")) + cat(paste0("P(X <= ", vub, ") = ", vp_leub, "\n")) + } + cat(paste0("P(X > ", vub, ") = ", round(1 - (vp_ub + vp_eub), dec), "\n")) + cat(paste0("P(X >= ", vub, ") = ", round(1 - vp_ub, dec), "\n")) + } + + if (!is.na(plb) && !is.na(pub)) { + cat(paste0("P(", vlb, " <= X <= ", vub, ") = ", vp_int, "\n")) + cat(paste0("1 - P(", vlb, " <= X <= ", vub, ") = ", round(1 - vp_int, dec), "\n")) + } + } + } +} diff --git a/radiant.basics/R/radiant.R b/radiant.basics/R/radiant.R new file mode 100644 index 0000000000000000000000000000000000000000..f6e015d8804f47ec74b9941a4c7b9fcd6460c279 --- /dev/null +++ b/radiant.basics/R/radiant.R @@ -0,0 +1,48 @@ +#' Launch radiant.basics in the default browser +#' +#' @description Launch radiant.basics in the default web browser +#' @details See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +#' +#' @param state Path to state file to load +#' @param ... additional arguments to pass to shiny::runApp (e.g, port = 8080) +#' +#' @importFrom radiant.data launch +#' +#' @examples +#' \dontrun{ +#' radiant.basics() +#' } +#' @export +radiant.basics <- function(state, ...) radiant.data::launch(package = "radiant.basics", run = "browser", state, ...) + +#' Launch radiant.basics in an Rstudio window +#' +#' @details See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +#' +#' @param state Path to state file to load +#' @param ... additional arguments to pass to shiny::runApp (e.g, port = 8080) +#' +#' @importFrom radiant.data launch +#' +#' @examples +#' \dontrun{ +#' radiant.basics_window() +#' } +#' @export +radiant.basics_window <- function(state, ...) radiant.data::launch(package = "radiant.basics", run = "window", state, ...) + +#' Launch radiant.basics in the Rstudio viewer +#' +#' @details See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +#' +#' @param state Path to state file to load +#' @param ... additional arguments to pass to shiny::runApp (e.g, port = 8080) +#' +#' @importFrom radiant.data launch +#' +#' @examples +#' \dontrun{ +#' radiant.basics_viewer() +#' } +#' @export +radiant.basics_viewer <- function(state, ...) radiant.data::launch(package = "radiant.basics", run = "viewer", state, ...) diff --git a/radiant.basics/R/single_mean.R b/radiant.basics/R/single_mean.R new file mode 100644 index 0000000000000000000000000000000000000000..0c4804c02104d4f6c7e316e2c1c987378de04639 --- /dev/null +++ b/radiant.basics/R/single_mean.R @@ -0,0 +1,236 @@ +#' Compare a sample mean to a population mean +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/single_mean.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param var The variable selected for the mean comparison +#' @param comp_value Population value to compare to the sample mean +#' @param alternative The alternative hypothesis ("two.sided", "greater", or "less") +#' @param conf_lev Span for the confidence interval +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param envir Environment to extract data from +#' +#' @return A list of variables defined in single_mean as an object of class single_mean +#' +#' @examples +#' single_mean(diamonds, "price") %>% str() +#' +#' @seealso \code{\link{summary.single_mean}} to summarize results +#' @seealso \code{\link{plot.single_mean}} to plot results +#' +#' @export +single_mean <- function(dataset, var, comp_value = 0, + alternative = "two.sided", conf_lev = .95, + data_filter = "", envir = parent.frame()) { + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, var, filt = data_filter, na.rm = FALSE, envir = envir) + + ## counting missing values + # miss <- n_missing(dataset) + ## removing any missing values + # dataset <- na.omit(dataset) + + res <- t.test(dataset[[var]], mu = comp_value, alternative = alternative, conf.level = conf_lev) %>% + tidy() + + ## from http://www.cookbook-r.com/Graphs/Plotting_means_and_error_bars_(ggplot2)/ + me_calc <- function(se, n, conf.lev = .95) { + se * qt(conf.lev / 2 + .5, n - 1) + } + + dat_summary <- summarise_all( + dataset, + list( + diff = ~ mean(., na.rm = TRUE) - comp_value, + mean = ~ mean(., na.rm = TRUE), + n = length, + n_missing = n_missing, + sd = ~ sd(., na.rm = TRUE), + se = se, + me = ~ me_calc(se, n, conf_lev) + ) + ) + + # removing unneeded arguments + rm(envir, me_calc) + + as.list(environment()) %>% add_class("single_mean") +} + +#' Summary method for the single_mean function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/single_mean.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{single_mean}} +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- single_mean(diamonds, "price") +#' summary(result) +#' diamonds %>% +#' single_mean("price") %>% +#' summary() +#' +#' @seealso \code{\link{single_mean}} to generate the results +#' @seealso \code{\link{plot.single_mean}} to plot results +#' +#' @export +summary.single_mean <- function(object, dec = 3, ...) { + cat("Single mean test\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + cat("Variable :", object$var, "\n") + cat("Confidence:", object$conf_lev, "\n") + + hyp_symbol <- c( + "two.sided" = "not equal to", + "less" = "<", + "greater" = ">" + )[object$alternative] + + cat("Null hyp. : the mean of", object$var, "=", object$comp_value, "\n") + cat("Alt. hyp. : the mean of", object$var, "is", hyp_symbol, object$comp_value, "\n\n") + + ## determine lower and upper % for ci + ci_perc <- ci_label(object$alternative, object$conf_lev) + + ## print summary statistics + object$dat_summary %>% + select(-1) %>% + # select_at(c("mean", "n", "n_missing", "sd", "se", "me")) %>% + as.data.frame(stringsAsFactors = FALSE) %>% + format_df(dec = dec, mark = ",") %>% + print(row.names = FALSE) + cat("\n") + + res <- object$res + res <- bind_cols( + data.frame( + diff = object$dat_summary[["diff"]], + se = object$dat_summary[["se"]], + stringsAsFactors = FALSE + ), + res[, -1] + ) %>% + as.data.frame(stringsAsFactors = FALSE) %>% + select(base::setdiff(colnames(.), c("method", "alternative"))) %>% + mutate(parameter = as.integer(parameter)) + + + names(res) <- c("diff", "se", "t.value", "p.value", "df", ci_perc[1], ci_perc[2]) + res %<>% round(dec) ## restrict the number of decimals + res$` ` <- sig_stars(res$p.value) + if (res$p.value < .001) res$p.value <- "< .001" + + ## print statistics + print(res, row.names = FALSE) + cat("\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n") +} + +#' Plot method for the single_mean function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/single_mean.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{single_mean}} +#' @param plots Plots to generate. "hist" shows a histogram of the data along with vertical lines that indicate the sample mean and the confidence interval. "simulate" shows the location of the sample mean and the comparison value (comp_value). Simulation is used to demonstrate the sampling variability in the data under the null-hypothesis +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- single_mean(diamonds, "price", comp_value = 3500) +#' plot(result, plots = c("hist", "simulate")) +#' +#' @seealso \code{\link{single_mean}} to generate the result +#' @seealso \code{\link{summary.single_mean}} to summarize results +#' +#' @importFrom rlang .data +#' +#' @export +plot.single_mean <- function(x, plots = "hist", + shiny = FALSE, custom = FALSE, ...) { + plot_list <- list() + if ("hist" %in% plots) { + bw <- x$dataset %>% + range(na.rm = TRUE) %>% + diff() %>% + divide_by(10) + + plot_list[[which("hist" == plots)]] <- + ggplot(x$dataset, aes(x = .data[[x$var]])) + + geom_histogram(fill = "blue", binwidth = bw, alpha = 0.5) + + geom_vline( + xintercept = x$comp_value, + color = "red", + linetype = "solid", + linewidth = 1 + ) + + geom_vline( + xintercept = x$res$estimate, + color = "black", + linetype = "solid", + linewidth = 1 + ) + + geom_vline( + xintercept = c(x$res$conf.low, x$res$conf.high), + color = "black", + linetype = "longdash", + linewidth = 0.5 + ) + } + if ("simulate" %in% plots) { + var <- na.omit(x$dataset[[x$var]]) + nr <- length(var) + + simdat <- replicate(1000, mean(sample(var, nr, replace = TRUE))) %>% + (function(z) (z - mean(z)) + x$comp_value) %>% + as.data.frame(stringsAsFactors = FALSE) %>% + set_colnames(x$var) + + cip <- ci_perc(simdat[[x$var]], x$alternative, x$conf_lev) + + bw <- simdat %>% + range() %>% + diff() %>% + divide_by(20) + + plot_list[[which("simulate" == plots)]] <- + ggplot(simdat, aes(x = .data[[x$var]])) + + geom_histogram( + fill = "blue", + binwidth = bw, + alpha = 0.5 + ) + + geom_vline( + xintercept = x$comp_value, + color = "red", + linetype = "solid", + linewidth = 1 + ) + + geom_vline( + xintercept = x$res$estimate, + color = "black", + linetype = "solid", + linewidth = 1 + ) + + geom_vline( + xintercept = cip, + color = "red", + linetype = "longdash", + linewidth = 0.5 + ) + + labs(title = paste0("Simulated means if null hyp. is true (", x$var, ")")) + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = 1) %>% + (function(x) if (shiny) x else print(x)) + } + } +} diff --git a/radiant.basics/R/single_prop.R b/radiant.basics/R/single_prop.R new file mode 100644 index 0000000000000000000000000000000000000000..314c18eed5367779fde00632820fe9f6122b6440 --- /dev/null +++ b/radiant.basics/R/single_prop.R @@ -0,0 +1,242 @@ +#' Compare a sample proportion to a population proportion +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/single_prop.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param var The variable selected for the proportion comparison +#' @param lev The factor level selected for the proportion comparison +#' @param comp_value Population value to compare to the sample proportion +#' @param alternative The alternative hypothesis ("two.sided", "greater", or "less") +#' @param conf_lev Span of the confidence interval +#' @param test bionomial exact test ("binom") or Z-test ("z") +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param envir Environment to extract data from +#' +#' @return A list of variables used in single_prop as an object of class single_prop +#' +#' @examples +#' single_prop(titanic, "survived") %>% str() +#' single_prop(titanic, "survived", lev = "Yes", comp_value = 0.5, alternative = "less") %>% str() +#' +#' @seealso \code{\link{summary.single_prop}} to summarize the results +#' @seealso \code{\link{plot.single_prop}} to plot the results +#' +#' @export +single_prop <- function(dataset, var, lev = "", comp_value = 0.5, + alternative = "two.sided", conf_lev = .95, + test = "binom", data_filter = "", + envir = parent.frame()) { + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, var, filt = data_filter, na.rm = FALSE, envir = envir) %>% + mutate_all(as.factor) + + ## removing any missing values + n_miss <- n_missing(dataset) + dataset <- na.omit(dataset) + + levs <- levels(dataset[[var]]) + if (lev != "") { + if (lev %in% levs && levs[1] != lev) { + dataset[[var]] %<>% as.character %>% + as.factor() %>% + relevel(lev) + levs <- levels(dataset[[var]]) + } + } else { + lev <- levs[1] + } + + n <- nrow(dataset) + ns <- sum(dataset == lev) + p <- ns / n + + dat_summary <- data.frame( + diff = p - comp_value, + p = p, + ns = ns, + n = n, + n_missing = n_miss, + stringsAsFactors = FALSE + ) %>% mutate( + sd = sqrt(p * (1 - p)), + se = sqrt(p * (1 - p) / n), + me = se * qnorm(conf_lev / 2 + .5, lower.tail = TRUE) + ) + + if (test == "z") { + ## use z-test + res <- sshhr(prop.test( + ns, n, + p = comp_value, alternative = alternative, + conf.level = conf_lev, correct = FALSE + )) + res <- tidy(res) + ## convert chi-square stat to a z-score + res$statistic <- sqrt(res$statistic) * ifelse(res$estimate < comp_value, -1, 1) + } else { + ## use binom.test for exact + res <- binom.test( + ns, n, + p = comp_value, alternative = alternative, + conf.level = conf_lev + ) + res <- tidy(res) + } + + # removing unneeded arguments + rm(envir) + + as.list(environment()) %>% add_class("single_prop") +} + +#' Summary method for the single_prop function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/single_prop.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{single_prop}} +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- single_prop(titanic, "survived", lev = "Yes", comp_value = 0.5, alternative = "less") +#' summary(result) +#' +#' @seealso \code{\link{single_prop}} to generate the results +#' @seealso \code{\link{plot.single_prop}} to plot the results +#' +#' @export +summary.single_prop <- function(object, dec = 3, ...) { + if (object$test == "z") { + cat("Single proportion test (z-test)\n") + } else { + cat("Single proportion test (binomial exact)\n") + } + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + cat("Variable :", object$var, "\n") + cat("Level :", object$lev, "in", object$var, "\n") + cat("Confidence:", object$conf_lev, "\n") + + hyp_symbol <- c( + "two.sided" = "not equal to", + "less" = "<", + "greater" = ">" + )[object$alternative] + + cat("Null hyp. : the proportion of", object$lev, "in", object$var, "=", object$comp_value, "\n") + cat("Alt. hyp. : the proportion of", object$lev, "in", object$var, hyp_symbol, object$comp_value, "\n\n") + + ## determine lower and upper % for ci + ci_perc <- ci_label(object$alternative, object$conf_lev) + + ## print summary statistics + object$dat_summary[-1] %>% + as.data.frame(stringsAsFactors = FALSE) %>% + format_df(dec = dec, mark = ",") %>% + print(row.names = FALSE) + cat("\n") + + res <- object$res + res <- bind_cols(data.frame(diff = object$dat_summary[["diff"]]), res[, -1]) %>% + select(base::setdiff(colnames(.), c("parameter", "method", "alternative"))) + + if (object$test == "z") { + names(res) <- c("diff", "z.value", "p.value", ci_perc[1], ci_perc[2]) + res <- format_df(res, dec = dec, mark = ",") # restrict the number of decimals + } else { + names(res) <- c("diff", "ns", "p.value", ci_perc[1], ci_perc[2]) + res <- format_df(mutate(res, ns = as.integer(res$ns)), dec = dec, mark = ",") # restrict the number of decimals + } + res$` ` <- sig_stars(res$p.value) + if (res$p.value < .001) res$p.value <- "< .001" + + ## print statistics + print(as.data.frame(res, stringsAsFactors = FALSE), row.names = FALSE) + cat("\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n") +} + +#' Plot method for the single_prop function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/basics/single_prop.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{single_prop}} +#' @param plots Plots to generate. "bar" shows a bar chart of the data. The "simulate" chart shows the location of the sample proportion and the comparison value (comp_value). Simulation is used to demonstrate the sampling variability in the data under the null-hypothesis +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- single_prop(titanic, "survived", lev = "Yes", comp_value = 0.5, alternative = "less") +#' plot(result, plots = c("bar", "simulate")) +#' +#' @seealso \code{\link{single_prop}} to generate the result +#' @seealso \code{\link{summary.single_prop}} to summarize the results +#' +#' @importFrom rlang .data +#' +#' @export +plot.single_prop <- function(x, plots = "bar", + shiny = FALSE, custom = FALSE, ...) { + if (any(!plots %in% c("bar", "simulate"))) { + stop("Available plot types for 'single_prop' are \"bar\" and \"simulate\"") + } + + lev_name <- x$levs[1] + plot_list <- list() + if ("bar" %in% plots) { + plot_list[[which("bar" == plots)]] <- + ggplot(x$dataset, aes(x = .data[[x$var]], fill = .data[[x$var]])) + + geom_bar(aes(y = after_stat(count) / sum(after_stat(count))), alpha = 0.5) + + scale_y_continuous(labels = scales::percent) + + theme(legend.position = "none") + + labs( + title = paste0("Single proportion: ", lev_name, " in ", x$var), + y = "" + ) + } + if ("simulate" %in% plots) { + simdat <- rbinom(1000, prob = x$comp_value, x$n) %>% + divide_by(x$n) %>% + data.frame(stringsAsFactors = FALSE) %>% + set_colnames(lev_name) + + cip <- ci_perc(simdat[[lev_name]], x$alternative, x$conf_lev) %>% set_names(NULL) + + bw <- simdat %>% + range() %>% + diff() %>% + divide_by(20) + + # to avoid problems with levels that start with numbers or contain spaces + # http://stackoverflow.com/questions/13445435/ggplot2-aes-string-fails-to-handle-names-starting-with-numbers-or-containing-s + names(simdat) <- "col1" + + plot_list[[which("simulate" == plots)]] <- + ggplot(simdat, aes(x = col1)) + + geom_histogram(fill = "blue", binwidth = bw, alpha = 0.5) + + geom_vline( + xintercept = x$comp_value, color = "red", + linetype = "solid", linewidth = 1 + ) + + geom_vline( + xintercept = x$res$estimate, color = "black", + linetype = "solid", linewidth = 1 + ) + + geom_vline(xintercept = cip, color = "red", linetype = "longdash", linewidth = .5) + + labs( + title = paste0("Simulated proportions if null hyp. is true (", lev_name, " in ", x$var, ")"), + x = paste0("Level ", lev_name, " in variable ", x$var) + ) + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = 1) %>% + (function(x) if (shiny) x else print(x)) + } + } +} diff --git a/radiant.basics/README.md b/radiant.basics/README.md new file mode 100644 index 0000000000000000000000000000000000000000..0a2a001c42f735f094a185dfd70c6be7e82b4f8a --- /dev/null +++ b/radiant.basics/README.md @@ -0,0 +1,188 @@ +# Radiant - Business analytics using R and Shiny + + + +[![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/radiant.basics)](https://CRAN.R-project.org/package=radiant.basics) + + +Radiant is an open-source platform-independent browser-based interface for business analytics in [R](https://www.r-project.org/). The application is based on the [Shiny](https://shiny.posit.co/) package and can be run locally or on a server. Radiant was developed by Vincent Nijs. Please use the issue tracker on GitHub to suggest enhancements or report problems: https://github.com/radiant-rstats/radiant.basics/issues. For other questions and comments please use radiant@rady.ucsd.edu. + +## Key features + +- Explore: Quickly and easily summarize, visualize, and analyze your data +- Cross-platform: It runs in a browser on Windows, Mac, and Linux +- Reproducible: Recreate results and share work with others as a state file or an [Rmarkdown](https://rmarkdown.rstudio.com/) report +- Programming: Integrate Radiant's analysis functions with your own R-code +- Context: Data and examples focus on business applications + + + + +#### Playlists + +There are two youtube playlists with video tutorials. The first provides a general introduction to key features in Radiant. The second covers topics relevant in a course on business analytics (i.e., Probability, Decision Analysis, Hypothesis Testing, Linear Regression, and Simulation). + +* Introduction to Radiant +* Radiant Tutorial Series + +#### Explore + +Radiant is interactive. Results update immediately when inputs are changed (i.e., no separate dialog boxes) and/or when a button is pressed (e.g., `Estimate` in _Model > Estimate > Logistic regression (GLM)_). This facilitates rapid exploration and understanding of the data. + +#### Cross-platform + +Radiant works on Windows, Mac, or Linux. It can run without an Internet connection and no data will leave your computer. You can also run the app as a web application on a server. + +#### Reproducible + +To conduct high-quality analysis, simply saving output is not enough. You need the ability to reproduce results for the same data and/or when new data become available. Moreover, others may want to review your analysis and results. Save and load the state of the application to continue your work at a later time or on another computer. Share state files with others and create reproducible reports using [Rmarkdown](https://rmarkdown.rstudio.com/). See also the section on `Saving and loading state` below + +If you are using Radiant on a server you can even share the URL (include the SSUID) with others so they can see what you are working on. Thanks for this feature go to [Joe Cheng](https://github.com/jcheng5). + +#### Programming + +Although Radiant's web-interface can handle quite a few data and analysis tasks, you may prefer to write your own R-code. Radiant provides a bridge to programming in R(studio) by exporting the functions used for analysis (i.e., you can conduct your analysis using the Radiant web-interface or by calling Radiant's functions directly from R-code). For more information about programming with Radiant see the [programming](https://radiant-rstats.github.io/docs/programming.html) page on the documentation site. + +#### Context + +Radiant focuses on business data and decisions. It offers tools, examples, and documentation relevant for that context, effectively reducing the business analytics learning curve. + +## How to install Radiant + +- Required: [R](https://cran.r-project.org/) version 4.0.0 or later +- Required: [Rstudio](https://posit.co/download/rstudio-server/) + +In Rstudio you can start and update Radiant through the `Addins` menu at the top of the screen. To install the latest version of Radiant for Windows or Mac, with complete documentation for off-line access, open R(studio) and copy-and-paste the command below: + +```r +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org")) +install.packages("radiant") +``` + +Once all packages are installed, select `Start radiant` from the `Addins` menu in Rstudio or use the command below to launch the app: + +```r +radiant::radiant() +``` + +To launch Radiant in Rstudio's viewer pane use the command below: + +```r +radiant::radiant_viewer() +``` + +To launch Radiant in an Rstudio Window use the command below: + +```r +radiant::radiant_window() +``` + +To easily update Radiant and the required packages, install the `radiant.update` package using: + +```r +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org")) +install.packages("remotes") +remotes::install_github("radiant-rstats/radiant.update", upgrade = "never") +``` + +Then select `Update radiant` from the `Addins` menu in Rstudio or use the command below: + +```r +radiant.update::radiant.update() +``` + +See the [installing radiant](https://radiant-rstats.github.io/docs/install.html) page additional for details. + +**Optional:** You can also create a launcher on your Desktop to start Radiant by typing `radiant::launcher()` in the R(studio) console and pressing return. A file called `radiant.bat` (windows) or `radiant.command` (mac) will be created that you can double-click to start Radiant in your default browser. The `launcher` command will also create a file called `update_radiant.bat` (windows) or `update_radiant.command` (mac) that you can double-click to update Radiant to the latest release. + +When Radiant starts you will see data on diamond prices. To close the application click the icon in the navigation bar and then click `Stop`. The Radiant process will stop and the browser window will close (Chrome) or gray-out. + +## Documentation + +Documentation and tutorials are available at and in the Radiant web interface (the icons on each page and the icon in the navigation bar). + +Individual Radiant packages also each have their own [pkgdown](https://github.com/r-lib/pkgdown) sites: + +* http://radiant-rstats.github.io/radiant +* http://radiant-rstats.github.io/radiant.data +* http://radiant-rstats.github.io/radiant.design +* http://radiant-rstats.github.io/radiant.basics +* http://radiant-rstats.github.io/radiant.model +* http://radiant-rstats.github.io/radiant.multivariate + +Want some help getting started? Watch the tutorials on the [documentation site](https://radiant-rstats.github.io/docs/tutorials.html). + + +## Reporting issues + +Please use the GitHub issue tracker at github.com/radiant-rstats/radiant/issues if you have any problems using Radiant. + +## Try Radiant online + +Not ready to install Radiant on your computer? Try it online at the link below: + +https://vnijs.shinyapps.io/radiant + +Do **not** upload sensitive data to this public server. The size of data upload has been restricted to 10MB for security reasons. + +## Running Radiant on shinyapps.io + +To run your own instance of Radiant on shinyapps.io first install Radiant and its dependencies. Then clone the radiant repo and ensure you have the latest version of the Radiant packages installed by running `radiant/inst/app/for.shinyapps.io.R`. Finally, open `radiant/inst/app/ui.R` and [deploy](https://shiny.posit.co/articles/shinyapps.html) the application. + +## Running Radiant on shiny-server + +You can also host Radiant using [shiny-server](https://posit.co/download/shiny-server/). First, install radiant on the server using the command below: + +```r +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org")) +install.packages("radiant") +``` + +Then clone the radiant repo and point shiny-server to the `inst/app/` directory. As a courtesy, please let me know if you intend to use Radiant on a server. + +When running Radiant on a server, by default, file uploads are limited to 10MB and R-code in _Report > Rmd_ and _Report > R_ will not be evaluated for security reasons. If you have `sudo` access to the server and have appropriate security in place you can change these settings by adding the following lines to `.Rprofile` for the `shiny` user on the server. + +```bash +options(radiant.maxRequestSize = -1) ## no file size limit +options(radiant.report = TRUE) +``` + +## Running Radiant in the cloud (e.g., AWS) + +To run radiant in the cloud you can use the customized Docker container. See https://github.com/radiant-rstats/docker for details + +## Saving and loading state + +To save your analyses save the state of the app to a file by clicking on the icon in the navbar and then on `Save radiant state file` (see also the _Data > Manage_ tab). You can open this state file at a later time or on another computer to continue where you left off. You can also share the file with others that may want to replicate your analyses. As an example, load the state file [`radiant-example.state.rda`](https://radiant-rstats.github.io/docs/examples/radiant-example.state.rda) by clicking on the icon in the navbar and then on `Load radiant state file`. Go to _Data > View_ and _Data > Visualize_ to see some of the settings from the previous "state" of the app. There is also a report in _Report > Rmd_ that was created using the Radiant interface. The html file `radiant-example.nb.html` contains the output. + +A related feature in Radiant is that state is maintained if you accidentally navigate to another web page, close (and reopen) the browser, and/or hit refresh. Use `Refresh` in the menu in the navigation bar to return to a clean/new state. + +Loading and saving state also works with Rstudio. If you start Radiant from Rstudio and use > `Stop` to stop the app, lists called `r_data`, `r_info`, and `r_state` will be put into Rstudio's global workspace. If you start radiant again using `radiant::radiant()` it will use these lists to restore state. Also, if you load a state file directly into Rstudio it will be used when you start Radiant to recreate a previous state. + +**Technical note**: Loading state works as follows in Radiant: When an input is initialized in a Shiny app you set a default value in the call to, for example, numericInput. In Radiant, when a state file has been loaded and an input is initialized it looks to see if there is a value for an input of that name in a list called `r_state`. If there is, this value is used. The `r_state` list is created when saving state using `reactiveValuesToList(input)`. An example of a call to `numericInput` is given below where the `state_init` function from `radiant.R` is used to check if a value from `r_state` can be used. + +```r +numericInput("sm_comp_value", "Comparison value:", state_init("sm_comp_value", 0)) +``` + +## Source code + +The source code for the radiant application is available on GitHub at . `radiant.data`, offers tools to load, save, view, visualize, summarize, combine, and transform data. `radiant.design` builds on `radiant.data` and adds tools for experimental design, sampling, and sample size calculation. `radiant.basics` covers the basics of statistical analysis (e.g., comparing means and proportions, cross-tabs, correlation, etc.) and includes a probability calculator. `radiant.model` covers model estimation (e.g., logistic regression and neural networks), model evaluation (e.g., gains chart, profit curve, confusion matrix, etc.), and decision tools (e.g., decision analysis and simulation). Finally, `radiant.multivariate` includes tools to generate brand maps and conduct cluster, factor, and conjoint analysis. + +These tools are used in the _Business Analytics_, _Quantitative Analysis_, _Research for Marketing Decisions_, _Applied Market Research_, _Consumer Behavior_, _Experiments in Firms_, _Pricing_, _Pricing Analytics_, and _Customer Analytics_ classes at the Rady School of Management (UCSD). + +## Credits + +Radiant would not be possible without [R](https://cran.r-project.org/) and [Shiny](https://shiny.posit.co/). I would like to thank [Joe Cheng](https://github.com/jcheng5), [Winston Chang](https://github.com/wch), and [Yihui Xie](https://github.com/yihui) for answering questions, providing suggestions, and creating amazing tools for the R community. Other key components used in Radiant are ggplot2, dplyr, tidyr, magrittr, broom, shinyAce, shinyFiles, rmarkdown, and DT. For an overview of other packages that Radiant relies on please see the about page. + + +## License + + +Radiant is licensed under the AGPLv3. As a summary, the AGPLv3 license requires, attribution, including copyright and license information in copies of the software, stating changes if the code is modified, and disclosure of all source code. Details are in the COPYING file. + +The documentation, images, and videos for the `radiant.data` package are licensed under the creative commons attribution and share-alike license CC-BY-SA. All other documentation and videos on this site, as well as the help files for `radiant.design`, `radiant.basics`, `radiant.model`, and `radiant.multivariate`, are licensed under the creative commons attribution, non-commercial, share-alike license CC-NC-SA. + +If you are interested in using any of the radiant packages please email me at radiant@rady.ucsd.edu + +© Vincent Nijs (2023) Creative Commons License \ No newline at end of file diff --git a/radiant.basics/_pkgdown.yml b/radiant.basics/_pkgdown.yml new file mode 100644 index 0000000000000000000000000000000000000000..36f50234d4e4d1349a8e10057989da411cc1b35f --- /dev/null +++ b/radiant.basics/_pkgdown.yml @@ -0,0 +1,136 @@ +url: https://radiant-rstats.github.io/radiant.basics + +template: + params: + docsearch: + api_key: 0629d253426ce7046f92e2bc5bb11b03 + index_name: radiant_basics + +navbar: + title: "radiant.basics" + left: + - icon: fa-home fa-lg + href: index.html + - text: "Reference" + href: reference/index.html + - text: "Articles" + href: articles/index.html + - text: "Changelog" + href: news/index.html + - text: "Other Packages" + menu: + - text: "radiant" + href: https://radiant-rstats.github.io/radiant/ + - text: "radiant.data" + href: https://radiant-rstats.github.io/radiant.data/ + - text: "radiant.design" + href: https://radiant-rstats.github.io/radiant.design/ + - text: "radiant.basics" + href: https://radiant-rstats.github.io/radiant.basics/ + - text: "radiant.model" + href: https://radiant-rstats.github.io/radiant.model/ + - text: "radiant.multivariate" + href: https://radiant-rstats.github.io/radiant.multivariate/ + - text: "docker" + href: https://github.com/radiant-rstats/docker + right: + - icon: fa-twitter fa-lg + href: https://twitter.com/vrnijs + - icon: fa-github fa-lg + href: https://github.com/radiant-rstats + +reference: +- title: Basics > Probability + desc: Functions used with the Probability Calculator and the Central Limit Theorem simulator + contents: + - clt + - plot.clt + - prob_binom + - summary.prob_binom + - plot.prob_binom + - prob_chisq + - summary.prob_chisq + - plot.prob_chisq + - prob_disc + - summary.prob_disc + - plot.prob_disc + - prob_expo + - summary.prob_expo + - plot.prob_expo + - prob_fdist + - summary.prob_fdist + - plot.prob_fdist + - prob_lnorm + - summary.prob_lnorm + - plot.prob_lnorm + - prob_norm + - summary.prob_norm + - plot.prob_norm + - prob_pois + - summary.prob_pois + - plot.prob_pois + - prob_tdist + - summary.prob_tdist + - plot.prob_tdist + - prob_unif + - summary.prob_unif + - plot.prob_unif +- title: Basics > Means + desc: Functions used with Basics > Means + contents: + - single_mean + - summary.single_mean + - plot.single_mean + - compare_means + - summary.compare_means + - plot.compare_means +- title: Basics > Proportions + desc: Functions used with Basics > Proportions + contents: + - single_prop + - summary.single_prop + - plot.single_prop + - compare_props + - summary.compare_props + - plot.compare_props +- title: Basics > Tables + desc: Functions used with Basics > Tables + contents: + - goodness + - summary.goodness + - plot.goodness + - cross_tabs + - summary.cross_tabs + - plot.cross_tabs + - correlation + - summary.correlation + - plot.correlation + - print.rcorr + - cor2df +- title: Data sets + desc: Data sets bundled with radiant.basics + contents: + - consider + - demand_uk + - newspaper + - salary +- title: Starting radiant.basics + desc: Functions used to start the radiant.basics shiny app + contents: + - radiant.basics + - radiant.basics_viewer + - radiant.basics_window +articles: +- title: Basics Menu + desc: > + These vignettes provide an introduction to the Basics menu in radiant + contents: + - pkgdown/clt + - pkgdown/prob_calc + - pkgdown/single_mean + - pkgdown/compare_means + - pkgdown/single_prop + - pkgdown/compare_props + - pkgdown/goodness + - pkgdown/cross_tabs + - pkgdown/correlation diff --git a/radiant.basics/build/build.R b/radiant.basics/build/build.R new file mode 100644 index 0000000000000000000000000000000000000000..c901d8c63ae7fea5f8f38df2565e82c615cc4e64 --- /dev/null +++ b/radiant.basics/build/build.R @@ -0,0 +1,87 @@ +setwd(rstudioapi::getActiveProject()) +curr <- getwd() +pkg <- basename(curr) + +## building package for mac and windows +rv <- R.Version() +rv <- paste(rv$major, substr(rv$minor, 1, 1), sep = ".") + +rvprompt <- readline(prompt = paste0("Running for R version: ", rv, ". Is that what you wanted y/n: ")) +if (grepl("[nN]", rvprompt)) stop("Change R-version") + +dirsrc <- "../minicran/src/contrib" + +if (rv < "3.4") { + dirmac <- fs::path("../minicran/bin/macosx/mavericks/contrib", rv) +} else if (rv > "3.6") { + dirmac <- c( + fs::path("../minicran/bin/macosx/big-sur-arm64/contrib", rv), + fs::path("../minicran/bin/macosx/contrib", rv) + ) +} else { + dirmac <- fs::path("../minicran/bin/macosx/el-capitan/contrib", rv) +} + +dirwin <- fs::path("../minicran/bin/windows/contrib", rv) + +if (!fs::file_exists(dirsrc)) fs::dir_create(dirsrc, recursive = TRUE) +for (d in dirmac) { + if (!fs::file_exists(d)) fs::dir_create(d, recursive = TRUE) +} +if (!fs::file_exists(dirwin)) fs::dir_create(dirwin, recursive = TRUE) + +# delete older version of radiant +rem_old <- function(pkg) { + unlink(paste0(dirsrc, "/", pkg, "*")) + for (d in dirmac) { + unlink(paste0(d, "/", pkg, "*")) + } + unlink(paste0(dirwin, "/", pkg, "*")) +} + +sapply(pkg, rem_old) + +## avoid 'loaded namespace' stuff when building for mac +system(paste0(Sys.which("R"), " -e \"setwd('", getwd(), "'); app <- '", pkg, "'; source('build/build_mac.R')\"")) + + +win <- readline(prompt = "Did you build on Windows? y/n: ") +if (grepl("[yY]", win)) { + + fl <- list.files(pattern = "*.zip", path = "~/Dropbox/r-packages/", full.names = TRUE) + for (f in fl) { + file.copy(f, "~/gh/") + } + + ## move packages to radiant_miniCRAN. must package in Windows first + # path <- normalizePath("../") + pth <- fs::path_abs("../") + + sapply(list.files(pth, pattern = "*.tar.gz", full.names = TRUE), file.copy, dirsrc) + unlink("../*.tar.gz") + for (d in dirmac) { + sapply(list.files(pth, pattern = "*.tgz", full.names = TRUE), file.copy, d) + } + unlink("../*.tgz") + sapply(list.files(pth, pattern = "*.zip", full.names = TRUE), file.copy, dirwin) + unlink("../*.zip") + + tools::write_PACKAGES(dirwin, type = "win.binary") + for (d in dirmac) { + tools::write_PACKAGES(d, type = "mac.binary") + } + tools::write_PACKAGES(dirsrc, type = "source") + + # commit to repo + setwd("../minicran") + system("git add --all .") + mess <- paste0(pkg, " package update: ", format(Sys.Date(), format = "%m-%d-%Y")) + system(paste0("git commit -m '", mess, "'")) + system("git push") +} + +setwd(curr) + +# remove.packages(c("radiant.model", "radiant.data")) +# radiant.update::radiant.update() +# install.packages("radiant.update") diff --git a/radiant.basics/build/build_mac.R b/radiant.basics/build/build_mac.R new file mode 100644 index 0000000000000000000000000000000000000000..1452bac080e154c24c6cd9acb6eef6c09a76c6ae --- /dev/null +++ b/radiant.basics/build/build_mac.R @@ -0,0 +1,6 @@ +## build for mac +app <- basename(getwd()) +curr <- setwd("../") +f <- devtools::build(app) +system(paste0("R CMD INSTALL --build ", f)) +setwd(curr) diff --git a/radiant.basics/build/build_win.R b/radiant.basics/build/build_win.R new file mode 100644 index 0000000000000000000000000000000000000000..e6861ceb5e94157a4ed21359a4d3339b9f1de8fb --- /dev/null +++ b/radiant.basics/build/build_win.R @@ -0,0 +1,26 @@ +## build for windows +rv <- R.Version() +rv <- paste(rv$major, substr(rv$minor, 1, 1), sep = ".") + +rvprompt <- readline(prompt = paste0("Running for R version: ", rv, ". Is that what you wanted y/n: ")) +if (grepl("[nN]", rvprompt)) + stop("Change R-version using Rstudio > Tools > Global Options > Rversion") + +## build for windows +setwd(rstudioapi::getActiveProject()) +f <- devtools::build(binary = TRUE) +devtools::install(upgrade = "never") + +fl <- list.files(pattern = "*.zip", path = "../", full.names = TRUE) + +for (f in fl) { + print(glue::glue("Copying: {f}")) + file.copy(f, "C:/Users/vnijs/Dropbox/r-packages/", overwrite = TRUE) + unlink(f) +} + +#options(repos = c(RSM = "https://radiant-rstats.github.io/minicran")) +#install.packages("radiant.data", type = "binary") +# remove.packages(c("radiant.data", "radiant.model")) +#install.packages("radiant.update") +# radiant.update::radiant.update() diff --git a/radiant.basics/data/consider.rda b/radiant.basics/data/consider.rda new file mode 100644 index 0000000000000000000000000000000000000000..d00b31838f8bf9cbe39ca333d1fba82a47346ba9 Binary files /dev/null and b/radiant.basics/data/consider.rda differ diff --git a/radiant.basics/data/demand_uk.rda b/radiant.basics/data/demand_uk.rda new file mode 100644 index 0000000000000000000000000000000000000000..558d54557306b612a4faca6a794635d8e3ad3ce1 Binary files /dev/null and b/radiant.basics/data/demand_uk.rda differ diff --git a/radiant.basics/data/newspaper.rda b/radiant.basics/data/newspaper.rda new file mode 100644 index 0000000000000000000000000000000000000000..15cd23c5daf54ee27f71ac48adf1c6766017f220 Binary files /dev/null and b/radiant.basics/data/newspaper.rda differ diff --git a/radiant.basics/data/salary.rda b/radiant.basics/data/salary.rda new file mode 100644 index 0000000000000000000000000000000000000000..811a3223f58c686fb16683300103e95d6bad34b6 Binary files /dev/null and b/radiant.basics/data/salary.rda differ diff --git a/radiant.basics/inst/app/global.R b/radiant.basics/inst/app/global.R new file mode 100644 index 0000000000000000000000000000000000000000..f83f097571a1d7f92255ec4dcb32d6d5ebc00c5d --- /dev/null +++ b/radiant.basics/inst/app/global.R @@ -0,0 +1,32 @@ +library(shiny.i18n) +# file with translations +i18n <- Translator$new(translation_csvs_path = "../translations") + +# change this to zh +i18n$set_translation_language("zh") + +## sourcing from radiant.data +options(radiant.path.data = system.file(package = "radiant.data")) +source(file.path(getOption("radiant.path.data"), "app/global.R"), encoding = getOption("radiant.encoding", default = "UTF-8"), local = TRUE) + +ifelse(grepl("radiant.basics", getwd()) && file.exists("../../inst"), "..", system.file(package = "radiant.basics")) %>% + options(radiant.path.basics = .) + +## setting path for figures in help files +addResourcePath("figures_basics", "tools/help/figures/") + +## setting path for www resources +addResourcePath("www_basics", file.path(getOption("radiant.path.basics"), "app/www/")) + +## loading urls and ui +source("init.R", encoding = getOption("radiant.encoding", "UTF-8"), local = TRUE) +options(radiant.url.patterns = make_url_patterns()) + +## if radiant.data is not in search main function from dplyr etc. won't be available +if (!"package:radiant.basics" %in% search() && + isTRUE(getOption("radiant.development")) && + getOption("radiant.path.basics") == "..") { + options(radiant.from.package = FALSE) +} else { + options(radiant.from.package = TRUE) +} diff --git a/radiant.basics/inst/app/help.R b/radiant.basics/inst/app/help.R new file mode 100644 index 0000000000000000000000000000000000000000..040ebd73f3781357465085386964580480ed6beb --- /dev/null +++ b/radiant.basics/inst/app/help.R @@ -0,0 +1,27 @@ +help_basics <- c( + "Probability calculator" = "prob_calc.md", "Central limit theorem" = "clt.md", + "Single mean" = "single_mean.md", "Compare means" = "compare_means.md", + "Single proportion" = "single_prop.md", "Compare proportions" = "compare_props.md", + "Goodness of fit" = "goodness.md", "Cross-tabs" = "cross_tabs.md", + "Correlation" = "correlation.md" +) + +output$help_basics <- reactive(append_help("help_basics", file.path(getOption("radiant.path.basics"), "app/tools/help"), Rmd = TRUE)) + +observeEvent(input$help_basics_all, { + help_switch(input$help_basics_all, "help_basics") +}) +observeEvent(input$help_basics_none, { + help_switch(input$help_basics_none, "help_basics", help_on = FALSE) +}) + +help_basics_panel <- tagList( + wellPanel( + HTML(""), + checkboxGroupInput( + "help_basics", NULL, help_basics, + selected = state_group("help_basics"), inline = TRUE + ) + ) +) diff --git a/radiant.basics/inst/app/init.R b/radiant.basics/inst/app/init.R new file mode 100644 index 0000000000000000000000000000000000000000..5f9513350f94f8488166992b6fbf5e26204ab920 --- /dev/null +++ b/radiant.basics/inst/app/init.R @@ -0,0 +1,49 @@ +## urls for menu +r_url_list <- getOption("radiant.url.list") +r_url_list[["Single mean"]] <- + list("tabs_single_mean" = list("Summary" = "basics/single-mean/", "Plot" = "basics/single-mean/plot/")) +r_url_list[["Compare means"]] <- + list("tabs_compare_means" = list("Summary" = "basics/compare-means/", "Plot" = "basics/compare-means/plot/")) +r_url_list[["Single proportion"]] <- + list("tabs_single_prop" = list("Summary" = "basics/single-prop/", "Plot" = "basics/single-prop/plot/")) +r_url_list[["Compare proportions"]] <- + list("tabs_compare_props" = list("Summary" = "basics/compare-props/", "Plot" = "basics/compare-props/plot/")) +r_url_list[["Goodness of fit"]] <- + list("tabs_goodness" = list("Summary" = "basics/goodness/", "Plot" = "basics/goodness/plot/")) +r_url_list[["Cross-tabs"]] <- + list("tabs_cross_tabs" = list("Summary" = "basics/cross-tabs/", "Plot" = "basics/cross-tabs/plot/")) +r_url_list[["Correlation"]] <- + list("tabs_correlation" = list("Summary" = "basics/correlation/", "Plot" = "basics`/correlation/plot/")) +options(radiant.url.list = r_url_list) +rm(r_url_list) + +## try http://127.0.0.1:3174/?url=basics/goodness/plot/&SSUID=local +## http://127.0.0.1:7407/?url=basics/compare-means/plot/&SSUID=local-a82049 + +## design menu +options( + radiant.basics_ui = + tagList( + navbarMenu( + i18n$t("Basics"), + tags$head( + tags$script(src = "www_basics/js/run_return.js") + ), + i18n$t("Probability"), + tabPanel(i18n$t("Probability calculator"), uiOutput("prob_calc")), + tabPanel(i18n$t("Central Limit Theorem"), uiOutput("clt")), + "----", i18n$t("Means"), + tabPanel(i18n$t("Single mean"), uiOutput("single_mean")), + tabPanel(i18n$t("Compare means"), uiOutput("compare_means")), + tabPanel(i18n$t("Normality test"),uiOutput("normality_test")), + tabPanel(i18n$t("Homogeneity of variance test"),uiOutput("homo_variance_test")), + "----", i18n$t("Proportions"), + tabPanel(i18n$t("Single proportion"), uiOutput("single_prop")), + tabPanel(i18n$t("Compare proportions"), uiOutput("compare_props")), + "----", i18n$t("Tables"), + tabPanel(i18n$t("Goodness of fit"), uiOutput("goodness")), + tabPanel(i18n$t("Cross-tabs"), uiOutput("cross_tabs")), + tabPanel(i18n$t("Correlation"), uiOutput("correlation")) + ) + ) +) diff --git a/radiant.basics/inst/app/server.R b/radiant.basics/inst/app/server.R new file mode 100644 index 0000000000000000000000000000000000000000..dd26d78c10b5e97367b84154896f2473ce022a9a --- /dev/null +++ b/radiant.basics/inst/app/server.R @@ -0,0 +1,59 @@ +if (isTRUE(getOption("radiant.from.package"))) { + library(radiant.basics) +} + +shinyServer(function(input, output, session) { + + ## source shared functions + source(file.path(getOption("radiant.path.data"), "app/init.R"), encoding = getOption("radiant.encoding"), local = TRUE) + source(file.path(getOption("radiant.path.data"), "app/radiant.R"), encoding = getOption("radiant.encoding"), local = TRUE) + source("help.R", encoding = getOption("radiant.encoding"), local = TRUE) + + ## help ui + output$help_basics_ui <- renderUI({ + sidebarLayout( + sidebarPanel( + help_data_panel, + help_basics_panel, + uiOutput("help_text"), + width = 3 + ), + mainPanel( + HTML(paste0("

Select help files to show and search

")), + htmlOutput("help_data"), + htmlOutput("help_basics") + ) + ) + }) + + ## packages to use for example data + options(radiant.example.data = c("radiant.data", "radiant.basics")) + + ## source data & app tools from radiant.data + for (file in list.files( + c( + file.path(getOption("radiant.path.data"), "app/tools/app"), + file.path(getOption("radiant.path.data"), "app/tools/data") + ), + pattern = "\\.(r|R)$", full.names = TRUE + )) + source(file, encoding = getOption("radiant.encoding"), local = TRUE) + + ## 'sourcing' package functions in the server.R environment for development + if (!isTRUE(getOption("radiant.from.package"))) { + for (file in list.files("../../R", pattern = "\\.(r|R)$", full.names = TRUE)) { + source(file, encoding = getOption("radiant.encoding"), local = TRUE) + } + cat("\nGetting radiant.basics from source ...\n") + } else { + ## weired but required + summary.correlation <- radiant.basics:::summary.correlation + } + + ## source analysis tools for basic app + for (file in list.files(c("tools/analysis"), pattern = "\\.(r|R)$", full.names = TRUE)) + source(file, encoding = getOption("radiant.encoding"), local = TRUE) + + ## save state on refresh or browser close + saveStateOnRefresh(session) +}) diff --git a/radiant.basics/inst/app/tools/analysis/clt_ui.R b/radiant.basics/inst/app/tools/analysis/clt_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..fd2b94b3e8fb244ba6487f81e037c202a36ac251 --- /dev/null +++ b/radiant.basics/inst/app/tools/analysis/clt_ui.R @@ -0,0 +1,252 @@ +############################### +# Central Limit Theorem +############################### +clt_dist <- c("Normal", "Binomial", "Uniform", "Exponential") %>% + setNames(c( + i18n$t("Normal"), + i18n$t("Binomial"), + i18n$t("Uniform"), + i18n$t("Exponential") + )) + +clt_stat <- c("sum", "mean") %>% + setNames(c( + i18n$t("Sum"), + i18n$t("Mean") + )) +clt_args <- as.list(formals(clt)) + +clt_inputs <- reactive({ + for (i in names(clt_args)) { + clt_args[[i]] <- input[[paste0("clt_", i)]] + } + clt_args +}) + +## add a spinning refresh icon if the tabel needs to be (re)calculated +run_refresh(clt_args, "clt", init = "dist", label = i18n$t("Run simulation"), relabel = i18n$t("Re-run simulation"), data = FALSE) + +output$ui_clt <- renderUI({ + tagList( + wellPanel( + actionButton("clt_run", i18n$t("Run simulation"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ), + wellPanel( + selectInput( + "clt_dist", i18n$t("Distribution:"), + choices = clt_dist, + selected = state_single("clt_dist", clt_dist), + multiple = FALSE + ), + conditionalPanel( + condition = "input.clt_dist == 'Uniform'", + make_side_by_side( + numericInput( + "clt_unif_min", i18n$t("Min:"), + value = state_init("clt_unif_min", 0) + ), + numericInput( + "clt_unif_max", i18n$t("Max:"), + value = state_init("clt_unif_max", 1) + ) + ) + ), + conditionalPanel( + condition = "input.clt_dist == 'Normal'", + make_side_by_side( + numericInput( + "clt_norm_mean", i18n$t("Mean:"), + value = state_init("clt_norm_mean", 0) + ), + numericInput( + "clt_norm_sd", i18n$t("SD:"), + value = state_init("clt_norm_sd", 1), + min = 0.1, step = 0.1 + ) + ) + ), + conditionalPanel( + condition = "input.clt_dist == 'Exponential'", + numericInput( + "clt_expo_rate", i18n$t("Rate:"), + value = state_init("clt_expo_rate", 1), + min = 1, step = 1 + ) + ), + conditionalPanel( + condition = "input.clt_dist == 'Binomial'", + make_side_by_side( + numericInput( + "clt_binom_size", i18n$t("Size:"), + value = state_init("clt_binom_size", 10), + min = 1, step = 1 + ), + numericInput( + "clt_binom_prob", i18n$t("Prob:"), + value = state_init("clt_binom_prob", 0.2), + min = 0, max = 1, step = .1 + ) + ) + ), + make_side_by_side( + numericInput( + "clt_n", i18n$t("Sample size:"), + value = state_init("clt_n", 100), + min = 2, step = 1 + ), + numericInput( + "clt_m", i18n$t("# of samples:"), + value = state_init("clt_m", 100), + min = 2, step = 1 + ) + ), + sliderInput( + "clt_bins", + label = i18n$t("Number of bins:"), + min = 1, max = 50, step = 1, + value = state_init("clt_bins", 15), + ), + radioButtons( + "clt_stat", NULL, + choices = clt_stat, + selected = state_init("clt_stat", "sum"), + inline = TRUE + ) + ), + help_and_report( + modal_title = i18n$t("Central Limit Theorem"), fun_name = "clt", + help_file = inclRmd(file.path(getOption("radiant.path.basics"), "app/tools/help/clt.md")) + ) + ) +}) + +clt_plot_width <- function() 700 +clt_plot_height <- function() 700 + +## output is called from the main radiant ui.R +output$clt <- renderUI({ + register_plot_output( + "plot_clt", ".plot_clt", + height_fun = "clt_plot_height", + width_fun = "clt_plot_width" + ) + + ## two separate tabs + clt_output_panels <- tagList( + tabPanel( + "Plot", + download_link("dlp_clt"), + plotOutput("plot_clt", width = "100%", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Basics > Probability"), + tool = i18n$t("Central Limit Theorem"), + data = NULL, + tool_ui = "ui_clt", + output_panels = clt_output_panels + ) +}) + +.clt <- eventReactive(input$clt_run, { + ## avoiding input errors + ret <- "" + if (is.na(input$clt_n) || input$clt_n < 2) { + ret <- i18n$t("Please choose a sample size larger than 2") + } else if (is.na(input$clt_m) || input$clt_m < 2) { + ret <- i18n$t("Please choose 2 or more samples") + } else if (input$clt_dist == "Uniform") { + if (is.na(input$clt_unif_min)) { + ret <- i18n$t("Please choose a minimum value for the uniform distribution") + } else if (is.na(input$clt_unif_max)) { + ret <- i18n$t("Please choose a maximum value for the uniform distribution") + } else if (input$clt_unif_max <= input$clt_unif_min) { + ret <- i18n$t("The maximum value for the uniform distribution\nmust be larger than the minimum value") + } + } else if (input$clt_dist == "Normal") { + if (is.na(input$clt_norm_mean)) { + ret <- i18n$t("Please choose a mean value for the normal distribution") + } else if (is.na(input$clt_norm_sd) || input$clt_norm_sd < .001) { + ret <- i18n$t("Please choose a non-zero standard deviation for the normal distribution") + } + } else if (input$clt_dist == "Exponential") { + if (is.na(input$clt_expo_rate) || input$clt_expo_rate < 1) { + ret <- i18n$t("Please choose a rate larger than 1 for the exponential distribution") + } + } else if (input$clt_dist == "Binomial") { + if (is.na(input$clt_binom_size) || input$clt_binom_size < 1) { + ret <- i18n$t("Please choose a size parameter larger than 1 for the binomial distribution") + } else if (is.na(input$clt_binom_prob) || input$clt_binom_prob < 0.01) { + ret <- i18n$t("Please choose a probability between 0 and 1 for the binomial distribution") + } + } + if (is.empty(ret)) { + do.call(clt, clt_inputs()) + } else { + ret + } +}) + +.plot_clt <- reactive({ + if (not_pressed(input$clt_run)) { + return(i18n$t("** Press the Run simulation button to simulate data **")) + } + clt <- .clt() + validate(need(!is.character(clt), paste0("\n\n\n ", clt))) + withProgress(message = i18n$t("Generating plots"), value = 1, { + plot(clt, stat = input$clt_stat, bins = input$clt_bins) + }) +}) + +clt_report <- function() { + outputs <- c("plot") + inp_out <- list(list(stat = input$clt_stat, bins = input$clt_bins)) + inp <- clt_inputs() + inp3 <- inp[!grepl("_", names(inp))] + if (input$clt_dist == "Normal") { + inp <- c(inp3, inp[grepl("norm_", names(inp))]) + } else if (input$clt_dist == "Uniform") { + inp <- c(inp3, inp[grepl("unif", names(inp))]) + } else if (input$clt_dist == "Binomial") { + inp <- c(inp3, inp[grepl("binom_", names(inp))]) + } else if (input$clt_dist == "Exponential") { + inp <- c(inp3, inp[grepl("expo_", names(inp))]) + } + + update_report( + inp_main = clean_args(inp, clt_args), + fun_name = "clt", + inp_out = inp_out, + outputs = outputs, + figs = TRUE, + fig.width = clt_plot_width(), + fig.height = clt_plot_height() + ) +} + +download_handler( + id = "dlp_clt", + fun = download_handler_plot, + fn = function() paste0(tolower(input$clt_dist), "_clt"), + type = "png", + caption = i18n$t("Save central limit theorem plot"), + plot = .plot_clt, + width = clt_plot_width, + height = clt_plot_height +) + +observeEvent(input$clt_report, { + r_info[["latest_screenshot"]] <- NULL + clt_report() +}) + +observeEvent(input$clt_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_clt_screenshot") +}) + +observeEvent(input$modal_clt_screenshot, { + clt_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.basics/inst/app/tools/analysis/compare_means_ui.R b/radiant.basics/inst/app/tools/analysis/compare_means_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..4e0de2e3ee302ed066b3c2507f65fc83205e9058 --- /dev/null +++ b/radiant.basics/inst/app/tools/analysis/compare_means_ui.R @@ -0,0 +1,317 @@ +## choice lists for compare means +cm_alt <- c( + "two.sided", + "less", + "greater" +) %>% setNames(c( + i18n$t("Two sided"), + i18n$t("Less than"), + i18n$t("Greater than") +)) + +cm_samples <- c( + "independent", + "paired" +) %>% setNames(c( + i18n$t("independent"), + i18n$t("paired") +)) + +cm_adjust <- c( + "none", + "bonf" +) %>% setNames(c( + i18n$t("None"), + i18n$t("Bonferroni") +)) + +cm_plots <- c( + "scatter", + "box", + "density", + "bar" +) %>% setNames(c( + i18n$t("Scatter"), + i18n$t("Box"), + i18n$t("Density"), + i18n$t("Bar") +)) +## list of function arguments +cm_args <- as.list(formals(compare_means)) + +## list of function inputs selected by user +cm_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + cm_args$data_filter <- if (input$show_filter) input$data_filter else "" + cm_args$dataset <- input$dataset + for (i in r_drop(names(cm_args))) { + cm_args[[i]] <- input[[paste0("cm_", i)]] + } + cm_args +}) + +############################### +# Compare means +############################### +output$ui_cm_var1 <- renderUI({ + vars <- c("None" = "", groupable_vars()) + isNum <- .get_class() %in% c("integer", "numeric", "ts") + + ## can't use unique here - removes variable type information + vars <- c(vars, varnames()[isNum]) %>% .[!duplicated(.)] + + selectInput( + inputId = "cm_var1", + label = i18n$t("Select a factor or numeric variable:"), + choices = vars, + selected = state_single("cm_var1", vars), + multiple = FALSE + ) +}) + +output$ui_cm_var2 <- renderUI({ + if (not_available(input$cm_var1)) { + return() + } + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- varnames()[isNum] + + if (input$cm_var1 %in% vars) { + ## when cm_var1 is numeric comparisons for multiple variables are possible + vars <- vars[-which(vars == input$cm_var1)] + if (length(vars) == 0) { + return() + } + + selectizeInput( + inputId = "cm_var2", label = i18n$t("Numeric variable(s):"), + selected = state_multiple("cm_var2", vars, isolate(input$cm_var2)), + choices = vars, multiple = TRUE, + options = list(placeholder = "None", plugins = list("remove_button", "drag_drop")) + ) + } else { + ## when cm_var1 is not numeric comparisons are across levels/groups + vars <- c("None" = "", vars) + selectInput( + "cm_var2", i18n$t("Numeric variable:"), + selected = state_single("cm_var2", vars), + choices = vars, + multiple = FALSE + ) + } +}) + +output$ui_cm_comb <- renderUI({ + if (not_available(input$cm_var1)) { + return() + } + + if (.get_class()[[input$cm_var1]] == "factor") { + levs <- .get_data()[[input$cm_var1]] %>% levels() + } else { + levs <- c(input$cm_var1, input$cm_var2) + } + + if (length(levs) > 2) { + cmb <- combn(levs, 2) %>% apply(2, paste, collapse = ":") + } else { + return() + } + + selectizeInput( + "cm_comb", + label = i18n$t("Choose combinations:"), + choices = cmb, + selected = state_multiple("cm_comb", cmb, cmb[1]), + multiple = TRUE, + options = list(placeholder = i18n$t("Evaluate all combinations"), plugins = list("remove_button", "drag_drop")) + ) +}) + + +output$ui_compare_means <- renderUI({ + req(input$dataset) + tagList( + wellPanel( + conditionalPanel( + uiOutput("ui_cm_var1"), + uiOutput("ui_cm_var2"), + condition = "input.tabs_compare_means == 'Summary'", + uiOutput("ui_cm_comb"), + selectInput( + inputId = "cm_alternative", label = i18n$t("Alternative hypothesis:"), + choices = cm_alt, + selected = state_single("cm_alternative", cm_alt, cm_args$alternative) + ), + sliderInput( + "cm_conf_lev", i18n$t("Confidence level:"), + min = 0.85, max = 0.99, step = 0.01, + value = state_init("cm_conf_lev", cm_args$conf_lev) + ), + checkboxInput("cm_show", i18n$t("Show additional statistics"), value = state_init("cm_show", FALSE)), + radioButtons( + inputId = "cm_samples", label = i18n$t("Sample type:"), cm_samples, + selected = state_init("cm_samples", cm_args$samples), + inline = TRUE + ), + radioButtons( + inputId = "cm_adjust", label = i18n$t("Multiple comp. adjustment:"), cm_adjust, + selected = state_init("cm_adjust", cm_args$adjust), + inline = TRUE + ), + radioButtons( + inputId = "cm_test", label = i18n$t("Test type:"), + choices = c( + "t", + "wilcox" + ) %>% setNames(c( + i18n$t("t-test"), + i18n$t("Wilcox") + )), + selected = state_init("cm_test", cm_args$test), + inline = TRUE + ) + ), + conditionalPanel( + condition = "input.tabs_compare_means == 'Plot'", + selectizeInput( + inputId = "cm_plots", label = i18n$t("Select plots:"), + choices = cm_plots, + selected = state_multiple("cm_plots", cm_plots, "scatter"), + multiple = TRUE, + options = list(placeholder = i18n$t("Select plots"), plugins = list("remove_button", "drag_drop")) + ) + ) + ), + help_and_report( + modal_title = i18n$t("Compare means"), + fun_name = "compare_means", + help_file = inclMD(file.path(getOption("radiant.path.basics"), "app/tools/help/compare_means.md")) + ) + ) +}) + +cm_plot <- reactive({ + list(plot_width = 650, plot_height = 400 * max(length(input$cm_plots), 1)) +}) + +cm_plot_width <- function() { + cm_plot() %>% + (function(x) if (is.list(x)) x$plot_width else 650) +} + +cm_plot_height <- function() { + cm_plot() %>% + (function(x) if (is.list(x)) x$plot_height else 400) +} + +# output is called from the main radiant ui.R +output$compare_means <- renderUI({ + register_print_output("summary_compare_means", ".summary_compare_means", ) + register_plot_output( + "plot_compare_means", ".plot_compare_means", + height_fun = "cm_plot_height" + ) + + # two separate tabs + cm_output_panels <- tabsetPanel( + id = "tabs_compare_means", + tabPanel(i18n$t("Summary"), value = "Summary", verbatimTextOutput("summary_compare_means")), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_compare_means"), + plotOutput("plot_compare_means", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Basics > Means"), + tool = i18n$t("Compare means"), + tool_ui = "ui_compare_means", + output_panels = cm_output_panels + ) +}) + +cm_available <- reactive({ + if (not_available(input$cm_var1) || not_available(input$cm_var2)) { + return(i18n$t("This analysis requires at least two variables. The first can be of type\nfactor, numeric, or interval. The second must be of type numeric or interval.\nIf these variable types are not available please select another dataset.\n\n") %>% suggest_data("salary")) + } else if (length(input$cm_var2) > 1 && .get_class()[input$cm_var1] == "factor") { + " " + } else if (input$cm_var1 %in% input$cm_var2) { + " " + } else { + "available" + } +}) + +.compare_means <- reactive({ + cmi <- cm_inputs() + cmi$envir <- r_data + do.call(compare_means, cmi) +}) + +.summary_compare_means <- reactive({ + if (cm_available() != "available") { + return(cm_available()) + } + if (input$cm_show) summary(.compare_means(), show = TRUE) else summary(.compare_means()) +}) + +.plot_compare_means <- reactive({ + if (cm_available() != "available") { + return(cm_available()) + } + validate(need(input$cm_plots, i18n$t("Nothing to plot. Please select a plot type"))) + withProgress(message = i18n$t("Generating plots"), value = 1, { + plot(.compare_means(), plots = input$cm_plots, shiny = TRUE) + }) +}) + +compare_means_report <- function() { + if (is.empty(input$cm_var1) || is.empty(input$cm_var2)) { + return(invisible()) + } + figs <- FALSE + outputs <- c("summary") + inp_out <- list(list(show = input$cm_show), "") + if (length(input$cm_plots) > 0) { + outputs <- c("summary", "plot") + inp_out[[2]] <- list(plots = input$cm_plots, custom = FALSE) + figs <- TRUE + } + update_report( + inp_main = clean_args(cm_inputs(), cm_args), + fun_name = "compare_means", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = cm_plot_width(), + fig.height = cm_plot_height() + ) +} + +download_handler( + id = "dlp_compare_means", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_compare_means"), + type = "png", + caption = i18n$t("Save compare means plot"), + plot = .plot_compare_means, + width = cm_plot_width, + height = cm_plot_height +) + +observeEvent(input$compare_means_report, { + r_info[["latest_screenshot"]] <- NULL + compare_means_report() +}) + +observeEvent(input$compare_means_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_compare_means_screenshot") +}) + +observeEvent(input$modal_compare_means_screenshot, { + compare_means_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.basics/inst/app/tools/analysis/compare_props_ui.R b/radiant.basics/inst/app/tools/analysis/compare_props_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..8e814a8968b3798b2708305b2990c5dae1614803 --- /dev/null +++ b/radiant.basics/inst/app/tools/analysis/compare_props_ui.R @@ -0,0 +1,281 @@ +## choice lists for compare proportions（不使用等号命名） +cp_alt <- c("two.sided", "less", "greater") %>% + setNames(c( + i18n$t("Two sided"), + i18n$t("Less than"), + i18n$t("Greater than") + )) + +cp_adjust <- c("none", "bonf") %>% + setNames(c( + i18n$t("None"), + i18n$t("Bonferroni") + )) + +# cp_plots <- c("props", "counts") %>% setNames(c(i18n$t("Proportions"), i18n$t("Relative"))) +cp_plots <- c("bar", "dodge") %>% + setNames(c( + i18n$t("Bar"), + i18n$t("Dodge") + )) + +## list of function arguments +cp_args <- as.list(formals(compare_props)) + +## list of function inputs selected by user +cp_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + cp_args$data_filter <- if (input$show_filter) input$data_filter else "" + cp_args$dataset <- input$dataset + for (i in r_drop(names(cp_args))) { + cp_args[[i]] <- input[[paste0("cp_", i)]] + } + cp_args +}) + +############################### +# Compare proportions +############################### +output$ui_cp_var1 <- renderUI({ + vars <- c("None" = "", groupable_vars()) + selectInput( + "cp_var1", i18n$t("Select a grouping variable:"), + choices = vars, + selected = state_single("cp_var1", vars), + multiple = FALSE + ) +}) + +output$ui_cp_var2 <- renderUI({ + vars <- two_level_vars() + if (not_available(input$cp_var1)) { + return() + } + if (input$cp_var1 %in% vars) vars <- vars[-which(vars == input$cp_var1)] + + vars <- c("None" = "", vars) + selectInput( + inputId = "cp_var2", i18n$t("Variable (select one):"), + selected = state_single("cp_var2", vars), + choices = vars, + multiple = FALSE + ) +}) + +output$ui_cp_levs <- renderUI({ + if (not_available(input$cp_var2)) { + return() + } else { + levs <- .get_data()[[input$cp_var2]] %>% + as.factor() %>% + levels() + } + + selectInput( + inputId = "cp_levs", i18n$t("Choose level:"), + choices = levs, + selected = state_single("cp_levs", levs), + multiple = FALSE + ) +}) + +output$ui_cp_comb <- renderUI({ + if (not_available(input$cp_var1)) { + return() + } + + dat <- .get_data()[[input$cp_var1]] %>% as.factor() + levs <- levels(dat) + alevs <- unique(dat) + len <- length(dat) + levs <- levs[levs %in% alevs] + + if (length(levs) > 2 && length(levs) < len) { + cmb <- combn(levs, 2) %>% apply(2, paste, collapse = ":") + } else { + return() + } + + selectizeInput( + "cp_comb", i18n$t("Choose combinations:"), + choices = cmb, + selected = state_multiple("cp_comb", cmb, cmb[1]), + multiple = TRUE, + options = list(placeholder = i18n$t("Evaluate all combinations"), plugins = list("remove_button", "drag_drop")) + ) +}) + + +output$ui_compare_props <- renderUI({ + req(input$dataset) + tagList( + wellPanel( + conditionalPanel( + condition = "input.tabs_compare_props == 'Summary'", + uiOutput("ui_cp_var1"), + uiOutput("ui_cp_var2"), + uiOutput("ui_cp_levs"), + uiOutput("ui_cp_comb"), + selectInput( + inputId = "cp_alternative", i18n$t("Alternative hypothesis:"), + choices = cp_alt, + selected = state_single("cp_alternative", cp_alt, cp_args$alternative) + ), + checkboxInput( + "cp_show", i18n$t("Show additional statistics"), + value = state_init("cp_show", FALSE) + ), + sliderInput( + "cp_conf_lev", i18n$t("Confidence level:"), + min = 0.85, max = 0.99, step = 0.01, + value = state_init("cp_conf_lev", cp_args$conf_lev) + ), + radioButtons( + inputId = "cp_adjust", i18n$t("Multiple comp. adjustment:"), + cp_adjust, + selected = state_init("cp_adjust", cp_args$adjust), + inline = TRUE + ) + ), + conditionalPanel( + condition = "input.tabs_compare_props == 'Plot'", + selectizeInput( + inputId = "cp_plots", label = i18n$t("Select plots:"), + choices = cp_plots, + selected = state_multiple("cp_plots", cp_plots, "bar"), + multiple = TRUE, + options = list(placeholder = i18n$t("Select plots"), plugins = list("remove_button", "drag_drop")) + ) + ) + ), + help_and_report( + modal_title = i18n$t("Compare proportions"), + fun_name = "compare_props", + help_file = inclMD(file.path(getOption("radiant.path.basics"), "app/tools/help/compare_props.md")) + ) + ) +}) + +cp_plot <- reactive({ + list(plot_width = 650, plot_height = 400 * max(length(input$cp_plots), 1)) +}) + +cp_plot_width <- function() { + cp_plot() %>% + (function(x) if (is.list(x)) x$plot_width else 650) +} + +cp_plot_height <- function() { + cp_plot() %>% + (function(x) if (is.list(x)) x$plot_height else 400) +} + +# output is called from the main radiant ui.R +output$compare_props <- renderUI({ + register_print_output("summary_compare_props", ".summary_compare_props", ) + register_plot_output( + "plot_compare_props", ".plot_compare_props", + height_fun = "cp_plot_height" + ) + + # two separate tabs + cp_output_panels <- tabsetPanel( + id = "tabs_compare_props", + tabPanel(i18n$t("Summary"), value = "Summary", verbatimTextOutput("summary_compare_props")), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_compare_props"), + plotOutput("plot_compare_props", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Basics > Proportions"), + tool = i18n$t("Compare proportions"), + tool_ui = "ui_compare_props", + output_panels = cp_output_panels + ) +}) + +cp_available <- reactive({ + if (not_available(input$cp_var1) || not_available(input$cp_var2)) { + i18n$t("This analysis requires two categorical variables. The first must have\ntwo or more levels. The second can have only two levels. If these\nvariable types are not available please select another dataset.\n\n") %>% suggest_data("titanic") + } else if (input$cp_var1 %in% input$cp_var2) { + " " + } else { + "available" + } +}) + +.compare_props <- reactive({ + cpi <- cp_inputs() + cpi$envir <- r_data + do.call(compare_props, cpi) +}) + +.summary_compare_props <- reactive({ + if (cp_available() != "available") { + return(cp_available()) + } + if (input$cp_show) summary(.compare_props(), show = TRUE) else summary(.compare_props()) +}) + +.plot_compare_props <- reactive({ + if (cp_available() != "available") { + return(cp_available()) + } + validate(need(input$cp_plots, i18n$t("Nothing to plot. Please select a plot type"))) + withProgress(message = i18n$t("Generating plots"), value = 1, { + plot(.compare_props(), plots = input$cp_plots, shiny = TRUE) + }) +}) + +compare_props_report <- function() { + if (is.empty(input$cp_var1) || is.empty(input$cp_var2)) { + return(invisible()) + } + figs <- FALSE + outputs <- c("summary") + inp_out <- list(list(show = input$cp_show), "") + if (length(input$cp_plots) > 0) { + outputs <- c("summary", "plot") + inp_out[[2]] <- list(plots = input$cp_plots, custom = FALSE) + figs <- TRUE + } + + update_report( + inp_main = clean_args(cp_inputs(), cp_args), + fun_name = "compare_props", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = cp_plot_width(), + fig.height = cp_plot_height() + ) +} + +download_handler( + id = "dlp_compare_props", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_compare_props"), + type = "png", + caption = i18n$t("Save compare proportions plot"), + plot = .plot_compare_props, + width = cp_plot_width, + height = cp_plot_height +) + +observeEvent(input$compare_props_report, { + r_info[["latest_screenshot"]] <- NULL + compare_props_report() +}) + +observeEvent(input$compare_props_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_compare_props_screenshot") +}) + +observeEvent(input$modal_compare_props_screenshot, { + compare_props_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.basics/inst/app/tools/analysis/correlation_ui.R b/radiant.basics/inst/app/tools/analysis/correlation_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..89417d747800f92868710e3152439645f13230d5 --- /dev/null +++ b/radiant.basics/inst/app/tools/analysis/correlation_ui.R @@ -0,0 +1,330 @@ +############################### +## Correlation +############################### +cor_method <- c( + "pearson", + "spearman", + "kendall" +) %>% setNames(c( + i18n$t("Pearson"), + i18n$t("Spearman"), + i18n$t("Kendall") +)) +## list of function arguments +cor_args <- as.list(formals(correlation)) + +## list of function inputs selected by user +cor_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + cor_args$data_filter <- if (input$show_filter) input$data_filter else "" + cor_args$dataset <- input$dataset + for (i in r_drop(names(cor_args))) { + cor_args[[i]] <- input[[paste0("cor_", i)]] + } + cor_args +}) + +output$ui_cor_method <- renderUI({ + if (isTRUE(input$cor_hcor)) { + cor_method <- c("pearson") %>% + setNames(c(i18n$t("Pearson"))) + } + selectInput( + "cor_method", i18n$t("Method:"), + choices = cor_method, + selected = state_single("cor_method", cor_method, "pearson"), + multiple = FALSE + ) +}) + +cor_sum_args <- as.list(if (exists("summary.correlation")) { + formals(summary.correlation) +} else { + formals(radiant.basics::summary.correlation) +}) + +## list of function inputs selected by user +cor_sum_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(cor_sum_args)) { + cor_sum_args[[i]] <- input[[paste0("cor_", i)]] + } + cor_sum_args +}) + +output$ui_cor_vars <- renderUI({ + withProgress(message = i18n$t("Acquiring variable information"), value = 1, { + vars <- varnames() + toSelect <- .get_class() %in% c("numeric", "integer", "date", "factor") + vars <- vars[toSelect] + }) + if (length(vars) == 0) { + return() + } + selectInput( + inputId = "cor_vars", label = i18n$t("Select variables:"), + choices = vars, + selected = state_multiple("cor_vars", vars, isolate(input$cor_vars)), + multiple = TRUE, + size = min(10, length(vars)), + selectize = FALSE + ) +}) + +output$ui_cor_nrobs <- renderUI({ + nrobs <- nrow(.get_data()) + choices <- c("1,000" = 1000, "5,000" = 5000, "10,000" = 10000, "All" = -1) %>% + .[. < nrobs] + selectInput( + "cor_nrobs", i18n$t("Number of data points plotted:"), + choices = choices, + selected = state_single("cor_nrobs", choices, 1000) + ) +}) + +output$ui_cor_name <- renderUI({ + req(input$dataset) + textInput("cor_name", i18n$t("Store as data.frame:"), "", placeholder = "Provide a name") +}) + +## add a spinning refresh icon if correlations need to be (re)calculated +run_refresh(cor_args, "cor", init = "vars", tabs = "tabs_correlation", label = i18n$t("Calculate correlation"), relabel = i18n$t("Re-calculate correlations")) + +output$ui_correlation <- renderUI({ + req(input$dataset) + tagList( + conditionalPanel( + condition = "input.tabs_correlation == 'Summary'", + wellPanel( + actionButton("cor_run", i18n$t("Calculate correlation"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ) + ), + wellPanel( + conditionalPanel( + condition = "input.tabs_correlation == 'Summary'", + uiOutput("ui_cor_vars"), + uiOutput("ui_cor_method"), + checkboxInput("cor_hcor", i18n$t("Adjust for {factor} variables"), value = state_init("cor_hcor", FALSE)), + conditionalPanel( + condition = "input.cor_hcor == true", + checkboxInput("cor_hcor_se", i18n$t("Calculate adjusted p.values"), value = state_init("cor_hcor_se", FALSE)) + ), + numericInput( + "cor_cutoff", i18n$t("Correlation cutoff:"), + min = 0, max = 1, step = 0.05, + value = state_init("cor_cutoff", 0) + ), + conditionalPanel( + condition = "input.cor_hcor == false", + checkboxInput( + "cor_covar", i18n$t("Show covariance matrix"), + value = state_init("cor_covar", FALSE) + ) + ), + ), + conditionalPanel( + condition = "input.tabs_correlation == 'Plot'", + uiOutput("ui_cor_nrobs") + ) + ), + conditionalPanel( + condition = "input.tabs_correlation == 'Summary'", + wellPanel( + tags$table( + tags$td(uiOutput("ui_cor_name")), + tags$td(actionButton("cor_store", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ) + ), + help_and_report( + modal_title = i18n$t("Correlation"), + fun_name = "correlation", + help_file = inclMD(file.path(getOption("radiant.path.basics"), "app/tools/help/correlation.md")) + ) + ) +}) + +observeEvent(input$cor_hcor, { + if (input$cor_hcor == FALSE) { + updateCheckboxInput(session, "cor_hcor_se", value = FALSE) + } else { + updateCheckboxInput(session, "cor_covar", value = FALSE) + } +}) + +cor_plot <- reactive({ + max(2, length(input$cor_vars)) %>% + (function(x) list(plot_width = 400 + 75 * x, plot_height = 400 + 75 * x)) +}) + +cor_plot_width <- function() { + cor_plot() %>% + (function(x) if (is.list(x)) x$plot_width else 650) +} + +cor_plot_height <- function() { + cor_plot() %>% + (function(x) if (is.list(x)) x$plot_height else 650) +} + +## output is called from the main radiant ui.R +output$correlation <- renderUI({ + register_print_output("summary_correlation", ".summary_correlation") + register_plot_output( + "plot_correlation", ".plot_correlation", + height_fun = "cor_plot_height", + width_fun = "cor_plot_width" + ) + + ## two separate tabs + cor_output_panels <- tabsetPanel( + id = "tabs_correlation", + tabPanel(i18n$t("Summary"), value = "Summary", verbatimTextOutput("summary_correlation")), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_correlation"), + plotOutput( + "plot_correlation", + width = "100%", + height = "100%" + ) + ) + ) + + stat_tab_panel( + menu = i18n$t("Basics > Tables"), + tool = i18n$t("Correlation"), + tool_ui = "ui_correlation", + output_panels = cor_output_panels + ) +}) + +cor_available <- reactive({ + if (not_available(input$cor_vars) || length(input$cor_vars) < 2) { + return(i18n$t("This analysis requires two or more variables or type numeric,\ninteger,or date. If these variable types are not available\nplease select another dataset.\n\n") %>% suggest_data("salary")) + } + "available" +}) + +# .correlation <- reactive({ +.correlation <- eventReactive(input$cor_run, { + cori <- cor_inputs() + cori$envir <- r_data + do.call(correlation, cori) +}) + +.summary_correlation <- reactive({ + if (cor_available() != "available") { + return(cor_available()) + } + if (not_pressed(input$cor_run)) { + return(i18n$t("** Press the Calculate correlation button to generate output **")) + } + validate( + need( + input$cor_cutoff >= 0 && input$cor_cutoff <= 1, + i18n$t("Provide a correlation cutoff value in the range from 0 to 1") + ) + ) + withProgress(message = i18n$t("Calculating correlations"), value = 0.5, { + do.call(summary, c(list(object = .correlation()), cor_sum_inputs())) + }) +}) + +.plot_correlation <- reactive({ + if (cor_available() != "available") { + return(cor_available()) + } + if (not_pressed(input$cor_run)) { + return(i18n$t("** Press the Calculate correlation button to generate output **")) + } + req(input$cor_nrobs) + withProgress(message = i18n$t("Generating correlation plot"), value = 0.5, { + capture_plot(plot(.correlation(), nrobs = input$cor_nrobs)) + }) +}) + +correlation_report <- function() { + if (length(input$cor_vars) < 2) { + return(invisible()) + } + inp_out <- list("", "") + nrobs <- ifelse(is.empty(input$cor_nrobs), 1000, as_integer(input$cor_nrobs)) + inp_out[[1]] <- clean_args(cor_sum_inputs(), cor_sum_args[-1]) + inp_out[[2]] <- list(nrobs = nrobs) + + if (!is.empty(input$cor_name)) { + dataset <- fix_names(input$cor_name) + if (input$cor_name != dataset) { + updateTextInput(session, inputId = "cor_name", value = dataset) + } + xcmd <- paste0(dataset, " <- cor2df(result)\nregister(\"", dataset, "\", descr = result$descr)") + } else { + xcmd <- "" + } + + update_report( + inp_main = clean_args(cor_inputs(), cor_args), + fun_name = "correlation", + inp_out = inp_out, + fig.width = cor_plot_width(), + fig.height = cor_plot_height(), + xcmd = xcmd + ) +} + +download_handler( + id = "dlp_correlation", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_correlation"), + type = "png", + caption = i18n$t("Save correlation plot"), + plot = .plot_correlation, + width = cor_plot_width, + height = cor_plot_height +) + +observeEvent(input$cor_store, { + req(input$cor_name) + cmat <- try(.correlation(), silent = TRUE) + if (inherits(cmat, "try-error") || is.null(cmat)) { + return() + } + + dataset <- fix_names(input$cor_name) + updateTextInput(session, inputId = "cor_name", value = dataset) + r_data[[dataset]] <- cor2df(cmat) + register(dataset, descr = cmat$descr) + updateSelectInput(session, "dataset", selected = input$dataset) + + ## See https://shiny.posit.co//reference/shiny/latest/modalDialog.html + showModal( + modalDialog( + title = i18n$t("Data Stored"), + span( + i18n$t( + "Dataset '{dataset}' was successfully added to the datasets dropdown. Add code to Report > Rmd or Report > R to (re)create the results by clicking the report icon on the bottom left of your screen.", + dataset = dataset + ) + ), + footer = modalButton(i18n$t("OK")), + size = "s", + easyClose = TRUE + ) + ) +}) + +observeEvent(input$correlation_report, { + r_info[["latest_screenshot"]] <- NULL + correlation_report() +}) + +observeEvent(input$correlation_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_correlation_screenshot") +}) + +observeEvent(input$modal_correlation_screenshot, { + correlation_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.basics/inst/app/tools/analysis/cross_tabs_ui.R b/radiant.basics/inst/app/tools/analysis/cross_tabs_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..b349d232b44e881711c0d8a8f91f0cee62284958 --- /dev/null +++ b/radiant.basics/inst/app/tools/analysis/cross_tabs_ui.R @@ -0,0 +1,211 @@ +## alternative hypothesis options +ct_check <- c( + "observed", + "expected", + "chi_sq", + "dev_std", + "row_perc", + "col_perc", + "perc" +) + +names(ct_check) <- c( + i18n$t("Observed"), + i18n$t("Expected"), + i18n$t("Chi-squared"), + i18n$t("Deviation std."), + i18n$t("Row percentages"), + i18n$t("Column percentages"), + i18n$t("Table percentages") +) + +## list of function arguments +ct_args <- as.list(formals(cross_tabs)) + +## list of function inputs selected by user +ct_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + ct_args$data_filter <- if (input$show_filter) input$data_filter else "" + ct_args$dataset <- input$dataset + for (i in r_drop(names(ct_args))) { + ct_args[[i]] <- input[[paste0("ct_", i)]] + } + ct_args +}) + +############################### +# Cross-tabs +############################### +output$ui_ct_var1 <- renderUI({ + vars <- c("None" = "", groupable_vars()) + selectInput( + inputId = "ct_var1", label = i18n$t("Select a categorical variable:"), + choices = vars, selected = state_single("ct_var1", vars), multiple = FALSE + ) +}) + +output$ui_ct_var2 <- renderUI({ + if (not_available(input$ct_var1)) { + return() + } + vars <- c("None" = "", groupable_vars()) + + if (length(vars) > 0) vars <- vars[-which(vars == input$ct_var1)] + selectInput( + inputId = "ct_var2", label = i18n$t("Select a categorical variable:"), + selected = state_single("ct_var2", vars), + choices = vars, multiple = FALSE + ) +}) + +output$ui_cross_tabs <- renderUI({ + req(input$dataset) + tagList( + wellPanel( + conditionalPanel( + condition = "input.tabs_cross_tabs == 'Summary'", + uiOutput("ui_ct_var1"), + uiOutput("ui_ct_var2") + ), + br(), + checkboxGroupInput( + "ct_check", NULL, + choices = ct_check, + selected = state_group("ct_check"), + inline = FALSE + ) + ), + help_and_report( + modal_title = i18n$t("Cross-tabs"), + fun_name = "cross_tabs", + help_file = inclMD(file.path(getOption("radiant.path.basics"), "app/tools/help/cross_tabs.md")) + ) + ) +}) + +ct_plot <- reactive({ + list(plot_width = 650, plot_height = 400 * max(length(input$ct_check), 1)) +}) + +ct_plot_width <- function() { + ct_plot() %>% + (function(x) if (is.list(x)) x$plot_width else 650) +} + +ct_plot_height <- function() { + ct_plot() %>% + (function(x) if (is.list(x)) x$plot_height else 400) +} + +## output is called from the main radiant ui.R +output$cross_tabs <- renderUI({ + register_print_output("summary_cross_tabs", ".summary_cross_tabs") + register_plot_output( + "plot_cross_tabs", ".plot_cross_tabs", + height_fun = "ct_plot_height", + width_fun = "ct_plot_width" + ) + + ## two separate tabs + ct_output_panels <- tabsetPanel( + id = "tabs_cross_tabs", + tabPanel(i18n$t("Summary"), value = "Summary", verbatimTextOutput("summary_cross_tabs")), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_cross_tabs"), + plotOutput("plot_cross_tabs", width = "100%", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Basics > Tables"), + tool = i18n$t("Cross-tabs"), + tool_ui = "ui_cross_tabs", + output_panels = ct_output_panels + ) +}) + +ct_available <- reactive({ + if (not_available(input$ct_var1) || not_available(input$ct_var2)) { + i18n$t("This analysis requires two categorical variables. Both must have two or more levels.\nIf these variable types are not available please select another dataset.\n\n") %>% + suggest_data("newspaper") + } else { + "available" + } +}) + +.cross_tabs <- reactive({ + cti <- ct_inputs() + cti$envir <- r_data + do.call(cross_tabs, cti) +}) + +.summary_cross_tabs <- reactive({ + if (ct_available() != "available") { + return(ct_available()) + } + summary(.cross_tabs(), check = input$ct_check) +}) + +.plot_cross_tabs <- reactive({ + if (ct_available() != "available") { + return(ct_available()) + } + validate(need(input$ct_check, i18n$t("Nothing to plot. Please select a plot type"))) + withProgress(message = i18n$t("Generating plots"), value = 1, { + plot(.cross_tabs(), check = input$ct_check, shiny = TRUE) + }) +}) + +cross_tabs_report <- function() { + if (is.empty(input$ct_var1) || is.empty(input$ct_var2)) { + return(invisible()) + } + inp_out <- list("", "") + if (length(input$ct_check) > 0) { + outputs <- c("summary", "plot") + inp_out[[1]] <- list(check = input$ct_check) + inp_out[[2]] <- list(check = input$ct_check, custom = FALSE) + figs <- TRUE + } else { + outputs <- "summary" + inp_out[[1]] <- list(check = "") + figs <- FALSE + } + + update_report( + inp_main = clean_args(ct_inputs(), ct_args), + inp_out = inp_out, + fun_name = "cross_tabs", + outputs = outputs, + figs = figs, + fig.width = ct_plot_width(), + fig.height = ct_plot_height() + ) +} + +download_handler( + id = "dlp_cross_tabs", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_cross_tabs"), + type = "png", + caption = i18n$t("Save cross-tabs plot"), + plot = .plot_cross_tabs, + width = ct_plot_width, + height = ct_plot_height +) + +observeEvent(input$cross_tabs_report, { + r_info[["latest_screenshot"]] <- NULL + cross_tabs_report() +}) + +observeEvent(input$cross_tabs_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_cross_tabs_screenshot") +}) + +observeEvent(input$modal_cross_tabs_screenshot, { + cross_tabs_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.basics/inst/app/tools/analysis/goodness_ui.R b/radiant.basics/inst/app/tools/analysis/goodness_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..66723f09e901e95a16d4585dfe7e99d9532b6dae --- /dev/null +++ b/radiant.basics/inst/app/tools/analysis/goodness_ui.R @@ -0,0 +1,197 @@ +## alternative hypothesis options +gd_check <- c("observed", "expected", "chi_sq", "dev_std") +names(gd_check) <- c( + i18n$t("Observed"), + i18n$t("Expected"), + i18n$t("Chi-squared"), + i18n$t("Deviation std.") +) + +## list of function arguments +gd_args <- as.list(formals(goodness)) + +## list of function inputs selected by user +gd_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + gd_args$data_filter <- if (input$show_filter) input$data_filter else "" + gd_args$dataset <- input$dataset + for (i in r_drop(names(gd_args))) { + gd_args[[i]] <- input[[paste0("gd_", i)]] + } + gd_args +}) + +############################### +# Goodness of fit test +############################### +output$ui_gd_var <- renderUI({ + vars <- c("None" = "", groupable_vars()) + selectInput( + "gd_var", i18n$t("Select a categorical variable:"), + choices = vars, + selected = state_single("gd_var", vars), + multiple = FALSE + ) +}) + +output$ui_gd_p <- renderUI({ + req(input$gd_var) + returnTextInput( + "gd_p", i18n$t("Probabilities:"), + value = state_init("gd_p", ""), + placeholder = i18n$t("Enter probabilities (e.g., 1/2 1/2)") + ) +}) + +output$ui_goodness <- renderUI({ + req(input$dataset) + tagList( + wellPanel( + conditionalPanel( + condition = "input.tabs_goodness == 'Summary'", + uiOutput("ui_gd_var"), + uiOutput("ui_gd_p"), + br() + ), + checkboxGroupInput( + "gd_check", NULL, + choices = gd_check, + selected = state_group("gd_check"), + inline = FALSE + ) + ), + help_and_report( + modal_title = i18n$t("Goodness of fit"), + fun_name = "goodness", + help_file = inclMD(file.path(getOption("radiant.path.basics"), "app/tools/help/goodness.md")) + ) + ) +}) + +gd_plot <- reactive({ + list(plot_width = 650, plot_height = 400 * max(length(input$gd_check), 1)) +}) + +gd_plot_width <- function() { + gd_plot() %>% + (function(x) if (is.list(x)) x$plot_width else 650) +} + +gd_plot_height <- function() { + gd_plot() %>% + (function(x) if (is.list(x)) x$plot_height else 400) +} + +## output is called from the main radiant ui.R +output$goodness <- renderUI({ + register_print_output("summary_goodness", ".summary_goodness") + register_plot_output( + "plot_goodness", ".plot_goodness", + height_fun = "gd_plot_height", + width_fun = "gd_plot_width" + ) + + ## two separate tabs + gd_output_panels <- tabsetPanel( + id = "tabs_goodness", + tabPanel(i18n$t("Summary"), value = "Summary", verbatimTextOutput("summary_goodness")), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_goodness"), + plotOutput("plot_goodness", width = "100%", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Basics > Tables"), + tool = i18n$t("Goodness of fit"), + tool_ui = "ui_goodness", + output_panels = gd_output_panels + ) +}) + +gd_available <- reactive({ + if (not_available(input$gd_var)) { + i18n$t("This analysis requires a categorical variables with two or more levels.\nIf such a variable type is not available please select another dataset.\n\n") %>% suggest_data("newspaper") + } else { + "available" + } +}) + +.goodness <- reactive({ + gdi <- gd_inputs() + gdi$envir <- r_data + do.call(goodness, gdi) +}) + +.summary_goodness <- reactive({ + if (gd_available() != "available") { + return(gd_available()) + } + summary(.goodness(), check = input$gd_check) +}) + +.plot_goodness <- reactive({ + if (gd_available() != "available") { + return(gd_available()) + } + validate(need(input$gd_check, i18n$t("Nothing to plot. Please select a plot type"))) + withProgress(message = i18n$t("Generating plots"), value = 1, { + plot(.goodness(), check = input$gd_check, shiny = TRUE) + }) +}) + +goodness_report <- function() { + if (is.empty(input$gd_var)) { + return(invisible()) + } + inp_out <- list("", "") + if (length(input$gd_check) > 0) { + outputs <- c("summary", "plot") + inp_out[[1]] <- list(check = input$gd_check) + inp_out[[2]] <- list(check = input$gd_check, custom = FALSE) + figs <- TRUE + } else { + outputs <- "summary" + figs <- FALSE + } + + gdi <- gd_inputs() + gdi$p <- radiant.data::make_vec(gdi$p) + + update_report( + inp_main = clean_args(gdi, gd_args), + inp_out = inp_out, + fun_name = "goodness", + outputs = outputs, + figs = figs, + fig.width = gd_plot_width(), + fig.height = gd_plot_height() + ) +} + +download_handler( + id = "dlp_goodness", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_goodness"), + type = "png", + caption = i18n$t("Save goodness of fit plot"), + plot = .plot_goodness, + width = gd_plot_width, + height = gd_plot_height +) + +observeEvent(input$goodness_report, { + r_info[["latest_screenshot"]] <- NULL + goodness_report() +}) + +observeEvent(input$goodness_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_goodness_screenshot") +}) + +observeEvent(input$modal_goodness_screenshot, { + goodness_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.basics/inst/app/tools/analysis/homo_variance_test_ui.R b/radiant.basics/inst/app/tools/analysis/homo_variance_test_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..7a400fd1c78ec4adb3dea18b99ac2c19f5d20d82 --- /dev/null +++ b/radiant.basics/inst/app/tools/analysis/homo_variance_test_ui.R @@ -0,0 +1,190 @@ +############################################ +## Homogeneity of variance test - ui +############################################ + +## 1. 翻译标签 +hv_method <- c("levene", "bartlett", "fligner") +names(hv_method) <- c(i18n$t("Levene"), + i18n$t("Bartlett"), + i18n$t("Fligner")) + +hv_plots <- c("hist", "density", "boxplot") +names(hv_plots) <- c(i18n$t("Histogram"), + i18n$t("Density"), + i18n$t("Boxplot")) + +## 2. 函数形参 +hv_args <- as.list(formals(homo_variance_test)) + +## 3. 收集输入 +hv_inputs <- reactive({ + hv_args$data_filter <- if (input$show_filter) input$data_filter else "" + hv_args$dataset <- input$dataset + for (i in r_drop(names(hv_args))) { + hv_args[[i]] <- input[[paste0("hv_", i)]] + } + hv_args +}) + +## 4. 变量选择（numeric + grouping） +output$ui_hv_var <- renderUI({ + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- c("None" = "", varnames()[isNum]) + selectInput( + inputId = "hv_var", label = i18n$t("Variable (select one):"), + choices = vars, selected = state_single("hv_var", vars), multiple = FALSE + ) +}) + +output$ui_hv_group <- renderUI({ + vars <- groupable_vars() + selectInput( + inputId = "hv_group", label = i18n$t("Grouping variable:"), + choices = vars, selected = state_single("hv_group", vars), multiple = FALSE + ) +}) + +## 5. 主 UI +output$ui_homo_variance_test <- renderUI({ + req(input$dataset) + tagList( + wellPanel( + conditionalPanel( + condition = "input.tabs_homo_variance_test == 'Summary'", + uiOutput("ui_hv_var"), + uiOutput("ui_hv_group"), + selectInput( + inputId = "hv_method", label = i18n$t("Test method:"), + choices = hv_method, + selected = state_single("hv_method", hv_method, "levene"), + multiple = FALSE + ), + sliderInput( + "hv_conf_lev", i18n$t("Confidence level:"), + min = 0.85, max = 0.99, + value = state_init("hv_conf_lev", 0.95), step = 0.01 + ) + ), + conditionalPanel( + condition = "input.tabs_homo_variance_test == 'Plot'", + selectizeInput( + inputId = "hv_plots", label = i18n$t("Select plots:"), + choices = hv_plots, + selected = state_multiple("hv_plots", hv_plots, "boxplot"), + multiple = TRUE, + options = list(placeholder = i18n$t("Select plots"), + plugins = list("remove_button", "drag_drop")) + ) + ) + ), + help_and_report( + modal_title = i18n$t("Homogeneity of variance test"), + fun_name = "homo_variance_test", + help_file = inclMD(file.path(getOption("radiant.path.basics"), + "app/tools/help/homo_variance_test.md")) + ) + ) +}) + +## 6. 画图尺寸 +hv_plot <- reactive({ + list(plot_width = 650, + plot_height = 400 * max(length(input$hv_plots), 1)) +}) +hv_plot_width <- function() hv_plot()$plot_width +hv_plot_height <- function() hv_plot()$plot_height + +## 7. 输出面板 +output$homo_variance_test <- renderUI({ + register_print_output("summary_homo_variance_test", ".summary_homo_variance_test") + register_plot_output("plot_homo_variance_test", ".plot_homo_variance_test", + height_fun = "hv_plot_height") + + hv_output_panels <- tabsetPanel( + id = "tabs_homo_variance_test", + tabPanel(title = i18n$t("Summary"), + value = "Summary", + verbatimTextOutput("summary_homo_variance_test")), + tabPanel(title = i18n$t("Plot"), + value = "Plot", + download_link("dlp_homo_variance_test"), + plotOutput("plot_homo_variance_test", height = "100%")) + ) + + stat_tab_panel( + menu = i18n$t("Basics > Homogeneity"), + tool = i18n$t("Homogeneity of variance test"), + tool_ui = "ui_homo_variance_test", + output_panels = hv_output_panels + ) +}) + +## 8. 可用性检查 +hv_available <- reactive({ + if (not_available(input$hv_var)) + return(i18n$t("This analysis requires a numeric variable. If none are\navailable please select another dataset.") %>% suggest_data("demand_uk")) + if (not_available(input$hv_group)) + return(i18n$t("Please select a grouping variable.")) + "available" +}) + +## 9. 计算核心 +.homo_variance_test <- reactive({ + hvi <- hv_inputs() + hvi$envir <- r_data + do.call(homo_variance_test, hvi) +}) + +.summary_homo_variance_test <- reactive({ + if (hv_available() != "available") return(hv_available()) + summary(.homo_variance_test()) +}) + +.plot_homo_variance_test <- reactive({ + if (hv_available() != "available") return(hv_available()) + validate(need(input$hv_plots, i18n$t("Nothing to plot. Please select a plot type"))) + withProgress(message = i18n$t("Generating plots"), value = 1, + plot(.homo_variance_test(), plots = input$hv_plots, shiny = TRUE)) +}) + +## 10. Report +homo_variance_test_report <- function() { + if (is.empty(input$hv_var)) return(invisible()) + figs <- length(input$hv_plots) > 0 + outputs <- if (figs) c("summary", "plot") else "summary" + inp_out <- if (figs) list("", list(plots = input$hv_plots, custom = FALSE)) else list("", "") + update_report(inp_main = clean_args(hv_inputs(), hv_args), + fun_name = "homo_variance_test", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = hv_plot_width(), + fig.height = hv_plot_height()) +} + +## 11. 下载 & 截图 +download_handler( + id = "dlp_homo_variance_test", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_homo_variance_test"), + type = "png", + caption = i18n$t("Save homogeneity of variance plot"), + plot = .plot_homo_variance_test, + width = hv_plot_width, + height = hv_plot_height +) + +observeEvent(input$homo_variance_test_report, { + r_info[["latest_screenshot"]] <- NULL + homo_variance_test_report() +}) + +observeEvent(input$homo_variance_test_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_homo_variance_test_screenshot") +}) + +observeEvent(input$modal_homo_variance_test_screenshot, { + homo_variance_test_report() + removeModal() +}) diff --git a/radiant.basics/inst/app/tools/analysis/normality_test_ui.R b/radiant.basics/inst/app/tools/analysis/normality_test_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..b22ad9aaab3acebc8c332718551cc55d3a859337 --- /dev/null +++ b/radiant.basics/inst/app/tools/analysis/normality_test_ui.R @@ -0,0 +1,181 @@ +############################################ +## Normality test - ui +############################################ + +## 1. 翻译标签 +nt_method <- c("shapiro", "ks", "ad") # 先给 3 个常用方法 +names(nt_method) <- c(i18n$t("Shapiro-Wilk"), + i18n$t("Kolmogorov-Smirnov"), + i18n$t("Anderson-Darling")) + +nt_plots <- c("qq", "hist", "pp", "density") +names(nt_plots) <- c(i18n$t("Q-Q plot"), + i18n$t("Histogram"), + i18n$t("P-P plot"), + i18n$t("Density")) + +## 2. 函数形参 +nt_args <- as.list(formals(normality_test)) + +## 3. 收集输入 +nt_inputs <- reactive({ + nt_args$data_filter <- if (input$show_filter) input$data_filter else "" + nt_args$dataset <- input$dataset + for (i in r_drop(names(nt_args))) { + nt_args[[i]] <- input[[paste0("nt_", i)]] + } + nt_args +}) + +## 4. 变量选择（仅 numeric） +output$ui_nt_var <- renderUI({ + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- c("None" = "", varnames()[isNum]) + selectInput( + inputId = "nt_var", label = i18n$t("Variable (select one):"), + choices = vars, selected = state_single("nt_var", vars), multiple = FALSE + ) +}) + +## 5. 主 UI +output$ui_normality_test <- renderUI({ + req(input$dataset) + tagList( + wellPanel( + conditionalPanel( + condition = "input.tabs_normality_test == 'Summary'", + uiOutput("ui_nt_var"), + selectInput( + inputId = "nt_method", label = i18n$t("Test method:"), + choices = nt_method, + selected = state_single("nt_method", nt_method, "shapiro"), + multiple = FALSE + ), + sliderInput( + "nt_conf_lev", i18n$t("Confidence level:"), + min = 0.85, max = 0.99, + value = state_init("nt_conf_lev", 0.95), step = 0.01 + ) + ), + conditionalPanel( + condition = "input.tabs_normality_test == 'Plot'", + selectizeInput( + inputId = "nt_plots", label = i18n$t("Select plots:"), + choices = nt_plots, + selected = state_multiple("nt_plots", nt_plots, "qq"), + multiple = TRUE, + options = list(placeholder = i18n$t("Select plots"), + plugins = list("remove_button", "drag_drop")) + ) + ) + ), + help_and_report( + modal_title = i18n$t("Normality test"), + fun_name = "normality_test", + help_file = inclMD(file.path(getOption("radiant.path.basics"), + "app/tools/help/normality_test.md")) + ) + ) +}) + +## 6. 画图尺寸（直接抄） +nt_plot <- reactive({ + list(plot_width = 650, + plot_height = 400 * max(length(input$nt_plots), 1)) +}) +nt_plot_width <- function() nt_plot()$plot_width +nt_plot_height <- function() nt_plot()$plot_height + + +## 7. 输出面板 +output$normality_test <- renderUI({ + register_print_output("summary_normality_test", ".summary_normality_test") + register_plot_output("plot_normality_test", ".plot_normality_test", + height_fun = "nt_plot_height") + + nt_output_panels <- tabsetPanel( + id = "tabs_normality_test", + tabPanel(title = i18n$t("Summary"), + value = "Summary", + verbatimTextOutput("summary_normality_test")), + tabPanel(title = i18n$t("Plot"), + value = "Plot", + download_link("dlp_normality_test"), + plotOutput("plot_normality_test", height = "100%")) + ) + + stat_tab_panel( + menu = i18n$t("Basics > Normality"), + tool = i18n$t("Normality test"), + tool_ui = "ui_normality_test", + output_panels = nt_output_panels + ) +}) + +## 8. 可用性检查 +nt_available <- reactive({ + if (not_available(input$nt_var)) + return(i18n$t("This analysis requires a numeric variable. If none are\navailable please select another dataset.") %>% suggest_data("demand_uk")) + "available" +}) + +## 9. 计算核心 +.normality_test <- reactive({ + nti <- nt_inputs() + nti$envir <- r_data + do.call(normality_test, nti) +}) + +.summary_normality_test <- reactive({ + if (nt_available() != "available") return(nt_available()) + summary(.normality_test()) +}) + +.plot_normality_test <- reactive({ + if (nt_available() != "available") return(nt_available()) + validate(need(input$nt_plots, i18n$t("Nothing to plot. Please select a plot type"))) + withProgress(message = i18n$t("Generating plots"), value = 1, + plot(.normality_test(), plots = input$nt_plots, shiny = TRUE)) +}) + +## 10. Report +normality_test_report <- function() { + if (is.empty(input$nt_var)) return(invisible()) + figs <- length(input$nt_plots) > 0 + outputs <- if (figs) c("summary", "plot") else "summary" + inp_out <- if (figs) list("", list(plots = input$nt_plots, custom = FALSE)) else list("", "") + update_report(inp_main = clean_args(nt_inputs(), nt_args), + fun_name = "normality_test", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = nt_plot_width(), + fig.height = nt_plot_height()) +} + +## 11. 下载 & 截图 +download_handler( + id = "dlp_normality_test", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_normality_test"), + type = "png", + caption = i18n$t("Save normality test plot"), + plot = .plot_normality_test, + width = nt_plot_width, + height = nt_plot_height +) + +observeEvent(input$normality_test_report, { + r_info[["latest_screenshot"]] <- NULL + normality_test_report() +}) + +observeEvent(input$normality_test_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_normality_test_screenshot") +}) + +observeEvent(input$modal_normality_test_screenshot, { + normality_test_report() + removeModal() +}) \ No newline at end of file diff --git a/radiant.basics/inst/app/tools/analysis/prob_calc_ui.R b/radiant.basics/inst/app/tools/analysis/prob_calc_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..a8422981f35e7af5e1154c412b7c9b539b36a341 --- /dev/null +++ b/radiant.basics/inst/app/tools/analysis/prob_calc_ui.R @@ -0,0 +1,572 @@ +pc_dist <- c("binom", "chisq", "disc", "expo", "fdist", "lnorm", "norm", "pois", "tdist", "unif") +names(pc_dist) <- c( + i18n$t("Binomial"), i18n$t("Chi-squared"), i18n$t("Discrete"), + i18n$t("Exponential"), i18n$t("F"), i18n$t("Log normal"), + i18n$t("Normal"), i18n$t("Poisson"), i18n$t("t"), i18n$t("Uniform") +) + +pc_type <- c("values", "probs") +names(pc_type) <- c(i18n$t("Values"), i18n$t("Probabilities")) + + +make_pc_values_input <- function(lb, lb_init = NA, ub, ub_init = 0) { + if(!is.empty(r_state[[lb]])) ub_init <- NA + if(!is.empty(r_state[[ub]])) lb_init <- NA + tags$table( + tags$td(numericInput(lb, i18n$t("Lower bound:"), value = state_init(lb, lb_init))), + tags$td(numericInput(ub, i18n$t("Upper bound:"), value = state_init(ub, ub_init))) + ) +} + +make_side_by_side <- function(a, b) { + tags$table( + tags$td(a, width="50%"), + tags$td(b, width="50%"), + width="100%" + ) +} + +make_pc_prob_input <- function(lb, lb_init = NA, ub, ub_init = 0.95) { + if(!is.empty(r_state[[lb]])) ub_init <- NA + if(!is.empty(r_state[[ub]])) lb_init <- NA + make_side_by_side( + numericInput( + lb, i18n$t("Lower bound:"), value = state_init(lb, lb_init), + min = 0, max = 1, step = .005 + ), + numericInput( + ub, i18n$t("Upper bound:"), value = state_init(ub, ub_init), + min = 0, max = 1, step = .005 + ) + ) +} + +output$ui_pc_pois <- renderUI({ + numericInput( + "pcp_lambda", i18n$t("Lambda:"), + value = state_init("pcp_lambda", 1), + min = 1 + ) +}) + +output$ui_pc_input_pois <- renderUI({ + if (input$pc_type == "values") { + make_pc_values_input("pcp_lb", lb_init = NA, "pcp_ub", ub_init = 3) + } else { + make_pc_prob_input("pcp_plb", lb_init = NA, "pcp_pub", ub_init = 0.95) + } +}) + +output$ui_pc_expo <- renderUI({ + numericInput( + "pce_rate", i18n$t("Rate:"), + value = state_init("pce_rate", 1), + min = 0 + ) +}) + +output$ui_pc_input_expo <- renderUI({ + if (input$pc_type == "values") { + make_pc_values_input("pce_lb", lb_init = NA, "pce_ub", ub_init = 2.996) + } else { + make_pc_prob_input("pce_plb", lb_init = NA, "pce_pub", ub_init = 0.95) + } +}) + +output$ui_pc_disc <- renderUI({ + tagList( + returnTextInput( + "pcd_v", i18n$t("Values:"), + value = state_init("pcd_v", "1 2 3 4 5 6") + ), + returnTextInput( + "pcd_p", i18n$t("Probabilities:"), + value = state_init("pcd_p", "1/6") + ) + ) +}) + +output$ui_pc_input_disc <- renderUI({ + if (input$pc_type == "values") { + make_pc_values_input("pcd_lb", lb_init = NA, "pcd_ub", ub_init = 3) + } else { + make_pc_prob_input("pcd_plb", lb_init = NA, "pcd_pub", ub_init = 0.95) + } +}) + +output$ui_pc_fdist <- renderUI({ + tagList( + numericInput( + "pcf_df1", i18n$t("Degrees of freedom 1:"), + value = state_init("pcf_df1", 10), + min = 1 + ), + numericInput( + "pcf_df2", i18n$t("Degrees of freedom 2:"), + value = state_init("pcf_df2", 10), + min = 5 + ) + ) +}) + +output$ui_pc_input_fdist <- renderUI({ + if (input$pc_type == "values") { + make_pc_values_input("pcf_lb", lb_init = NA, "pcf_ub", ub_init = 2.978) + } else { + make_pc_prob_input("pcf_plb", lb_init = NA, "pcf_pub", ub_init = 0.95) + } +}) + +output$ui_pc_chisq <- renderUI({ + numericInput( + "pcc_df", i18n$t("Degrees of freedom:"), + value = state_init("pcc_df", 1), + min = 1 + ) +}) + +output$ui_pc_input_chisq <- renderUI({ + if (input$pc_type == "values") { + make_pc_values_input("pcc_lb", lb_init = NA, "pcc_ub", ub_init = 3.841) + } else { + make_pc_prob_input("pcc_plb", lb_init = NA, "pcc_pub", ub_init = 0.95) + } +}) + +output$ui_pc_tdist <- renderUI({ + numericInput( + "pct_df", i18n$t("Degrees of freedom:"), + value = state_init("pct_df", 10), + min = 3 + ) +}) + +output$ui_pc_input_tdist <- renderUI({ + if (input$pc_type == "values") { + make_pc_values_input("pct_lb", lb_init = -Inf, "pct_ub", ub_init = 2.228) + } else { + make_pc_prob_input("pct_plb", lb_init = 0.025, "pct_pub", ub_init = 0.975) + } +}) + +output$ui_pc_norm <- renderUI({ + make_side_by_side( + numericInput( + "pc_mean", i18n$t("Mean:"), + value = state_init("pc_mean", 0) + ), + numericInput( + "pc_stdev", i18n$t("St. dev:"), + min = 0, + value = state_init("pc_stdev", 1) + ) + ) +}) + +output$ui_pc_input_norm <- renderUI({ + if (input$pc_type == "values") { + make_pc_values_input("pc_lb", lb_init = -Inf, "pc_ub", ub_init = 0) + } else { + make_pc_prob_input("pc_plb", lb_init = 0.025, "pc_pub", ub_init = 0.975) + } +}) + +output$ui_pc_lnorm <- renderUI({ + make_side_by_side( + numericInput( + "pcln_meanlog", i18n$t("Mean log:"), + value = state_init("pcln_meanlog", 0) + ), + numericInput( + "pcln_sdlog", i18n$t("St. dev log:"), + min = 0, + value = state_init("pcln_sdlog", 1) + ) + ) +}) + +output$ui_pc_input_lnorm <- renderUI({ + if (input$pc_type == "values") { + make_pc_values_input("pcln_lb", lb_init = 0, "pcln_ub", ub_init = 1) + } else { + make_pc_prob_input("pcln_plb", lb_init = 0.025, "pcln_pub", ub_init = 0.975) + } +}) + +output$ui_pc_binom <- renderUI({ + make_side_by_side( + numericInput( + "pcb_n", label = i18n$t("n:"), + value = state_init("pcb_n", 10), min = 0 + ), + numericInput( + "pcb_p", i18n$t("p:"), + min = 0, max = 1, step = .005, + value = state_init("pcb_p", .2) + ) + ) +}) + +output$ui_pc_input_binom <- renderUI({ + if (input$pc_type == "values") { + make_pc_values_input("pcb_lb", lb_init = NA, "pcb_ub", ub_init = 3) + } else { + make_pc_prob_input("pcb_plb", lb_init = NA, "pcb_pub", ub_init = 0.3) + } +}) + +output$ui_pc_unif <- renderUI({ + make_side_by_side( + numericInput( + "pcu_min", i18n$t("Min:"), + value = state_init("pcu_min", 0) + ), + numericInput( + "pcu_max", i18n$t("Max:"), + value = state_init("pcu_max", 1) + ) + ) +}) + +output$ui_pc_input_unif <- renderUI({ + if (input$pc_type == "values") { + make_pc_values_input("pcu_lb", lb_init = NA, "pcu_ub", ub_init = 0.3) + } else { + make_pc_prob_input("pcu_plb", lb_init = NA, "pcu_pub", ub_init = 0.3) + } +}) + +output$ui_prob_calc <- renderUI({ + tagList( + wellPanel( + selectInput( + "pc_dist", label = i18n$t("Distribution:"), + choices = pc_dist, + selected = state_init("pc_dist", "norm"), + multiple = FALSE + ), + conditionalPanel( + "input.pc_dist == 'norm'", + uiOutput("ui_pc_norm") + ), + conditionalPanel( + "input.pc_dist == 'lnorm'", + uiOutput("ui_pc_lnorm") + ), + conditionalPanel( + "input.pc_dist == 'binom'", + uiOutput("ui_pc_binom") + ), + conditionalPanel( + "input.pc_dist == 'unif'", + uiOutput("ui_pc_unif") + ), + conditionalPanel( + "input.pc_dist == 'tdist'", + uiOutput("ui_pc_tdist") + ), + conditionalPanel( + "input.pc_dist == 'fdist'", + uiOutput("ui_pc_fdist") + ), + conditionalPanel( + "input.pc_dist == 'chisq'", + uiOutput("ui_pc_chisq") + ), + conditionalPanel( + "input.pc_dist == 'disc'", + uiOutput("ui_pc_disc") + ), + conditionalPanel( + "input.pc_dist == 'expo'", + uiOutput("ui_pc_expo") + ), + conditionalPanel( + "input.pc_dist == 'pois'", + uiOutput("ui_pc_pois") + ) + ), + wellPanel( + radioButtons( + "pc_type", i18n$t("Input type:"), + choices = pc_type, + selected = state_init("pc_type", "values"), + inline = TRUE + ), + conditionalPanel( + "input.pc_dist == 'norm'", + uiOutput("ui_pc_input_norm") + ), + conditionalPanel( + "input.pc_dist == 'lnorm'", + uiOutput("ui_pc_input_lnorm") + ), + conditionalPanel( + "input.pc_dist == 'binom'", + uiOutput("ui_pc_input_binom") + ), + conditionalPanel( + "input.pc_dist == 'unif'", + uiOutput("ui_pc_input_unif") + ), + conditionalPanel( + "input.pc_dist == 'tdist'", + uiOutput("ui_pc_input_tdist") + ), + conditionalPanel( + "input.pc_dist == 'fdist'", + uiOutput("ui_pc_input_fdist") + ), + conditionalPanel( + "input.pc_dist == 'chisq'", + uiOutput("ui_pc_input_chisq") + ), + conditionalPanel( + "input.pc_dist == 'disc'", + uiOutput("ui_pc_input_disc") + ), + conditionalPanel( + "input.pc_dist == 'expo'", + uiOutput("ui_pc_input_expo") + ), + conditionalPanel( + "input.pc_dist == 'pois'", + uiOutput("ui_pc_input_pois") + ), + numericInput( + "pc_dec", i18n$t("Decimals:"), + value = state_init("pc_dec", 3), + min = 0 + ) + ), + help_and_report( + modal_title = i18n$t("Probability calculator"), + fun_name = "prob_calc", + help_file = inclMD(file.path(getOption("radiant.path.basics"), "app/tools/help/prob_calc.md")) + ) + ) +}) + +pc_plot_width <- function() + if (!is.null(input$viz_plot_width)) input$viz_plot_width else 650 + +pc_plot_height <- function() 400 + +pc_args <- reactive({ + pc_dist <- input$pc_dist + if (is.empty(pc_dist) || pc_dist == "norm") { + as.list(formals(prob_norm)) + } else if (pc_dist == "lnorm") { + as.list(formals(prob_lnorm)) + } else if (pc_dist == "binom") { + as.list(formals(prob_binom)) + } else if (pc_dist == "unif") { + as.list(formals(prob_unif)) + } else if (pc_dist == "tdist") { + as.list(formals(prob_tdist)) + } else if (pc_dist == "fdist") { + as.list(formals(prob_fdist)) + } else if (pc_dist == "chisq") { + as.list(formals(prob_chisq)) + } else if (pc_dist == "disc") { + as.list(formals(prob_disc)) + } else if (pc_dist == "expo") { + as.list(formals(prob_expo)) + } else if (pc_dist == "pois") { + as.list(formals(prob_pois)) + } +}) + +## list of function inputs selected by user +pc_inputs <- reactive({ + pc_dist <- input$pc_dist + if (is.empty(pc_dist) || pc_dist == "norm") { + pre <- "pc_" + } else if (pc_dist == "lnorm") { + pre <- "pcln_" + } else if (pc_dist == "binom") { + pre <- "pcb_" + } else if (pc_dist == "unif") { + pre <- "pcu_" + } else if (pc_dist == "tdist") { + pre <- "pct_" + } else if (pc_dist == "fdist") { + pre <- "pcf_" + } else if (pc_dist == "chisq") { + pre <- "pcc_" + } else if (pc_dist == "disc") { + pre <- "pcd_" + } else if (pc_dist == "expo") { + pre <- "pce_" + } else if (pc_dist == "pois") { + pre <- "pcp_" + } + + # loop needed because reactive values don't allow single bracket indexing + args <- pc_args() + for (i in names(args)) + args[[i]] <- input[[paste0(pre, i)]] + + validate( + need( + input$pc_dec, + i18n$t("Provide an integer value for the number of decimal places") + ) + ) + + args[["dec"]] <- input$pc_dec + args +}) + +## output is called from the main radiant ui.R +output$prob_calc <- renderUI({ + register_print_output("summary_prob_calc", ".summary_prob_calc") + register_plot_output( + "plot_prob_calc", ".plot_prob_calc", + height_fun = "pc_plot_height", + width_fun = "pc_plot_width" + ) + + ## two separate tabs + pc_output_panels <- tagList( + tabPanel(i18n$t("Summary"), value = "Summary", verbatimTextOutput("summary_prob_calc")), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_prob_calc"), + plotOutput("plot_prob_calc", width = "100%", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Basics > Probability"), + tool = i18n$t("Probability calculator"), + data = NULL, + tool_ui = "ui_prob_calc", + output_panels = pc_output_panels + ) +}) + +pc_available <- reactive({ + if (is.empty(input$pc_dist) || is.empty(input$pc_type)) { + "" + } else { + a <- "available" + if (input$pc_dist == "norm") { + if (is_not(input$pc_mean) || is_not(input$pc_stdev) || input$pc_stdev <= 0) { + a <- i18n$t("Please provide a mean and standard deviation (> 0)") + } + } else if (input$pc_dist == "lnorm") { + if (is_not(input$pcln_meanlog) || is_not(input$pcln_sdlog) || input$pcln_sdlog <= 0) { + a <- i18n$t("Please provide a mean and standard deviation (> 0)") + } + } else if (input$pc_dist == "binom") { + if (is_not(input$pcb_n) || input$pcb_n < 0 || is_not(input$pcb_p) || input$pcb_p < 0) { + a <- i18n$t("Please provide a value for n (number of trials) and p (probability of success)") + } + } else if (input$pc_dist == "unif") { + if (is_not(input$pcu_min) || is_not(input$pcu_max)) { + a <- i18n$t("Please provide a minimum and a maximum value") + } + } else if (input$pc_dist == "tdist") { + if (is_not(input$pct_df)) { + a <- i18n$t("Please provide a value for the degrees of freedom (> 0)") + } + } else if (input$pc_dist == "fdist") { + if (is_not(input$pcf_df1) || is_not(input$pcf_df2) || input$pcf_df1 < 1 || input$pcf_df2 < 5) { + a <- i18n$t("Please provide a value for Degrees of freedom 1 (> 0)\nand for Degrees of freedom 2 (> 4)") + } + } else if (input$pc_dist == "chisq") { + if (is_not(input$pcc_df)) { + a <- i18n$t("Please provide a value for the degrees of freedom (> 0)") + } + } else if (input$pc_dist == "disc") { + if (is.empty(input$pcd_v) || is.empty(input$pcd_p)) { + a <- i18n$t("Please provide a set of values and probabilities.\nSeparate numbers using spaces (e.g., 1/2 1/2)") + } + } else if (input$pc_dist == "expo") { + if (is_not(input$pce_rate) || input$pce_rate <= 0) { + a <- i18n$t("Please provide a value for the rate (> 0)") + } + } else if (input$pc_dist == "pois") { + if (is_not(input$pcp_lambda) || input$pcp_lambda <= 0) { + a <- i18n$t("Please provide a value for lambda (> 0)") + } + } else { + a <- "" + } + a + } +}) + +.prob_calc <- reactive({ + validate( + need(pc_available() == "available", pc_available()) + ) + do.call(get(paste0("prob_", input$pc_dist)), pc_inputs()) +}) + +.summary_prob_calc <- reactive({ + type <- if (is.empty(input$pc_type)) "values" else input$pc_type + summary(.prob_calc(), type = type) +}) + +.plot_prob_calc <- reactive({ + req(pc_available() == "available") + type <- if (is.empty(input$pc_type)) "values" else input$pc_type + plot(.prob_calc(), type = type) +}) + +prob_calc_report <- function() { + req(input$pc_dist) + type <- input$pc_type + inp <- pc_inputs() + if (!is.null(type) && type == "probs") { + inp_out <- list(type = type) %>% list(., .) + inp[["ub"]] <- inp[["lb"]] <- NA + } else { + inp_out <- list("", "") + inp[["pub"]] <- inp[["plb"]] <- NA + } + + if (input$pc_dist == "disc") { + inp$v <- radiant.data::make_vec(inp$v) + inp$p <- radiant.data::make_vec(inp$p) + } + + outputs <- c("summary", "plot") + update_report( + inp_main = clean_args(inp, pc_args()), + fun_name = paste0("prob_", input$pc_dist), + inp_out = inp_out, + outputs = outputs, + figs = TRUE, + fig.width = pc_plot_width(), + fig.height = pc_plot_height() + ) +} + +download_handler( + id = "dlp_prob_calc", + fun = download_handler_plot, + fn = function() paste0(input$pc_dist, "_prob_calc"), + type = "png", + caption = i18n$t("Save probability calculator plot"), + plot = .plot_prob_calc, + width = pc_plot_width, + height = pc_plot_height +) + +observeEvent(input$prob_calc_report, { + r_info[["latest_screenshot"]] <- NULL + prob_calc_report() +}) + +observeEvent(input$prob_calc_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_prob_calc_screenshot") +}) + +observeEvent(input$modal_prob_calc_screenshot, { + prob_calc_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.basics/inst/app/tools/analysis/single_mean_ui.R b/radiant.basics/inst/app/tools/analysis/single_mean_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..7dd125927abaa2b746519385a0b91b594bcea09e --- /dev/null +++ b/radiant.basics/inst/app/tools/analysis/single_mean_ui.R @@ -0,0 +1,201 @@ +############################### +## Single mean - ui +############################### + +## alternative hypothesis options +sm_alt <- c("two.sided", "less", "greater") +names(sm_alt) <- c(i18n$t("Two sided"), i18n$t("Less than"), i18n$t("Greater than")) + +sm_plots <- c("hist", "simulate") +names(sm_plots) <- c(i18n$t("Histogram"), i18n$t("Simulate")) + +## list of function arguments +sm_args <- as.list(formals(single_mean)) + +## list of function inputs selected by user +sm_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + sm_args$data_filter <- if (input$show_filter) input$data_filter else "" + sm_args$dataset <- input$dataset + for (i in r_drop(names(sm_args))) { + sm_args[[i]] <- input[[paste0("sm_", i)]] + } + sm_args +}) + +output$ui_sm_var <- renderUI({ + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- c("None" = "", varnames()[isNum]) + selectInput( + inputId = "sm_var", label = i18n$t("Variable (select one):"), + choices = vars, selected = state_single("sm_var", vars), multiple = FALSE + ) +}) + +output$ui_single_mean <- renderUI({ + req(input$dataset) + tagList( + wellPanel( + conditionalPanel( + condition = "input.tabs_single_mean == 'Summary'", + uiOutput("ui_sm_var"), + selectInput( + inputId = "sm_alternative", label = i18n$t("Alternative hypothesis:"), + choices = sm_alt, + selected = state_single("sm_alternative", sm_alt, sm_args$alternative), + multiple = FALSE + ), + sliderInput( + "sm_conf_lev", i18n$t("Confidence level:"), + min = 0.85, max = 0.99, + value = state_init("sm_conf_lev", sm_args$conf_lev), step = 0.01 + ), + numericInput( + "sm_comp_value", i18n$t("Comparison value:"), + state_init("sm_comp_value", sm_args$comp_value) + ) + ), + conditionalPanel( + condition = "input.tabs_single_mean == 'Plot'", + selectizeInput( + inputId = "sm_plots", label = i18n$t("Select plots:"), + choices = sm_plots, + selected = state_multiple("sm_plots", sm_plots, "hist"), + multiple = TRUE, + options = list(placeholder = i18n$t("Select plots"), plugins = list("remove_button", "drag_drop")) + ) + ) + ), + help_and_report( + modal_title = i18n$t("Single mean"), + fun_name = "single_mean", + help_file = inclMD(file.path(getOption("radiant.path.basics"), "app/tools/help/single_mean.md")) + ) + ) +}) + +sm_plot <- reactive({ + list(plot_width = 650, plot_height = 400 * max(length(input$sm_plots), 1)) +}) + +sm_plot_width <- function() { + sm_plot() %>% + { + if (is.list(.)) .$plot_width else 650 + } +} + +sm_plot_height <- function() { + sm_plot() %>% + { + if (is.list(.)) .$plot_height else 400 + } +} + +## output is called from the main radiant ui.R +output$single_mean <- renderUI({ + register_print_output("summary_single_mean", ".summary_single_mean") + register_plot_output( + "plot_single_mean", ".plot_single_mean", + height_fun = "sm_plot_height" + ) + + ## two separate tabs + sm_output_panels <- tabsetPanel( + id = "tabs_single_mean", + tabPanel(i18n$t("Summary"), value = "Summary", verbatimTextOutput("summary_single_mean")), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_single_mean"), + plotOutput("plot_single_mean", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Basics > Means"), + tool = i18n$t("Single mean"), + tool_ui = "ui_single_mean", + output_panels = sm_output_panels + ) +}) + +sm_available <- reactive({ + if (not_available(input$sm_var)) { + i18n$t("This analysis requires a variable of type numeric or interval. If none are\navailable please select another dataset.\n\n") %>% suggest_data("demand_uk") + } else if (is.na(input$sm_comp_value)) { + i18n$t("Please choose a comparison value") + } else { + "available" + } +}) + +.single_mean <- reactive({ + smi <- sm_inputs() + smi$envir <- r_data + do.call(single_mean, smi) +}) + +.summary_single_mean <- reactive({ + if (sm_available() != "available") { + return(sm_available()) + } + summary(.single_mean()) +}) + +.plot_single_mean <- reactive({ + if (sm_available() != "available") { + return(sm_available()) + } + validate(need(input$sm_plots, i18n$t("Nothing to plot. Please select a plot type"))) + withProgress(message = i18n$t("Generating plots"), value = 1, { + plot(.single_mean(), plots = input$sm_plots, shiny = TRUE) + }) +}) + +single_mean_report <- function() { + if (is.empty(input$sm_var)) { + return(invisible()) + } + if (length(input$sm_plots) == 0) { + figs <- FALSE + outputs <- c("summary") + inp_out <- list("", "") + } else { + outputs <- c("summary", "plot") + inp_out <- list("", list(plots = input$sm_plots, custom = FALSE)) + figs <- TRUE + } + update_report( + inp_main = clean_args(sm_inputs(), sm_args), + fun_name = "single_mean", inp_out = inp_out, + outputs = outputs, figs = figs, + fig.width = sm_plot_width(), + fig.height = sm_plot_height() + ) +} + +download_handler( + id = "dlp_single_mean", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_single_mean"), + type = "png", + caption = i18n$t("Save single mean plot"), + plot = .plot_single_mean, + width = sm_plot_width, + height = sm_plot_height +) + +observeEvent(input$single_mean_report, { + r_info[["latest_screenshot"]] <- NULL + single_mean_report() +}) + +observeEvent(input$single_mean_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_single_mean_screenshot") +}) + +observeEvent(input$modal_single_mean_screenshot, { + single_mean_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.basics/inst/app/tools/analysis/single_prop_ui.R b/radiant.basics/inst/app/tools/analysis/single_prop_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..df99c83cfff6c52164eb0a9d2fae26478a0f3c80 --- /dev/null +++ b/radiant.basics/inst/app/tools/analysis/single_prop_ui.R @@ -0,0 +1,228 @@ +############################### +# Single proportion - ui +############################### + +## alternative hypothesis options +sp_alt <- list("two.sided", "less", "greater") +names(sp_alt) <- c( + i18n$t("Two sided"), + i18n$t("Less than"), + i18n$t("Greater than") +) +sp_plots <- c("bar", "simulate") +names(sp_plots) <- c(i18n$t("Bar"), i18n$t("Simulate")) + +## list of function arguments +sp_args <- as.list(formals(single_prop)) + +## list of function inputs selected by user +sp_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + sp_args$data_filter <- if (input$show_filter) input$data_filter else "" + sp_args$dataset <- input$dataset + for (i in r_drop(names(sp_args))) { + sp_args[[i]] <- input[[paste0("sp_", i)]] + } + sp_args +}) + +output$ui_sp_var <- renderUI({ + vars <- c("None" = "", groupable_vars()) + selectInput( + inputId = "sp_var", label = i18n$t("Variable (select one):"), + choices = vars, + selected = state_single("sp_var", vars), + multiple = FALSE + ) +}) + +output$up_sp_lev <- renderUI({ + req(available(input$sp_var)) + levs <- .get_data()[[input$sp_var]] %>% + as.factor() %>% + levels() + + selectInput( + "sp_lev", i18n$t("Choose level:"), + choices = levs, + selected = state_single("sp_lev", levs), + multiple = FALSE + ) +}) + +output$ui_single_prop <- renderUI({ + req(input$dataset) + tagList( + wellPanel( + conditionalPanel( + condition = "input.tabs_single_prop == 'Summary'", + uiOutput("ui_sp_var"), + uiOutput("up_sp_lev"), + selectInput( + "sp_alternative", i18n$t("Alternative hypothesis:"), + choices = sp_alt, + selected = state_single("sp_alternative", sp_alt, sp_args$alternative), + multiple = FALSE + ), + sliderInput( + "sp_conf_lev", i18n$t("Confidence level:"), + min = 0.85, max = 0.99, step = 0.01, + value = state_init("sp_conf_lev", sp_args$conf_lev) + ), + numericInput( + "sp_comp_value", i18n$t("Comparison value:"), + value = state_init("sp_comp_value", sp_args$comp_value), + min = 0.01, max = 0.99, step = 0.01 + ), + # radioButtons("sp_type", label = "Test:", c("Binomial" = "binom", "Chi-square" = "chisq"), + radioButtons( + inputId = "sp_test", + label = i18n$t("Test type:"), + choices = { + opts <- c("binom", "z") + names(opts) <- c(i18n$t("Binomial exact"), i18n$t("Z-test")) + opts + }, + selected = state_init("sp_test", "binom"), inline = TRUE + ) + ), + conditionalPanel( + condition = "input.tabs_single_prop == 'Plot'", + selectizeInput( + "sp_plots", i18n$t("Select plots:"), + choices = sp_plots, + selected = state_multiple("sp_plots", sp_plots, "bar"), + multiple = TRUE, + options = list(placeholder = i18n$t("Select plots"), plugins = list("remove_button", "drag_drop")) + ) + ) + ), + help_and_report( + modal_title = i18n$t("Single proportion"), + fun_name = "single_prop", + help_file = inclMD(file.path(getOption("radiant.path.basics"), "app/tools/help/single_prop.md")) + ) + ) +}) + +sp_plot <- reactive({ + list(plot_width = 650, plot_height = 400 * max(length(input$sp_plots), 1)) +}) + +sp_plot_width <- function() { + sp_plot() %>% + (function(x) if (is.list(x)) x$plot_width else 650) +} + +sp_plot_height <- function() { + sp_plot() %>% + (function(x) if (is.list(x)) x$plot_height else 400) +} + +## output is called from the main radiant ui.R +output$single_prop <- renderUI({ + register_print_output("summary_single_prop", ".summary_single_prop") + register_plot_output( + "plot_single_prop", ".plot_single_prop", + height_fun = "sp_plot_height" + ) + + ## two separate tabs + sp_output_panels <- tabsetPanel( + id = "tabs_single_prop", + tabPanel(i18n$t("Summary"), value = "Summary", verbatimTextOutput("summary_single_prop")), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_single_prop"), + plotOutput("plot_single_prop", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Basics > Proportions"), + tool = i18n$t("Single proportion"), + tool_ui = "ui_single_prop", + output_panels = sp_output_panels + ) +}) + +sp_available <- reactive({ + if (not_available(input$sp_var)) { + i18n$t("This analysis requires a categorical variable. In none are available\nplease select another dataset.\n\n") %>% suggest_data("consider") + } else if (input$sp_comp_value %>% (function(x) is.na(x) | x > 1 | x <= 0)) { + i18n$t("Please choose a comparison value between 0 and 1") + } else { + "available" + } +}) + +.single_prop <- reactive({ + spi <- sp_inputs() + spi$envir <- r_data + do.call(single_prop, spi) +}) + +.summary_single_prop <- reactive({ + if (sp_available() != "available") { + return(sp_available()) + } + summary(.single_prop()) +}) + +.plot_single_prop <- reactive({ + if (sp_available() != "available") { + return(sp_available()) + } + validate(need(input$sp_plots, i18n$t("Nothing to plot. Please select a plot type"))) + withProgress(message = i18n$t("Generating plots"), value = 1, { + plot(.single_prop(), plots = input$sp_plots, shiny = TRUE) + }) +}) + +single_prop_report <- function() { + if (is.empty(input$sp_var)) { + return(invisible()) + } + if (length(input$sp_plots) == 0) { + figs <- FALSE + outputs <- c("summary") + inp_out <- list("", "") + } else { + outputs <- c("summary", "plot") + inp_out <- list("", list(plots = input$sp_plots, custom = FALSE)) + figs <- TRUE + } + update_report( + inp_main = clean_args(sp_inputs(), sp_args), + fun_name = "single_prop", inp_out = inp_out, + outputs = outputs, figs = figs, + fig.width = sp_plot_width(), + fig.height = sp_plot_height() + ) +} + +download_handler( + id = "dlp_single_prop", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_single_prop"), + type = "png", + caption = i18n$t("Save single proportion plot"), + plot = .plot_single_prop, + width = sp_plot_width, + height = sp_plot_height +) + +observeEvent(input$single_prop_report, { + r_info[["latest_screenshot"]] <- NULL + single_prop_report() +}) + +observeEvent(input$single_prop_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_single_prop_screenshot") +}) + +observeEvent(input$modal_single_prop_screenshot, { + single_prop_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.basics/inst/app/tools/help/clt.md b/radiant.basics/inst/app/tools/help/clt.md new file mode 100644 index 0000000000000000000000000000000000000000..a446ed5ab9cfb947621ca30f497c234ea639a8de --- /dev/null +++ b/radiant.basics/inst/app/tools/help/clt.md @@ -0,0 +1,19 @@ +> 用随机抽样说明中心极限定理 + +### 什么是中心极限定理？ + +“在概率论中，中心极限定理（CLT）指出，在特定条件下，大量独立随机变量（每个变量都有明确的期望值和方差）的算术平均值将近似服从正态分布，而与变量的潜在分布无关。也就是说，假设获取一个包含大量观测值的样本，每个观测值都是随机生成的，且不依赖于其他观测值的值，然后计算观测值的算术平均值。如果多次执行此过程，中心极限定理表明，计算得到的平均值将服从正态分布（通常称为‘钟形曲线’）。” + +来源：维基百科 + +## 抽样 + +要生成样本，请从 “分布（Distribution）” 下拉菜单中选择一种分布，并接受（或更改）默认值。然后点击 “抽样（Sample）” 按钮或按`CTRL-enter`（Mac 上为`CMD-enter`）运行模拟并显示模拟数据的图表。 + +### Khan 讲解中心极限定理 + +
+ +### R 函数 + +有关 Radiant 中用于概率计算的相关 R 函数概述，请参见*基础 > 概率* 。 \ No newline at end of file diff --git a/radiant.basics/inst/app/tools/help/compare_means.md b/radiant.basics/inst/app/tools/help/compare_means.md new file mode 100644 index 0000000000000000000000000000000000000000..be4a420988864803fefe200446bc56adb8b9665e --- /dev/null +++ b/radiant.basics/inst/app/tools/help/compare_means.md @@ -0,0 +1,120 @@ +> 比较数据中两个或多个变量或组的均值 + +均值比较 t 检验用于比较一个组中某个变量的均值与一个或多个其他组中同一变量的均值。总体中组间差异的原假设设为零。我们使用样本数据检验这一假设。 + +我们可以执行单侧检验（即`小于`或`大于`）或双侧检验（见 “备择假设（Alternative hypothesis）” 下拉菜单）。单侧检验用于评估现有数据是否提供证据表明组间样本均值差异小于（或大于）零。 + +### 示例：教授薪资 + +我们获取了美国某学院助理教授、副教授和教授的 9 个月学术薪资数据（2008-09 学年）。这些数据是学院行政部门为监测男女教师薪资差异而持续收集的一部分。数据包含 397 个观测值和以下 6 个变量： + +- `rank` = 因子，水平为 AsstProf（助理教授）、AssocProf（副教授）、Prof（教授） +- `discipline` = 因子，水平为 A（“理论型” 院系）或 B（“应用型” 院系） +- `yrs.since.phd` = 获得博士学位后的年数 +- `yrs.service` = 任职年数 +- `sex` = 因子，水平为 Female（女性）和 Male（男性） +- `salary` = 9 个月薪资（美元） + +这些数据来自 CAR 包，与以下书籍相关：Fox J. 和 Weisberg, S. (2011)《应用回归的 R 伴侣（第二版）》，Sage 出版社。 + +假设我们要检验职级较低的教授是否比职级较高的教授薪资更低。为检验这一假设，我们首先选择教授`rank`，并选择`salary`作为要在不同职级间比较的数值变量。在 “选择组合（Choose combinations）” 框中选择所有可用条目，对三个职级进行两两比较。注意，移除所有条目会自动选择所有组合。我们关注单侧假设（即`小于`）。 + +

+ +输出的前两个区块显示检验的基本信息（如所选变量和置信水平）和汇总统计量（如每组的均值、标准差、误差边际等）。最后一个区块显示以下内容： + +* `Null hyp.`是原假设，`Alt. hyp.`是备择假设 +* `diff`是两组样本均值的差异（例如，80775.99 - 93876.44 = -13100.45）。如果原假设为真，我们预期这一差异较小（即接近零） +* `p.value`是在原假设为真时，找到与`diff`一样极端或更极端值的概率 + +如果勾选 “显示额外统计量（Show additional statistics）”，会添加以下输出： + +
+Pairwise mean comparisons (t-test)
+Data      : salary 
+Variables : rank, salary 
+Samples   : independent 
+Confidence: 0.95 
+Adjustment: None 
+
+      rank        mean   n n_missing         sd        se        me
+  AsstProf  80,775.985  67         0  8,174.113   998.627 1,993.823
+ AssocProf  93,876.438  64         0 13,831.700 1,728.962 3,455.056
+      Prof 126,772.109 266         0 27,718.675 1,699.541 3,346.322
+
+ Null hyp.              Alt. hyp.              diff      p.value se       t.value df      0%   95%           
+ AsstProf = AssocProf   AsstProf < AssocProf   -13100.45 < .001  1996.639  -6.561 101.286 -Inf  -9785.958 ***
+ AsstProf = Prof        AsstProf < Prof        -45996.12 < .001  1971.217 -23.334 324.340 -Inf -42744.474 ***
+ AssocProf = Prof       AssocProf < Prof       -32895.67 < .001  2424.407 -13.569 199.325 -Inf -28889.256 ***
+
+Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+ +* `se`是标准误（即`diff`抽样分布的标准差） +* `t.value`是与`diff`相关的 t 统计量，可与 t 分布比较（即`diff` / `se`） +* `df`是统计检验的自由度。注意，自由度使用 Welch 近似法计算 +* `0% 95%`显示样本均值差异的 95% 置信区间。这些数值提供了真实总体差异可能落入的范围 + +### 检验方法 + +我们可以使用三种方法评估原假设。我们选择显著性水平为 0.05。1 当然，每种方法会得出相同结论。 + +#### p 值 + +由于每个 p 值都**小于**显著性水平，我们拒绝每个评估的教授职级对的原假设。数据表明，副教授薪资高于助理教授，教授薪资高于助理教授和副教授。注意，“***” 用作显著性指标。 + +#### 置信区间 + +由于任何置信区间都**不**包含零，我们拒绝每个评估的职级组合的原假设。由于我们的备择假设是`小于`，置信区间实际上是总体薪资差异的 95% 置信上限（即 - 9785.958、-42744.474 和 - 28889.256）。 + +#### t 值 + +由于计算的 t 值（-6.561、-23.334 和 - 13.569）**小于**相应的临界 t 值，我们拒绝每个评估的职级组合的原假设。可通过 “基础（Basics）” 菜单中的概率计算器获取临界 t 值。以助理教授与副教授的检验为例，我们发现对于自由度为 101.286 的 t 分布（见`df`），临界 t 值为 1.66。由于备择假设是`小于`，我们选择 0.05 作为下侧概率界。 + +

+ +除 “摘要（Summary）” 标签页中的数值输出外，我们还可以可视化研究`rank`与`salary`之间的关联（见 “绘图（Plot）” 标签页）。下方截图显示教授薪资的散点图和带有置信区间（黑色）与标准误（蓝色）条的条形图。与 “摘要” 标签页中的结果一致，不同职级的薪资存在明显差异。我们也可以选择将样本数据绘制成箱线图或密度曲线图。 + +

+ +### 多重比较调整 + +我们评估的比较越多，即使原假设为真，仅因随机因素而发现 “显著” 结果的可能性就越大。如果我们进行 100 次检验，并将**显著性水平**设为 0.05（或 5%），即使总体中不存在关联，我们也可能预期有 5 个 p 值小于或等于 0.05。 + +Bonferroni 调整确保 p 值根据所进行的检验数量适当缩放。这幅 XKCD 漫画清晰地说明了这类调整的必要性。 + +### 统计术语 + +这是**均值比较**检验，原假设为真实总体**均值差异**等于**0**。使用 0.05 的显著性水平，我们拒绝每个评估的职级对的原假设，并得出结论：真实总体**均值差异小于**0。 + +助理教授与副教授薪资差异检验的 p 值为 **< .001**。这是在原假设为真时，观察到与数据中样本**均值差异**一样极端或更极端的样本**均值差异**的概率。在本例中，它是当真实总体**均值差异**为**0**时，观察到样本**均值差异**小于（或等于）**-13100.45**的概率。 + +95% 置信界为 **-9785.958**。如果重复抽样并为每个样本计算 95% 置信界，真实总体均值将在 95% 的样本中低于该下界。 + +1**显著性水平**（通常用α表示）是你愿意接受的、在原假设实际为真时拒绝原假设的最高概率。常用的显著性水平为 0.05（或 5%）。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令进行自定义（例如，`plot(result, plots = "scatter", custom = TRUE) + labs(title = "均值比较")`）。详情请参见*数据 > 可视化*。 + +### R 函数 + +有关 Radiant 中用于评估均值的相关 R 函数概述，请参见*基础 > 均值*。 + +`compare_means`工具中使用的来自`stats`包的核心函数是`t.test`。 + +### 视频教程 + +将以下完整命令复制粘贴到 RStudio 控制台（即左下角窗口），按回车即可获取 Radiant 教程系列中假设检验模块使用的所有材料： + +
usethis::use_course("https://www.dropbox.com/sh/0xvhyolgcvox685/AADSppNSIocrJS-BqZXhD1Kna?dl=1")
+ +均值比较假设检验 + +- 本视频展示如何进行均值比较假设检验 +- 主题列表： + - 按组计算汇总统计量 + - 在 Radiant 中设置均值比较的假设检验 + - 使用 p 值和置信区间评估假设检验 diff --git a/radiant.basics/inst/app/tools/help/compare_props.md b/radiant.basics/inst/app/tools/help/compare_props.md new file mode 100644 index 0000000000000000000000000000000000000000..d309afe4b2fba570b40483eb72eff7a4e3c3d9f2 --- /dev/null +++ b/radiant.basics/inst/app/tools/help/compare_props.md @@ -0,0 +1,119 @@ +> 比较数据中两个或多个组的比例 + +比例比较检验用于评估某些事件、行为、意图等的发生频率在不同组间是否存在差异。总体中组间比例差异的原假设设为零。我们使用样本数据检验这一假设。 + +我们可以执行单侧检验（即`小于`或`大于`）或双侧检验（见 “备择假设（Alternative hypothesis）” 下拉菜单）。单侧检验适用于评估样本数据是否表明，例如，某一无线运营商的掉话比例比其他运营商更高（或更低）。 + +### 示例 + +我们将使用泰坦尼克号乘客生存状态数据集的一个样本。泰坦尼克号乘客数据的主要来源是《泰坦尼克号百科全书》。原始来源之一是 Eaton & Haas（1994）的《泰坦尼克号：胜利与悲剧》（Patrick Stephens Ltd 出版），其中包含由多位研究者整理、经 Michael A. Findlay 编辑的乘客名单。我们关注数据中的两个变量： + +- `survived` = 因子，水平为`Yes`（是）和`No`（否） +- `pclass` = 乘客等级（1 等、2 等、3 等），作为社会经济地位（SES）的替代指标：1 等≈上层；2 等≈中层；3 等≈下层 + +假设我们要检验泰坦尼克号沉没事件中，不同乘客等级的生存比例是否存在差异。为检验这一假设，我们选择`pclass`作为分组变量，并计算`survived`中`yes`的比例（见 “选择水平（Choose level）”）（见 “变量（选择一个）（Variable (select one)）”）。 + +在 “选择组合（Choose combinations）” 框中选择所有可用条目，对三个乘客等级进行两两比较。注意，移除所有条目会自动选择所有组合。除非我们对效应方向有明确假设，否则应使用双侧检验（即`two.sided`）。我们的第一个备择假设是 “1 等舱乘客的生存比例与 2 等舱乘客不同”。 + +

+ +输出的前两个区块显示检验的基本信息（如所选变量和置信水平）和汇总统计量（如每组的比例、标准误、误差边际等）。最后一个区块显示以下内容： + +* `Null hyp.`是原假设，`Alt. hyp.`是备择假设 +* `diff`是两组样本比例的差异（例如，0.635 - 0.441 = 0.194）。如果原假设为真，我们预期这一差异较小（即接近零） +* `p.value`是在原假设为真时，找到与`diff`一样极端或更极端值的概率 + +如果勾选 “显示额外统计量（Show additional statistics）”，会添加以下输出： + +
+Pairwise proportion comparisons
+Data      : titanic 
+Variables : pclass, survived 
+Level     : Yes in survived 
+Confidence: 0.95 
+Adjustment: None 
+
+ pclass Yes  No     p   n n_missing    sd    se    me
+    1st 179 103 0.635 282         0 8.086 0.029 0.056
+    2nd 115 146 0.441 261         0 8.021 0.031 0.060
+    3rd 131 369 0.262 500         0 9.832 0.020 0.039
+
+ Null hyp.   Alt. hyp.              diff  p.value chisq.value df 2.5%  97.5%    
+ 1st = 2nd   1st not equal to 2nd   0.194 < .001  20.576      1  0.112 0.277 ***
+ 1st = 3rd   1st not equal to 3rd   0.373 < .001  104.704     1  0.305 0.441 ***
+ 2nd = 3rd   2nd not equal to 3rd   0.179 < .001  25.008      1  0.107 0.250 ***
+
+Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+ +* `chisq.value`是与`diff`相关的卡方统计量，可与卡方分布比较。关于该指标的计算方法，详见 “基础> 表格 > 交叉表” 的帮助文件。每组组合都会计算等效的 2×2 交叉表。 +* `df`是每个统计检验的自由度（1）。 +* `2.5% 97.5%`显示样本比例差异的 95% 置信区间。这些数值提供了真实总体差异可能落入的范围。 + +### 检验方法 + +我们可以使用三种方法评估原假设。我们选择显著性水平为 0.05。1 当然，每种方法会得出相同结论。 + +#### p 值 + +由于每个两两比较的 p 值都**小于**显著性水平，基于可用样本数据，我们可以拒绝比例相等的原假设。结果表明，1 等舱乘客比 2 等舱和 3 等舱乘客更可能在沉没事件中幸存；同样，2 等舱乘客比 3 等舱乘客更可能幸存。 + +#### 置信区间 + +由于任何置信区间都**不**包含零，我们拒绝每个评估的乘客等级组合的原假设。 + +#### 卡方值 + +由于计算的卡方值（20.576、104.704 和 25.008）**大于**相应的临界卡方值，我们拒绝每个评估的乘客等级组合的原假设。可通过 “基础（Basics）” 菜单中的概率计算器获取临界卡方值。以 1 等舱与 2 等舱乘客的检验为例，我们发现对于自由度为 1（见`df`）、置信水平为 0.95 的卡方分布，临界卡方值为 3.841。 + +

+ +除 “摘要（Summary）” 标签页中的数值输出外，我们还可以可视化研究`pclass`与`survived`之间的关联（见 “绘图（Plot）” 标签页）。下方截图显示两个条形图。第一个图表包含样本中`survived`为`yes`的比例的置信区间（黑色）和标准误（蓝色）条。与 “摘要” 标签页中的结果一致，不同乘客等级的生存率存在明显差异。“并列（Dodge）” 图表按乘客等级并排显示`survived`中`yes`和`no`的比例：1 等舱乘客中`yes`的比例高于`no`，而 3 等舱乘客则相反。 + +

+ +### 技术说明 + +- Radiant 使用 R 的`prop.test`函数进行比例比较。当一个或多个期望频数较小时（例如≤5），该检验的 p 值通过模拟方法计算。出现这种情况时，建议使用 “基础> 表格 > 交叉表” 重新运行检验，并评估是否有单元格的期望频数低于 1。 +- 对于单侧检验（即`小于`或`大于`），临界值必须通过概率计算器中的正态分布获取，并对相应的 Z 统计量进行平方。 + +### 多重比较调整 + +我们评估的比较越多，即使原假设为真，仅因随机因素而发现 “显著” 结果的可能性就越大。如果我们进行 100 次检验，并将**显著性水平**设为 0.05（或 5%），即使总体中不存在关联，我们也可能预期有 5 个 p 值小于或等于 0.05。 + +邦费罗尼调整（Bonferroni adjustment）确保 p 值根据所进行的检验数量适当缩放。这幅 XKCD 漫画清晰地说明了这类调整的必要性。 + +### 统计术语 + +这是**比例比较**检验，原假设为真实总体**比例差异**等于**0**。使用 0.05 的显著性水平，我们拒绝每个评估的乘客等级对的原假设，并得出结论：真实总体**比例差异不等于 0**。 + +1 等舱与 2 等舱乘客生存比例差异检验的 p 值为 **< .001**。这是在原假设为真时，观察到与数据中样本**比例差异**一样极端或更极端的样本**比例差异**的概率。在本例中，它是当真实总体**比例差异**为**0**时，观察到样本**比例差异**小于 **-0.194**或大于**0.194** 的概率。 + +95% 置信区间为**0.112**至**0.277**。如果重复抽样并为每个样本计算 95% 置信区间，真实**总体比例差异**将在 95% 的样本中落入置信区间内。 + +1**显著性水平**（通常用α表示）是你愿意接受的、在原假设实际为真时拒绝原假设的最高概率。常用的显著性水平为 0.05（或 5%）。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令进行自定义（例如，`plot(result, plots = "bar", custom = TRUE) + labs(title = "比例比较")`）。详情请参见*数据 > 可视化*。 + +### R 函数 + +有关 Radiant 中用于评估比例的相关 R 函数概述，请参见*基础 > 比例*。 + +`compare_props`工具中使用的来自`stats`包的核心函数是`prop.test`。 + +### 视频教程 + +将以下完整命令复制粘贴到 RStudio 控制台（即左下角窗口），按回车即可获取 Radiant 教程系列中假设检验模块使用的所有材料： + +
usethis::use_course("https://www.dropbox.com/sh/0xvhyolgcvox685/AADSppNSIocrJS-BqZXhD1Kna?dl=1")
+ +比例比较假设检验 + +- 本视频展示如何进行比例比较假设检验 +- 主题列表： + - 在 Radiant 中设置比例比较的假设检验 + - 使用 p 值和置信区间评估假设检验 diff --git a/radiant.basics/inst/app/tools/help/correlation.md b/radiant.basics/inst/app/tools/help/correlation.md new file mode 100644 index 0000000000000000000000000000000000000000..9520c3e1f5eac77c95ec093b357bbc7b76de4d64 --- /dev/null +++ b/radiant.basics/inst/app/tools/help/correlation.md @@ -0,0 +1,54 @@ +> 数据中变量的相关性如何？ + +创建所选变量的相关矩阵。为每个变量对提供相关性和 p 值。要仅显示高于特定（绝对）水平的相关性，使用相关性截断框。 + +注意：相关性可基于`numeric`、`integer`、`date`和`factor`类型的变量计算。当纳入因子型变量时，应勾选 “调整因子型变量（Adjust for {factor} variables）” 框。进行调整后估计相关性时，因子型变量将被视为（有序）分类变量，其他所有变量将被视为连续变量。 + +

+ +“绘图（Plot）” 标签页提供相关矩阵的可视化表示。注意，图表中的散点图默认最多显示 1000 个数据点。要生成使用所有观测值的散点图，在 “报告 > Rmd” 中使用`plot(result, n = -1)`。 + +“绘图” 标签页中显示的星号含义如下： + +- p 值在 0 到 0.001 之间：*** +- p 值在 0.001 到 0.01 之间：** +- p 值在 0.01 到 0.05 之间：* +- p 值在 0.05 到 0.1 之间：. + +

+ +图中使用的字体大小与两个变量间相关性的大小和显著性成正比。 + +### 方法） + +选择用于计算相关性的方法。最常用的方法是`Pearson`（皮尔逊）。详见维基百科。 + +### 相关性截断 + +要仅显示高于特定值的相关性，在 0 到 1 之间的数值输入框中选择非零值（例如 0.15）。 + +### 协方差矩阵 + +尽管我们通常使用相关矩阵，但也可通过勾选 “显示协方差矩阵（Show covariance matrix）” 框显示协方差矩阵。 + +## 存储为数据框 + +可通过（1）为新数据集提供名称和（2）点击 “存储（Store）” 按钮，将相关矩阵存储为数据框。新数据集将包含每个变量对的估计`correlation`（相关性）和`distance`（距离）度量，距离度量计算如下：`distance = 0.5 * (1 - correlation)`。当两个变量的相关性等于 - 1 时，该度量为 1；当两个变量的相关性等于 1 时，该度量为 0。关于此类数据集的示例，见下方 “数据> 查看” 标签页的截图。此结构的数据集可作为输入，通过 “多元分析 >（不）相似性分析” 创建基于（不）相似性的感知图。 + +

+ +### Khan 讲解相关性 + +

+ +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +默认情况下，相关性图抽样 1000 个数据点。要包含所有数据点，使用`plot(result, n = -1)`。例如，要为图表添加标题，使用`title(main = "相关性图\n\n")`。更多信息见R 图形文档。 + +### R 函数 + +有关 Radiant 中用于评估相关性的相关 R 函数概述，请参见*基础 > 表格*。 + +`correlation`工具中使用的来自`psych`包的核心函数是`corr.test`。 diff --git a/radiant.basics/inst/app/tools/help/cross_tabs.md b/radiant.basics/inst/app/tools/help/cross_tabs.md new file mode 100644 index 0000000000000000000000000000000000000000..9019c53dbad61ba9c787ab559a029a31e2ee4921 --- /dev/null +++ b/radiant.basics/inst/app/tools/help/cross_tabs.md @@ -0,0 +1,66 @@ +> 交叉表分析用于评估分类变量之间是否存在关联。该工具也被称为卡方检验或列联表分析 + +### 示例 + +数据来自 580 名报纸读者的样本，这些读者表明了（1）他们最常阅读的报纸（《今日美国》或《华尔街日报》）和（2）他们的收入水平（低收入 vs. 高收入）。数据包含三个变量：受访者标识符（id）、受访者收入（高或低）以及受访者主要阅读的报纸（《今日美国》或《华尔街日报》）。 + +我们将研究收入水平与报纸选择之间是否存在关系。具体而言，我们检验以下原假设和备择假设： + +* H0：收入水平与报纸选择之间无关联 +* Ha：收入水平与报纸选择之间有关联 + +如果拒绝原假设，我们可以进一步研究哪些单元格对假设的关联有贡献。在 Radiant（基础 > 交叉表）中，选择收入作为第一个因子，报纸作为第二个因子。首先，比较观察频数和期望频数。期望频数基于原假设（即无关联）计算，公式为（行总计 × 列总计）/ 总总计。 + +

+ +（皮尔逊）卡方检验用于评估我们是否可以拒绝两个变量独立的原假设。它通过比较观察频数（即数据中实际看到的频数）与期望频数（即如果两个变量独立时预期看到的频数）来实现。如果期望频数表与观察频数表之间存在较大差异，卡方值将**较大**。每个单元格的卡方值计算公式为`(o - e)^2 / e`，其中`o`是单元格中的观察频数，`e`是原假设成立时该单元格的期望频数。点击 “卡方（Chi-squared）” 复选框可显示这些值。总卡方值通过对所有单元格求和获得，即它是 “卡方贡献（Contribution to chi-square）” 表中所示值的总和。 + +为了确定卡方值是否可被视为**较大**，我们首先计算自由度（df）。具体而言：自由度 =（行数 - 1）×（列数 - 1）。在 2×2 表格中，自由度 =（2-1）×（2-1）=1。“摘要（Summary）” 标签页的输出显示了卡方统计量的值、相关的自由度以及检验的 p 值。我们还能看到每个单元格对总卡方统计量的贡献。 + +记住要检查期望値：所有期望频数均大于 5，因此卡方统计量的 p 值不太可能存在偏差。与通常一样，当 p 值小于 0.05 时，我们拒绝原假设。由于我们的 p 值非常小（<0.001），我们可以拒绝原假设（即数据表明报纸阅读习惯与收入之间存在关联）。 + +我们可以使用与 187.783 的卡方值相关的 p 值来评估原假设。不过，我们也可以使用概率计算器计算临界卡方值。从下方输出中可以看到，如果选择 95% 的置信水平，该值为 3.841。由于计算得到的卡方值大于临界值（187.783 > 3.841），我们拒绝 “收入（Income）” 与 “报纸（Newspaper）” 独立的原假设。 + +

+ +我们也可以使用概率计算器确定与计算得到的卡方值相关的 p 值。与 “交叉表> 摘要” 标签页的输出一致，该`p.value`为`< .001`。 + +

+ +除 “摘要” 标签页中的数值输出外，我们还可以可视化评估假设（见 “绘图（Plot）” 标签页）。我们选择与之前相同的变量，但将绘制标准化偏差。该度量的计算公式为（o-e）/sqrt (e)，即衡量表格中某个单元格的观察频数与期望频数差异的得分。当单元格的标准化偏差绝对值大于 1.96 时，该单元格与独立性模型（或无关联）存在显著偏差。 + +

+ +在图中，我们看到所有单元格都对收入与阅读习惯之间的关联有贡献，因为所有标准化偏差的绝对值都大于 1.96（即条形图延伸超出了图中的外部虚线）。 + +换句话说，与无关联的原假设成立时的预期相比，阅读《华尔街日报》的低收入受访者似乎更少，阅读《华尔街日报》的高收入受访者似乎更多；此外，阅读《今日美国》的低收入受访者更多，阅读《今日美国》的高收入受访者更少。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令进行自定义（例如，`plot(result, check = "observed", custom = TRUE) + labs(y = "百分比")`）。详情请参见*数据 > 可视化*。 + +### 技术说明 + +当一个或多个期望値较小时（例如≤5），卡方检验的 p 值通过模拟方法计算。如果某些单元格的期望计数低于 1，可能需要**合并**行和 / 或列。 + +### R 函数 + +有关 Radiant 中用于评估分类变量间关联的相关 R 函数概述，请参见*基础 > 表格*。 + +`cross_tabs`工具中使用的来自`stats`包的核心函数是`chisq.test`。 + +### 视频教程 + +将以下完整命令复制粘贴到 RStudio 控制台（即左下角窗口），按回车即可获取 Radiant 教程系列中假设检验模块使用的所有材料： + +
usethis::use_course("https://www.dropbox.com/sh/0xvhyolgcvox685/AADSppNSIocrJS-BqZXhD1Kna?dl=1")
+ +交叉表假设检验 + +- 本视频演示如何通过交叉表假设检验研究两个分类变量之间的关联 +- 主题列表： + - 在 Radiant 中设置交叉表的假设检验 + - 解释观察频数表、期望频数表和卡方贡献表的构建方式 + - 使用 p 值和临界值评估假设检验 diff --git a/radiant.basics/inst/app/tools/help/figures/compare_means_plot.png b/radiant.basics/inst/app/tools/help/figures/compare_means_plot.png new file mode 100644 index 0000000000000000000000000000000000000000..78038008b60cd31b4eddaf6a4af9ab3d434b6563 Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/compare_means_plot.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/compare_means_prob_calc.png b/radiant.basics/inst/app/tools/help/figures/compare_means_prob_calc.png new file mode 100644 index 0000000000000000000000000000000000000000..23277042ca69f06afbdcbda9e2c51f91e531a260 Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/compare_means_prob_calc.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/compare_means_summary.png b/radiant.basics/inst/app/tools/help/figures/compare_means_summary.png new file mode 100644 index 0000000000000000000000000000000000000000..1248700dc6ad0b6ea33057081b5d772d199bf50c Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/compare_means_summary.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/compare_means_summary_additional.png b/radiant.basics/inst/app/tools/help/figures/compare_means_summary_additional.png new file mode 100644 index 0000000000000000000000000000000000000000..0bf7e4d4314f57f32aab2c12e9f502afc1a4f85a Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/compare_means_summary_additional.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/compare_props_plot.png b/radiant.basics/inst/app/tools/help/figures/compare_props_plot.png new file mode 100644 index 0000000000000000000000000000000000000000..8cf24791321ea0170418447208ac1b5ce54d7331 Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/compare_props_plot.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/compare_props_prob_calc.png b/radiant.basics/inst/app/tools/help/figures/compare_props_prob_calc.png new file mode 100644 index 0000000000000000000000000000000000000000..e7e373bd109429e67e2e364e76bd26e0bfd25f36 Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/compare_props_prob_calc.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/compare_props_summary.png b/radiant.basics/inst/app/tools/help/figures/compare_props_summary.png new file mode 100644 index 0000000000000000000000000000000000000000..89f8e70eca8a9c6e5483933317ef04520a8e2649 Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/compare_props_summary.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/compare_props_summary_additional.png b/radiant.basics/inst/app/tools/help/figures/compare_props_summary_additional.png new file mode 100644 index 0000000000000000000000000000000000000000..6e7aa40e94065dfaa1ea55e888b33a1c509ded3d Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/compare_props_summary_additional.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/correlation_plot.png b/radiant.basics/inst/app/tools/help/figures/correlation_plot.png new file mode 100644 index 0000000000000000000000000000000000000000..b808e353362c2210818ecc624b5c31e81e298d8d Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/correlation_plot.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/correlation_store.png b/radiant.basics/inst/app/tools/help/figures/correlation_store.png new file mode 100644 index 0000000000000000000000000000000000000000..596b87fc6a50c1095c4d586797c0dbf6688437f6 Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/correlation_store.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/correlation_summary.png b/radiant.basics/inst/app/tools/help/figures/correlation_summary.png new file mode 100644 index 0000000000000000000000000000000000000000..7bbbadb53eac4eeb5061cd6a37f160bb0c123c3a Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/correlation_summary.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/cross_tabs_chi_critical.png b/radiant.basics/inst/app/tools/help/figures/cross_tabs_chi_critical.png new file mode 100644 index 0000000000000000000000000000000000000000..f3fda78bc06a26b9e1225153fd530b2e6045a02e Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/cross_tabs_chi_critical.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/cross_tabs_chi_pvalue.png b/radiant.basics/inst/app/tools/help/figures/cross_tabs_chi_pvalue.png new file mode 100644 index 0000000000000000000000000000000000000000..adee22a4a080b4c642e6395e53b14d359a5a5de0 Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/cross_tabs_chi_pvalue.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/cross_tabs_plot.png b/radiant.basics/inst/app/tools/help/figures/cross_tabs_plot.png new file mode 100644 index 0000000000000000000000000000000000000000..35fdafd244096b2a08a2921803dd92d732062e3b Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/cross_tabs_plot.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/cross_tabs_summary.png b/radiant.basics/inst/app/tools/help/figures/cross_tabs_summary.png new file mode 100644 index 0000000000000000000000000000000000000000..8d62a388d5eff23eb5bf3c1ac628d98de25c45e4 Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/cross_tabs_summary.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/goodness_chi_pvalue.png b/radiant.basics/inst/app/tools/help/figures/goodness_chi_pvalue.png new file mode 100644 index 0000000000000000000000000000000000000000..bbcfa2757c42945ed551646e75b75dfe576ec22f Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/goodness_chi_pvalue.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/goodness_summary.png b/radiant.basics/inst/app/tools/help/figures/goodness_summary.png new file mode 100644 index 0000000000000000000000000000000000000000..056d580ddb7f0ca98225620aae6f5e47faa77e80 Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/goodness_summary.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/prob_calc_batteries.png b/radiant.basics/inst/app/tools/help/figures/prob_calc_batteries.png new file mode 100644 index 0000000000000000000000000000000000000000..638bb5a37e056c0b2592b0390656fc51816f84ab Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/prob_calc_batteries.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/prob_calc_headphones.png b/radiant.basics/inst/app/tools/help/figures/prob_calc_headphones.png new file mode 100644 index 0000000000000000000000000000000000000000..9d7485c3bed477d4e11561dbe1280eb7644f0699 Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/prob_calc_headphones.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/prob_calc_icecream.png b/radiant.basics/inst/app/tools/help/figures/prob_calc_icecream.png new file mode 100644 index 0000000000000000000000000000000000000000..8ffaf3c8c0ca38d9720bdf17303b865872e8f6ad Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/prob_calc_icecream.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/single_mean_plot.png b/radiant.basics/inst/app/tools/help/figures/single_mean_plot.png new file mode 100644 index 0000000000000000000000000000000000000000..5a9762da3892bb78d4f29b57030188f5abf48f68 Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/single_mean_plot.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/single_mean_prob_calc.png b/radiant.basics/inst/app/tools/help/figures/single_mean_prob_calc.png new file mode 100644 index 0000000000000000000000000000000000000000..0fb9912a2d24150730cb2ff7e7b2eacf9d205002 Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/single_mean_prob_calc.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/single_mean_summary.png b/radiant.basics/inst/app/tools/help/figures/single_mean_summary.png new file mode 100644 index 0000000000000000000000000000000000000000..0449b74dada49d3f2d104b5504c4aee1517498ee Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/single_mean_summary.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/single_prop_prob_calc_p.png b/radiant.basics/inst/app/tools/help/figures/single_prop_prob_calc_p.png new file mode 100644 index 0000000000000000000000000000000000000000..a4c9fe3fbdeb7a4e29e8b2487bd8db99a05be032 Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/single_prop_prob_calc_p.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/single_prop_prob_calc_v.png b/radiant.basics/inst/app/tools/help/figures/single_prop_prob_calc_v.png new file mode 100644 index 0000000000000000000000000000000000000000..7fe9f957276fd5c93b34482eeee2041f44098363 Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/single_prop_prob_calc_v.png differ diff --git a/radiant.basics/inst/app/tools/help/figures/single_prop_summary.png b/radiant.basics/inst/app/tools/help/figures/single_prop_summary.png new file mode 100644 index 0000000000000000000000000000000000000000..672f7375d929398a1e2f320e7c6f3fd60efeafcb Binary files /dev/null and b/radiant.basics/inst/app/tools/help/figures/single_prop_summary.png differ diff --git a/radiant.basics/inst/app/tools/help/goodness.md b/radiant.basics/inst/app/tools/help/goodness.md new file mode 100644 index 0000000000000000000000000000000000000000..97bff7d8e6ef121b01d90fa6632a881a78f07936 --- /dev/null +++ b/radiant.basics/inst/app/tools/help/goodness.md @@ -0,0 +1,46 @@ +> 拟合优度检验用于确定样本数据是否与假设的分布一致 + +### 示例 + +数据来自 580 名报纸读者的样本，这些读者表明了（1）他们最常阅读的报纸（《今日美国》或《华尔街日报》）和（2）他们的收入水平（低收入 vs. 高收入）。数据包含三个变量：受访者标识符（id）、受访者收入（高或低）以及受访者主要阅读的报纸（《今日美国》或《华尔街日报》）。 + +收集这些数据是为了研究收入水平与报纸选择之间是否存在关系。为确保结果具有可推广性，样本必须能代表目标总体。已知在该总体中，《今日美国》读者的相对比例高于《华尔街日报》读者，两者比例分别应为 55% 和 45%。我们可以使用拟合优度检验来检验以下原假设和备择假设： + +- H0：《今日美国》和《华尔街日报》的阅读份额分别为 55% 和 45% +- Ha：《今日美国》和《华尔街日报》的阅读份额不等于上述设定值 + +如果基于可用样本不能拒绝原假设，则观察数据与假设的总体份额或概率之间存在 “良好拟合”。在 Radiant（基础 > 表格 > 拟合优度检验）中，选择 “报纸（Newspaper）” 作为分类变量。如果我们将 “概率（Probabilities）” 输入框留空（或输入 1/2），则会检验份额是否相等。但为了检验 H0 和 Ha，我们需要输入`0.45 and 0.55`，然后按回车键。首先，比较观察频数和期望频数。期望频数基于原假设成立（即与设定份额无偏差）计算，公式为总样本量 ×p，其中 p 是某个单元格的假设份额（或概率）。 + +

+ +（皮尔逊）卡方检验用于评估我们是否可以拒绝观察值与期望值一致的原假设。它通过比较观察频数（即数据中实际看到的频数）与期望频数（即如果份额分布与我们假设的一致时预期看到的频数）来实现。如果期望频数表与观察频数表之间存在较大差异，卡方值将**较大**。每个单元格的卡方值计算公式为`(o - e)^2 / e`，其中`o`是单元格中的观察频数，`e`是原假设成立时该单元格的期望频数。点击 “卡方（Chi-squared）” 复选框可显示这些值。总卡方值通过对所有单元格求和获得，即它是 “卡方贡献（Contribution to chi-square）” 表中所示值的总和。 + +为了确定卡方统计量是否可被视为**较大**，我们首先计算自由度（df = 单元格数量 - 1）。在包含两个单元格的表格中，自由度 =（2-1）=1。“摘要（Summary）” 标签页的输出显示了卡方统计量的值、自由度以及检验的 p 值。我们还能看到每个单元格对总卡方统计量的贡献。 + +记住要检查期望値：所有期望频数均大于 5，因此卡方统计量的 p 值不太可能存在偏差（另见下方技术说明）。与通常一样，当 p 值小于 0.05 时，我们拒绝原假设。由于我们的 p 值非常大（>0.8），我们不能拒绝原假设（即观察数据中的份额分布与我们假设的一致）。 + +我们可以使用与 0.028 的卡方值相关的 p 值来评估原假设。不过，我们也可以使用概率计算器计算临界卡方值。从下方输出中可以看到，如果选择 95% 的置信水平，临界值为 3.841。由于计算得到的卡方值小于临界值（0.028 < 3.841），我们不能拒绝上述原假设。 + +

+ +我们也可以使用概率计算器确定与计算得到的卡方值相关的 p 值。与 “摘要” 标签页的输出一致，该`p.value`为`< .001`。 + +

+ +除 “摘要” 标签页中的数值输出外，我们还可以在 “绘图（Plot）” 标签页中可视化评估假设。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令进行自定义（例如，`plot(result, check = "observed", custom = TRUE) + labs(y = "百分比")`）。详情请参见*数据 > 可视化*。 + +### 技术说明 + +当一个或多个期望値较小时（例如≤5），卡方检验的 p 值通过模拟方法计算。如果某些单元格的期望计数低于 1，可能需要合并单元格 / 类别。 + +### R 函数 + +有关 Radiant 中用于评估离散概率分布的相关 R 函数概述，请参见*基础 > 表格*。 + +`goodness`工具中使用的来自`stats`包的核心函数是`chisq.test`。 diff --git a/radiant.basics/inst/app/tools/help/homo_variance_test.md b/radiant.basics/inst/app/tools/help/homo_variance_test.md new file mode 100644 index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 diff --git a/radiant.basics/inst/app/tools/help/normality_test.md b/radiant.basics/inst/app/tools/help/normality_test.md new file mode 100644 index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 diff --git a/radiant.basics/inst/app/tools/help/prob_calc.Rmd b/radiant.basics/inst/app/tools/help/prob_calc.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..2a3740e2a8c636b59b1c4e01a6834e63fd2353fb --- /dev/null +++ b/radiant.basics/inst/app/tools/help/prob_calc.Rmd @@ -0,0 +1,106 @@ +> Probability calculator + +Calculate probabilities or values based on the _Binomial_, _Chi-squared_, _Discrete_, _F_, _Exponential_, _Normal_, _Poisson_, _t_, or _Uniform_ distribution. + +## Testing batteries + +Suppose Consumer Reports (CR) wants to test manufacturer claims about battery life. The manufacturer claims that more than 90% of their batteries will power a laptop for at least 12 hours of continuous use. CR sets up 20 identical laptops with the manufacturer's batteries. If the manufacturer's claims are accurate, what is the probability that 15 or more laptops are still running after 12 hours? + +The description of the problem suggests we should select `Binomial` from the `Distribution` dropdown. To find the probability, select `Values` as the `Input type` and enter `15` as the `Upper bound`. In the output below we can see that the probability is 0.989. The probability that exactly 15 laptops are still running after 12 hours is 0.032. + +

+ +## Demand for headphones + +A manufacturer wants to determine the appropriate inventory level for headphones required to achieve a 95% service level. Demand for the headphones obeys a normal distribution with a mean of 3000 and a standard deviation of 800. + +To find the required number of headphones to hold in inventory choose `Normal` from the `Distribution` dropdown and then select `Probability` as the `Input type`. Enter `.95` as the `Upper bound`. In the output below we see the number of units to stock is 4316. + +

+ +## Cups of ice cream + +A **discrete** random variable can take on a limited (finite) number of possible values. The **probability distribution** of a discrete random variable lists these values and their probabilities. For example, probability distribution of the number of cups of ice cream a customer buys could be described as follows: + +* 40% of customers buy 1 cup; +* 30% of customers buy 2 cups; +* 20% of customers buy 3 cups; +* 10% of customers buy 4 cups. + +We can use the probability distribution of a random variable to calculate its **mean** (or **expected value**) as follows; + +$$ + E(C) = \mu_C = 1 \times 0.40 + 2 \times 0.30 + 3 \times 0.20 + 4 \times 0.10 = 2\,, +$$ + +where $\mu_C$ is the mean number of cups purchased. We can _expect_ a randomly selected customer to buy 2 cups. The variance is calculated as follow: + +$$ + Var(C) = (1 - 2)^2 \times 0.4 + (2 - 2)^2 \times 0.3 + (3 - 2)^2 \times 0.2 + (4 - 2)^2 \times 0.1 = 1\,. +$$ + +To get the mean and standard deviation of the discrete probability distribution above, as well as the probability a customer will buy 2 or more cups (0.6), specify the following in the probability calculator. + +

+ +## Hypothesis testing + +You can also use the probability calculator to determine a `p.value` or a `critical value` for a statistical test. See the help files for `Single mean`, `Single proportion`, `Compare means`, `Compare proportions`, `Cross-tabs` in the _Basics_ menu and `Linear regression (OLS)` in the _Model_ menu for details. + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If a plot was created it can be customized using `ggplot2` commands (e.g., `plot(result) + labs(title = "Normal distribution")`). See _Data > Visualize_ for details. + +### R-functions + +For an overview of related R-functions used by Radiant for probability calculations see _Basics > Probability_ + +Key functions from the `stats` package used in the probability calculator: + +* `prob_norm` uses `pnorm`, `qnorm`, and `dnorm` +* `prob_lnorm` uses `plnorm`, `qlnorm`, and `dlnorm` +* `prob_tdist` uses `pt`, `qt`, and `dt` +* `prob_fdist` uses `pf`, `qf`, and `df` +* `prob_chisq` uses `pchisq`, `qchisq`, and `dchisq` +* `prob_unif` uses `punif`, `qunif`, and `dunif` +* `prob_binom` uses `pbinom`, `qbinom`, and `dbinom` +* `prob_expo` uses `pexp`, `qexp`, and `dexp` +* `prob_pois` uses `ppios`, `qpois`, and `dpois` + +### Video Tutorials + +Copy-and-paste the full command below into the RStudio console (i.e., the bottom-left window) and press return to gain access to all materials used in the probability calculator module of the Radiant Tutorial Series: + +
usethis::use_course("https://www.dropbox.com/sh/zw1yuiw8hvs47uc/AABPo1BncYv_i2eZfHQ7dgwCa?dl=1")
+ +Describing the Distribution of a Discrete Random + Variable (#1) + +* This video shows how to summarize information about a discrete random variable using the probability calculator in Radiant +* Topics List: + - Calculate the mean and variance for a discrete random variable by hand + - Calculate the mean, variance, and select probabilities for a discrete random variable in Radiant + +Describing Normal and Binomial Distributions in Radiant(#2) + +* This video shows how to summarize information about Normal and Binomial distributions using the probability calculator in Radiant +* Topics List: + - Calculate probabilities of a random variable following a Normal distribution in Radiant + - Calculate probabilities of a random variable following a Binomial distribution by hand + - Calculate probabilities of a random variable following a Binomial distribution in Radiant + +Describing Uniform and Binomial Distributions in Radiant(#3) + +* This video shows how to summarize information about Uniform and Binomial distributions using the probability calculator in Radiant +* Topics List: + - Calculate probabilities of a random variable following a Uniform distribution in Radiant + - Calculate probabilities of a random variable following a Binomial distribution in Radiant + +Providing Probability Bounds(#4) + +* This video demonstrates how to provide probability bounds in Radiant +* Topics List: + - Use probabilities as input type + - Round up the cutoff value diff --git a/radiant.basics/inst/app/tools/help/prob_calc.md b/radiant.basics/inst/app/tools/help/prob_calc.md new file mode 100644 index 0000000000000000000000000000000000000000..d98e2b9670b7c304f0c17b23ddc7181bf6b8f39b --- /dev/null +++ b/radiant.basics/inst/app/tools/help/prob_calc.md @@ -0,0 +1,105 @@ +> 概率计算器 + +基于二项分布（Binomial）、卡方分布（Chi-squared）、离散分布（Discrete）、F 分布（F）、指数分布（Exponential）、正态分布（Normal）、泊松分布（Poisson）、t 分布（t）或均匀分布（Uniform）计算概率或数值。 + +## 电池测试 + +假设《消费者报告》（CR）想要测试制造商关于电池寿命的声明。制造商声称，超过 90% 的电池可为笔记本电脑提供至少 12 小时的连续使用电力。CR 为 20 台相同的笔记本电脑配备了该制造商的电池。如果制造商的声明准确，那么 15 台或更多笔记本电脑在 12 小时后仍能运行的概率是多少？ + +问题描述表明我们应从 “分布（Distribution）” 下拉菜单中选择 “二项分布（Binomial）”。要计算概率，选择 “数值（Values）” 作为 “输入类型（Input type）”，并输入`15`作为 “上限（Upper bound）”。在下方输出中，我们可以看到该概率为 0.989。恰好 15 台笔记本电脑在 12 小时后仍能运行的概率为 0.032。 + +

+ +## 耳机需求 + +制造商希望确定耳机的适当库存水平，以实现 95% 的服务水平。耳机需求服从均值为 3000、标准差为 800 的正态分布。 + +要找到所需持有的耳机库存数量，从 “分布（Distribution）” 下拉菜单中选择 “正态分布（Normal）”，然后选择 “概率（Probability）” 作为 “输入类型（Input type）”。输入`.95`作为 “上限（Upper bound）”。在下方输出中，我们看到应备货的数量为 4316 台。 + +

+ +## 冰淇淋杯数 + +**离散**随机变量只能取有限个可能的值。离散随机变量的**概率分布**列出了这些值及其概率。例如，顾客购买冰淇淋杯数的概率分布可描述如下： + +* 40% 的顾客购买 1 杯； +* 30% 的顾客购买 2 杯； +* 20% 的顾客购买 3 杯； +* 10% 的顾客购买 4 杯。 + +我们可以使用随机变量的概率分布计算其**均值**（或**期望价值**）： + +$$ + E(C) = \mu_C = 1 \times 0.40 + 2 \times 0.30 + 3 \times 0.20 + 4 \times 0.10 = 2\,, +$$ + +其中μC是购买杯数的均值。我们可以**预期**随机选择的顾客会购买 2 杯。方差计算如下： + +$$ + Var(C) = (1 - 2)^2 \times 0.4 + (2 - 2)^2 \times 0.3 + (3 - 2)^2 \times 0.2 + (4 - 2)^2 \times 0.1 = 1\,. +$$ + +要获取上述离散概率分布的均值和标准差，以及顾客购买 2 杯或更多杯的概率（0.6），在概率计算器中进行如下设置。 + +

+ +## 假设检验 + +你也可以使用概率计算器确定统计检验的`p值（p.value）`或`临界值（critical value）`。详见 “基础（Basics）” 菜单中 “单样本均值（Single mean）”、“单样本比例（Single proportion）”、“均值比较（Compare means）”、“比例比较（Compare proportions）”、“交叉表（Cross-tabs）” 以及 “模型（Model）” 菜单中 “线性回归（OLS）” 的帮助文件。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令进行自定义（例如，`plot(result) + labs(title = "正态分布")`）。详情请参见*数据 > 可视化*。 + +### R 函数 + +有关 Radiant 中用于概率计算的相关 R 函数概述，请参见*基础 > 概率*。 + +概率计算器中使用的来自`stats`包的核心函数： + +* `prob_norm`使用`pnorm`、`qnorm`和`dnorm` +* `prob_lnorm`使用`plnorm`、`qlnorm`和`dlnorm` +* `prob_tdist`使用`pt`、`qt`和`dt` +* `prob_fdist`使用`pf`、`qf`和`df` +* `prob_chisq`使用`pchisq`、`qchisq`和`dchisq` +* `prob_unif`使用`punif`、`qunif`和`dunif` +* `prob_binom`使用`pbinom`、`qbinom`和`dbinom` +* `prob_expo`使用`pexp`、`qexp`和`dexp` +* `prob_pois`使用`ppois`、`qpois`和`dpois` + +### 视频教程 + +将以下完整命令复制粘贴到 RStudio 控制台（即左下角窗口），按回车即可获取 Radiant 教程系列中概率计算器模块使用的所有材料： + +
usethis::use_course("https://www.dropbox.com/sh/zw1yuiw8hvs47uc/AABPo1BncYv_i2eZfHQ7dgwCa?dl=1")
+ +描述离散随机变量的分布（一） + +- 本视频展示如何使用 Radiant 中的概率计算器汇总离散随机变量的信息 +- 主题列表： + - 手动计算离散随机变量的均值和方差 + - 在 Radiant 中计算离散随机变量的均值、方差和特定概率 + +在 Radiant 中描述正态分布和二项分布（二） + +- 本视频展示如何使用 Radiant 中的概率计算器汇总正态分布和二项分布的信息 +- 主题列表： + - 在 Radiant 中计算服从正态分布的随机变量的概率 + - 手动计算服从二项分布的随机变量的概率 + - 在 Radiant 中计算服从二项分布的随机变量的概率 + +在 Radiant 中描述均匀分布和二项分布（三） + +- 本视频展示如何使用 Radiant 中的概率计算器汇总均匀分布和二项分布的信息 +- 主题列表： + - 在 Radiant 中计算服从均匀分布的随机变量的概率 + - 在 Radiant 中计算服从二项分布的随机变量的概率 + +设置概率边界（四） + +- 本视频演示如何在 Radiant 中设置概率边界 +- 主题列表： + - 使用概率作为输入类型 + - 对临界值向上取整 diff --git a/radiant.basics/inst/app/tools/help/single_mean.md b/radiant.basics/inst/app/tools/help/single_mean.md new file mode 100644 index 0000000000000000000000000000000000000000..0aa97440684706a576fe4902bffc4de1821ea478 --- /dev/null +++ b/radiant.basics/inst/app/tools/help/single_mean.md @@ -0,0 +1,82 @@ +> 将单个均值与总体均值进行比较 + +单样本均值 t 检验（或单样本 t 检验）用于将样本数据中某个变量的均值与我们样本数据所来自的总体中的（假设）均值进行比较。这很重要，因为我们很少能获取整个总体的数据。“比较值（Comparison value）” 框中指定了总体中的假设值。 + +我们可以执行单侧检验（即`小于`或`大于`）或双侧检验（见 “备择假设（Alternative hypothesis）” 下拉菜单）。单侧检验用于评估现有数据是否提供证据表明样本均值大于（或小于）比较值（即原假设中的总体值）。 + +## 示例 + +我们获取了英国杂货店随机样本的数据。如果该产品类别的消费者需求超过 1 亿单位（即每家店约 1750 单位），管理层将考虑进入该市场。样本中每家店的平均需求为 1953 单位。虽然这个数字大于 1750，但我们需要确定这种差异是否可能由抽样误差导致。 + +你可以在**demand_uk.rda**数据集中找到各样本店的单位销售量信息。该数据集包含两个变量：`store_id`（店铺 ID）和`demand_uk`（英国需求）。我们的原假设是英国每家店的平均需求等于 1750 单位，因此将该数值输入 “比较值（Comparison value）” 框。我们从 “备择假设（Alternative hypothesis）” 下拉菜单中选择 “大于（Greater than）” 选项，因为我们想确定现有数据是否提供足够证据拒绝原假设，支持英国每家店的平均需求**大于 1750 单位**的备择假设。 + +

+ +输出的前两个区块显示检验的基本信息（如原假设和备择假设）和汇总统计量（如均值、标准差、标准误、误差边际等）。输出的最后一行显示以下内容： + +- `diff`是样本均值（1953.393）与比较值（1750）之间的差值 +- `se`是标准误（即`diff`抽样分布的标准差） +- `t.value`是与`diff`相关的 t 统计量，可与 t 分布比较（即`diff` / `se`） +- `p.value`是在原假设为真时，找到与`diff`一样极端或更极端值的概率 +- `df`是统计检验的自由度（即 n - 1） +- `5% 100%`显示样本均值的 95% 置信区间（1897 至无穷大）。这些数值提供了真实总体均值可能落入的范围 + +### 检验方法 + +我们可以使用三种方法评估原假设。我们选择显著性水平为 0.05。1 当然，每种方法会得出相同结论。 + +#### p 值 + +由于 p 值**小于**常规显著性水平（即 0.05），我们拒绝原假设，并建议管理层应进入英国市场。注意，“***” 用作显著性指标。 + +#### 置信区间 + +由于 “比较值”**未**包含在置信区间内，我们拒绝原假设，并建议管理层应进入英国市场。 + +#### t 值 + +由于计算的 t 值（5.967）**大于**临界 t 值，我们拒绝原假设，并建议管理层应进入英国市场。可通过 “基础（Basics）” 菜单中的概率计算器获取临界 t 值。对于自由度为 571 的 t 分布（见`df`），临界 t 值为 1.648。由于备择假设是 “大于（Greater than）”，我们必须输入 0.95 作为上侧概率界（即 1 - 0.05）。2 + +

+ +除 “摘要（Summary）” 标签页中的数值输出外，我们还可以在 “绘图（Plot）” 标签页中可视化数据。侧边栏中的设置与之前相同。直方图中的黑线显示样本均值（实线）和样本均值的置信区间（虚线）。红线显示比较值（即原假设下的单位销售量）。由于红线**未**落在置信区间（1897 至无穷大）内，我们拒绝原假设，接受备择假设。 + +

+ +### 统计术语 + +这是**单样本均值**检验，原假设为真实总体**均值**等于**1750**。使用 0.05 的显著性水平，我们拒绝原假设，并得出结论：真实总体**均值** **大于**1750。 + +该检验的 p 值为 **< .001**。这是在原假设为真时，观察到与数据中样本**均值**一样极端或更极端的样本**均值**的概率。在本例中，它是当真实总体**均值**为**1750**时，观察到样本**均值**大于（或等于）**1953.393**的概率。 + +5% 置信界为**1897.233**。如果重复抽样并为每个样本计算 5% 置信界，真实总体均值将在 95% 的样本中超过该下界。 + +1**显著性水平**（通常用α表示）是你愿意接受的、在原假设实际为真时拒绝原假设的最高概率。常用的显著性水平为 0.05（或 5%）。 + +2 1−α称为**置信水平**。常用的置信水平为 0.95（或 95%）。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令进行自定义（例如，`plot(result, plots = "hist", custom = TRUE) + labs(title = "直方图")`）。详情请参见*数据 > 可视化*。 + +### R 函数 + +有关 Radiant 中用于评估均值的相关 R 函数概述，请参见*基础 > 均值*。 + +`single_mean`工具中使用的来自`stats`包的核心函数是`t.test`。 + +### 视频教程 + +将以下完整命令复制粘贴到 RStudio 控制台（即左下角窗口），按回车即可获取 Radiant 教程系列中假设检验模块使用的所有材料： + +
usethis::use_course("https://www.dropbox.com/sh/0xvhyolgcvox685/AADSppNSIocrJS-BqZXhD1Kna?dl=1")
+ +单样本均值假设检验 + +- 本视频展示如何检验关于单样本均值与总体均值的假设 +- 主题列表： + - 计算样本的汇总统计量 + - 在 Radiant 中设置单样本均值的假设检验 + - 使用 p 值、置信区间或临界值评估假设检验 diff --git a/radiant.basics/inst/app/tools/help/single_prop.md b/radiant.basics/inst/app/tools/help/single_prop.md new file mode 100644 index 0000000000000000000000000000000000000000..79ce589c5b2f7a4f129735e810926f3d3435deec --- /dev/null +++ b/radiant.basics/inst/app/tools/help/single_prop.md @@ -0,0 +1,87 @@ +> 将单个比例与总体比例进行比较 + +单样本比例检验（或单样本二项检验）用于将样本数据中某类响应或取值的比例与我们样本数据所来自的总体中的（假设）比例进行比较。这很重要，因为我们很少能获取整个总体的数据。“比较值（Comparison value）” 框中指定了总体中的假设值。 + +我们可以执行单侧检验（即`小于`或`大于`）或双侧检验（见 “备择假设（Alternative hypothesis）” 下拉菜单）。单侧检验用于评估现有数据是否提供证据表明样本比例大于（或小于）比较值（即原假设中的总体值）。 + +## 示例 + +一家汽车制造商通过在新目标市场随机抽样并采访 1000 名消费者开展了一项研究。研究目标是确定消费者是否会考虑购买该品牌汽车。 + +管理层已决定公司将进入该细分市场。但如果品牌偏好率低于 10%，将投入额外资源用于广告和赞助，以提高目标消费者中的品牌知名度。在样本中，有 93 名消费者表现出公司所认为的强烈品牌喜爱度。 + +你可以在**consider.rda**数据集中找到调查参与者的响应信息。该数据集包含两个变量：`id`和`consider`。 + +我们的原假设是，会考虑在未来购买该汽车品牌的消费者比例等于 10%。从 “变量（Variable）” 下拉菜单中选择`consider`变量。要评估样本中`yes`响应的比例，从 “选择水平（Choose level）” 下拉菜单中选择`yes`。 + +从 “备择假设（Alternative hypothesis）” 下拉菜单中选择 “小于（Less than）” 选项，以确定现有数据是否提供足够证据拒绝原假设，支持 “会考虑该品牌的消费者比例**小于 10%**” 的备择假设。 + +

+ +输出的前两个区块显示检验的基本信息（如原假设和备择假设）和汇总统计量（如 “yes” 响应的比例、标准误、误差边际等）。输出的最后一行显示以下内容： + +- `diff`是样本比例（0.093）与比较值（0.1）之间的差值 +- `ns`是成功次数。这是我们可以与参数为n=1000和p=0.10的二项分布进行比较的数量 +- `p.value`是在原假设为真时，找到与`diff`一样极端或更极端值的概率 +- `0% 95%`显示样本比例的 95% 置信区间（0 至 0.11）。这些数值提供了真实总体比例可能落入的范围 + +### 检验方法 + +我们可以使用三种方法评估原假设。我们选择显著性水平为 0.05。1 当然，每种方法会得出相同结论。 + +#### p 值 + +由于 p 值**大于**常规显著性水平（0.249>0.05），我们**不能**拒绝原假设，且**不建议**管理层投入资源提高品牌知名度。 + +我们也可以通过 “基础（Basics）” 菜单中的概率计算器获取 p 值。在参数为n=1000和p=0.1的二项分布中，输入数据中的成功次数（93）作为下界（值）。p 值是观察到与样本中 93 次成功一样极端或更极端的成功次数的概率。我们看到P(X<=93)=0.249，这与 “基础> 比例 > 单样本比例” 中的结果相同。 + +

+ +#### 置信区间 + +由于 “比较值”**包含在**置信区间内（即0<0.1<0.11），我们**不能**拒绝原假设，且**不建议**管理层投入资源提高品牌知名度。 + +#### 成功次数 + +我们可以通过 “基础（Basics）” 菜单中的概率计算器获取临界值。对于参数为n=1000和p=0.1的二项分布，临界值为 85。由于备择假设是 “小于（Less than）”，我们必须输入 0.05 作为下侧概率界。2 + +

+ +由于成功次数（即 “yes” 响应的数量）**大于**临界值（93 vs 85），我们**不能**拒绝原假设，且**不建议**管理层投入资源提高品牌知名度。 + +### 统计术语 + +这是**单样本比例**检验，原假设为真实总体**比例**等于**0.1**。使用 0.05 的显著性水平，我们**不能**拒绝原假设，且**不能**得出真实总体**比例** **小于**0.1 的结论。 + +该检验的 p 值为**0.249**。这是在原假设为真时，观察到与从数据中估计的样本**比例**（或**成功次数**）一样极端或更极端的样本值的概率。在本例中，它是当真实总体**比例**为**0.1**时，观察到样本**比例**（**成功次数**）小于（或等于）**0.093**（**93**）的概率。 + +95% 置信界为**0.11**。如果重复抽样并为每个样本计算 95% 置信界，真实总体比例将在 95% 的样本中低于该界值。 + +1**显著性水平**（通常用α表示）是你愿意接受的、在原假设实际为真时拒绝原假设的最高概率。常用的显著性水平为 0.05（或 5%）。 + +2 1−α称为**置信水平**。常用的置信水平为 0.95（或 95%）。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令进行自定义（例如，`plot(result, plots = "bar", custom = TRUE) + labs(y = "百分比")`）。详情请参见*数据 > 可视化*。 + +### R 函数 + +有关 Radiant 中用于评估比例的相关 R 函数概述，请参见*基础 > 比例*。 + +`single_prop`工具中使用的来自`stats`包的核心函数是`binom.test`和`prop.test`。 + +### 视频教程 + +将以下完整命令复制粘贴到 RStudio 控制台（即左下角窗口），按回车即可获取 Radiant 教程系列中假设检验模块使用的所有材料： + +
usethis::use_course("https://www.dropbox.com/sh/0xvhyolgcvox685/AADSppNSIocrJS-BqZXhD1Kna?dl=1")
+ +单样本比例假设检验 + +- 本视频展示如何检验关于单样本比例与总体比例的假设 +- 主题列表： + - 在 Radiant 中设置单样本比例的假设检验 + - 使用 p 值、置信区间或临界值评估假设检验 diff --git a/radiant.basics/inst/app/ui.R b/radiant.basics/inst/app/ui.R new file mode 100644 index 0000000000000000000000000000000000000000..3b532d0e954e66cbf682cc7859682a9db4f1e44e --- /dev/null +++ b/radiant.basics/inst/app/ui.R @@ -0,0 +1,13 @@ +## ui for basics menu in radiant +navbar_proj( + do.call( + navbarPage, + c( + "Radiant for R", + getOption("radiant.nav_ui"), + getOption("radiant.basics_ui"), + getOption("radiant.shared_ui"), + help_menu("help_basics_ui") + ) + ) +) diff --git a/radiant.basics/inst/app/www/js/run_return.js b/radiant.basics/inst/app/www/js/run_return.js new file mode 100644 index 0000000000000000000000000000000000000000..8c79126445cd0cd7fa4e5c12da462b8eca9e9ea3 --- /dev/null +++ b/radiant.basics/inst/app/www/js/run_return.js @@ -0,0 +1,5 @@ +$(document).keydown(function(event) { + if ($("#cor_name").is(":focus") && event.keyCode == 13) { + $("#cor_store").click(); + } +}); diff --git a/radiant.basics/inst/translations/translation_zh.csv b/radiant.basics/inst/translations/translation_zh.csv new file mode 100644 index 0000000000000000000000000000000000000000..a29bf6a2e8e532c5c23bde7c4b9e56da8e11dc6a --- /dev/null +++ b/radiant.basics/inst/translations/translation_zh.csv @@ -0,0 +1,220 @@ +en,zh,source +Help,帮助,"global.R, radiant.R" +Keyboard shortcuts,键盘快捷键,global.R +Normal,正态分布,clt_ui.R +Binomial,二项分布,clt_ui.R +Uniform,均匀分布,clt_ui.R +Exponential,指数分布,clt_ui.R +Sum,求和,clt_ui.R +Mean,平均值,clt_ui.R +Run simulation,运行模拟,clt_ui.R +Re-run simulation,重新运行模拟,clt_ui.R +Distribution:,分布：,clt_ui.R +Min:,最小值：,clt_ui.R +Max:,最大值：,clt_ui.R +Mean:,均值：,clt_ui.R +SD:,标准差：,clt_ui.R +Rate:,速率：,clt_ui.R +Size:,样本量：,clt_ui.R +Prob:,概率：,clt_ui.R +Sample size:,样本大小：,clt_ui.R +# of samples:,样本数量：,clt_ui.R +Number of bins:,分箱数量：,clt_ui.R +Central Limit Theorem,中心极限定理,clt_ui.R +Basics > Probability,基础 > 概率,clt_ui.R +Please choose a sample size larger than 2,请选择一个大于 2 的样本大小,clt_ui.R +Please choose 2 or more samples,请选择 2 个或更多样本,clt_ui.R +Please choose a minimum value for the uniform distribution,请为均匀分布选择一个最小值,clt_ui.R +Please choose a maximum value for the uniform distribution,请为均匀分布选择一个最大值,clt_ui.R +The maximum value for the uniform distribution\nmust be larger than the minimum value,均匀分布的最大值必须大于最小值,clt_ui.R +Please choose a mean value for the normal distribution,请为正态分布选择一个均值,clt_ui.R +Please choose a non-zero standard deviation for the normal distribution,请为正态分布选择一个非零的标准差,clt_ui.R +Please choose a rate larger than 1 for the exponential distribution,请为指数分布选择一个大于 1 的速率,clt_ui.R +Please choose a size parameter larger than 1 for the binomial distribution,请为二项分布选择一个大于 1 的大小参数,clt_ui.R +Please choose a probability between 0 and 1 for the binomial distribution,请为二项分布选择一个介于 0 到 1 之间的概率,clt_ui.R +** Press the Run simulation button to simulate data **,** 点击运行模拟按钮以生成数据 **,clt_ui.R +Generating plots,正在生成图形,"clt_ui.R, compare_means_ui.R" +Save central limit theorem plot,保存中心极限定理图,clt_ui.R +Two sided,双侧,compare_means_ui.R +Less than,小于,compare_means_ui.R +Greater than,大于,compare_means_ui.R +independent,独立样本,compare_means_ui.R +paired,配对样本,compare_means_ui.R +None,无,compare_means_ui.R +Bonferroni,Bonferroni 校正,compare_means_ui.R +Scatter,散点图,compare_means_ui.R +Box,箱线图,compare_means_ui.R +Density,密度图,compare_means_ui.R +Bar,条形图,compare_means_ui.R +Select a factor or numeric variable:,选择一个因子或数值变量：,compare_means_ui.R +Numeric variable(s):,数值变量（可多选）：,compare_means_ui.R +Numeric variable:,数值变量：,compare_means_ui.R +Choose combinations:,选择组合：,compare_means_ui.R +Evaluate all combinations,评估所有组合,compare_means_ui.R +Alternative hypothesis:,备择假设：,compare_means_ui.R +Confidence level:,置信水平：,compare_means_ui.R +Show additional statistics,显示额外统计量,compare_means_ui.R +Sample type:,样本类型：,compare_means_ui.R +Multiple comp. adjustment:,多重比较校正：,compare_means_ui.R +Test type:,检验类型：,compare_means_ui.R +t-test,t 检验,compare_means_ui.R +Wilcox,Wilcoxon 检验,compare_means_ui.R +Select plots:,选择绘图类型：,compare_means_ui.R +Select plots,选择绘图,compare_means_ui.R +Compare means,均值比较,compare_means_ui.R +Summary,摘要,compare_means_ui.R +Plot,图形,compare_means_ui.R +Basics > Means,基础 > 均值,compare_means_ui.R +"This analysis requires at least two variables. The first can be of type +factor, numeric, or interval. The second must be of type numeric or interval. +If these variable types are not available please select another dataset. + +","该分析至少需要两个变量。 +第一个变量可以是因子、数值或区间类型，第二个变量必须是数值或区间类型。 +如果这些类型的变量不可用，请选择其他数据集。 + +",compare_means_ui.R +Nothing to plot. Please select a plot type,没有可绘制的内容，请选择绘图类型,compare_means_ui.R +Save compare means plot,保存均值比较图,compare_means_ui.R +Basics > Proportions,基础 > 比例,compare_props_ui.R +Compare proportions,比较比例,compare_props_ui.R +"This analysis requires two categorical variables. The first must have +two or more levels. The second can have only two levels. If these +variable types are not available please select another dataset. + +","该分析需要两个分类变量。 +第一个变量必须具有两个或更多水平，第二个变量只能有两个水平。 +如果这些变量类型不可用，请选择其他数据集。 + +",compare_props_ui.R +Select a grouping variable:,选择分组变量：,compare_props_ui.R +Save compare proportions plot,保存比较比例图,compare_props_ui.R +Dodge,并列柱状图,compare_props_ui.R +Variable (select one):,变量（选择一个）：,compare_props_ui.R +Pearson,皮尔逊积矩相关,correlation_ui.R +Spearman,斯皮尔曼秩相关,correlation_ui.R +Kendall,肯德尔秩相关,correlation_ui.R +Calculate correlation,计算相关性,correlation_ui.R +Basics > Tables,基础 > 表格,correlation_ui.R +Correlation,相关性,correlation_ui.R +Adjust for {factor} variables,针对 {factor} 变量进行调整,correlation_ui.R +Calculate adjusted p.values,计算调整后的 p 值,correlation_ui.R +Correlation cutoff:,相关性阈值:,correlation_ui.R +Show covariance matrix,显示协方差矩阵,correlation_ui.R +Store,存储,correlation_ui.R +"This analysis requires two or more variables or type numeric, integer,or date. If these variable types are not available please select another dataset.",该分析需要两个或以上的数值型、整数型或日期型变量。如果这些变量类型不可用，请选择其他数据集。,correlation_ui.R +Method:,方法:,correlation_ui.R +Acquiring variable information,正在获取变量信息,correlation_ui.R +Select variables:,选择变量:,correlation_ui.R +Store as data.frame:,存储为数据框:,correlation_ui.R +"This analysis requires two or more variables or type numeric,\ninteger,or date. If these variable types are not available\nplease select another dataset.\n\n",本分析需要两个或以上的变量，并且类型必须是数值型、整数型或日期型。如果这些变量类型不可用，请选择其他数据集。,correlation_ui.R +Save correlation plot,保存相关性图表,correlation_ui.R +Number of data points plotted:,绘制的数据点数量：,correlation_ui.R +"This analysis requires two or more variables or type numeric, +integer,or date. If these variable types are not available +please select another dataset. + +","本分析需要两个或以上的变量，并且类型必须是数值型、整数型或日期型。 +如果这些变量类型不可用，请选择其他数据集。 + +",correlation_ui.R +Re-calculate correlations,重新计算相关系数,correlation_ui.R +Observed,观察值,cross_tabs_ui.R +Expected,期望值,cross_tabs_ui.R +Chi-squared,卡方值,cross_tabs_ui.R +Deviation std.,标准差偏差,cross_tabs_ui.R +Row percentages,行百分比,cross_tabs_ui.R +Column percentages,列百分比,cross_tabs_ui.R +Table percentages,表格百分比,cross_tabs_ui.R +Cross-tabs,交叉表,cross_tabs_ui.R +"This analysis requires two categorical variables. Both must have two or more levels. +If these variable types are not available please select another dataset. + +","此分析需要两个分类变量，且每个变量必须至少有两个水平。 +如果这些类型的变量不可用，请选择其他数据集。 + +",cross_tabs_ui.R +Select a categorical variable:,请选择一个分类变量：,cross_tabs_ui.R +Save cross-tabs plot,保存交叉表图形,cross_tabs_ui.R +Goodness of fit,拟合优度检验,goodness_ui.R +"This analysis requires a categorical variables with two or more levels. +If such a variable type is not available please select another dataset. + +","此分析需要一个具有两个或以上水平的分类变量。 +如果没有这种类型的变量，请选择其他数据集。 + +",goodness_ui.R +Save goodness of fit plot,保存拟合优度检验图形,goodness_ui.R +Probabilities:,概率：,goodness_ui.R +"Enter probabilities (e.g., 1/2 1/2)",输入概率（例如：1/2 1/2）,goodness_ui.R +Discrete,离散分布,prob_calc_ui.R +F,F 分布,prob_calc_ui.R +Log normal,对数正态,prob_calc_ui.R +Poisson,泊松分布,prob_calc_ui.R +Values,数值,prob_calc_ui.R +Probability calculator,概率计算器,prob_calc_ui.R +Input type:,输入类型：,prob_calc_ui.R +Decimals:,小数位数：,prob_calc_ui.R +Save probability calculator plot,保存概率计算器图形,prob_calc_ui.R +Please provide a mean and standard deviation (> 0),请提供平均值和标准差（标准差需大于 0）,prob_calc_ui.R +St. dev:,标准差：,prob_calc_ui.R +Lower bound:,下限：,prob_calc_ui.R +Upper bound:,上限：,prob_calc_ui.R +Provide an integer value for the number of decimal places,请输入整数，表示保留的小数位数,prob_calc_ui.R +"Please provide a set of values and probabilities. +Separate numbers using spaces (e.g., 1/2 1/2)","请提供一组数值和对应的概率。 +请用空格分隔（例如：1/2 1/2）",prob_calc_ui.R +Values:,数值：,prob_calc_ui.R +Please provide a value for n (number of trials) and p (probability of success),请提供试验次数 (n) 和成功概率 (p) 的值,prob_calc_ui.R +Please provide a minimum and a maximum value,请提供最小值和最大值,prob_calc_ui.R +Please provide a value for the degrees of freedom (> 0),请提供大于 0 的自由度值,prob_calc_ui.R +"Please provide a value for Degrees of freedom 1 (> 0) +and for Degrees of freedom 2 (> 4)",请提供自由度 1（大于 0）和自由度 2（大于 4）的值,prob_calc_ui.R +Please provide a value for the rate (> 0),请提供大于 0 的速率值,prob_calc_ui.R +Please provide a value for lambda (> 0),请提供大于 0 的 λ（Lambda）值,prob_calc_ui.R +n:,试验次数：,prob_calc_ui.R +p:,成功概率：,prob_calc_ui.R +Degrees of freedom:,自由度：,prob_calc_ui.R +Degrees of freedom 1:,自由度 1：,prob_calc_ui.R +Degrees of freedom 2:,自由度 2：,prob_calc_ui.R +Mean log:,对数均值：,prob_calc_ui.R +St. dev log:,对数标准差：,prob_calc_ui.R +Lambda:,λ：,prob_calc_ui.R +Histogram,直方图,single_mean_ui.R +Simulate,模拟,single_mean_ui.R +Single mean,单样本均值,single_mean_ui.R +Comparison value:,比较值：,single_mean_ui.R +"This analysis requires a variable of type numeric or interval. If none are +available please select another dataset. + +","此分析需要一个数值型或区间型变量。 +如果当前数据集中没有此类变量，请选择其他数据集。 + +",single_mean_ui.R +Save single mean plot,保存单样本均值图表,single_mean_ui.R +Single proportion,单样本比例,single_prop_ui.R +Binomial exact,精确二项检验,single_prop_ui.R +Z-test,Z 检验,single_prop_ui.R +Choose level:,选择水平：,single_prop_ui.R +"This analysis requires a categorical variable. In none are available +please select another dataset. + +","本分析需要一个分类变量。 +如果没有可用的分类变量，请选择其他数据集。 + +",single_prop_ui.R +Save single proportion plot,保存单样本比例图,single_prop_ui.R +Basics,基础,init.R +Probability,概率,init.R +Probability calculator,概率计算器,init.R +Central Limit Theorem,中心极限定理,init.R +Means,均值,init.R +Single mean,单样本均值,init.R +Compare means,均值比较,init.R +Proportions,比例,init.R +Single proportion,单样本比例,init.R +Compare proportions,比例比较,init.R +Tables,表格,init.R +Goodness of fit,拟合优度,init.R +Cross-tabs,交叉表,init.R +Correlation,相关性,init.R diff --git a/radiant.basics/man/clt.Rd b/radiant.basics/man/clt.Rd new file mode 100644 index 0000000000000000000000000000000000000000..818c961a7b7bff10163b58af0c90df128b03f496 --- /dev/null +++ b/radiant.basics/man/clt.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/clt.R +\name{clt} +\alias{clt} +\title{Central Limit Theorem simulation} +\usage{ +clt( + dist, + n = 100, + m = 100, + norm_mean = 0, + norm_sd = 1, + binom_size = 10, + binom_prob = 0.2, + unif_min = 0, + unif_max = 1, + expo_rate = 1 +) +} +\arguments{ +\item{dist}{Distribution to simulate} + +\item{n}{Sample size} + +\item{m}{Number of samples} + +\item{norm_mean}{Mean for the normal distribution} + +\item{norm_sd}{Standard deviation for the normal distribution} + +\item{binom_size}{Size for the binomial distribution} + +\item{binom_prob}{Probability for the binomial distribution} + +\item{unif_min}{Minimum for the uniform distribution} + +\item{unif_max}{Maximum for the uniform distribution} + +\item{expo_rate}{Rate for the exponential distribution} +} +\value{ +A list with the name of the Distribution and a matrix of simulated data +} +\description{ +Central Limit Theorem simulation +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/clt.html} for an example in Radiant +} +\examples{ +clt("Uniform", 10, 10, unif_min = 10, unif_max = 20) + +} diff --git a/radiant.basics/man/compare_means.Rd b/radiant.basics/man/compare_means.Rd new file mode 100644 index 0000000000000000000000000000000000000000..399cf1610384e0b3c4c7bd397175aa5ef6a29118 --- /dev/null +++ b/radiant.basics/man/compare_means.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/compare_means.R +\name{compare_means} +\alias{compare_means} +\title{Compare sample means} +\usage{ +compare_means( + dataset, + var1, + var2, + samples = "independent", + alternative = "two.sided", + conf_lev = 0.95, + comb = "", + adjust = "none", + test = "t", + data_filter = "", + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{var1}{A numeric variable or factor selected for comparison} + +\item{var2}{One or more numeric variables for comparison. If var1 is a factor only one variable can be selected and the mean of this variable is compared across (factor) levels of var1} + +\item{samples}{Are samples independent ("independent") or not ("paired")} + +\item{alternative}{The alternative hypothesis ("two.sided", "greater" or "less")} + +\item{conf_lev}{Span of the confidence interval} + +\item{comb}{Combinations to evaluate} + +\item{adjust}{Adjustment for multiple comparisons ("none" or "bonf" for Bonferroni)} + +\item{test}{t-test ("t") or Wilcox ("wilcox")} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{envir}{Environment to extract data from} +} +\value{ +A list of all variables defined in the function as an object of class compare_means +} +\description{ +Compare sample means +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/compare_means.html} for an example in Radiant +} +\examples{ +compare_means(diamonds, "cut", "price") \%>\% str() + +} +\seealso{ +\code{\link{summary.compare_means}} to summarize results + +\code{\link{plot.compare_means}} to plot results +} diff --git a/radiant.basics/man/compare_props.Rd b/radiant.basics/man/compare_props.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d4e1cdf2eec88fdbe9f02f2e725ca3780cba2adc --- /dev/null +++ b/radiant.basics/man/compare_props.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/compare_props.R +\name{compare_props} +\alias{compare_props} +\title{Compare sample proportions across groups} +\usage{ +compare_props( + dataset, + var1, + var2, + levs = "", + alternative = "two.sided", + conf_lev = 0.95, + comb = "", + adjust = "none", + data_filter = "", + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{var1}{A grouping variable to split the data for comparisons} + +\item{var2}{The variable to calculate proportions for} + +\item{levs}{The factor level selected for the proportion comparison} + +\item{alternative}{The alternative hypothesis ("two.sided", "greater" or "less")} + +\item{conf_lev}{Span of the confidence interval} + +\item{comb}{Combinations to evaluate} + +\item{adjust}{Adjustment for multiple comparisons ("none" or "bonf" for Bonferroni)} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{envir}{Environment to extract data from} +} +\value{ +A list of all variables defined in the function as an object of class compare_props +} +\description{ +Compare sample proportions across groups +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/compare_props.html} for an example in Radiant +} +\examples{ +compare_props(titanic, "pclass", "survived") \%>\% str() + +} +\seealso{ +\code{\link{summary.compare_props}} to summarize results + +\code{\link{plot.compare_props}} to plot results +} diff --git a/radiant.basics/man/consider.Rd b/radiant.basics/man/consider.Rd new file mode 100644 index 0000000000000000000000000000000000000000..b340dfbef754283e2baf633a77414977536813c7 --- /dev/null +++ b/radiant.basics/man/consider.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{consider} +\alias{consider} +\title{Car brand consideration} +\format{ +A data frame with 1000 rows and 2 variables +} +\usage{ +data(consider) +} +\description{ +Car brand consideration +} +\details{ +Survey data of consumer purchase intentions. Description provided in attr(consider,"description") +} +\keyword{datasets} diff --git a/radiant.basics/man/cor2df.Rd b/radiant.basics/man/cor2df.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f0e54e32d823dcb0920e9d709df2766d7a1b748b --- /dev/null +++ b/radiant.basics/man/cor2df.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/correlation.R +\name{cor2df} +\alias{cor2df} +\title{Store a correlation matrix as a (long) data.frame} +\usage{ +cor2df(object, labels = c("label1", "label2"), ...) +} +\arguments{ +\item{object}{Return value from \code{\link{correlation}}} + +\item{labels}{Column names for the correlation pairs} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Store a correlation matrix as a (long) data.frame +} +\details{ +Return the correlation matrix as a (long) data.frame. See \url{https://radiant-rstats.github.io/docs/basics/correlation.html} for an example in Radiant +} diff --git a/radiant.basics/man/correlation.Rd b/radiant.basics/man/correlation.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f3a4049cb3c6a8de27a9919c16fe044008a5690c --- /dev/null +++ b/radiant.basics/man/correlation.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/correlation.R +\name{correlation} +\alias{correlation} +\title{Calculate correlations for two or more variables} +\usage{ +correlation( + dataset, + vars = "", + method = "pearson", + hcor = FALSE, + hcor_se = FALSE, + data_filter = "", + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{vars}{Variables to include in the analysis. Default is all but character and factor variables with more than two unique values are removed} + +\item{method}{Type of correlations to calculate. Options are "pearson", "spearman", and "kendall". "pearson" is the default} + +\item{hcor}{Use polycor::hetcor to calculate the correlation matrix} + +\item{hcor_se}{Calculate standard errors when using polycor::hetcor} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{envir}{Environment to extract data from} +} +\value{ +A list with all variables defined in the function as an object of class compare_means +} +\description{ +Calculate correlations for two or more variables +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/correlation.html} for an example in Radiant +} +\examples{ +correlation(diamonds, c("price", "carat")) \%>\% str() +correlation(diamonds, "x:z") \%>\% str() + +} +\seealso{ +\code{\link{summary.correlation}} to summarize results + +\code{\link{plot.correlation}} to plot results +} diff --git a/radiant.basics/man/cross_tabs.Rd b/radiant.basics/man/cross_tabs.Rd new file mode 100644 index 0000000000000000000000000000000000000000..1456c010c70770630d8b5f69757ed291dfb3b98d --- /dev/null +++ b/radiant.basics/man/cross_tabs.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cross_tabs.R +\name{cross_tabs} +\alias{cross_tabs} +\title{Evaluate associations between categorical variables} +\usage{ +cross_tabs( + dataset, + var1, + var2, + tab = NULL, + data_filter = "", + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset (i.e., a data.frame or table)} + +\item{var1}{A categorical variable} + +\item{var2}{A categorical variable} + +\item{tab}{Table with frequencies as alternative to dataset} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{envir}{Environment to extract data from} +} +\value{ +A list of all variables used in cross_tabs as an object of class cross_tabs +} +\description{ +Evaluate associations between categorical variables +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/cross_tabs.html} for an example in Radiant +} +\examples{ +cross_tabs(newspaper, "Income", "Newspaper") \%>\% str() +table(select(newspaper, Income, Newspaper)) \%>\% cross_tabs(tab = .) + +} +\seealso{ +\code{\link{summary.cross_tabs}} to summarize results + +\code{\link{plot.cross_tabs}} to plot results +} diff --git a/radiant.basics/man/demand_uk.Rd b/radiant.basics/man/demand_uk.Rd new file mode 100644 index 0000000000000000000000000000000000000000..ec4f9ea65ecdd9842cf2d837a5fc2386cdc06f65 --- /dev/null +++ b/radiant.basics/man/demand_uk.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{demand_uk} +\alias{demand_uk} +\title{Demand in the UK} +\format{ +A data frame with 1000 rows and 2 variables +} +\usage{ +data(demand_uk) +} +\description{ +Demand in the UK +} +\details{ +Survey data of consumer purchase intentions. Description provided in attr(demand_uk,"description") +} +\keyword{datasets} diff --git a/radiant.basics/man/goodness.Rd b/radiant.basics/man/goodness.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d9599a766bc8c985d7f57b67fbc8f228fb68f227 --- /dev/null +++ b/radiant.basics/man/goodness.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/goodness.R +\name{goodness} +\alias{goodness} +\title{Evaluate if sample data for a categorical variable is consistent with a hypothesized distribution} +\usage{ +goodness( + dataset, + var, + p = NULL, + tab = NULL, + data_filter = "", + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{var}{A categorical variable} + +\item{p}{Hypothesized distribution as a number, fraction, or numeric vector. If unspecified, defaults to an even distribution} + +\item{tab}{Table with frequencies as alternative to dataset} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{envir}{Environment to extract data from} +} +\value{ +A list of all variables used in goodness as an object of class goodness +} +\description{ +Evaluate if sample data for a categorical variable is consistent with a hypothesized distribution +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/goodness.html} for an example in Radiant +} +\examples{ +goodness(newspaper, "Income") \%>\% str() +goodness(newspaper, "Income", p = c(3 / 4, 1 / 4)) \%>\% str() +table(select(newspaper, Income)) \%>\% goodness(tab = .) + +} +\seealso{ +\code{\link{summary.goodness}} to summarize results + +\code{\link{plot.goodness}} to plot results +} diff --git a/radiant.basics/man/newspaper.Rd b/radiant.basics/man/newspaper.Rd new file mode 100644 index 0000000000000000000000000000000000000000..755b4b98c00a44da355b682133536ae4a02616d8 --- /dev/null +++ b/radiant.basics/man/newspaper.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{newspaper} +\alias{newspaper} +\title{Newspaper readership} +\format{ +A data frame with 580 rows and 2 variables +} +\usage{ +data(newspaper) +} +\description{ +Newspaper readership +} +\details{ +Newspaper readership data for 580 consumers. Description provided in attr(newspaper,"description") +} +\keyword{datasets} diff --git a/radiant.basics/man/plot.clt.Rd b/radiant.basics/man/plot.clt.Rd new file mode 100644 index 0000000000000000000000000000000000000000..1bade81d1765d5f71062cacdcb92773137880d81 --- /dev/null +++ b/radiant.basics/man/plot.clt.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/clt.R +\name{plot.clt} +\alias{plot.clt} +\title{Plot method for the Central Limit Theorem simulation} +\usage{ +\method{plot}{clt}(x, stat = "sum", bins = 15, ...) +} +\arguments{ +\item{x}{Return value from \code{\link{clt}}} + +\item{stat}{Statistic to use (sum or mean)} + +\item{bins}{Number of bins to use} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the Central Limit Theorem simulation +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/clt.html} for an example in Radiant +} +\examples{ +clt("Uniform", 100, 100, unif_min = 10, unif_max = 20) \%>\% plot() + +} diff --git a/radiant.basics/man/plot.compare_means.Rd b/radiant.basics/man/plot.compare_means.Rd new file mode 100644 index 0000000000000000000000000000000000000000..91d95b2e4245677998f0f742eb5289367c2d7262 --- /dev/null +++ b/radiant.basics/man/plot.compare_means.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/compare_means.R +\name{plot.compare_means} +\alias{plot.compare_means} +\title{Plot method for the compare_means function} +\usage{ +\method{plot}{compare_means}(x, plots = "scatter", shiny = FALSE, custom = FALSE, ...) +} +\arguments{ +\item{x}{Return value from \code{\link{compare_means}}} + +\item{plots}{One or more plots ("bar", "density", "box", or "scatter")} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the compare_means function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/compare_means.html} for an example in Radiant +} +\examples{ +result <- compare_means(diamonds, "cut", "price") +plot(result, plots = c("bar", "density")) + +} +\seealso{ +\code{\link{compare_means}} to calculate results + +\code{\link{summary.compare_means}} to summarize results +} diff --git a/radiant.basics/man/plot.compare_props.Rd b/radiant.basics/man/plot.compare_props.Rd new file mode 100644 index 0000000000000000000000000000000000000000..3ca4263d2da1c387c40f9ce1a71f0ad57d167cd4 --- /dev/null +++ b/radiant.basics/man/plot.compare_props.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/compare_props.R +\name{plot.compare_props} +\alias{plot.compare_props} +\title{Plot method for the compare_props function} +\usage{ +\method{plot}{compare_props}(x, plots = "bar", shiny = FALSE, custom = FALSE, ...) +} +\arguments{ +\item{x}{Return value from \code{\link{compare_props}}} + +\item{plots}{One or more plots of proportions ("bar" or "dodge")} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the compare_props function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/compare_props.html} for an example in Radiant +} +\examples{ +result <- compare_props(titanic, "pclass", "survived") +plot(result, plots = c("bar", "dodge")) + +} +\seealso{ +\code{\link{compare_props}} to calculate results + +\code{\link{summary.compare_props}} to summarize results +} diff --git a/radiant.basics/man/plot.correlation.Rd b/radiant.basics/man/plot.correlation.Rd new file mode 100644 index 0000000000000000000000000000000000000000..0a1178ef38e88922d9d2d4ea20b93e464ead3d97 --- /dev/null +++ b/radiant.basics/man/plot.correlation.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/correlation.R +\name{plot.correlation} +\alias{plot.correlation} +\title{Plot method for the correlation function} +\usage{ +\method{plot}{correlation}(x, nrobs = -1, jit = c(0, 0), dec = 2, ...) +} +\arguments{ +\item{x}{Return value from \code{\link{correlation}}} + +\item{nrobs}{Number of data points to show in scatter plots (-1 for all)} + +\item{jit}{A numeric vector that determines the amount of jittering to apply to the x and y variables in a scatter plot. Default is 0. Use, e.g., 0.3 to add some jittering} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods.} +} +\description{ +Plot method for the correlation function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/correlation.html} for an example in Radiant +} +\examples{ +result <- correlation(diamonds, c("price", "carat", "table")) +plot(result) + +} +\seealso{ +\code{\link{correlation}} to calculate results + +\code{\link{summary.correlation}} to summarize results +} diff --git a/radiant.basics/man/plot.cross_tabs.Rd b/radiant.basics/man/plot.cross_tabs.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f473abd01fc2ac5489f8a80a7b6cb1ab1b4d3b3b --- /dev/null +++ b/radiant.basics/man/plot.cross_tabs.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cross_tabs.R +\name{plot.cross_tabs} +\alias{plot.cross_tabs} +\title{Plot method for the cross_tabs function} +\usage{ +\method{plot}{cross_tabs}(x, check = "", shiny = FALSE, custom = FALSE, ...) +} +\arguments{ +\item{x}{Return value from \code{\link{cross_tabs}}} + +\item{check}{Show plots for variables var1 and var2. "observed" for the observed frequencies table, "expected" for the expected frequencies table (i.e., frequencies that would be expected if the null hypothesis holds), "chi_sq" for the contribution to the overall chi-squared statistic for each cell (i.e., (o - e)^2 / e), "dev_std" for the standardized differences between the observed and expected frequencies (i.e., (o - e) / sqrt(e)), and "row_perc", "col_perc", and "perc" for row, column, and table percentages respectively} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the cross_tabs function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/cross_tabs.html} for an example in Radiant +} +\examples{ +result <- cross_tabs(newspaper, "Income", "Newspaper") +plot(result, check = c("observed", "expected", "chi_sq")) + +} +\seealso{ +\code{\link{cross_tabs}} to calculate results + +\code{\link{summary.cross_tabs}} to summarize results +} diff --git a/radiant.basics/man/plot.goodness.Rd b/radiant.basics/man/plot.goodness.Rd new file mode 100644 index 0000000000000000000000000000000000000000..cf51cf4490117e9116ac657147cc8085efa5308a --- /dev/null +++ b/radiant.basics/man/plot.goodness.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/goodness.R +\name{plot.goodness} +\alias{plot.goodness} +\title{Plot method for the goodness function} +\usage{ +\method{plot}{goodness}(x, check = "", fillcol = "blue", shiny = FALSE, custom = FALSE, ...) +} +\arguments{ +\item{x}{Return value from \code{\link{goodness}}} + +\item{check}{Show plots for variable var. "observed" for the observed frequencies table, "expected" for the expected frequencies table (i.e., frequencies that would be expected if the null hypothesis holds), "chi_sq" for the contribution to the overall chi-squared statistic for each cell (i.e., (o - e)^2 / e), and "dev_std" for the standardized differences between the observed and expected frequencies (i.e., (o - e) / sqrt(e))} + +\item{fillcol}{Color used for bar plots} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the goodness function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/goodness} for an example in Radiant +} +\examples{ +result <- goodness(newspaper, "Income") +plot(result, check = c("observed", "expected", "chi_sq")) +goodness(newspaper, "Income") \%>\% plot(c("observed", "expected")) + +} +\seealso{ +\code{\link{goodness}} to calculate results + +\code{\link{summary.goodness}} to summarize results +} diff --git a/radiant.basics/man/plot.prob_binom.Rd b/radiant.basics/man/plot.prob_binom.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a68c582640bc4d69b0a735a300f60f922bba8969 --- /dev/null +++ b/radiant.basics/man/plot.prob_binom.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{plot.prob_binom} +\alias{plot.prob_binom} +\title{Plot method for the probability calculator (binomial)} +\usage{ +\method{plot}{prob_binom}(x, type = "values", ...) +} +\arguments{ +\item{x}{Return value from \code{\link{prob_binom}}} + +\item{type}{Probabilities ("probs") or values ("values")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the probability calculator (binomial) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +result <- prob_binom(n = 10, p = 0.3, ub = 3) +plot(result, type = "values") + +} +\seealso{ +\code{\link{prob_binom}} to calculate results + +\code{\link{summary.prob_binom}} to summarize results +} diff --git a/radiant.basics/man/plot.prob_chisq.Rd b/radiant.basics/man/plot.prob_chisq.Rd new file mode 100644 index 0000000000000000000000000000000000000000..ba4e037657b1fb4d18d8f1470218d8babbac9842 --- /dev/null +++ b/radiant.basics/man/plot.prob_chisq.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{plot.prob_chisq} +\alias{plot.prob_chisq} +\title{Plot method for the probability calculator (Chi-squared distribution)} +\usage{ +\method{plot}{prob_chisq}(x, type = "values", ...) +} +\arguments{ +\item{x}{Return value from \code{\link{prob_chisq}}} + +\item{type}{Probabilities ("probs") or values ("values")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the probability calculator (Chi-squared distribution) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +result <- prob_chisq(df = 1, ub = 3.841) +plot(result, type = "values") + +} +\seealso{ +\code{\link{prob_chisq}} to calculate results + +\code{\link{summary.prob_chisq}} to summarize results +} diff --git a/radiant.basics/man/plot.prob_disc.Rd b/radiant.basics/man/plot.prob_disc.Rd new file mode 100644 index 0000000000000000000000000000000000000000..10f3ff4d79c4ec404235211bc2edc427c08fdd15 --- /dev/null +++ b/radiant.basics/man/plot.prob_disc.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{plot.prob_disc} +\alias{plot.prob_disc} +\title{Plot method for the probability calculator (discrete)} +\usage{ +\method{plot}{prob_disc}(x, type = "values", ...) +} +\arguments{ +\item{x}{Return value from \code{\link{prob_disc}}} + +\item{type}{Probabilities ("probs") or values ("values")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the probability calculator (discrete) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +result <- prob_disc(v = 1:6, p = c(2 / 6, 2 / 6, 1 / 12, 1 / 12, 1 / 12, 1 / 12), pub = 0.95) +plot(result, type = "probs") + +} +\seealso{ +\code{\link{prob_disc}} to calculate results + +\code{\link{summary.prob_disc}} to summarize results +} diff --git a/radiant.basics/man/plot.prob_expo.Rd b/radiant.basics/man/plot.prob_expo.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f6453aaabb83a484e5280c87280a4ff1fa130250 --- /dev/null +++ b/radiant.basics/man/plot.prob_expo.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{plot.prob_expo} +\alias{plot.prob_expo} +\title{Plot method for the probability calculator (Exponential distribution)} +\usage{ +\method{plot}{prob_expo}(x, type = "values", ...) +} +\arguments{ +\item{x}{Return value from \code{\link{prob_expo}}} + +\item{type}{Probabilities ("probs") or values ("values")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the probability calculator (Exponential distribution) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +result <- prob_expo(rate = 1, ub = 2.996) +plot(result, type = "values") + +} +\seealso{ +\code{\link{prob_expo}} to calculate results + +\code{\link{summary.prob_expo}} to summarize results +} diff --git a/radiant.basics/man/plot.prob_fdist.Rd b/radiant.basics/man/plot.prob_fdist.Rd new file mode 100644 index 0000000000000000000000000000000000000000..3fbbfaa998afdd13a7db9013ece65582f85a49a8 --- /dev/null +++ b/radiant.basics/man/plot.prob_fdist.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{plot.prob_fdist} +\alias{plot.prob_fdist} +\title{Plot method for the probability calculator (F-distribution)} +\usage{ +\method{plot}{prob_fdist}(x, type = "values", ...) +} +\arguments{ +\item{x}{Return value from \code{\link{prob_fdist}}} + +\item{type}{Probabilities ("probs") or values ("values")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the probability calculator (F-distribution) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +result <- prob_fdist(df1 = 10, df2 = 10, ub = 2.978) +plot(result, type = "values") + +} +\seealso{ +\code{\link{prob_fdist}} to calculate results + +\code{\link{summary.prob_fdist}} to summarize results +} diff --git a/radiant.basics/man/plot.prob_lnorm.Rd b/radiant.basics/man/plot.prob_lnorm.Rd new file mode 100644 index 0000000000000000000000000000000000000000..e5335aeb6f9ad26ced2832d3840c18d3ccad46d2 --- /dev/null +++ b/radiant.basics/man/plot.prob_lnorm.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{plot.prob_lnorm} +\alias{plot.prob_lnorm} +\title{Plot method for the probability calculator (log normal)} +\usage{ +\method{plot}{prob_lnorm}(x, type = "values", ...) +} +\arguments{ +\item{x}{Return value from \code{\link{prob_norm}}} + +\item{type}{Probabilities ("probs") or values ("values")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the probability calculator (log normal) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +result <- prob_lnorm(meanlog = 0, sdlog = 1, lb = 0, ub = 1) +plot(result, type = "values") + +} +\seealso{ +\code{\link{prob_lnorm}} to calculate results + +\code{\link{plot.prob_lnorm}} to plot results +} diff --git a/radiant.basics/man/plot.prob_norm.Rd b/radiant.basics/man/plot.prob_norm.Rd new file mode 100644 index 0000000000000000000000000000000000000000..afe3f850a20c1294753cb48243b4f6dd1cf5e628 --- /dev/null +++ b/radiant.basics/man/plot.prob_norm.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{plot.prob_norm} +\alias{plot.prob_norm} +\title{Plot method for the probability calculator (normal)} +\usage{ +\method{plot}{prob_norm}(x, type = "values", ...) +} +\arguments{ +\item{x}{Return value from \code{\link{prob_norm}}} + +\item{type}{Probabilities ("probs") or values ("values")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the probability calculator (normal) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +result <- prob_norm(mean = 0, stdev = 1, ub = 0) +plot(result) + +} +\seealso{ +\code{\link{prob_norm}} to calculate results + +\code{\link{summary.prob_norm}} to summarize results +} diff --git a/radiant.basics/man/plot.prob_pois.Rd b/radiant.basics/man/plot.prob_pois.Rd new file mode 100644 index 0000000000000000000000000000000000000000..7cf291206eecdba6835687df5a4b5189b28038ce --- /dev/null +++ b/radiant.basics/man/plot.prob_pois.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{plot.prob_pois} +\alias{plot.prob_pois} +\title{Plot method for the probability calculator (poisson)} +\usage{ +\method{plot}{prob_pois}(x, type = "values", ...) +} +\arguments{ +\item{x}{Return value from \code{\link{prob_pois}}} + +\item{type}{Probabilities ("probs") or values ("values")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the probability calculator (poisson) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +result <- prob_pois(lambda = 1, ub = 3) +plot(result, type = "values") + +} +\seealso{ +\code{\link{prob_pois}} to calculate results + +\code{\link{summary.prob_pois}} to summarize results +} diff --git a/radiant.basics/man/plot.prob_tdist.Rd b/radiant.basics/man/plot.prob_tdist.Rd new file mode 100644 index 0000000000000000000000000000000000000000..34ec0be99907549abd959e60a5ad92080ddd283d --- /dev/null +++ b/radiant.basics/man/plot.prob_tdist.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{plot.prob_tdist} +\alias{plot.prob_tdist} +\title{Plot method for the probability calculator (t-distribution)} +\usage{ +\method{plot}{prob_tdist}(x, type = "values", ...) +} +\arguments{ +\item{x}{Return value from \code{\link{prob_tdist}}} + +\item{type}{Probabilities ("probs") or values ("values")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the probability calculator (t-distribution) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +result <- prob_tdist(df = 10, ub = 2.228) +plot(result, type = "values") + +} +\seealso{ +\code{\link{prob_tdist}} to calculate results + +\code{\link{summary.prob_tdist}} to summarize results +} diff --git a/radiant.basics/man/plot.prob_unif.Rd b/radiant.basics/man/plot.prob_unif.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d5a763cd28dfb79eb00b542445fa8eca57b93c23 --- /dev/null +++ b/radiant.basics/man/plot.prob_unif.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{plot.prob_unif} +\alias{plot.prob_unif} +\title{Plot method for the probability calculator (uniform)} +\usage{ +\method{plot}{prob_unif}(x, type = "values", ...) +} +\arguments{ +\item{x}{Return value from \code{\link{prob_unif}}} + +\item{type}{Probabilities ("probs") or values ("values")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the probability calculator (uniform) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +result <- prob_unif(min = 0, max = 1, ub = 0.3) +plot(result, type = "values") + +} +\seealso{ +\code{\link{prob_unif}} to calculate results + +\code{\link{summary.prob_unif}} to summarize results +} diff --git a/radiant.basics/man/plot.single_mean.Rd b/radiant.basics/man/plot.single_mean.Rd new file mode 100644 index 0000000000000000000000000000000000000000..cf5d912ae1c75ebd1c6b69a5b1243d3c9a8c5877 --- /dev/null +++ b/radiant.basics/man/plot.single_mean.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/single_mean.R +\name{plot.single_mean} +\alias{plot.single_mean} +\title{Plot method for the single_mean function} +\usage{ +\method{plot}{single_mean}(x, plots = "hist", shiny = FALSE, custom = FALSE, ...) +} +\arguments{ +\item{x}{Return value from \code{\link{single_mean}}} + +\item{plots}{Plots to generate. "hist" shows a histogram of the data along with vertical lines that indicate the sample mean and the confidence interval. "simulate" shows the location of the sample mean and the comparison value (comp_value). Simulation is used to demonstrate the sampling variability in the data under the null-hypothesis} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the single_mean function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/single_mean.html} for an example in Radiant +} +\examples{ +result <- single_mean(diamonds, "price", comp_value = 3500) +plot(result, plots = c("hist", "simulate")) + +} +\seealso{ +\code{\link{single_mean}} to generate the result + +\code{\link{summary.single_mean}} to summarize results +} diff --git a/radiant.basics/man/plot.single_prop.Rd b/radiant.basics/man/plot.single_prop.Rd new file mode 100644 index 0000000000000000000000000000000000000000..6d63422c5490d9b60f7dc0f026e571735fe5b01b --- /dev/null +++ b/radiant.basics/man/plot.single_prop.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/single_prop.R +\name{plot.single_prop} +\alias{plot.single_prop} +\title{Plot method for the single_prop function} +\usage{ +\method{plot}{single_prop}(x, plots = "bar", shiny = FALSE, custom = FALSE, ...) +} +\arguments{ +\item{x}{Return value from \code{\link{single_prop}}} + +\item{plots}{Plots to generate. "bar" shows a bar chart of the data. The "simulate" chart shows the location of the sample proportion and the comparison value (comp_value). Simulation is used to demonstrate the sampling variability in the data under the null-hypothesis} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the single_prop function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/single_prop.html} for an example in Radiant +} +\examples{ +result <- single_prop(titanic, "survived", lev = "Yes", comp_value = 0.5, alternative = "less") +plot(result, plots = c("bar", "simulate")) + +} +\seealso{ +\code{\link{single_prop}} to generate the result + +\code{\link{summary.single_prop}} to summarize the results +} diff --git a/radiant.basics/man/print.rcorr.Rd b/radiant.basics/man/print.rcorr.Rd new file mode 100644 index 0000000000000000000000000000000000000000..06d15876bbb75409e525106fcc6e7759a44f9d60 --- /dev/null +++ b/radiant.basics/man/print.rcorr.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/correlation.R +\name{print.rcorr} +\alias{print.rcorr} +\title{Print method for the correlation function} +\usage{ +\method{print}{rcorr}(x, ...) +} +\arguments{ +\item{x}{Return value from \code{\link{correlation}}} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Print method for the correlation function +} diff --git a/radiant.basics/man/prob_binom.Rd b/radiant.basics/man/prob_binom.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d49389aebbad1cec74e01b91435dcdbef571f7c5 --- /dev/null +++ b/radiant.basics/man/prob_binom.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{prob_binom} +\alias{prob_binom} +\title{Probability calculator for the binomial distribution} +\usage{ +prob_binom(n, p, lb = NA, ub = NA, plb = NA, pub = NA, dec = 3) +} +\arguments{ +\item{n}{Number of trials} + +\item{p}{Probability} + +\item{lb}{Lower bound on the number of successes} + +\item{ub}{Upper bound on the number of successes} + +\item{plb}{Lower probability bound} + +\item{pub}{Upper probability bound} + +\item{dec}{Number of decimals to show} +} +\description{ +Probability calculator for the binomial distribution +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +prob_binom(n = 10, p = 0.3, ub = 3) + +} +\seealso{ +\code{\link{summary.prob_binom}} to summarize results + +\code{\link{plot.prob_binom}} to plot results +} diff --git a/radiant.basics/man/prob_chisq.Rd b/radiant.basics/man/prob_chisq.Rd new file mode 100644 index 0000000000000000000000000000000000000000..2accf21595abb8b61e55b97867abf7b1608e1caa --- /dev/null +++ b/radiant.basics/man/prob_chisq.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{prob_chisq} +\alias{prob_chisq} +\title{Probability calculator for the chi-squared distribution} +\usage{ +prob_chisq(df, lb = NA, ub = NA, plb = NA, pub = NA, dec = 3) +} +\arguments{ +\item{df}{Degrees of freedom} + +\item{lb}{Lower bound (default is 0)} + +\item{ub}{Upper bound (default is Inf)} + +\item{plb}{Lower probability bound} + +\item{pub}{Upper probability bound} + +\item{dec}{Number of decimals to show} +} +\description{ +Probability calculator for the chi-squared distribution +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +prob_chisq(df = 1, ub = 3.841) + +} +\seealso{ +\code{\link{summary.prob_chisq}} to summarize results + +\code{\link{plot.prob_chisq}} to plot results +} diff --git a/radiant.basics/man/prob_disc.Rd b/radiant.basics/man/prob_disc.Rd new file mode 100644 index 0000000000000000000000000000000000000000..11d4798a7b787d11fff170873c3223ff28f6f08c --- /dev/null +++ b/radiant.basics/man/prob_disc.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{prob_disc} +\alias{prob_disc} +\title{Probability calculator for a discrete distribution} +\usage{ +prob_disc(v, p, lb = NA, ub = NA, plb = NA, pub = NA, dec = 3) +} +\arguments{ +\item{v}{Values} + +\item{p}{Probabilities} + +\item{lb}{Lower bound on the number of successes} + +\item{ub}{Upper bound on the number of successes} + +\item{plb}{Lower probability bound} + +\item{pub}{Upper probability bound} + +\item{dec}{Number of decimals to show} +} +\description{ +Probability calculator for a discrete distribution +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +prob_disc(v = 1:6, p = 1 / 6, pub = 0.95) +prob_disc(v = 1:6, p = c(2 / 6, 2 / 6, 1 / 12, 1 / 12, 1 / 12, 1 / 12), pub = 0.95) + +} +\seealso{ +\code{\link{summary.prob_disc}} to summarize results + +\code{\link{plot.prob_disc}} to plot results +} diff --git a/radiant.basics/man/prob_expo.Rd b/radiant.basics/man/prob_expo.Rd new file mode 100644 index 0000000000000000000000000000000000000000..5091759736ea481cc0c2c51495c962c46d5ac33b --- /dev/null +++ b/radiant.basics/man/prob_expo.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{prob_expo} +\alias{prob_expo} +\title{Probability calculator for the exponential distribution} +\usage{ +prob_expo(rate, lb = NA, ub = NA, plb = NA, pub = NA, dec = 3) +} +\arguments{ +\item{rate}{Rate} + +\item{lb}{Lower bound (default is 0)} + +\item{ub}{Upper bound (default is Inf)} + +\item{plb}{Lower probability bound} + +\item{pub}{Upper probability bound} + +\item{dec}{Number of decimals to show} +} +\description{ +Probability calculator for the exponential distribution +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +prob_expo(rate = 1, ub = 2.996) + +} +\seealso{ +\code{\link{summary.prob_expo}} to summarize results + +\code{\link{plot.prob_expo}} to plot results +} diff --git a/radiant.basics/man/prob_fdist.Rd b/radiant.basics/man/prob_fdist.Rd new file mode 100644 index 0000000000000000000000000000000000000000..aeac2d30c9f81944a775f2c02fa688fb545dd970 --- /dev/null +++ b/radiant.basics/man/prob_fdist.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{prob_fdist} +\alias{prob_fdist} +\title{Probability calculator for the F-distribution} +\usage{ +prob_fdist(df1, df2, lb = NA, ub = NA, plb = NA, pub = NA, dec = 3) +} +\arguments{ +\item{df1}{Degrees of freedom} + +\item{df2}{Degrees of freedom} + +\item{lb}{Lower bound (default is 0)} + +\item{ub}{Upper bound (default is Inf)} + +\item{plb}{Lower probability bound} + +\item{pub}{Upper probability bound} + +\item{dec}{Number of decimals to show} +} +\description{ +Probability calculator for the F-distribution +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +prob_fdist(df1 = 10, df2 = 10, ub = 2.978) + +} +\seealso{ +\code{\link{summary.prob_fdist}} to summarize results + +\code{\link{plot.prob_fdist}} to plot results +} diff --git a/radiant.basics/man/prob_lnorm.Rd b/radiant.basics/man/prob_lnorm.Rd new file mode 100644 index 0000000000000000000000000000000000000000..74ab5373280b69dd23928f5b2990035e8e8c730d --- /dev/null +++ b/radiant.basics/man/prob_lnorm.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{prob_lnorm} +\alias{prob_lnorm} +\title{Probability calculator for the log normal distribution} +\usage{ +prob_lnorm(meanlog, sdlog, lb = NA, ub = NA, plb = NA, pub = NA, dec = 3) +} +\arguments{ +\item{meanlog}{Mean of the distribution on the log scale} + +\item{sdlog}{Standard deviation of the distribution on the log scale} + +\item{lb}{Lower bound (default is -Inf)} + +\item{ub}{Upper bound (default is Inf)} + +\item{plb}{Lower probability bound} + +\item{pub}{Upper probability bound} + +\item{dec}{Number of decimals to show} +} +\description{ +Probability calculator for the log normal distribution +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +prob_lnorm(meanlog = 0, sdlog = 1, lb = 0, ub = 1) + +} +\seealso{ +\code{\link{summary.prob_lnorm}} to summarize results + +\code{\link{plot.prob_lnorm}} to plot results +} diff --git a/radiant.basics/man/prob_norm.Rd b/radiant.basics/man/prob_norm.Rd new file mode 100644 index 0000000000000000000000000000000000000000..63193d14364958159fdd276ef671bcbf68ec319b --- /dev/null +++ b/radiant.basics/man/prob_norm.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{prob_norm} +\alias{prob_norm} +\title{Probability calculator for the normal distribution} +\usage{ +prob_norm(mean, stdev, lb = NA, ub = NA, plb = NA, pub = NA, dec = 3) +} +\arguments{ +\item{mean}{Mean} + +\item{stdev}{Standard deviation} + +\item{lb}{Lower bound (default is -Inf)} + +\item{ub}{Upper bound (default is Inf)} + +\item{plb}{Lower probability bound} + +\item{pub}{Upper probability bound} + +\item{dec}{Number of decimals to show} +} +\description{ +Probability calculator for the normal distribution +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +prob_norm(mean = 0, stdev = 1, ub = 0) + +} +\seealso{ +\code{\link{summary.prob_norm}} to summarize results + +\code{\link{plot.prob_norm}} to plot results +} diff --git a/radiant.basics/man/prob_pois.Rd b/radiant.basics/man/prob_pois.Rd new file mode 100644 index 0000000000000000000000000000000000000000..68c38162073edca98f2145e1455b403abf6bcb17 --- /dev/null +++ b/radiant.basics/man/prob_pois.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{prob_pois} +\alias{prob_pois} +\title{Probability calculator for the poisson distribution} +\usage{ +prob_pois(lambda, lb = NA, ub = NA, plb = NA, pub = NA, dec = 3) +} +\arguments{ +\item{lambda}{Rate} + +\item{lb}{Lower bound (default is 0)} + +\item{ub}{Upper bound (default is Inf)} + +\item{plb}{Lower probability bound} + +\item{pub}{Upper probability bound} + +\item{dec}{Number of decimals to show} +} +\description{ +Probability calculator for the poisson distribution +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +prob_pois(lambda = 1, ub = 3) + +} +\seealso{ +\code{\link{summary.prob_pois}} to summarize results + +\code{\link{plot.prob_pois}} to plot results +} diff --git a/radiant.basics/man/prob_tdist.Rd b/radiant.basics/man/prob_tdist.Rd new file mode 100644 index 0000000000000000000000000000000000000000..7d108993b10a6e8b6366ef430b3fadbe3df3a116 --- /dev/null +++ b/radiant.basics/man/prob_tdist.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{prob_tdist} +\alias{prob_tdist} +\title{Probability calculator for the t-distribution} +\usage{ +prob_tdist(df, lb = NA, ub = NA, plb = NA, pub = NA, dec = 3) +} +\arguments{ +\item{df}{Degrees of freedom} + +\item{lb}{Lower bound (default is -Inf)} + +\item{ub}{Upper bound (default is Inf)} + +\item{plb}{Lower probability bound} + +\item{pub}{Upper probability bound} + +\item{dec}{Number of decimals to show} +} +\description{ +Probability calculator for the t-distribution +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +prob_tdist(df = 10, ub = 2.228) + +} +\seealso{ +\code{\link{summary.prob_tdist}} to summarize results + +\code{\link{plot.prob_tdist}} to plot results +} diff --git a/radiant.basics/man/prob_unif.Rd b/radiant.basics/man/prob_unif.Rd new file mode 100644 index 0000000000000000000000000000000000000000..85ea27afa1ea6bbf6c11ef03d6290f200b7441d7 --- /dev/null +++ b/radiant.basics/man/prob_unif.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{prob_unif} +\alias{prob_unif} +\title{Probability calculator for the uniform distribution} +\usage{ +prob_unif(min, max, lb = NA, ub = NA, plb = NA, pub = NA, dec = 3) +} +\arguments{ +\item{min}{Minimum value} + +\item{max}{Maximum value} + +\item{lb}{Lower bound (default = 0)} + +\item{ub}{Upper bound (default = 1)} + +\item{plb}{Lower probability bound} + +\item{pub}{Upper probability bound} + +\item{dec}{Number of decimals to show} +} +\description{ +Probability calculator for the uniform distribution +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +prob_unif(min = 0, max = 1, ub = 0.3) + +} +\seealso{ +\code{\link{summary.prob_unif}} to summarize results + +\code{\link{plot.prob_unif}} to plot results +} diff --git a/radiant.basics/man/radiant.basics.Rd b/radiant.basics/man/radiant.basics.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d9c36135096832917e619567ff45248403bf90d8 --- /dev/null +++ b/radiant.basics/man/radiant.basics.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R, R/radiant.R +\name{radiant.basics} +\alias{radiant.basics} +\title{radiant.basics} +\usage{ +radiant.basics(state, ...) +} +\arguments{ +\item{state}{Path to state file to load} + +\item{...}{additional arguments to pass to shiny::runApp (e.g, port = 8080)} +} +\description{ +Launch radiant.basics in the default web browser +} +\details{ +See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +} +\examples{ +\dontrun{ +radiant.basics() +} +} diff --git a/radiant.basics/man/radiant.basics_viewer.Rd b/radiant.basics/man/radiant.basics_viewer.Rd new file mode 100644 index 0000000000000000000000000000000000000000..4a8aad4ed724bc9018fa773e264b5b7a13aacb1c --- /dev/null +++ b/radiant.basics/man/radiant.basics_viewer.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{radiant.basics_viewer} +\alias{radiant.basics_viewer} +\title{Launch radiant.basics in the Rstudio viewer} +\usage{ +radiant.basics_viewer(state, ...) +} +\arguments{ +\item{state}{Path to state file to load} + +\item{...}{additional arguments to pass to shiny::runApp (e.g, port = 8080)} +} +\description{ +Launch radiant.basics in the Rstudio viewer +} +\details{ +See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +} +\examples{ +\dontrun{ +radiant.basics_viewer() +} +} diff --git a/radiant.basics/man/radiant.basics_window.Rd b/radiant.basics/man/radiant.basics_window.Rd new file mode 100644 index 0000000000000000000000000000000000000000..7d58b514e6cbdd19a3756b3d702633863f2588ae --- /dev/null +++ b/radiant.basics/man/radiant.basics_window.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{radiant.basics_window} +\alias{radiant.basics_window} +\title{Launch radiant.basics in an Rstudio window} +\usage{ +radiant.basics_window(state, ...) +} +\arguments{ +\item{state}{Path to state file to load} + +\item{...}{additional arguments to pass to shiny::runApp (e.g, port = 8080)} +} +\description{ +Launch radiant.basics in an Rstudio window +} +\details{ +See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +} +\examples{ +\dontrun{ +radiant.basics_window() +} +} diff --git a/radiant.basics/man/salary.Rd b/radiant.basics/man/salary.Rd new file mode 100644 index 0000000000000000000000000000000000000000..ef7bdc1fc348a3f2b1f15a6abbc83794fb6c20e4 --- /dev/null +++ b/radiant.basics/man/salary.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{salary} +\alias{salary} +\title{Salaries for Professors} +\format{ +A data frame with 397 rows and 6 variables +} +\usage{ +data(salary) +} +\description{ +Salaries for Professors +} +\details{ +2008-2009 nine-month salary for professors in a college in the US. Description provided in attr(salary,description") +} +\keyword{datasets} diff --git a/radiant.basics/man/single_mean.Rd b/radiant.basics/man/single_mean.Rd new file mode 100644 index 0000000000000000000000000000000000000000..9fe0c8cf3de8a901b6198a3758a6e6de3709d7de --- /dev/null +++ b/radiant.basics/man/single_mean.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/single_mean.R +\name{single_mean} +\alias{single_mean} +\title{Compare a sample mean to a population mean} +\usage{ +single_mean( + dataset, + var, + comp_value = 0, + alternative = "two.sided", + conf_lev = 0.95, + data_filter = "", + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{var}{The variable selected for the mean comparison} + +\item{comp_value}{Population value to compare to the sample mean} + +\item{alternative}{The alternative hypothesis ("two.sided", "greater", or "less")} + +\item{conf_lev}{Span for the confidence interval} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{envir}{Environment to extract data from} +} +\value{ +A list of variables defined in single_mean as an object of class single_mean +} +\description{ +Compare a sample mean to a population mean +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/single_mean.html} for an example in Radiant +} +\examples{ +single_mean(diamonds, "price") \%>\% str() + +} +\seealso{ +\code{\link{summary.single_mean}} to summarize results + +\code{\link{plot.single_mean}} to plot results +} diff --git a/radiant.basics/man/single_prop.Rd b/radiant.basics/man/single_prop.Rd new file mode 100644 index 0000000000000000000000000000000000000000..3692d995597d6f6c467de6bdfbae4008f131b3f4 --- /dev/null +++ b/radiant.basics/man/single_prop.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/single_prop.R +\name{single_prop} +\alias{single_prop} +\title{Compare a sample proportion to a population proportion} +\usage{ +single_prop( + dataset, + var, + lev = "", + comp_value = 0.5, + alternative = "two.sided", + conf_lev = 0.95, + test = "binom", + data_filter = "", + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{var}{The variable selected for the proportion comparison} + +\item{lev}{The factor level selected for the proportion comparison} + +\item{comp_value}{Population value to compare to the sample proportion} + +\item{alternative}{The alternative hypothesis ("two.sided", "greater", or "less")} + +\item{conf_lev}{Span of the confidence interval} + +\item{test}{bionomial exact test ("binom") or Z-test ("z")} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{envir}{Environment to extract data from} +} +\value{ +A list of variables used in single_prop as an object of class single_prop +} +\description{ +Compare a sample proportion to a population proportion +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/single_prop.html} for an example in Radiant +} +\examples{ +single_prop(titanic, "survived") \%>\% str() +single_prop(titanic, "survived", lev = "Yes", comp_value = 0.5, alternative = "less") \%>\% str() + +} +\seealso{ +\code{\link{summary.single_prop}} to summarize the results + +\code{\link{plot.single_prop}} to plot the results +} diff --git a/radiant.basics/man/summary.compare_means.Rd b/radiant.basics/man/summary.compare_means.Rd new file mode 100644 index 0000000000000000000000000000000000000000..96aafc43879e6c8c82819aed7c8117ab565cc6a9 --- /dev/null +++ b/radiant.basics/man/summary.compare_means.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/compare_means.R +\name{summary.compare_means} +\alias{summary.compare_means} +\title{Summary method for the compare_means function} +\usage{ +\method{summary}{compare_means}(object, show = FALSE, dec = 3, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{compare_means}}} + +\item{show}{Show additional output (i.e., t.value, df, and confidence interval)} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the compare_means function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/compare_means.html} for an example in Radiant +} +\examples{ +result <- compare_means(diamonds, "cut", "price") +summary(result) + +} +\seealso{ +\code{\link{compare_means}} to calculate results + +\code{\link{plot.compare_means}} to plot results +} diff --git a/radiant.basics/man/summary.compare_props.Rd b/radiant.basics/man/summary.compare_props.Rd new file mode 100644 index 0000000000000000000000000000000000000000..5d028da495a8c7a5057952c2a0713f7913818f45 --- /dev/null +++ b/radiant.basics/man/summary.compare_props.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/compare_props.R +\name{summary.compare_props} +\alias{summary.compare_props} +\title{Summary method for the compare_props function} +\usage{ +\method{summary}{compare_props}(object, show = FALSE, dec = 3, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{compare_props}}} + +\item{show}{Show additional output (i.e., chisq.value, df, and confidence interval)} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the compare_props function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/compare_props.html} for an example in Radiant +} +\examples{ +result <- compare_props(titanic, "pclass", "survived") +summary(result) + +} +\seealso{ +\code{\link{compare_props}} to calculate results + +\code{\link{plot.compare_props}} to plot results +} diff --git a/radiant.basics/man/summary.correlation.Rd b/radiant.basics/man/summary.correlation.Rd new file mode 100644 index 0000000000000000000000000000000000000000..0c6a824525005fcc1ff79d2a2b837834c3bc89f6 --- /dev/null +++ b/radiant.basics/man/summary.correlation.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/correlation.R +\name{summary.correlation} +\alias{summary.correlation} +\title{Summary method for the correlation function} +\usage{ +\method{summary}{correlation}(object, cutoff = 0, covar = FALSE, dec = 2, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{correlation}}} + +\item{cutoff}{Show only correlations larger than the cutoff in absolute value. Default is a cutoff of 0} + +\item{covar}{Show the covariance matrix (default is FALSE)} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods.} +} +\description{ +Summary method for the correlation function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/correlation.html} for an example in Radiant +} +\examples{ +result <- correlation(diamonds, c("price", "carat", "table")) +summary(result, cutoff = .3) + +} +\seealso{ +\code{\link{correlation}} to calculate results + +\code{\link{plot.correlation}} to plot results +} diff --git a/radiant.basics/man/summary.cross_tabs.Rd b/radiant.basics/man/summary.cross_tabs.Rd new file mode 100644 index 0000000000000000000000000000000000000000..4f2e0207b591899486f15cd5ebd21a98db0ffa5c --- /dev/null +++ b/radiant.basics/man/summary.cross_tabs.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cross_tabs.R +\name{summary.cross_tabs} +\alias{summary.cross_tabs} +\title{Summary method for the cross_tabs function} +\usage{ +\method{summary}{cross_tabs}(object, check = "", dec = 2, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{cross_tabs}}} + +\item{check}{Show table(s) for variables var1 and var2. "observed" for the observed frequencies table, "expected" for the expected frequencies table (i.e., frequencies that would be expected if the null hypothesis holds), "chi_sq" for the contribution to the overall chi-squared statistic for each cell (i.e., (o - e)^2 / e), "dev_std" for the standardized differences between the observed and expected frequencies (i.e., (o - e) / sqrt(e)), and "dev_perc" for the percentage difference between the observed and expected frequencies (i.e., (o - e) / e)} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods.} +} +\description{ +Summary method for the cross_tabs function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/cross_tabs.html} for an example in Radiant +} +\examples{ +result <- cross_tabs(newspaper, "Income", "Newspaper") +summary(result, check = c("observed", "expected", "chi_sq")) + +} +\seealso{ +\code{\link{cross_tabs}} to calculate results + +\code{\link{plot.cross_tabs}} to plot results +} diff --git a/radiant.basics/man/summary.goodness.Rd b/radiant.basics/man/summary.goodness.Rd new file mode 100644 index 0000000000000000000000000000000000000000..2163d863beb0ff5c1f1212cccf78637142a20526 --- /dev/null +++ b/radiant.basics/man/summary.goodness.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/goodness.R +\name{summary.goodness} +\alias{summary.goodness} +\title{Summary method for the goodness function} +\usage{ +\method{summary}{goodness}(object, check = "", dec = 2, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{goodness}}} + +\item{check}{Show table(s) for the selected variable (var). "observed" for the observed frequencies table, "expected" for the expected frequencies table (i.e., frequencies that would be expected if the null hypothesis holds), "chi_sq" for the contribution to the overall chi-squared statistic for each cell (i.e., (o - e)^2 / e), "dev_std" for the standardized differences between the observed and expected frequencies (i.e., (o - e) / sqrt(e)), and "dev_perc" for the percentage difference between the observed and expected frequencies (i.e., (o - e) / e)} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods.} +} +\description{ +Summary method for the goodness function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/goodness} for an example in Radiant +} +\examples{ +result <- goodness(newspaper, "Income", c(.3, .7)) +summary(result, check = c("observed", "expected", "chi_sq")) +goodness(newspaper, "Income", c(1 / 3, 2 / 3)) \%>\% summary("observed") + +} +\seealso{ +\code{\link{goodness}} to calculate results + +\code{\link{plot.goodness}} to plot results +} diff --git a/radiant.basics/man/summary.prob_binom.Rd b/radiant.basics/man/summary.prob_binom.Rd new file mode 100644 index 0000000000000000000000000000000000000000..2be5878e633abc64f5c90f6c30ced937ed5059ea --- /dev/null +++ b/radiant.basics/man/summary.prob_binom.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{summary.prob_binom} +\alias{summary.prob_binom} +\title{Summary method for the probability calculator (binomial)} +\usage{ +\method{summary}{prob_binom}(object, type = "values", ...) +} +\arguments{ +\item{object}{Return value from \code{\link{prob_binom}}} + +\item{type}{Probabilities ("probs") or values ("values")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the probability calculator (binomial) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +result <- prob_binom(n = 10, p = 0.3, ub = 3) +summary(result, type = "values") + +} +\seealso{ +\code{\link{prob_binom}} to calculate results + +\code{\link{plot.prob_binom}} to plot results +} diff --git a/radiant.basics/man/summary.prob_chisq.Rd b/radiant.basics/man/summary.prob_chisq.Rd new file mode 100644 index 0000000000000000000000000000000000000000..dea05f3902f14fc8bebf34ed5ef97200a5014987 --- /dev/null +++ b/radiant.basics/man/summary.prob_chisq.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{summary.prob_chisq} +\alias{summary.prob_chisq} +\title{Summary method for the probability calculator (Chi-squared distribution)} +\usage{ +\method{summary}{prob_chisq}(object, type = "values", ...) +} +\arguments{ +\item{object}{Return value from \code{\link{prob_chisq}}} + +\item{type}{Probabilities ("probs") or values ("values")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the probability calculator (Chi-squared distribution) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +result <- prob_chisq(df = 1, ub = 3.841) +summary(result, type = "values") + +} +\seealso{ +\code{\link{prob_chisq}} to calculate results + +\code{\link{plot.prob_chisq}} to plot results +} diff --git a/radiant.basics/man/summary.prob_disc.Rd b/radiant.basics/man/summary.prob_disc.Rd new file mode 100644 index 0000000000000000000000000000000000000000..4dc69d30b1cbb9136f822e1151a26b48603e6a57 --- /dev/null +++ b/radiant.basics/man/summary.prob_disc.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{summary.prob_disc} +\alias{summary.prob_disc} +\title{Summary method for the probability calculator (discrete)} +\usage{ +\method{summary}{prob_disc}(object, type = "values", ...) +} +\arguments{ +\item{object}{Return value from \code{\link{prob_disc}}} + +\item{type}{Probabilities ("probs") or values ("values")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the probability calculator (discrete) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +result <- prob_disc(v = 1:6, p = c(2 / 6, 2 / 6, 1 / 12, 1 / 12, 1 / 12, 1 / 12), pub = 0.95) +summary(result, type = "probs") + +} +\seealso{ +\code{\link{prob_disc}} to calculate results + +\code{\link{plot.prob_disc}} to plot results +} diff --git a/radiant.basics/man/summary.prob_expo.Rd b/radiant.basics/man/summary.prob_expo.Rd new file mode 100644 index 0000000000000000000000000000000000000000..9a526abf1c3e4fcce18cf2c115e3ea9b2d6b3a1b --- /dev/null +++ b/radiant.basics/man/summary.prob_expo.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{summary.prob_expo} +\alias{summary.prob_expo} +\title{Summary method for the probability calculator (exponential)} +\usage{ +\method{summary}{prob_expo}(object, type = "values", ...) +} +\arguments{ +\item{object}{Return value from \code{\link{prob_expo}}} + +\item{type}{Probabilities ("probs") or values ("values")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the probability calculator (exponential) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +result <- prob_expo(rate = 1, ub = 2.996) +summary(result, type = "values") + +} +\seealso{ +\code{\link{prob_expo}} to calculate results + +\code{\link{plot.prob_expo}} to plot results +} diff --git a/radiant.basics/man/summary.prob_fdist.Rd b/radiant.basics/man/summary.prob_fdist.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d6a78dcef28ff0317a05790093c17706c973cbf1 --- /dev/null +++ b/radiant.basics/man/summary.prob_fdist.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{summary.prob_fdist} +\alias{summary.prob_fdist} +\title{Summary method for the probability calculator (F-distribution)} +\usage{ +\method{summary}{prob_fdist}(object, type = "values", ...) +} +\arguments{ +\item{object}{Return value from \code{\link{prob_fdist}}} + +\item{type}{Probabilities ("probs") or values ("values")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the probability calculator (F-distribution) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +result <- prob_fdist(df1 = 10, df2 = 10, ub = 2.978) +summary(result, type = "values") + +} +\seealso{ +\code{\link{prob_fdist}} to calculate results + +\code{\link{plot.prob_fdist}} to plot results +} diff --git a/radiant.basics/man/summary.prob_lnorm.Rd b/radiant.basics/man/summary.prob_lnorm.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a1348794597bf68acd0e5d671cebd7c76058629c --- /dev/null +++ b/radiant.basics/man/summary.prob_lnorm.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{summary.prob_lnorm} +\alias{summary.prob_lnorm} +\title{Summary method for the probability calculator (log normal)} +\usage{ +\method{summary}{prob_lnorm}(object, type = "values", ...) +} +\arguments{ +\item{object}{Return value from \code{\link{prob_norm}}} + +\item{type}{Probabilities ("probs") or values ("values")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the probability calculator (log normal) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +result <- prob_lnorm(meanlog = 0, sdlog = 1, lb = 0, ub = 1) +summary(result, type = "values") + +} +\seealso{ +\code{\link{prob_lnorm}} to calculate results + +\code{\link{plot.prob_lnorm}} to summarize results +} diff --git a/radiant.basics/man/summary.prob_norm.Rd b/radiant.basics/man/summary.prob_norm.Rd new file mode 100644 index 0000000000000000000000000000000000000000..c90a47643574074af751ee02510ab9b9ed4f0452 --- /dev/null +++ b/radiant.basics/man/summary.prob_norm.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{summary.prob_norm} +\alias{summary.prob_norm} +\title{Summary method for the probability calculator (normal)} +\usage{ +\method{summary}{prob_norm}(object, type = "values", ...) +} +\arguments{ +\item{object}{Return value from \code{\link{prob_norm}}} + +\item{type}{Probabilities ("probs") or values ("values")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the probability calculator (normal) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +result <- prob_norm(mean = 0, stdev = 1, ub = 0) +summary(result) + +} +\seealso{ +\code{\link{prob_norm}} to calculate results + +\code{\link{plot.prob_norm}} to plot results +} diff --git a/radiant.basics/man/summary.prob_pois.Rd b/radiant.basics/man/summary.prob_pois.Rd new file mode 100644 index 0000000000000000000000000000000000000000..b61780c463e747bc825f0509e6a41d29c76a6fc7 --- /dev/null +++ b/radiant.basics/man/summary.prob_pois.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{summary.prob_pois} +\alias{summary.prob_pois} +\title{Summary method for the probability calculator (poisson)} +\usage{ +\method{summary}{prob_pois}(object, type = "values", ...) +} +\arguments{ +\item{object}{Return value from \code{\link{prob_pois}}} + +\item{type}{Probabilities ("probs") or values ("values")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the probability calculator (poisson) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +result <- prob_pois(lambda = 1, ub = 3) +summary(result, type = "values") + +} +\seealso{ +\code{\link{prob_pois}} to calculate results + +\code{\link{plot.prob_pois}} to plot results +} diff --git a/radiant.basics/man/summary.prob_tdist.Rd b/radiant.basics/man/summary.prob_tdist.Rd new file mode 100644 index 0000000000000000000000000000000000000000..41d85ab4c74d72ff838a49dc6eaf82b73be449cc --- /dev/null +++ b/radiant.basics/man/summary.prob_tdist.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{summary.prob_tdist} +\alias{summary.prob_tdist} +\title{Summary method for the probability calculator (t-distribution)} +\usage{ +\method{summary}{prob_tdist}(object, type = "values", ...) +} +\arguments{ +\item{object}{Return value from \code{\link{prob_tdist}}} + +\item{type}{Probabilities ("probs") or values ("values")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the probability calculator (t-distribution) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +result <- prob_tdist(df = 10, ub = 2.228) +summary(result, type = "values") + +} +\seealso{ +\code{\link{prob_tdist}} to calculate results + +\code{\link{plot.prob_tdist}} to plot results +} diff --git a/radiant.basics/man/summary.prob_unif.Rd b/radiant.basics/man/summary.prob_unif.Rd new file mode 100644 index 0000000000000000000000000000000000000000..7364b92ce1b66367730b18ee99617a6b65bf1336 --- /dev/null +++ b/radiant.basics/man/summary.prob_unif.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prob_calc.R +\name{summary.prob_unif} +\alias{summary.prob_unif} +\title{Summary method for the probability calculator (uniform)} +\usage{ +\method{summary}{prob_unif}(object, type = "values", ...) +} +\arguments{ +\item{object}{Return value from \code{\link{prob_unif}}} + +\item{type}{Probabilities ("probs") or values ("values")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the probability calculator (uniform) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/prob_calc.html} for an example in Radiant +} +\examples{ +result <- prob_unif(min = 0, max = 1, ub = 0.3) +summary(result, type = "values") + +} +\seealso{ +\code{\link{prob_unif}} to calculate results + +\code{\link{plot.prob_unif}} to plot results +} diff --git a/radiant.basics/man/summary.single_mean.Rd b/radiant.basics/man/summary.single_mean.Rd new file mode 100644 index 0000000000000000000000000000000000000000..7d06b9cbf49a064d0c0c6b5fb2548d11f42bfff4 --- /dev/null +++ b/radiant.basics/man/summary.single_mean.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/single_mean.R +\name{summary.single_mean} +\alias{summary.single_mean} +\title{Summary method for the single_mean function} +\usage{ +\method{summary}{single_mean}(object, dec = 3, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{single_mean}}} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the single_mean function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/single_mean.html} for an example in Radiant +} +\examples{ +result <- single_mean(diamonds, "price") +summary(result) +diamonds \%>\% + single_mean("price") \%>\% + summary() + +} +\seealso{ +\code{\link{single_mean}} to generate the results + +\code{\link{plot.single_mean}} to plot results +} diff --git a/radiant.basics/man/summary.single_prop.Rd b/radiant.basics/man/summary.single_prop.Rd new file mode 100644 index 0000000000000000000000000000000000000000..e683bfa294a9f1f807e661420fd54ffb7c319b9c --- /dev/null +++ b/radiant.basics/man/summary.single_prop.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/single_prop.R +\name{summary.single_prop} +\alias{summary.single_prop} +\title{Summary method for the single_prop function} +\usage{ +\method{summary}{single_prop}(object, dec = 3, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{single_prop}}} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the single_prop function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/basics/single_prop.html} for an example in Radiant +} +\examples{ +result <- single_prop(titanic, "survived", lev = "Yes", comp_value = 0.5, alternative = "less") +summary(result) + +} +\seealso{ +\code{\link{single_prop}} to generate the results + +\code{\link{plot.single_prop}} to plot the results +} diff --git a/radiant.basics/tests/testthat.R b/radiant.basics/tests/testthat.R new file mode 100644 index 0000000000000000000000000000000000000000..5e9232f5f2e637e97d41b03bb04a29398117dca4 --- /dev/null +++ b/radiant.basics/tests/testthat.R @@ -0,0 +1,5 @@ +## use shift-cmd-t to run all tests +library(testthat) +test_check("radiant.basics") +# if (interactive() && !exists("coverage_test")) devtools::run_examples() +# devtools::run_examples(start = "single_prop") diff --git a/radiant.basics/tests/testthat/test_stats.R b/radiant.basics/tests/testthat/test_stats.R new file mode 100644 index 0000000000000000000000000000000000000000..165b986e716db9de6e20c5c3a72e1a242505b15f --- /dev/null +++ b/radiant.basics/tests/testthat/test_stats.R @@ -0,0 +1,82 @@ +# library(radiant.basics) +# library(testthat) + +trim <- function(x) gsub("^\\s+|\\s+$", "", x) + +context("Compare means") + +test_that("compare_means 1", { + result <- compare_means(diamonds, "cut", "price") + res1 <- capture.output(summary(result))[9] %>% trim() + # cat(paste0(res1, "\n")) + res2 <- "Fair 4,505.238 101 0 3,749.540 373.093 740.206" + expect_equal(res1, res2) + res1 <- capture.output(summary(result))[16] %>% trim() + # cat(paste0(res1, "\n")) + res2 <- "Fair = Good Fair not equal to Good 374.805 0.391" + expect_equal(res1, res2) +}) + +test_that("compare_means 2", { + result <- compare_means(diamonds, "cut", "price") + res1 <- capture_output(summary(result, show = TRUE)) + # dput(res1) + res2 <- "Pairwise mean comparisons (t-test)\nData : diamonds \nVariables : cut, price \nSamples : independent \nConfidence: 0.95 \nAdjustment: None \n\n cut mean n n_missing sd se me\n Fair 4,505.238 101 0 3,749.540 373.093 740.206\n Good 4,130.433 275 0 3,730.354 224.949 442.848\n Very Good 3,959.916 677 0 3,895.899 149.732 293.995\n Premium 4,369.409 771 0 4,236.977 152.591 299.544\n Ideal 3,470.224 1,176 0 3,827.423 111.610 218.977\n\n Null hyp. Alt. hyp. diff p.value\n Fair = Good Fair not equal to Good 374.805 0.391 \n Fair = Very Good Fair not equal to Very Good 545.322 0.177 \n Fair = Premium Fair not equal to Premium 135.829 0.737 \n Fair = Ideal Fair not equal to Ideal 1035.014 0.009 \n Good = Very Good Good not equal to Very Good 170.517 0.528 \n Good = Premium Good not equal to Premium -238.976 0.38 \n Good = Ideal Good not equal to Ideal 660.209 0.009 \n Very Good = Premium Very Good not equal to Premium -409.493 0.056 \n Very Good = Ideal Very Good not equal to Ideal 489.692 0.009 \n Premium = Ideal Premium not equal to Ideal 899.185 < .001 \n se t.value df 2.5% 97.5% \n 435.661 0.860 177.365 -484.941 1234.551 \n 402.018 1.356 134.291 -249.783 1340.427 \n 403.091 0.337 135.759 -661.321 932.979 \n 389.429 2.658 118.618 263.879 1806.149 ** \n 270.225 0.631 528.529 -360.330 701.364 \n 271.820 -0.879 543.242 -772.922 294.971 \n 251.115 2.629 419.577 166.609 1153.809 ** \n 213.784 -1.915 1442.922 -828.853 9.868 . \n 186.752 2.622 1389.163 123.346 856.039 ** \n 189.052 4.756 1527.729 528.355 1270.015 ***\n\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1" + expect_equal(res1, res2) +}) + +context("Compare proportions") + +test_that("compare_props 1", { + result <- compare_props(titanic, "pclass", "survived") + res1 <- capture.output(summary(result))[9] %>% trim() + # cat(paste0(res1, "\n")) + res2 <- "1st 179 103 0.635 282 0 0.481 0.029 0.056" + expect_equal(res1, res2) +}) + +test_that("compare_props 2", { + result <- compare_props(titanic, "pclass", "survived") + res1 <- capture_output(summary(result, show = TRUE)) + # dput(res1) + res2 <- "Pairwise proportion comparisons\nData : titanic \nVariables : pclass, survived \nLevel : in survived \nConfidence: 0.95 \nAdjustment: None \n\n pclass Yes No p n n_missing sd se me\n 1st 179 103 0.635 282 0 0.481 0.029 0.056\n 2nd 115 146 0.441 261 0 0.496 0.031 0.060\n 3rd 131 369 0.262 500 0 0.440 0.020 0.039\n\n Null hyp. Alt. hyp. diff p.value chisq.value df 2.5% 97.5%\n 1st = 2nd 1st not equal to 2nd 0.194 < .001 20.576 1 0.112 0.277\n 1st = 3rd 1st not equal to 3rd 0.373 < .001 104.704 1 0.305 0.441\n 2nd = 3rd 2nd not equal to 3rd 0.179 < .001 25.008 1 0.107 0.250\n \n ***\n ***\n ***\n\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1" + expect_equal(res1, res2) +}) + +context("Single proportion") + +test_that("single_prop 1", { + result <- single_prop(diamonds, "color") + expect_equal(result$lev, "D") + res1 <- capture_output(summary(result)) + # dput(res1) + res2 <- "Single proportion test (binomial exact)\nData : diamonds \nVariable : color \nLevel : D in color \nConfidence: 0.95 \nNull hyp. : the proportion of D in color = 0.5 \nAlt. hyp. : the proportion of D in color not equal to 0.5 \n\n p ns n n_missing sd se me\n 0.127 382 3,000 0 0.333 0.006 0.012\n\n diff ns p.value 2.5% 97.5% \n -0.373 382 < .001 0.116 0.140 ***\n\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1" + expect_equal(res1, res2) +}) + +test_that("single_prop 2", { + result <- single_prop(diamonds, "clarity", lev = "IF", comp_value = 0.05) + expect_equal(result$lev, "IF") + res1 <- capture_output(summary(result)) + # dput(res1) + res2 <- "Single proportion test (binomial exact)\nData : diamonds \nVariable : clarity \nLevel : IF in clarity \nConfidence: 0.95 \nNull hyp. : the proportion of IF in clarity = 0.05 \nAlt. hyp. : the proportion of IF in clarity not equal to 0.05 \n\n p ns n n_missing sd se me\n 0.033 99 3,000 0 0.179 0.003 0.006\n\n diff ns p.value 2.5% 97.5% \n -0.017 99 < .001 0.027 0.040 ***\n\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1" + expect_equal(res1, res2) +}) + +context("Single mean") + +test_that("single_mean 1", { + result <- single_mean(diamonds, "carat") + res1 <- capture.output(summary(result))[12] %>% trim() + # cat(paste0(res1, "\n")) + res2 <- "0.794 0.009 91.816 < .001 2999 0.777 0.811 ***" + expect_equal(res1, res2) +}) + +test_that("single_mean 2", { + result <- single_mean(titanic, "age", comp_value = 40) + res1 <- capture.output(summary(result))[12] %>% trim() + # cat(paste0(res1, "\n")) + res2 <- "-10.187 0.445 -22.9 < .001 1042 28.94 30.686 ***" + expect_equal(res1, res2) +}) diff --git a/radiant.basics/vignettes/pkgdown/_clt.Rmd b/radiant.basics/vignettes/pkgdown/_clt.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..1d807bac2973a097bf881133c6fbf103d28c86b1 --- /dev/null +++ b/radiant.basics/vignettes/pkgdown/_clt.Rmd @@ -0,0 +1,19 @@ +> Using random sampling to illustrate the Central Limit Theorem + +### What is the Central Limit Theorem? + +"In probability theory, the central limit theorem (CLT) states that, given certain conditions, the arithmetic mean of a sufficiently large number of iterates of independent random variables, each with a well-defined expected value and well-defined variance, will be approximately normally distributed, regardless of the underlying distribution. That is, suppose that a sample is obtained containing a large number of observations, each observation being randomly generated in a way that does not depend on the values of the other observations, and that the arithmetic average of the observed values is computed. If this procedure is performed many times, the central limit theorem says that the computed values of the average will be distributed according to the normal distribution (commonly known as a 'bell curve')." + +Source: Wikipedia + +## Sample + +To generate samples select a distribution from the `Distribution` dropdown and accept (or change) the default values. Then press `Sample` or press `CTRL-enter` (`CMD-enter` on mac) to run the simulation and show plots of the simulated data. + +### Khan on the CLT + +
+ +### R-functions + +For an overview of related R-functions used by Radiant for probability calculations see _Basics > Probability_ diff --git a/radiant.basics/vignettes/pkgdown/_compare_means.Rmd b/radiant.basics/vignettes/pkgdown/_compare_means.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..3dbe5793d24df6379ceb08b0bb3cfe15ff2fdfbe --- /dev/null +++ b/radiant.basics/vignettes/pkgdown/_compare_means.Rmd @@ -0,0 +1,120 @@ +> Compare the means of two or more variables or groups in the data + +The compare means t-test is used to compare the mean of a variable in one group to the mean of the same variable in one, or more, other groups. The null hypothesis for the difference between the groups in the population is set to zero. We test this hypothesis using sample data. + +We can perform either a one-tailed test (i.e., `less than` or `greater than`) or a two-tailed test (see the 'Alternative hypothesis' dropdown). We use one-tailed tests to evaluate if the available data provide evidence that the difference in sample means between groups is less than (or greater than ) zero. + +### Example: Professor salaries + +We have access to the nine-month academic salary for Assistant Professors, Associate Professors and Professors in a college in the U.S (2008-09). The data were collected as part of an on-going effort by the college's administration to monitor salary differences between male and female faculty members. The data has 397 observations and the following 6 variables. + +- rank = a factor with levels AsstProf, AssocProf, and Prof +- discipline = a factor with levels A ("theoretical" departments) or B ("applied" departments) +- yrs.since.phd = years since PhD +- yrs.service = years of service +- sex = a factor with levels Female and Male +- salary = nine-month salary, in dollars + +The data are part of the CAR package and are linked to the book: Fox J. and Weisberg, S. (2011) An R Companion to Applied Regression, Second Edition Sage. + +Suppose we want to test if professors of lower rank earn lower salaries compared to those of higher rank. To test this hypothesis we first select professor `rank` and select `salary` as the numerical variable to compare across ranks. In the `Choose combinations` box select all available entries to conduct pair-wise comparisons across the three levels. Note that removing all entries will automatically select all combinations. We are interested in a one-sided hypothesis (i.e., `less than`). + +

+ +The first two blocks of output show basic information about the test (e.g., selected variables and confidence levels) and summary statistics (e.g., mean, standard deviation, margin or error, etc. per group). The final block of output shows the following: + +* `Null hyp.` is the null hypothesis and `Alt. hyp.` the alternative hypothesis +* `diff` is the difference between the sample means for two groups (e.g., 80775.99 - 93876.44 = -13100.45). If the null hypothesis is true we expect this difference to be small (i.e., close to zero) +* `p.value` is the probability of finding a value as extreme or more extreme than `diff` if the null hypothesis is true + +If we check `Show additional statistics` the following output is added: + +
+Pairwise mean comparisons (t-test)
+Data      : salary 
+Variables : rank, salary 
+Samples   : independent 
+Confidence: 0.95 
+Adjustment: None 
+
+      rank        mean   n n_missing         sd        se        me
+  AsstProf  80,775.985  67         0  8,174.113   998.627 1,993.823
+ AssocProf  93,876.438  64         0 13,831.700 1,728.962 3,455.056
+      Prof 126,772.109 266         0 27,718.675 1,699.541 3,346.322
+
+ Null hyp.              Alt. hyp.              diff      p.value se       t.value df      0%   95%           
+ AsstProf = AssocProf   AsstProf < AssocProf   -13100.45 < .001  1996.639  -6.561 101.286 -Inf  -9785.958 ***
+ AsstProf = Prof        AsstProf < Prof        -45996.12 < .001  1971.217 -23.334 324.340 -Inf -42744.474 ***
+ AssocProf = Prof       AssocProf < Prof       -32895.67 < .001  2424.407 -13.569 199.325 -Inf -28889.256 ***
+
+Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+ +* `se` is the standard error (i.e., the standard deviation of the sampling distribution of `diff`) +* `t.value` is the _t_ statistic associated with `diff` that we can compare to a t-distribution (i.e., `diff` / `se`) +* `df` is the degrees of freedom associated with the statistical test. Note that the Welch approximation is used for the degrees of freedom +* `0% 95%` show the 95% confidence interval around the difference in sample means. These numbers provide a range within which the true population difference is likely to fall + +### Testing + +There are three approaches we can use to evaluate the null hypothesis. We will choose a significance level of 0.05.1 Of course, each approach will lead to the same conclusion. + +#### p.value + +Because each of the p.values is **smaller** than the significance level we reject the null hypothesis for each evaluated pair of professor ranks. The data suggest that associate professors make more than assistant professors and professors make more than assistant and associate professors. Note also the '***' that are used as an indicator for significance. + +#### confidence interval + +Because zero is **not** contained in any of the confidence intervals we reject the null hypothesis for each evaluated combination of ranks. Because our alternative hypothesis is `Less than` the confidence interval is actually an upper bound for the difference in salaries in the population at a 95% confidence level (i.e., -9785.958, -42744.474, and -28889.256) + +#### t.value + +Because the calculated t.values (-6.561, -23.334, and -13.569) are **smaller** than the corresponding _critical_ t.value we reject the null hypothesis for each evaluated combination of ranks. We can obtain the critical t.value by using the probability calculator in the _Basics_ menu. Using the test for assistant versus associate professors as an example, we find that for a t-distribution with 101.286 degrees of freedom (see `df`) the critical t.value is 1.66. We choose 0.05 as the lower probability bound because the alternative hypothesis is `Less than`. + +

+ +In addition to the numerical output provided in the _Summary_ tab we can also investigate the association between `rank` and `salary` visually (see the _Plot_ tab). The screen shot below shows a scatter plot of professor salaries and a bar chart with confidence interval (black) and standard error (blue) bars. Consistent with the results shown in the _Summary_ tab there is clear separation between the salaries across ranks. We could also choose to plot the sample data as a box plot or as a set of density curves. + +

+ +### Multiple comparison adjustment + +The more comparisons we evaluate the more likely we are to find a "significant" result just by chance even if the null hypothesis is true. If we conduct 100 tests and set our **significance level** at 0.05 (or 5%) we can expect to find 5 p.values smaller than or equal to 0.05 even if the are no associations in the population. + +Bonferroni adjustment ensures the p.values are scaled appropriately given the number of tests conducted. This XKCD cartoon expresses the need for this type of adjustments very clearly. + +### _Stats speak_ + +This is a **comparison of means** test of the null hypothesis that the true population **difference in means** is equal to **0**. Using a significance level of 0.05, we reject the null hypothesis for each pair of ranks evaluated, and conclude that the true population **difference in means** is **less** than **0**. + +The p.value for the test of differences in salaries between assistant and associate professors is **< .001**. This is the probability of observing a sample **difference in means** that is as or more extreme than the sample **difference in means** from the data if the null hypothesis is true. In this case, it is the probability of observing a sample **difference in means** that is less than (or equal to) **-13100.45** if the true population **difference in means** is **0**. + +The 95% confidence bound is **-9785.958**. If repeated samples were taken and the 95% confidence bound computed for each one, the true population mean would be below the lower bound in 95% of the samples + +1 The **significance level**, often denoted by $\alpha$, is the highest probability you are willing to accept of rejecting the null hypothesis when it is actually true. A commonly used significance level is 0.05 (or 5%) + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If a plot was created it can be customized using `ggplot2` commands (e.g., `plot(result, plots = "scatter", custom = TRUE) + labs(title = "Compare means")`). See _Data > Visualize_ for details. + +### R-functions + +For an overview of related R-functions used by Radiant to evaluate means see _Basics > Means_ + +The key function from the `stats` package used in the `compare_means` tool is `t.test`. + +### Video Tutorials + +Copy-and-paste the full command below into the RStudio console (i.e., the bottom-left window) and press return to gain access to all materials used in the hypothesis testing module of the Radiant Tutorial Series: + +
usethis::use_course("https://www.dropbox.com/sh/0xvhyolgcvox685/AADSppNSIocrJS-BqZXhD1Kna?dl=1")
+ +Compare Means Hypothesis Test + +* This video shows how to conduct a compare means hypothesis test +* Topics List: + - Calculate summary statistics by groups + - Setup a hypothesis test for compare means in Radiant + - Use the p.value and confidence interval to evaluate the hypothesis test diff --git a/radiant.basics/vignettes/pkgdown/_compare_props.Rmd b/radiant.basics/vignettes/pkgdown/_compare_props.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..e56ad244c2942be564453bf30bf27a9f154ef74f --- /dev/null +++ b/radiant.basics/vignettes/pkgdown/_compare_props.Rmd @@ -0,0 +1,120 @@ +> Compare proportions for two or more groups in the data + +The compare proportions test is used to evaluate if the frequency of occurrence of some event, behavior, intention, etc. differs across groups. The null hypothesis for the difference in proportions across groups in the population is set to zero. We test this hypothesis using sample data. + +We can perform either a one-tailed test (i.e., `less than` or `greater than`) or a two-tailed test (see the `Alternative hypothesis` dropdown). A one-tailed test is useful if we want to evaluate if the available sample data suggest that, for example, the proportion of dropped calls is larger (or smaller) for one wireless provider compared to others. + +### Example + +We will use a sample from a dataset that describes the survival status of individual passengers on the Titanic. The principal source for data about Titanic passengers is the Encyclopedia Titanic. One of the original sources is Eaton & Haas (1994) Titanic: Triumph and Tragedy, Patrick Stephens Ltd, which includes a passenger list created by many researchers and edited by Michael A. Findlay. Lets focus on two variables in the database: + +- survived = a factor with levels `Yes` and `No` +- pclass = Passenger Class (1st, 2nd, 3rd). This is a proxy for socio-economic status (SES) 1st ~ Upper; 2nd ~ Middle; 3rd ~ Lower + +Suppose we want to test if the proportion of people that survived the sinking of the Titanic differs across passenger classes. To test this hypothesis we select `pclass` as the grouping variable and calculate proportions of `yes` (see `Choose level`) for `survived` (see `Variable (select one)`). + +In the `Choose combinations` box select all available entries to conduct pair-wise comparisons across the three passenger class levels. Note that removing all entries will automatically select all combinations. Unless we have an explicit hypothesis for the direction of the effect we should use a two-sided test (i.e., `two.sided`). Our first alternative hypothesis would be 'The proportion of survivors among 1st class passengers was different compared to 2nd class passengers'. + +

+ +The first two blocks of output show basic information about the test (e.g.,. selected variables and confidence levels) and summary statistics (e.g., proportions, standard error, margin or error, etc. per group). The final block of output shows the following: + +* `Null hyp.` is the null hypothesis and `Alt. hyp.` the alternative hypothesis +* `diff` is the difference between the sample proportion for two groups (e.g., 0.635 - 0.441 = 0.194). If the null hypothesis is true we expect this difference to be small (i.e., close to zero) +* `p.value` is the probability of finding a value as extreme or more extreme than `diff` if the null hypothesis is true + +If we check `Show additional statistics` the following output is added: + +
+Pairwise proportion comparisons
+Data      : titanic 
+Variables : pclass, survived 
+Level     : Yes in survived 
+Confidence: 0.95 
+Adjustment: None 
+
+ pclass Yes  No     p   n n_missing    sd    se    me
+    1st 179 103 0.635 282         0 8.086 0.029 0.056
+    2nd 115 146 0.441 261         0 8.021 0.031 0.060
+    3rd 131 369 0.262 500         0 9.832 0.020 0.039
+
+ Null hyp.   Alt. hyp.              diff  p.value chisq.value df 2.5%  97.5%    
+ 1st = 2nd   1st not equal to 2nd   0.194 < .001  20.576      1  0.112 0.277 ***
+ 1st = 3rd   1st not equal to 3rd   0.373 < .001  104.704     1  0.305 0.441 ***
+ 2nd = 3rd   2nd not equal to 3rd   0.179 < .001  25.008      1  0.107 0.250 ***
+
+Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+ +* `chisq.value` is the chi-squared statistic associated with `diff` that we can compare to a chi-squared distribution. For additional discussion on how this metric is calculated see the help file in _Basics > Tables > Cross-tabs_. For each combination the equivalent of a 2X2 cross-tab is calculated. +* `df` is the degrees of freedom associated with each statistical test (1). +* `2.5% 97.5%` show the 95% confidence interval around the difference in sample proportions. These numbers provide a range within which the true population difference is likely to fall + +### Testing + +There are three approaches we can use to evaluate the null hypothesis. We will choose a significance level of 0.05.1 Of course, each approach will lead to the same conclusion. + +#### p.value + +Because the p.values are **smaller** than the significance level for each pair-wise comparison we can reject the null hypothesis that the proportions are equal based on the available sample of data. The results suggest that 1st class passengers were more likely to survive the sinking than either 2nd or 3rd class passengers. In turn, the 2nd class passengers were more likely to survive than those in 3rd class. + +#### Confidence interval + +Because zero is **not** contained in any of the confidence intervals we reject the null hypothesis for each evaluated combination of passenger class levels. + +#### Chi-squared values + +Because the calculated chi-squared values (20.576, 104.704, and 25.008) are **larger** than the corresponding _critical_ chi-squared value we reject the null hypothesis for each evaluated combination of passenger class levels. We can obtain the critical chi-squared value by using the probability calculator in the _Basics_ menu. Using the test for 1st versus 2nd class passengers as an example, we find that for a chi-squared distribution with 1 degree of freedom (see `df`) and a confidence level of 0.95 the critical chi-squared value is 3.841. + +

+ +In addition to the numerical output provided in the _Summary_ tab we can also investigate the association between `pclass` and `survived` visually (see the _Plot_ tab). The screen shot below shows two bar charts. The first chart has confidence interval (black) and standard error (blue) bars for the proportion of `yes` entries for `survived` in the sample. Consistent with the results shown in the _Summary_ tab there are clear differences in the survival rate across passenger classes. The `Dodge` chart shows the proportions of `yes` and `no` in `survived` side-by-side for each passenger class. While 1st class passengers had a higher proportion of `yes` than `no` the opposite holds for the 3rd class passengers. + +

+ +### Technical notes + +* Radiant uses R's `prop.test` function to compare proportions. When one or more expected values are small (e.g., 5 or less) the p.value for this test is calculated using simulation methods. When this occurs it is recommended to rerun the test using _Basics > Tables > Cross-tabs_ and evaluate if some cells may have an expected value below 1. +* For one-sided tests (i.e., `Less than` or `Greater than`) critical values must be obtained by using the normal distribution in the probability calculator and squaring the corresponding Z-statistic. + +### Multiple comparison adjustment + +The more comparisons we evaluate the more likely we are to find a "significant" result just by chance even if the null hypothesis is true. If we conduct 100 tests and set our **significance level** at 0.05 (or 5%) we can expect to find 5 p.values smaller than or equal to 0.05 even if there are no associations in the population. + +Bonferroni adjustment ensures the p.values are scaled appropriately given the number of tests conducted. This XKCD cartoon expresses the need for this type of adjustments very clearly. + +### _Stats speak_ + +This is a **comparison of proportions** test of the null hypothesis that the true population **difference in proportions** is equal to **0**. Using a significance level of 0.05, we reject the null hypothesis for each pair of passengers classes evaluated, and conclude that the true population **difference in proportions** is **not equal to 0**. + +The p.value for the test of differences in the survival proportion for 1st versus 2nd class passengers is **< .001**. This is the probability of observing a sample **difference in proportions** that is as or more extreme than the sample **difference in proportions** from the data if the null hypothesis is true. In this case, it is the probability of observing a sample **difference in proportions** that is less than **-0.194** or greater than **0.194** if the true population **difference in proportions** is **0**. + +The 95% confidence interval is **0.112** to **0.277**. If repeated samples were taken and the 95% confidence interval computed for each one, the true **difference in population proportions** would fall inside the confidence interval in 95% of the samples + +1 The **significance level**, often denoted by $\alpha$, is the highest probability you are willing to accept of rejecting the null hypothesis when it is actually true. A commonly used significance level is 0.05 (or 5%) + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If a plot was created it can be customized using `ggplot2` commands (e.g., `plot(result, plots = "bar", custom = TRUE) + labs(title = "Compare proportions")`). See _Data > Visualize_ for details. + +### R-functions + +For an overview of related R-functions used by Radiant to evaluate proportions see _Basics > Proportions_. + +The key function from the `stats` package used in the `compare_props` tool is `prop.test`. + +### Video Tutorials + +Copy-and-paste the full command below into the RStudio console (i.e., the bottom-left window) and press return to gain access to all materials used in the hypothesis testing module of the Radiant Tutorial Series: + +
usethis::use_course("https://www.dropbox.com/sh/0xvhyolgcvox685/AADSppNSIocrJS-BqZXhD1Kna?dl=1")
+ +Compare Proportions Hypothesis Test + +* This video shows how to conduct a compare proportions hypothesis test +* Topics List: + - Setup a hypothesis test for compare means in Radiant + - Use the p.value and confidence interval to evaluate the hypothesis test + diff --git a/radiant.basics/vignettes/pkgdown/_correlation.Rmd b/radiant.basics/vignettes/pkgdown/_correlation.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..ac0274bec91c5c28258f831c2c9d8a0996fda127 --- /dev/null +++ b/radiant.basics/vignettes/pkgdown/_correlation.Rmd @@ -0,0 +1,55 @@ +> How correlated are the variables in the data? + +Create a correlation matrix of the selected variables. Correlations and p.values are provided for each variable pair. To show only those correlations above a certain (absolute) level, use the correlation cutoff box. + +Note: Correlations can be calculated for variables of type `numeric`, `integer`, `date`, and `factor`. When variables of type factor are included the `Adjust for {factor} variables` box should be checked. When correlations are estimated with adjustment, variables that are of type `factor` will be treated as (ordinal) categorical variables and all other variables will be treated as continuous. + +

+ +A visual representation of the correlation matrix is provided in the _Plot_ tab. Note that scatter plots in the graph at most 1,000 data points by default. To generate scatter plots that use all observations use `plot(result, n = -1)` in _Report > Rmd_. + +Stars shown in the _Plot_ tab are interpreted as: + +- p.value between 0 and 0.001: *** +- p.value between 0.001 and 0.01: ** +- p.value between 0.01 and 0.05: * +- p.value between 0.05 and 0.1: . + +

+ +The font-size used in the plot is proportional to the size and significance of the correlation between two variables. + +### Method + +Select the method to use to calculate correlations. The most common method is `Pearson`. See Wikipedia for details. + +### Correlation cutoff + +To show only correlations above a certain value choose a non-zero value in the numeric input between 0 and 1 (e.g., 0.15). + +### Covariance matrix + +Although we generally use the correlation matrix, you can also show the covariance matrix by checking the `Show covariance matrix` box. + +## Store as data.frame + +The correlation matrix can be stored as a data.frame by (1) providing a name for the new data set and (2) clicking on the `Store` button. The new data sets will the estimated `correlation` for each variable pair and a `distance` measure that is calculated as follows: `distance = 0.5 * (1 - correlation)`. This measure will be equal to 1 when the correlation between two variable is equal to -1 and equal to 0 when the correlation between two variables is equal to 1. For an example of what such a dataset would look like, see the screenshot below of the _Data > View_ tab. Data sets with this structure can be used as input to create a (dis)similarity based map by using _Multivariate > (Dis)similarity_. + +

+ +### Khan on correlation + +

+ +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +By default the correlation plot samples 1,000 data points. To include all data points use `plot(result, n = -1)` +To add, for example, a title to the plot use `title(main = "Correlation plot\n\n")`. See the R graphics documentation for additional information. + +### R-functions + +For an overview of related R-functions used by Radiant to evaluate correlations see _Basics > Tables_. + +The key function from the `psych` package used in the `correlation` tool is `corr.test`. diff --git a/radiant.basics/vignettes/pkgdown/_cross_tabs.Rmd b/radiant.basics/vignettes/pkgdown/_cross_tabs.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..10356bc5b49642dc5de4892e410c57717bc45206 --- /dev/null +++ b/radiant.basics/vignettes/pkgdown/_cross_tabs.Rmd @@ -0,0 +1,67 @@ +> Cross-tab analysis is used to evaluate if categorical variables are associated. This tool is also known as chi-square or contingency table analysis + +### Example + +The data are from a sample of 580 newspaper readers that indicated (1) which newspaper they read most frequently (USA today or Wall Street Journal) and (2) their level of income (Low income vs. High income). The data has three variables: A respondent identifier (id), respondent income (High or Low), and the primary newspaper the respondent reads (USA today or Wall Street Journal). + +We will examine if there is a relationship between income level and choice of newspaper. In particular, we test the following null and alternative hypotheses: + +* H0: There is no relationship between income level and newspaper choice +* Ha: There is a relationship between income level and newspaper choice + +If the null-hypothesis is rejected we can investigate which cell(s) contribute to the hypothesized association. In Radiant (Basics > Cross-tab) choose Income as the first factor and Newspaper as the second factor. First, compare the observed and expected frequencies. The expected frequencies are calculated using H0 (i.e., no association) as (Row total x Column Total) / Overall Total. + +

+ +The (Pearson) chi-squared test evaluates if we can reject the null-hypothesis that the two variables are independent. It does so by comparing the observed frequencies (i.e., what we actually see in the data) to the expected frequencies (i.e., what we would expect to see if the two variables were independent). If there are big differences between the table of expected and observed frequencies the chi-square value will be _large_. The chi-square value for each cell is calculated as `(o - e)^2 / e`, where `o` is the observed frequency in a cell and `e` is the expected frequency in that cell if the null hypothesis holds. These values can be shown by clicking the `Chi-squared` check box. The overall chi-square value is obtained by summing across all cells, i.e., it is the sum of the values shown in the _Contribution to chi-square_ table. + +In order to determine if the chi-square value can be considered _large_ we first determine the degrees of freedom (df). In particular: df = (# rows - 1) x (# columns - 1). In a 2x2 table, we have (2-1) x (2-1) = 1 df. The output in the _Summary_ tab shows the value of the chi-square statistic, the associated df, and the p.value associated with the test. We also see the contribution from each cells to the overall chi-square statistic. + +Remember to check the expected values: All expected frequencies are larger than 5 therefore the p.value for the chi-square statistic is unlikely to be biased. As usual we reject the null-hypothesis when the p.value is smaller 0.05. Since our p.value is very small (< .001) we can reject the null-hypothesis (i.e., the data suggest there is an association between newspaper readership and income). + +We can use the provided p.value associated with the Chi-squared value of 187.783 to evaluate the null hypothesis. However, we can also calculate the critical Chi-squared value using the probability calculator. As we can see from the output below that value is 3.841 if we choose a 95% confidence level. Because the calculated Chi-square value is larger than the critical value (187.783 > 3.841) we reject null hypothesis that `Income` and `Newspaper` are independent. + +

+ +We can also use the probability calculator to determine the p.value associated with the calculated Chi-square value. Consistent with the output from the _Cross-tabs > Summary_ tab this `p.value` is `< .001`. + +

+ +In addition to the numerical output provided in the _Summary_ tab we can evaluate the hypothesis visually (see the _Plot_ tab). We choose the same variables as before. However, we will plot the standardized deviations. This measure is calculated as (o-e)/sqrt(e), i.e., a score of how different the observed and expected frequencies in one cell in our table are. When a cell's standardized deviation is greater than 1.96 (in absolute value) the cell has a significant deviation from the model of independence (or no association). + +

+ +In the plot we see that all cells contribute to the association between income and readership as all standardized deviations are larger than 1.96 in absolute value (i.e., the bars extend beyond the outer dotted line in the plot). + +In other words, there seem to be fewer low income respondents that read WSJ and more high income respondents that read WSJ than would be expected if the null hypothesis of no-association were true. Furthermore, there are more low income respondents that read USA today and fewer high income respondents that read USA Today than would be expected if the null hypothesis of no-association were true. + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If a plot was created it can be customized using `ggplot2` commands (e.g., `plot(result, check = "observed", custom = TRUE) + labs(y = "Percentage")`). See _Data > Visualize_ for details. + +### Technical note + +When one or more expected values are small (e.g., 5 or less) the p.value for the Chi-squared test is calculated using simulation methods. If some cells have an expected count below 1 it may be necessary to _collapse_ rows and/or columns. + +### R-functions + +For an overview of related R-functions used by Radiant to evaluate associations between categorical variables see _Basics > Tables_ + +The key function from the `stats` package used in the `cross_tabs` tool is `chisq.test`. + +### Video Tutorials + +Copy-and-paste the full command below into the RStudio console (i.e., the bottom-left window) and press return to gain access to all materials used in the hypothesis testing module of the Radiant Tutorial Series: + +
usethis::use_course("https://www.dropbox.com/sh/0xvhyolgcvox685/AADSppNSIocrJS-BqZXhD1Kna?dl=1")
+ +Cross-tabs Hypothesis Test + +* This video demonstrates how to investigate associations between two categorical variables by a cross-tabs hypothesis test +* Topics List: + - Setup a hypothesis test for cross-tabs in Radiant + - Explain how observed, expected and contribution to chi-squared tables are constructed + - Use the p.value and critical value to evaluate the hypothesis test + diff --git a/radiant.basics/vignettes/pkgdown/_footer.md b/radiant.basics/vignettes/pkgdown/_footer.md new file mode 100644 index 0000000000000000000000000000000000000000..05010f02dd76f9e82c3cb8a79ee3cfcec670384d --- /dev/null +++ b/radiant.basics/vignettes/pkgdown/_footer.md @@ -0,0 +1,2 @@ + +© Vincent Nijs (2023) Creative Commons License diff --git a/radiant.basics/vignettes/pkgdown/_goodness.Rmd b/radiant.basics/vignettes/pkgdown/_goodness.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..d7339bea9ad2c7c0093db3dff51ca0d2a22501d4 --- /dev/null +++ b/radiant.basics/vignettes/pkgdown/_goodness.Rmd @@ -0,0 +1,46 @@ +> A goodness-of-fit test is used to determine if data from a sample are consistent with a hypothesized distribution + +### Example + +The data are from a sample of 580 newspaper readers that indicated (1) which newspaper they read most frequently (USA today or Wall Street Journal) and (2) their level of income (Low income vs. High income). The data has three variables: A respondent identifier (id), respondent income (High or Low), and the primary newspaper the respondent reads (USA today or Wall Street Journal). + +The data were collected to examine if there is a relationship between income level and choice of newspaper. To ensure the results are generalizable it is important that sample is representative of the population of interest. It is known that in this population the relative share of US today readers is higher than the share of Wall Street Journal readers. The shares should be 55% and 45% respectively. We can use a goodness-of-fit test to examine the following null and alternative hypotheses: + +* H0: Readership shares for USA today and Wall Street Journal are 55% and 45% respectively +* Ha: Readership shares for USA today and Wall Street Journal are not equal to the stated values + +If we cannot reject the null hypothesis based on the available sample there is a "good fit" between the observed data and the assumed population shares or probabilities. In Radiant (_Basics > Tables > Goodness of fit_) choose Newspaper as the categorical variable. If we leave the `Probabilities` input field empty (or enter 1/2) we would be testing if the shares are equal. However, to test H0 and Ha we need to enter `0.45 and 0.55` and then press `Enter`. First, compare the observed and expected frequencies. The expected frequencies are calculated assuming H0 is true (i.e., no deviation from the stated shares) as total $\times$ $p$, where $p$ is the share (or probability) assumed for a cell. + +

+ +The (Pearson) chi-squared test evaluates if we can reject the null-hypothesis that the observed and expected values are the same. It does so by comparing the observed frequencies (i.e., what we actually see in the data) to the expected frequencies (i.e., what we would expect to see if the distribution of shares is as we assumed). If there are big differences between the table of expected and observed frequencies the chi-square value will be _large_. The chi-square value for each cell is calculated as `(o - e)^2 / e`, where `o` is the observed frequency in a cell and `e` is the expected frequency in that cell if the null hypothesis holds. These values can be shown by clicking the `Chi-squared` check box. The overall chi-square value is obtained by summing across all cells, i.e., it is the sum of the values shown in the _Contribution to chi-square_ table. + +In order to determine if the chi-square statistic can be considered _large_ we first determine the degrees of freedom (df = # cells - 1). In a table with two cells we have df = (2-1) = 1. The output in the _Summary_ tab shows the value of the chi-square statistic, the df, and the p.value associated with the test. We also see the contribution from each cells to the overall chi-square statistic. + +Remember to check the expected values: All expected frequencies are larger than 5 so the p.value for the chi-square statistic is unlikely to be biased (see also the technical note below). As usual we reject the null-hypothesis when the p.value is smaller 0.05. Since our p.value is very large (> .8) we cannot reject the null-hypothesis (i.e., the distribution of shares in the observed data is consistent with those we assumed). + +We can use the provided p.value associated with the Chi-squared value of 0.028 to evaluate the null hypothesis. However, we can also calculate the critical Chi-squared value using the probability calculator. As we can see from the output below the critical value is 3.841 if we choose a 95% confidence level. Because the calculated Chi-square value is smaller than the critical value (0.028 < 3.841) we cannot reject null hypothesis stated above. + +

+ +We can also use the probability calculator to determine the p.value associated with the calculated Chi-square value. Consistent with the output from the _Summary_ tab this `p.value` is `< .001`. + +

+ +In addition to the numerical output provided in the _Summary_ tab we can evaluate the hypothesis visually in the _Plot_. + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If a plot was created it can be customized using `ggplot2` commands (e.g., `plot(result, check = "observed", custom = TRUE) + labs(y = "Percentage")`). See _Data > Visualize_ for details. + +### Technical note + +When one or more expected values are small (e.g., 5 or less) the p.value for the Chi-squared test is calculated using simulation methods. If some cells have an expected count below 1 it may be necessary to combine cells/categories. + +### R-functions + +For an overview of related R-functions used by Radiant to evaluate a discrete probability distribution see _Basics > Tables_ + +The key function from the `stats` package used in the `goodness` tool is `chisq.test`. diff --git a/radiant.basics/vignettes/pkgdown/_prob_calc.Rmd b/radiant.basics/vignettes/pkgdown/_prob_calc.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..d19959da70924a774e3a0b3e26402f868630d424 --- /dev/null +++ b/radiant.basics/vignettes/pkgdown/_prob_calc.Rmd @@ -0,0 +1,106 @@ +> Probability calculator + +Calculate probabilities or values based on the _Binomial_, _Chi-squared_, _Discrete_, _F_, _Exponential_, _Normal_, _Poisson_, _t_, or _Uniform_ distribution. + +## Testing batteries + +Suppose Consumer Reports (CR) wants to test manufacturer claims about battery life. The manufacturer claims that more than 90% of their batteries will power a laptop for at least 12 hours of continuous use. CR sets up 20 identical laptops with the manufacturer's batteries. If the manufacturer's claims are accurate, what is the probability that 15 or more laptops are still running after 12 hours? + +The description of the problem suggests we should select `Binomial` from the `Distribution` dropdown. To find the probability, select `Values` as the `Input type` and enter `15` as the `Upper bound`. In the output below we can see that the probability is 0.989. The probability that exactly 15 laptops are still running after 12 hours is 0.032. + +

+ +## Demand for headphones + +A manufacturer wants to determine the appropriate inventory level for headphones required to achieve a 95% service level. Demand for the headphones obeys a normal distribution with a mean of 3000 and a standard deviation of 800. + +To find the required number of headphones to hold in inventory choose `Normal` from the `Distribution` dropdown and then select `Probability` as the `Input type`. Enter `.95` as the `Upper bound`. In the output below we see the number of units to stock is 4316. + +

+ +## Cups of ice cream + +A **discrete** random variable can take on a limited (finite) number of possible values. The **probability distribution** of a discrete random variable lists these values and their probabilities. For example, probability distribution of the number of cups of ice cream a customer buys could be described as follows: + +* 40% of customers buy 1 cup; +* 30% of customers buy 2 cups; +* 20% of customers buy 3 cups; +* 10% of customers buy 4 cups. + +We can use the probability distribution of a random variable to calculate its **mean** (or **expected value**) as follows; + +$$ + E(C) = \mu_C = 1 \times 0.40 + 2 \times 0.30 + 3 \times 0.20 + 4 \times 0.10 = 2\,, +$$ + +where $\mu_C$ is the mean number of cups purchased. We can _expect_ a randomly selected customer to buy 2 cups. The variance is calculated as follow: + +$$ + Var(C) = (1 - 2)^2 \times 0.4 + (2 - 2)^2 \times 0.3 + (3 - 2)^2 \times 0.2 + (4 - 2)^2 \times 0.1 = 1\,. +$$ + +To get the mean and standard deviation of the discrete probability distribution above, as well as the probability a customer will buy 2 or more cups (0.6), specify the following in the probability calculator. + +

+ +## Hypothesis testing + +You can also use the probability calculator to determine a `p.value` or a `critical value` for a statistical test. See the help files for `Single mean`, `Single proportion`, `Compare means`, `Compare proportions`, `Cross-tabs` in the _Basics_ menu and `Linear regression (OLS)` in the _Model_ menu for details. + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If a plot was created it can be customized using `ggplot2` commands (e.g., `plot(result) + labs(title = "Normal distribution")`). See _Data > Visualize_ for details. + +### R-functions + +For an overview of related R-functions used by Radiant for probability calculations see _Basics > Probability_ + +Key functions from the `stats` package used in the probability calculator: + +* `prob_norm` uses `pnorm`, `qnorm`, and `dnorm` +* `prob_lnorm` uses `plnorm`, `qlnorm`, and `dlnorm` +* `prob_tdist` uses `pt`, `qt`, and `dt` +* `prob_fdist` uses `pf`, `qf`, and `df` +* `prob_chisq` uses `pchisq`, `qchisq`, and `dchisq` +* `prob_unif` uses `punif`, `qunif`, and `dunif` +* `prob_binom` uses `pbinom`, `qbinom`, and `dbinom` +* `prob_expo` uses `pexp`, `qexp`, and `dexp` +* `prob_pois` uses `ppios`, `qpois`, and `dpois` + +### Video Tutorials + +Copy-and-paste the full command below into the RStudio console (i.e., the bottom-left window) and press return to gain access to all materials used in the probability calculator module of the Radiant Tutorial Series: + +
usethis::use_course("https://www.dropbox.com/sh/zw1yuiw8hvs47uc/AABPo1BncYv_i2eZfHQ7dgwCa?dl=1")
+ +Describing the Distribution of a Discrete Random + Variable (#1) + +* This video shows how to summarize information about a discrete random variable using the probability calculator in Radiant +* Topics List: + - Calculate the mean and variance for a discrete random variable by hand + - Calculate the mean, variance, and select probabilities for a discrete random variable in Radiant + +Describing Normal and Binomial Distributions in Radiant(#2) + +* This video shows how to summarize information about Normal and Binomial distributions using the probability calculator in Radiant +* Topics List: + - Calculate probabilities of a random variable following a Normal distribution in Radiant + - Calculate probabilities of a random variable following a Binomial distribution by hand + - Calculate probabilities of a random variable following a Binomial distribution in Radiant + +Describing Uniform and Binomial Distributions in Radiant(#3) + +* This video shows how to summarize information about Uniform and Binomial distributions using the probability calculator in Radiant +* Topics List: + - Calculate probabilities of a random variable following a Uniform distribution in Radiant + - Calculate probabilities of a random variable following a Binomial distribution in Radiant + +Providing Probability Bounds(#4) + +* This video demonstrates how to provide probability bounds in Radiant +* Topics List: + - Use probabilities as input type + - Round up the cutoff value diff --git a/radiant.basics/vignettes/pkgdown/_single_mean.Rmd b/radiant.basics/vignettes/pkgdown/_single_mean.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..80228a653a68b98eb05e8aadde052ea8b3e382aa --- /dev/null +++ b/radiant.basics/vignettes/pkgdown/_single_mean.Rmd @@ -0,0 +1,82 @@ +> Compare a single mean to the mean value in the population + +The single mean (or one-sample) t-test is used to compare the mean of a variable in a sample of data to a (hypothesized) mean in the population from which our sample data are drawn. This is important because we seldom have access to data for an entire population. The hypothesized value in the population is specified in the `Comparison value` box. + +We can perform either a one-sided test (i.e., `less than` or `greater than`) or a two-sided test (see the `Alternative hypothesis` dropdown). We use one-sided tests to evaluate if the available data provide evidence that the sample mean is larger (or smaller) than the comparison value (i.e., the population value in the null-hypothesis). + +## Example + +We have access to data from a random sample of grocery stores in the UK. Management will consider entering this market if consumer demand for the product category exceeds 100M units, or, approximately, 1750 units per store. The average demand per store in the sample is equal to 1953. While this number is larger than 1750 we need to determine if the difference could be attributed to sampling error. + +You can find the information on unit sales in each of the sample stores in the **demand\_uk.rda** data set. The data set contains two variables, `store_id` and `demand_uk`. Our null-hypothesis is that the average store demand in the UK is equal to 1750 unit so we enter that number into the `Comparison value` box. We choose the `Greater than` option from the `Alternative hypothesis` drop-down because we want to determine if the available data provides sufficient evidence to reject the null-hypothesis favor of the alternative that average store demand in the UK is **larger than 1750**. + +

+ +The first two blocks of output show basic information about the test (e.g.,. the null and alternative hypothesis) and summary statistics (e.g., mean, standard deviation, standard error, margin or error, etc.). The final row of output shows the following: + +* `diff` is the difference between the sample mean (1953.393) and the comparison value (1750) +* `se` is the standard error (i.e., the standard deviation of the sampling distribution of `diff`) +* `t.value` is the _t_ statistic associated with `diff` that we can compare to a t-distribution (i.e., `diff` / `se`) +* `p.value` is the probability of finding a value as extreme or more extreme than `diff` if the null hypothesis is true +* `df` is the degrees of freedom associated with the statistical test (i.e., _n_ - 1) +* `5% 100%` show the 95% confidence interval around the sample mean (1897 to Inf.). These numbers provide a range within which the true population mean is likely to fall + +### Testing + +There are three approaches we can use to evaluate the null hypothesis. We will choose a significance level of 0.05.1 Of course, each approach will lead to the same conclusion. + +#### p.value + +Because the p.value is **smaller** than the conventional significance level (i.e., 0.05) we reject the null hypothesis and suggest that management should enter the UK market. Note also the '***' that are used as an indicator for significance. + +#### confidence interval + +Because the `comparison value` is **not** contained in the confidence interval we reject the null hypothesis and suggest that management should enter the UK market. + +#### t.value + +Because the calculated t.value (5.967) is **larger** than the _critical_ t.value we reject the null hypothesis and suggest that management should enter the UK market. We can obtain the critical t.value by using the probability calculator in the _Basics_ menu. For a t-distribution with 571 degrees of freedom (see `df`) the critical t.value is 1.648. We have to enter 0.95 as the upper probability bound (i.e., 1 - 0.05) because the alternative hypothesis is `Greater than`.2 + +

+ +In addition to the numerical output provided in the _Summary_ tab we can visualize the data in the _Plot_ tab. The settings in the side-panel are the same as before. The black lines in the histogram show the sample mean (solid) and the confidence interval around the sample mean (dashed). The red line shows the comparison value (i.e., unit sales under the null-hypothesis). Because the red line does **not** fall within the confidence interval (1897 to Inf.) we reject the null-hypothesis in favor of the alternative. + +

+ +### _Stats speak_ + +This is a **single mean** test of the null hypothesis that the true population **mean** is equal to **1750**. Using a significance level of 0.05, we reject the null hypothesis, and conclude that the true population **mean** is **larger** than **1750**. + +The p.value for this test is **< .001**. This is the probability of observing a sample **mean** that is as or more extreme than the sample **mean** from the data if the null hypothesis is true. In this case, it is the probability of observing a sample **mean** that is larger than (or equal to) **1953.393** if the true population **mean** is **1750**. + +The 5% confidence bound is **1897.233**. If repeated samples were taken and the 5% confidence bound computed for each one, the true population mean would exceed the lower bound in 95% of the samples + +1 The **significance level**, often denoted by $\alpha$, is the highest probability you are willing to accept of rejecting the null hypothesis when it is actually true. A commonly used significance level is 0.05 (or 5%) + +2 $1 - \alpha$ is called the **confidence level**. A commonly used confidence level is 0.95 (or 95%) + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If a plot was created it can be customized using `ggplot2` commands (e.g., `plot(result, plots = "hist", custom = TRUE) + labs(title = "Histogram")`). See _Data > Visualize_ for details. + +### R-functions + +For an overview of related R-functions used by Radiant to evaluate means see _Basics > Means_. + +The key function from the `stats` package used in the `single_mean` tool is `t.test`. + +### Video Tutorials + +Copy-and-paste the full command below into the RStudio console (i.e., the bottom-left window) and press return to gain access to all materials used in the hypothesis testing module of the Radiant Tutorial Series: + +
usethis::use_course("https://www.dropbox.com/sh/0xvhyolgcvox685/AADSppNSIocrJS-BqZXhD1Kna?dl=1")
+ +Single Mean Hypothesis Test + +* This video shows how to test a hypothesis about a single sample mean versus a population mean +* Topics List: + - Calculate summary statistics for a sample + - Setup a hypothesis test for a single mean in Radiant + - Use the p.value, confidence interval, or critical value to evaluate the hypothesis test diff --git a/radiant.basics/vignettes/pkgdown/_single_prop.Rmd b/radiant.basics/vignettes/pkgdown/_single_prop.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..f113a8577dfc5aed15eb8614b87726cdc1e7e385 --- /dev/null +++ b/radiant.basics/vignettes/pkgdown/_single_prop.Rmd @@ -0,0 +1,87 @@ +> Compare a single proportion to the population proportion + +The single proportion (or one-sample) binomial test is used to compare a proportion of responses or values in a sample of data to a (hypothesized) proportion in the population from which our sample data are drawn. This is important because we seldom have access to data for an entire population. The hypothesized value in the population is specified in the `Comparison value` box. + +We can perform either a one-sided test (i.e., `less than` or `greater than`) or a two-sided test (see the `Alternative hypothesis` dropdown). We use one-sided tests to evaluate if the available data provide evidence that a sample proportion is larger (or smaller) than the comparison value (i.e., the population value in the null-hypothesis). + +## Example + +A car manufacturer conducted a study by randomly sampling and interviewing 1,000 consumers in a new target market. The goal of the study was to determine if consumers would consider purchasing this brand of car. + +Management has already determined that the company will enter this segment. However, if brand preference is lower than 10% additional resources will be committed to advertising and sponsorship in an effort to enhance brand awareness among the target consumers. In the sample, 93 consumers exhibited what the company considered strong brand liking. + +You can find information on the responses by survey participants in the **consider.rda** data set. The data set contains two variables, `id` and `consider`. + +Our null-hypothesis is that the proportion of consumers that would consider the car brand for a future purchase is equal to 10%. Select the `consider` variable from the `Variable` dropdown. To evaluate the proportion of `yes` responses in the sample select `yes` from the `Choose level` dropdown. + +Choose the `Less than` option from the `Alternative hypothesis` drop-down to determine if the available data provides sufficient evidence to reject the null-hypothesis in favor of the alternative that the proportion of consumers that will consider the brand is **less than 10%**. + +

+ +The first two blocks of output show basic information about the test (e.g.,. the null and alternative hypothesis) and summary statistics (e.g., the proportion of "yes" responses, standard error, margin or error, etc.). The final row of output shows the following: + +* `diff` is the difference between the sample proportion (0.093) and the comparison value (0.1) +* `ns` is the number of _successes_. This is the number we can compare to a binomial-distribution with parameters $n = 1000$ and $p = 0.10$. +* `p.value` is the probability of finding a value as extreme or more extreme than `diff` if the null hypothesis is true +* `0% 95%` show the 95% confidence interval around the sample proportion (0 to 0.11). These numbers provide a range within which the true population mean is likely to fall + +### Testing + +There are three approaches we can use to evaluate the null hypothesis. We will choose a significance level of 0.05.1 Of course, each approach will lead to the same conclusion. + +#### p.value + +Because the p.value is **larger** than the conventional significance level ($0.249 > 0.05$) we **cannot** reject the null hypothesis and **do not suggest** that management should commit resources to increase brand awareness. + +We can also obtain the p.value by using the probability calculator in the _Basics_ menu. Enter the number of successes in the data (93) as the lower bound (value) for a binomial-distribution with $n = 1000$ and $p = 0.1$. The p.value is the probability of observing a number of successes as or more extreme than the 93 we got in our sample. We see that $P(X <= 93) = 0.249$ which is the same value we got from _Basics > Proportions > Single proportion_. + +

+ +#### confidence interval + +Because the `comparison value` **is** contained in the confidence interval (i.e., $0 < 0.1 < 0.11$) we **cannot** reject the null hypothesis and **do not suggest** that management should commit resources to increase brand awareness. + +#### number of successes + +We can obtain the critical value by using the probability calculator in the _Basics_ menu. For a binomial-distribution with $n = 1000$ and $p = 0.1$ the critical value is 85. We have to enter 0.05 as the lower probability bound because the alternative hypothesis is `Less than`.2 + +

+ +Because the number of successes (i.e., the number of "yes" responses) **is** larger than the critical value (93 vs 85) we **cannot** reject the null hypothesis and **do not suggest** that management should commit resources to increase brand awareness. + +### _Stats speak_ + +This is a **single proportion** test of the null hypothesis that the true population **proportion** is equal to **0.1**. Using a significance level of 0.05, we **cannot** reject the null hypothesis, and **cannot** conclude that the true population **proportion** is **less** than **0.1**. + +The p.value for this test is **0.249**. This is the probability of observing a sample **proportion** (or **number of successes**) that is as or more extreme than the sample value we estimated from the data if the null hypothesis is true. In this case, it is the probability of observing a sample **proportion** (**number of successes**) that is less than (or equal to) **0.093** (**93**) if the true population **proportion** is **0.1**. + +The 95% confidence bound is **0.11**. If repeated samples were taken and the 95% confidence bound computed for each one, the true population proportion would be below that bound in 95% of the samples + +1 The **significance level**, often denoted by $\alpha$, is the highest probability you are willing to accept of rejecting the null hypothesis when it is actually true. A commonly used significance level is 0.05 (or 5%) + +2 $1 - \alpha$ is called the **confidence level**. A commonly used confidence level is 0.95 (or 95%) + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If a plot was created it can be customized using `ggplot2` commands (e.g., `plot(result, plots = "bar", custom = TRUE) + labs(y = "Percentage")`). See _Data > Visualize_ for details. + +### R-functions + +For an overview of related R-functions used by Radiant to evaluate proportions see _Basics > Proportions_. + +The key functions from the `stats` package used in the `single_prop` tool are `binom.test` and `prop.test`. + +### Video Tutorials + +Copy-and-paste the full command below into the RStudio console (i.e., the bottom-left window) and press return to gain access to all materials used in the hypothesis testing module of the Radiant Tutorial Series: + +
usethis::use_course("https://www.dropbox.com/sh/0xvhyolgcvox685/AADSppNSIocrJS-BqZXhD1Kna?dl=1")
+ +Single Proportion Hypothesis Test + +* This video shows how to test a hypothesis about a single sample proportion versus a population proportion +* Topics List: + - Setup a hypothesis test for a single proportion in Radiant + - Use the p.value, confidence interval, or critical value to evaluate the hypothesis test diff --git a/radiant.basics/vignettes/pkgdown/clt.Rmd b/radiant.basics/vignettes/pkgdown/clt.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..38408943fc720e594492528479bf9b5478bfac4b --- /dev/null +++ b/radiant.basics/vignettes/pkgdown/clt.Rmd @@ -0,0 +1,10 @@ +--- +title: "Basics > Central Limit Theorem" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_clt.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.basics/vignettes/pkgdown/compare_means.Rmd b/radiant.basics/vignettes/pkgdown/compare_means.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..04662318a4b3d8eb335cee6bd65061a2d7787342 --- /dev/null +++ b/radiant.basics/vignettes/pkgdown/compare_means.Rmd @@ -0,0 +1,11 @@ +--- +title: "Basics > Compare means" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_compare_means.Rmd"} +``` + +```{r child = "_footer.md"} +``` + diff --git a/radiant.basics/vignettes/pkgdown/compare_props.Rmd b/radiant.basics/vignettes/pkgdown/compare_props.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..6f4f74fd8ecaf6e40cc79259ac0dfdbe6340a188 --- /dev/null +++ b/radiant.basics/vignettes/pkgdown/compare_props.Rmd @@ -0,0 +1,10 @@ +--- +title: "Basics > Compare proportions" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_compare_props.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.basics/vignettes/pkgdown/correlation.Rmd b/radiant.basics/vignettes/pkgdown/correlation.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..5824c19788b0723e93e362ce4ea51790357905b6 --- /dev/null +++ b/radiant.basics/vignettes/pkgdown/correlation.Rmd @@ -0,0 +1,11 @@ +--- +title: "Basics > Correlation" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_correlation.Rmd"} +``` + +```{r child = "_footer.md"} +``` + diff --git a/radiant.basics/vignettes/pkgdown/cross_tabs.Rmd b/radiant.basics/vignettes/pkgdown/cross_tabs.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..2080fe8fdfaeb145539fb98c2489c65138ee0a45 --- /dev/null +++ b/radiant.basics/vignettes/pkgdown/cross_tabs.Rmd @@ -0,0 +1,11 @@ +--- +title: "Basics > Cross-tabs" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_cross_tabs.Rmd"} +``` + +```{r child = "_footer.md"} +``` + diff --git a/radiant.basics/vignettes/pkgdown/goodness.Rmd b/radiant.basics/vignettes/pkgdown/goodness.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..ed2c1f2465339ed4265783cf57bbe2303dc05c9c --- /dev/null +++ b/radiant.basics/vignettes/pkgdown/goodness.Rmd @@ -0,0 +1,11 @@ +--- +title: "Basics > Goodness of fit" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_goodness.Rmd"} +``` + +```{r child = "_footer.md"} +``` + diff --git a/radiant.basics/vignettes/pkgdown/images/by-nc-sa.png b/radiant.basics/vignettes/pkgdown/images/by-nc-sa.png new file mode 100644 index 0000000000000000000000000000000000000000..76eb5da461b41405c500a557253eec5f65169519 Binary files /dev/null and b/radiant.basics/vignettes/pkgdown/images/by-nc-sa.png differ diff --git a/radiant.basics/vignettes/pkgdown/prob_calc.Rmd b/radiant.basics/vignettes/pkgdown/prob_calc.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..ba1165ed7089803c29bba19a05d44b3729aaa203 --- /dev/null +++ b/radiant.basics/vignettes/pkgdown/prob_calc.Rmd @@ -0,0 +1,10 @@ +--- +title: "Basics > Probability calculator" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_prob_calc.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.basics/vignettes/pkgdown/single_mean.Rmd b/radiant.basics/vignettes/pkgdown/single_mean.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..630db385a8eeeb4d284798784ab988cc97f0e812 --- /dev/null +++ b/radiant.basics/vignettes/pkgdown/single_mean.Rmd @@ -0,0 +1,11 @@ +--- +title: "Basics > Single mean" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_single_mean.Rmd"} +``` + +```{r child = "_footer.md"} +``` + diff --git a/radiant.basics/vignettes/pkgdown/single_prop.Rmd b/radiant.basics/vignettes/pkgdown/single_prop.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..57db4a3c26fb09a312f92a5b32e9bbfc745b3af0 --- /dev/null +++ b/radiant.basics/vignettes/pkgdown/single_prop.Rmd @@ -0,0 +1,11 @@ +--- +title: "Basics > Single proportion" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_single_prop.Rmd"} +``` + +```{r child = "_footer.md"} +``` + diff --git a/radiant.data b/radiant.data deleted file mode 160000 index 8981e238837b6bcc95e2811c9509162ee54b3088..0000000000000000000000000000000000000000 --- a/radiant.data +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 8981e238837b6bcc95e2811c9509162ee54b3088 diff --git a/radiant.data/.Rbuildignore b/radiant.data/.Rbuildignore new file mode 100644 index 0000000000000000000000000000000000000000..8efef6658f700d1c7b2363b8bd8aee42146e4d29 --- /dev/null +++ b/radiant.data/.Rbuildignore @@ -0,0 +1,18 @@ +^CRAN-RELEASE$ +^.*\.Rproj$ +^\.Rproj\.user$ +^inst/rstudio$ +^build$ +^docs$ +^vignettes$ +^\.travis\.yml$ +_pkgdown.yml +cran-comments.md +coverage.R +^tests/testthat/data$ +.vscode +radiant.data.code-workspace +^CRAN-SUBMISSION$ +R/app.R +^.codespellrc$ +^.github$ diff --git a/radiant.data/.codespellrc b/radiant.data/.codespellrc new file mode 100644 index 0000000000000000000000000000000000000000..baeecfca45067c8c5bda6b3b4d832f8e5d698926 --- /dev/null +++ b/radiant.data/.codespellrc @@ -0,0 +1,5 @@ +[codespell] +skip = .git,*.pdf,*.svg,*.min.js,*.csv,*.html +# rady - server/domain name +# nd, isTs - variable names +ignore-words-list = rady,nd,ists diff --git a/radiant.data/.github/workflows/codespell.yml b/radiant.data/.github/workflows/codespell.yml new file mode 100644 index 0000000000000000000000000000000000000000..5768d7c63672e68e60791ca6828d50d76be35e61 --- /dev/null +++ b/radiant.data/.github/workflows/codespell.yml @@ -0,0 +1,19 @@ +--- +name: Codespell + +on: + push: + branches: [master] + pull_request: + branches: [master] + +jobs: + codespell: + name: Check for spelling errors + runs-on: ubuntu-latest + + steps: + - name: Checkout + uses: actions/checkout@v3 + - name: Codespell + uses: codespell-project/actions-codespell@v1 diff --git a/radiant.data/.gitignore b/radiant.data/.gitignore new file mode 100644 index 0000000000000000000000000000000000000000..20d099f783e75a214cff301b29258ae11559db30 --- /dev/null +++ b/radiant.data/.gitignore @@ -0,0 +1,12 @@ +.Rproj.user +.Rhistory +.Rapp.history +.RData +.Ruserdata +radiant.data.Rproj +.DS_Store +revdep/ +.vscode +radiant-data.dcf +radiant-data.Rproj +R/app.R diff --git a/radiant.data/.travis.yml b/radiant.data/.travis.yml new file mode 100644 index 0000000000000000000000000000000000000000..ac61638545836ea37ea3f6a16636496886cf5290 --- /dev/null +++ b/radiant.data/.travis.yml @@ -0,0 +1,25 @@ +language: r +cache: packages +r: + - oldrel + - release + - devel +warnings_are_errors: true +sudo: required +dist: bionic + +r_packages: + - devtools + +after_success: + - Rscript -e 'pkgdown::build_site()' + +## based on https://www.datacamp.com/community/tutorials/cd-package-docs-pkgdown-travis +deploy: + provider: pages + skip-cleanup: true + github-token: $GITHUB_PAT + keep-history: true + local-dir: docs + on: + branch: master diff --git a/radiant.data/COPYING b/radiant.data/COPYING new file mode 100644 index 0000000000000000000000000000000000000000..0fb9090d488e333fb8eb8461a561f215990278b3 --- /dev/null +++ b/radiant.data/COPYING @@ -0,0 +1,727 @@ +The radiant.data package is licensed to you under the AGPLv3, the terms of +which are included below. The help files for radiant.data are licensed under the creative commons attribution and share-alike license [CC-BY-SA]. + +Radiant code license +-------------------------------------------------------------------------------------------- + GNU AFFERO GENERAL PUBLIC LICENSE + Version 3, 19 November 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU Affero General Public License is a free, copyleft license for +software and other kinds of works, specifically designed to ensure +cooperation with the community in the case of network server software. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +our General Public Licenses are intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + Developers that use our General Public Licenses protect your rights +with two steps: (1) assert copyright on the software, and (2) offer +you this License which gives you legal permission to copy, distribute +and/or modify the software. + + A secondary benefit of defending all users' freedom is that +improvements made in alternate versions of the program, if they +receive widespread use, become available for other developers to +incorporate. Many developers of free software are heartened and +encouraged by the resulting cooperation. However, in the case of +software used on network servers, this result may fail to come about. +The GNU General Public License permits making a modified version and +letting the public access it on a server without ever releasing its +source code to the public. + + The GNU Affero General Public License is designed specifically to +ensure that, in such cases, the modified source code becomes available +to the community. It requires the operator of a network server to +provide the source code of the modified version running there to the +users of that server. Therefore, public use of a modified version, on +a publicly accessible server, gives the public access to the source +code of the modified version. + + An older license, called the Affero General Public License and +published by Affero, was designed to accomplish similar goals. This is +a different license, not a version of the Affero GPL, but Affero has +released a new version of the Affero GPL which permits relicensing under +this license. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU Affero General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Remote Network Interaction; Use with the GNU General Public License. + + Notwithstanding any other provision of this License, if you modify the +Program, your modified version must prominently offer all users +interacting with it remotely through a computer network (if your version +supports such interaction) an opportunity to receive the Corresponding +Source of your version by providing access to the Corresponding Source +from a network server at no charge, through some standard or customary +means of facilitating copying of software. This Corresponding Source +shall include the Corresponding Source for any work covered by version 3 +of the GNU General Public License that is incorporated pursuant to the +following paragraph. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the work with which it is combined will remain governed by version +3 of the GNU General Public License. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU Affero General Public License from time to time. Such new versions +will be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU Affero General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU Affero General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU Affero General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If your software can interact with users remotely through a computer +network, you should also make sure that it provides a way for users to +get its source. For example, if your program is a web application, its +interface could display a "Source" link that leads users to an archive +of the code. There are many ways you could offer source, and different +solutions will be better for different programs; see section 13 for the +specific requirements. + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU AGPL, see +. + + +Help file License +-------------------------------------------------------------------------------------------- + +THE WORK (AS DEFINED BELOW) IS PROVIDED UNDER THE TERMS OF THIS CREATIVE COMMONS PUBLIC LICENSE ("CCPL" OR "LICENSE"). THE WORK IS PROTECTED BY COPYRIGHT AND/OR OTHER APPLICABLE LAW. ANY USE OF THE WORK OTHER THAN AS AUTHORIZED UNDER THIS LICENSE OR COPYRIGHT LAW IS PROHIBITED. + +BY EXERCISING ANY RIGHTS TO THE WORK PROVIDED HERE, YOU ACCEPT AND AGREE TO BE BOUND BY THE TERMS OF THIS LICENSE. TO THE EXTENT THIS LICENSE MAY BE CONSIDERED TO BE A CONTRACT, THE LICENSOR GRANTS YOU THE RIGHTS CONTAINED HERE IN CONSIDERATION OF YOUR ACCEPTANCE OF SUCH TERMS AND CONDITIONS. + +1. Definitions + +"Adaptation" means a work based upon the Work, or upon the Work and other pre-existing works, such as a translation, adaptation, derivative work, arrangement of music or other alterations of a literary or artistic work, or phonogram or performance and includes cinematographic adaptations or any other form in which the Work may be recast, transformed, or adapted including in any form recognizably derived from the original, except that a work that constitutes a Collection will not be considered an Adaptation for the purpose of this License. For the avoidance of doubt, where the Work is a musical work, performance or phonogram, the synchronization of the Work in timed-relation with a moving image ("syncing") will be considered an Adaptation for the purpose of this License. +"Collection" means a collection of literary or artistic works, such as encyclopedias and anthologies, or performances, phonograms or broadcasts, or other works or subject matter other than works listed in Section 1(g) below, which, by reason of the selection and arrangement of their contents, constitute intellectual creations, in which the Work is included in its entirety in unmodified form along with one or more other contributions, each constituting separate and independent works in themselves, which together are assembled into a collective whole. A work that constitutes a Collection will not be considered an Adaptation (as defined above) for the purposes of this License. +"Distribute" means to make available to the public the original and copies of the Work or Adaptation, as appropriate, through sale or other transfer of ownership. +"License Elements" means the following high-level license attributes as selected by Licensor and indicated in the title of this License: Attribution, Noncommercial, ShareAlike. +"Licensor" means the individual, individuals, entity or entities that offer(s) the Work under the terms of this License. +"Original Author" means, in the case of a literary or artistic work, the individual, individuals, entity or entities who created the Work or if no individual or entity can be identified, the publisher; and in addition (i) in the case of a performance the actors, singers, musicians, dancers, and other persons who act, sing, deliver, declaim, play in, interpret or otherwise perform literary or artistic works or expressions of folklore; (ii) in the case of a phonogram the producer being the person or legal entity who first fixes the sounds of a performance or other sounds; and, (iii) in the case of broadcasts, the organization that transmits the broadcast. +"Work" means the literary and/or artistic work offered under the terms of this License including without limitation any production in the literary, scientific and artistic domain, whatever may be the mode or form of its expression including digital form, such as a book, pamphlet and other writing; a lecture, address, sermon or other work of the same nature; a dramatic or dramatico-musical work; a choreographic work or entertainment in dumb show; a musical composition with or without words; a cinematographic work to which are assimilated works expressed by a process analogous to cinematography; a work of drawing, painting, architecture, sculpture, engraving or lithography; a photographic work to which are assimilated works expressed by a process analogous to photography; a work of applied art; an illustration, map, plan, sketch or three-dimensional work relative to geography, topography, architecture or science; a performance; a broadcast; a phonogram; a compilation of data to the extent it is protected as a copyrightable work; or a work performed by a variety or circus performer to the extent it is not otherwise considered a literary or artistic work. +"You" means an individual or entity exercising rights under this License who has not previously violated the terms of this License with respect to the Work, or who has received express permission from the Licensor to exercise rights under this License despite a previous violation. +"Publicly Perform" means to perform public recitations of the Work and to communicate to the public those public recitations, by any means or process, including by wire or wireless means or public digital performances; to make available to the public Works in such a way that members of the public may access these Works from a place and at a place individually chosen by them; to perform the Work to the public by any means or process and the communication to the public of the performances of the Work, including by public digital performance; to broadcast and rebroadcast the Work by any means including signs, sounds or images. +"Reproduce" means to make copies of the Work by any means including without limitation by sound or visual recordings and the right of fixation and reproducing fixations of the Work, including storage of a protected performance or phonogram in digital form or other electronic medium. +2. Fair Dealing Rights. Nothing in this License is intended to reduce, limit, or restrict any uses free from copyright or rights arising from limitations or exceptions that are provided for in connection with the copyright protection under copyright law or other applicable laws. + +3. License Grant. Subject to the terms and conditions of this License, Licensor hereby grants You a worldwide, royalty-free, non-exclusive, perpetual (for the duration of the applicable copyright) license to exercise the rights in the Work as stated below: + +to Reproduce the Work, to incorporate the Work into one or more Collections, and to Reproduce the Work as incorporated in the Collections; +to create and Reproduce Adaptations provided that any such Adaptation, including any translation in any medium, takes reasonable steps to clearly label, demarcate or otherwise identify that changes were made to the original Work. For example, a translation could be marked "The original work was translated from English to Spanish," or a modification could indicate "The original work has been modified."; +to Distribute and Publicly Perform the Work including as incorporated in Collections; and, +to Distribute and Publicly Perform Adaptations. +The above rights may be exercised in all media and formats whether now known or hereafter devised. The above rights include the right to make such modifications as are technically necessary to exercise the rights in other media and formats. Subject to Section 8(f), all rights not expressly granted by Licensor are hereby reserved, including but not limited to the rights described in Section 4(e). + +4. Restrictions. The license granted in Section 3 above is expressly made subject to and limited by the following restrictions: + +You may Distribute or Publicly Perform the Work only under the terms of this License. You must include a copy of, or the Uniform Resource Identifier (URI) for, this License with every copy of the Work You Distribute or Publicly Perform. You may not offer or impose any terms on the Work that restrict the terms of this License or the ability of the recipient of the Work to exercise the rights granted to that recipient under the terms of the License. You may not sublicense the Work. You must keep intact all notices that refer to this License and to the disclaimer of warranties with every copy of the Work You Distribute or Publicly Perform. When You Distribute or Publicly Perform the Work, You may not impose any effective technological measures on the Work that restrict the ability of a recipient of the Work from You to exercise the rights granted to that recipient under the terms of the License. This Section 4(a) applies to the Work as incorporated in a Collection, but this does not require the Collection apart from the Work itself to be made subject to the terms of this License. If You create a Collection, upon notice from any Licensor You must, to the extent practicable, remove from the Collection any credit as required by Section 4(d), as requested. If You create an Adaptation, upon notice from any Licensor You must, to the extent practicable, remove from the Adaptation any credit as required by Section 4(d), as requested. +You may Distribute or Publicly Perform an Adaptation only under: (i) the terms of this License; (ii) a later version of this License with the same License Elements as this License; (iii) a Creative Commons jurisdiction license (either this or a later license version) that contains the same License Elements as this License (e.g., Attribution-NonCommercial-ShareAlike 3.0 US) ("Applicable License"). You must include a copy of, or the URI, for Applicable License with every copy of each Adaptation You Distribute or Publicly Perform. You may not offer or impose any terms on the Adaptation that restrict the terms of the Applicable License or the ability of the recipient of the Adaptation to exercise the rights granted to that recipient under the terms of the Applicable License. You must keep intact all notices that refer to the Applicable License and to the disclaimer of warranties with every copy of the Work as included in the Adaptation You Distribute or Publicly Perform. When You Distribute or Publicly Perform the Adaptation, You may not impose any effective technological measures on the Adaptation that restrict the ability of a recipient of the Adaptation from You to exercise the rights granted to that recipient under the terms of the Applicable License. This Section 4(b) applies to the Adaptation as incorporated in a Collection, but this does not require the Collection apart from the Adaptation itself to be made subject to the terms of the Applicable License. +You may not exercise any of the rights granted to You in Section 3 above in any manner that is primarily intended for or directed toward commercial advantage or private monetary compensation. The exchange of the Work for other copyrighted works by means of digital file-sharing or otherwise shall not be considered to be intended for or directed toward commercial advantage or private monetary compensation, provided there is no payment of any monetary compensation in con-nection with the exchange of copyrighted works. +If You Distribute, or Publicly Perform the Work or any Adaptations or Collections, You must, unless a request has been made pursuant to Section 4(a), keep intact all copyright notices for the Work and provide, reasonable to the medium or means You are utilizing: (i) the name of the Original Author (or pseudonym, if applicable) if supplied, and/or if the Original Author and/or Licensor designate another party or parties (e.g., a sponsor institute, publishing entity, journal) for attribution ("Attribution Parties") in Licensor's copyright notice, terms of service or by other reasonable means, the name of such party or parties; (ii) the title of the Work if supplied; (iii) to the extent reasonably practicable, the URI, if any, that Licensor specifies to be associated with the Work, unless such URI does not refer to the copyright notice or licensing information for the Work; and, (iv) consistent with Section 3(b), in the case of an Adaptation, a credit identifying the use of the Work in the Adaptation (e.g., "French translation of the Work by Original Author," or "Screenplay based on original Work by Original Author"). The credit required by this Section 4(d) may be implemented in any reasonable manner; provided, however, that in the case of a Adaptation or Collection, at a minimum such credit will appear, if a credit for all contributing authors of the Adaptation or Collection appears, then as part of these credits and in a manner at least as prominent as the credits for the other contributing authors. For the avoidance of doubt, You may only use the credit required by this Section for the purpose of attribution in the manner set out above and, by exercising Your rights under this License, You may not implicitly or explicitly assert or imply any connection with, sponsorship or endorsement by the Original Author, Licensor and/or Attribution Parties, as appropriate, of You or Your use of the Work, without the separate, express prior written permission of the Original Author, Licensor and/or Attribution Parties. +For the avoidance of doubt: + +Non-waivable Compulsory License Schemes. In those jurisdictions in which the right to collect royalties through any statutory or compulsory licensing scheme cannot be waived, the Licensor reserves the exclusive right to collect such royalties for any exercise by You of the rights granted under this License; +Waivable Compulsory License Schemes. In those jurisdictions in which the right to collect royalties through any statutory or compulsory licensing scheme can be waived, the Licensor reserves the exclusive right to collect such royalties for any exercise by You of the rights granted under this License if Your exercise of such rights is for a purpose or use which is otherwise than noncommercial as permitted under Section 4(c) and otherwise waives the right to collect royalties through any statutory or compulsory licensing scheme; and, +Voluntary License Schemes. The Licensor reserves the right to collect royalties, whether individually or, in the event that the Licensor is a member of a collecting society that administers voluntary licensing schemes, via that society, from any exercise by You of the rights granted under this License that is for a purpose or use which is otherwise than noncommercial as permitted under Section 4(c). +Except as otherwise agreed in writing by the Licensor or as may be otherwise permitted by applicable law, if You Reproduce, Distribute or Publicly Perform the Work either by itself or as part of any Adaptations or Collections, You must not distort, mutilate, modify or take other derogatory action in relation to the Work which would be prejudicial to the Original Author's honor or reputation. Licensor agrees that in those jurisdictions (e.g. Japan), in which any exercise of the right granted in Section 3(b) of this License (the right to make Adaptations) would be deemed to be a distortion, mutilation, modification or other derogatory action prejudicial to the Original Author's honor and reputation, the Licensor will waive or not assert, as appropriate, this Section, to the fullest extent permitted by the applicable national law, to enable You to reasonably exercise Your right under Section 3(b) of this License (right to make Adaptations) but not otherwise. +5. Representations, Warranties and Disclaimer + +UNLESS OTHERWISE MUTUALLY AGREED TO BY THE PARTIES IN WRITING AND TO THE FULLEST EXTENT PERMITTED BY APPLICABLE LAW, LICENSOR 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, NONINFRINGEMENT, OR THE ABSENCE OF LATENT OR OTHER DEFECTS, ACCURACY, OR THE PRESENCE OF ABSENCE OF ERRORS, WHETHER OR NOT DISCOVERABLE. SOME JURISDICTIONS DO NOT ALLOW THE EXCLUSION OF IMPLIED WARRANTIES, SO THIS EXCLUSION MAY NOT APPLY TO YOU. + +6. Limitation on Liability. EXCEPT TO THE EXTENT REQUIRED BY APPLICABLE LAW, IN NO EVENT WILL LICENSOR BE LIABLE TO YOU ON ANY LEGAL THEORY FOR ANY SPECIAL, INCIDENTAL, CONSEQUENTIAL, PUNITIVE OR EXEMPLARY DAMAGES ARISING OUT OF THIS LICENSE OR THE USE OF THE WORK, EVEN IF LICENSOR HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. + +7. Termination + +This License and the rights granted hereunder will terminate automatically upon any breach by You of the terms of this License. Individuals or entities who have received Adaptations or Collections from You under this License, however, will not have their licenses terminated provided such individuals or entities remain in full compliance with those licenses. Sections 1, 2, 5, 6, 7, and 8 will survive any termination of this License. +Subject to the above terms and conditions, the license granted here is perpetual (for the duration of the applicable copyright in the Work). Notwithstanding the above, Licensor reserves the right to release the Work under different license terms or to stop distributing the Work at any time; provided, however that any such election will not serve to withdraw this License (or any other license that has been, or is required to be, granted under the terms of this License), and this License will continue in full force and effect unless terminated as stated above. +8. Miscellaneous + +Each time You Distribute or Publicly Perform the Work or a Collection, the Licensor offers to the recipient a license to the Work on the same terms and conditions as the license granted to You under this License. +Each time You Distribute or Publicly Perform an Adaptation, Licensor offers to the recipient a license to the original Work on the same terms and conditions as the license granted to You under this License. +If any provision of this License is invalid or unenforceable under applicable law, it shall not affect the validity or enforceability of the remainder of the terms of this License, and without further action by the parties to this agreement, such provision shall be reformed to the minimum extent necessary to make such provision valid and enforceable. +No term or provision of this License shall be deemed waived and no breach consented to unless such waiver or consent shall be in writing and signed by the party to be charged with such waiver or consent. +This License constitutes the entire agreement between the parties with respect to the Work licensed here. There are no understandings, agreements or representations with respect to the Work not specified here. Licensor shall not be bound by any additional provisions that may appear in any communication from You. This License may not be modified without the mutual written agreement of the Licensor and You. +The rights granted under, and the subject matter referenced, in this License were drafted utilizing the terminology of the Berne Convention for the Protection of Literary and Artistic Works (as amended on September 28, 1979), the Rome Convention of 1961, the WIPO Copyright Treaty of 1996, the WIPO Performances and Phonograms Treaty of 1996 and the Universal Copyright Convention (as revised on July 24, 1971). These rights and subject matter take effect in the relevant jurisdiction in which the License terms are sought to be enforced according to the corresponding provisions of the implementation of those treaty provisions in the applicable national law. If the standard suite of rights granted under applicable copyright law includes additional rights not granted under this License, such additional rights are deemed to be included in the License; this License is not intended to restrict the license of any rights under applicable law. diff --git a/radiant.data/CRAN-RELEASE b/radiant.data/CRAN-RELEASE new file mode 100644 index 0000000000000000000000000000000000000000..38e54a88180f076d210fd53132e613d9317747e6 --- /dev/null +++ b/radiant.data/CRAN-RELEASE @@ -0,0 +1,2 @@ +This package was submitted to CRAN on 2020-08-06. +Once it is accepted, delete this file and tag the release (commit b81ae0e31c). diff --git a/radiant.data/CRAN-SUBMISSION b/radiant.data/CRAN-SUBMISSION new file mode 100644 index 0000000000000000000000000000000000000000..08250fff1f8a669cc89e180b81457c301f4a1342 --- /dev/null +++ b/radiant.data/CRAN-SUBMISSION @@ -0,0 +1,3 @@ +Version: 1.6.6 +Date: 2024-05-14 23:05:49 UTC +SHA: 0c84c6defccc2050cfe133e40538b6b8cc1d2520 diff --git a/radiant.data/DESCRIPTION b/radiant.data/DESCRIPTION new file mode 100644 index 0000000000000000000000000000000000000000..8bd5df2452cfbafa4aa383e84c78c84f3eea284e --- /dev/null +++ b/radiant.data/DESCRIPTION @@ -0,0 +1,69 @@ +Package: radiant.data +Title: Data Menu for Radiant: Business Analytics using R and Shiny +Version: 1.6.7 +Date: 2024-10-22 +Authors@R: c( + person("Vincent", "Nijs", email = "radiant@rady.ucsd.edu", role = c("aut", "cre")), + person("Niklas", "von Hertzen", email = "niklasvh@gmail.com", role = c("aut"), comment = "html2canvas library") + ) +Description: The Radiant Data menu includes interfaces for loading, saving, + viewing, visualizing, summarizing, transforming, and combining data. It also + contains functionality to generate reproducible reports of the analyses + conducted in the application. +Depends: + R (>= 4.3.0), + magrittr (>= 1.5), + ggplot2 (>= 3.4.2), + lubridate (>= 1.7.4), + tidyr (>= 0.8.2), + dplyr (>= 1.1.2) +Imports: + tibble (>= 1.4.2), + rlang (>= 0.4.10), + broom (>= 0.5.2), + car (>= 3.0-0), + knitr (>= 1.20), + markdown (>= 1.7), + rmarkdown(>= 2.22), + shiny (>= 1.8.1), + jsonlite (>= 1.0), + shinyAce (>= 0.4.1), + psych (>= 1.8.4), + DT (>= 0.28), + readr (>= 1.1.1), + readxl (>= 1.0.0), + writexl (>= 0.2), + scales (>= 0.4.0), + curl (>= 2.5), + rstudioapi (>= 0.7), + import (>= 1.1.0), + plotly (>= 4.7.1), + glue (>= 1.3.0), + shinyFiles (>= 0.9.1), + stringi (>= 1.2.4), + randomizr (>= 0.20.0), + patchwork (>= 1.0.0), + bslib (>= 0.5.0), + png, + MASS, + base64enc, + shiny.i18n +Suggests: + arrow (>= 12.0.1), + dbplyr (>= 2.1.1), + DBI (>= 0.7), + RSQLite (>= 2.0), + RPostgres (>= 1.4.4), + webshot (>= 0.5.0), + testthat (>= 2.0.0), + pkgdown (>= 1.1.0) +URL: + https://github.com/radiant-rstats/radiant.data/, + https://radiant-rstats.github.io/radiant.data/, + https://radiant-rstats.github.io/docs/ +BugReports: https://github.com/radiant-rstats/radiant.data/issues/ +License: AGPL-3 | file LICENSE +LazyData: true +Encoding: UTF-8 +Language: en-US +RoxygenNote: 7.3.2 diff --git a/radiant.data/LICENSE b/radiant.data/LICENSE new file mode 100644 index 0000000000000000000000000000000000000000..2f3785fcdb3e096c36da554c93779029c27c942d --- /dev/null +++ b/radiant.data/LICENSE @@ -0,0 +1,102 @@ +radiant.data is licensed under AGPL3 (see https://tldrlegal.com/license/gnu-affero-general-public-license-v3-(agpl-3.0) and https://www.r-project.org/Licenses/AGPL-3). The radiant.data help files and images are licensed under the creative commons attribution and share-alike license CC-BY-SA (https://creativecommons.org/licenses/by-sa/4.0/legalcode). + +As a summary, the AGPLv3 license requires, attribution, including copyright and license information in copies of the software, stating changes if the code is modified, and disclosure of all source code. Details are in the COPYING file. + +If you are interested in using radiant.data or other radiant packages please email me at radiant@rady.ucsd.edu + +==================================================================== + +Creative Commons Attribution-ShareAlike 4.0 International Public License +By exercising the Licensed Rights (defined below), You accept and agree to be bound by the terms and conditions of this Creative Commons Attribution-ShareAlike 4.0 International Public License ("Public License"). To the extent this Public License may be interpreted as a contract, You are granted the Licensed Rights in consideration of Your acceptance of these terms and conditions, and the Licensor grants You such rights in consideration of benefits the Licensor receives from making the Licensed Material available under these terms and conditions. + +Section 1 – Definitions. + +Adapted Material means material subject to Copyright and Similar Rights that is derived from or based upon the Licensed Material and in which the Licensed Material is translated, altered, arranged, transformed, or otherwise modified in a manner requiring permission under the Copyright and Similar Rights held by the Licensor. For purposes of this Public License, where the Licensed Material is a musical work, performance, or sound recording, Adapted Material is always produced where the Licensed Material is synched in timed relation with a moving image. +Adapter's License means the license You apply to Your Copyright and Similar Rights in Your contributions to Adapted Material in accordance with the terms and conditions of this Public License. +BY-SA Compatible License means a license listed at creativecommons.org/compatiblelicenses, approved by Creative Commons as essentially the equivalent of this Public License. +Copyright and Similar Rights means copyright and/or similar rights closely related to copyright including, without limitation, performance, broadcast, sound recording, and Sui Generis Database Rights, without regard to how the rights are labeled or categorized. For purposes of this Public License, the rights specified in Section 2(b)(1)-(2) are not Copyright and Similar Rights. +Effective Technological Measures means those measures that, in the absence of proper authority, may not be circumvented under laws fulfilling obligations under Article 11 of the WIPO Copyright Treaty adopted on December 20, 1996, and/or similar international agreements. +Exceptions and Limitations means fair use, fair dealing, and/or any other exception or limitation to Copyright and Similar Rights that applies to Your use of the Licensed Material. +License Elements means the license attributes listed in the name of a Creative Commons Public License. The License Elements of this Public License are Attribution and ShareAlike. +Licensed Material means the artistic or literary work, database, or other material to which the Licensor applied this Public License. +Licensed Rights means the rights granted to You subject to the terms and conditions of this Public License, which are limited to all Copyright and Similar Rights that apply to Your use of the Licensed Material and that the Licensor has authority to license. +Licensor means the individual(s) or entity(ies) granting rights under this Public License. +Share means to provide material to the public by any means or process that requires permission under the Licensed Rights, such as reproduction, public display, public performance, distribution, dissemination, communication, or importation, and to make material available to the public including in ways that members of the public may access the material from a place and at a time individually chosen by them. +Sui Generis Database Rights means rights other than copyright resulting from Directive 96/9/EC of the European Parliament and of the Council of 11 March 1996 on the legal protection of databases, as amended and/or succeeded, as well as other essentially equivalent rights anywhere in the world. +You means the individual or entity exercising the Licensed Rights under this Public License. Your has a corresponding meaning. +Section 2 – Scope. + +License grant. +Subject to the terms and conditions of this Public License, the Licensor hereby grants You a worldwide, royalty-free, non-sublicensable, non-exclusive, irrevocable license to exercise the Licensed Rights in the Licensed Material to: +reproduce and Share the Licensed Material, in whole or in part; and +produce, reproduce, and Share Adapted Material. +Exceptions and Limitations. For the avoidance of doubt, where Exceptions and Limitations apply to Your use, this Public License does not apply, and You do not need to comply with its terms and conditions. +Term. The term of this Public License is specified in Section 6(a). +Media and formats; technical modifications allowed. The Licensor authorizes You to exercise the Licensed Rights in all media and formats whether now known or hereafter created, and to make technical modifications necessary to do so. The Licensor waives and/or agrees not to assert any right or authority to forbid You from making technical modifications necessary to exercise the Licensed Rights, including technical modifications necessary to circumvent Effective Technological Measures. For purposes of this Public License, simply making modifications authorized by this Section 2(a)(4) never produces Adapted Material. +Downstream recipients. +Offer from the Licensor – Licensed Material. Every recipient of the Licensed Material automatically receives an offer from the Licensor to exercise the Licensed Rights under the terms and conditions of this Public License. +Additional offer from the Licensor – Adapted Material. Every recipient of Adapted Material from You automatically receives an offer from the Licensor to exercise the Licensed Rights in the Adapted Material under the conditions of the Adapter’s License You apply. +No downstream restrictions. You may not offer or impose any additional or different terms or conditions on, or apply any Effective Technological Measures to, the Licensed Material if doing so restricts exercise of the Licensed Rights by any recipient of the Licensed Material. +No endorsement. Nothing in this Public License constitutes or may be construed as permission to assert or imply that You are, or that Your use of the Licensed Material is, connected with, or sponsored, endorsed, or granted official status by, the Licensor or others designated to receive attribution as provided in Section 3(a)(1)(A)(i). +Other rights. + +Moral rights, such as the right of integrity, are not licensed under this Public License, nor are publicity, privacy, and/or other similar personality rights; however, to the extent possible, the Licensor waives and/or agrees not to assert any such rights held by the Licensor to the limited extent necessary to allow You to exercise the Licensed Rights, but not otherwise. +Patent and trademark rights are not licensed under this Public License. +To the extent possible, the Licensor waives any right to collect royalties from You for the exercise of the Licensed Rights, whether directly or through a collecting society under any voluntary or waivable statutory or compulsory licensing scheme. In all other cases the Licensor expressly reserves any right to collect such royalties. +Section 3 – License Conditions. + +Your exercise of the Licensed Rights is expressly made subject to the following conditions. + +Attribution. + +If You Share the Licensed Material (including in modified form), You must: + +retain the following if it is supplied by the Licensor with the Licensed Material: +identification of the creator(s) of the Licensed Material and any others designated to receive attribution, in any reasonable manner requested by the Licensor (including by pseudonym if designated); +a copyright notice; +a notice that refers to this Public License; +a notice that refers to the disclaimer of warranties; +a URI or hyperlink to the Licensed Material to the extent reasonably practicable; +indicate if You modified the Licensed Material and retain an indication of any previous modifications; and +indicate the Licensed Material is licensed under this Public License, and include the text of, or the URI or hyperlink to, this Public License. +You may satisfy the conditions in Section 3(a)(1) in any reasonable manner based on the medium, means, and context in which You Share the Licensed Material. For example, it may be reasonable to satisfy the conditions by providing a URI or hyperlink to a resource that includes the required information. +If requested by the Licensor, You must remove any of the information required by Section 3(a)(1)(A) to the extent reasonably practicable. +ShareAlike. +In addition to the conditions in Section 3(a), if You Share Adapted Material You produce, the following conditions also apply. + +The Adapter’s License You apply must be a Creative Commons license with the same License Elements, this version or later, or a BY-SA Compatible License. +You must include the text of, or the URI or hyperlink to, the Adapter's License You apply. You may satisfy this condition in any reasonable manner based on the medium, means, and context in which You Share Adapted Material. +You may not offer or impose any additional or different terms or conditions on, or apply any Effective Technological Measures to, Adapted Material that restrict exercise of the rights granted under the Adapter's License You apply. +Section 4 – Sui Generis Database Rights. + +Where the Licensed Rights include Sui Generis Database Rights that apply to Your use of the Licensed Material: + +for the avoidance of doubt, Section 2(a)(1) grants You the right to extract, reuse, reproduce, and Share all or a substantial portion of the contents of the database; +if You include all or a substantial portion of the database contents in a database in which You have Sui Generis Database Rights, then the database in which You have Sui Generis Database Rights (but not its individual contents) is Adapted Material, including for purposes of Section 3(b); and +You must comply with the conditions in Section 3(a) if You Share all or a substantial portion of the contents of the database. +For the avoidance of doubt, this Section 4 supplements and does not replace Your obligations under this Public License where the Licensed Rights include other Copyright and Similar Rights. +Section 5 – Disclaimer of Warranties and Limitation of Liability. + +Unless otherwise separately undertaken by the Licensor, to the extent possible, the Licensor offers the Licensed Material as-is and as-available, and makes no representations or warranties of any kind concerning the Licensed Material, whether express, implied, statutory, or other. This includes, without limitation, warranties of title, merchantability, fitness for a particular purpose, non-infringement, absence of latent or other defects, accuracy, or the presence or absence of errors, whether or not known or discoverable. Where disclaimers of warranties are not allowed in full or in part, this disclaimer may not apply to You. +To the extent possible, in no event will the Licensor be liable to You on any legal theory (including, without limitation, negligence) or otherwise for any direct, special, indirect, incidental, consequential, punitive, exemplary, or other losses, costs, expenses, or damages arising out of this Public License or use of the Licensed Material, even if the Licensor has been advised of the possibility of such losses, costs, expenses, or damages. Where a limitation of liability is not allowed in full or in part, this limitation may not apply to You. +The disclaimer of warranties and limitation of liability provided above shall be interpreted in a manner that, to the extent possible, most closely approximates an absolute disclaimer and waiver of all liability. +Section 6 – Term and Termination. + +This Public License applies for the term of the Copyright and Similar Rights licensed here. However, if You fail to comply with this Public License, then Your rights under this Public License terminate automatically. +Where Your right to use the Licensed Material has terminated under Section 6(a), it reinstates: + +automatically as of the date the violation is cured, provided it is cured within 30 days of Your discovery of the violation; or +upon express reinstatement by the Licensor. +For the avoidance of doubt, this Section 6(b) does not affect any right the Licensor may have to seek remedies for Your violations of this Public License. +For the avoidance of doubt, the Licensor may also offer the Licensed Material under separate terms or conditions or stop distributing the Licensed Material at any time; however, doing so will not terminate this Public License. +Sections 1, 5, 6, 7, and 8 survive termination of this Public License. +Section 7 – Other Terms and Conditions. + +The Licensor shall not be bound by any additional or different terms or conditions communicated by You unless expressly agreed. +Any arrangements, understandings, or agreements regarding the Licensed Material not stated herein are separate from and independent of the terms and conditions of this Public License. +Section 8 – Interpretation. + +For the avoidance of doubt, this Public License does not, and shall not be interpreted to, reduce, limit, restrict, or impose conditions on any use of the Licensed Material that could lawfully be made without permission under this Public License. +To the extent possible, if any provision of this Public License is deemed unenforceable, it shall be automatically reformed to the minimum extent necessary to make it enforceable. If the provision cannot be reformed, it shall be severed from this Public License without affecting the enforceability of the remaining terms and conditions. +No term or condition of this Public License will be waived and no failure to comply consented to unless expressly agreed to by the Licensor. +Nothing in this Public License constitutes or may be interpreted as a limitation upon, or waiver of, any privileges and immunities that apply to the Licensor or You, including from the legal processes of any jurisdiction or authority. diff --git a/radiant.data/NAMESPACE b/radiant.data/NAMESPACE new file mode 100644 index 0000000000000000000000000000000000000000..aa1b27829c9df45e4085d70d3ad043aebcad3384 --- /dev/null +++ b/radiant.data/NAMESPACE @@ -0,0 +1,319 @@ +# Generated by roxygen2: do not edit by hand + +S3method(dtab,data.frame) +S3method(dtab,explore) +S3method(dtab,pivotr) +S3method(plot,character) +S3method(plot,pivotr) +S3method(render,character) +S3method(render,datatables) +S3method(render,plotly) +S3method(render,shiny.render.function) +S3method(store,character) +S3method(store,explore) +S3method(store,pivotr) +S3method(summary,explore) +S3method(summary,pivotr) +export(Search) +export(add_class) +export(add_description) +export(arrange_data) +export(as_character) +export(as_distance) +export(as_dmy) +export(as_dmy_hm) +export(as_dmy_hms) +export(as_duration) +export(as_factor) +export(as_hm) +export(as_hms) +export(as_integer) +export(as_mdy) +export(as_mdy_hm) +export(as_mdy_hms) +export(as_numeric) +export(as_tibble) +export(as_ymd) +export(as_ymd_hm) +export(as_ymd_hms) +export(bs_theme) +export(center) +export(choose_dir) +export(choose_files) +export(ci_label) +export(ci_perc) +export(combine_data) +export(combinedata) +export(copy_all) +export(copy_attr) +export(copy_from) +export(cv) +export(date) +export(deregister) +export(describe) +export(does_vary) +export(dtab) +export(empty_level) +export(explore) +export(filter_data) +export(filterdata) +export(find_dropbox) +export(find_gdrive) +export(find_home) +export(find_project) +export(fixMS) +export(fix_names) +export(fix_smart) +export(flip) +export(format_df) +export(format_nr) +export(formatdf) +export(formatnr) +export(get_class) +export(get_data) +export(get_summary) +export(getclass) +export(getdata) +export(getsummary) +export(ggplotly) +export(glance) +export(glue) +export(glue_collapse) +export(glue_data) +export(indexr) +export(install_webshot) +export(inverse) +export(is.empty) +export(is_double) +export(is_not) +export(is_numeric) +export(is_string) +export(iterms) +export(knit_print) +export(kurtosi) +export(launch) +export(level_list) +export(ln) +export(load_clip) +export(make_arrange_cmd) +export(make_train) +export(make_vec) +export(max_rm) +export(me) +export(mean_rm) +export(median_rm) +export(meprop) +export(min_rm) +export(modal) +export(month) +export(mutate_ext) +export(n_missing) +export(n_obs) +export(normalize) +export(p01) +export(p025) +export(p05) +export(p10) +export(p25) +export(p75) +export(p90) +export(p95) +export(p975) +export(p99) +export(parse_path) +export(pcv) +export(pfun) +export(pivotr) +export(plot_annotation) +export(pmean) +export(pmedian) +export(pp01) +export(pp025) +export(pp05) +export(pp10) +export(pp25) +export(pp75) +export(pp95) +export(pp975) +export(pp99) +export(prop) +export(psd) +export(psum) +export(pvar) +export(qscatter) +export(qterms) +export(radiant.data) +export(radiant.data_url) +export(radiant.data_viewer) +export(radiant.data_window) +export(read_files) +export(refactor) +export(register) +export(render) +export(round_df) +export(rounddf) +export(rownames_to_column) +export(save_clip) +export(sd_rm) +export(sdpop) +export(sdprop) +export(se) +export(search_data) +export(seprop) +export(set_attr) +export(show_duplicated) +export(sig_stars) +export(skew) +export(slice_data) +export(square) +export(sshh) +export(sshhr) +export(standardize) +export(store) +export(subplot) +export(sum_rm) +export(table2data) +export(theme_version) +export(tibble) +export(tidy) +export(toFct) +export(to_fct) +export(var_rm) +export(varpop) +export(varprop) +export(view_data) +export(viewdata) +export(visualize) +export(wday) +export(weighted.sd) +export(which.pmax) +export(which.pmin) +export(wrap_plots) +export(writePNG) +export(write_parquet) +export(xtile) +import(dplyr) +import(ggplot2) +import(shiny) +importFrom(MASS,fractions) +importFrom(base64enc,dataURI) +importFrom(broom,glance) +importFrom(broom,tidy) +importFrom(bslib,bs_theme) +importFrom(bslib,theme_version) +importFrom(car,Recode) +importFrom(curl,curl_download) +importFrom(glue,glue) +importFrom(glue,glue_collapse) +importFrom(glue,glue_data) +importFrom(import,from) +importFrom(jsonlite,fromJSON) +importFrom(knitr,knit) +importFrom(knitr,knit2html) +importFrom(knitr,knit_print) +importFrom(lubridate,as.duration) +importFrom(lubridate,date) +importFrom(lubridate,dmy) +importFrom(lubridate,hm) +importFrom(lubridate,hms) +importFrom(lubridate,hour) +importFrom(lubridate,is.Date) +importFrom(lubridate,is.POSIXt) +importFrom(lubridate,mdy) +importFrom(lubridate,minute) +importFrom(lubridate,month) +importFrom(lubridate,now) +importFrom(lubridate,parse_date_time) +importFrom(lubridate,second) +importFrom(lubridate,wday) +importFrom(lubridate,week) +importFrom(lubridate,year) +importFrom(lubridate,ymd) +importFrom(lubridate,ymd_hms) +importFrom(magrittr,"%$%") +importFrom(magrittr,"%<>%") +importFrom(magrittr,"%T>%") +importFrom(magrittr,add) +importFrom(magrittr,divide_by) +importFrom(magrittr,extract2) +importFrom(magrittr,set_colnames) +importFrom(magrittr,set_names) +importFrom(magrittr,set_rownames) +importFrom(markdown,mark_html) +importFrom(patchwork,plot_annotation) +importFrom(patchwork,wrap_plots) +importFrom(plotly,ggplotly) +importFrom(plotly,renderPlotly) +importFrom(plotly,subplot) +importFrom(png,writePNG) +importFrom(psych,kurtosi) +importFrom(psych,skew) +importFrom(randomizr,block_ra) +importFrom(randomizr,complete_ra) +importFrom(readr,locale) +importFrom(readr,problems) +importFrom(readr,read_csv) +importFrom(readr,read_delim) +importFrom(readr,read_rds) +importFrom(readr,write_csv) +importFrom(readr,write_rds) +importFrom(readxl,read_excel) +importFrom(rlang,.data) +importFrom(rlang,parse_exprs) +importFrom(rmarkdown,html_dependency_bootstrap) +importFrom(rmarkdown,html_document) +importFrom(rmarkdown,pdf_document) +importFrom(rmarkdown,render) +importFrom(rmarkdown,word_document) +importFrom(rstudioapi,getActiveProject) +importFrom(rstudioapi,insertText) +importFrom(rstudioapi,isAvailable) +importFrom(rstudioapi,selectFile) +importFrom(shiny,getDefaultReactiveDomain) +importFrom(shiny,makeReactiveBinding) +importFrom(shiny,paneViewer) +importFrom(shiny,tags) +importFrom(shinyAce,aceEditor) +importFrom(shinyAce,updateAceEditor) +importFrom(shinyFiles,getVolumes) +importFrom(shinyFiles,parseDirPath) +importFrom(shinyFiles,parseFilePaths) +importFrom(shinyFiles,parseSavePath) +importFrom(shinyFiles,shinyFileChoose) +importFrom(shinyFiles,shinyFileSave) +importFrom(shinyFiles,shinyFilesButton) +importFrom(shinyFiles,shinyFilesLink) +importFrom(shinyFiles,shinySaveButton) +importFrom(shinyFiles,shinySaveLink) +importFrom(stats,IQR) +importFrom(stats,as.formula) +importFrom(stats,chisq.test) +importFrom(stats,dbinom) +importFrom(stats,density) +importFrom(stats,median) +importFrom(stats,na.omit) +importFrom(stats,qnorm) +importFrom(stats,qt) +importFrom(stats,quantile) +importFrom(stats,sd) +importFrom(stats,setNames) +importFrom(stats,var) +importFrom(stats,weighted.mean) +importFrom(stringi,stri_trans_general) +importFrom(tibble,as_tibble) +importFrom(tibble,rownames_to_column) +importFrom(tibble,tibble) +importFrom(tidyr,extract) +importFrom(tidyr,gather) +importFrom(tidyr,separate) +importFrom(tidyr,spread) +importFrom(tools,file_ext) +importFrom(utils,browseURL) +importFrom(utils,combn) +importFrom(utils,head) +importFrom(utils,install.packages) +importFrom(utils,read.table) +importFrom(utils,str) +importFrom(utils,tail) +importFrom(utils,write.table) +importFrom(writexl,write_xlsx) diff --git a/radiant.data/NEWS.md b/radiant.data/NEWS.md new file mode 100644 index 0000000000000000000000000000000000000000..e07832d6527dc8196fd35714fd4446ea5e5de586 --- /dev/null +++ b/radiant.data/NEWS.md @@ -0,0 +1,512 @@ +# radiant.data 1.6.7 + +* Moving arrow package to 'recommended' because of its size on macOS (> 100MB) + +# radiant.data 1.6.6 + +* Require Shiny 1.8.1. Adjustments related to icon-buttons were made to address a breaking change in Shiny 1.8.1 +* Reverting changes that removed `req(input$dataset)` in different places + +# radiant.data 1.6.3 + +* Require shiny 1.8.0. This fixes a bug in the shiny 1.7 versions that caused issues with all radiant packages. + +# radiant.data 1.6.2 + +* Fixed a bug in Radiant by changing knitr options. Usernames with a space should no longer cause issues on Windows + +# radiant.data 1.6.0 + +* Added a dependency on the arrow package to allow loading and saving parquet files +* Added option to load and save parquet files and data description files (see Data > Manage) +* Renamed Radiant to "Radiant for R" to destinguish from "Radiant for Python" +* Addressed a bug that can occur when combining line graphs in Data > Visualize + +# radiant.data 1.5.6 + +* Address deprecation issues in markdown >= 1.5 + +# radiant.data 1.5.1 + +* Added features in the UI to facilitate persistent filters for filtered, sorted, and sliced data +* Improvements to screenshot feature: + - Navigation bar is omitted and the image is adjusted to the length of the UI. + - html2canvas.js is now included so users can take screenshot when offline +* Added a convenience function `add_description` to add a description attribute to a data.frame in markdown format +* Line graphs treated more similarly to bar-graphs: + - Can have a binary factor variable on the y-axis + - Y-variable only line are now also possible +* Removed all references to `aes_string` which is being deprecated in ggplot soon +* Improved cleanup after Radiant UI is closed + +# radiant.data 1.4.7 + +* Code cleanup in different areas + +# radiant.data 1.4.6 + +* gsub("[\x80-\xFF]", "", text) is no longer valid in R 4.2.0 and above. Non-asci symbols will now be escaped using stringi::stri_trans_general when needed + +# radiant.data 1.4.5 + +* Add scrolling for dropdown menus that might extend past the edge of the screen +* Addressed warning messages about Font Awesome icons not existing +* gsub("[\x80-\xFF]", "", text) is no longer valid in R 4.2.0 and above. Non-asci symbols will now be escaped using stringi when needed + +# radiant.data 1.4.4 + +* Added option to create screenshots of settings on a page. Approach is inspired by the snapper package by @yonicd +* Added contact request for users on Radiant startup +* Fix issue with R_ZIPCMD when 7zip is on the path but not being recognized by R + +# radiant.data 1.4.2 + +* Use `all` for `is.null` and `is.na` if object length can be greater than 1 as required in R 4.2.0 + +# radiant.data 1.4.1 + +* Setup to allow formatting of the shiny interface with bootstrap 4 +* Addressing `is_empty` function clash with `rlang` +* Upgrading `shiny` dependency to 1.6.0 and fixing project text alignment issue (@cpsievert, https://github.com/radiant-rstats/radiant.data/pull/28) + +# radiant.data 1.3.12 + +* Fixes related to breaking changes in `magrittr` +* Fixes related to changes in `readr` argument names +* Fix to launch radiant in a "windows" + +# radiant.data 1.3.10 + +* Add Google Drive to the default set of directories to explore if available +* Add back functionality to convert a column to type `ts` in _Data > Transform_ now that this is again supported by dplyr 1.0.1 + +# radiant.data 1.3.9 + +* Fix for using the `date` function from the lubridate package in a filter +* Removed functionality to convert a column to type `ts` as this is not supported by dplyr 1.0.0 and vctrs 0.3.1 +* Updated documentation using https://github.com/r-lib/roxygen2/pull/1109 + +# radiant.data 1.3.6 + +* Updated styling for formatting for modals (e.g., help pages) that will also allow improved sizing of the (shinyFiles) file browser +* Fix for `\r` line-endings in _Report > Rmd_ on Windows. Issue was most likely to occur when copy-and-pasting text from PDF into _Report > Rmd_. + +# radiant.data 1.3.4 + +* Minor adjustments in anticipation of dplyr 1.0.0 + +# radiant.data 1.3.3 + +* Function to calculate "mode" +* Fix for "spread" in Data > Transform with column name includes "." + +# radiant.data 1.3.1 + +* If radiant is not opened from an Rstudio project, use the working directory at launch as the base directory for the application + +# radiant.data 1.3.0 + +* Updated styling of Notebook and HTML reports (cosmo + zenburn) +* Documentation updates to link to new video tutorials +* Use `patchwork` for grouping multiple plots together +* Apply `refactor` to any type in the _Data > Transform_ UI +* Fix for `weighted.sd` when missing values differ for `x` and weights +* Avoid resetting the "Column header" to its default value in _Data > Explore_ when other settings are changed. + +# radiant.data 1.2.3 + +* Fix for _Data > Transform > Spread_ when no variables are selected +* Set `debounce` to 0 for all shinyAce editors + +# radiant.data 1.2.2 + +* Use `zenburn` for code highlighting in Notebook and HTML report from _Report > Rmd_ +* Clean up "sf_volumes" from the when radiant is stopped + +# radiant.data 1.2.0 + +* Update action buttons that initiate a calculation when one or more relevant inputs are changed. For example, when a model should be re-estimated because the set of explanatory variables was changed by the user, a spinning "refresh" icon will be shown + +# radiant.data 1.1.8 + +* Changed default `quantile` algorithm used in the `xtile` function from number 2 to 7. See the help for `stats::quantile` for details +* Added `me` and `meprop` functions to calculate the margin of error for a mean and a proportion. Functions are accessible from _Data > Pivot_ and _Data > Explore_ + +# radiant.data 1.1.6 + +* Improvements for wrapping generated code to _Report > Rmd_ or _Report > R_ +* _Data > Transform > Training_ now uses the `randomizr` package to allow blocking variables when creating a training variables. + +# radiant.data 1.1.3 + +* Guard against _using Data > Transform > Reorder/remove levels_ with too many levels (i.e., > 100) +* Guard against _using Data > Transform > Reorder/remove variables_ with too many variables (i.e., > 100) +* Fix for DT table callbacks when shiny 1.4 hits CRAN (see https://github.com/rstudio/DT/issues/146#issuecomment-534319155) +* Tables from _Data > Pivot_ and _Data > Explore_ now have `nr` set to `Inf` by default (i.e., show all rows). The user can change this to the number of desired rows to show (e.g., select 3 rows in a sorted table) +* Fix for example numbering in the help file for _Data > Transform_ +* Numerous small code changes to support enhanced auto-completion, tooltips, and annotations in shinyAce 0.4.1 + +# radiant.data 1.0.6 + +* Fix for `Data > Transform > Change type` +* Option to `fix_names` to lower case +* Keyboard shortcut (Enter) to load remove csv and rds files +* Use a shinyAce input to generate data descriptions +* Allow custom initial dataset list +* Fix for latex formulas in _Report > Rmd_ on Windows +* Updated requirements for markdown and Rmarkdown +* Fix for `radiant.init.data` with shiny-server +* Improvements to setup to allow access to server-side files by adding options to .Rprofile: + - Add `options(radiant.report = TRUE)` to allow report generation in _Report > Rmd_ and _Report > R_ + - Add `options(radiant.shinyFiles = TRUE)` to allow server-side access to files + - List specific directories you want to use with radiant using, for example, `options(radiant.sf_volumes = c(Git = "/home/jovyan/git"))` + +# radiant.data 1.0.0 + +* Support for series of class `ts` (e.g., Data > Transform > Change type > Time series) +* Require shinyAce 0.4.0 +* Vertical jitter set to 0 by default + +# radiant.data 0.9.9.0 + +* Added option to save _Report > Rmd_ as a powerpoint file using `Rmarkdown` +* Removed dependency on `summarytools` due to breaking changes +* Fix for interaction (`iterm`) and non-linear term (`qterm`) creation if character strings rather than integers are passed to the function +* Remove specific symbols from reports in _Report > Rmd_ to avoid issues when generating HTML or PDF documents +* Keyboard shortcuts, i.e., CTRL-O and CTRL-S (CMD-O and CMD-S on macOS) to open and save data files in the _Data > Manage_ tab +* Various fixes to address breaking changes in dplyr 0.8.0 +* Added `radiant_` prefix to all attributes, except `description`, to avoid conflicts with other packages (e.g., `vars` in dplyr) + +# radiant.data 0.9.8.6 + +* Use `stringi::stri_trans_general` to replace special symbols in Rmarkdown that may cause problems +* Add empty line before and after code chunks when saving reports to Rmarkdown +* Use `rio` to load `sav`, `dta`, or `sas7bdat` files through the `read files` button in _Report > Rmd_ and _Report > R_. +* Create a `qscatter` plot similar to the function of the same name in Stata +* New radiant icon +* Fix for setting where both `xlim` and `ylim` are set in `visualize` function +* Use an expandable `shinyAce` input for the R-code log in _Data > Transform_ + +# radiant.data 0.9.8.0 + +* Added an "autosave" options. Use `options(radiant.autosave = c(10, 180)); radiant::radiant()` to auto-save the application state to the `~/.radiant.session` folder every 10 minutes for the next 180 minutes. This can be useful if radiant is being used during an exam, for example. +* Emergency backups are now saved to `~/.radiant.session/r_some_id.state.rda`. The files should be automatically loaded when needed but can also be loaded as a regular radiant state file +* Replace option to load an `.rda` from from a URL in _Data > Manage_ to load `.rds` files instead +* Ensure variable and dataset names are valid for R (i.e., no spaces or symbols), "fixing" the input as needed +* Fix to visualize now `ggplot::labs` no longer accepts a list as input +* Add option to generate square and cubed terms for use in linear and logistic regression in `radiant.model` +* Fix for error when trying to save invalid predictions in `radiant.model`. This action now generates a pop-up in the browser interface +* Add a specified description to a data.frame immediately on `register` +* Option to pass additional arguments to `shiny::runApp` when starting radiant such as the port to use. For example, radiant.data::radiant.data("https://github.com/radiant-rstats/docs/raw/gh-pages/examples/demo-dvd-rnd.state.rda", port = 8080) +* Option for automatic cleanup of deprecated code in both _Report > Rmd_ and _Report > R_ +* Avoid attempt to fix deprecated code in _Report > Rmd_ if `pred_data = ""` +* Fix for download icon linked to downloading of a state file after upgrade to shiny 1.2 +* Update documentation for _Data > Combine_ +* Fix for `format_df` when the data.frame contains missing values. This fix is relevant for several `summary` functions run in _Report > Rmd_ or _Report > R_ +* Fix for directory set when using `Knit report` in _Report > Rmd_ and _Report > R_ **without** an Rstudio project. Will now correctly default to the working directory used in R(studio) +* Added option to change `smooth` setting for histograms with a density plot +* Similar to `pmin` and `pmax`, `pfun` et al. calculate summary statistics elementwise across multiple vectors +* Add `Desktop` as a default directory to show in the `shinyFiles` file browser +* Load a state file on startup by providing a (relative) file path or a url. For example, radiant.data::radiant.data("https://github.com/radiant-rstats/docs/raw/gh-pages/examples/demo-dvd-rnd.state.rda") +or radiant.data::radiant.data("assignment.state.rda") +* Update example report in _Report > Rmd_ +* Add `deregister` function to remove data in radiant from memory and the `datasets` dropdown list +* Fix for invalid column names if used in `Data > Pivot` + +# radiant.data 0.9.7.0 + +* Use `summarytools` to generate summary information for datasets in _Data > Manage_ +* Show modal with warning about non-writable working directory when saving reports in _Report > Rmd_ or _Report > R_ +* Apply `radiant.data::fix_names` to files loaded into radiant to ensure valid R-object names +* Use the content of the `Store filtered data as` input to name the csv download in _Data > View_ +* Add "txt" as a recognized file type for `Read files` in _Report > Rmd_ and _Report > R_ +* Allow multiple `lines` or `loess` curves based on a selected `color` variable for scatter plots in _Data > Visualize_ +* Indicate that a plot in _Data > Visualize_ should be updated when plot labels are changed +* Fix for [#81](https://github.com/radiant-rstats/radiant/issues/81) when variables used in _Data > Pivot_ contain dots +* Fix for `radiant.project_dir` when no Rstudio project is used which could cause incorrect relative paths to be used +* Fix code formatting for _Report > Rmd_ when arguments include a list (e.g., ggplot labels) +* On Linux use a modal to show code in Report > Rmd and Report > R when reporting is set to "manual" +* Use `is_double` to ensure dates are not treated as numeric variables in _Data > View_ +* Make sort and filter state of tables in Data > Explore and Data > Pivot available in Report > Rmd +* Fix names for data sets loaded using the `Read files` button in Report > Rmd or Report > R +* Cleanup environment after closing app +* Fix column names with spaces, etc. when reading csv files +* Additional styling and labeling options for _Data > Visualize_ are now available in the browser interface +* Fix for code generation related to DT filters + +# radiant.data 0.9.6.14 + +## Major changes + +* Using [`shinyFiles`](https://github.com/thomasp85/shinyFiles) to provide convenient access to data located on a server +* Avoid `XQuartz` requirement + +## Minor changes + +* Load `data(...)` into the current environment rather than defaulting only to the global environment +* `file.rename` failed using docker on windows when saving a report. Using `file.copy` instead +* Fix for `sf_volumes` used to set the root directories to load and save files +* Set default locale to "en_US.UTF-8" when using shiny-server unless `Sys.getlocale(category = "LC_ALL")` what set to something other than "C" +* Modal shown if and Rmd (R) file is not available when using "To Rstudio (Rmd)" in _Report > Rmd_ or "To Rstudio (R)" in _Report > R_ +* Track progress loading (state) files +* Fix for `radiant.sf_volumes` used for the `shinyFiles` file browser +* Improvements for sending code from Radiant to Rstudio +* Better support for paths when using radiant on a server (i.e., revert to home directory using `radiant.data::find_home()`) +* Revert from `svg` to `png` for plots in `_Report > Rmd_ and _Report > R_. `svg` scatter plots with many point get to big for practical use on servers that have to transfer images to a local browser +* Removed dependency on `methods` package + +# radiant.data 0.9.5.3 + +* Fix smart comma's in data descriptions +* Search and replace `desc(n)` in reports and replace by `desc(n_obs)` +* Revert to storing the r_data environment as a list on stop to avoid reference problems (@josh1400) +* Fix for plot type in _Data > Pivot_ in older state files (@josh1400) +* Used all declared imports (CRAN) + +# radiant.data 0.9.5.0 + +* Fix for `radiant.data::explore` when variable names contain an underscore +* Fix for `find_gdrive` when drive is not being synced +* Fixes in _Report > Rmd_ and _Report > R_ to accommodate for pandoc > 2 + +# radiant.data 0.9.4.6 + +* Don't update a reactive binding for an object if the binding already exists. See issue https://github.com/rstudio/shiny/issues/2065 +* Fix to accommodate changes in `deparse` in R 3.5 +* Fix for saving data in _Data > Manage_ and generating the relevant R-code + +# radiant.data 0.9.3.5 + +## Minor changes + +* Use `dev = "svg"` for plots in _Report > Rmd_ and _Report > R_ + +# radiant.data 0.9.3.4 + +## Minor changes + +* Add argument to `dtab.data.frame` to format specified columns as a percentage + +## Bug fixes + +* Round to the specified number of decimal places even if input if not of type integer (e.g., 2.0) + +# radiant.data 0.9.3.3 + +## Major changes + +* When using radiant with Rstudio Viewer or in an Rstudio Window, loading and saving data through _Data > Manage_ generates R-code the user can add to _Report > Rmd_ or _Report > R_. Clicking the `Show R-code` checkbox displays the R-code used to load or save the current dataset +* Various changes to the code to accommodate the use of `shiny::makeReactiveBinding`. The advantage is that the code generated for _Report > Rmd_ and _Report > R_ will no longer have to use a list (`r_data`) to store and access data. This means that code generated and used in the Radiant browser interface will be directly usable without the browser interface as well +* Removed `loadr`, `saver`, `load_csv`, `loadcsv_url`, `loadrds_url`, and `make_funs` functions as they are no longer needed +* Deprecated `mean_rm`, `median_rm`, `min_rm`, `max_rm, `sd_rm`, `var_rm, and `sum_rm` functions as they are no longer needed + +## Minor changes + +* Added `load_clip` and `save_clip` to load and save data to the clipboard on Windows and macOS +* Improved auto completion in _Report > Rmd_ and _Report > R_ +* Maintain, store, and clean the settings of the interactive table in _Data > View_ +* Address closing Rstudio Window issue (https://github.com/rstudio/shiny/issues/2033) + +# radiant.data 0.9.2.3 + +## Major changes + +* _Report > Rmd_ and _Report > R_ will now be evaluated the `r_data` environment. This means that the return value from `ls()` will be much cleaner + +## Minor changes + +* Add option to load files with extension .rdata or .tsv using `loadr` which add that data to the Datasets dropdown +* `visualize` will default to a scatter plot if `xvar` and `yvar` are specified but no plot `type` is provided in the function call +* Improvements to `read_files` function to interactively generate R-code (or Rmarkdown code-chunks) to read files in various format (e.g., SQLite, rds, csv, xlsx, css, jpg, etc.). Supports relative paths and uses `find_dropbox()` and `find_gdrive()` when applicable + +# radiant.data 0.9.2.2 + +## Minor changes + +* Require `shinyAce` 0.3.0 +* Export `read_files` function to interactively generate R-code or Rmarkdown code-chunks to read files in various format (e.g., SQLite, rds, csv, xlsx, css, jpg, etc.). Supports relative paths and uses `find_dropbox()` and `find_gdrive()` when applicable + +# radiant.data 0.9.2.0 + +## Minor changes + +* Addins option to start app in Rstudio window +* Upload and download data using the Rstudio file browser. Allows using relative paths to files (e.g., data or images inside an Rstudio project) + +# CHANGES IN radiant.data 0.9.0.22 + +## Bug fixes + +* Fix for [#43](https://github.com/radiant-rstats/radiant/issues/43) where scatter plot was not shown for a dataset with less than 1,000 rows +* Fix for _Report > Rmd_ and _Report > R_ when R-code or Rmarkdown is being pulled from the Rstudio editor + +## Minor changes + +* Updated equation example in _Report > Rmd_ + +# radiant.data 0.9.0.17 + +## Minor changes + +* Use thousand separator for `summary.pivotr` and `summary.explore` +* Fix in code-generation for `table2data` + +# radiant.data 0.9.0.16 + +## Minor changes + +* Changed license for help files and images for radiant.data to [CC-BY-SA](https://creativecommons.org/licenses/by-sa/4.0/legalcode) + +# radiant.data 0.9.0.15 + +## Minor changes + +* Allow all textarea inputs and multi-select inputs to be resized manually by the user +* Use 200 dpi for plots in _Report > Rmd_ and _Report > R_ +* _Data > Visualize_ now has an option to select a sample of data for scatter plots (e.g., 1K, 5K, 10K, or All) + +## Bug fixes + +* Fix for `rounddf` to ignore dates + +# radiant.data 0.9.0.13 + +## Minor changes + +* Apply `fixMS` to replace curly quotes, em dash, etc. when using _Data > Transform > Create_ +* Option to set number of decimals to show in _Data > View_ +* Improved number formatting in interactive tables in _Data > View_, _Data > Pivot_, and _Data > Explore_ +* Option to include an interactive view of a dataset in _Report > Rmd_. By default, the number of rows is set to 100 as, most likely, the user will not want to embed a large dataset in save HTML report +* _Data > Transform_ will leave variables selected, unless switching to `Create` or `Spread` +* Switch focus to editor in _Report > Rmd_ and _Report > R_ when no other input has focus + +## Bug fixes + +* Fix for decimals to show in interactive tables _Report > Rmd_ and saved HTML reports +* Better error messages for `xtile` and when binning data with too many groups +* Fix for variable type warnings in _Data > Pivot_ when filtering the table +* Fix for \ in equations in _Report > Rmd_ + +# radiant.data 0.9.0.7 + +## Minor changes + +* Allow response variables with NA values in _Model > Logistic regression_ and other classification models +* Support logicals in code generation from _Data > View_ +* Track window size using `input$get_screen_width` +* Focus on editor when switching to _Report > Rmd_ or _Report > R_ so generated code is shown immediately and the user can navigate and type in the editor without having to click first +* Add information about the first level when plotting a bar chart with a categorical variable on the Y-axis (e.g., mean(buyer {yes})) + +## Bug fixes + +* Cleanup now also occurs when the stop button is used in Rstudio to close the app +* Fix to include `DiagrammeR` based plots in Rmarkdown reports +* Fix in `read_files` for SQLite data names +* De-activate spell check auto correction in `selectizeInput` in Rstudio Viewer [shiny #1916](https://github.com/rstudio/shiny/issues/1916) +* Fix to allow selecting and copying text output from _Report > Rmd_ and _Report > R_ +* Remove "fancy" quotes from filters +* Known issue: The Rstudio viewer may not always close the viewer window when trying to stop the application with the `Stop` link in the navbar. As a work-around, use Rstudio's stop buttons instead. + +# radiant.data 0.9.0.0 + +## Major changes + +* If Rstudio project is used _Report > Rmd_ and _Report > R_ will use the project directory as base. This allows users to use relative paths and making it easier to share (reproducible) code +* Specify options in .Rprofile for upload memory limit and running _Report > Rmd_ on server +* `find_project` function based on `rstudioapi` +* _Report > Rmd_ Read button to generate code to load various types of data (e.g., rda, rds, xls, yaml, feather) +* _Report > Rmd_ Read button to generate code to load various types of files in report (e.g., jpg, png, md, Rmd, R). If Radiant was started from an Rstudio project, the file paths used will be relative to the project root. Paths to files synced to local Dropbox or Google Drive folder will use the `find_dropbox` and `find_gdrive` functions to enhances reproducibility. +* _Report > Rmd_ Load Report button can be used to load Rmarkdown file in the editor. It will also extract the source code from Notebook and HTML files with embedded Rmarkdown +* _Report > Rmd_ will read Rmd directly from Rstudio when "To Rstudio (Rmd)" is selected. This will make it possible to use Rstudio Server Pro's _Share project_ option for realtime collaboration in Radiant +* Long lines of code generated for _Report > Rmd_ will be wrapped to enhance readability +* _Report > R_ is now equivalent to _Report > Rmd_ but in R-code format +* _Report > Rmd_ option to view Editor, Preview, or Both +* Show Rstudio project information in navbar if available + +## Minor changes + +* Overflow `pre` and `code` blocks in HTML reports generated in _Report > Rmd_ +* Read rdata files through _Data > Manage_ +* Enhanced keyboard shortcuts +* Enhanced editing features in _Report > Rmd_ and _Report > R_ based on updates to `shinyAce` + +# radiant.data 0.8.7.8 + +## Minor changes + +* Added preview options to _Data > Manage_ based on https://github.com/radiant-rstats/radiant/issues/30 +* Add selected dataset name as default table download name in _Data > View_, _Data > Pivot_, and _Data > Explore_ +* Use "stack" as the default for histograms and frequency charts in _Data > Visualize_ +* Cleanup `Stop & Report` option in navbar +* Upgraded tidyr dependency to 0.7 +* Upgraded dplyr dependency to 0.7.1 + +## Bug fixes + +* Fix for large numbers in _Data > Explore_ that could cause an integer overflow + +# radiant.data 0.8.6.0 + +## Minor changes + +* Export `ggplotly` from `plotly` for interactive plots in _Report > Rmd_ +* Export `subplot` from `plotly` for grids of interactive plots in _Report > Rmd_ +* Set default `res = 96` for `renderPlot` and `dpi = 96` for `knitr::opts_chunk` +* Add `fillcol`, `linecol`, and `pointcol` to `visualize` to set plot colors when no `fill` or `color` variable has been selected +* Reverse legend ordering in _Data > Visualize_ when axes are flipped using `coor_flip()` +* Added functions to choose.files and choose.dir. Uses JavaScript on Mac, utils::choose.files and utils::choose.dir on Windows, and reverts to file.choose on Linux +* Added `find_gdrive` to determine the path to a user's local Google Drive folder if available +* `fixMs` for encoding in reports on Windows + +## Bug fixes + +* Chi-square results were not displayed correctly in _Data > Pivot_ +* Fix for `state_multiple` + +# radiant.data 0.8.1.0 + +## Minor changes + +* Specify the maximum number of rows to load for a csv and csv (url) file through _Data > Manage_ +* Support for loading and saving feather files, including specifying the maximum number of rows to load through _Data > Manage_ +* Added author and year arguments to help modals in inst/app/radiant.R (thanks @kmezhoud) +* Added size argument for scatter plots to create bubble charts (thanks @andrewsali) +* Example and CSS formatting for tables in _Report > Rmd_ +* Added `seed` argument to `make_train` +* Added `prop`, `sdprop`, etc. for working with proportions +* Set `ylim` in `visualize` for multiple plots +* Show progress indicator when saving reports from _Report > Rmd_ +* `copy_attr` convenience function +* `refactor` function to keep only a subset of levels in a factor and recode the remaining (and first) level to, for example, other +* `register` function to add a (transformed) dataset to the dataset dropdown +* Remember name of state files loaded and suggest that name when re-saving the state +* Show dataset name in output if dataframe passed directly to analysis function +* R-notebooks are now the default option for output saved from _Report > Rmd_ and _Report > R_ +* Improved documentation on how to customize plots in _Report > Rmd_ +* Keyboard short-cut to put code into _Report > Rmd_ (ALT-enter) + +## Bug fixes + +* When clicking the `rename` button, without changing the name, the dataset was set to NULL (thanks @kmezhoud, https://github.com/radiant-rstats/radiant/issues/5) +* Replace ext with .ext in `mutate_each` function call +* Variance estimation in Data > Explore would cause an error with unit cell-frequencies (thanks @kmezhoud, https://github.com/radiant-rstats/radiant/issues/6) +* Fix for as_integer when factor levels are characters +* Fix for integer conversion in explore +* Remove \\r and special characters from strings in r_data and r_state +* Fix sorting in _Report > Rmd_ for tables created using _Data > Pivot_ and _Data > Explore_ when column headers contain symbols or spaces (thanks @4kammer) +* Set `error = TRUE` for rmarkdown for consistency with knitr as used in _Report > Rmd_ +* Correctly handle decimal indicators when loading csv files in _Data > Manage_ +* Don't overwrite a dataset to combine if combine generates an error when user sets the the name of the combined data to that of an already selected dataset +* When multiple variables were selected, data were not correctly summarized in Data > Transform +* Add (function) label to bar plot when x-variable is an integer +* Maintain order of variables in Data > Visualize when using "color", "fill", "comby", or "combx" +* Avoid warning when switching datasets in Data > Transform and variables being summarized do not exists in the new dataset +* which.pmax produced a list but needed to be integer +* To customized predictions in radiant.model indexr must be able to customize the prediction dataframe +* describe now correctly resets the working directory on exit +* removed all calls to summarise_each and mutate_each from dplyr + +## Deprecated +* varp_rm has been deprecated in favor of varpop +* sdp_rm has been deprecated in favor of sdpop +* mutate_each has been deprecated in favor of mutate_at, mutate_all, and radiant.data::mutate_ext diff --git a/radiant.data/R/aaa.R b/radiant.data/R/aaa.R new file mode 100644 index 0000000000000000000000000000000000000000..1a91737fa22cbb4930c262aa66003cb4a49cb1e7 --- /dev/null +++ b/radiant.data/R/aaa.R @@ -0,0 +1,135 @@ +# to avoid 'no visible binding for global variable' NOTE +globalVariables( + c(".", "r_data", "r_info", "thead", "th", "tr", "tfoot", "bslib_current_version", "variable") +) + +#' radiant.data +#' +#' @name radiant.data +#' @import ggplot2 shiny dplyr +#' @importFrom rlang parse_exprs +#' @importFrom car Recode +#' @importFrom rstudioapi insertText isAvailable +#' @importFrom knitr knit2html knit +#' @importFrom markdown mark_html +#' @importFrom rmarkdown render html_dependency_bootstrap pdf_document html_document word_document +#' @importFrom magrittr %<>% %T>% %$% set_rownames set_colnames set_names divide_by add extract2 +#' @importFrom lubridate is.Date is.POSIXt now year month wday week hour minute second ymd mdy dmy ymd_hms hms hm as.duration parse_date_time +#' @importFrom tidyr gather spread separate extract +#' @importFrom shinyAce aceEditor updateAceEditor +#' @importFrom readr read_delim read_csv write_csv read_rds write_rds locale problems +#' @importFrom readxl read_excel +#' @importFrom base64enc dataURI +#' @importFrom stats as.formula chisq.test dbinom median na.omit quantile sd setNames var weighted.mean IQR +#' @importFrom utils combn head tail install.packages read.table write.table +#' @importFrom import from +#' @importFrom curl curl_download +#' @importFrom writexl write_xlsx +#' @importFrom shinyFiles getVolumes parseDirPath parseFilePaths parseSavePath shinyFileChoose shinyFileSave shinyFilesButton shinyFilesLink shinySaveButton shinySaveLink +#' +NULL + +#' @importFrom bslib theme_version bs_theme +#' @export +bslib::theme_version + +#' @export +bslib::bs_theme + +#' @importFrom patchwork wrap_plots plot_annotation +#' @export +patchwork::wrap_plots + +#' @export +patchwork::plot_annotation + +#' @importFrom png writePNG +#' @export +png::writePNG + +#' @importFrom glue glue glue_data glue_collapse +#' @export +glue::glue + +#' @export +glue::glue_data + +#' @export +glue::glue_collapse + +#' @importFrom knitr knit_print +#' @export +knitr::knit_print + +#' @importFrom tibble rownames_to_column tibble as_tibble +#' @export +tibble::rownames_to_column + +#' @export +tibble::tibble + +#' @export +tibble::as_tibble + +#' @importFrom broom tidy glance +#' @export +broom::tidy + +#' @export +broom::glance + +#' @importFrom psych kurtosi skew +#' @export +psych::kurtosi + +#' @export +psych::skew + +#' @importFrom lubridate date +#' @export +lubridate::date + +#' Diamond prices +#' @details A sample of 3,000 from the diamonds dataset bundled with ggplot2. Description provided in attr(diamonds,"description") +#' @docType data +#' @keywords datasets +#' @name diamonds +#' @usage data(diamonds) +#' @format A data frame with 3000 rows and 10 variables +NULL + +#' Survival data for the Titanic +#' @details Survival data for the Titanic. Description provided in attr(titanic,"description") +#' @docType data +#' @keywords datasets +#' @name titanic +#' @usage data(titanic) +#' @format A data frame with 1043 rows and 10 variables +NULL + +#' Comic publishers +#' @details List of comic publishers from \url{https://stat545.com/join-cheatsheet.html}. The dataset is used to illustrate data merging / joining. Description provided in attr(publishers,"description") +#' @docType data +#' @keywords datasets +#' @name publishers +#' @usage data(publishers) +#' @format A data frame with 3 rows and 2 variables +NULL + +#' Super heroes +#' @details List of super heroes from \url{https://stat545.com/join-cheatsheet.html}. The dataset is used to illustrate data merging / joining. Description provided in attr(superheroes,"description") +#' @docType data +#' @keywords datasets +#' @name superheroes +#' @usage data(superheroes) +#' @format A data frame with 7 rows and 4 variables +NULL + +#' Avengers +#' @details List of avengers. The dataset is used to illustrate data merging / joining. Description provided in attr(avengers,"description") +#' @docType data +#' @keywords datasets +#' @name avengers +#' @usage data(avengers) +#' @format A data frame with 7 rows and 4 variables +NULL diff --git a/radiant.data/R/combine.R b/radiant.data/R/combine.R new file mode 100644 index 0000000000000000000000000000000000000000..e9d201be89d722b6637a6fdffc0fca3eee594672 --- /dev/null +++ b/radiant.data/R/combine.R @@ -0,0 +1,81 @@ +#' Combine datasets using dplyr's bind and join functions +#' +#' @details See \url{https://radiant-rstats.github.io/docs/data/combine.html} for an example in Radiant +#' +#' @param x Dataset +#' @param y Dataset to combine with x +#' @param by Variables used to combine `x` and `y` +#' @param add Variables to add from `y` +#' @param type The main bind and join types from the dplyr package are provided. \bold{inner_join} returns all rows from x with matching values in y, and all columns from x and y. If there are multiple matches between x and y, all match combinations are returned. \bold{left_join} returns all rows from x, and all columns from x and y. If there are multiple matches between x and y, all match combinations are returned. \bold{right_join} is equivalent to a left join for datasets y and x. \bold{full_join} combines two datasets, keeping rows and columns that appear in either. \bold{semi_join} returns all rows from x with matching values in y, keeping just columns from x. A semi join differs from an inner join because an inner join will return one row of x for each matching row of y, whereas a semi join will never duplicate rows of x. \bold{anti_join} returns all rows from x without matching values in y, keeping only columns from x. \bold{bind_rows} and \bold{bind_cols} are also included, as are \bold{intersect}, \bold{union}, and \bold{setdiff}. See \url{https://radiant-rstats.github.io/docs/data/combine.html} for further details +#' @param data_filter Expression used to filter the dataset. This should be a string (e.g., "price > 10000") +#' @param arr Expression to arrange (sort) the data on (e.g., "color, desc(price)") +#' @param rows Rows to select from the specified dataset +#' @param envir Environment to extract data from +#' @param ... further arguments passed to or from other methods +#' +#' @return Combined dataset +#' +#' @examples +#' avengers %>% combine_data(superheroes, type = "bind_cols") +#' combine_data(avengers, superheroes, type = "bind_cols") +#' avengers %>% combine_data(superheroes, type = "bind_rows") +#' avengers %>% combine_data(superheroes, add = "publisher", type = "bind_rows") +#' +#' @export +combine_data <- function(x, y, by = "", add = "", + type = "inner_join", + data_filter = "", + arr = "", + rows = NULL, + envir = parent.frame(), + ...) { + is_join <- grepl("_join", type) + if (is_join && is.empty(by)) { + return(cat("No variables selected to join datasets\n")) + } + + ## legacy to deal with argument name change + if (missing(x) || missing(y)) { + depr <- list(...) + x <- depr$dataset + y <- depr$cmb_dataset + } + + x_name <- ifelse(is_string(x), x, deparse(substitute(x))) + y_name <- ifelse(is_string(y), y, deparse(substitute(y))) + + x <- get_data(x, filt = data_filter, arr = arr, rows = rows, na.rm = FALSE, envir = envir) + if (all(add == "")) { + y <- get_data(y, na.rm = FALSE, envir = envir) + } else { + y <- get_data(y, unique(c(by, add)), na.rm = FALSE, envir = envir) + } + + ## keeping data descriptions + x_descr <- attr(x, "description") + y_descr <- attr(y, "description") + + if (is_join) { + x <- get(type, envir = as.environment("package:dplyr"))(x, y, by = by) + madd <- paste0("
\nBy: ", paste0(by, collapse = ", ")) + } else { + x <- get(type, envir = as.environment("package:dplyr"))(x, y) + madd <- "" + } + + ## return error message as needed + if (is.character(x)) { + return(x) + } + + mess <- paste0( + "## Combined\n\nDatasets: ", x_name, " and ", y_name, + " (", type, ")", madd, "
\nOn: ", lubridate::now(), "\n\n", x_descr, + ifelse(!is.empty(data_filter), paste0("\n\n**Data filter:** ", data_filter), ""), + ifelse(!is.empty(arr), paste0("\n\n**Data arrange:** ", make_arrange_cmd(arr)), ""), + ifelse(!is.empty(rows), paste0("\n\n**Data slice:** ", rows), ""), + "\n\n", y_descr + ) + + set_attr(x, "description", mess) +} \ No newline at end of file diff --git a/radiant.data/R/deprecated.R b/radiant.data/R/deprecated.R new file mode 100644 index 0000000000000000000000000000000000000000..73bc25108cd830edbd355c72c8859efaa4d33749 --- /dev/null +++ b/radiant.data/R/deprecated.R @@ -0,0 +1,118 @@ +#' Deprecated function(s) in the radiant.data package +#' +#' These functions are provided for compatibility with previous versions of +#' radiant but will be removed +#' @rdname radiant.data-deprecated +#' @name radiant.data-deprecated +#' @param ... Parameters to be passed to the updated functions +#' @export mean_rm median_rm min_rm max_rm sd_rm var_rm sum_rm getdata filterdata combinedata viewdata toFct fixMS getsummary Search formatnr formatdf rounddf getclass is_numeric +#' @aliases mean_rm median_rm min_rm max_rm sd_rm var_rm sum_rm getdata filterdata combinedata viewdata toFct fixMS getsummary Search formatnr formatdf rounddf getclass is_numeric +#' @section Details: +#' \itemize{ +#' \item Replace \code{mean_rm} by \code{\link{mean}} +#' \item Replace \code{median_rm} by \code{\link{median}} +#' \item Replace \code{min_rm} by \code{\link{min}} +#' \item Replace \code{max_rm} by \code{\link{max}} +#' \item Replace \code{sd_rm} by \code{\link{sd}} +#' \item Replace \code{var_rm} by \code{\link{var}} +#' \item Replace \code{sum_rm} by \code{\link{sum}} +#' \item Replace \code{getdata} by \code{\link{get_data}} +#' \item Replace \code{filterdata} by \code{\link{filter_data}} +#' \item Replace \code{combinedata} by \code{\link{combine_data}} +#' \item Replace \code{viewdata} by \code{\link{view_data}} +#' \item Replace \code{toFct} by \code{\link{to_fct}} +#' \item Replace \code{fixMS} by \code{\link{fix_smart}} +#' \item Replace \code{rounddf} by \code{\link{round_df}} +#' \item Replace \code{formatdf} by \code{\link{format_df}} +#' \item Replace \code{formatnr} by \code{\link{format_nr}} +#' \item Replace \code{getclass} by \code{\link{get_class}} +#' \item Replace \code{is_numeric} by \code{\link{is_double}} +#' \item Replace \code{is_empty} by \code{\link{is.empty}} +#' } +#' +mean_rm <- function(...) { + .Deprecated("mean") + mean(..., na.rm = TRUE) +} +median_rm <- function(...) { + .Deprecated("median") + median(..., na.rm = TRUE) +} +min_rm <- function(...) { + .Deprecated("min") + min(..., na.rm = TRUE) +} +max_rm <- function(...) { + .Deprecated("max") + max(..., na.rm = TRUE) +} +sd_rm <- function(...) { + .Deprecated("sd") + sd(..., na.rm = TRUE) +} +var_rm <- function(...) { + .Deprecated("var") + var(..., na.rm = TRUE) +} +sum_rm <- function(...) { + .Deprecated("sum") + sum(..., na.rm = TRUE) +} +getsummary <- function(...) { + .Deprecated("get_summary") + get_summary(...) +} +getdata <- function(...) { + .Deprecated("get_data") + get_data(...) +} +filterdata <- function(...) { + .Deprecated("filter_data") + filter_data(...) +} +combinedata <- function(...) { + .Deprecated("combine_data") + combine_data(...) +} +viewdata <- function(...) { + .Deprecated("view_data") + view_data(...) +} +toFct <- function(...) { + .Deprecated("to_fct") + to_fct(...) +} +fixMS <- function(...) { + .Deprecated("fix_smart") + fix_smart(...) +} +Search <- function(...) { + .Deprecated("search_data") + search_data(...) +} +formatnr <- function(...) { + .Deprecated("format_nr") + format_nr(...) +} +formatdf <- function(...) { + .Deprecated("format_df") + format_df(...) +} +rounddf <- function(...) { + .Deprecated("round_df") + round_df(...) +} +getclass <- function(...) { + .Deprecated("get_class") + get_class(...) +} +is_numeric <- function(...) { + .Deprecated("is_double") + is_double(...) +} +is_empty <- function(...) { + .Deprecated("is.empty") + is.empty(...) +} + +NULL diff --git a/radiant.data/R/explore.R b/radiant.data/R/explore.R new file mode 100644 index 0000000000000000000000000000000000000000..8d44fe9269be8b0b707ceaa0f806a6bca7d01416 --- /dev/null +++ b/radiant.data/R/explore.R @@ -0,0 +1,708 @@ +#' Explore and summarize data +#' +#' @details See \url{https://radiant-rstats.github.io/docs/data/explore.html} for an example in Radiant +#' +#' @param dataset Dataset to explore +#' @param vars (Numeric) variables to summarize +#' @param byvar Variable(s) to group data by +#' @param fun Functions to use for summarizing +#' @param top Use functions ("fun"), variables ("vars"), or group-by variables as column headers +#' @param tabfilt Expression used to filter the table (e.g., "Total > 10000") +#' @param tabsort Expression used to sort the table (e.g., "desc(Total)") +#' @param tabslice Expression used to filter table (e.g., "1:5") +#' @param nr Number of rows to display +#' @param data_filter Expression used to filter the dataset before creating the table (e.g., "price > 10000") +#' @param arr Expression to arrange (sort) the data on (e.g., "color, desc(price)") +#' @param rows Rows to select from the specified dataset +#' @param envir Environment to extract data from +#' +#' @return A list of all variables defined in the function as an object of class explore +#' +#' @examples +#' explore(diamonds, c("price", "carat")) %>% str() +#' explore(diamonds, "price:x")$tab +#' explore(diamonds, c("price", "carat"), byvar = "cut", fun = c("n_missing", "skew"))$tab +#' +#' @seealso See \code{\link{summary.explore}} to show summaries +#' +#' @export +explore <- function(dataset, vars = "", byvar = "", fun = c("mean", "sd"), + top = "fun", tabfilt = "", tabsort = "", tabslice = "", + nr = Inf, data_filter = "", arr = "", rows = NULL, + envir = parent.frame()) { + tvars <- vars + if (!is.empty(byvar)) tvars <- unique(c(tvars, byvar)) + + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, tvars, filt = data_filter, arr = arr, rows = rows, na.rm = FALSE, envir = envir) + rm(tvars) + + ## in case : was used + vars <- base::setdiff(colnames(dataset), byvar) + + ## converting data as needed for summarization + dc <- get_class(dataset) + fixer <- function(x, fun = as_integer) { + if (is.character(x) || is.Date(x)) { + x <- rep(NA, length(x)) + } else if (is.factor(x)) { + x_num <- sshhr(as.integer(as.character(x))) + if (length(na.omit(x_num)) == 0) { + x <- fun(x) + } else { + x <- x_num + } + } + x + } + fixer_first <- function(x) { + x <- fixer(x, function(x) as_integer(x == levels(x)[1])) + } + mean <- function(x, na.rm = TRUE) sshhr(base::mean(fixer_first(x), na.rm = na.rm)) + sum <- function(x, na.rm = TRUE) sshhr(base::sum(fixer_first(x), na.rm = na.rm)) + var <- function(x, na.rm = TRUE) sshhr(stats::var(fixer_first(x), na.rm = na.rm)) + sd <- function(x, na.rm = TRUE) sshhr(stats::sd(fixer_first(x), na.rm = na.rm)) + se <- function(x, na.rm = TRUE) sshhr(radiant.data::se(fixer_first(x), na.rm = na.rm)) + me <- function(x, na.rm = TRUE) sshhr(radiant.data::me(fixer_first(x), na.rm = na.rm)) + cv <- function(x, na.rm = TRUE) sshhr(radiant.data::cv(fixer_first(x), na.rm = na.rm)) + prop <- function(x, na.rm = TRUE) sshhr(radiant.data::prop(fixer_first(x), na.rm = na.rm)) + varprop <- function(x, na.rm = TRUE) sshhr(radiant.data::varprop(fixer_first(x), na.rm = na.rm)) + sdprop <- function(x, na.rm = TRUE) sshhr(radiant.data::sdprop(fixer_first(x), na.rm = na.rm)) + seprop <- function(x, na.rm = TRUE) sshhr(radiant.data::seprop(fixer_first(x), na.rm = na.rm)) + meprop <- function(x, na.rm = TRUE) sshhr(radiant.data::meprop(fixer_first(x), na.rm = na.rm)) + varpop <- function(x, na.rm = TRUE) sshhr(radiant.data::varpop(fixer_first(x), na.rm = na.rm)) + sdpop <- function(x, na.rm = TRUE) sshhr(radiant.data::sdpop(fixer_first(x), na.rm = na.rm)) + + median <- function(x, na.rm = TRUE) sshhr(stats::median(fixer(x), na.rm = na.rm)) + min <- function(x, na.rm = TRUE) sshhr(base::min(fixer(x), na.rm = na.rm)) + max <- function(x, na.rm = TRUE) sshhr(base::max(fixer(x), na.rm = na.rm)) + p01 <- function(x, na.rm = TRUE) sshhr(radiant.data::p01(fixer(x), na.rm = na.rm)) + p025 <- function(x, na.rm = TRUE) sshhr(radiant.data::p025(fixer(x), na.rm = na.rm)) + p05 <- function(x, na.rm = TRUE) sshhr(radiant.data::p05(fixer(x), na.rm = na.rm)) + p10 <- function(x, na.rm = TRUE) sshhr(radiant.data::p10(fixer(x), na.rm = na.rm)) + p25 <- function(x, na.rm = TRUE) sshhr(radiant.data::p25(fixer(x), na.rm = na.rm)) + p75 <- function(x, na.rm = TRUE) sshhr(radiant.data::p75(fixer(x), na.rm = na.rm)) + p90 <- function(x, na.rm = TRUE) sshhr(radiant.data::p90(fixer(x), na.rm = na.rm)) + p95 <- function(x, na.rm = TRUE) sshhr(radiant.data::p95(fixer(x), na.rm = na.rm)) + p975 <- function(x, na.rm = TRUE) sshhr(radiant.data::p975(fixer(x), na.rm = na.rm)) + p99 <- function(x, na.rm = TRUE) sshhr(radiant.data::p99(fixer(x), na.rm = na.rm)) + skew <- function(x, na.rm = TRUE) sshhr(radiant.data::skew(fixer(x), na.rm = na.rm)) + kurtosi <- function(x, na.rm = TRUE) sshhr(radiant.data::kurtosi(fixer(x), na.rm = na.rm)) + + isLogNum <- "logical" == dc & names(dc) %in% base::setdiff(vars, byvar) + if (sum(isLogNum) > 0) { + dataset[, isLogNum] <- select(dataset, which(isLogNum)) %>% + mutate_all(as.integer) + dc[isLogNum] <- "integer" + } + + if (is.empty(byvar)) { + byvar <- c() + tab <- summarise_all(dataset, fun, na.rm = TRUE) + } else { + + ## convert categorical variables to factors if needed + ## needed to deal with empty/missing values + dataset[, byvar] <- select_at(dataset, .vars = byvar) %>% + mutate_all(~ empty_level(.)) + + tab <- dataset %>% + group_by_at(.vars = byvar) %>% + summarise_all(fun, na.rm = TRUE) + } + + ## adjust column names + if (length(vars) == 1 || length(fun) == 1) { + rng <- (length(byvar) + 1):ncol(tab) + colnames(tab)[rng] <- paste0(vars, "_", fun) + rm(rng) + } + + ## setup regular expression to split variable/function column appropriately + rex <- paste0("(.*?)_", glue('({glue_collapse(fun, "$|")}$)')) + + ## useful answer and comments: http://stackoverflow.com/a/27880388/1974918 + tab <- gather(tab, "variable", "value", !!-(seq_along(byvar))) %>% + extract(variable, into = c("variable", "fun"), regex = rex) %>% + mutate(fun = factor(fun, levels = !!fun), variable = factor(variable, levels = vars)) %>% + # mutate(variable = paste0(variable, " {", dc[variable], "}")) %>% + spread("fun", "value") + + ## flip the table if needed + if (top != "fun") { + tab <- list(tab = tab, byvar = byvar, fun = fun) %>% + flip(top) + } + + nrow_tab <- nrow(tab) + + ## filtering the table if desired from Report > Rmd + if (!is.empty(tabfilt)) { + tab <- filter_data(tab, tabfilt) + } + + ## sorting the table if desired from Report > Rmd + if (!identical(tabsort, "")) { + tabsort <- gsub(",", ";", tabsort) + tab <- tab %>% arrange(!!!rlang::parse_exprs(tabsort)) + } + + ## ensure factors ordered as in the (sorted) table + if (!is.empty(byvar) && top != "byvar") { + for (i in byvar) tab[[i]] <- tab[[i]] %>% (function(x) factor(x, levels = unique(x))) + rm(i) + } + + ## frequencies converted to doubles during gather/spread above + check_int <- function(x) { + if (is.double(x) && length(na.omit(x)) > 0) { + x_int <- sshhr(as.integer(round(x, .Machine$double.rounding))) + if (isTRUE(all.equal(x, x_int, check.attributes = FALSE))) x_int else x + } else { + x + } + } + + tab <- ungroup(tab) %>% mutate_all(check_int) + + ## slicing the table if desired + if (!is.empty(tabslice)) { + tab <- tab %>% + slice_data(tabslice) %>% + droplevels() + } + + ## convert to data.frame to maintain attributes + tab <- as.data.frame(tab, stringsAsFactors = FALSE) + attr(tab, "radiant_nrow") <- nrow_tab + if (!isTRUE(is.infinite(nr))) { + ind <- if (nr > nrow(tab)) 1:nrow(tab) else 1:nr + tab <- tab[ind, , drop = FALSE] + rm(ind) + } + + list( + tab = tab, + df_name = df_name, + vars = vars, + byvar = byvar, + fun = fun, + top = top, + tabfilt = tabfilt, + tabsort = tabsort, + tabslice = tabslice, + nr = nr, + data_filter = data_filter, + arr = arr, + rows = rows + ) %>% add_class("explore") +} + +#' Summary method for the explore function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/data/explore.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{explore}} +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- explore(diamonds, "price:x") +#' summary(result) +#' result <- explore(diamonds, "price", byvar = "cut", fun = c("n_obs", "skew")) +#' summary(result) +#' explore(diamonds, "price:x", byvar = "color") %>% summary() +#' +#' @seealso \code{\link{explore}} to generate summaries +#' +#' @export +summary.explore <- function(object, dec = 3, ...) { + cat("Explore\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + if (!is.empty(object$arr)) { + cat("Arrange :", gsub("\\n", "", object$arr), "\n") + } + if (!is.empty(object$rows)) { + cat("Slice :", gsub("\\n", "", object$rows), "\n") + } + if (!is.empty(object$tabfilt)) { + cat("Table filter:", object$tabfilt, "\n") + } + if (!is.empty(object$tabsort[1])) { + cat("Table sorted:", paste0(object$tabsort, collapse = ", "), "\n") + } + if (!is.empty(object$tabslice)) { + cat("Table slice :", object$tabslice, "\n") + } + nr <- attr(object$tab, "radiant_nrow") + if (!isTRUE(is.infinite(nr)) && !isTRUE(is.infinite(object$nr)) && object$nr < nr) { + cat(paste0("Rows shown : ", object$nr, " (out of ", nr, ")\n")) + } + if (!is.empty(object$byvar[1])) { + cat("Grouped by :", object$byvar, "\n") + } + cat("Functions :", paste0(object$fun, collapse = ", "), "\n") + cat("Top :", c("fun" = "Function", "var" = "Variables", "byvar" = "Group by")[object$top], "\n") + cat("\n") + + format_df(object$tab, dec = dec, mark = ",") %>% + print(row.names = FALSE) + invisible() +} + +#' Deprecated: Store method for the explore function +#' +#' @details Return the summarized data. See \url{https://radiant-rstats.github.io/docs/data/explore.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param object Return value from \code{\link{explore}} +#' @param name Name to assign to the dataset +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{explore}} to generate summaries +#' +#' @export +store.explore <- function(dataset, object, name, ...) { + if (missing(name)) { + object$tab + } else { + stop( + paste0( + "This function is deprecated. Use the code below instead:\n\n", + name, " <- ", deparse(substitute(object)), "$tab\nregister(\"", + name, ")" + ), + call. = FALSE + ) + } +} + +#' Flip the DT table to put Function, Variable, or Group by on top +#' +#' @details See \url{https://radiant-rstats.github.io/docs/data/explore.html} for an example in Radiant +#' +#' @param expl Return value from \code{\link{explore}} +#' @param top The variable (type) to display at the top of the table ("fun" for Function, "var" for Variable, and "byvar" for Group by. "fun" is the default +#' +#' @examples +#' explore(diamonds, "price:x", top = "var") %>% summary() +#' explore(diamonds, "price", byvar = "cut", fun = c("n_obs", "skew"), top = "byvar") %>% summary() +#' +#' @seealso \code{\link{explore}} to calculate summaries +#' @seealso \code{\link{summary.explore}} to show summaries +#' @seealso \code{\link{dtab.explore}} to create the DT table +#' +#' @export +flip <- function(expl, top = "fun") { + cvars <- expl$byvar %>% + (function(x) if (is.empty(x[1])) character(0) else x) + if (top[1] == "var") { + expl$tab %<>% gather(".function", "value", !!-(1:(length(cvars) + 1))) %>% + spread("variable", "value") + expl$tab[[".function"]] %<>% factor(., levels = expl$fun) + } else if (top[1] == "byvar" && length(cvars) > 0) { + expl$tab %<>% gather(".function", "value", !!-(1:(length(cvars) + 1))) %>% + spread(!!cvars[1], "value") + expl$tab[[".function"]] %<>% factor(., levels = expl$fun) + + ## ensure we don't have invalid column names + colnames(expl$tab) <- fix_names(colnames(expl$tab)) + } + + expl$tab +} + +#' Make an interactive table of summary statistics +#' +#' @details See \url{https://radiant-rstats.github.io/docs/data/explore.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{explore}} +#' @param dec Number of decimals to show +#' @param searchCols Column search and filter +#' @param order Column sorting +#' @param pageLength Page length +#' @param caption Table caption +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' \dontrun{ +#' tab <- explore(diamonds, "price:x") %>% dtab() +#' tab <- explore(diamonds, "price", byvar = "cut", fun = c("n_obs", "skew"), top = "byvar") %>% +#' dtab() +#' } +#' +#' @seealso \code{\link{pivotr}} to create a pivot table +#' @seealso \code{\link{summary.pivotr}} to show summaries +#' +#' @export +dtab.explore <- function(object, dec = 3, searchCols = NULL, + order = NULL, pageLength = NULL, + caption = NULL, ...) { + style <- if (exists("bslib_current_version") && "4" %in% bslib_current_version()) "bootstrap4" else "bootstrap" + tab <- object$tab + cn_all <- colnames(tab) + cn_num <- cn_all[sapply(tab, is.numeric)] + cn_cat <- cn_all[-which(cn_all %in% cn_num)] + isInt <- sapply(tab, is.integer) + isDbl <- sapply(tab, is_double) + dec <- ifelse(is.empty(dec) || dec < 0, 3, round(dec, 0)) + + top <- c("fun" = "Function", "var" = "Variables", "byvar" = paste0("Group by: ", object$byvar[1]))[object$top] + sketch <- shiny::withTags( + table( + thead( + tr( + th(" ", colspan = length(cn_cat)), + lapply(top, th, colspan = length(cn_num), class = "text-center") + ), + tr(lapply(cn_all, th)) + ) + ) + ) + + if (!is.empty(caption)) { + ## from https://github.com/rstudio/DT/issues/630#issuecomment-461191378 + caption <- shiny::tags$caption(style = "caption-side: bottom; text-align: left; font-size:100%;", caption) + } + + ## for display options see https://datatables.net/reference/option/dom + dom <- if (nrow(tab) < 11) "t" else "ltip" + fbox <- if (nrow(tab) > 5e6) "none" else list(position = "top") + dt_tab <- DT::datatable( + tab, + container = sketch, + caption = caption, + selection = "none", + rownames = FALSE, + filter = fbox, + ## must use fillContainer = FALSE to address + ## see https://github.com/rstudio/DT/issues/367 + ## https://github.com/rstudio/DT/issues/379 + fillContainer = FALSE, + style = style, + options = list( + dom = dom, + stateSave = TRUE, ## store state + searchCols = searchCols, + order = order, + columnDefs = list(list(orderSequence = c("desc", "asc"), targets = "_all")), + autoWidth = TRUE, + processing = FALSE, + pageLength = { + if (is.null(pageLength)) 10 else pageLength + }, + lengthMenu = list(c(5, 10, 25, 50, -1), c("5", "10", "25", "50", "All")) + ), + ## https://github.com/rstudio/DT/issues/146#issuecomment-534319155 + callback = DT::JS('$(window).on("unload", function() { table.state.clear(); })') + ) %>% + DT::formatStyle(., cn_cat, color = "white", backgroundColor = "grey") + + ## rounding as needed + if (sum(isDbl) > 0) { + dt_tab <- DT::formatRound(dt_tab, names(isDbl)[isDbl], dec) + } + if (sum(isInt) > 0) { + dt_tab <- DT::formatRound(dt_tab, names(isInt)[isInt], 0) + } + + ## see https://github.com/yihui/knitr/issues/1198 + dt_tab$dependencies <- c( + list(rmarkdown::html_dependency_bootstrap("bootstrap")), + dt_tab$dependencies + ) + + dt_tab +} + +########################################### +## turn functions below into functional ... +########################################### + +#' Number of observations +#' @param x Input variable +#' @param ... Additional arguments +#' @return number of observations +#' @examples +#' n_obs(c("a", "b", NA)) +#' +#' @export +n_obs <- function(x, ...) length(x) + +#' Number of missing values +#' @param x Input variable +#' @param ... Additional arguments +#' @return number of missing values +#' @examples +#' n_missing(c("a", "b", NA)) +#' +#' @export +n_missing <- function(x, ...) sum(is.na(x)) + +#' Calculate percentiles +#' @param x Numeric vector +#' @param na.rm If TRUE missing values are removed before calculation +#' @examples +#' p01(0:100) +#' +#' @rdname percentiles +#' @export +p01 <- function(x, na.rm = TRUE) quantile(x, .01, na.rm = na.rm) + +#' @rdname percentiles +#' @export +p025 <- function(x, na.rm = TRUE) quantile(x, .025, na.rm = na.rm) + +#' @rdname percentiles +#' @export +p05 <- function(x, na.rm = TRUE) quantile(x, .05, na.rm = na.rm) + +#' @rdname percentiles +#' @export +p10 <- function(x, na.rm = TRUE) quantile(x, .1, na.rm = na.rm) + +#' @rdname percentiles +#' @export +p25 <- function(x, na.rm = TRUE) quantile(x, .25, na.rm = na.rm) + +#' @rdname percentiles +#' @export +p75 <- function(x, na.rm = TRUE) quantile(x, .75, na.rm = na.rm) + +#' @rdname percentiles +#' @export +p90 <- function(x, na.rm = TRUE) quantile(x, .90, na.rm = na.rm) + +#' @rdname percentiles +#' @export +p95 <- function(x, na.rm = TRUE) quantile(x, .95, na.rm = na.rm) + +#' @rdname percentiles +#' @export +p975 <- function(x, na.rm = TRUE) quantile(x, .975, na.rm = na.rm) + +#' @rdname percentiles +#' @export +p99 <- function(x, na.rm = TRUE) quantile(x, .99, na.rm = na.rm) + +#' Coefficient of variation +#' @param x Input variable +#' @param na.rm If TRUE missing values are removed before calculation +#' @return Coefficient of variation +#' @examples +#' cv(runif(100)) +#' +#' @export +cv <- function(x, na.rm = TRUE) { + m <- mean(x, na.rm = na.rm) + if (m == 0) { + message("Mean should be greater than 0") + NA + } else { + sd(x, na.rm = na.rm) / m + } +} + +#' Standard error +#' @param x Input variable +#' @param na.rm If TRUE missing values are removed before calculation +#' @return Standard error +#' @examples +#' se(rnorm(100)) +#' +#' @export +se <- function(x, na.rm = TRUE) { + if (na.rm) x <- na.omit(x) + sd(x) / sqrt(length(x)) +} + +#' Margin of error +#' @param x Input variable +#' @param conf_lev Confidence level. The default is 0.95 +#' @param na.rm If TRUE missing values are removed before calculation +#' @return Margin of error +#' +#' @importFrom stats qt +#' +#' @examples +#' me(rnorm(100)) +#' +#' @export +me <- function(x, conf_lev = 0.95, na.rm = TRUE) { + if (na.rm) x <- na.omit(x) + se(x) * qt(conf_lev / 2 + .5, length(x) - 1, lower.tail = TRUE) +} + +#' Calculate proportion +#' @param x Input variable +#' @param na.rm If TRUE missing values are removed before calculation +#' @return Proportion of first level for a factor and of the maximum value for numeric +#' @examples +#' prop(c(rep(1L, 10), rep(0L, 10))) +#' prop(c(rep(4, 10), rep(2, 10))) +#' prop(rep(0, 10)) +#' prop(factor(c(rep("a", 20), rep("b", 10)))) +#' +#' @export +prop <- function(x, na.rm = TRUE) { + if (na.rm) x <- na.omit(x) + if (is.numeric(x)) { + mean(x == max(x, 1)) ## gives proportion of max value in x + } else if (is.factor(x)) { + mean(x == levels(x)[1]) ## gives proportion of first level in x + } else if (is.logical(x)) { + mean(x) + } else { + NA + } +} + +#' Variance for proportion +#' @param x Input variable +#' @param na.rm If TRUE missing values are removed before calculation +#' @return Variance for proportion +#' @examples +#' varprop(c(rep(1L, 10), rep(0L, 10))) +#' +#' @export +varprop <- function(x, na.rm = TRUE) { + p <- prop(x, na.rm = na.rm) + p * (1 - p) +} + +#' Standard deviation for proportion +#' @param x Input variable +#' @param na.rm If TRUE missing values are removed before calculation +#' @return Standard deviation for proportion +#' @examples +#' sdprop(c(rep(1L, 10), rep(0L, 10))) +#' +#' @export +sdprop <- function(x, na.rm = TRUE) sqrt(varprop(x, na.rm = na.rm)) + +#' Standard error for proportion +#' @param x Input variable +#' @param na.rm If TRUE missing values are removed before calculation +#' @return Standard error for proportion +#' @examples +#' seprop(c(rep(1L, 10), rep(0L, 10))) +#' +#' @export +seprop <- function(x, na.rm = TRUE) { + if (na.rm) x <- na.omit(x) + sqrt(varprop(x, na.rm = FALSE) / length(x)) +} + +#' Margin of error for proportion +#' @param x Input variable +#' @param conf_lev Confidence level. The default is 0.95 +#' @param na.rm If TRUE missing values are removed before calculation +#' @return Margin of error +#' +#' @importFrom stats qnorm +#' +#' @examples +#' meprop(c(rep(1L, 10), rep(0L, 10))) +#' +#' @export +meprop <- function(x, conf_lev = 0.95, na.rm = TRUE) { + if (na.rm) x <- na.omit(x) + seprop(x) * qnorm(conf_lev / 2 + .5, lower.tail = TRUE) +} + +#' Variance for the population +#' @param x Input variable +#' @param na.rm If TRUE missing values are removed before calculation +#' @return Variance for the population +#' @examples +#' varpop(rnorm(100)) +#' +#' @export +varpop <- function(x, na.rm = TRUE) { + if (na.rm) x <- na.omit(x) + n <- length(x) + var(x) * ((n - 1) / n) +} + +#' Standard deviation for the population +#' @param x Input variable +#' @param na.rm If TRUE missing values are removed before calculation +#' @return Standard deviation for the population +#' @examples +#' sdpop(rnorm(100)) +#' +#' @export +sdpop <- function(x, na.rm = TRUE) sqrt(varpop(x, na.rm = na.rm)) + +#' Natural log +#' @param x Input variable +#' @param na.rm Remove missing values (default is TRUE) +#' @return Natural log of vector +#' @examples +#' ln(runif(10, 1, 2)) +#' +#' @export +ln <- function(x, na.rm = TRUE) { + if (na.rm) log(na.omit(x)) else log(x) +} + +#' Does a vector have non-zero variability? +#' @param x Input variable +#' @param na.rm If TRUE missing values are removed before calculation +#' @return Logical. TRUE is there is variability +#' @examples +#' summarise_all(diamonds, does_vary) %>% as.logical() +#' +#' @export +does_vary <- function(x, na.rm = TRUE) { + ## based on http://stackoverflow.com/questions/4752275/test-for-equality-among-all-elements-of-a-single-vector + if (length(x) == 1L) { + FALSE + } else { + if (is.factor(x) || is.character(x)) { + length(unique(x)) > 1 + } else { + abs(max(x, na.rm = na.rm) - min(x, na.rm = na.rm)) > .Machine$double.eps^0.5 + } + } +} + +#' Convert categorical variables to factors and deal with empty/missing values +#' @param x Categorical variable used in table +#' @return Variable with updated levels +#' @export +empty_level <- function(x) { + if (!is.factor(x)) x <- as.factor(x) + levs <- levels(x) + if ("" %in% levs) { + levs[levs == ""] <- "NA" + x <- factor(x, levels = levs) + x[is.na(x)] <- "NA" + } else if (any(is.na(x))) { + x <- factor(x, levels = unique(c(levs, "NA"))) + x[is.na(x)] <- "NA" + } + x +} + +#' Calculate the mode (modal value) and return a label +#' +#' @details From https://www.tutorialspoint.com/r/r_mean_median_mode.htm +#' @param x A vector +#' @param na.rm If TRUE missing values are removed before calculation +#' +#' @examples +#' modal(c("a", "b", "b")) +#' modal(c(1:10, 5)) +#' modal(as.factor(c(letters, "b"))) +#' modal(runif(100) > 0.5) +#' +#' @export +modal <- function(x, na.rm = TRUE) { + if (na.rm) x <- na.omit(x) + unv <- unique(x) + unv[which.max(tabulate(match(x, unv)))] +} diff --git a/radiant.data/R/for.shinyapps.io.R b/radiant.data/R/for.shinyapps.io.R new file mode 100644 index 0000000000000000000000000000000000000000..14ab46e6a4edffc93a646bd2fddacc714aad6133 --- /dev/null +++ b/radiant.data/R/for.shinyapps.io.R @@ -0,0 +1,29 @@ +# ## install the latest version from github so it will be used on shinyapps.io +# packages <- "radiant-rstats/radiant.data" +# packages <- c(packages, "trestletech/shinyAce", "thomasp85/shinyFiles") +# +# ## Use the code below to install the development version +# if (!require(remotes)) { +# install.packages("remotes") +# } +# ret <- sapply( +# packages, +# function(p) { +# remotes::install_github( +# p, +# dependencies = FALSE, +# upgrade = "never" +# ) +# } +# ) +# +# # install.packages("htmltools", repo = "https://cloud.r-project.org/") +# +# ## by listing the call to the radiant library it will get picked up as a dependency +# library(radiant) +# library(radiant.data) +# library(rstudioapi) +# library(shinyAce) +# library(shinyFiles) +# library(DT) +# library(htmltools) diff --git a/radiant.data/R/manage.R b/radiant.data/R/manage.R new file mode 100644 index 0000000000000000000000000000000000000000..e7fdd79f52192b8a416345b08ff776ba52768db9 --- /dev/null +++ b/radiant.data/R/manage.R @@ -0,0 +1,88 @@ +#' Load data through clipboard on Windows or macOS +#' +#' @details Extract data from the clipboard into a data.frame on Windows or macOS +#' @param delim Delimiter to use (tab is the default) +#' @param text Text input to convert to table +#' @param suppress Suppress warnings +#' @seealso See the \code{\link{save_clip}} +#' @export +load_clip <- function(delim = "\t", text, suppress = TRUE) { + sw <- if (suppress) suppressWarnings else function(x) x + sw( + try( + { + os_type <- Sys.info()["sysname"] + if (os_type == "Windows") { + dataset <- read.table( + "clipboard", + header = TRUE, sep = delim, + comment.char = "", fill = TRUE, as.is = TRUE, + check.names = FALSE + ) + } else if (os_type == "Darwin") { + dataset <- read.table( + pipe("pbpaste"), + header = TRUE, sep = delim, + comment.char = "", fill = TRUE, as.is = TRUE, + check.names = FALSE + ) + } else if (os_type == "Linux") { + if (missing(text) || is.empty(text)) { + message("Loading data through clipboard is currently only supported on Windows and macOS") + return(invisible()) + } else { + dataset <- read.table( + text = text, header = TRUE, sep = delim, + comment.char = "", fill = TRUE, as.is = TRUE, + check.names = FALSE + ) + } + } + as.data.frame(dataset, check.names = FALSE, stringsAsFactors = FALSE) %>% + radiant.data::to_fct() + }, + silent = TRUE + ) + ) +} + +#' Save data to clipboard on Windows or macOS +#' +#' @details Save a data.frame or tibble to the clipboard on Windows or macOS +#' @param dataset Dataset to save to clipboard +#' @seealso See the \code{\link{load_clip}} +#' @export +save_clip <- function(dataset) { + os_type <- Sys.info()["sysname"] + if (os_type == "Windows") { + write.table(dataset, "clipboard-10000", sep = "\t", row.names = FALSE) + } else if (os_type == "Darwin") { + write.table(dataset, file = pipe("pbcopy"), sep = "\t", row.names = FALSE) + } else if (os_type == "Linux") { + message("Saving data to clipboard is currently only supported on Windows and macOS.\nSave data to csv for use in a spreadsheet") + } + invisible() +} + +#' Ensure column names are valid +#' +#' @details Remove symbols, trailing and leading spaces, and convert to valid R column names. Opinionated version of \code{\link{make.names}} +#' @param x Data.frame or vector of (column) names +#' @param lower Set letters to lower case (TRUE or FALSE) +#' @examples +#' fix_names(c(" var-name ", "$amount spent", "100")) +#' @export +fix_names <- function(x, lower = FALSE) { + isdf <- is.data.frame(x) + cn <- if (isdf) colnames(x) else x + cn <- gsub("(^\\s+|\\s+$)", "", cn) %>% + gsub("\\s+", "_", .) %>% + gsub("[[:punct:]]", "_", .) %>% + gsub("^[[:punct:]]", "", .) %>% + make.names(unique = TRUE) %>% + gsub("\\.{2,}", ".", .) %>% + gsub("_{2,}", "_", .) %>% + make.names(unique = TRUE) %>% ## used twice to make sure names are still unique + (function(x) if (lower) tolower(x) else x) + if (isdf) stats::setNames(x, cn) else cn +} \ No newline at end of file diff --git a/radiant.data/R/pivotr.R b/radiant.data/R/pivotr.R new file mode 100644 index 0000000000000000000000000000000000000000..9103605b0faa6d21554a22e395489db9d62f99a5 --- /dev/null +++ b/radiant.data/R/pivotr.R @@ -0,0 +1,572 @@ +#' Create a pivot table +#' +#' @details Create a pivot-table. See \url{https://radiant-rstats.github.io/docs/data/pivotr.html} for an example in Radiant +#' +#' @param dataset Dataset to tabulate +#' @param cvars Categorical variables +#' @param nvar Numerical variable +#' @param fun Function to apply to numerical variable +#' @param normalize Normalize the table by row total, column totals, or overall total +#' @param tabfilt Expression used to filter the table (e.g., "Total > 10000") +#' @param tabsort Expression used to sort the table (e.g., "desc(Total)") +#' @param tabslice Expression used to filter table (e.g., "1:5") +#' @param nr Number of rows to display +#' @param data_filter Expression used to filter the dataset before creating the table (e.g., "price > 10000") +#' @param arr Expression to arrange (sort) the data on (e.g., "color, desc(price)") +#' @param rows Rows to select from the specified dataset +#' @param envir Environment to extract data from +#' +#' @examples +#' pivotr(diamonds, cvars = "cut") %>% str() +#' pivotr(diamonds, cvars = "cut")$tab +#' pivotr(diamonds, cvars = c("cut", "clarity", "color"))$tab +#' pivotr(diamonds, cvars = "cut:clarity", nvar = "price")$tab +#' pivotr(diamonds, cvars = "cut", nvar = "price")$tab +#' pivotr(diamonds, cvars = "cut", normalize = "total")$tab +#' +#' @export +pivotr <- function(dataset, cvars = "", nvar = "None", fun = "mean", + normalize = "None", tabfilt = "", tabsort = "", tabslice = "", + nr = Inf, data_filter = "", arr = "", rows = NULL, envir = parent.frame()) { + vars <- if (nvar == "None") cvars else c(cvars, nvar) + fill <- if (nvar == "None") 0L else NA + + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, na.rm = FALSE, envir = envir) + + ## in case : was used for cvars + cvars <- base::setdiff(colnames(dataset), nvar) + + if (nvar == "None") { + nvar <- "n_obs" + } else { + fixer <- function(x, fun = as_integer) { + if (is.character(x) || is.Date(x)) { + x <- rep(NA, length(x)) + } else if (is.factor(x)) { + x_num <- sshhr(as.integer(as.character(x))) + if (length(na.omit(x_num)) == 0) { + x <- fun(x) + } else { + x <- x_num + } + } + x + } + fixer_first <- function(x) { + x <- fixer(x, function(x) as_integer(x == levels(x)[1])) + } + if (fun %in% c("mean", "sum", "sd", "var", "sd", "se", "me", "cv", "prop", "varprop", "sdprop", "seprop", "meprop", "varpop", "sepop")) { + dataset[[nvar]] <- fixer_first(dataset[[nvar]]) + } else if (fun %in% c("median", "min", "max", "p01", "p025", "p05", "p10", "p25", "p50", "p75", "p90", "p95", "p975", "p99", "skew", "kurtosi")) { + dataset[[nvar]] <- fixer(dataset[[nvar]]) + } + rm(fixer, fixer_first) + if ("logical" %in% class(dataset[[nvar]])) { + dataset[[nvar]] %<>% as.integer() + } + } + + ## convert categorical variables to factors and deal with empty/missing values + dataset <- mutate_at(dataset, .vars = cvars, .funs = empty_level) + + sel <- function(x, nvar, cvar = c()) { + if (nvar == "n_obs") x else select_at(x, .vars = c(nvar, cvar)) + } + sfun <- function(x, nvar, cvars = "", fun = fun) { + if (nvar == "n_obs") { + if (is.empty(cvars)) { + count(x) %>% dplyr::rename("n_obs" = "n") + } else { + count(select_at(x, .vars = cvars)) %>% dplyr::rename("n_obs" = "n") + } + } else { + dataset <- mutate_at(x, .vars = nvar, .funs = as.numeric) %>% + summarise_at(.vars = nvar, .funs = fun, na.rm = TRUE) + colnames(dataset)[ncol(dataset)] <- nvar + dataset + } + } + + ## main tab + tab <- dataset %>% + group_by_at(.vars = cvars) %>% + sfun(nvar, cvars, fun) + + ## total + total <- dataset %>% + sel(nvar) %>% + sfun(nvar, fun = fun) + + ## row and column totals + if (length(cvars) == 1) { + tab <- + bind_rows( + mutate_at(ungroup(tab), .vars = cvars, .funs = as.character), + bind_cols( + data.frame("Total", stringsAsFactors = FALSE) %>% + setNames(cvars), total %>% + set_colnames(nvar) + ) + ) + } else { + col_total <- + group_by_at(dataset, .vars = cvars[1]) %>% + sel(nvar, cvars[1]) %>% + sfun(nvar, cvars[1], fun) %>% + ungroup() %>% + mutate_at(.vars = cvars[1], .funs = as.character) + + row_total <- + group_by_at(dataset, .vars = cvars[-1]) %>% + sfun(nvar, cvars[-1], fun) %>% + ungroup() %>% + select(ncol(.)) %>% + bind_rows(total) %>% + set_colnames("Total") + + ## creating cross tab + tab <- spread(tab, !!cvars[1], !!nvar, fill = fill) %>% + ungroup() %>% + mutate_at(.vars = cvars[-1], .funs = as.character) + + tab <- bind_rows( + tab, + bind_cols( + t(rep("Total", length(cvars[-1]))) %>% + as.data.frame(stringsAsFactors = FALSE) %>% + setNames(cvars[-1]), + data.frame(t(col_total[[2]]), stringsAsFactors = FALSE) %>% + set_colnames(col_total[[1]]) + ) + ) %>% bind_cols(row_total) + + rm(col_total, row_total, vars) + } + + ## resetting factor levels + ind <- ifelse(length(cvars) > 1, -1, 1) + levs <- lapply(select_at(dataset, .vars = cvars[ind]), levels) + + for (i in cvars[ind]) { + tab[[i]] %<>% factor(levels = unique(c(levs[[i]], "Total"))) + } + + ## frequency table for chi-square test + tab_freq <- tab + + isNum <- if (length(cvars) == 1) -1 else -c(1:(length(cvars) - 1)) + if (normalize == "total") { + tab[, isNum] %<>% (function(x) x / total[[1]]) + } else if (normalize == "row") { + if (!is.null(tab[["Total"]])) { + tab[, isNum] %<>% (function(x) x / x[["Total"]]) + } + } else if (length(cvars) > 1 && normalize == "column") { + tab[, isNum] %<>% apply(2, function(.) . / .[which(tab[, 1] == "Total")]) + } + + nrow_tab <- nrow(tab) - 1 + + ## ensure we don't have invalid column names + ## but skip variable names already being used + cn <- colnames(tab) + cni <- cn %in% setdiff(cn, c(cvars, nvar)) + colnames(tab)[cni] <- fix_names(cn[cni]) + + ## filtering the table if desired + if (!is.empty(tabfilt)) { + tab <- tab[-nrow(tab), ] %>% + filter_data(tabfilt, drop = FALSE) %>% + bind_rows(tab[nrow(tab), ]) %>% + droplevels() + } + + ## sorting the table if desired + if (!is.empty(tabsort, "")) { + tabsort <- gsub(",", ";", tabsort) + tab[-nrow(tab), ] %<>% arrange(!!!rlang::parse_exprs(tabsort)) + + ## order factors as set in the sorted table + tc <- if (length(cvars) == 1) cvars else cvars[-1] ## don't change top cv + for (i in tc) { + tab[[i]] %<>% factor(., levels = unique(.)) + } + } + + ## slicing the table if desired + if (!is.empty(tabslice)) { + tab <- tab %>% + slice_data(tabslice) %>% + bind_rows(tab[nrow(tab), , drop = FALSE]) %>% + droplevels() + } + + tab <- as.data.frame(tab, stringsAsFactors = FALSE) + attr(tab, "radiant_nrow") <- nrow_tab + if (!isTRUE(is.infinite(nr))) { + ind <- if (nr >= nrow(tab)) 1:nrow(tab) else c(1:nr, nrow(tab)) + tab <- tab[ind, , drop = FALSE] + } + + rm(isNum, dataset, sfun, sel, i, levs, total, ind, nrow_tab, envir) + + as.list(environment()) %>% add_class("pivotr") +} + +#' Summary method for pivotr +#' +#' @details See \url{https://radiant-rstats.github.io/docs/data/pivotr.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{pivotr}} +#' @param perc Display numbers as percentages (TRUE or FALSE) +#' @param dec Number of decimals to show +#' @param chi2 If TRUE calculate the chi-square statistic for the (pivot) table +#' @param shiny Did the function call originate inside a shiny app +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' pivotr(diamonds, cvars = "cut") %>% summary(chi2 = TRUE) +#' pivotr(diamonds, cvars = "cut", tabsort = "desc(n_obs)") %>% summary() +#' pivotr(diamonds, cvars = "cut", tabfilt = "n_obs > 700") %>% summary() +#' pivotr(diamonds, cvars = "cut:clarity", nvar = "price") %>% summary() +#' +#' @seealso \code{\link{pivotr}} to create the pivot-table using dplyr +#' +#' @export +summary.pivotr <- function(object, perc = FALSE, dec = 3, + chi2 = FALSE, shiny = FALSE, ...) { + if (!shiny) { + cat("Pivot table\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + if (!is.empty(object$arr)) { + cat("Arrange :", gsub("\\n", "", object$arr), "\n") + } + if (!is.empty(object$rows)) { + cat("Slice :", gsub("\\n", "", object$rows), "\n") + } + if (!is.empty(object$tabfilt)) { + cat("Table filter:", object$tabfilt, "\n") + } + if (!is.empty(object$tabsort[1])) { + cat("Table sorted:", paste0(object$tabsort, collapse = ", "), "\n") + } + if (!is.empty(object$tabslice)) { + cat("Table slice :", object$tabslice, "\n") + } + nr <- attr(object$tab, "radiant_nrow") + if (!isTRUE(is.infinite(nr)) && !isTRUE(is.infinite(object$nr)) && object$nr < nr) { + cat(paste0("Rows shown : ", object$nr, " (out of ", nr, ")\n")) + } + cat("Categorical :", object$cvars, "\n") + if (object$normalize != "None") { + cat("Normalize by:", object$normalize, "\n") + } + if (object$nvar != "n_obs") { + cat("Numeric :", object$nvar, "\n") + cat("Function :", object$fun, "\n") + } + cat("\n") + print(format_df(object$tab, dec, perc, mark = ","), row.names = FALSE) + cat("\n") + } + + if (chi2) { + if (length(object$cvars) < 3) { + cst <- object$tab_freq %>% + filter(.[[1]] != "Total") %>% + select(-which(names(.) %in% c(object$cvars, "Total"))) %>% + mutate_all(~ ifelse(is.na(.), 0, .)) %>% + { + sshhr(chisq.test(., correct = FALSE)) + } + + res <- tidy(cst) + if (dec < 4 && res$p.value < .001) { + p.value <- "< .001" + } else { + p.value <- format_nr(res$p.value, dec = dec) + } + res <- round_df(res, dec) + + l1 <- paste0("Chi-squared: ", res$statistic, " df(", res$parameter, "), p.value ", p.value, "\n") + l2 <- paste0(sprintf("%.1f", 100 * (sum(cst$expected < 5) / length(cst$expected))), "% of cells have expected values below 5\n") + if (nrow(object$tab_freq) == nrow(object$tab)) { + if (shiny) HTML(paste0("
", l1, "
", l2)) else cat(paste0(l1, l2)) + } else { + note <- "\nNote: Test conducted on unfiltered table" + if (shiny) HTML(paste0("
", l1, "
", l2, "
", note)) else cat(paste0(l1, l2, note)) + } + } else { + cat("The number of categorical variables should be 1 or 2 for Chi-square") + } + } +} + +#' Make an interactive pivot table +#' +#' @details See \url{https://radiant-rstats.github.io/docs/data/pivotr.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{pivotr}} +#' @param format Show Color bar ("color_bar"), Heat map ("heat"), or None ("none") +#' @param perc Display numbers as percentages (TRUE or FALSE) +#' @param dec Number of decimals to show +#' @param searchCols Column search and filter +#' @param order Column sorting +#' @param pageLength Page length +#' @param caption Table caption +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' \dontrun{ +#' pivotr(diamonds, cvars = "cut") %>% dtab() +#' pivotr(diamonds, cvars = c("cut", "clarity")) %>% dtab(format = "color_bar") +#' pivotr(diamonds, cvars = c("cut", "clarity"), normalize = "total") %>% +#' dtab(format = "color_bar", perc = TRUE) +#' } +#' +#' @seealso \code{\link{pivotr}} to create the pivot table +#' @seealso \code{\link{summary.pivotr}} to print the table +#' +#' @export +dtab.pivotr <- function(object, format = "none", perc = FALSE, dec = 3, + searchCols = NULL, order = NULL, pageLength = NULL, + caption = NULL, ...) { + style <- if (exists("bslib_current_version") && "4" %in% bslib_current_version()) "bootstrap4" else "bootstrap" + tab <- object$tab + cvar <- object$cvars[1] + cvars <- object$cvars %>% + (function(x) if (length(x) > 1) x[-1] else x) + cn <- colnames(tab) %>% + (function(x) x[-which(cvars %in% x)]) + + ## for rounding + isDbl <- sapply(tab, is_double) + isInt <- sapply(tab, is.integer) + dec <- ifelse(is.empty(dec) || dec < 0, 3, round(dec, 0)) + + ## column names without total + cn_nt <- if ("Total" %in% cn) cn[-which(cn == "Total")] else cn + + tot <- tail(tab, 1)[-(1:length(cvars))] %>% + format_df(perc = perc, dec = dec, mark = ",") + + if (length(cvars) == 1 && cvar == cvars) { + sketch <- shiny::withTags(table( + thead(tr(lapply(c(cvars, cn), th))), + tfoot(tr(lapply(c("Total", tot), th))) + )) + } else { + sketch <- shiny::withTags(table( + thead( + tr(th(colspan = length(c(cvars, cn)), cvar, class = "dt-center")), + tr(lapply(c(cvars, cn), th)) + ), + tfoot( + tr(th(colspan = length(cvars), "Total"), lapply(tot, th)) + ) + )) + } + + if (!is.empty(caption)) { + ## from https://github.com/rstudio/DT/issues/630#issuecomment-461191378 + caption <- shiny::tags$caption(style = "caption-side: bottom; text-align: left; font-size:100%;", caption) + } + + + ## remove row with column totals + ## should perhaps be part of pivotr but convenient for now in tfoot + ## and for external calls to pivotr + tab <- filter(tab, tab[[1]] != "Total") + ## for display options see https://datatables.net/reference/option/dom + dom <- if (nrow(tab) < 11) "t" else "ltip" + fbox <- if (nrow(tab) > 5e6) "none" else list(position = "top") + dt_tab <- DT::datatable( + tab, + container = sketch, + caption = caption, + selection = "none", + rownames = FALSE, + filter = fbox, + ## must use fillContainer = FALSE to address + ## see https://github.com/rstudio/DT/issues/367 + ## https://github.com/rstudio/DT/issues/379 + fillContainer = FALSE, + style = style, + options = list( + dom = dom, + stateSave = TRUE, ## store state + searchCols = searchCols, + order = order, + columnDefs = list(list(orderSequence = c("desc", "asc"), targets = "_all")), + autoWidth = TRUE, + processing = FALSE, + pageLength = { + if (is.null(pageLength)) 10 else pageLength + }, + lengthMenu = list(c(5, 10, 25, 50, -1), c("5", "10", "25", "50", "All")) + ), + ## https://github.com/rstudio/DT/issues/146#issuecomment-534319155 + callback = DT::JS('$(window).on("unload", function() { table.state.clear(); })') + ) %>% + DT::formatStyle(., cvars, color = "white", backgroundColor = "grey") %>% + (function(x) if ("Total" %in% cn) DT::formatStyle(x, "Total", fontWeight = "bold") else x) + + ## heat map with red or color_bar + if (format == "color_bar") { + dt_tab <- DT::formatStyle( + dt_tab, + cn_nt, + background = DT::styleColorBar(range(tab[, cn_nt], na.rm = TRUE), "lightblue"), + backgroundSize = "98% 88%", + backgroundRepeat = "no-repeat", + backgroundPosition = "center" + ) + } else if (format == "heat") { + ## round seems to ensure that 'cuts' are ordered according to DT::stylInterval + brks <- quantile(tab[, cn_nt], probs = seq(.05, .95, .05), na.rm = TRUE) %>% round(5) + clrs <- seq(255, 40, length.out = length(brks) + 1) %>% + round(0) %>% + (function(x) paste0("rgb(255,", x, ",", x, ")")) + + dt_tab <- DT::formatStyle(dt_tab, cn_nt, backgroundColor = DT::styleInterval(brks, clrs)) + } + + if (perc) { + ## show percentages + dt_tab <- DT::formatPercentage(dt_tab, cn, dec) + } else { + if (sum(isDbl) > 0) { + dt_tab <- DT::formatRound(dt_tab, names(isDbl)[isDbl], dec) + } + if (sum(isInt) > 0) { + dt_tab <- DT::formatRound(dt_tab, names(isInt)[isInt], 0) + } + } + + ## see https://github.com/yihui/knitr/issues/1198 + dt_tab$dependencies <- c( + list(rmarkdown::html_dependency_bootstrap("bootstrap")), + dt_tab$dependencies + ) + + dt_tab +} + +#' Plot method for the pivotr function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/data/pivotr} for an example in Radiant +#' +#' @param x Return value from \code{\link{pivotr}} +#' @param type Plot type to use ("fill" or "dodge" (default)) +#' @param perc Use percentage on the y-axis +#' @param flip Flip the axes in a plot (FALSE or TRUE) +#' @param fillcol Fill color for bar-plot when only one categorical variable has been selected (default is "blue") +#' @param opacity Opacity for plot elements (0 to 1) +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' pivotr(diamonds, cvars = "cut") %>% plot() +#' pivotr(diamonds, cvars = c("cut", "clarity")) %>% plot() +#' pivotr(diamonds, cvars = c("cut", "clarity", "color")) %>% plot() +#' +#' @seealso \code{\link{pivotr}} to generate summaries +#' @seealso \code{\link{summary.pivotr}} to show summaries +#' +#' @importFrom rlang .data +#' +#' @export +plot.pivotr <- function(x, type = "dodge", perc = FALSE, flip = FALSE, + fillcol = "blue", opacity = 0.5, ...) { + cvars <- x$cvars + nvar <- x$nvar + tab <- x$tab %>% + (function(x) filter(x, x[[1]] != "Total")) + + if (flip) { + # need reverse order here because of how coord_flip works + tab <- lapply(tab, function(x) if (inherits(x, "factor")) factor(x, levels = rev(levels(x))) else x) %>% + as_tibble() + } + + if (length(cvars) == 1) { + p <- ggplot(na.omit(tab), aes(x = .data[[cvars]], y = .data[[nvar]])) + + geom_bar(stat = "identity", position = "dodge", alpha = opacity, fill = fillcol) + } else if (length(cvars) == 2) { + ctot <- which(colnames(tab) == "Total") + if (length(ctot) > 0) tab %<>% select(base::setdiff(colnames(.), "Total")) + + dots <- paste0("factor(", cvars[1], ", levels = c('", paste0(base::setdiff(colnames(tab), cvars[2]), collapse = "','"), "'))") %>% + rlang::parse_exprs(.) %>% + set_names(cvars[1]) + + p <- tab %>% + gather(!!cvars[1], !!nvar, !!base::setdiff(colnames(.), cvars[2])) %>% + na.omit() %>% + mutate(!!!dots) %>% + ggplot(aes(x = .data[[cvars[1]]], y = .data[[nvar]], fill = .data[[cvars[2]]])) + + geom_bar(stat = "identity", position = type, alpha = opacity) + } else if (length(cvars) == 3) { + ctot <- which(colnames(tab) == "Total") + if (length(ctot) > 0) tab %<>% select(base::setdiff(colnames(.), "Total")) + + dots <- paste0("factor(", cvars[1], ", levels = c('", paste0(base::setdiff(colnames(tab), cvars[2:3]), collapse = "','"), "'))") %>% + rlang::parse_exprs(.) %>% + set_names(cvars[1]) + + p <- tab %>% + gather(!!cvars[1], !!nvar, !!base::setdiff(colnames(.), cvars[2:3])) %>% + na.omit() %>% + mutate(!!!dots) %>% + ggplot(aes(x = .data[[cvars[1]]], y = .data[[nvar]], fill = .data[[cvars[2]]])) + + geom_bar(stat = "identity", position = type, alpha = opacity) + + facet_grid(paste(cvars[3], "~ .")) + } else { + ## No plot returned if more than 3 grouping variables are selected + return(invisible()) + } + + if (flip) p <- p + coord_flip() + if (perc) p <- p + scale_y_continuous(labels = scales::percent) + + if (isTRUE(nvar == "n_obs")) { + if (!is.empty(x$normalize, "None")) { + p <- p + labs(y = ifelse(perc, "Percentage", "Proportion")) + } + } else { + p <- p + labs(y = paste0(nvar, " (", x$fun, ")")) + } + + sshhr(p) +} + + +#' Deprecated: Store method for the pivotr function +#' +#' @details Return the summarized data. See \url{https://radiant-rstats.github.io/docs/data/pivotr.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param object Return value from \code{\link{pivotr}} +#' @param name Name to assign to the dataset +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{pivotr}} to generate summaries +#' +#' @export +store.pivotr <- function(dataset, object, name, ...) { + if (missing(name)) { + object$tab + } else { + stop( + paste0( + "This function is deprecated. Use the code below instead:\n\n", + name, " <- ", deparse(substitute(object)), "$tab\nregister(\"", + name, ")" + ), + call. = FALSE + ) + } +} diff --git a/radiant.data/R/radiant.R b/radiant.data/R/radiant.R new file mode 100644 index 0000000000000000000000000000000000000000..f15d919998bd06b2fdd8fc8a362c8e1c10bcfe54 --- /dev/null +++ b/radiant.data/R/radiant.R @@ -0,0 +1,1617 @@ +#' Launch radiant apps +#' +#' @details See \url{https://radiant-rstats.github.io/docs/} for radiant documentation and tutorials +#' +#' @param package Radiant package to start. One of "radiant.data", "radiant.design", "radiant.basics", "radiant.model", "radiant.multivariate", or "radiant" +#' @param run Run a radiant app in an external browser ("browser"), an Rstudio window ("window"), or in the Rstudio viewer ("viewer") +#' @param state Path to statefile to load +#' @param ... additional arguments to pass to shiny::runApp (e.g, port = 8080) +#' +#' @importFrom shiny paneViewer +#' +#' @examples +#' \dontrun{ +#' launch() +#' launch(run = "viewer") +#' launch(run = "window") +#' launch(run = "browser") +#' } +#' +#' @export +launch <- function(package = "radiant.data", run = "viewer", state, ...) { + ## check if package attached + if (!paste0("package:", package) %in% search()) { + if (!suppressWarnings(suppressMessages(suppressPackageStartupMessages(require(package, character.only = TRUE))))) { + stop(sprintf("Calling %s start function but %s is not installed.", package, package)) + } + } + + ## from Yihui's DT::datatable function + oop <- base::options( + width = max(getOption("width", 250), 250), + scipen = max(getOption("scipen", 100), 100), + max.print = max(getOption("max.print", 5000), 5000), + stringsAsFactors = FALSE, + radiant.launch_dir = normalizePath(getwd(), winslash = "/"), + dctrl = if (getRversion() > "3.4.4") c("keepNA", "niceNames") else "keepNA" + ) + on.exit(base::options(oop), add = TRUE) + if (run == FALSE) { + message(sprintf("\nStarting %s at the url shown below ...\nClick on the link or copy-and-paste it into\nyour browser's url bar to start", package)) + options(radiant.launch = "browser") + } else if (run == "browser" || run == "external") { + message(sprintf("\nStarting %s in the default browser", package)) + options(radiant.launch = "browser") + run <- TRUE + } else if (rstudioapi::getVersion() < "1.1") { + stop(sprintf("Rstudio version 1.1 or later required. Use %s::%s() to open %s in your default browser or download the latest version of Rstudio from https://posit.co/products/open-source/rstudio/", package, package, package)) + } else if (run == "viewer") { + message(sprintf("\nStarting %s in the Rstudio viewer ...\n\nUse %s::%s() to open %s in the default browser or %s::%s_window() in Rstudio to open %s in an Rstudio window", package, package, package, package, package, package, package)) + options(radiant.launch = "viewer") + run <- shiny::paneViewer(minHeight = "maximize") + } else if (run == "window") { + message(sprintf("\nStarting %s in an Rstudio window ...\n\nUse %s::%s() to open %s in the default browser or %s::%s_viewer() in Rstudio to open %s in the Rstudio viewer", package, package, package, package, package, package, package)) + os_type <- Sys.info()["sysname"] + if (os_type != "Darwin" && rstudioapi::getVersion() < "1.2") { + message(sprintf("\nUsing Radiant in an Rstudio Window works best in a newer version of Rstudio (i.e., version > 1.2). See https://dailies.rstudio.com/ for the latest version. Alternatively, use %s::%s_viewer()", package, package)) + } + options(radiant.launch = "window") + run <- get(".rs.invokeShinyWindowViewer") + } else { + message(sprintf("\nStarting %s in the default browser", package)) + options(radiant.launch = "browser") + run <- TRUE + } + + cat("\nRadiant is opensource and free to use. If you are a student or instructor using Radiant for a class, as a favor to the developer, please send an email to with the name of the school and class. If you are using Radiant in your company, as a favor to the developer, please share the name of your company and what types of activites you are supporting with the tool.\n") + + ## load radiant state file if specified + if (!missing(state)) { + if (grepl("^www\\.|^http:|^https:", state)) { + load(url(state), envir = .GlobalEnv) + } else if (file.exists(state)) { + load(state, envir = .GlobalEnv) + } + } + + ## cannot (yet) suppress ERROR: [on_request_read] connection reset by peer in viewer + suppressPackageStartupMessages( + shiny::runApp(system.file("app", package = package), launch.browser = run, ...) + ) +} + +#' Launch the radiant.data app in the default web browser +#' +#' @description Launch the radiant.data app in the default web browser +#' @param state Path to statefile to load +#' @param ... additional arguments to pass to shiny::runApp (e.g, port = 8080) +#' +#' @examples +#' \dontrun{ +#' radiant.data() +#' radiant.data("https://github.com/radiant-rstats/docs/raw/gh-pages/examples/demo-dvd-rnd.state.rda") +#' radiant.data("viewer") +#' } +#' @export +radiant.data <- function(state, ...) launch(package = "radiant.data", run = "browser", state, ...) + +#' Launch the radiant.data app in an Rstudio window +#' +#' @param state Path to statefile to load +#' @param ... additional arguments to pass to shiny::runApp (e.g, port = 8080) +#' +#' @examples +#' \dontrun{ +#' radiant.data_window() +#' } +#' @export +radiant.data_window <- function(state, ...) launch(package = "radiant.data", run = "window", state, ...) + +#' Launch the radiant.data app in the Rstudio viewer +#' +#' @param state Path to statefile to load +#' @param ... additional arguments to pass to shiny::runApp (e.g, port = 8080) +#' +#' @examples +#' \dontrun{ +#' radiant.data_viewer() +#' } +#' @export +radiant.data_viewer <- function(state, ...) launch(package = "radiant.data", run = "viewer", state, ...) + +#' Start radiant.data app but do not open a browser +#' +#' @param state Path to statefile to load +#' @param ... additional arguments to pass to shiny::runApp (e.g, port = 8080) +#' +#' @examples +#' \dontrun{ +#' radiant.data_url() +#' } +#' @export +radiant.data_url <- function(state, ...) launch(package = "radiant.data", run = FALSE, state, ...) + +#' Install webshot and phantomjs +#' @export +install_webshot <- function() { + if (isNamespaceLoaded("webshot")) unloadNamespace("webshot") + type <- ifelse(Sys.info()["sysname"] == "Linux", "source", "binary") + install.packages("webshot", repos = "https://cran.rstudio.com", type = type) + if (Sys.which("phantomjs") == "") eval(parse(text = "webshot::install_phantomjs()")) +} + +#' Alias used to add an attribute +#' +#' @param x Object +#' @param which Attribute name +#' @param value Value to set +# +#' @examples +#' foo <- data.frame(price = 1:5) %>% set_attr("description", "price set in experiment ...") +#' @export +set_attr <- function(x, which, value) `attr<-`(x, which, value) + +#' Convenience function to add a markdown description to a data.frame +#' +#' @param df A data.frame or tibble +#' @param md Data description in markdown format +#' @param path Path to a text file with the data description in markdown format +#' +#' @examples +#' if (interactive()) { +#' mt <- mtcars |> add_description(md = "# MTCARS\n\nThis data.frame contains information on ...") +#' describe(mt) +#' } +#' +#' @seealso See also \code{\link{register}} +#' +#' @export +add_description <- function(df, md = "", path = "") { + if (path != "") { + md <- readLines(path) %>% paste0(collapse = "\n") + } else if (md == "") { + md <- "No description available" + } + set_attr(df, "description", md) +} + +#' Copy attributes from one object to another +#' +#' @param to Object to copy attributes to +#' @param from Object to copy attributes from +#' @param attr Vector of attributes. If missing all attributes will be copied +# +#' @export +copy_attr <- function(to, from, attr) { + if (missing(attr)) { + attr <- attributes(from) + } + for (i in attr) { + to <- set_attr(to, i, attributes(from)[[i]]) + } + to +} + +#' Convenience function to add a class +#' +#' @param x Object +#' @param cl Vector of class labels to add +#' +#' @examples +#' foo <- "some text" %>% add_class("text") +#' foo <- "some text" %>% add_class(c("text", "another class")) +#' @export +add_class <- function(x, cl) `class<-`(x, c(cl, class(x))) + +#' Add stars based on p.values +#' @param pval Vector of p-values +#' @return A vector of stars +#' @examples +#' sig_stars(c(.0009, .049, .009, .4, .09)) +#' @export +sig_stars <- function(pval) { + sapply(pval, function(x) x < c(.001, .01, .05, .1)) %>% + colSums() %>% + add(1) %>% + c("", ".", "*", "**", "***")[.] +} + +#' Hide warnings and messages and return invisible +#' +#' @details Hide warnings and messages and return invisible +#' +#' @param ... Inputs to keep quite +#' +#' @examples +#' sshh(library(dplyr)) +#' @export +sshh <- function(...) { + suppressWarnings(suppressMessages(...)) + invisible() +} + +#' Hide warnings and messages and return result +#' +#' @details Hide warnings and messages and return result +#' +#' @param ... Inputs to keep quite +#' +#' @examples +#' sshhr(library(dplyr)) +#' @export +sshhr <- function(...) suppressWarnings(suppressMessages(...)) + +#' Find user directory +#' @details Returns /Users/x and not /Users/x/Documents +#' @export +find_home <- function() { + os_type <- Sys.info()["sysname"] + if (os_type == "Windows") { + normalizePath( + file.path(Sys.getenv("HOMEDRIVE"), Sys.getenv("HOMEPATH")), + winslash = "/" + ) + } else { + Sys.getenv("HOME") + } +} + +#' Select variables and filter data +#' +#' @details Function is used in radiant to select variables and filter data based on user input in string form +#' @param dataset Dataset or name of the data.frame +#' @param vars Variables to extract from the data.frame +#' @param filt Filter to apply to the specified dataset +#' @param arr Expression to use to arrange (sort) the specified dataset +#' @param rows Select rows in the specified dataset +#' @param data_view_rows Vector of rows to select. Only used by Data > View in Radiant. Users should use "rows" instead +#' @param na.rm Remove rows with missing values (default is TRUE) +#' @param rev Reverse filter and row selection (i.e., get the remainder) +#' @param envir Environment to extract data from +#' +#' @return Data.frame with specified columns and rows +#' +#' @examples +#' get_data(mtcars, vars = "cyl:vs", filt = "mpg > 25") +#' get_data(mtcars, vars = c("mpg", "cyl"), rows = 1:10) +#' get_data(mtcars, vars = c("mpg", "cyl"), arr = "desc(mpg)", rows = "1:5") +#' @export +get_data <- function(dataset, vars = "", filt = "", arr = "", rows = NULL, + data_view_rows = NULL, na.rm = TRUE, rev = FALSE, envir = c()) { + filter_cmd <- gsub("\\n", "", filt) %>% + gsub("\"", "\'", .) + + arrange_cmd <- gsub("\\n", "", arr) %>% + gsub("\"", "\'", .) + + slice_cmd <- rows + + dataset <- if (is.data.frame(dataset)) { + dataset + } else if (is.environment(envir) && !is.null(envir[[dataset]])) { + envir[[dataset]] + } else { + paste0("Dataset ", dataset, " is not available. Please load the dataset") %>% + stop(call. = FALSE) + } + + get_flipped_ind <- function() { + get_data(dataset, arr = arr) %>% + mutate(ind__ = seq_len(n())) %>% + get_data( + c("ind__", colnames(.)), + filt = ifelse(is.empty(filter_cmd), "", filter_cmd), + rows = ifelse(is.empty(slice_cmd), "", slice_cmd) + ) %>% + pull("ind__") + } + if (isTRUE(rev)) { + slice_cmd <- -(get_flipped_ind()) + filter_cmd <- "" + } + + dataset %>% + (function(x) if ("grouped_df" %in% class(x)) ungroup(x) else x) %>% ## ungroup data if needed + (function(x) if (is.empty(filter_cmd)) x else filter_data(x, filter_cmd)) %>% ## apply data_filter + (function(x) if (is.empty(arrange_cmd)) x else arrange_data(x, arrange_cmd)) %>% + (function(x) if (is.empty(slice_cmd)) x else slice_data(x, slice_cmd)) %>% + (function(x) if (is.empty(data_view_rows)) x else x[data_view_rows, , drop = FALSE]) %>% + (function(x) if (is.empty(vars[1])) x else select(x, !!!if (any(grepl(":", vars))) rlang::parse_exprs(paste0(vars, collapse = ";")) else vars)) %>% + (function(x) if (na.rm) droplevels(na.omit(x)) else x) +} + +#' Convert characters to factors +#' @details Convert columns of type character to factors based on a set of rules. By default columns will be converted for small datasets (<= 100 rows) with more rows than unique values. For larger datasets, columns are converted only when the number of unique values is <= 100 and there are 30 or more rows in the data for every unique value +#' @param dataset Data frame +#' @param safx Ratio of number of rows to number of unique values +#' @param nuniq Cutoff for number of unique values +#' @param n Cutoff for small dataset +#' @examples +#' tibble(a = c("a", "b"), b = c("a", "a"), c = 1:2) %>% to_fct() +#' @export +to_fct <- function(dataset, safx = 30, nuniq = 100, n = 100) { + isChar <- sapply(dataset, is.character) + if (sum(isChar) == 0) { + return(dataset) + } + nobs <- nrow(dataset) + fab <- function(x) { + nd <- length(unique(x)) + (nobs <= n && nd < nobs) || (nd <= nuniq && (nd / nobs < (1 / safx))) + } + toFct <- select(dataset, which(isChar)) %>% + summarise_all(fab) %>% + select(which(. == TRUE)) %>% + names() + if (length(toFct) == 0) { + dataset + } else { + mutate_at(dataset, .vars = toFct, .funs = as.factor) + } +} + +#' Choose files interactively +#' +#' @details Open a file dialog. Uses JavaScript on Mac, utils::choose.files on Windows, and file.choose() on Linux +#' +#' @param ... Strings used to indicate which file types should be available for selection (e.g., "csv" or "pdf") +#' +#' @return Vector of paths to files selected by the user +#' +#' @examples +#' \dontrun{ +#' choose_files("pdf", "csv") +#' } +#' +#' @export +choose_files <- function(...) { + argv <- unlist(list(...)) + os_type <- Sys.info()["sysname"] + if (os_type == "Windows") { + if (length(argv) > 0) { + argv <- paste0(paste0("*.", argv), collapse = "; ") + argv <- matrix( + c("All files (*.*)", "*.*", argv, argv), + nrow = 2, ncol = 2, byrow = TRUE + ) + } else { + argv <- c("All files", "*.*") + } + utils::choose.files(filters = argv) + } else if (os_type == "Darwin") { + pth <- file.path(system.file(package = "radiant.data"), "app/www/scpt/choose.files.scpt") + if (length(argv) > 0) { + argv <- paste0("\"", paste0(unlist(argv), collapse = "\" \""), "\"") + } + fpath <- suppressWarnings( + system( + paste0("osascript -l JavaScript ", pth, " ", argv), + intern = TRUE + ) + ) + if (length(fpath) > 0) { + fpath <- strsplit(fpath, ", ")[[1]] + gsub("Path\\(\"(.*)\"\\)", "\\1", fpath) + } else { + character(0) + } + } else { + file.choose() + } +} + +#' Choose a directory interactively +#' +#' @details Open a file dialog to select a directory. Uses JavaScript on Mac, utils::choose.dir on Windows, and dirname(file.choose()) on Linux +#' +#' @param ... Arguments passed to utils::choose.dir on Windows +#' +#' @return Path to the directory selected by the user +#' +#' @examples +#' \dontrun{ +#' choose_dir() +#' } +#' +#' @export +choose_dir <- function(...) { + os_type <- Sys.info()["sysname"] + if (os_type == "Windows") { + utils::choose.dir(...) + } else if (os_type == "Darwin") { + pth <- file.path(system.file(package = "radiant.data"), "app/www/scpt/choose.dir.scpt") + dpath <- suppressWarnings( + system(paste0("osascript -l JavaScript ", pth), intern = TRUE) + ) + if (length(dpath) > 0) { + gsub("Path\\(\"(.*)\"\\)", "\\1", dpath) + } else { + character(0) + } + } else { + dirname(file.choose()) + } +} + +#' Get variable class +#' +#' @details Get variable class information for each column in a data.frame +#' +#' @param dat Dataset to evaluate +#' +#' @return Vector with class information for each variable +#' +#' @examples +#' get_class(mtcars) +#' @export +get_class <- function(dat) { + sapply(dat, function(x) class(x)[1]) %>% + sub("ordered", "factor", .) %>% + sub("POSIXct", "date", .) %>% + sub("POSIXlt", "date", .) %>% + sub("Date", "date", .) %>% + sub("Period", "period", .) +} + +#' Is a variable empty +#' +#' @details Is a variable empty +#' +#' @param x Character value to evaluate +#' @param empty Indicate what 'empty' means. Default is empty string (i.e., "") +#' +#' @return TRUE if empty, else FALSE +#' +#' @examples +#' is.empty("") +#' is.empty(NULL) +#' is.empty(NA) +#' is.empty(c()) +#' is.empty("none", empty = "none") +#' is.empty("") +#' is.empty(" ") +#' is.empty(" something ") +#' is.empty(c("", "something")) +#' is.empty(c(NA, 1:100)) +#' is.empty(mtcars) +#' @export +is.empty <- function(x, empty = "\\s*") { + # any should not be needed here but patchwork objects can have length == 1 + # and yet still return a vector of logicals + is_not(x) || (length(x) == 1 && any(grepl(paste0("^", empty, "$"), x))) +} + +#' Is input a string? +#' +#' @param x Input +#' +#' @return TRUE if string, else FALSE +#' +#' @examples +#' is_string(" ") +#' is_string("data") +#' is_string(c("data", "")) +#' is_string(NULL) +#' is_string(NA) +#' @export +is_string <- function(x) { + # any should not be needed here but patchwork objects can have length == 1 + # and yet still return a vector of logicals + length(x) == 1 && any(is.character(x)) && !is.empty(x) +} + +#' Is input a double (and not a date type)? +#' +#' @param x Input +#' +#' @return TRUE if double and not a type of date, else FALSE +#' +#' @importFrom lubridate is.Date is.POSIXt +#' +#' @export +is_double <- function(x) { + is.double(x) && !lubridate::is.Date(x) && !lubridate::is.POSIXt(x) +} + +#' Create a vector of interaction terms for linear and logistic regression +#' +#' @param vars Labels to use +#' @param nway 2-way (2) or 3-way (3) interaction labels to create +#' @param sep Separator to use between variable names (e.g., :) +#' +#' @return Character vector of interaction term labels +#' +#' @examples +#' paste0("var", 1:3) %>% iterms(2) +#' paste0("var", 1:3) %>% iterms(3) +#' paste0("var", 1:3) %>% iterms(2, sep = ".") +#' @export +iterms <- function(vars, nway = 2, sep = ":") { + sapply(2:min(as.integer(nway), length(vars)), function(x) apply(combn(vars, x), 2, paste, collapse = sep)) %>% + unlist() %>% + as.vector() +} + +#' Create a vector of quadratic and cubed terms for use in linear and logistic regression +#' +#' @param vars Variables labels to use +#' @param nway quadratic (2) or cubic (3) term labels to create +#' +#' @return Character vector of (regression) term labels +#' +#' @examples +#' qterms(c("a", "b"), 3) +#' qterms(c("a", "b"), 2) +#' @export +qterms <- function(vars, nway = 2) { + sapply(2:as.integer(nway), function(x) glue("I({vars}^{x})")) %>% + as.vector() +} + +#' Source for package functions +#' +#' @details Equivalent of source with local=TRUE for package functions. Written by smbache, author of the import package. See \url{https://github.com/rticulate/import/issues/4/} for a discussion. This function will be deprecated when (if) it is included in \url{https://github.com/rticulate/import/} +#' +#' @param .from The package to pull the function from +#' @param ... Functions to pull +#' +#' @examples +#' copy_from(radiant.data, get_data) +#' @export +copy_from <- function(.from, ...) { + ## copied from import:::symbol_list and import:::symbol_as_character by @smbache + dots <- eval(substitute(alist(...)), parent.frame(), parent.frame()) + names <- names(dots) + unnamed <- if (is.null(names)) { + 1:length(dots) + } else { + which(names == "") + } + dots <- vapply(dots, as.character, character(1)) + names(dots)[unnamed] <- dots[unnamed] + + symbols <- dots + parent <- parent.frame() + from <- as.character(substitute(.from)) + + for (s in seq_along(symbols)) { + fn <- get(symbols[s], envir = asNamespace(from), inherits = TRUE) + assign( + names(symbols)[s], + eval.parent(call("function", formals(fn), body(fn))), + parent + ) + } + + invisible(NULL) +} + +#' Source all package functions +#' +#' @details Equivalent of source with local=TRUE for all package functions. Adapted from functions by smbache, author of the import package. See \url{https://github.com/rticulate/import/issues/4/} for a discussion. This function will be deprecated when (if) it is included in \url{https://github.com/rticulate/import/} +#' +#' @param .from The package to pull the function from +#' +#' @examples +#' copy_all(radiant.data) +#' @export +copy_all <- function(.from) { + from <- as.character(substitute(.from)) + + ls(getNamespace(from), all.names = TRUE) %>% + .[grep("^\\.", ., invert = TRUE)] %>% + set_names(., .) -> symbols + + parent <- parent.frame() + + for (s in seq_along(symbols)) { + fn <- get(symbols[s], envir = asNamespace(from), inherits = TRUE) + assign( + names(symbols)[s], + eval.parent(call("function", formals(fn), body(fn))), + parent + ) + } + + invisible(NULL) +} + +#' Labels for confidence intervals +#' +#' @param alt Type of hypothesis ("two.sided","less","greater") +#' @param cl Confidence level +#' @param dec Number of decimals to show +#' +#' @return A character vector with labels for a confidence interval +#' +#' @examples +#' ci_label("less", .95) +#' ci_label("two.sided", .95) +#' ci_label("greater", .9) +#' @export +ci_label <- function(alt = "two.sided", cl = .95, dec = 3) { + if (alt == "less") { + c("0%", paste0(100 * cl, "%")) + } else if (alt == "greater") { + c(paste0(100 * (1 - cl), "%"), "100%") + } else {{ + 100 * (1 - cl) / 2 + } %>% + c(., 100 - .) %>% + round(dec) %>% + paste0(., "%") } +} + +#' Values at confidence levels +#' +#' @param dat Data +#' @param alt Type of hypothesis ("two.sided","less","greater") +#' @param cl Confidence level +#' +#' @return A vector with values at a confidence level +#' +#' @examples +#' ci_perc(0:100, "less", .95) +#' ci_perc(0:100, "greater", .95) +#' ci_perc(0:100, "two.sided", .80) +#' @export +ci_perc <- function(dat, alt = "two.sided", cl = .95) { + probs <- if (alt == "two.sided") { + ((1 - cl) / 2) %>% c(., 1 - .) + } else if (alt == "less") { + 1 - cl + } else { + cl + } + quantile(dat, probs = probs) +} + +#' Format a data.frame with a specified number of decimal places +#' +#' @param tbl Data.frame +#' @param dec Number of decimals to show +#' @param perc Display numbers as percentages (TRUE or FALSE) +#' @param mark Thousand separator +#' @param na.rm Remove missing values +#' @param ... Additional arguments for format_nr +#' +#' @return Data.frame for printing +#' +#' @examples +#' data.frame(x = c("a", "b"), y = c(1L, 2L), z = c(-0.0005, 3)) %>% +#' format_df(dec = 4) +#' data.frame(x = c(1L, 2L), y = c(0.06, 0.8)) %>% +#' format_df(dec = 2, perc = TRUE) +#' data.frame(x = c(1L, 2L, NA), y = c(NA, 1.008, 2.8)) %>% +#' format_df(dec = 2) +#' @export +format_df <- function(tbl, dec = NULL, perc = FALSE, mark = "", na.rm = FALSE, ...) { + frm <- function(x, ...) { + if (is_double(x)) { + format_nr(x, dec = dec, perc = perc, mark = mark, na.rm = na.rm, ...) + } else if (is.integer(x)) { + format_nr(x, dec = 0, mark = mark, na.rm = na.rm, ...) + } else { + x + } + } + mutate_all(tbl, .funs = frm) +} + +#' Format a number with a specified number of decimal places, thousand sep, and a symbol +#' +#' @param x Number or vector +#' @param sym Symbol to use +#' @param dec Number of decimals to show +#' @param perc Display number as a percentage +#' @param mark Thousand separator +#' @param na.rm Remove missing values +#' @param ... Additional arguments passed to \code{\link{formatC}} +#' +#' @return Character (vector) in the desired format +#' +#' @examples +#' format_nr(2000, "$") +#' format_nr(2000, dec = 4) +#' format_nr(.05, perc = TRUE) +#' format_nr(c(.1, .99), perc = TRUE) +#' format_nr(data.frame(a = c(.1, .99)), perc = TRUE) +#' format_nr(data.frame(a = 1:10), sym = "$", dec = 0) +#' format_nr(c(1, 1.9, 1.008, 1.00)) +#' format_nr(c(1, 1.9, 1.008, 1.00), drop0trailing = TRUE) +#' format_nr(NA) +#' format_nr(NULL) +#' @export +format_nr <- function(x, sym = "", dec = 2, perc = FALSE, + mark = ",", na.rm = TRUE, ...) { + if (is.data.frame(x)) x <- x[[1]] + if (na.rm && length(x) > 0) x <- na.omit(x) + if (perc) { + paste0(sym, formatC(100 * x, digits = dec, big.mark = mark, format = "f", ...), "%") + } else { + paste0(sym, formatC(x, digits = dec, big.mark = mark, format = "f", ...)) + } +} + +#' Round doubles in a data.frame to a specified number of decimal places +#' +#' @param tbl Data frame +#' @param dec Number of decimals to show +#' @return Data frame with rounded doubles +#' @examples +#' data.frame(x = as.factor(c("a", "b")), y = c(1L, 2L), z = c(-0.0005, 3.1)) %>% +#' round_df(dec = 2) +#' @export +round_df <- function(tbl, dec = 3) { + mutate_if(tbl, is_double, .funs = ~ round(., dec)) +} + +#' Find Dropbox folder +#' +#' @details Find the path for Dropbox if available +#' @param account Integer. If multiple accounts exist, specify which one to use. By default, the first account listed is used +#' @return Path to Dropbox account +#' @importFrom jsonlite fromJSON +#' @export +find_dropbox <- function(account = 1) { + if (length(account) > 1) { + stop("find_dropbox can only return the path for one account at a time") + } + + os_type <- Sys.info()["sysname"] + if (os_type == "Linux" && file.exists("~/Dropbox")) { + return(normalizePath("~/Dropbox", winslash = "/")) + } else if (os_type == "Windows") { + fp <- file.path(Sys.getenv("APPDATA"), "Dropbox/info.json") %>% gsub("\\\\", "/", .) + if (!file.exists(fp)) { + fp <- file.path(Sys.getenv("LOCALAPPDATA"), "Dropbox/info.json") %>% + gsub("\\\\", "/", .) + } + } else { + fp <- "~/.dropbox/info.json" + } + + if (file.exists(fp)) { + fp <- normalizePath(fp, winslash = "/") + dbinfo <- jsonlite::fromJSON(fp) + ldb <- length(dbinfo) + if (ldb > 1) { + message("Multiple dropbox folders found. By default the first folder is used.\nTo select, for example, the third dropbox folder use find_dropbox(3).\nAlternatively, specify the type of dropbox account, e.g., find_dropbox('personal')") + } + if (is.numeric(account) && account > ldb) { + stop(paste0("Invalid account number. Choose a number between 1 and ", ldb)) + } else if (is.character(account) && !account %in% names(dbinfo)) { + stop(paste0("Invalid account type. Choose ", paste0(names(dbinfo), collapse = " or "))) + } else { + dbp <- dbinfo[[account]]$path + if (file.exists(dbp)) { + normalizePath(dbp, winslash = "/") + } else if (file.exists("~/Dropbox")) { + normalizePath("~/Dropbox", winslash = "/") + } else if (file.exists("~/../Dropbox")) { + normalizePath("~/../Dropbox", winslash = "/") + } else { + stop("Failed to uncover the path to a Dropbox account") + } + } + } else if (file.exists("~/Dropbox")) { + normalizePath("~/Dropbox", winslash = "/") + } else if (file.exists("~/../Dropbox")) { + normalizePath("~/../Dropbox", winslash = "/") + } else { + stop("Failed to uncover the path to a Dropbox account") + } +} + +#' Find Google Drive folder +#' +#' @details Find the path for Google Drive if available +#' @return Path to Google Drive folder +#' @export +find_gdrive <- function() { + os_type <- Sys.info()["sysname"] + home <- radiant.data::find_home() + home_gdrive <- paste0(home, "/Google Drive") + if (dir.exists(home_gdrive)) { + return(normalizePath(home_gdrive, winslash = "/")) + } else if (dir.exists("/Volumes/GoogleDrive")) { + return("/Volumes/GoogleDrive") + } else if (os_type == "Windows") { + fp <- file.path(Sys.getenv("LOCALAPPDATA"), "Google/Drive/user_default/sync_config.db") %>% + gsub("\\\\", "/", .) + } else if (os_type == "Darwin") { + fp <- "~/Library/Application Support/Google/Drive/user_default/sync_config.db" + } else if (os_type == "Linux") { + ## http://www.techrepublic.com/article/how-to-mount-your-google-drive-on-linux-with-google-drive-ocamlfuse/ + ## Linux update suggested by Chris Armstrong (https://github.com/chrisarm) + if (file.exists(file.path("~/google_drive/.grive"))) { + return(normalizePath("~/google_drive")) + } else { + stop("Please install grive2 and use '~/google_drive' as your grive directory (http://www.techrepublic.com/article/how-to-sync-your-google-cloud-on-linux-with-grive2/)", call. = FALSE) + } + } else { + stop("find_gdrive not supported on this platform", call. = FALSE) + } + + if (file.exists(fp)) { + if (!requireNamespace("DBI", quietly = TRUE)) { + stop("DBI package is needed for this function to work. Please install it", call. = FALSE) + if (!requireNamespace("RSQLite", quietly = TRUE)) { + stop("RSQLite package is needed for this function to work. Please install it", call. = FALSE) + } + } + + fp <- normalizePath(fp, winslash = "/") + con <- DBI::dbConnect(RSQLite::SQLite(), fp) + ret <- DBI::dbGetQuery(con, 'select data_value from data where entry_key = "local_sync_root_path"') %>% + unlist() + DBI::dbDisconnect(con) + + if (length(ret) > 0) { + return(normalizePath(ret, winslash = "/")) + } + } else { + stop("Failed to uncover the path to a Google Drive folder") + } +} + +#' Find the Rstudio project folder +#' +#' @details Find the path for the Rstudio project folder if available. The returned path is normalized (see \code{\link{normalizePath}}) +#' @param mess Show or hide messages (default mess = TRUE) +#' @return Path to Rstudio project folder if available or else and empty string. The returned path is normalized +#' @importFrom rstudioapi isAvailable getActiveProject +#' @export +find_project <- function(mess = TRUE) { + if (rstudioapi::isAvailable()) { + pdir <- rstudioapi::getActiveProject() + if (is.null(pdir)) { + if (mess) { + message("Project directory cannot be found because application is not run from Rstudio project") + } + "" + } else { + normalizePath(pdir, winslash = "/") + } + } else { + "" + } +} + +#' Index of the maximum per row +#' @details Determine the index of the maximum of the input vectors per row. Extension of \code{which.max} +#' @param ... Numeric or character vectors of the same length +#' @return Vector of rankings +#' @seealso See also \code{\link{which.max}} and \code{\link{which.pmin}} +#' @examples +#' which.pmax(1:10, 10:1) +#' which.pmax(2, 10:1) +#' which.pmax(mtcars) +#' @export +which.pmax <- function(...) unname(apply(cbind(...), 1, which.max)) + +#' Index of the minimum per row +#' @details Determine the index of the minimum of the input vectors per row. Extension of \code{which.min} +#' @param ... Numeric or character vectors of the same length +#' @return Vector of rankings +#' @seealso See also \code{\link{which.min}} and \code{\link{which.pmax}} +#' @examples +#' which.pmin(1:10, 10:1) +#' which.pmin(2, 10:1) +#' which.pmin(mtcars) +#' @export +which.pmin <- function(...) unname(apply(cbind(...), 1, which.min)) + +#' Summarize a set of numeric vectors per row +#' @rdname pfun +#' @details Calculate summary statistics of the input vectors per row (or 'parallel') +#' @param ... Numeric vectors of the same length +#' @param fun Function to apply +#' @param na.rm a logical indicating whether missing values should be removed. +#' @return A vector of 'parallel' summaries of the argument vectors. +#' @seealso See also \code{\link{pmin}} and \code{\link{pmax}} +#' @examples +#' pfun(1:10, fun = mean) +#' @export +pfun <- function(..., fun, na.rm = TRUE) unname(apply(cbind(...), 1, fun, na.rm = na.rm)) + +#' @rdname pfun +#' @examples +#' psum(1:10, 10:1) +#' @export +psum <- function(..., na.rm = TRUE) pfun(..., fun = sum, na.rm = na.rm) + +#' @rdname pfun +#' @export +pmean <- function(..., na.rm = TRUE) pfun(..., fun = mean, na.rm = na.rm) + +#' @rdname pfun +#' @export +pmedian <- function(..., na.rm = TRUE) pfun(..., fun = median, na.rm = na.rm) + +#' @rdname pfun +#' @export +psd <- function(..., na.rm = TRUE) pfun(..., fun = sd, na.rm = na.rm) + +#' @rdname pfun +#' @export +pvar <- function(..., na.rm = TRUE) pfun(..., fun = var, na.rm = na.rm) + +#' @rdname pfun +#' @export +pcv <- function(..., na.rm = TRUE) pfun(..., fun = cv, na.rm = na.rm) + +#' @rdname pfun +#' @export +pp01 <- function(..., na.rm = TRUE) pfun(..., fun = p01, na.rm = na.rm) + +#' @rdname pfun +#' @export +pp025 <- function(..., na.rm = TRUE) pfun(..., fun = p025, na.rm = na.rm) + +#' @rdname pfun +#' @export +pp05 <- function(..., na.rm = TRUE) pfun(..., fun = p05, na.rm = na.rm) + +#' @rdname pfun +#' @export +pp10 <- function(..., na.rm = TRUE) pfun(..., fun = p10, na.rm = na.rm) + +#' @rdname pfun +#' @export +pp25 <- function(..., na.rm = TRUE) pfun(..., fun = p25, na.rm = na.rm) + +#' @rdname pfun +#' @export +pp75 <- function(..., na.rm = TRUE) pfun(..., fun = p75, na.rm = na.rm) + +#' @rdname pfun +#' @export +pp95 <- function(..., na.rm = TRUE) pfun(..., fun = p95, na.rm = na.rm) + +#' @rdname pfun +#' @export +pp975 <- function(..., na.rm = TRUE) pfun(..., fun = p975, na.rm = na.rm) + +#' @rdname pfun +#' @export +pp99 <- function(..., na.rm = TRUE) pfun(..., fun = p99, na.rm = na.rm) + +#' Method to store variables in a dataset in Radiant +#' +#' @param dataset Dataset +#' @param object Object of relevant class that has information to be stored +#' @param ... Additional arguments +#' +#' @export +store <- function(dataset, object = "deprecated", ...) { + UseMethod("store", object) +} + +#' Catch error messages when a user tries to store results +#' +#' @param dataset Dataset +#' @param object Object of type character +#' @param ... Additional arguments +#' +#' @noRd +#' @export +store.character <- function(dataset = NULL, object, ...) { + if ("pivotr" %in% class(dataset)) { + store.pivotr(dataset = NULL, object = dataset, ...) + } else if ("explore" %in% class(dataset)) { + store.explore(dataset = NULL, object = dataset, ...) + } else if ("crs" %in% class(dataset)) { + ## using get("...") to avoid 'undefined' global function warnings + get("store.crs")(dataset = NULL, object = dataset, ...) + } else if ("conjoint" %in% class(dataset)) { + ## using get("...") to avoid 'undefined' global function warnings + get("store.conjoint")(dataset = NULL, object = dataset, ...) + } else if ("model" %in% class(dataset)) { + paste0( + "This usage of the store function is now deprecated.\nUse the code below instead:\n\n", + dataset$df_name, " <- store(", dataset$df_name, ", ", deparse(substitute(dataset)), ", name = \"", list(...)[["name"]], "\")" + ) %>% store_character_popup() + } else if ("data.frame" %in% class(dataset)) { + if (grepl("\\s", object)) { + store_character_popup(object) + } else { + paste0("This usage of the store function is now deprecated.\nUse the code below instead:\n\n", object, " <- ...") %>% + store_character_popup() + } + } else { + if (missing(object)) { + object <- "Incorrect call to the 'store' function. The function should be\ncalled as follows:\n\ndata <- store(data, model, name = \"new_column_name\")" + } + paste0("Unable to store output. The returned message was:\n\n", object) %>% + store_character_popup() + } + + ## ensure the original data is not over-written if what is to be stores is a character object + dataset +} + +store_character_popup <- function(mess) { + if (is.null(shiny::getDefaultReactiveDomain())) { + stop(mess, call. = FALSE) + } else { + ## See https://shiny.posit.co/reference/shiny/latest/modalDialog.html + showModal( + modalDialog( + title = "Data not stored", + span(HTML(gsub("\n", "
", mess))), + footer = modalButton("OK"), + size = "m", + easyClose = TRUE + ) + ) + } +} + +#' Find index corrected for missing values and filters +#' +#' @param dataset Dataset +#' @param vars Variables to select +#' @param filt Data filter +#' @param arr Expression to arrange (sort) the data on (e.g., "color, desc(price)") +#' @param rows Selected rows +#' @param cmd A command used to customize the data +#' +#' @export +indexr <- function(dataset, vars = "", filt = "", arr = "", rows = NULL, cmd = "") { + if (is.empty(vars) || sum(vars %in% colnames(dataset)) != length(vars)) { + vars <- colnames(dataset) + } + nrows <- nrow(dataset) + + ## customizing data if a command was used + if (!is.empty(cmd)) { + pred_cmd <- gsub("\"", "\'", cmd) %>% + gsub("\\s+", "", .) + cmd_vars <- strsplit(pred_cmd, ";\\s*")[[1]] %>% + strsplit(., "=") %>% + sapply("[", 1) %>% + gsub("\\s+", "", .) + + dots <- rlang::parse_exprs(pred_cmd) %>% + set_names(cmd_vars) + + dataset <- try(dataset %>% mutate(!!!dots), silent = TRUE) + } + + ind <- mutate(dataset, imf___ = seq_len(nrows)) %>% + (function(x) if (is.empty(filt)) x else filter_data(x, filt)) %>% + (function(x) if (is.empty(arr)) x else arrange_data(x, arr)) %>% + (function(x) if (is.empty(rows)) x else slice_data(x, rows)) %>% + select_at(.vars = unique(c("imf___", vars))) %>% + na.omit() %>% + .[["imf___"]] + + list(nr = nrows, ind = ind) +} + +#' Convenience function for is.null or is.na +#' +#' @param x Input +#' +#' @examples +#' is_not(NA) +#' is_not(NULL) +#' is_not(c()) +#' is_not(list()) +#' is_not(data.frame()) +#' @export +is_not <- function(x) { + # any should not be needed here but patchwork objects can have length == 1 + # and yet still return a vector of logicals + length(x) == 0 || (length(x) == 1 && any(is.na(x))) +} + +#' Don't try to plot strings +#' +#' @param x A character returned from a function +#' @param ... Any additional arguments +#' +#' @noRd +#' @export +plot.character <- function(x, ...) { + return(invisible()) +} + +#' Base method used to render htmlwidgets +#' +#' @param object Object of relevant class to render +#' @param ... Additional arguments +#' +#' @export +render <- function(object, ...) UseMethod("render", object) + +#' Method to render DT tables +#' +#' @param object DT table +#' @param shiny Check if function is called from a shiny application +#' @param ... Additional arguments +#' +#' @importFrom shiny getDefaultReactiveDomain +#' +#' @export +render.datatables <- function(object, shiny = shiny::getDefaultReactiveDomain(), ...) { + ## hack for rmarkdown from Report > Rmd and Report > R + if (!is.null(shiny) && !getOption("radiant.rmarkdown", FALSE)) { + DT::renderDataTable(object) + } else { + object + } +} + +#' Work around to avoid (harmless) messages from ggplotly +#' +#' @param ... Arguments to pass to the \code{\link[plotly]{ggplotly}} function in the plotly package +#' +#' @seealso See the \code{\link[plotly]{ggplotly}} function in the plotly package for details (?plotly::ggplotly) +#' +#' @importFrom plotly ggplotly +#' +#' @export +ggplotly <- function(...) { + args <- list(...) + ## awaiting resolution of https://github.com/ropensci/plotly/issues/1171 + # if (!"width" %in% names(args)) { + # args$width <- knitr::opts_current$get('fig.width') * 96 + # } + # if (!"height" %in% names(args)) { + # args$height <- knitr::opts_current$get('fig.height') * 96 + # } + suppressMessages(do.call(plotly::ggplotly, args)) +} + +#' Work around to avoid (harmless) messages from subplot +#' +#' @param ... Arguments to pass to the \code{\link[plotly]{subplot}} function in the plotly packages +#' @param margin Default margin to use between plots +#' @seealso See the \code{\link[plotly]{subplot}} in the plotly package for details (?plotly::subplot) +#' +#' @importFrom plotly subplot +#' +#' @export +subplot <- function(..., margin = 0.04) { + ## awaiting resolution of https://github.com/ropensci/plotly/issues/1171 + suppressMessages(plotly::subplot(..., margin = margin)) +} + +#' Method to render plotly plots +#' +#' @param object plotly object +#' @param shiny Check if function is called from a shiny application +#' @param ... Additional arguments +#' +#' @importFrom shiny getDefaultReactiveDomain +#' @importFrom plotly renderPlotly +#' +#' @export +render.plotly <- function(object, shiny = shiny::getDefaultReactiveDomain(), ...) { + ## hack for rmarkdown from Report > Rmd and Report > R + if (!is.null(shiny) && !getOption("radiant.rmarkdown", FALSE)) { + ## avoid the ID-not-used-by-Shiny message + object$elementId <- NULL + + ## see https://github.com/ropensci/plotly/issues/1171 + # if (is.null(object$height)) { + # message("\n\nThe height of (gg)plotly objects may not be correct in Preview. Height will be correctly set in saved reports however.\n\n") + # } + + plotly::renderPlotly(object) + } else { + object + } +} + +#' Method to render rmarkdown documents +#' +#' @param object File path to an R-markdown file +#' @param ... Additional arguments passed on to rmarkdown::render +#' +#' @noRd +#' @export +render.character <- function(object, ...) { + if (length(object) > 1) { + stop("Expecting file path to an R-markdown file") + } else if (file.exists(object)) { + rmarkdown::render(object, ...) + } else { + stop("R-markdown file not found") + } +} + +#' Method to avoid re-rendering a shiny.render.function +#' +#' @param object Shiny render function +#' @param ... Additional arguments +#' +#' @noRd +#' @export +render.shiny.render.function <- function(object, ...) object + +#' Show dataset description +#' +#' @details Show dataset description, if available, in html form in Rstudio viewer or the default browser. The description should be in markdown format, attached to a data.frame as an attribute with the name "description" +#' +#' @param dataset Dataset with "description" attribute +#' @param envir Environment to extract data from +#' +#' @importFrom utils browseURL str +#' @importFrom knitr knit2html +#' +#' @export +describe <- function(dataset, envir = parent.frame()) { + dataset <- if (is.character(dataset)) { + message(paste0("Using describe(\"", dataset, "\") is deprecated.\nUse describe(", dataset, ") instead")) + get_data(dataset, envir = envir) + } else { + dataset + } + + description <- attr(dataset, "description") + if (is.empty(description)) { + return(str(dataset)) + } + + tf <- file.path(tempdir(), "index.html") + ## generate html and open in the Rstudio viewer or in the default browser + cat(knitr::knit2html(text = description), file = tf, output = FALSE) + ## based on https://support.posit.co/hc/en-us/articles/202133558-Extending-RStudio-with-the-Viewer-Pane + viewer <- getOption("viewer", default = browseURL) + viewer(tf) +} + +#' Workaround to store description file together with a parquet data file +#' +#' @param x A data frame to write to disk +#' @param file Path to store parquet file +#' @param description Data description +#' +#' @export +write_parquet <- function(x, file, description = attr(x, "description")) { + if (requireNamespace("arrow", quietly = TRUE)) { + arrow::write_parquet(x, file) + if (!is.empty(description)) { + cat(description, file = sub(".parquet", "_description.md", file)) + } + } else { + stop("The arrow package is required to work with data in parquet format is not installed. Please use install.packages('arrow')") + } +} + +#' Replace smart quotes etc. +#' +#' @param text Text to be parsed +#' @param all Should all non-ascii characters be removed? Default is FALSE +#' +#' @importFrom stringi stri_trans_general +#' +#' @export +fix_smart <- function(text, all = FALSE) { + if (all) { + ## to remove all non-ascii symbols use ... + text <- stringi::stri_trans_general(text, "latin-ascii") + } else { + ## based on https://stackoverflow.com/a/1262210/1974918 + ## based on https://stackoverflow.com/a/54467895/1974918 + text <- gsub("\u2022", "*", text) %>% + gsub("\u2026", "...", .) %>% + gsub("\u2013", "-", .) %>% + gsub("\u2019", "'", .) %>% + gsub("\u2018", "'", .) %>% + gsub("\u201D", '"', .) %>% + gsub("\u201C", '"', .) + } + gsub("\r\n", "\n", text) %>% + gsub("\r", "\n", .) %>% + gsub("\f", "\n", .) +} + +#' Register a data.frame or list in Radiant +#' +#' @param new String containing the name of the data.frame to register +#' @param org Name of the original data.frame if a (working) copy is being made +#' @param descr Data description in markdown format +#' @param shiny Check if function is called from a shiny application +#' @param envir Environment to assign data to +#' +#' @importFrom shiny makeReactiveBinding getDefaultReactiveDomain +#' +#' @seealso See also \code{\link{add_description}} to add a description in markdown format +#' to a data.frame +#' +#' @export +register <- function(new, org = "", descr = "", shiny = shiny::getDefaultReactiveDomain(), envir = r_data) { + if (!is.null(shiny)) { + if (is.environment(envir)) { + if (length(new) > 1) { + message("Only one object can be registered at a time") + return(invisible()) + } else if (!is_string(new) || is.null(envir[[new]])) { + message("No dataset with that name (", new, ") has been loaded in Radiant") + return(invisible()) + } + } else { + message("Unable to assign data (", new, ") to ", envir, "as this does not seem to be an environment") + return(invisible()) + } + + if (is.data.frame(envir[[new]])) { + ## use data description from the original data.frame if available + if (!is.empty(descr)) { + r_info[[paste0(new, "_descr")]] <- descr + } else if (is.empty(r_info[[paste0(new, "_descr")]]) && !is.empty(org)) { + r_info[[paste0(new, "_descr")]] <- r_info[[paste0(org, "_descr")]] + } else { + r_info[[paste0(new, "_descr")]] <- attr(envir[[new]], "description") + } + + ## add description to the data.frame + attr(envir[[new]], "description") <- r_info[[paste0(new, "_descr")]] + + r_info[["datasetlist"]] <- c(new, r_info[["datasetlist"]]) %>% unique() + if (exists(new, envir = envir) && !bindingIsActive(as.symbol(new), env = envir)) { + shiny::makeReactiveBinding(new, env = envir) + } + } else if (is.list(envir[[new]])) { + r_info[["dtree_list"]] <- c(new, r_info[["dtree_list"]]) %>% unique() + } else { + ## See https://shiny.posit.co/reference/shiny/latest/modalDialog.html + showModal( + modalDialog( + title = "Data not registered", + span("Only data.frames can be registered"), + footer = modalButton("OK"), + size = "m", + easyClose = TRUE + ) + ) + } + } + invisible() +} + +#' Deregister a data.frame or list in Radiant +#' +#' @param dataset String containing the name of the data.frame to deregister +#' @param shiny Check if function is called from a shiny application +#' @param envir Environment to remove data from +#' @param info Reactive list with information about available data in radiant +#' +#' @importFrom shiny getDefaultReactiveDomain +#' +#' @export +deregister <- function(dataset, shiny = shiny::getDefaultReactiveDomain(), envir = r_data, info = r_info) { + if (is.null(shiny)) { + message("The deregister function should only be used in the radiant web application") + } else { + datasets <- info[["datasetlist"]] + if (!dataset %in% datasets) { + message("No dataset with that name (", dataset, ") has been loaded in Radiant") + } else { + info[[paste0(dataset, "_descr")]] <- NULL + info[[paste0(dataset, "_lcmd")]] <- NULL + info[[paste0(dataset, "_scmd")]] <- NULL + info[["datasetlist"]] <- setdiff(datasets, dataset) + rm(list = dataset, envir = envir) + } + } +} + +#' Parse file path into useful components +#' @details Parse file path into useful components (i.e., file name, file extension, relative path, etc.) +#' @param path Path to be parsed +#' @param chr Character to wrap around path for display +#' @param pdir Project directory if available +#' @param mess Print messages if Dropbox or Google Drive not found +#' @importFrom tools file_ext +#' @examples +#' list.files(".", full.names = TRUE)[1] %>% parse_path() +#' @export +parse_path <- function(path, chr = "", pdir = getwd(), mess = TRUE) { + if (inherits(path, "try-error") || is.empty(path)) { + return( + list(path = "", rpath = "", base = "", base_name = "", ext = "", content = "") + ) + } + + if (is.empty(pdir)) { + pdir <- try(rstudioapi::getActiveProject(), silent = TRUE) + if (inherits(pdir, "try-error") || is.empty(pdir)) { + pdir <- radiant.data::find_home() + } + } + + path <- normalizePath(path[1], winslash = "/", mustWork = FALSE) + filename <- basename(path) + fext <- tools::file_ext(filename) + + ## objname is used as the name of the data.frame without any spaces, dashes, etc. + objname <- sub(glue(".{fext}$"), "", filename, ignore.case = TRUE) %>% fix_names() + + fext <- tolower(fext) + + if (!is.empty(pdir) && grepl(glue("^{pdir}"), path)) { + rpath <- sub(glue("^{pdir}"), "", path) %>% sub("^/", "", .) + rpath <- glue("{chr}{rpath}{chr}") + } else { + dbdir <- getOption("radiant.dropbox_dir", "") + if (is.empty(dbdir)) { + dbdir <- try(radiant.data::find_dropbox(), silent = TRUE) + if (inherits(dbdir, "try-error") && mess) { + message("Not able to determine the location of a local the Dropbox folder") + dbdir <- "" + } + } + + if (!is.empty(dbdir) && grepl(glue("^{dbdir}"), path)) { + rpath <- sub(glue("^{dbdir}"), "", path) %>% sub("^/", "", .) + rpath <- glue('file.path(radiant.data::find_dropbox(), "{rpath}")') + } else { + gddir <- getOption("radiant.gdrive_dir", "") + if (is.empty(gddir)) { + gddir <- try(radiant.data::find_gdrive(), silent = TRUE) + if (inherits(gddir, "try-error") && mess) { + message("Not able to determine the location of a local Google Drive folder") + gddir <- "" + } + } + if (!is.empty(gddir) && grepl(glue("^{gddir}"), path)) { + rpath <- sub(glue("^{gddir}"), "", path) %>% sub("^/", "", .) + rpath <- glue('file.path(radiant.data::find_gdrive(), "{rpath}")') + } else { + rpath <- glue("{chr}{path}{chr}") + } + } + } + + list(path = path, rpath = rpath, filename = filename, fext = fext, objname = objname) +} + +#' Generate code to read a file +#' @details Return code to read a file at the specified path. Will open a file browser if no path is provided +#' @param path Path to file. If empty, a file browser will be opened +#' @param pdir Project dir +#' @param type Generate code for _Report > Rmd_ ("rmd") or _Report > R_ ("r") +#' @param to Name to use for object. If empty, will use file name to derive an object name +#' @param clipboard Return code to clipboard (not available on Linux) +#' @param radiant Should returned code be formatted for use with other code generated by Radiant? +#' @examples +#' if (interactive()) { +#' read_files(clipboard = FALSE) +#' } +#' @importFrom rstudioapi selectFile isAvailable +#' @export +read_files <- function(path, pdir = "", type = "rmd", to = "", clipboard = TRUE, radiant = FALSE) { + ## if no path is provided, an interactive file browser will be opened + if (missing(path) || is.empty(path)) { + if (rstudioapi::isAvailable()) { + pdir <- getOption("radiant.project_dir", default = rstudioapi::getActiveProject()) + path <- rstudioapi::selectFile( + caption = "Generate code to read file", + filter = "All files (*)", + path = pdir + ) + } else { + path <- try(choose_files(), silent = TRUE) + pdir <- getwd() + } + if (inherits(path, "try-error") || is.empty(path)) { + return("") + } else { + pp <- parse_path(path, pdir = pdir, chr = "\"", mess = FALSE) + } + } else { + if (is.empty(pdir)) { + pp <- parse_path(path, chr = "\"", mess = FALSE) + } else { + pp <- parse_path(path, pdir = pdir, chr = "\"", mess = FALSE) + } + } + + if (to == "") { + to <- gsub("\\s+", "_", pp$objname) %>% radiant.data::fix_names() + } + if (pp$fext %in% c("rda", "rdata")) { + cmd <- glue('## loaded object assigned to {to[1]}\n{to[1]} <- load({pp$rpath}) %>% get()\nregister("{to[1]}")') + } else if (pp$fext == "rds") { + cmd <- glue('{to} <- readr::read_rds({pp$rpath})\nregister("{pp$objname}")') + } else if (pp$fext == "csv") { + cmd <- glue(' + {to} <- readr::read_csv({pp$rpath}) %>% + fix_names() %>% + to_fct() + register("{pp$objname}")') + } else if (pp$fext == "tsv") { + cmd <- glue(' + {to} <- readr::read_tsv({pp$rpath}) %>% + fix_names() %>% + to_fct() + register("{pp$objname}")') + } else if (pp$fext %in% c("xls", "xlsx")) { + cmd <- glue(' + {to} <- readxl::read_excel({pp$rpath}, sheet = 1) %>% + fix_names() %>% + to_fct() + register("{pp$objname}")') + } else if (pp$fext == "feather") { + ## waiting for https://github.com/wesm/feather/pull/326 + # cmd <- paste0(to, " <- feather::read_feather(", pp$rpath, ", columns = c())\nregister(\"", pp$objname, "\", desc = feather::feather_metadata(\"", pp$rpath, "\")$description)") + cmd <- glue('{to} <- feather::read_feather({pp$rpath}, columns = c())\nregister("{pp$objname}")') + } else if (pp$fext %in% c("dta", "save", "sas7bdat")) { + cmd <- glue('{to} <- rio::import({pp$rpath})\nregister("{pp$objname}")') + } else if (pp$fext == "yaml") { + cmd <- glue('{to} <- yaml::yaml.load_file({pp$rpath})\nregister("{pp$objname}")') + } else if (grepl("sqlite", pp$fext)) { + obj <- glue("{pp$objname}_tab1") + cmd <- "## see https://solutions.posit.co/connections/db/r-packages/dplyr/\n" %>% + glue('library(DBI)\ncon <- dbConnect(RSQLite::SQLite(), dbname = {pp$rpath})\n(tables <- dbListTables(con))\n{obj} <- dplyr::tbl(con, from = tables[1]) %>% collect()\ndbDisconnect(con)\nregister("{obj}")') + } else if (pp$fext == "sql") { + if (type == "rmd") { + cmd <- "/* see https://bookdown.org/yihui/rmarkdown/language-engines.html */\n" %>% + paste0(paste0(readLines(pp$path), collapse = "\n")) + cmd <- glue("\n\n```{sql, connection = con, max.print = 20}\n<>\n```\n\n", .open = "<<", .close = ">>") + type <- "" + } else { + cmd <- glue("{to} <- readLines({pp$rpath})") + } + } else if (pp$fext %in% c("py", "css", "js")) { + if (type == "rmd") { + cmd <- "## see https://bookdown.org/yihui/rmarkdown/language-engines.html\n" %>% + paste0(paste0(readLines(pp$path), collapse = "\n")) + cmd <- glue('\n\n```{<>}\n<>\n```\n\n', .open = "<<", .close = ">>") + type <- "" + } else { + cmd <- glue("{to} <- readLines({pp$rpath})") + } + } else if (pp$fext %in% c("md", "rmd")) { + if (type == "rmd") { + cmd <- glue("\n```{r child = <>}\n```\n", .open = "<<", .close = ">>") + type <- "" + } else { + cmd <- glue("{to} <- readLines({pp$rpath})") + } + } else if (pp$fext == "txt") { + cmd <- glue("{to} <- readLines({pp$rpath})") + } else if (pp$fext %in% c("jpg", "jpeg", "png", "pdf")) { + if (type == "rmd") { + cmd <- glue("\n\n![](`r {pp$rpath}`)\n\n") + if (!grepl("file.path", cmd)) cmd <- sub("`r \"", "", cmd) %>% sub("\"`", "", .) + type <- "" + } else { + cmd <- "## see https://cran.r-project.org/web/packages/magick/vignettes/intro.html\n" %>% + glue("{to} <- magick::image_read({pp$rpath})") + } + } else if (pp$fext %in% c("r", "R")) { + cmd <- glue("source({pp$rpath}, local = TRUE, echo = TRUE)") + } else { + cmd <- pp$rpath + } + + if (type == "rmd") { + cmd <- paste0("\n```{r}\n", cmd, "\n```\n") + } else if (type == "r") { + cmd <- paste0("\n", cmd, "\n") + } + + if (radiant) { + cmd + } else { + ## if not in Radiant remove register calls + cmd <- gsub("\nregister\\(.*?\\)", "", cmd) + if (clipboard) { + os_type <- Sys.info()["sysname"] + if (os_type == "Windows") { + cat(cmd, file = "clipboard") + } else if (os_type == "Darwin") { + pipe("pbcopy") %T>% cat(cmd, file = .) %>% close() + } + } else { + cat(cmd) + } + return(invisible(cmd)) + } +} diff --git a/radiant.data/R/transform.R b/radiant.data/R/transform.R new file mode 100644 index 0000000000000000000000000000000000000000..4a84ee40ec8fd6541fc9e0960e12feae8de9c255 --- /dev/null +++ b/radiant.data/R/transform.R @@ -0,0 +1,764 @@ +#' Center +#' @param x Input variable +#' @param na.rm If TRUE missing values are removed before calculation +#' @return If x is a numeric variable return x - mean(x) +#' @export +center <- function(x, na.rm = TRUE) { + if (is.numeric(x)) { + x - mean(x, na.rm = na.rm) + } else { + x + } +} + +#' Standardize +#' @param x Input variable +#' @param na.rm If TRUE missing values are removed before calculation +#' @return If x is a numeric variable return (x - mean(x)) / sd(x) +#' @export +standardize <- function(x, na.rm = TRUE) { + if (is.numeric(x)) { + x_sd <- sd(x, na.rm = na.rm) + x <- x - mean(x, na.rm = na.rm) + if (isTRUE(x_sd > 0)) { + x / x_sd + } else { + x + } + } else { + x + } +} + +#' Calculate square of a variable +#' @param x Input variable +#' @return x^2 +#' @export +square <- function(x) x^2 + +#' Calculate inverse of a variable +#' @param x Input variable +#' @return 1/x +#' @export +inverse <- function(x) { + if (is.numeric(x)) 1 / x else x +} + +#' Normalize a variable x by a variable y +#' @param x Input variable +#' @param y Normalizing variable +#' @return x/y +#' @export +normalize <- function(x, y) { + if (is.numeric(x) && is.numeric(y)) x / y else x +} + +#' Convert input in month-day-year format to date +#' @details Use as.character if x is a factor +#' @param x Input variable +#' @return Date variable of class Date +#' @examples +#' as_mdy("2-1-2014") +#' \dontrun{ +#' as_mdy("2-1-2014") %>% month(label = TRUE) +#' as_mdy("2-1-2014") %>% week() +#' as_mdy("2-1-2014") %>% wday(label = TRUE) +#' } +#' @export +as_mdy <- function(x) { + if (is.factor(x)) x <- as.character(x) + sshhr(mdy(x)) %>% as.Date() +} + +#' Convert input in day-month-year format to date +#' @param x Input variable +#' @return Date variable of class Date +#' @examples +#' as_dmy("1-2-2014") +#' +#' @export +as_dmy <- function(x) { + if (is.factor(x)) x <- as.character(x) + sshhr(dmy(x)) %>% as.Date() +} + +#' Convert input in year-month-day format to date +#' @param x Input variable +#' @return Date variable of class Date +#' @examples +#' as_ymd("2013-1-1") +#' +#' @export +as_ymd <- function(x) { + if (is.factor(x)) x <- as.character(x) + sshhr(ymd(x)) %>% as.Date() +} + +# http://www.noamross.net/blog/2014/2/10/using-times-and-dates-in-r---presentation-code.html +#' Convert input in year-month-day-hour-minute-second format to date-time +#' @param x Input variable +#' @return Date-time variable of class Date +#' @examples +#' as_ymd_hms("2014-1-1 12:15:01") +#' \dontrun{ +#' as_ymd_hms("2014-1-1 12:15:01") %>% as.Date() +#' as_ymd_hms("2014-1-1 12:15:01") %>% month() +#' as_ymd_hms("2014-1-1 12:15:01") %>% hour() +#' } +#' @export +as_ymd_hms <- function(x) { + if (is.factor(x)) x <- as.character(x) + sshhr(ymd_hms(x)) +} + +#' Convert input in year-month-day-hour-minute format to date-time +#' @param x Input variable +#' @return Date-time variable of class Date +#' @examples +#' as_ymd_hm("2014-1-1 12:15") +#' @export +as_ymd_hm <- function(x) { + if (is.factor(x)) x <- as.character(x) + sshhr(parse_date_time(x, "%Y%m%d %H%M")) +} + +#' Convert input in month-day-year-hour-minute-second format to date-time +#' @param x Input variable +#' @return Date-time variable of class Date +#' @examples +#' as_mdy_hms("1-1-2014 12:15:01") +#' @export +as_mdy_hms <- function(x) { + if (is.factor(x)) x <- as.character(x) + sshhr(parse_date_time(x, "%m%d%Y %H%M%S")) +} + +#' Convert input in month-day-year-hour-minute format to date-time +#' @param x Input variable +#' @return Date-time variable of class Date +#' @examples +#' as_mdy_hm("1-1-2014 12:15") +#' @export +as_mdy_hm <- function(x) { + if (is.factor(x)) x <- as.character(x) + sshhr(parse_date_time(x, "%m%d%Y %H%M")) +} + +#' Convert input in day-month-year-hour-minute-second format to date-time +#' @param x Input variable +#' @return Date-time variable of class Date +#' @examples +#' as_mdy_hms("1-1-2014 12:15:01") +#' @export +as_dmy_hms <- function(x) { + if (is.factor(x)) x <- as.character(x) + sshhr(parse_date_time(x, "%d%m%Y %H%M%S")) +} + +#' Convert input in day-month-year-hour-minute format to date-time +#' @param x Input variable +#' @return Date-time variable of class Date +#' @examples +#' as_mdy_hm("1-1-2014 12:15") +#' @export +as_dmy_hm <- function(x) { + if (is.factor(x)) x <- as.character(x) + sshhr(parse_date_time(x, "%d%m%Y %H%M")) +} + +#' Convert input in hour-minute-second format to time +#' @param x Input variable +#' @return Time variable of class Period +#' @examples +#' as_hms("12:45:00") +#' \dontrun{ +#' as_hms("12:45:00") %>% hour() +#' as_hms("12:45:00") %>% second() +#' } +#' @export +as_hms <- function(x) { + if (is.factor(x)) x <- as.character(x) + sshhr(hms(x)) +} + +#' Convert input in hour-minute format to time +#' @param x Input variable +#' @return Time variable of class Period +#' @examples +#' as_hm("12:45") +#' \dontrun{ +#' as_hm("12:45") %>% minute() +#' } +#' @export +as_hm <- function(x) { + if (is.factor(x)) x <- as.character(x) + sshhr(hm(x)) +} + +#' Convert variable to integer avoiding potential issues with factors +#' @param x Input variable +#' @return Integer +#' @examples +#' as_integer(rnorm(10)) +#' as_integer(letters) +#' as_integer(as.factor(5:10)) +#' as.integer(as.factor(5:10)) +#' as_integer(c("a", "b")) +#' as_integer(c("0", "1")) +#' as_integer(as.factor(c("0", "1"))) +#' +#' @export +as_integer <- function(x) { + if (is.factor(x)) { + int <- sshhr(levels(x) %>% .[x] %>% as.integer()) + if (length(na.omit(int)) == 0) as.integer(x) else int + } else if (is.character(x)) { + int <- sshhr(as.integer(x)) + if (length(na.omit(int)) == 0) as_integer(as.factor(x)) else int + } else { + as.integer(x) + } +} + +#' Convert variable to numeric avoiding potential issues with factors +#' @param x Input variable +#' @return Numeric +#' @examples +#' as_numeric(rnorm(10)) +#' as_numeric(letters) +#' as_numeric(as.factor(5:10)) +#' as.numeric(as.factor(5:10)) +#' as_numeric(c("a", "b")) +#' as_numeric(c("3", "4")) +#' as_numeric(as.factor(c("3", "4"))) +#' +#' @export +as_numeric <- function(x) { + if (is.factor(x)) { + num <- sshhr(levels(x) %>% .[x] %>% as.numeric()) + if (length(na.omit(num)) == 0) as.numeric(x) else num + } else if (is.character(x)) { + num <- sshhr(as.numeric(x)) + if (length(na.omit(num)) == 0) as_numeric(as.factor(x)) else num + } else { + as.numeric(x) + } +} + +#' Wrapper for factor with ordered = FALSE +#' @param x Input vector +#' @param ordered Order factor levels (TRUE, FALSE) +#' @export +as_factor <- function(x, ordered = FALSE) factor(x, ordered = ordered) + +#' Wrapper for as.character +#' @param x Input vector +#' @export +as_character <- function(x) as.character(x) + +#' Wrapper for lubridate's as.duration function. Result converted to numeric +#' @param x Time difference +#' @export +as_duration <- function(x) as.numeric(lubridate::as.duration(x)) + +#' Distance in kilometers or miles between two locations based on lat-long +#' Function based on \url{http://www.movable-type.co.uk/scripts/latlong.html}. Uses the haversine formula +#' @param long1 Longitude of location 1 +#' @param lat1 Latitude of location 1 +#' @param long2 Longitude of location 2 +#' @param lat2 Latitude of location 2 +#' @param unit Measure kilometers ("km", default) or miles ("miles") +#' @param R Radius of the earth +#' @return Distance between two points +#' @examples +#' as_distance(32.8245525, -117.0951632, 40.7033127, -73.979681, unit = "km") +#' as_distance(32.8245525, -117.0951632, 40.7033127, -73.979681, unit = "miles") +#' +#' @export +as_distance <- function(lat1, long1, lat2, long2, + unit = "km", R = c("km" = 6371, "miles" = 3959)[[unit]]) { + rad <- pi / 180 + d1 <- lat1 * rad + d2 <- lat2 * rad + dlat <- (lat2 - lat1) * rad + dlong <- (long2 - long1) * rad + a <- sin(dlat / 2)^2 + cos(d1) * cos(d2) * sin(dlong / 2)^2 + c <- 2 * atan2(sqrt(a), sqrt(1 - a)) + R * c +} + +#' Generate a variable used to selected a training sample +#' @param n Number (or fraction) of observations to label as training +#' @param nr Number of rows in the dataset +#' @param blocks A vector to use for blocking or a data.frame from which to construct a blocking vector +#' @param seed Random seed +#' +#' @return 0/1 variables for filtering +#' +#' @importFrom randomizr complete_ra block_ra +#' +#' @examples +#' make_train(.5, 10) +#' make_train(.5, 10) %>% table() +#' make_train(100, 1000) %>% table() +#' make_train(.15, blocks = mtcars$vs) %>% table() / nrow(mtcars) +#' make_train(.10, blocks = iris$Species) %>% table() / nrow(iris) +#' make_train(.5, blocks = iris[, c("Petal.Width", "Species")]) %>% table() +#' +#' @export +make_train <- function(n = .7, nr = NULL, blocks = NULL, seed = 1234) { + seed <- gsub("[^0-9]", "", seed) + if (!is.empty(seed)) set.seed(seed) + + if (is.empty(nr) && is.empty(blocks)) { + stop("Please provided the number of rows in the data (nr) or a vector with blocking information (blocks)") + } else if (is.data.frame(blocks)) { + blocks <- do.call(paste, c(blocks, sep = "-")) + nr <- length(blocks) + } else if (is.vector(blocks)) { + nr <- length(blocks) + } + + if (n > 1) n <- n / nr + + if (length(blocks) > 0) { + randomizr::block_ra(blocks, prob = n) + } else { + randomizr::complete_ra(N = nr, prob = n) + } +} + +#' Add transformed variables to a data frame with the option to include a custom variable name extension +#' +#' @details Wrapper for dplyr::mutate_at that allows custom variable name extensions +#' +#' @param .tbl Data frame to add transformed variables to +#' @param .funs Function(s) to apply (e.g., log) +#' @param ... Variables to transform +#' @param .ext Extension to add for each variable +#' @param .vars A list of columns generated by dplyr::vars(), or a character vector of column names, or a numeric vector of column positions. +#' +#' @examples +#' mutate_ext(mtcars, .funs = log, mpg, cyl, .ext = "_ln") +#' mutate_ext(mtcars, .funs = log, .ext = "_ln") +#' mutate_ext(mtcars, .funs = log) +#' mutate_ext(mtcars, .funs = log, .ext = "_ln", .vars = vars(mpg, cyl)) +#' +#' @export +mutate_ext <- function(.tbl, .funs, ..., .ext = "", .vars = c()) { + if (length(.vars) == 0) { + ## from https://stackoverflow.com/a/35317870/1974918 + .vars <- sapply(substitute(list(...))[-1], deparse) + if (length(.vars) == 0) { + .vars <- colnames(.tbl) + } + } + + if (is.empty(.ext)) { + dplyr::mutate_at(.tbl, .vars = .vars, .funs = .funs) %>% + set_rownames(rownames(.tbl)) + } else { + new <- gsub("^~", "", .vars) %>% paste0(., .ext) + .tbl[, new] <- transmute_at(.tbl, .vars = .vars, .funs = .funs) %>% + set_colnames(new) + .tbl + } +} + +#' Split a numeric variable into a number of bins and return a vector of bin numbers +#' +#' @param x Numeric variable +#' @param n number of bins to create +#' @param rev Reverse the order of the bin numbers +#' @param type An integer between 1 and 9 to select one of the quantile algorithms described in the help for the stats::quantile function +#' +#' @seealso See \link[stats]{quantile} for a description of the different algorithm types +#' +#' @examples +#' xtile(1:10, 5) +#' xtile(1:10, 5, rev = TRUE) +#' xtile(c(rep(1, 6), 7:10), 5) +#' +#' @export +xtile <- function(x, n = 5, rev = FALSE, type = 7) { + if (!is.numeric(x)) { + stop(paste0("The variable to bin must be of type {numeric} but is of type {", class(x)[1], "}"), call. = FALSE) + } else if (n < 1) { + stop(paste0("The number of bins must be > 1 but is ", n), call. = FALSE) + } else if (length(x) < n) { + stop(paste("The number of bins to create is larger than\nthe number of data points. Perhaps you grouped the data before\ncalling the xtile function and the number of observations per\ngroup is too small"), call. = FALSE) + } else if (type < 1 || type > 9) { + stop(paste("The value for type is", type, "but must be between 1 and 9"), call. = FALSE) + } + + breaks <- quantile(x, prob = seq(0, 1, length = n + 1), na.rm = TRUE, type = type) + if (length(breaks) < 2) stop(paste("Insufficient variation in x to construct", n, "breaks"), call. = FALSE) + bins <- .bincode(x, breaks, include.lowest = TRUE) + + if (rev) as.integer((n + 1) - bins) else bins +} + +#' Show all rows with duplicated values (not just the first or last) +#' +#' @details If an entire row is duplicated use "duplicated" to show only one of the duplicated rows. When using a subset of variables to establish uniqueness it may be of interest to show all rows that have (some) duplicate elements +#' +#' @param .tbl Data frame to add transformed variables to +#' @param ... Variables used to evaluate row uniqueness +#' +#' @examples +#' bind_rows(mtcars, mtcars[c(1, 5, 7), ]) %>% +#' show_duplicated(mpg, cyl) +#' bind_rows(mtcars, mtcars[c(1, 5, 7), ]) %>% +#' show_duplicated() +#' +#' @export +show_duplicated <- function(.tbl, ...) { + .vars <- sapply(substitute(list(...))[-1], deparse) + if (length(.vars) == 0 || length(unique(.vars)) == ncol(.tbl)) { + filter(.tbl, duplicated(.tbl)) + } else { + .tbl %>% + group_by_at(.vars = .vars) %>% + filter(n() > 1) %>% + mutate(nr_dup = 1:n()) %>% + arrange_at(.vars = .vars) %>% + ungroup() + } +} + +#' Weighted standard deviation +#' +#' @details Calculate weighted standard deviation +#' +#' @param x Numeric vector +#' @param wt Numeric vector of weights +#' @param na.rm Remove missing values (default is TRUE) +#' +#' @export +weighted.sd <- function(x, wt, na.rm = TRUE) { + if (na.rm) { + ind <- is.na(x) | is.na(wt) + x <- x[!ind] + wt <- wt[!ind] + } + wt <- wt / sum(wt) + wm <- weighted.mean(x, wt) + sqrt(sum(wt * (x - wm)^2)) +} + +#' Create data.frame summary +#' +#' @details Used in Radiant's Data > Transform tab +#' +#' @param dataset Data.frame +#' @param dc Class for each variable +#' @param dec Number of decimals to show +#' +#' @export +get_summary <- function(dataset, dc = get_class(dataset), dec = 3) { + isFct <- "factor" == dc + isNum <- dc %in% c("numeric", "integer", "Duration") + isDate <- "date" == dc + isChar <- "character" == dc + isLogic <- "logical" == dc + isPeriod <- "period" == dc + isTs <- "ts" == dc + + if (sum(isNum) > 0) { + cn <- names(dc)[isNum] + + cat("Summarize numeric variables:\n") + select(dataset, which(isNum)) %>% + gather("variable", "values", !!cn, factor_key = TRUE) %>% + group_by_at(.vars = "variable") %>% + summarise_all( + list( + n_obs = n_obs, + n_missing = n_missing, + n_distinct = n_distinct, + mean = mean, + median = median, + min = min, + max = max, + p25 = p25, + p75 = p75, + sd = sd, + se = se + ), + na.rm = TRUE + ) %>% + data.frame(check.names = FALSE, stringsAsFactors = FALSE) %>% + format_df(dec = dec, mark = ",") %>% + set_colnames(c("", colnames(.)[-1])) %>% + print(row.names = FALSE) + cat("\n") + } + + if (sum(isTs) > 0) { + cn <- names(dc)[isTs] + + cat("Summarize time-series variables:\n") + lapply( + select(dataset, which(isTs)), + function(x) { + as.data.frame(x) %>% + summarise_all( + list( + n_obs = n_obs, + n_missing = n_missing, + n_distinct = n_distinct, + mean = mean, + median = median, + min = min, + max = max, + start = ~ attr(., "tsp")[1] %>% round(dec), + end = ~ attr(., "tsp")[2] %>% round(dec), + frequency = ~ attr(., "tsp")[3] %>% as.integer() + ), + na.rm = TRUE + ) + } + ) %>% + bind_rows() %>% + data.frame(check.names = FALSE, stringsAsFactors = FALSE) %>% + data.frame(.vars = cn, .) %>% + format_df(dec = 3, mark = ",") %>% + set_colnames(c("", colnames(.)[-1])) %>% + print(row.names = FALSE) + cat("\n") + } + + if (sum(isFct) > 0) { + cat("Summarize factors:\n") + select(dataset, which(isFct)) %>% + summary(maxsum = 20) %>% + print() + cat("\n") + } + + if (sum(isDate) > 0) { + cat("Earliest dates:\n") + select(dataset, which(isDate)) %>% + summarise_all(min) %>% + as.data.frame(stringsAsFactors = FALSE) %>% + print(row.names = FALSE) + cat("\nFinal dates:\n") + select(dataset, which(isDate)) %>% + summarise_all(max) %>% + as.data.frame(stringsAsFactors = FALSE) %>% + print(row.names = FALSE) + + cat("\n") + } + + if (sum(isPeriod) > 0) { + max_time <- function(x) sort(x) %>% tail(1) + min_time <- function(x) sort(x) %>% head(1) + + cat("Earliest time:\n") + select(dataset, which(isPeriod)) %>% + summarise_all(min_time) %>% + as.data.frame(stringsAsFactors = FALSE) %>% + print(row.names = FALSE) + cat("\nFinal time:\n") + select(dataset, which(isPeriod)) %>% + summarise_all(max_time) %>% + as.data.frame(stringsAsFactors = FALSE) %>% + print(row.names = FALSE) + cat("\n") + } + + if (sum(isChar) > 0) { + ## finding unique elements can be slow for large files + if (nrow(dataset) < 10^5) { + cat("Summarize character variables (< 20 unique values shown):\n") + select(dataset, which(isChar)) %>% + lapply(unique) %>% + (function(x) { + for (i in names(x)) { + cat(i, paste0("(n_distinct ", length(x[[i]]), "): "), x[[i]][1:min(20, length(x[[i]]))], "\n") + } + }) + } else { + cat("Summarize character variables (< 20 values shown):\n") + select(dataset, which(isChar)) %>% + (function(x) { + for (i in names(x)) { + cat(i, ":", x[[i]][1:min(20, length(x[[i]]))], "\n") + } + }) + } + cat("\n") + } + if (sum(isLogic) > 0) { + cat("Summarize logical variables:\n") + select(dataset, which(isLogic)) %>% + summarise_all(list(x = ~ sum(., na.rm = TRUE), y = ~ mean(., na.rm = TRUE), z = ~ n_missing(.))) %>% + round(dec) %>% + matrix(ncol = 3) %>% + as.data.frame(stringsAsFactors = FALSE) %>% + set_colnames(c("# TRUE", "% TRUE", "n_missing")) %>% + set_rownames(names(dataset)[isLogic]) %>% + format(big.mark = ",", scientific = FALSE) %>% + print() + cat("\n") + } +} + +#' Create data.frame from a table +#' +#' @param dataset Data.frame +#' @param freq Column name with frequency information +#' +#' @examples +#' data.frame(price = c("$200", "$300"), sale = c(10, 2)) %>% table2data() +#' +#' @export +table2data <- function(dataset, freq = tail(colnames(dataset), 1)) { + if (!is.numeric(dataset[[freq]])) stop("The frequency variable must be numeric", call = FALSE) + blowup <- function(i) { + if (!is.na(dataset[[freq]][i])) dataset[rep(i, each = dataset[[freq]][i]), ] + } + + lapply(seq_len(nrow(dataset)), blowup) %>% + bind_rows() %>% + select_at(.vars = base::setdiff(colnames(dataset), freq)) %>% + mutate_all(as.factor) +} + +#' Generate list of levels and unique values +#' +#' @param dataset A data.frame +#' @param ... Unquoted variable names to evaluate +#' +#' @examples +#' data.frame(a = c(rep("a", 5), rep("b", 5)), b = c(rep(1, 5), 6:10)) %>% level_list() +#' level_list(mtcars, mpg, cyl) +#' +#' @export +level_list <- function(dataset, ...) { + fl <- function(x) { + if ("factor" %in% class(x)) { + levels(x) + } else { + unique(x) + } + } + .vars <- sapply(substitute(list(...))[-1], deparse) + if (length(.vars) > 0) { + lapply(select_at(dataset, .vars = .vars), fl) + } else { + lapply(dataset, fl) + } +} + +#' Add ordered argument to lubridate::month +#' @param x Input date vector +#' @param label Month as label (TRUE, FALSE) +#' @param abbr Abbreviate label (TRUE, FALSE) +#' @param ordered Order factor (TRUE, FALSE) +#' +#' @importFrom lubridate month +#' +#' @seealso See the \code{\link[lubridate]{month}} function in the lubridate package for additional details +#' +#' @export +month <- function(x, label = FALSE, abbr = TRUE, ordered = FALSE) { + x <- lubridate::month(x, label = label, abbr = abbr) + if (!ordered && label) { + factor(x, ordered = FALSE) + } else { + x + } +} + +#' Add ordered argument to lubridate::wday +#' @param x Input date vector +#' @param label Weekday as label (TRUE, FALSE) +#' @param abbr Abbreviate label (TRUE, FALSE) +#' @param ordered Order factor (TRUE, FALSE) +#' +#' @importFrom lubridate wday +#' +#' @seealso See the \code{\link[lubridate:day]{lubridate::wday()}} function in the lubridate package for additional details +#' +#' @export +wday <- function(x, label = FALSE, abbr = TRUE, ordered = FALSE) { + x <- lubridate::wday(x, label = label, abbr = abbr) + if (!ordered && label) { + factor(x, ordered = FALSE) + } else { + x + } +} + +#' Remove/reorder levels +#' @details Keep only a specific set of levels in a factor. By removing levels the base for comparison in, e.g., regression analysis, becomes the first level. To relabel the base use, for example, repl = 'other' +#' @param x Character or Factor +#' @param levs Set of levels to use +#' @param repl String (or NA) used to replace missing levels +#' +#' @examples +#' refactor(diamonds$cut, c("Premium", "Ideal")) %>% head() +#' refactor(diamonds$cut, c("Premium", "Ideal"), "Other") %>% head() +#' +#' @export +refactor <- function(x, levs = levels(x), repl = NA) { + if (is.factor(x)) { + lv <- levels(x) + } else { + lv <- unique(x) + if (length(levs) == 0) levs <- lv + } + + if (length(levs) > 0 && length(lv) > length(levs)) { + if (!is.empty(repl)) levs <- unique(c(repl, levs)) + x <- as_character(x) %>% ifelse(. %in% base::setdiff(lv, levs), repl, .) + } + + factor(x, levels = levs) +} + +#' Convert a string of numbers into a vector +#' +#' @param x A string of numbers that may include fractions +#' +#' @importFrom MASS fractions +#' +#' @examples +#' make_vec("1 2 4") +#' make_vec("1/2 2/3 4/5") +#' make_vec(0.1) +#' @export +make_vec <- function(x) { + if (is.empty(x)) { + return(NULL) + } else if (!is.character(x)) { + return(x) + } + + any_frac <- FALSE + check_frac <- function(x) { + if (length(x) == 2) { + any_frac <<- TRUE + as.numeric(x[1]) / as.numeric(x[2]) + } else { + as.numeric(x) + } + } + x <- strsplit(x, "(\\s*,\\s*|\\s*;\\s*|\\s+)") %>% + unlist() %>% + strsplit("\\s*/\\s*") %>% + sapply(check_frac) + + if (any_frac) { + MASS::fractions(x) + } else { + x + } +} + +############################### +## function below not exported +############################### +.recode. <- function(x, cmd) car::Recode(x, cmd) \ No newline at end of file diff --git a/radiant.data/R/view.R b/radiant.data/R/view.R new file mode 100644 index 0000000000000000000000000000000000000000..12c36977d55688014c996b09db222475ff3832cf --- /dev/null +++ b/radiant.data/R/view.R @@ -0,0 +1,312 @@ +#' Method to create datatables +#' +#' @param object Object of relevant class to render +#' @param ... Additional arguments +#' +#' @seealso See \code{\link{dtab.data.frame}} to create an interactive table from a data.frame +#' @seealso See \code{\link{dtab.explore}} to create an interactive table from an \code{\link{explore}} object +#' @seealso See \code{\link{dtab.pivotr}} to create an interactive table from a \code{\link{pivotr}} object +#' +#' @export +dtab <- function(object, ...) UseMethod("dtab", object) + +#' Create an interactive table to view, search, sort, and filter data +#' +#' @details View, search, sort, and filter a data.frame. For styling options see \url{https://rstudio.github.io/DT/functions.html} +#' +#' @param object Data.frame to display +#' @param vars Variables to show (default is all) +#' @param filt Filter to apply to the specified dataset. For example "price > 10000" if dataset is "diamonds" (default is "") +#' @param arr Expression to arrange (sort) the data on (e.g., "color, desc(price)") +#' @param rows Select rows in the specified dataset. For example "1:10" for the first 10 rows or "n()-10:n()" for the last 10 rows (default is NULL) +#' @param nr Number of rows of data to include in the table. This function will be mainly used in reports so it is best to keep this number small +#' @param na.rm Remove rows with missing values (default is FALSE) +#' @param dec Number of decimal places to show. Default is no rounding (NULL) +#' @param perc Vector of column names to be displayed as a percentage +#' @param filter Show column filters in DT table. Options are "none", "top", "bottom" +#' @param pageLength Number of rows to show in table +#' @param dom Table control elements to show on the page. See \url{https://datatables.net/reference/option/dom} +#' @param style Table formatting style ("bootstrap" or "default") +#' @param rownames Show data.frame rownames. Default is FALSE +#' @param caption Table caption +#' @param envir Environment to extract data from +#' @param ... Additional arguments +#' +#' @importFrom shiny tags +#' @examples +#' \dontrun{ +#' dtab(mtcars) +#' } +#' +#' @export +dtab.data.frame <- function(object, vars = "", filt = "", arr = "", rows = NULL, + nr = NULL, na.rm = FALSE, dec = 3, perc = "", + filter = "top", pageLength = 10, dom = "", + style = "bootstrap4", rownames = FALSE, + caption = NULL, + envir = parent.frame(), ...) { + ## does this need a data_view_rows argument? + dat <- get_data(object, vars, filt = filt, arr = arr, rows = rows, na.rm = na.rm, envir = envir) + if (!is.empty(nr) && nr < nrow(dat)) { + dat <- dat[seq_len(nr), , drop = FALSE] + } + + ## for rounding + isInt <- sapply(dat, is.integer) + isDbl <- sapply(dat, is_double) + dec <- ifelse(is.empty(dec) || dec < 0, 3, round(dec, 0)) + + ## don't do normal rounding for perc variables + isInt[intersect(names(isInt), perc)] <- FALSE + isDbl[intersect(names(isDbl), perc)] <- FALSE + + ## avoid factor with a huge number of levels + isBigFct <- function(x) is.factor(x) && length(levels(x)) > 1000 + dat <- mutate_if(dat, isBigFct, as.character) + + ## for display options see https://datatables.net/reference/option/dom + if (is.empty(dom)) { + dom <- if (pageLength == -1 || nrow(dat) < pageLength) "t" else "lftip" + } + + if (!is.empty(caption)) { + ## from https://github.com/rstudio/DT/issues/630#issuecomment-461191378 + caption <- shiny::tags$caption(style = "caption-side: bottom; text-align: left; font-size:100%;", caption) + } + + dt_tab <- DT::datatable( + dat, + caption = caption, + filter = filter, + selection = "none", + rownames = rownames, + ## must use fillContainer = FALSE to address + ## see https://github.com/rstudio/DT/issues/367 + ## https://github.com/rstudio/DT/issues/379 + fillContainer = FALSE, + escape = FALSE, + style = style, + options = list( + dom = dom, + search = list(regex = TRUE), + columnDefs = list( + list(orderSequence = c("desc", "asc"), targets = "_all"), + list(className = "dt-center", targets = "_all") + ), + autoWidth = TRUE, + processing = FALSE, + pageLength = pageLength, + lengthMenu = list(c(5, 10, 25, 50, -1), c("5", "10", "25", "50", "All")) + ) + ) + + ## rounding as needed + if (sum(isDbl) > 0) { + dt_tab <- DT::formatRound(dt_tab, colnames(dat)[isDbl], digits = dec) + } + if (sum(isInt) > 0) { + dt_tab <- DT::formatRound(dt_tab, colnames(dat)[isInt], digits = 0) + } + if (!is.empty(perc)) { + dt_tab <- DT::formatPercentage(dt_tab, perc, digits = dec) + } + + ## see https://github.com/yihui/knitr/issues/1198 + dt_tab$dependencies <- c( + list(rmarkdown::html_dependency_bootstrap("bootstrap")), + dt_tab$dependencies + ) + + dt_tab +} + +#' Filter data with user-specified expression +#' @details Filters can be used to view a sample from a selected dataset. For example, runif(nrow(.)) > .9 could be used to sample approximately 10% of the rows in the data and 1:nrow(.) < 101 would select only the first 100 rows in the data. Note: "." references the currently selected dataset. +#' @param dataset Data frame to filter +#' @param filt Filter expression to apply to the specified dataset +#' @param drop Drop unused factor levels after filtering (default is TRUE) +#' @return Filtered data frame +#' @examples +#' select(diamonds, 1:3) %>% filter_data(filt = "price > max(.$price) - 100") +#' select(diamonds, 1:3) %>% filter_data(filt = "runif(nrow(.)) > .995") +#' @export +filter_data <- function(dataset, filt = "", drop = TRUE) { + if (grepl("([^=!<>])=([^=])", filt)) { + message("Invalid filter: Never use = in a filter. Use == instead (e.g., year == 2014). Update or remove the expression") + } else { + filter_dat <- try(dataset %>% filter(!!rlang::parse_expr(filt)), silent = TRUE) + if (inherits(filter_dat, "try-error")) { + message(paste0("Invalid filter: \"", attr(filter_dat, "condition")$message, "\". Update or remove the expression")) + } else { + if (drop) { + return(droplevels(filter_dat)) + } else { + return(filter_dat) + } + } + } + dataset +} + +#' Generate arrange commands from user input +#' @details Form arrange command from user input +#' @param expr Expression to use arrange rows from the specified dataset +#' @param dataset String with dataset name +#' @return Arrange command +#' @importFrom glue glue +#' @export +make_arrange_cmd <- function(expr, dataset = "") { + expr %>% + strsplit(., split = "(\\s*&\\s*|\\s*,\\s*|\\s+)") %>% + unlist() %>% + .[!. == ""] %>% + paste0(collapse = ", ") %>% + (function(x) ifelse(is.empty(dataset), glue("arrange({x})"), glue("arrange({dataset}, {x})"))) +} + +#' Arrange data with user-specified expression +#' @details Arrange data, likely in combination with slicing +#' @param dataset Data frame to arrange +#' @param expr Expression to use arrange rows from the specified dataset +#' @return Arranged data frame +#' @export +arrange_data <- function(dataset, expr = NULL) { + if (!is.empty(expr)) { + arrange_cmd <- make_arrange_cmd(expr, "dataset") + arrange_dat <- try(eval(parse(text = arrange_cmd)), silent = TRUE) + if (inherits(arrange_dat, "try-error")) { + message(paste0("Invalid arrange expression: \"", attr(arrange_dat, "condition")$message, "\". Update or remove the expression")) + } else { + return(arrange_dat) + } + } + + dataset +} + +#' Slice data with user-specified expression +#' @details Select only a slice of the data to work with +#' @param dataset Data frame to slice +#' @param expr Expression to use select rows from the specified dataset +#' @param drop Drop unused factor levels after filtering (default is TRUE) +#' @return Sliced data frame +#' @export +slice_data <- function(dataset, expr = NULL, drop = TRUE) { + if (is.numeric(expr)) { + slice_dat <- try(dataset %>% slice(expr), silent = TRUE) + } else { + slice_dat <- try(dataset %>% slice(!!rlang::parse_expr(expr)), silent = TRUE) + } + if (inherits(slice_dat, "try-error")) { + message(paste0("Invalid slice: \"", attr(slice_dat, "condition")$message, "\". Update or remove the expression")) + } else { + if (drop) { + return(droplevels(slice_dat)) + } else { + return(slice_dat) + } + } + dataset +} + +#' Search for a pattern in all columns of a data.frame +#' +#' @param dataset Data.frame to search +#' @param pattern String to match +#' @param ignore.case Should search be case sensitive or not (default is FALSE) +#' @param fixed Allow regular expressions or not (default is FALSE) +#' @seealso See \code{\link{grepl}} for a detailed description of the function arguments +#' @examples +#' publishers %>% filter(search_data(., "^m")) +#' @export +search_data <- function(dataset, pattern, ignore.case = TRUE, fixed = FALSE) { + mutate_all( + dataset, + ~ grepl(pattern, as.character(.), ignore.case = ignore.case, fixed = fixed) + ) %>% + transmute(sel = rowSums(.) > 0) %>% + pull("sel") +} + +#' View data in a shiny-app +#' +#' @details View, search, sort, etc. your data +#' +#' @param dataset Data.frame or name of the dataframe to view +#' @param vars Variables to show (default is all) +#' @param filt Filter to apply to the specified dataset +#' @param arr Expression to arrange (sort) data +#' @param rows Select rows in the specified dataset +#' @param na.rm Remove rows with missing values (default is FALSE) +#' @param dec Number of decimals to show +#' @param envir Environment to extract data from +#' +#' @seealso See \code{\link{get_data}} and \code{\link{filter_data}} +#' +#' @examples +#' \dontrun{ +#' view_data(mtcars) +#' } +#' +#' @export +view_data <- function(dataset, vars = "", filt = "", + arr = "", rows = NULL, na.rm = FALSE, dec = 3, + envir = parent.frame()) { + ## based on https://rstudio.github.io/DT/server.html + dat <- get_data(dataset, vars, filt = filt, arr = arr, rows = rows, na.rm = na.rm, envir = envir) + title <- if (is_string(dataset)) paste0("DT:", dataset) else "DT" + fbox <- if (nrow(dat) > 5e6) "none" else list(position = "top") + + ## avoid factor with a huge number of levels + isBigFct <- function(x) is.factor(x) && length(levels(x)) > 1000 + dat <- mutate_if(dat, isBigFct, as.character) + + ## for rounding + isDbl <- sapply(dat, is_double) + isInt <- sapply(dat, is.integer) + dec <- ifelse(is.empty(dec) || dec < 0, 3, round(dec, 0)) + + shinyApp( + ui = fluidPage( + title = title, + includeCSS(file.path(system.file(package = "radiant.data"), "app/www/style.css")), + fluidRow(DT::dataTableOutput("tbl")), + actionButton("stop", "Stop", class = "btn-danger", onclick = "window.close();") + ), + server = function(input, output, session) { + widget <- DT::datatable( + dat, + selection = "none", + rownames = FALSE, + style = "bootstrap4", + filter = fbox, + escape = FALSE, + ## must use fillContainer = FALSE to address + ## see https://github.com/rstudio/DT/issues/367 + ## https://github.com/rstudio/DT/issues/379 + # fillContainer = FALSE, + ## works with client-side processing + extensions = "KeyTable", + options = list( + keys = TRUE, + search = list(regex = TRUE), + columnDefs = list( + list(orderSequence = c("desc", "asc"), targets = "_all"), + list(className = "dt-center", targets = "_all") + ), + autoWidth = TRUE, + processing = FALSE, + pageLength = 10, + lengthMenu = list(c(5, 10, 25, 50, -1), c("5", "10", "25", "50", "All")) + ) + ) %>% + (function(x) if (sum(isDbl) > 0) DT::formatRound(x, names(isDbl)[isDbl], dec) else x) %>% + (function(x) if (sum(isInt) > 0) DT::formatRound(x, names(isInt)[isInt], 0) else x) + + output$tbl <- DT::renderDataTable(widget) + observeEvent(input$stop, { + stopApp(cat("Stopped view_data")) + }) + } + ) +} diff --git a/radiant.data/R/visualize.R b/radiant.data/R/visualize.R new file mode 100644 index 0000000000000000000000000000000000000000..8475dfb64095fa96da0f49fcf37b0d1c46be36ff --- /dev/null +++ b/radiant.data/R/visualize.R @@ -0,0 +1,796 @@ +#' Visualize data using ggplot2 \url{https://ggplot2.tidyverse.org/} +#' +#' @details See \url{https://radiant-rstats.github.io/docs/data/visualize.html} for an example in Radiant +#' +#' @param dataset Data to plot (data.frame or tibble) +#' @param xvar One or more variables to display along the X-axis of the plot +#' @param yvar Variable to display along the Y-axis of the plot (default = "none") +#' @param comby Combine yvars in plot (TRUE or FALSE, FALSE is the default) +#' @param combx Combine xvars in plot (TRUE or FALSE, FALSE is the default) +#' @param type Type of plot to create. One of Distribution ('dist'), Density ('density'), Scatter ('scatter'), Surface ('surface'), Line ('line'), Bar ('bar'), or Box-plot ('box') +#' @param nrobs Number of data points to show in scatter plots (-1 for all) +#' @param facet_row Create vertically arranged subplots for each level of the selected factor variable +#' @param facet_col Create horizontally arranged subplots for each level of the selected factor variable +#' @param color Adds color to a scatter plot to generate a 'heat map'. For a line plot one line is created for each group and each is assigned a different color +#' @param fill Display bar, distribution, and density plots by group, each with a different color. Also applied to surface plots to generate a 'heat map' +#' @param size Numeric variable used to scale the size of scatter-plot points +#' @param fillcol Color used for bars, boxes, etc. when no color or fill variable is specified +#' @param linecol Color for lines when no color variable is specified +#' @param pointcol Color for points when no color variable is specified +#' @param bins Number of bins used for a histogram (1 - 50) +#' @param smooth Adjust the flexibility of the loess line for scatter plots +#' @param fun Set the summary measure for line and bar plots when the X-variable is a factor (default is "mean"). Also used to plot an error bar in a scatter plot when the X-variable is a factor. Options are "mean" and/or "median" +#' @param check Add a regression line ("line"), a loess line ("loess"), or jitter ("jitter") to a scatter plot +#' @param axes Flip the axes in a plot ("flip") or apply a log transformation (base e) to the y-axis ("log_y") or the x-axis ("log_x") +#' @param alpha Opacity for plot elements (0 to 1) +#' @param theme ggplot theme to use (e.g., "theme_gray" or "theme_classic") +#' @param base_size Base font size to use (default = 11) +#' @param base_family Base font family to use (e.g., "Times" or "Helvetica") +#' @param labs Labels to use for plots +#' @param xlim Set limit for x-axis (e.g., c(0, 1)) +#' @param ylim Set limit for y-axis (e.g., c(0, 1)) +#' @param data_filter Expression used to filter the dataset. This should be a string (e.g., "price > 10000") +#' @param arr Expression used to sort the data. Likely used in combination for `rows` +#' @param rows Rows to select from the specified dataset +#' @param shiny Logical (TRUE, FALSE) to indicate if the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options. +#' @param envir Environment to extract data from +#' +#' @return Generated plots +#' +#' @examples +#' visualize(diamonds, "price:cut", type = "dist", fillcol = "red") +#' visualize(diamonds, "carat:cut", +#' yvar = "price", type = "scatter", +#' pointcol = "blue", fun = c("mean", "median"), linecol = c("red", "green") +#' ) +#' visualize(diamonds, +#' yvar = "price", xvar = c("cut", "clarity"), +#' type = "bar", fun = "median" +#' ) +#' visualize(diamonds, +#' yvar = "price", xvar = c("cut", "clarity"), +#' type = "line", fun = "max" +#' ) +#' visualize(diamonds, +#' yvar = "price", xvar = "carat", type = "scatter", +#' size = "table", custom = TRUE +#' ) + scale_size(range = c(1, 10), guide = "none") +#' visualize(diamonds, yvar = "price", xvar = "carat", type = "scatter", custom = TRUE) + +#' labs(title = "A scatterplot", x = "price in $") +#' visualize(diamonds, xvar = "price:carat", custom = TRUE) %>% +#' wrap_plots(ncol = 2) + plot_annotation(title = "Histograms") +#' visualize(diamonds, +#' xvar = "cut", yvar = "price", type = "bar", +#' facet_row = "cut", fill = "cut" +#' ) +#' +#' @importFrom rlang .data +#' @importFrom stats density +#' +#' @export +visualize <- function(dataset, xvar, yvar = "", comby = FALSE, combx = FALSE, + type = ifelse(is.empty(yvar), "dist", "scatter"), nrobs = -1, + facet_row = ".", facet_col = ".", color = "none", fill = "none", + size = "none", fillcol = "blue", linecol = "black", pointcol = "black", + bins = 10, smooth = 1, fun = "mean", check = "", axes = "", + alpha = 0.5, theme = "theme_gray", base_size = 11, base_family = "", + labs = list(), xlim = NULL, ylim = NULL, data_filter = "", + arr = "", rows = NULL, shiny = FALSE, custom = FALSE, + envir = parent.frame()) { + if (missing(xvar) && type %in% c("box", "line")) { + xvar <- yvar + if (type == "box") { + type <- "box-single" + if (comby) { + comby <- FALSE + combx <- TRUE + } + } else { + type <- "line-single" + } + } + + ## inspired by Joe Cheng's ggplot2 browser app http://www.youtube.com/watch?feature=player_embedded&v=o2B5yJeEl1A#! + vars <- xvar + + if (!type %in% c("scatter", "line", "line-single", "box")) color <- "none" + if (!type %in% c("bar", "dist", "density", "surface")) fill <- "none" + if (type != "scatter") { + check %<>% sub("line", "", .) %>% sub("loess", "", .) + if (length(fun) > 1) { + fun <- fun[1] ## only scatter can deal with multiple functions + message("No more than one function (", fun, ") will be used for plots of type ", type) + } + size <- "none" + } + if (type == "scatter" && length(fun) > 3) { + fun <- fun[1:3] ## only scatter can deal with multiple functions, max 3 for now + message("No more than three functions (", paste(fun, collapse = ", "), ") can be used with scatter plots") + } + if (!type %in% c("scatter", "box", "box-single")) check %<>% sub("jitter", "", .) + + ## variable to use if bar chart is specified + byvar <- NULL + + if (length(yvar) == 0 || identical(yvar, "")) { + if (!type %in% c("dist", "density")) { + return("No Y-variable provided for a plot that requires one") + } + } else if (type == "surface" && is.empty(fill, "none")) { + return("No Fill variable provided for a plot that requires one") + } else { + if (type %in% c("dist", "density")) { + yvar <- "" + } else { + vars %<>% c(., yvar) + } + } + + if (color != "none") { + vars %<>% c(., color) + if (type == "line") byvar <- color + } + if (facet_row != ".") { + vars %<>% c(., facet_row) + byvar <- if (is.null(byvar)) facet_row else unique(c(byvar, facet_row)) + } + if (facet_col != ".") { + vars %<>% c(., facet_col) + byvar <- if (is.null(byvar)) facet_col else unique(c(byvar, facet_col)) + } + + if (facet_col != "." && facet_row == facet_col) { + return("The same variable cannot be used for both Facet row and Facet column") + } + + if (fill != "none") { + vars %<>% c(., fill) + if (type == "bar") { + byvar <- if (is.null(byvar)) fill else unique(c(byvar, fill)) + } + } + if (size != "none") vars %<>% c(., size) + + ## so you can also pass-in a data.frame + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, envir = envir) + + if (type == "scatter" && !is.empty(nrobs)) { + nrobs <- as.integer(nrobs) + if (nrobs > 0 && nrobs < nrow(dataset)) { + dataset <- sample_n(dataset, nrobs, replace = FALSE) + } + } + + ## get class + dc <- dc_org <- get_class(dataset) + + ## if : is used to specify a range of variables + if (length(vars) < ncol(dataset)) { + fl <- strsplit(xvar, ":") %>% unlist() + cn <- colnames(dataset) + xvar <- cn[which(fl[1] == cn):which(fl[2] == cn)] + } + + ## converting character variables if needed + isChar <- dc == "character" + if (sum(isChar) > 0) { + if (type == "density") { + dataset[, isChar] <- select(dataset, which(isChar)) %>% mutate_all(as_numeric) + if ("character" %in% get_class(select(dataset, which(isChar)))) { + return("Character variable(s) were not converted to numeric for plotting.\nTo use these variables in a plot convert them to numeric\nvariables (or factors) in the Data > Transform tab") + } + } else { + dataset[, isChar] <- select(dataset, which(isChar)) %>% mutate_all(as_factor) + nrlev <- sapply(dataset, function(x) if (is.factor(x)) length(levels(x)) else 0) + if (max(nrlev) > 500) { + return("Character variable(s) were not converted to factors for plotting.\nTo use these variable in a plot convert them to factors\n(or numeric variables) in the Data > Transform tab") + } + } + ## in case something was changed, if not, this won't run + dc <- get_class(dataset) + } + + if (type %in% c("bar", "line")) { + if (any(xvar %in% yvar)) { + return("Cannot create a bar or line chart if an X-variable is also included as a Y-variable") + } + } else if (type == "box") { + if (any(xvar %in% yvar)) { + return("Cannot create a box-plot if an X-variable is also included as a Y-variable") + } + } + + ## Determine if you want to use the first level of factor or not + if (type %in% c("bar", "line")) { + isFctY <- "factor" == dc & names(dc) %in% yvar + if (sum(isFctY)) { + levs_org <- sapply(dataset[, isFctY, drop = FALSE], function(x) levels(x)[1]) + levs <- c() + fixer_first <- function(x) { + x_num <- sshhr(as.integer(as.character(x))) + if (length(na.omit(x_num)) == 0) { + lx <- levels(x) + x <- as_integer(x == lx[1]) + levs <<- c(levs, lx[1]) + } else { + x <- x_num + levs <<- c(levs, NA) + } + x + } + fixer <- function(x) { + x_num <- sshhr(as.integer(as.character(x))) + if (length(na.omit(x_num)) == 0) { + lx <- levels(x) + x <- as_integer(x) + levs <<- c(levs, lx[1]) + } else { + x <- x_num + levs <<- c(levs, NA) + } + x + } + if (fun %in% c("mean", "sum", "sd", "var", "sd", "se", "me", "cv", "prop", "varprop", "sdprop", "seprop", "meprop", "varpop", "sepop")) { + mfun <- fixer_first + } else if (fun %in% c("median", "min", "max", "p01", "p025", "p05", "p10", "p25", "p50", "p75", "p90", "p95", "p975", "p99", "skew", "kurtosi")) { + mfun <- fixer + } else { + mfun <- function(x) { + levs <<- c(levs, NA) + x + } + } + + dataset[, isFctY] <- select(dataset, which(isFctY)) %>% + mutate_all(mfun) + names(levs) <- names(levs_org) + dc[isFctY] <- "integer" + } + } + + if (xor("log_x" %in% axes, "log_y" %in% axes)) { + if (any(xvar %in% yvar)) { + return("When applying 'Log X' an X-variable cannot also be selected as a Y-variable") + } + if (any(yvar %in% xvar)) { + return("When applying 'Log Y' a Y-variable cannot also be selected as an X-variable") + } + } + + log_trans <- function(x) ifelse(x > 0, log(x), NA) + + if ("log_x" %in% axes) { + if (any(!dc[xvar] %in% c("integer", "numeric"))) { + return("'Log X' is only meaningful for X-variables of type integer or numeric") + } + to_log <- (dc[xvar] %in% c("integer", "numeric")) %>% xvar[.] + dataset <- mutate_at(dataset, .vars = to_log, .funs = log_trans) + } + + if ("log_y" %in% axes) { + if (any(!dc[yvar] %in% c("integer", "numeric"))) { + return("'Log Y' is only meaningful for Y-variables of type integer or numeric") + } + to_log <- (dc[yvar] %in% c("integer", "numeric")) %>% yvar[.] + dataset <- mutate_at(dataset, .vars = to_log, .funs = log_trans) + } + + ## combining Y-variables if needed + if (comby && length(yvar) > 1) { + if (any(xvar %in% yvar) && !type %in% c("box-single", "line-single")) { + return("X-variables cannot be part of Y-variables when combining Y-variables") + } + if (!is.empty(color, "none")) { + return("Cannot use Color when combining Y-variables") + } + if (!is.empty(fill, "none")) { + return("Cannot use Fill when combining Y-variables") + } + if (!is.empty(size, "none")) { + return("Cannot use Size when combining Y-variables") + } + if (facet_row %in% yvar || facet_col %in% yvar) { + return("Facet row or column variables cannot be part of\nY-variables when combining Y-variables") + } + + dataset <- gather(dataset, "yvar", "values", !!yvar, factor_key = TRUE) + yvar <- "values" + byvar <- if (is.null(byvar)) "yvar" else c("yvar", byvar) + color <- fill <- "yvar" + + dc <- get_class(dataset) + } + + ## combining X-variables if needed + if (combx && length(xvar) > 1) { + if (!is.empty(fill, "none")) { + return("Cannot use Fill when combining X-variables") + } + if (facet_row %in% xvar || facet_col %in% xvar) { + return("Facet row or column variables cannot be part of\nX-variables when combining Y-variables") + } + if (any(!get_class(select_at(dataset, .vars = xvar)) %in% c("numeric", "integer"))) { + return("Cannot combine plots for non-numeric variables") + } + + dataset <- gather(dataset, "xvar", "values", !!xvar, factor_key = TRUE) + xvar <- "values" + byvar <- if (is.null(byvar)) "xvar" else c("xvar", byvar) + color <- fill <- "xvar" + + dc <- get_class(dataset) + } + + plot_list <- list() + if (type == "dist") { + for (i in xvar) { + ## can't create a distribution plot for a logical + if (dc[i] == "logical") { + dataset[[i]] <- as_factor(dataset[[i]]) + dc[i] <- "factor" + } + + hist_par <- list(alpha = alpha, position = "stack") + if (combx) hist_par[["position"]] <- "identity" + if (fill == "none") hist_par[["fill"]] <- fillcol + plot_list[[i]] <- ggplot(dataset, aes(x = .data[[i]])) + if ("density" %in% axes && !"factor" %in% dc[i]) { + hist_par <- c(list(aes(y = after_stat(density))), hist_par) + plot_list[[i]] <- plot_list[[i]] + geom_density(adjust = smooth, color = linecol, linewidth = .5) + } + if ("factor" %in% dc[i]) { + plot_fun <- get("geom_bar") + if ("log_x" %in% axes) axes <- sub("log_x", "", axes) + } else { + plot_fun <- get("geom_histogram") + hist_par[["binwidth"]] <- select_at(dataset, .vars = i) %>% + range() %>% + { + diff(.) / (bins - 1) + } + } + + plot_list[[i]] <- plot_list[[i]] + do.call(plot_fun, hist_par) + if ("log_x" %in% axes) plot_list[[i]] <- plot_list[[i]] + xlab(paste("log", i)) + } + } else if (type == "density") { + for (i in xvar) { + plot_list[[i]] <- ggplot(dataset, aes(x = .data[[i]])) + + if (fill == "none") { + geom_density(adjust = smooth, color = linecol, fill = fillcol, alpha = alpha, linewidth = 1) + } else { + geom_density(adjust = smooth, alpha = alpha, linewidth = 1) + } + + if ("log_x" %in% axes) plot_list[[i]] <- plot_list[[i]] + xlab(paste("log", i)) + } + } else if (type == "scatter") { + itt <- 1 + if ("jitter" %in% check) { + if (color == "none") { + gs <- geom_jitter(alpha = alpha, color = pointcol, position = position_jitter(width = 0.4, height = 0.0)) + } else { + gs <- geom_jitter(alpha = alpha, position = position_jitter(width = 0.4, height = 0.0)) + } + check <- sub("jitter", "", check) + } else { + if (color == "none") { + gs <- geom_point(alpha = alpha, color = pointcol) + } else { + gs <- geom_point(alpha = alpha) + } + } + + for (i in xvar) { + if ("log_x" %in% axes && dc[i] == "factor") axes <- sub("log_x", "", axes) + + for (j in yvar) { + plot_list[[itt]] <- ggplot(dataset, aes(x = .data[[i]], y = .data[[j]])) + gs + + if ("log_x" %in% axes) plot_list[[itt]] <- plot_list[[itt]] + xlab(paste("log", i)) + if ("log_y" %in% axes) plot_list[[itt]] <- plot_list[[itt]] + ylab(paste("log", j)) + + if (dc[i] == "factor") { + ## make range comparable to bar plot + ymax <- max(0, max(dataset[[j]])) + ymin <- min(0, min(dataset[[j]])) + plot_list[[itt]] <- plot_list[[itt]] + ylim(ymin, ymax) + + fun1 <- function(y) { + y <- get(fun[1])(y) + data.frame(ymin = y, ymax = y, y = y, stringsAsFactors = FALSE) + } + + if (length(fun) == 1) { + ## need some contrast in this case + if (pointcol[1] == "black" && linecol[1] == "black") { + linecol[1] <- "blue" + } + + plot_list[[itt]] <- plot_list[[itt]] + + stat_summary( + fun.data = fun1, na.rm = TRUE, aes(fill = fun[1]), + geom = "crossbar", show.legend = FALSE, + color = linecol[1] + ) + } else { + plot_list[[itt]] <- plot_list[[itt]] + + stat_summary( + fun.data = fun1, na.rm = TRUE, aes(fill = fun[1]), + geom = "crossbar", show.legend = TRUE, + color = linecol[1] + ) + + if (length(fun) > 1) { + fun2 <- function(y) { + y <- get(fun[2])(y) + data.frame(ymin = y, ymax = y, y = y, stringsAsFactors = FALSE) + } + if (length(linecol) == 1) linecol <- c(linecol, "blue") + plot_list[[itt]] <- plot_list[[itt]] + + stat_summary( + fun.data = fun2, na.rm = TRUE, aes(fill = fun[2]), + geom = "crossbar", show.legend = FALSE, + color = linecol[2] + ) + } + + if (length(fun) == 3) { + fun3 <- function(y) { + y <- get(fun[3])(y) + data.frame(ymin = y, ymax = y, y = y, stringsAsFactors = FALSE) + } + if (length(linecol) == 2) linecol <- c(linecol, "red") + plot_list[[itt]] <- plot_list[[itt]] + + stat_summary( + fun.data = fun3, na.rm = TRUE, aes(fill = fun[3]), + geom = "crossbar", show.legend = FALSE, + color = linecol[3] + ) + } + + ## adding a legend if needed + plot_list[[itt]] <- plot_list[[itt]] + + scale_fill_manual(name = "", values = linecol, labels = fun) + + ## next line based on https://stackoverflow.com/a/25294787/1974918 + guides(fill = guide_legend(override.aes = list(color = NULL))) + } + + ## Not working for some reason + # fun_list <- list() + # for (f in seq_along(fun)) { + # fun_list[[f]] <- function(y) { + # y <- get(fun[deparse(f)])(y, na.rm = TRUE) + # data.frame(ymin = y, ymax = y, y = y, stringsAsFactors = FALSE) + # } + # plot_list[[itt]] <- plot_list[[itt]] + + # stat_summary(fun.data = fun_list[[f]], geom = "crossbar", color = c("red", "green", "blue")[f]) + # } + + nr <- nrow(dataset) + if (nr > 1000 || nr != length(unique(dataset[[i]]))) { + plot_list[[itt]]$labels$y %<>% paste0(., " (", paste(fun, collapse = ", "), ")") + } + } + + itt <- itt + 1 + } + } + } else if (type == "surface") { + itt <- 1 + for (i in xvar) { + if ("log_x" %in% axes && dc[i] == "factor") axes <- sub("log_x", "", axes) + interpolate <- ifelse("interpolate" %in% check, TRUE, FALSE) + + for (j in yvar) { + plot_list[[itt]] <- ggplot(dataset, aes(x = .data[[i]], y = .data[[j]], fill = .data[[fill]])) + + geom_raster(interpolate = interpolate) + + if ("log_x" %in% axes) plot_list[[itt]] <- plot_list[[itt]] + xlab(paste("log", i)) + if ("log_y" %in% axes) plot_list[[itt]] <- plot_list[[itt]] + ylab(paste("log", j)) + + itt <- itt + 1 + } + } + } else if (type == "line") { + itt <- 1 + for (i in xvar) { + for (j in yvar) { + flab <- "" + if (color == "none") { + if (dc[i] %in% c("factor", "date") || dc_org[j] == "factor") { + tbv <- if (is.null(byvar)) i else c(i, byvar) + tmp <- dataset %>% + group_by_at(.vars = tbv) %>% + select_at(.vars = c(tbv, j)) %>% + na.omit() %>% + summarise_all(fun) + colnames(tmp)[ncol(tmp)] <- j + plot_list[[itt]] <- ggplot(tmp, aes(x = .data[[i]], y = .data[[j]])) + + geom_line(aes(group = 1), color = linecol) + if (nrow(tmp) < 101) plot_list[[itt]] <- plot_list[[itt]] + geom_point(color = pointcol) + } else { + plot_list[[itt]] <- ggplot(dataset, aes(x = .data[[i]], y = .data[[j]])) + + geom_line(color = linecol) + } + } else { + if (dc[i] %in% c("factor", "date") || (!is.empty(dc_org[j]) && dc_org[j] == "factor")) { + tbv <- if (is.null(byvar)) i else unique(c(i, byvar)) + tmp <- dataset %>% + group_by_at(.vars = tbv) %>% + select_at(.vars = c(tbv, color, j)) %>% + na.omit() %>% + summarise_all(fun) + colnames(tmp)[ncol(tmp)] <- j + plot_list[[itt]] <- ggplot(tmp, aes(x = .data[[i]], y = .data[[j]], color = .data[[color]], group = .data[[color]])) + + geom_line() + if (nrow(tmp) < 101) plot_list[[itt]] <- plot_list[[itt]] + geom_point() + } else { + plot_list[[itt]] <- ggplot(dataset, aes(x = .data[[i]], y = .data[[j]], color = .data[[color]], group = .data[[color]])) + + geom_line() + } + } + if ("log_x" %in% axes) plot_list[[itt]] <- plot_list[[itt]] + xlab(paste("log", i)) + if ("log_y" %in% axes) plot_list[[itt]] <- plot_list[[itt]] + ylab(paste("log", j)) + if ((dc[i] %in% c("factor", "date") || (!is.empty(dc_org[j]) && dc_org[j] == "factor")) && nrow(tmp) < nrow(dataset)) { + if (exists("levs")) { + if (j %in% names(levs) && !is.na(levs[j])) { + plot_list[[itt]]$labels$y %<>% paste0(., " (", fun, " {", levs[j], "})") + } else { + plot_list[[itt]]$labels$y %<>% paste0(., " (", fun, ")") + } + } else { + plot_list[[itt]]$labels$y %<>% paste0(., " (", fun, ")") + } + } + itt <- itt + 1 + } + } + } else if (type == "line-single") { + itt <- 1 + for (i in yvar) { + if (color == "none") { + plot_list[[itt]] <- ggplot(dataset, aes(x = seq_along(.data[[i]]), y = .data[[i]])) + + geom_line(color = linecol) + + labs(x = "") + } else { + plot_list[[itt]] <- ggplot(dataset, aes(x = seq_along(.data[[i]]), y = .data[[i]], color = .data[[color]], group = .data[[color]])) + + geom_line() + + labs(x = "") + } + itt <- itt + 1 + } + } else if (type == "bar") { + itt <- 1 + for (i in xvar) { + if (!"factor" %in% dc[i]) dataset[[i]] %<>% as_factor() + if ("log_x" %in% axes) axes <- sub("log_x", "", axes) + for (j in yvar) { + tbv <- if (is.null(byvar)) i else c(i, byvar) + tmp <- dataset %>% + group_by_at(.vars = tbv) %>% + select_at(.vars = c(tbv, j)) %>% + na.omit() %>% + summarise_all(fun) + colnames(tmp)[ncol(tmp)] <- j + + if ("sort" %in% axes && facet_row == "." && facet_col == ".") { + if ("flip" %in% axes) { + tmp <- arrange_at(ungroup(tmp), .vars = j) + } else { + tmp <- arrange_at(ungroup(tmp), .vars = j, .funs = desc) + } + tmp[[i]] %<>% factor(., levels = unique(.)) + } + + plot_list[[itt]] <- ggplot(tmp, aes(x = .data[[i]], y = .data[[j]])) + { + if (fill == "none") { + geom_bar(stat = "identity", position = "dodge", alpha = alpha, fill = fillcol) + } else { + geom_bar(stat = "identity", position = "dodge", alpha = alpha) + } + } + + if (!custom && (fill == "none" || fill == i)) { + plot_list[[itt]] <- plot_list[[itt]] + theme(legend.position = "none") + } + + if ("log_y" %in% axes) plot_list[[itt]] <- plot_list[[itt]] + ylab(paste("log", j)) + + if (dc[i] %in% c("factor", "integer", "date") && nrow(tmp) < nrow(dataset)) { + if (exists("levs")) { + if (j %in% names(levs) && !is.na(levs[j])) { + plot_list[[itt]]$labels$y %<>% paste0(., " (", fun, " {", levs[j], "})") + } else { + plot_list[[itt]]$labels$y %<>% paste0(., " (", fun, ")") + } + } else { + plot_list[[itt]]$labels$y %<>% paste0(., " (", fun, ")") + } + } + + itt <- itt + 1 + } + } + } else if (type == "box") { + itt <- 1 + for (i in xvar) { + if (!"factor" %in% dc[i]) dataset[[i]] %<>% as_factor + for (j in yvar) { + if (color == "none") { + plot_list[[itt]] <- ggplot(dataset, aes(x = .data[[i]], y = .data[[j]])) + + geom_boxplot(alpha = alpha, fill = fillcol, outlier.color = pointcol, color = linecol) + } else { + plot_list[[itt]] <- ggplot(dataset, aes(x = .data[[i]], y = .data[[j]], fill = .data[[color]])) + + geom_boxplot(alpha = alpha) + } + + if (!custom && (color == "none" || color == i)) { + plot_list[[itt]] <- plot_list[[itt]] + theme(legend.position = "none") + } + + if ("log_y" %in% axes) plot_list[[itt]] <- plot_list[[itt]] + ylab(paste("log", j)) + + itt <- itt + 1 + } + } + } else if (type == "box-single") { + itt <- 1 + for (i in xvar) { + if (color == "none") { + plot_list[[itt]] <- dataset %>% ggplot(aes(x = "", y = .data[[i]])) + + geom_boxplot(alpha = alpha, fill = fillcol, outlier.color = pointcol, color = linecol) + + scale_x_discrete(labels = NULL, breaks = NULL) + + labs(x = "") + } else { + plot_list[[itt]] <- dataset %>% ggplot(aes(x = "", y = .data[[i]], fill = color)) + + geom_boxplot(alpha = alpha) + } + + if (!custom && (color == "none" || color == i)) { + plot_list[[itt]] <- plot_list[[itt]] + theme(legend.position = "none") + } + + if ("log_y" %in% axes) plot_list[[itt]] <- plot_list[[itt]] + ylab(paste("log", i)) + + itt <- itt + 1 + } + } + + + if (facet_row != "." || facet_col != ".") { + facets <- if (facet_row == ".") { + paste("~", facet_col) + } else { + paste(facet_row, "~", facet_col) + } + scl <- if ("scale_y" %in% axes) "free_y" else "fixed" + facet_fun <- if (facet_row == ".") facet_wrap else facet_grid + for (i in 1:length(plot_list)) { + plot_list[[i]] <- plot_list[[i]] + facet_fun(as.formula(facets), scales = scl) + } + } + + if (color != "none") { + for (i in 1:length(plot_list)) { + plot_list[[i]] <- plot_list[[i]] + aes(color = .data[[color]]) + } + } + + if (size != "none") { + for (i in 1:length(plot_list)) { + plot_list[[i]] <- plot_list[[i]] + aes(size = .data[[size]]) + } + } + + if (fill != "none") { + for (i in 1:length(plot_list)) { + plot_list[[i]] <- plot_list[[i]] + aes(fill = .data[[fill]]) + } + } + + if ((length(xlim) == 2 && is.numeric(xlim)) && + (length(ylim) == 2 && is.numeric(ylim))) { + for (i in 1:length(plot_list)) { + plot_list[[i]] <- plot_list[[i]] + coord_cartesian(xlim = xlim, ylim = ylim) + } + } else if (length(xlim) == 2 && is.numeric(xlim)) { + for (i in 1:length(plot_list)) { + plot_list[[i]] <- plot_list[[i]] + coord_cartesian(xlim = xlim) + } + } else if (length(ylim) == 2 && is.numeric(ylim)) { + for (i in 1:length(plot_list)) { + plot_list[[i]] <- plot_list[[i]] + coord_cartesian(ylim = ylim) + } + } + + if ("jitter" %in% check) { + for (i in 1:length(plot_list)) { + plot_list[[i]] <- plot_list[[i]] + + geom_jitter(alpha = alpha, position = position_jitter(width = 0.4, height = 0.0)) + } + } + + if ("line" %in% check) { + for (i in 1:length(plot_list)) { + plot_list[[i]] <- plot_list[[i]] + + sshhr(geom_smooth(method = "lm", alpha = 0.2, linewidth = .75, linetype = "dashed")) + } + } + + if ("loess" %in% check) { + for (i in 1:length(plot_list)) { + plot_list[[i]] <- plot_list[[i]] + + sshhr(geom_smooth(span = smooth, method = "loess", alpha = 0.2, linewidth = .75, linetype = "dotdash")) + } + } + + if ("flip" %in% axes) { + ## reverse legend ordering if available + for (i in 1:length(plot_list)) { + plot_list[[i]] <- plot_list[[i]] + coord_flip() + + guides(fill = guide_legend(reverse = TRUE)) + + guides(color = guide_legend(reverse = TRUE)) + } + } + + if (length(labs) > 0) { + if (is.list(labs[[1]])) { + for (i in 1:length(labs)) { + plot_list[[i]] <- plot_list[[i]] + do.call(ggplot2::labs, labs[[i]]) + } + } else { + plot_list[[1]] <- plot_list[[1]] + do.call(ggplot2::labs, labs) + } + } + + ## setting theme + for (i in 1:length(plot_list)) { + plot_list[[i]] <- plot_list[[i]] + + get(theme)(base_size = ifelse(is.na(base_size), 11, base_size), base_family = base_family) + } + + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = min(length(plot_list), 2)) %>% + (function(x) if (isTRUE(shiny)) x else print(x)) + } +} + +#' Create a qscatter plot similar to Stata +#' +#' @param dataset Data to plot (data.frame or tibble) +#' @param xvar Character indicating the variable to display along the X-axis of the plot +#' @param yvar Character indicating the variable to display along the Y-axis of the plot +#' @param lev Level in yvar to use if yvar is of type character of factor. If lev is empty then the first level is used +#' @param fun Summary measure to apply to both the x and y variable +#' @param bins Number of bins to use +#' +#' @examples +#' qscatter(diamonds, "price", "carat") +#' qscatter(titanic, "age", "survived") +#' +#' @importFrom rlang .data +#' +#' @export +qscatter <- function(dataset, xvar, yvar, lev = "", fun = "mean", bins = 20) { + if (is.character(dataset[[yvar]])) { + dataset <- mutate_at(dataset, .vars = yvar, .funs = as.factor) + } + if (is.factor(dataset[[yvar]])) { + if (is.empty(lev)) lev <- levels(pull(dataset, !!yvar))[1] + dataset <- mutate_at(dataset, .vars = yvar, .funs = function(y) as.integer(y == lev)) + lev <- paste0(" {", lev, "}") + } else { + lev <- "" + } + mutate_at(dataset, .vars = xvar, .funs = list(bins = ~ radiant.data::xtile(., bins))) %>% + group_by(bins) %>% + summarize_at(.vars = c(xvar, yvar), .funs = fun) %>% + ggplot(aes(x = .data[[xvar]], y = .data[[yvar]])) + + geom_point() + + labs(y = paste0(yvar, " (", fun, lev, ")")) +} diff --git a/radiant.data/README.md b/radiant.data/README.md new file mode 100644 index 0000000000000000000000000000000000000000..b92da26fc30132fdb2a2c4c7be231ed79d01409a --- /dev/null +++ b/radiant.data/README.md @@ -0,0 +1,187 @@ +# Radiant - Business analytics using R and Shiny + + + +[![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/radiant.data)](https://CRAN.R-project.org/package=radiant.data) + + +Radiant is an open-source platform-independent browser-based interface for business analytics in [R](https://www.r-project.org/). The application is based on the [Shiny](https://shiny.posit.co/) package and can be run locally or on a server. Radiant was developed by Vincent Nijs. Please use the issue tracker on GitHub to suggest enhancements or report problems: https://github.com/radiant-rstats/radiant.data/issues. For other questions and comments please use radiant@rady.ucsd.edu. + +## Key features + +- Explore: Quickly and easily summarize, visualize, and analyze your data +- Cross-platform: It runs in a browser on Windows, Mac, and Linux +- Reproducible: Recreate results and share work with others as a state file or an [Rmarkdown](https://rmarkdown.rstudio.com/) report +- Programming: Integrate Radiant's analysis functions with your own R-code +- Context: Data and examples focus on business applications + + + +#### Playlists + +There are two youtube playlists with video tutorials. The first provides a general introduction to key features in Radiant. The second covers topics relevant in a course on business analytics (i.e., Probability, Decision Analysis, Hypothesis Testing, Linear Regression, and Simulation). + +* Introduction to Radiant +* Radiant Tutorial Series + +#### Explore + +Radiant is interactive. Results update immediately when inputs are changed (i.e., no separate dialog boxes) and/or when a button is pressed (e.g., `Estimate` in _Model > Estimate > Logistic regression (GLM)_). This facilitates rapid exploration and understanding of the data. + +#### Cross-platform + +Radiant works on Windows, Mac, or Linux. It can run without an Internet connection and no data will leave your computer. You can also run the app as a web application on a server. + +#### Reproducible + +To conduct high-quality analysis, simply saving output is not enough. You need the ability to reproduce results for the same data and/or when new data become available. Moreover, others may want to review your analysis and results. Save and load the state of the application to continue your work at a later time or on another computer. Share state files with others and create reproducible reports using [Rmarkdown](https://rmarkdown.rstudio.com/). See also the section on `Saving and loading state` below + +If you are using Radiant on a server you can even share the URL (include the SSUID) with others so they can see what you are working on. Thanks for this feature go to [Joe Cheng](https://github.com/jcheng5). + +#### Programming + +Although Radiant's web-interface can handle quite a few data and analysis tasks, you may prefer to write your own R-code. Radiant provides a bridge to programming in R(studio) by exporting the functions used for analysis (i.e., you can conduct your analysis using the Radiant web-interface or by calling Radiant's functions directly from R-code). For more information about programming with Radiant see the [programming](https://radiant-rstats.github.io/docs/programming.html) page on the documentation site. + +#### Context + +Radiant focuses on business data and decisions. It offers tools, examples, and documentation relevant for that context, effectively reducing the business analytics learning curve. + +## How to install Radiant + +- Required: [R](https://cran.r-project.org/) version 4.0.0 or later +- Required: [Rstudio](https://posit.co/download/rstudio-server/) + +In Rstudio you can start and update Radiant through the `Addins` menu at the top of the screen. To install the latest version of Radiant for Windows or Mac, with complete documentation for off-line access, open R(studio) and copy-and-paste the command below: + +```r +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org")) +install.packages("radiant") +``` + +Once all packages are installed, select `Start radiant` from the `Addins` menu in Rstudio or use the command below to launch the app: + +```r +radiant::radiant() +``` + +To launch Radiant in Rstudio's viewer pane use the command below: + +```r +radiant::radiant_viewer() +``` + +To launch Radiant in an Rstudio Window use the command below: + +```r +radiant::radiant_window() +``` + +To easily update Radiant and the required packages, install the `radiant.update` package using: + +```r +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org")) +install.packages("remotes") +remotes::install_github("radiant-rstats/radiant.update", upgrade = "never") +``` + +Then select `Update radiant` from the `Addins` menu in Rstudio or use the command below: + +```r +radiant.update::radiant.update() +``` + +See the [installing radiant](https://radiant-rstats.github.io/docs/install.html) page additional for details. + +**Optional:** You can also create a launcher on your Desktop to start Radiant by typing `radiant::launcher()` in the R(studio) console and pressing return. A file called `radiant.bat` (windows) or `radiant.command` (mac) will be created that you can double-click to start Radiant in your default browser. The `launcher` command will also create a file called `update_radiant.bat` (windows) or `update_radiant.command` (mac) that you can double-click to update Radiant to the latest release. + +When Radiant starts you will see data on diamond prices. To close the application click the icon in the navigation bar and then click `Stop`. The Radiant process will stop and the browser window will close (Chrome) or gray-out. + +## Documentation + +Documentation and tutorials are available at and in the Radiant web interface (the icons on each page and the icon in the navigation bar). + +Individual Radiant packages also each have their own [pkgdown](https://github.com/r-lib/pkgdown) sites: + +* http://radiant-rstats.github.io/radiant +* http://radiant-rstats.github.io/radiant.data +* http://radiant-rstats.github.io/radiant.design +* http://radiant-rstats.github.io/radiant.basics +* http://radiant-rstats.github.io/radiant.model +* http://radiant-rstats.github.io/radiant.multivariate + +Want some help getting started? Watch the tutorials on the [documentation site](https://radiant-rstats.github.io/docs/tutorials.html). + + +## Reporting issues + +Please use the GitHub issue tracker at github.com/radiant-rstats/radiant/issues if you have any problems using Radiant. + +## Try Radiant online + +Not ready to install Radiant on your computer? Try it online at the link below: + +https://vnijs.shinyapps.io/radiant + +Do **not** upload sensitive data to this public server. The size of data upload has been restricted to 10MB for security reasons. + +## Running Radiant on shinyapps.io + +To run your own instance of Radiant on shinyapps.io first install Radiant and its dependencies. Then clone the radiant repo and ensure you have the latest version of the Radiant packages installed by running `radiant/inst/app/for.shinyapps.io.R`. Finally, open `radiant/inst/app/ui.R` and [deploy](https://shiny.posit.co/articles/shinyapps.html) the application. + +## Running Radiant on shiny-server + +You can also host Radiant using [shiny-server](https://posit.co/download/shiny-server/). First, install radiant on the server using the command below: + +```r +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org")) +install.packages("radiant") +``` + +Then clone the radiant repo and point shiny-server to the `inst/app/` directory. As a courtesy, please let me know if you intend to use Radiant on a server. + +When running Radiant on a server, by default, file uploads are limited to 10MB and R-code in _Report > Rmd_ and _Report > R_ will not be evaluated for security reasons. If you have `sudo` access to the server and have appropriate security in place you can change these settings by adding the following lines to `.Rprofile` for the `shiny` user on the server. + +```bash +options(radiant.maxRequestSize = -1) ## no file size limit +options(radiant.report = TRUE) +``` + +## Running Radiant in the cloud (e.g., AWS) + +To run radiant in the cloud you can use the customized Docker container. See https://github.com/radiant-rstats/docker for details + +## Saving and loading state + +To save your analyses save the state of the app to a file by clicking on the icon in the navbar and then on `Save radiant state file` (see also the _Data > Manage_ tab). You can open this state file at a later time or on another computer to continue where you left off. You can also share the file with others that may want to replicate your analyses. As an example, load the state file [`radiant-example.state.rda`](https://radiant-rstats.github.io/docs/examples/radiant-example.state.rda) by clicking on the icon in the navbar and then on `Load radiant state file`. Go to _Data > View_ and _Data > Visualize_ to see some of the settings from the previous "state" of the app. There is also a report in _Report > Rmd_ that was created using the Radiant interface. The html file `radiant-example.nb.html` contains the output. + +A related feature in Radiant is that state is maintained if you accidentally navigate to another web page, close (and reopen) the browser, and/or hit refresh. Use `Refresh` in the menu in the navigation bar to return to a clean/new state. + +Loading and saving state also works with Rstudio. If you start Radiant from Rstudio and use > `Stop` to stop the app, lists called `r_data`, `r_info`, and `r_state` will be put into Rstudio's global workspace. If you start radiant again using `radiant::radiant()` it will use these lists to restore state. Also, if you load a state file directly into Rstudio it will be used when you start Radiant to recreate a previous state. + +**Technical note**: Loading state works as follows in Radiant: When an input is initialized in a Shiny app you set a default value in the call to, for example, numericInput. In Radiant, when a state file has been loaded and an input is initialized it looks to see if there is a value for an input of that name in a list called `r_state`. If there is, this value is used. The `r_state` list is created when saving state using `reactiveValuesToList(input)`. An example of a call to `numericInput` is given below where the `state_init` function from `radiant.R` is used to check if a value from `r_state` can be used. + +```r +numericInput("sm_comp_value", "Comparison value:", state_init("sm_comp_value", 0)) +``` + +## Source code + +The source code for the radiant application is available on GitHub at . `radiant.data`, offers tools to load, save, view, visualize, summarize, combine, and transform data. `radiant.design` builds on `radiant.data` and adds tools for experimental design, sampling, and sample size calculation. `radiant.basics` covers the basics of statistical analysis (e.g., comparing means and proportions, cross-tabs, correlation, etc.) and includes a probability calculator. `radiant.model` covers model estimation (e.g., logistic regression and neural networks), model evaluation (e.g., gains chart, profit curve, confusion matrix, etc.), and decision tools (e.g., decision analysis and simulation). Finally, `radiant.multivariate` includes tools to generate brand maps and conduct cluster, factor, and conjoint analysis. + +These tools are used in the _Business Analytics_, _Quantitative Analysis_, _Research for Marketing Decisions_, _Applied Market Research_, _Consumer Behavior_, _Experiments in Firms_, _Pricing_, _Pricing Analytics_, and _Customer Analytics_ classes at the Rady School of Management (UCSD). + +## Credits + +Radiant would not be possible without [R](https://cran.r-project.org/) and [Shiny](https://shiny.posit.co/). I would like to thank [Joe Cheng](https://github.com/jcheng5), [Winston Chang](https://github.com/wch), and [Yihui Xie](https://github.com/yihui) for answering questions, providing suggestions, and creating amazing tools for the R community. Other key components used in Radiant are ggplot2, dplyr, tidyr, magrittr, broom, shinyAce, shinyFiles, rmarkdown, and DT. For an overview of other packages that Radiant relies on please see the about page. + + +## License + + +Radiant is licensed under the AGPLv3. As a summary, the AGPLv3 license requires, attribution, including copyright and license information in copies of the software, stating changes if the code is modified, and disclosure of all source code. Details are in the COPYING file. + +The documentation, images, and videos for the `radiant.data` package are licensed under the creative commons attribution and share-alike license CC-BY-SA. All other documentation and videos on this site, as well as the help files for `radiant.design`, `radiant.basics`, `radiant.model`, and `radiant.multivariate`, are licensed under the creative commons attribution, non-commercial, share-alike license CC-NC-SA. + +If you are interested in using any of the radiant packages please email me at radiant@rady.ucsd.edu + +© Vincent Nijs (2024) Creative Commons License diff --git a/radiant.data/_pkgdown.yml b/radiant.data/_pkgdown.yml new file mode 100644 index 0000000000000000000000000000000000000000..b43df3c6695aa7b762da63cb695bf350134123ad --- /dev/null +++ b/radiant.data/_pkgdown.yml @@ -0,0 +1,265 @@ +url: https://radiant-rstats.github.io/radiant.data + +template: + params: + docsearch: + api_key: 311c7eff313b1f67999e5838086df74e + index_name: radiant_data + +navbar: + title: "radiant.data" + left: + - icon: fa-home fa-lg + href: index.html + - text: "Reference" + href: reference/index.html + - text: "Articles" + href: articles/index.html + - text: "Changelog" + href: news/index.html + - text: "Other Packages" + menu: + - text: "radiant" + href: https://radiant-rstats.github.io/radiant/ + - text: "radiant.data" + href: https://radiant-rstats.github.io/radiant.data/ + - text: "radiant.design" + href: https://radiant-rstats.github.io/radiant.design/ + - text: "radiant.basics" + href: https://radiant-rstats.github.io/radiant.basics/ + - text: "radiant.model" + href: https://radiant-rstats.github.io/radiant.model/ + - text: "radiant.multivariate" + href: https://radiant-rstats.github.io/radiant.multivariate/ + - text: "docker" + href: https://github.com/radiant-rstats/docker + right: + - icon: fa-twitter fa-lg + href: https://twitter.com/vrnijs + - icon: fa-github fa-lg + href: https://github.com/radiant-rstats + +reference: + - title: Data > Manage + desc: Functions used with Data > Manage + contents: + - choose_dir + - choose_files + - describe + - find_dropbox + - find_gdrive + - find_home + - find_project + - fix_names + - get_data + - load_clip + - parse_path + - read_files + - save_clip + - write_parquet + - to_fct + - title: Data > View + desc: Functions used with Data > View + contents: + - dtab + - dtab.data.frame + - filter_data + - make_arrange_cmd + - arrange_data + - slice_data + - search_data + - view_data + - title: Data > Visualize + desc: Function used with Data > Visualize + contents: + - visualize + - qscatter + - ggplotly + - subplot + - title: Data > Pivot + desc: Functions used with Data > Pivot + contents: + - pivotr + - summary.pivotr + - dtab.pivotr + - plot.pivotr + - title: Data > Explore + desc: Functions used with Data > Pivot + contents: + - explore + - summary.explore + - dtab.explore + - flip + - title: Data > Transform + desc: Functions used with Data > Transform + contents: + - as_character + - as_distance + - as_distance + - as_dmy + - as_dmy_hm + - as_dmy_hms + - as_duration + - as_factor + - as_hm + - as_hms + - as_integer + - as_mdy + - as_mdy_hm + - as_mdy_hms + - as_numeric + - as_ymd + - as_ymd_hm + - as_ymd_hms + - center + - cv + - inverse + - is.empty + - is_not + - is_double + - is_string + - level_list + - ln + - make_train + - month + - mutate_ext + - n_missing + - n_obs + - normalize + - make_vec + - me + - meprop + - modal + - p025 + - p05 + - p10 + - p25 + - p75 + - p90 + - p95 + - p975 + - prop + - refactor + - sdpop + - sdprop + - se + - seprop + - show_duplicated + - square + - standardize + - store + - table2data + - varpop + - varprop + - wday + - weighted.sd + - which.pmax + - which.pmin + - pfun + - psum + - pmean + - psd + - pvar + - pcv + - pp01 + - pp025 + - pp05 + - pp25 + - pp75 + - pp95 + - pp975 + - pp99 + - xtile + - title: Data > Combine + desc: Functions used with Data > Combine + contents: + - combine_data + - title: Report + desc: Functions used with Report > Rmd and Report > R + contents: + - fix_smart + - format_df + - format_nr + - round_df + - register + - deregister + - render + - render.datatables + - render.plotly + - title: Convenience functions + desc: Convenience functions + contents: + - add_class + - add_description + - get_class + - ci_label + - ci_perc + - copy_all + - copy_attr + - copy_from + - does_vary + - empty_level + - get_summary + - indexr + - install_webshot + - iterms + - qterms + - set_attr + - sig_stars + - sshh + - sshhr + - title: Starting radiant.data + desc: Functions used to start radiant shiny apps + contents: + - launch + - radiant.data + - radiant.data_url + - radiant.data_viewer + - radiant.data_window + - title: Re-exported + desc: Functions exported from other packages + contents: + - as_tibble + - tibble + - rownames_to_column + - glance + - tidy + - glue + - glue_collapse + - glue_data + - knit_print + - kurtosi + - skew + - title: Data sets + desc: Data sets bundled with radiant.data + contents: + - avengers + - diamonds + - publishers + - superheroes + - titanic + - title: Deprecated + desc: Deprecated + contents: + - radiant.data-deprecated + - store.pivotr + - store.explore +articles: + - title: Data Menu + desc: > + These vignettes provide an introduction to the Data menu in radiant + contents: + - pkgdown/manage + - pkgdown/view + - pkgdown/visualize + - pkgdown/pivotr + - pkgdown/explore + - pkgdown/transform + - pkgdown/combine + - title: Report + contents: + - pkgdown/report_rmd + - pkgdown/report_r + - title: State + contents: + - pkgdown/state diff --git a/radiant.data/build/build.R b/radiant.data/build/build.R new file mode 100644 index 0000000000000000000000000000000000000000..9c0968d00465615a557f6acb1565bf9bcb256cd2 --- /dev/null +++ b/radiant.data/build/build.R @@ -0,0 +1,87 @@ +setwd(rstudioapi::getActiveProject()) +curr <- getwd() +pkg <- basename(curr) + +## building package for mac and windows +rv <- R.Version() +rv <- paste(rv$major, substr(rv$minor, 1, 1), sep = ".") + +rvprompt <- readline(prompt = paste0("Running for R version: ", rv, ". Is that what you wanted y/n: ")) +if (grepl("[nN]", rvprompt)) stop("Change R-version") + +dirsrc <- "../minicran/src/contrib" + +if (rv < "3.4") { + dirmac <- fs::path("../minicran/bin/macosx/mavericks/contrib", rv) +} else if (rv > "3.6") { + dirmac <- c( + fs::path("../minicran/bin/macosx/big-sur-arm64/contrib", rv), + fs::path("../minicran/bin/macosx/contrib", rv) + ) +} else { + dirmac <- fs::path("../minicran/bin/macosx/el-capitan/contrib", rv) +} + +dirwin <- fs::path("../minicran/bin/windows/contrib", rv) + +if (!fs::file_exists(dirsrc)) fs::dir_create(dirsrc, recursive = TRUE) +for (d in dirmac) { + if (!fs::file_exists(d)) fs::dir_create(d, recursive = TRUE) +} +if (!fs::file_exists(dirwin)) fs::dir_create(dirwin, recursive = TRUE) + +# delete older version of radiant +rem_old <- function(pkg) { + unlink(paste0(dirsrc, "/", pkg, "*")) + for (d in dirmac) { + unlink(paste0(d, "/", pkg, "*")) + } + unlink(paste0(dirwin, "/", pkg, "*")) +} + +sapply(pkg, rem_old) + +## avoid 'loaded namespace' stuff when building for mac +system(paste0(Sys.which("R"), " -e \"setwd('", getwd(), "'); app <- '", pkg, "'; source('build/build_mac.R')\"")) + +win <- readline(prompt = "Did you build on Windows? y/n: ") +if (grepl("[yY]", win)) { + + fl <- list.files(pattern = "*.zip", path = "~/Dropbox/r-packages", full.names = TRUE) + for (f in fl) { + file.copy(f, "~/gh/") + } + unlink(fl) + + ## move packages to radiant_miniCRAN. must package in Windows first + # path <- normalizePath("../") + pth <- fs::path_abs("../") + + sapply(list.files(pth, pattern = "*.tar.gz", full.names = TRUE), file.copy, dirsrc) + unlink("../*.tar.gz") + for (d in dirmac) { + sapply(list.files(pth, pattern = "*.tgz", full.names = TRUE), file.copy, d) + } + unlink("../*.tgz") + sapply(list.files(pth, pattern = "*.zip", full.names = TRUE), file.copy, dirwin) + unlink("../*.zip") + + tools::write_PACKAGES(dirwin, type = "win.binary") + for (d in dirmac) { + tools::write_PACKAGES(d, type = "mac.binary") + } + tools::write_PACKAGES(dirsrc, type = "source") + + # commit to repo + setwd("../minicran") + system("git add --all .") + mess <- paste0(pkg, " package update: ", format(Sys.Date(), format = "%m-%d-%Y")) + system(paste0("git commit -m '", mess, "'")) + system("git push") +} + +setwd(curr) + +# remove.packages(c("radiant.model", "radiant.data")) +# radiant.update::radiant.update() +# install.packages("radiant.update") diff --git a/radiant.data/build/build_mac.R b/radiant.data/build/build_mac.R new file mode 100644 index 0000000000000000000000000000000000000000..1452bac080e154c24c6cd9acb6eef6c09a76c6ae --- /dev/null +++ b/radiant.data/build/build_mac.R @@ -0,0 +1,6 @@ +## build for mac +app <- basename(getwd()) +curr <- setwd("../") +f <- devtools::build(app) +system(paste0("R CMD INSTALL --build ", f)) +setwd(curr) diff --git a/radiant.data/build/build_win.R b/radiant.data/build/build_win.R new file mode 100644 index 0000000000000000000000000000000000000000..f988de18b876a6b5216dcf72656d7a8ad577144a --- /dev/null +++ b/radiant.data/build/build_win.R @@ -0,0 +1,24 @@ +## build for windows +rv <- R.Version() +rv <- paste(rv$major, substr(rv$minor, 1, 1), sep = ".") + +rvprompt <- readline(prompt = paste0("Running for R version: ", rv, ". Is that what you wanted y/n: ")) +if (grepl("[nN]", rvprompt)) + stop("Change R-version using Rstudio > Tools > Global Options > Rversion") + +## build for windows +setwd(rstudioapi::getActiveProject()) +f <- devtools::build(binary = TRUE) +devtools::install(upgrade = "never") + +f <- list.files(pattern = "*.zip", path = "../", full.names = TRUE) + +print(glue::glue("Copying: {f}")) +file.copy(f, "C:/Users/vnijs/Dropbox/r-packages/", overwrite = TRUE) +unlink(f) + +#options(repos = c(RSM = "https://radiant-rstats.github.io/minicran")) +#install.packages("radiant.data", type = "binary") +#remove.packages(c("radiant.data", "radiant.model")) +#install.packages("radiant.update") +#radiant.update::radiant.update() diff --git a/radiant.data/cran-comments.md b/radiant.data/cran-comments.md new file mode 100644 index 0000000000000000000000000000000000000000..1a3d0a8aedfe6721bf64858cea0e2db39f52b7c4 --- /dev/null +++ b/radiant.data/cran-comments.md @@ -0,0 +1,329 @@ +## Resubmission + +This is a resubmission. In this version I moved the arrow package to 'recommended' because of its size on macOS (>100MB) + +## Test environments + +* macOS, R 4.4.1 +* win-builder (devel) + +## R CMD check results + +There were no ERRORs or WARNINGs. There was one NOTE related to the number of non-standard dependencies. However, this note is not easily addressed without substantially inconveniencing users that rely on the web (shiny) interface available for radiant.data. + +# Previous cran-comments + +## Resubmission + +This is a resubmission. In this version I require shiny version 1.8.1 or newer and have addressed a breaking change introduced in that version of shiny. See NEWS.md for details. + +## Test environments + +* macOS, R 4.4.0 +* macOS, R 4.3.2 +* win-builder (devel) + +## R CMD check results + +There were no ERRORs or WARNINGs. There was one NOTE related to the number of non-standard dependencies. However, this note is not easily addressed without substantially inconveniencing users that rely on the web (shiny) interface available for radiant.data. + + + +## Resubmission + +This is a resubmission. In this version I require shiny version 1.8.0 which fixed a bug that caused issues in the radiant apps. See NEWS.md for details. + +## Test environments + +* macOS, R 4.3.2 +* win-builder (devel) + +## R CMD check results + +There were no ERRORs or WARNINGs. There was one NOTE related to the number of non-standard dependencies. However, this note is not easily addressed without substantially inconveniencing users that rely on the web (shiny) interface available for radiant.data. + + +## Resubmission + +This is a resubmission. In this version I have fixed a bug that caused problems for users on Windows with a space in their username. See NEWS.md for details. + +## Test environments + +* macOS, R 4.3.1 +* win-builder (devel) + +## R CMD check results + +There were no ERRORs or WARNINGs. There was one NOTE related to the number of non-standard dependencies. However, this note is not easily addressed without substantially inconveniencing users that rely on the web (shiny) interface available for radiant.data. + + +## Resubmission + +This is a resubmission. In this update I fixed a strange issue related the patchwork package. At least it was strange to me. In the code below `any` should not be needed. However, it seems that a patchwork object can have length == 1 and still have is.na return a vector of length > 1. Perhaps there are other libraries that have objects like this but I have never seen this before. + +My apologies for submitting a new version so soon after the previous version. + +```r +length(x) == 0 || (length(x) == 1 && any(is.na(x))) +``` + +## Test environments + +* macOS, R 4.3.1 +* win-builder (devel) + +## R CMD check results + +There were no ERRORs or WARNINGs. There was one NOTE related to the number of non-standard dependencies. However, this note is not easily addressed without substantially inconveniencing users that rely on the web (shiny) interface available for radiant.data. + + +## Resubmission + +This is a resubmission. In this update I have added features and removed a bug. See NEWS.md. + +## Test environments + +* macOS, R 4.3.1 +* win-builder (devel) + +## R CMD check results + +There were no ERRORs or WARNINGs. There was one NOTE related to the number of non-standard dependencies. However, this note is not easily addressed without substantially inconveniencing users that rely on the web (shiny) interface available for radiant.data. + +## Resubmission + +This is a resubmission. In this update I have added features and cleaned up code to avoid issues with markdown deprecation warnings. See NEWS.md. + +## Test environments + +* macOS, R 4.2.2 +* win-builder (devel) + +## R CMD check results + +There were no ERRORs or WARNINGs. There was one NOTE related to the number of non-standard dependencies. However, this note is not easily addressed without substantially inconveniencing users that rely on the web (shiny) interface available for radiant.data. + +# + +## Resubmission + +This is a resubmission. In this update I have added features and cleaned up code to avoid issues with ggplot deprecation warnings. See NEWS.md. Also, URLs have been updated from Rstudio to Posit and the Radiant Documentation site is now back online and accessible. + +I have also tried to address the build issue connected to calibre. See note below. + +"This suggests you open a web browser in non interactive mode. Please use +such calls only conditionally via + +if(interactive()) + +Please fix and resubmit. + +Best, +Uwe Ligges +" + +## Test environments + +* macOS, R 4.2.2 +* win-builder (devel) + +## R CMD check results + +There were no ERRORs or WARNINGs. There was one NOTE related to the number of non-standard dependencies. However, this note is not easily addressed without substantially inconveniencing users that rely on the web (shiny) interface available for radiant.data. + + +## Resubmission + +This is a resubmission. In this update I have addressed three issues. See NEWS.md. + +## Test environments + +* macOS, R 4.2.1 +* win-builder (devel) + +## R CMD check results + +There were no ERRORs or WARNINGs. There was one NOTE related to the number of non-standard dependencies. However, this note is not easily addressed without substantially inconveniencing users that rely on the web (shiny) interface available for radiant.data. + + +## Resubmission + +This is a resubmission. In this version I fixed a dependency issue that is essential for correct functioning of the radiant.data shiny application. This feature is difficult to evaluate with automated testing and unfortunately I made a mistake in the submission earlier today. I uncovered the issue after upgrading to R 4.2.1. My apologies. + +## Test environments + +* macOS, R 4.2.1 +* win-builder (devel) + +## R CMD check results + +There were no ERRORs or WARNINGs. There was one NOTE related to the number of non-standard dependencies. However, this note is not easily addressed without substantially inconveniencing users that rely on the web (shiny) interface available for radiant.data. + + +## Resubmission + +This is a resubmission. In this version I have fixed a bug and added features (see NEWS.md for details). + +## Test environments + +* macOS, R 4.2.0 +* win-builder (devel) + +## R CMD check results + +There were no ERRORs or WARNINGs. There was one NOTE related to the number of non-standard dependencies. However, this note is not easily addressed without substantially inconveniencing users that rely on the web (shiny) interface available for radiant.data. + + +## Resubmission + +This is a resubmission. In this version I have fixed bugs and updated documentation (see NEWS.md for details). I also fixed an link issue in the documentation for sshh and sshhr + +## Test environments + +* macOS, R 4.2.0 +* win-builder (devel) + +## R CMD check results + +There were no ERRORs or WARNINGs. There was one NOTE related to the number of non-standard dependencies. However, this note is not easily addressed without substantially inconveniencing users that rely on the web (shiny) interface available for radiant.data. + + +## Resubmission + +This is a resubmission. In this version I have fixed several bugs and added several new features (see NEWS.md for details). + +## Test environments + +* local Ubuntu 20.04, R 4.1.0 +* local Ubuntu 20.04 through WSL2, R 4.0.5 +* win-builder (devel) + +## R CMD check results + +There were no ERRORs or WARNINGs. There was one NOTE related to the number of non-standard dependencies. However, this note is not easily addressed without substantially inconveniencing users that rely on the web (shiny) interface available for radiant.data. + +## Resubmission + +This is a resubmission. In this version I have address a problem linked to issue: https://github.com/yihui/knitr/issues/1864 There are also a number of changes that allow users to change the aesthetics of the app using `bslib` if available. + +## Test environments + +* local Ubuntu 20.04, R 4.1.0 +* local Ubuntu 20.04 through WSL2, R 4.0.5 +* win-builder (devel) + +## R CMD check results + +There were no ERRORs or WARNINGs. There was one NOTE related to the number of non-standard dependencies. However, this note is not easily addressed without substantially inconveniencing users that rely on the web (shiny) interface available for radiant.data. + +# Previous cran-comments + + +## Resubmission + +This is a resubmission. In this version I have fixed issues related to updates in the `magrittr` and `readr` packages. I + +## Test environments + +* Ubuntu 20.04, R 4.0.3 +* win-builder (devel) +* ubuntu "bionic" (on travis-ci), R release and devel + +## R CMD check results + +There were no ERRORs or WARNINGs. There was one NOTE related to the number of non-standard dependencies. However, this note is not easily addressed without substantially inconveniencing users that rely on the web (shiny) interface available for radiant.data. + + +## Resubmission + +This is a resubmission. In this version I have added back a feature that is now supported in dplyr 1.0.1 and made it easier to connect to Google Drive from the file-browser. I also, updated links that CRAN's automated checking listed. + +## Test environments + +* local OS X install, R 4.0.2 +* local Windows install, R 4.0.2 +* win-builder (devel) +* ubuntu "bionic" (on travis-ci), R release and devel + +## R CMD check results + +There were no ERRORs or WARNINGs. There was one NOTE related to the number of non-standard dependencies. However, this note is not easily addressed without substantially inconveniencing users that rely on the web (shiny) interface available for radiant.data. + + +## Resubmission + +This is a resubmission. In this version I have fixed a bug and removed a feature that no-longer works with dplyr 1.0.0 (see NEWS.md for details). Also, update the link to the ggplot2 documentation + +## Test environments + +* local OS X install, R 4.0.1 +* local Windows install, R 4.0.0 +* win-builder + +## R CMD check results + +There were no ERRORs or WARNINGs. There is one NOTE about the number of imported non-default packages. + +## Resubmission + +This is a resubmission. In this version I have fixed several bugs and added several new features (see NEWS.md for details). + +## Test environments + +* local OS X install, R 3.6.3 +* local Windows install, R 3.6.2 +* ubuntu "trusty" (on travis-ci), R release and devel +* win-builder + +## R CMD check results + +There were no ERRORs, WARNINGs, or NOTEs. + + +## Resubmission + +This is a resubmission. In this version I have fixed several bugs and added several new features (see NEWS.md for details). + +## Test environments + +* local OS X install, R 3.6.1 +* local Windows install, R 3.6.1 +* ubuntu "trusty" (on travis-ci), R release and devel +* win-builder + +## R CMD check results + +There were no ERRORs, WARNINGs, or NOTEs. + +## Resubmission + +This is a resubmission. In this version I have fixed several bugs and added several new features (see NEWS.md for details). + +## Test environments + +* local OS X install, R 3.6.1 +* local Windows install, R 3.6.1 +* ubuntu "trusty" (on travis-ci), R release and devel +* win-builder +* rhub + +## R CMD check results + +There were no ERRORs, WARNINGs, or NOTEs. + +# Previous cran-comments + +## Resubmission + +This is a resubmission. In this version I have fixed several bugs and added several new features (see NEWS.md for details). + +## Test environments + +* local OS X install, R 3.5.2 +* local Windows install, R 3.5.2 +* ubuntu "trusty" (on travis-ci), R release and devel +* win-builder + +## R CMD check results + +There were no ERRORs, WARNINGs, or NOTEs. diff --git a/radiant.data/data/avengers.rda b/radiant.data/data/avengers.rda new file mode 100644 index 0000000000000000000000000000000000000000..3356e7a0fb17abe99a953f22da37a8e8335d1ac6 Binary files /dev/null and b/radiant.data/data/avengers.rda differ diff --git a/radiant.data/data/diamonds.rda b/radiant.data/data/diamonds.rda new file mode 100644 index 0000000000000000000000000000000000000000..0a2e828a77d6904bdf2c7f2b82ae2d8290fe8049 Binary files /dev/null and b/radiant.data/data/diamonds.rda differ diff --git a/radiant.data/data/publishers.rda b/radiant.data/data/publishers.rda new file mode 100644 index 0000000000000000000000000000000000000000..764affc023f365f67e89c87664ecb6234b77c1b3 Binary files /dev/null and b/radiant.data/data/publishers.rda differ diff --git a/radiant.data/data/superheroes.rda b/radiant.data/data/superheroes.rda new file mode 100644 index 0000000000000000000000000000000000000000..edcdc27ca2c4fba5b8fe2cf124101419f7726386 Binary files /dev/null and b/radiant.data/data/superheroes.rda differ diff --git a/radiant.data/data/titanic.rda b/radiant.data/data/titanic.rda new file mode 100644 index 0000000000000000000000000000000000000000..ecb4584b532e187340552fa3e5df3bbae6407f48 Binary files /dev/null and b/radiant.data/data/titanic.rda differ diff --git a/radiant.data/docs/404.html b/radiant.data/docs/404.html new file mode 100644 index 0000000000000000000000000000000000000000..c64a8f36fe02fc1214dd80a8f4f241cedd5cc179 --- /dev/null +++ b/radiant.data/docs/404.html @@ -0,0 +1,167 @@ + + + + + + + +Page not found (404) • radiant.data + + + + + + + + + + + + + +
+
+ + + + +
+
+
+

Page not found (404)

+
+ +Content not found. Please use links in the navbar. + +
+ + + +
+ + + +
+

+

Developed by Vincent Nijs, Niklas von Hertzen.

+
+ +
+

+

Site built with pkgdown 2.0.7.

+
+ +
+
+ + + + + diff --git a/radiant.data/docs/LICENSE-text.html b/radiant.data/docs/LICENSE-text.html new file mode 100644 index 0000000000000000000000000000000000000000..2d3041c52e9929674e0156886c74c5ab7b1582ad --- /dev/null +++ b/radiant.data/docs/LICENSE-text.html @@ -0,0 +1,237 @@ + +License • radiant.data + + +
+
+ + + +
+
+
+

License

+
+ +
radiant.data is licensed under AGPL3 (see https://tldrlegal.com/license/gnu-affero-general-public-license-v3-(agpl-3.0) and https://www.r-project.org/Licenses/AGPL-3). The radiant.data help files and images are licensed under the creative commons attribution and share-alike license CC-BY-SA (https://creativecommons.org/licenses/by-sa/4.0/legalcode).
+
+As a summary, the AGPLv3 license requires, attribution, including copyright and license information in copies of the software, stating changes if the code is modified, and disclosure of all source code. Details are in the COPYING file.
+
+If you are interested in using radiant.data or other radiant packages please email me at radiant@rady.ucsd.edu
+
+====================================================================
+
+Creative Commons Attribution-ShareAlike 4.0 International Public License
+By exercising the Licensed Rights (defined below), You accept and agree to be bound by the terms and conditions of this Creative Commons Attribution-ShareAlike 4.0 International Public License ("Public License"). To the extent this Public License may be interpreted as a contract, You are granted the Licensed Rights in consideration of Your acceptance of these terms and conditions, and the Licensor grants You such rights in consideration of benefits the Licensor receives from making the Licensed Material available under these terms and conditions.
+
+Section 1 – Definitions.
+
+Adapted Material means material subject to Copyright and Similar Rights that is derived from or based upon the Licensed Material and in which the Licensed Material is translated, altered, arranged, transformed, or otherwise modified in a manner requiring permission under the Copyright and Similar Rights held by the Licensor. For purposes of this Public License, where the Licensed Material is a musical work, performance, or sound recording, Adapted Material is always produced where the Licensed Material is synched in timed relation with a moving image.
+Adapter's License means the license You apply to Your Copyright and Similar Rights in Your contributions to Adapted Material in accordance with the terms and conditions of this Public License.
+BY-SA Compatible License means a license listed at creativecommons.org/compatiblelicenses, approved by Creative Commons as essentially the equivalent of this Public License.
+Copyright and Similar Rights means copyright and/or similar rights closely related to copyright including, without limitation, performance, broadcast, sound recording, and Sui Generis Database Rights, without regard to how the rights are labeled or categorized. For purposes of this Public License, the rights specified in Section 2(b)(1)-(2) are not Copyright and Similar Rights.
+Effective Technological Measures means those measures that, in the absence of proper authority, may not be circumvented under laws fulfilling obligations under Article 11 of the WIPO Copyright Treaty adopted on December 20, 1996, and/or similar international agreements.
+Exceptions and Limitations means fair use, fair dealing, and/or any other exception or limitation to Copyright and Similar Rights that applies to Your use of the Licensed Material.
+License Elements means the license attributes listed in the name of a Creative Commons Public License. The License Elements of this Public License are Attribution and ShareAlike.
+Licensed Material means the artistic or literary work, database, or other material to which the Licensor applied this Public License.
+Licensed Rights means the rights granted to You subject to the terms and conditions of this Public License, which are limited to all Copyright and Similar Rights that apply to Your use of the Licensed Material and that the Licensor has authority to license.
+Licensor means the individual(s) or entity(ies) granting rights under this Public License.
+Share means to provide material to the public by any means or process that requires permission under the Licensed Rights, such as reproduction, public display, public performance, distribution, dissemination, communication, or importation, and to make material available to the public including in ways that members of the public may access the material from a place and at a time individually chosen by them.
+Sui Generis Database Rights means rights other than copyright resulting from Directive 96/9/EC of the European Parliament and of the Council of 11 March 1996 on the legal protection of databases, as amended and/or succeeded, as well as other essentially equivalent rights anywhere in the world.
+You means the individual or entity exercising the Licensed Rights under this Public License. Your has a corresponding meaning.
+Section 2 – Scope.
+
+License grant.
+Subject to the terms and conditions of this Public License, the Licensor hereby grants You a worldwide, royalty-free, non-sublicensable, non-exclusive, irrevocable license to exercise the Licensed Rights in the Licensed Material to:
+reproduce and Share the Licensed Material, in whole or in part; and
+produce, reproduce, and Share Adapted Material.
+Exceptions and Limitations. For the avoidance of doubt, where Exceptions and Limitations apply to Your use, this Public License does not apply, and You do not need to comply with its terms and conditions.
+Term. The term of this Public License is specified in Section 6(a).
+Media and formats; technical modifications allowed. The Licensor authorizes You to exercise the Licensed Rights in all media and formats whether now known or hereafter created, and to make technical modifications necessary to do so. The Licensor waives and/or agrees not to assert any right or authority to forbid You from making technical modifications necessary to exercise the Licensed Rights, including technical modifications necessary to circumvent Effective Technological Measures. For purposes of this Public License, simply making modifications authorized by this Section 2(a)(4) never produces Adapted Material.
+Downstream recipients.
+Offer from the Licensor – Licensed Material. Every recipient of the Licensed Material automatically receives an offer from the Licensor to exercise the Licensed Rights under the terms and conditions of this Public License.
+Additional offer from the Licensor – Adapted Material. Every recipient of Adapted Material from You automatically receives an offer from the Licensor to exercise the Licensed Rights in the Adapted Material under the conditions of the Adapter’s License You apply.
+No downstream restrictions. You may not offer or impose any additional or different terms or conditions on, or apply any Effective Technological Measures to, the Licensed Material if doing so restricts exercise of the Licensed Rights by any recipient of the Licensed Material.
+No endorsement. Nothing in this Public License constitutes or may be construed as permission to assert or imply that You are, or that Your use of the Licensed Material is, connected with, or sponsored, endorsed, or granted official status by, the Licensor or others designated to receive attribution as provided in Section 3(a)(1)(A)(i).
+Other rights.
+
+Moral rights, such as the right of integrity, are not licensed under this Public License, nor are publicity, privacy, and/or other similar personality rights; however, to the extent possible, the Licensor waives and/or agrees not to assert any such rights held by the Licensor to the limited extent necessary to allow You to exercise the Licensed Rights, but not otherwise.
+Patent and trademark rights are not licensed under this Public License.
+To the extent possible, the Licensor waives any right to collect royalties from You for the exercise of the Licensed Rights, whether directly or through a collecting society under any voluntary or waivable statutory or compulsory licensing scheme. In all other cases the Licensor expressly reserves any right to collect such royalties.
+Section 3 – License Conditions.
+
+Your exercise of the Licensed Rights is expressly made subject to the following conditions.
+
+Attribution.
+
+If You Share the Licensed Material (including in modified form), You must:
+
+retain the following if it is supplied by the Licensor with the Licensed Material:
+identification of the creator(s) of the Licensed Material and any others designated to receive attribution, in any reasonable manner requested by the Licensor (including by pseudonym if designated);
+a copyright notice;
+a notice that refers to this Public License;
+a notice that refers to the disclaimer of warranties;
+a URI or hyperlink to the Licensed Material to the extent reasonably practicable;
+indicate if You modified the Licensed Material and retain an indication of any previous modifications; and
+indicate the Licensed Material is licensed under this Public License, and include the text of, or the URI or hyperlink to, this Public License.
+You may satisfy the conditions in Section 3(a)(1) in any reasonable manner based on the medium, means, and context in which You Share the Licensed Material. For example, it may be reasonable to satisfy the conditions by providing a URI or hyperlink to a resource that includes the required information.
+If requested by the Licensor, You must remove any of the information required by Section 3(a)(1)(A) to the extent reasonably practicable.
+ShareAlike.
+In addition to the conditions in Section 3(a), if You Share Adapted Material You produce, the following conditions also apply.
+
+The Adapter’s License You apply must be a Creative Commons license with the same License Elements, this version or later, or a BY-SA Compatible License.
+You must include the text of, or the URI or hyperlink to, the Adapter's License You apply. You may satisfy this condition in any reasonable manner based on the medium, means, and context in which You Share Adapted Material.
+You may not offer or impose any additional or different terms or conditions on, or apply any Effective Technological Measures to, Adapted Material that restrict exercise of the rights granted under the Adapter's License You apply.
+Section 4 – Sui Generis Database Rights.
+
+Where the Licensed Rights include Sui Generis Database Rights that apply to Your use of the Licensed Material:
+
+for the avoidance of doubt, Section 2(a)(1) grants You the right to extract, reuse, reproduce, and Share all or a substantial portion of the contents of the database;
+if You include all or a substantial portion of the database contents in a database in which You have Sui Generis Database Rights, then the database in which You have Sui Generis Database Rights (but not its individual contents) is Adapted Material, including for purposes of Section 3(b); and
+You must comply with the conditions in Section 3(a) if You Share all or a substantial portion of the contents of the database.
+For the avoidance of doubt, this Section 4 supplements and does not replace Your obligations under this Public License where the Licensed Rights include other Copyright and Similar Rights.
+Section 5 – Disclaimer of Warranties and Limitation of Liability.
+
+Unless otherwise separately undertaken by the Licensor, to the extent possible, the Licensor offers the Licensed Material as-is and as-available, and makes no representations or warranties of any kind concerning the Licensed Material, whether express, implied, statutory, or other. This includes, without limitation, warranties of title, merchantability, fitness for a particular purpose, non-infringement, absence of latent or other defects, accuracy, or the presence or absence of errors, whether or not known or discoverable. Where disclaimers of warranties are not allowed in full or in part, this disclaimer may not apply to You.
+To the extent possible, in no event will the Licensor be liable to You on any legal theory (including, without limitation, negligence) or otherwise for any direct, special, indirect, incidental, consequential, punitive, exemplary, or other losses, costs, expenses, or damages arising out of this Public License or use of the Licensed Material, even if the Licensor has been advised of the possibility of such losses, costs, expenses, or damages. Where a limitation of liability is not allowed in full or in part, this limitation may not apply to You.
+The disclaimer of warranties and limitation of liability provided above shall be interpreted in a manner that, to the extent possible, most closely approximates an absolute disclaimer and waiver of all liability.
+Section 6 – Term and Termination.
+
+This Public License applies for the term of the Copyright and Similar Rights licensed here. However, if You fail to comply with this Public License, then Your rights under this Public License terminate automatically.
+Where Your right to use the Licensed Material has terminated under Section 6(a), it reinstates:
+
+automatically as of the date the violation is cured, provided it is cured within 30 days of Your discovery of the violation; or
+upon express reinstatement by the Licensor.
+For the avoidance of doubt, this Section 6(b) does not affect any right the Licensor may have to seek remedies for Your violations of this Public License.
+For the avoidance of doubt, the Licensor may also offer the Licensed Material under separate terms or conditions or stop distributing the Licensed Material at any time; however, doing so will not terminate this Public License.
+Sections 1, 5, 6, 7, and 8 survive termination of this Public License.
+Section 7 – Other Terms and Conditions.
+
+The Licensor shall not be bound by any additional or different terms or conditions communicated by You unless expressly agreed.
+Any arrangements, understandings, or agreements regarding the Licensed Material not stated herein are separate from and independent of the terms and conditions of this Public License.
+Section 8 – Interpretation.
+
+For the avoidance of doubt, this Public License does not, and shall not be interpreted to, reduce, limit, restrict, or impose conditions on any use of the Licensed Material that could lawfully be made without permission under this Public License.
+To the extent possible, if any provision of this Public License is deemed unenforceable, it shall be automatically reformed to the minimum extent necessary to make it enforceable. If the provision cannot be reformed, it shall be severed from this Public License without affecting the enforceability of the remaining terms and conditions.
+No term or condition of this Public License will be waived and no failure to comply consented to unless expressly agreed to by the Licensor.
+Nothing in this Public License constitutes or may be interpreted as a limitation upon, or waiver of, any privileges and immunities that apply to the Licensor or You, including from the legal processes of any jurisdiction or authority.
+
+ +
+ + + +
+ + + +
+

Developed by Vincent Nijs, Niklas von Hertzen.

+
+ +
+

Site built with pkgdown 2.0.7.

+
+ +
+ + + + diff --git a/radiant.data/docs/articles/index.html b/radiant.data/docs/articles/index.html new file mode 100644 index 0000000000000000000000000000000000000000..1840e34d52b96be8b22a4a89d6fbe262ffd43f5c --- /dev/null +++ b/radiant.data/docs/articles/index.html @@ -0,0 +1,162 @@ + +Articles • radiant.data + + +
+
+ + + +
+
+
+

Articles

+
+ +
+

Data Menu

+

These vignettes provide an introduction to the Data menu in radiant

+ +
Loading and Saving data (Data > Manage)
+
+
View data in an interactive table (Data > View)
+
+
Visualize data (Data > Visualize)
+
+
Create pivot tables (Data > Pivot)
+
+
Summarize and explore your data (Data > Explore)
+
+
Transform variables (Data > Transform)
+
+
Combine data sets (Data > Combine)
+
+
+
+

Report

+

+ +
Create a reproducible report using Rmarkdown (Report > Rmd)
+
+
Create a reproducible report using R (Report > R)
+
+
+
+

State

+

+ +
Loading and Saving the State of the application
+
+
+
+
+ + +
+

Developed by Vincent Nijs, Niklas von Hertzen.

+
+ +
+

Site built with pkgdown 2.0.7.

+
+ +
+ + + + diff --git a/radiant.data/docs/articles/pkgdown/combine.html b/radiant.data/docs/articles/pkgdown/combine.html new file mode 100644 index 0000000000000000000000000000000000000000..bb288fb9f4fadfe71f740fcb59223fbb6656c3ed --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/combine.html @@ -0,0 +1,2290 @@ + + + + + + + +Combine data sets (Data > Combine) • radiant.data + + + + + + + + + + + + + + +
+
+ + + + +
+
+
+

Combine data sets (Data > Combine)

+

Vincent R. +Nijs, Rady School of Management (UCSD)

+ + + Source: vignettes/pkgdown/combine.Rmd + + +
+ + + +
+

Combine two datasets

+
+

There are six join (or merge) options available in +Radiant from the +dplyr +package developed by Hadley Wickham et.al.

+

The examples below are adapted from the +Cheatsheet +for dplyr join functions by +Jenny Bryan +and focus on three small datasets, superheroes, +publishers, and avengers, to illustrate the +different join types and other ways to combine datasets in R +and Radiant. The data are also available in csv format through the links +below:

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+Superheroes +
+name + +alignment + +gender + +publisher +
+Magneto + +bad + +male + +Marvel +
+Storm + +good + +female + +Marvel +
+Mystique + +bad + +female + +Marvel +
+Batman + +good + +male + +DC +
+Joker + +bad + +male + +DC +
+Catwoman + +bad + +female + +DC +
+Hellboy + +good + +male + +Dark Horse Comics +
+ + + + + + + + + + + + + + + + + + + + +
+Publishers +
+publisher + +yr_founded +
+DC + +1934 +
+Marvel + +1939 +
+Image + +1992 +
+

In the screen-shot of the Data > Combine tab below we see +the two datasets. The tables share the variable publisher which +is automatically selected for the join. Different join options are +available from the Combine type dropdown. You can also +specify a name for the combined dataset in the +Combined dataset text input box.

+

+

+


+
+

Inner join (superheroes, publishers) +

+

If x = superheroes and y = publishers:

+
+

An inner join returns all rows from x with matching values in y, and +all columns from both x and y. If there are multiple matches between x +and y, all match combinations are returned.

+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+name + +alignment + +gender + +publisher + +yr_founded +
+Magneto + +bad + +male + +Marvel + +1939 +
+Storm + +good + +female + +Marvel + +1939 +
+Mystique + +bad + +female + +Marvel + +1939 +
+Batman + +good + +male + +DC + +1934 +
+Joker + +bad + +male + +DC + +1934 +
+Catwoman + +bad + +female + +DC + +1934 +
+

In the table above we lose Hellboy because, although this +hero does appear in superheroes, the publisher (Dark +Horse Comics) does not appear in publishers. The join +result has all variables from superheroes, plus +yr_founded, from publishers. We can visualize an +inner join with the venn-diagram below:

+

+

+

The R(adiant) commands are:

+
+# Radiant
+combine_data(superheroes, publishers, by = "publisher", type = "inner_join")
+
+# R
+inner_join(superheroes, publishers, by = "publisher")
+


+
+
+

Left join (superheroes, publishers) +

+
+

A left join returns all rows from x, and all columns from x and y. If +there are multiple matches between x and y, all match combinations are +returned.

+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+name + +alignment + +gender + +publisher + +yr_founded +
+Magneto + +bad + +male + +Marvel + +1939 +
+Storm + +good + +female + +Marvel + +1939 +
+Mystique + +bad + +female + +Marvel + +1939 +
+Batman + +good + +male + +DC + +1934 +
+Joker + +bad + +male + +DC + +1934 +
+Catwoman + +bad + +female + +DC + +1934 +
+Hellboy + +good + +male + +Dark Horse Comics + +NA +
+

The join result contains superheroes with variable +yr_founded from publishers. Hellboy, +whose publisher does not appear in publishers, has an +NA for yr_founded. We can visualize a left join +with the venn-diagram below:

+

+

+

The R(adiant) commands are:

+
+# Radiant
+combine_data(superheroes, publishers, by = "publisher", type = "left_join")
+
+# R
+left_join(superheroes, publishers, by = "publisher")
+


+
+
+

Right join (superheroes, publishers) +

+
+

A right join returns all rows from y, and all columns from y and x. +If there are multiple matches between y and x, all match combinations +are returned.

+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+name + +alignment + +gender + +publisher + +yr_founded +
+Magneto + +bad + +male + +Marvel + +1939 +
+Storm + +good + +female + +Marvel + +1939 +
+Mystique + +bad + +female + +Marvel + +1939 +
+Batman + +good + +male + +DC + +1934 +
+Joker + +bad + +male + +DC + +1934 +
+Catwoman + +bad + +female + +DC + +1934 +
+NA + +NA + +NA + +Image + +1992 +
+

The join result contains all rows and columns from +publishers and all variables from superheroes. +We lose Hellboy, whose publisher does not appear in +publishers. Image is retained in the table but has +NA values for the variables name, +alignment, and gender from superheroes. +Notice that a join can change both the row and variable order so you +should not rely on these in your analysis. We can visualize a right join +with the venn-diagram below:

+

+

+

The R(adiant) commands are:

+
+# Radiant
+combine_data(superheroes, publishers, by = "publisher", type = "right_join")
+
+# R
+right_join(superheroes, publishers, by = "publisher")
+


+
+
+

Full join (superheroes, publishers) +

+
+

A full join combines two datasets, keeping rows and columns that +appear in either.

+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+name + +alignment + +gender + +publisher + +yr_founded +
+Magneto + +bad + +male + +Marvel + +1939 +
+Storm + +good + +female + +Marvel + +1939 +
+Mystique + +bad + +female + +Marvel + +1939 +
+Batman + +good + +male + +DC + +1934 +
+Joker + +bad + +male + +DC + +1934 +
+Catwoman + +bad + +female + +DC + +1934 +
+Hellboy + +good + +male + +Dark Horse Comics + +NA +
+NA + +NA + +NA + +Image + +1992 +
+

In this table we keep Hellboy (even though Dark Horse +Comics is not in publishers) and Image (even +though the publisher is not listed in superheroes) and get +variables from both datasets. Observations without a match are assigned +the value NA for variables from the other dataset. We can +visualize a full join with the venn-diagram below:

+

+

+

The R(adiant) commands are:

+
+# Radiant
+combine_data(superheroes, publishers, by = "publisher", type = "full_join")
+
+# R
+full_join(superheroes, publishers, by = "publisher")
+
+
+

Semi join (superheroes, publishers) +

+
+

A semi join keeps only columns from x. Whereas an inner join will +return one row of x for each matching row of y, a semi join will never +duplicate rows of x.

+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+name + +alignment + +gender + +publisher +
+Magneto + +bad + +male + +Marvel +
+Storm + +good + +female + +Marvel +
+Mystique + +bad + +female + +Marvel +
+Batman + +good + +male + +DC +
+Joker + +bad + +male + +DC +
+Catwoman + +bad + +female + +DC +
+

We get a similar table as with inner_join but it +contains only the variables in superheroes. The R(adiant) +commands are:

+
+# Radiant
+combine_data(superheroes, publishers, by = "publisher", type = "semi_join")
+
+# R
+semi_join(superheroes, publishers, by = "publisher")
+


+
+
+

Anti join (superheroes, publishers) +

+
+

An anti join returns all rows from x without matching values in y, +keeping only columns from x

+
+ + + + + + + + + + + + + +
+name + +alignment + +gender + +publisher +
+Hellboy + +good + +male + +Dark Horse Comics +
+

We now get only Hellboy, the only superhero +not in publishers and we do not get the variable +yr_founded either. We can visualize an anti join with the +venn-diagram below:

+

+

+


+
+
+

Dataset order +

+

Note that the order of the datasets selected may matter for a join. +If we setup the Data > Combine tab as below the results are +as follows:

+

+

+


+
+
+

Inner join (publishers, superheroes) +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+publisher + +yr_founded + +name + +alignment + +gender +
+DC + +1934 + +Batman + +good + +male +
+DC + +1934 + +Joker + +bad + +male +
+DC + +1934 + +Catwoman + +bad + +female +
+Marvel + +1939 + +Magneto + +bad + +male +
+Marvel + +1939 + +Storm + +good + +female +
+Marvel + +1939 + +Mystique + +bad + +female +
+

Every publisher that has a match in superheroes appears +multiple times, once for each match. Apart from variable and row order, +this is the same result we had for the inner join shown above.

+


+
+
+

Left and Right join (publishers, superheroes) +

+

Apart from row and variable order, a left join of +publishers and superheroes is equivalent to a +right join of superheroes and publishers. +Similarly, a right join of publishers and +superheroes is equivalent to a left join of +superheroes and publishers.

+


+
+
+

Full join (publishers, superheroes) +

+

As you might expect, apart from row and variable order, a full join +of publishers and superheroes is equivalent to +a full join of superheroes and publishers.

+


+
+
+

Semi join (publishers, superheroes) +

+ + + + + + + + + + + + + + + +
+publisher + +yr_founded +
+DC + +1934 +
+Marvel + +1939 +
+

With semi join the effect of switching the dataset order is more +clear. Even though there are multiple matches for each publisher only +one is shown. Contrast this with an inner join where “If there are +multiple matches between x and y, all match combinations are returned.” +We see that publisher Image is lost in the table because it is +not in superheroes.

+


+
+
+

Anti join (publishers, superheroes) +

+ + + + + + + + + +
+publisher + +yr_founded +
+Image + +1992 +
+

Only publisher Image is retained because both +Marvel and DC are in superheroes. We keep +only variables in publishers.

+


+
+
+

Additional tools to combine datasets (avengers, superheroes) +

+

When two datasets have the same columns (or rows) there are +additional ways in which we can combine them into a new dataset. We have +already used the superheroes dataset and will now try to +combine it with the avengers data. These two datasets have +the same number of rows and columns and the columns have the same +names.

+

In the screen-shot of the Data > Combine tab below we see +the two datasets. There is no need to select variables to combine the +datasets here. Any variables in Select variables are +ignored in the commands below. Again, you can specify a name for the +combined dataset in the Combined dataset text input +box.

+

+

+


+
+
+

Bind rows +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+name + +alignment + +gender + +publisher +
+Thor + +good + +male + +Marvel +
+Iron Man + +good + +male + +Marvel +
+Hulk + +good + +male + +Marvel +
+Hawkeye + +good + +male + +Marvel +
+Black Widow + +good + +female + +Marvel +
+Captain America + +good + +male + +Marvel +
+Magneto + +bad + +male + +Marvel +
+Magneto + +bad + +male + +Marvel +
+Storm + +good + +female + +Marvel +
+Mystique + +bad + +female + +Marvel +
+Batman + +good + +male + +DC +
+Joker + +bad + +male + +DC +
+Catwoman + +bad + +female + +DC +
+Hellboy + +good + +male + +Dark Horse Comics +
+

If the avengers dataset were meant to extend the list of +superheroes we could just stack the two datasets, one below the other. +The new datasets has 14 rows and 4 columns. Due to a coding error in the +avengers dataset (i.e.., Magneto is not +an Avenger) there is a duplicate row in the new combined +dataset. Something we probably don’t want.

+

The R(adiant) commands are:

+
+# Radiant
+combine_data(avengers, superheroes, type = "bind_rows")
+
+# R
+bind_rows(avengers, superheroes)
+


+
+
+

Bind columns +

+
## New names:
+## • `name` -> `name...1`
+## • `alignment` -> `alignment...2`
+## • `gender` -> `gender...3`
+## • `publisher` -> `publisher...4`
+## • `name` -> `name...5`
+## • `alignment` -> `alignment...6`
+## • `gender` -> `gender...7`
+## • `publisher` -> `publisher...8`
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+name…1 + +alignment…2 + +gender…3 + +publisher…4 + +name…5 + +alignment…6 + +gender…7 + +publisher…8 +
+Thor + +good + +male + +Marvel + +Magneto + +bad + +male + +Marvel +
+Iron Man + +good + +male + +Marvel + +Storm + +good + +female + +Marvel +
+Hulk + +good + +male + +Marvel + +Mystique + +bad + +female + +Marvel +
+Hawkeye + +good + +male + +Marvel + +Batman + +good + +male + +DC +
+Black Widow + +good + +female + +Marvel + +Joker + +bad + +male + +DC +
+Captain America + +good + +male + +Marvel + +Catwoman + +bad + +female + +DC +
+Magneto + +bad + +male + +Marvel + +Hellboy + +good + +male + +Dark Horse Comics +
+

If the dataset had different columns for the same superheroes we +could combine the two datasets, side by side. In radiant you will see an +error message if you try to bind these columns because they have the +same name. Something that we should always avoid. The method can be +useful if we know the order of the row ids of two dataset are +the same but the columns are all different.

+


+
+
+

Intersect +

+ + + + + + + + + + + + + +
+name + +alignment + +gender + +publisher +
+Magneto + +bad + +male + +Marvel +
+

A good way to check if two datasets with the same columns have +duplicate rows is to choose intersect from the +Combine type dropdown. There is indeed one row that is +identical in the avengers and superheroes data +(i.e., Magneto).

+

The R(adiant) commands are the same as shown above, except you will +need to replace bind_rows by intersect.

+


+
+
+

Union +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+name + +alignment + +gender + +publisher +
+Thor + +good + +male + +Marvel +
+Iron Man + +good + +male + +Marvel +
+Hulk + +good + +male + +Marvel +
+Hawkeye + +good + +male + +Marvel +
+Black Widow + +good + +female + +Marvel +
+Captain America + +good + +male + +Marvel +
+Magneto + +bad + +male + +Marvel +
+Storm + +good + +female + +Marvel +
+Mystique + +bad + +female + +Marvel +
+Batman + +good + +male + +DC +
+Joker + +bad + +male + +DC +
+Catwoman + +bad + +female + +DC +
+Hellboy + +good + +male + +Dark Horse Comics +
+

A union of avengers and +superheroes will combine the datasets but will omit +duplicate rows (i.e., it will keep only one copy of the row for +Magneto). Likely what we want here.

+

The R(adiant) commands are the same as shown above, except you will +need to replace bind_rows by union.

+


+
+
+

Setdiff +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+name + +alignment + +gender + +publisher +
+Thor + +good + +male + +Marvel +
+Iron Man + +good + +male + +Marvel +
+Hulk + +good + +male + +Marvel +
+Hawkeye + +good + +male + +Marvel +
+Black Widow + +good + +female + +Marvel +
+Captain America + +good + +male + +Marvel +
+

Finally, a setdiff will keep rows from +avengers that are not in superheroes. +If we reverse the inputs (i.e., choose superheroes from the +Datasets dropdown and superheroes from the +Combine with dropdown) we will end up with all rows from +superheroes that are not in avengers. In both +cases the entry for Magneto will be omitted.

+

The R(adiant) commands are the same as shown above, except you will +need to replace bind_rows by setdiff.

+


+
+
+

Report > Rmd +

+

Add code to +Report +> Rmd to (re)create the combined dataset by clicking the + icon on the bottom +left of your screen or by pressing ALT-enter on your +keyboard.

+

For additional discussion see the chapter on relational data in +R +for data science and +Tidy +Explain

+
+
+

R-functions +

+

For help with the combine_data function see +Data +> Combine

+

© Vincent Nijs (2023) +Creative Commons License

+
+
+ + + +
+ + + +
+

+

Developed by Vincent Nijs, Niklas von Hertzen.

+
+ +
+

+

Site built with pkgdown 2.0.7.

+
+ +
+
+ + + + + diff --git a/radiant.data/docs/articles/pkgdown/combine_files/accessible-code-block-0.0.1/empty-anchor.js b/radiant.data/docs/articles/pkgdown/combine_files/accessible-code-block-0.0.1/empty-anchor.js new file mode 100644 index 0000000000000000000000000000000000000000..ca349fd6a570108bde9d7daace534cd651c5f042 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/combine_files/accessible-code-block-0.0.1/empty-anchor.js @@ -0,0 +1,15 @@ +// Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> +// v0.0.1 +// Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. + +document.addEventListener('DOMContentLoaded', function() { + const codeList = document.getElementsByClassName("sourceCode"); + for (var i = 0; i < codeList.length; i++) { + var linkList = codeList[i].getElementsByTagName('a'); + for (var j = 0; j < linkList.length; j++) { + if (linkList[j].innerHTML === "") { + linkList[j].setAttribute('aria-hidden', 'true'); + } + } + } +}); diff --git a/radiant.data/docs/articles/pkgdown/combine_files/anchor-sections-1.0/anchor-sections.css b/radiant.data/docs/articles/pkgdown/combine_files/anchor-sections-1.0/anchor-sections.css new file mode 100644 index 0000000000000000000000000000000000000000..07aee5fcb8398a53ea2189cff95cbe6504116d96 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/combine_files/anchor-sections-1.0/anchor-sections.css @@ -0,0 +1,4 @@ +/* Styles for section anchors */ +a.anchor-section {margin-left: 10px; visibility: hidden; color: inherit;} +a.anchor-section::before {content: '#';} +.hasAnchor:hover a.anchor-section {visibility: visible;} diff --git a/radiant.data/docs/articles/pkgdown/combine_files/anchor-sections-1.0/anchor-sections.js b/radiant.data/docs/articles/pkgdown/combine_files/anchor-sections-1.0/anchor-sections.js new file mode 100644 index 0000000000000000000000000000000000000000..570f99a0a8775e26c9dac3b1dd7b82cbe6dbfae3 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/combine_files/anchor-sections-1.0/anchor-sections.js @@ -0,0 +1,33 @@ +// Anchor sections v1.0 written by Atsushi Yasumoto on Oct 3rd, 2020. +document.addEventListener('DOMContentLoaded', function() { + // Do nothing if AnchorJS is used + if (typeof window.anchors === 'object' && anchors.hasOwnProperty('hasAnchorJSLink')) { + return; + } + + const h = document.querySelectorAll('h1, h2, h3, h4, h5, h6'); + + // Do nothing if sections are already anchored + if (Array.from(h).some(x => x.classList.contains('hasAnchor'))) { + return null; + } + + // Use section id when pandoc runs with --section-divs + const section_id = function(x) { + return ((x.classList.contains('section') || (x.tagName === 'SECTION')) + ? x.id : ''); + }; + + // Add anchors + h.forEach(function(x) { + const id = x.id || section_id(x.parentElement); + if (id === '') { + return null; + } + let anchor = document.createElement('a'); + anchor.href = '#' + id; + anchor.classList = ['anchor-section']; + x.classList.add('hasAnchor'); + x.appendChild(anchor); + }); +}); diff --git a/radiant.data/docs/articles/pkgdown/combine_files/header-attrs-2.1/header-attrs.js b/radiant.data/docs/articles/pkgdown/combine_files/header-attrs-2.1/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/combine_files/header-attrs-2.1/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/combine_files/header-attrs-2.2/header-attrs.js b/radiant.data/docs/articles/pkgdown/combine_files/header-attrs-2.2/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/combine_files/header-attrs-2.2/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/combine_files/header-attrs-2.3/header-attrs.js b/radiant.data/docs/articles/pkgdown/combine_files/header-attrs-2.3/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/combine_files/header-attrs-2.3/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/explore.html b/radiant.data/docs/articles/pkgdown/explore.html new file mode 100644 index 0000000000000000000000000000000000000000..492139f0ffc0a1ba71f3a63c6641c7a9d0bfee2a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/explore.html @@ -0,0 +1,288 @@ + + + + + + + +Summarize and explore your data (Data > Explore) • radiant.data + + + + + + + + + + + + + + +
+
+ + + + +
+
+
+

Summarize and explore your data (Data > +Explore)

+

Vincent R. +Nijs, Rady School of Management (UCSD)

+ + + Source: vignettes/pkgdown/explore.Rmd + + +
+ + + +
+

Summarize and explore your data

+
+

Generate summary statistics for one or more variables in your data. +The most powerful feature in Data > Explore is that you can +easily describe the data by one or more other variables. Where +the +Data +> Pivot tab works best for frequency tables and to summarize +a single numeric variable, the Data > Explore tab allows you +to summarize multiple variables at the same time using various +statistics.

+

For example, if we select price from the +diamonds dataset and click the Create table +button we can see the number of observations (n), the mean, the +variance, etc. However, the mean price for each clarity level of the +diamond can also be easily provided by choosing clarity as +the Group by variable.

+
+

Note that when a categorical variable (factor) is +selected from the Numeric variable(s) dropdown menu it will +be converted to a numeric variable if required for the selected +function. If the factor levels are numeric these will be used in all +calculations. Since the mean, standard deviation, etc. are not relevant +for non-binary categorical variables, these will be converted to 0-1 +(binary) variables where the first level is coded as 1 and all other +levels as 0.

+
+

The created summary table can be stored in Radiant by clicking the +Store button. This can be useful if you want to create +plots of the summarized data in +Data +> Visualize. To download the table to csv format +click the download icon on the top-right.

+

You can select options from Column header dropdown to +switch between different column headers. Select either +Function (e.g., mean, median, etc), Variable +(e.g., price, carat, etc), or the levels of the (first) +Group by variable (e.g., Fair-Ideal).

+

+

+
+

Functions +

+

Below you will find a brief description of several functions +available from the Apply function(s) dropdown menu. Most +functions, however, will be self-explanatory.

+
    +
  • +n calculates the number of observations, or rows, in +the data or in a group if a Group by variable has been +selected (n uses the length function in +R)
    • +
  • +n_distinct calculates the number of distinct +values
    • +
  • +n_missing calculates the number of missing values
    • +
  • +cv is the coefficient of variation (i.e., mean(x) / +sd(x))
    • +
  • +sd and var calculate the sample standard +deviation and variance for numeric data
    • +
  • +me calculates the margin of error for a numeric +variable using a 95% confidence level
    • +
  • +prop calculates a proportion. For a variable with only +values 0 or 1 this is equivalent to mean. For other numeric +variables it captures the occurrence of the maximum value. For a +factor it captures the occurrence of the first level.
    • +
  • +sdprop and varprop calculate the sample +standard deviation and variance for a proportion
    • +
  • +meprop calculates the margin of error for a proportion +using a 95% confidence level
    • +
  • +sdpop and varpop calculate the population +standard deviation and variance
    • +
+
+

Filter data +

+

Use the Filter data box to select (or omit) specific +sets of rows from the data. See the helpfile for +Data +> View for details.

+
+
+

Report > Rmd +

+

Add code to +Report +> Rmd to (re)create the summary table by clicking the + icon on the bottom +left of your screen or by pressing ALT-enter on your +keyboard.

+
+
+

R-functions +

+

For an overview of related R-functions used by Radiant to summarize +and explore data see +Data +> Explore

+

© Vincent Nijs (2023) +Creative Commons License

+
+
+
+ + + +
+ + + +
+

+

Developed by Vincent Nijs, Niklas von Hertzen.

+
+ +
+

+

Site built with pkgdown 2.0.7.

+
+ +
+
+ + + + + diff --git a/radiant.data/docs/articles/pkgdown/explore_files/accessible-code-block-0.0.1/empty-anchor.js b/radiant.data/docs/articles/pkgdown/explore_files/accessible-code-block-0.0.1/empty-anchor.js new file mode 100644 index 0000000000000000000000000000000000000000..ca349fd6a570108bde9d7daace534cd651c5f042 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/explore_files/accessible-code-block-0.0.1/empty-anchor.js @@ -0,0 +1,15 @@ +// Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> +// v0.0.1 +// Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. + +document.addEventListener('DOMContentLoaded', function() { + const codeList = document.getElementsByClassName("sourceCode"); + for (var i = 0; i < codeList.length; i++) { + var linkList = codeList[i].getElementsByTagName('a'); + for (var j = 0; j < linkList.length; j++) { + if (linkList[j].innerHTML === "") { + linkList[j].setAttribute('aria-hidden', 'true'); + } + } + } +}); diff --git a/radiant.data/docs/articles/pkgdown/explore_files/anchor-sections-1.0/anchor-sections.css b/radiant.data/docs/articles/pkgdown/explore_files/anchor-sections-1.0/anchor-sections.css new file mode 100644 index 0000000000000000000000000000000000000000..07aee5fcb8398a53ea2189cff95cbe6504116d96 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/explore_files/anchor-sections-1.0/anchor-sections.css @@ -0,0 +1,4 @@ +/* Styles for section anchors */ +a.anchor-section {margin-left: 10px; visibility: hidden; color: inherit;} +a.anchor-section::before {content: '#';} +.hasAnchor:hover a.anchor-section {visibility: visible;} diff --git a/radiant.data/docs/articles/pkgdown/explore_files/anchor-sections-1.0/anchor-sections.js b/radiant.data/docs/articles/pkgdown/explore_files/anchor-sections-1.0/anchor-sections.js new file mode 100644 index 0000000000000000000000000000000000000000..570f99a0a8775e26c9dac3b1dd7b82cbe6dbfae3 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/explore_files/anchor-sections-1.0/anchor-sections.js @@ -0,0 +1,33 @@ +// Anchor sections v1.0 written by Atsushi Yasumoto on Oct 3rd, 2020. +document.addEventListener('DOMContentLoaded', function() { + // Do nothing if AnchorJS is used + if (typeof window.anchors === 'object' && anchors.hasOwnProperty('hasAnchorJSLink')) { + return; + } + + const h = document.querySelectorAll('h1, h2, h3, h4, h5, h6'); + + // Do nothing if sections are already anchored + if (Array.from(h).some(x => x.classList.contains('hasAnchor'))) { + return null; + } + + // Use section id when pandoc runs with --section-divs + const section_id = function(x) { + return ((x.classList.contains('section') || (x.tagName === 'SECTION')) + ? x.id : ''); + }; + + // Add anchors + h.forEach(function(x) { + const id = x.id || section_id(x.parentElement); + if (id === '') { + return null; + } + let anchor = document.createElement('a'); + anchor.href = '#' + id; + anchor.classList = ['anchor-section']; + x.classList.add('hasAnchor'); + x.appendChild(anchor); + }); +}); diff --git a/radiant.data/docs/articles/pkgdown/explore_files/header-attrs-2.1/header-attrs.js b/radiant.data/docs/articles/pkgdown/explore_files/header-attrs-2.1/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/explore_files/header-attrs-2.1/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/explore_files/header-attrs-2.2/header-attrs.js b/radiant.data/docs/articles/pkgdown/explore_files/header-attrs-2.2/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/explore_files/header-attrs-2.2/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/explore_files/header-attrs-2.3/header-attrs.js b/radiant.data/docs/articles/pkgdown/explore_files/header-attrs-2.3/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/explore_files/header-attrs-2.3/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/images/by-sa.png b/radiant.data/docs/articles/pkgdown/images/by-sa.png new file mode 100644 index 0000000000000000000000000000000000000000..2332cc49dd634c62e4013e13e5e4f06747c7e250 Binary files /dev/null and b/radiant.data/docs/articles/pkgdown/images/by-sa.png differ diff --git a/radiant.data/docs/articles/pkgdown/manage.html b/radiant.data/docs/articles/pkgdown/manage.html new file mode 100644 index 0000000000000000000000000000000000000000..e10664ca763ccf0dfae349fac957a2e9d5ad4a13 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/manage.html @@ -0,0 +1,335 @@ + + + + + + + +Loading and Saving data (Data > Manage) • radiant.data + + + + + + + + + + + + + + +
+
+ + + + +
+
+
+

Loading and Saving data (Data > Manage)

+

Vincent R. +Nijs, Rady School of Management (UCSD)

+ + + Source: vignettes/pkgdown/manage.Rmd + + +
+ + + +
+

Manage data and state: Load data into Radiant, Save data to disk, +Remove a dataset from memory, or Save/Load the state of the app

+
+
+

Datasets +

+

When you first start Radiant a dataset (diamonds) with +information on diamond prices is shown.

+

It is good practice to add a description of the data and variables to +each file you use. For the files that are bundled with Radiant you will +see a brief overview of the variables etc. below a table of the first 10 +rows of the data. To add a description for your own data click the +Add/edit data description check-box. A text-input box will +open below the table where you can add text in +markdown +format. The description provided for the diamonds data +included with Radiant should serve as a good example. After adding or +editing a description click the Update description +button.

+

To rename a dataset loaded in Radiant click the +Rename data check box, enter a new name, and click the +Rename button

+
+
+

Load data +

+

The best way to load and save data for use in Radiant (and R) is to +use the R-data format (rds or rda). These are binary files that can be +stored compactly and read into R quickly. Select rds (or +rda) from the Load data of type dropdown and +click Browse to locate the file(s) you want to load on your +computer.

+

You can get data from a spreadsheet (e.g., Excel or Google sheets) +into Radiant in two ways. First, you can save data from the spreadsheet +in csv format and then, in Radiant, choose csv from the +Load data of type dropdown. Most likely you will have a +header row in the csv file with variable names. If the data are not +comma separated you can choose semicolon or tab separated. To load a csv +file click ‘Browse’ and locate the file on your computer.

+

Alternatively, you can select and copy the data in the spreadsheet +using CTRL-C (or CMD-C on mac), go to Radiant, choose +clipboard from the Load data of type dropdown, +and click the Paste button. This is a short-cut that can be +convenient for smaller datasets that are cleanly formatted.

+

If the data is available in R’s global workspace (e.g., you opened a +data set in Rstudio and then started Radiant from the +addins menu) you can move (or copy) it to Radiant by +selecting from global workspace. Select the data.frame(s) +you want to use and click the Load button.

+

To access all data files bundled with Radiant choose +examples from the Load data of type dropdown +and then click the Load button. These files are used to +illustrate the various data and analysis tools accessible in Radiant. +For example, the avengers and publishers data +are used to illustrate how to combine data in R(adiant) (i.e., Data +> Combine).

+

If csv data is available online choose +csv (url) from the dropdown, paste the url into the text +input shown, and press Load. If an rda file is +available online choose rda (url) from the dropdown, paste +the url into the text input, and press Load.

+
+
+

Save data +

+

As mentioned above, the most convenient way to get data in and out of +Radiant is to use the R-data format (rds or rda). Choose +rds (or rda) from the +Save data to type dropdown and click the Save +button to save the selected dataset to file.

+

Again, it is good practice to add a description of the data and +variables to each file you use. To add a description for your own data +click the ‘Add/edit data description’ check-box, add text to the +text-input window shown in +markdown +format, and then click the Update description button. When +you save the data as an rds (or rda) file the description you created +(or edited) will automatically be added to the file as an +attribute.

+

Getting data from Radiant into a spreadsheet can be achieved in two +ways. First, you can save data in csv format and load the file into the +spreadsheet (i.e., choose csv from the +Save data to type dropdown and click the Save +button). Alternatively, you can copy the data from Radiant into the +clipboard by choosing clipboard from the dropdown and +clicking the Copy button, open the spreadsheet, and paste +the data from Radiant using CTRL-V (or CMD-V on mac).

+

To move or copy data from Radiant into R(studio)’s global workspace +select to global workspace from the +Save data to type dropdown and click the Save +button.

+
+
+

Save and load state +

+

It is convenient to work with state files if you want complete your +work at another time, perhaps on another computer, or to review previous +work you completed using Radiant. You can save and load the state of the +Radiant app just as you would a data file. The state file (extension +.state.rda) will contain (1) the data loaded in Radiant, +(2) settings for the analyses you were working on, (3) and any reports +or code from the Report menu. To save the current state of the +app to your hard-disk click the +icon in the navbar and then click Save radiant state file. +To load load a previous state click the + icon in the navbar and the click +Load radiant state file.

+

You can also share a state file with others that would like to +replicate your analyses. As an example, download and then load the state +file +radiant-example.state.rda +as described above. You will navigate automatically to the Data > +Visualize tab and will see a plot. See also the Data > +View tab for some additional settings loaded from the state file. +There is also a report in Report > Rmd created using the +Radiant interface. The html file +radiant-example.nb.html +contains the output created by clicking the Knit report +button.

+

Loading and saving state also works with Rstudio. If you start +Radiant from Rstudio and use + and then click +Stop, the r_data environment and the +r_info and r_state lists will be put into +Rstudio’s global workspace. If you start radiant again from the +Addins menu it will use r_data, +r_info, and r_state to restore state. Also, if +you load a state file directly into Rstudio it will be used when you +start Radiant.

+

Use Refresh in the + menu in the navbar to +return to a clean/new state.

+
+
+

Remove data from memory +

+

If data are loaded in memory that you no longer need in the current +session check the Remove data from memory box. Then select +the data to remove and click the Remove data button. One +datafile will always remain open.

+
+
+

Using commands to load and save data +

+

R-code can be used in Report > Rmd or Report > +R to load data from a file directly into the active Radiant +session. Use register("insert-dataset-name") to add a +dataset to the Datasets dropdown. R-code can also be used +to extract data from Radiant and save it to disk.

+
+
+

R-functions +

+

For an overview of related R-functions used by Radiant to load and +save data see +Data +> Manage

+

© Vincent Nijs (2023) +Creative Commons License

+
+
+ + + +
+ + + +
+

+

Developed by Vincent Nijs, Niklas von Hertzen.

+
+ +
+

+

Site built with pkgdown 2.0.7.

+
+ +
+
+ + + + + diff --git a/radiant.data/docs/articles/pkgdown/manage_files/accessible-code-block-0.0.1/empty-anchor.js b/radiant.data/docs/articles/pkgdown/manage_files/accessible-code-block-0.0.1/empty-anchor.js new file mode 100644 index 0000000000000000000000000000000000000000..ca349fd6a570108bde9d7daace534cd651c5f042 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/manage_files/accessible-code-block-0.0.1/empty-anchor.js @@ -0,0 +1,15 @@ +// Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> +// v0.0.1 +// Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. + +document.addEventListener('DOMContentLoaded', function() { + const codeList = document.getElementsByClassName("sourceCode"); + for (var i = 0; i < codeList.length; i++) { + var linkList = codeList[i].getElementsByTagName('a'); + for (var j = 0; j < linkList.length; j++) { + if (linkList[j].innerHTML === "") { + linkList[j].setAttribute('aria-hidden', 'true'); + } + } + } +}); diff --git a/radiant.data/docs/articles/pkgdown/manage_files/anchor-sections-1.0/anchor-sections.css b/radiant.data/docs/articles/pkgdown/manage_files/anchor-sections-1.0/anchor-sections.css new file mode 100644 index 0000000000000000000000000000000000000000..07aee5fcb8398a53ea2189cff95cbe6504116d96 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/manage_files/anchor-sections-1.0/anchor-sections.css @@ -0,0 +1,4 @@ +/* Styles for section anchors */ +a.anchor-section {margin-left: 10px; visibility: hidden; color: inherit;} +a.anchor-section::before {content: '#';} +.hasAnchor:hover a.anchor-section {visibility: visible;} diff --git a/radiant.data/docs/articles/pkgdown/manage_files/anchor-sections-1.0/anchor-sections.js b/radiant.data/docs/articles/pkgdown/manage_files/anchor-sections-1.0/anchor-sections.js new file mode 100644 index 0000000000000000000000000000000000000000..570f99a0a8775e26c9dac3b1dd7b82cbe6dbfae3 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/manage_files/anchor-sections-1.0/anchor-sections.js @@ -0,0 +1,33 @@ +// Anchor sections v1.0 written by Atsushi Yasumoto on Oct 3rd, 2020. +document.addEventListener('DOMContentLoaded', function() { + // Do nothing if AnchorJS is used + if (typeof window.anchors === 'object' && anchors.hasOwnProperty('hasAnchorJSLink')) { + return; + } + + const h = document.querySelectorAll('h1, h2, h3, h4, h5, h6'); + + // Do nothing if sections are already anchored + if (Array.from(h).some(x => x.classList.contains('hasAnchor'))) { + return null; + } + + // Use section id when pandoc runs with --section-divs + const section_id = function(x) { + return ((x.classList.contains('section') || (x.tagName === 'SECTION')) + ? x.id : ''); + }; + + // Add anchors + h.forEach(function(x) { + const id = x.id || section_id(x.parentElement); + if (id === '') { + return null; + } + let anchor = document.createElement('a'); + anchor.href = '#' + id; + anchor.classList = ['anchor-section']; + x.classList.add('hasAnchor'); + x.appendChild(anchor); + }); +}); diff --git a/radiant.data/docs/articles/pkgdown/manage_files/header-attrs-2.1/header-attrs.js b/radiant.data/docs/articles/pkgdown/manage_files/header-attrs-2.1/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/manage_files/header-attrs-2.1/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/manage_files/header-attrs-2.2/header-attrs.js b/radiant.data/docs/articles/pkgdown/manage_files/header-attrs-2.2/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/manage_files/header-attrs-2.2/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/manage_files/header-attrs-2.3/header-attrs.js b/radiant.data/docs/articles/pkgdown/manage_files/header-attrs-2.3/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/manage_files/header-attrs-2.3/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/pivotr.html b/radiant.data/docs/articles/pkgdown/pivotr.html new file mode 100644 index 0000000000000000000000000000000000000000..eaed0343ac6a214094c80396027f9d0fe14f11ee --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/pivotr.html @@ -0,0 +1,307 @@ + + + + + + + +Create pivot tables (Data > Pivot) • radiant.data + + + + + + + + + + + + + + +
+
+ + + + +
+
+
+

Create pivot tables (Data > Pivot)

+

Vincent R. +Nijs, Rady School of Management (UCSD)

+ + + Source: vignettes/pkgdown/pivotr.Rmd + + +
+ + + +
+

Create pivot tables to explore your data

+
+

If you have used pivot-tables in Excel the functionality provided in +the Data > Pivot tab should be familiar to you. Similar to +the +Data +> Explore tab, you can generate summary statistics for +variables in your data. You can also generate frequency tables. Perhaps +the most powerful feature in Data > Pivot is that you can +easily describe the data by one or more other variables.

+

For example, with the diamonds data loaded, select +clarity and cut from the +Categorical variables drop-down. The categories for the +first variable will be the column headers but you can drag-and-drop the +selected variables to change their ordering. After selecting these two +variables, and clicking on the Create pivot table button, a +frequency table of diamonds with different levels of clarity and quality +of cut is shown. Choose Row, Column, or +Total from the Normalize by drop-down to +normalize cell frequencies or create an index from a summary statistic +by the row, column, or overall total. If a normalize option is selected +it can be convenient to check the Percentage box to express +the numbers as percentages. Choose Color bar or +Heat map from the Conditional formatting +drop-down to emphasize the highest frequency counts.

+

It is also possible to summarize numerical variables. Select +price from the Numeric variables drop-down. +This will create the table shown below. Just as in the +Data +> View tab you can sort the table by clicking on the column +headers. You can also use sliders (e.g., click in the input box below +I1) to limit the view to values in a specified range. To +view only information for diamonds with a Very good, +Premium or Ideal cut click in the input box +below the cut header.

+

+

+

Below you will find a brief description of several functions +available from the Apply function dropdown menu. Most +functions, however, will be self-explanatory.

+
    +
  • +n calculates the number of observations, or rows, in +the data or in a group if a Group by variable has been +selected (n uses the length function in +R)
    • +
  • +n_distinct calculates the number of distinct +values
    • +
  • +n_missing calculates the number of missing values
    • +
  • +cv is the coefficient of variation (i.e., mean(x) / +sd(x))
    • +
  • +sd and var calculate the sample standard +deviation and variance for numeric data
    • +
  • +me calculates the margin of error for a numeric +variable using a 95% confidence level
    • +
  • +prop calculates a proportion. For a variable with only +values 0 or 1 this is equivalent to mean. For other numeric +variables it captures the occurrence of the maximum value. For a +factor it captures the occurrence of the first level.
    • +
  • +sdprop and varprop calculate the sample +standard deviation and variance for a proportion
    • +
  • +meprop calculates the margin of error for a proportion +using a 95% confidence level
    • +
  • +sdpop and varpop calculate the population +standard deviation and variance
    • +
+

You can also create a bar chart based on the generated table (see +image above). To download the table in csv format or the plot +in png format click the appropriate download icon on the +right.

+
+

Note that when a categorical variable (factor) is +selected from the Numeric variable(s) dropdown menu it will +be converted to a numeric variable if required for the selected +function(s). If the factor levels are numeric these will be used in all +calculations. Since the mean, standard deviation, etc. are not relevant +for non-binary categorical variables, these will be converted to 0-1 +(binary) variables where the first level is coded as 1 and all other +levels as 0.

+
+
+

Filter data +

+

Use the Filter data box to select (or omit) specific +sets of rows from the data to tabulate. See the help file for +Data +> View for details.

+
+
+

Store +

+

The created pivot table can be stored in Radiant by clicking the +Store button. This can be useful if you want do additional +analysis on the table or to create plots of the summarized data in +Data +> Visualize. To download the table to csv format +click the download icon on the top-right.

+
+
+

Report > Rmd +

+

Add code to +Report +> Rmd to (re)create the pivot table by clicking the + icon on the bottom +left of your screen or by pressing ALT-enter on your +keyboard.

+

If a plot was created it can be customized using ggplot2 +commands (e.g., +plot(result) + labs(title = "Pivot graph")). See +Data +> Visualize for details.

+
+
+

R-functions +

+

For an overview of related R-functions used by Radiant to create +pivot tables see +Data +> Pivot

+

© Vincent Nijs (2023) +Creative Commons License

+
+
+ + + +
+ + + +
+

+

Developed by Vincent Nijs, Niklas von Hertzen.

+
+ +
+

+

Site built with pkgdown 2.0.7.

+
+ +
+
+ + + + + diff --git a/radiant.data/docs/articles/pkgdown/pivotr_files/accessible-code-block-0.0.1/empty-anchor.js b/radiant.data/docs/articles/pkgdown/pivotr_files/accessible-code-block-0.0.1/empty-anchor.js new file mode 100644 index 0000000000000000000000000000000000000000..ca349fd6a570108bde9d7daace534cd651c5f042 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/pivotr_files/accessible-code-block-0.0.1/empty-anchor.js @@ -0,0 +1,15 @@ +// Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> +// v0.0.1 +// Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. + +document.addEventListener('DOMContentLoaded', function() { + const codeList = document.getElementsByClassName("sourceCode"); + for (var i = 0; i < codeList.length; i++) { + var linkList = codeList[i].getElementsByTagName('a'); + for (var j = 0; j < linkList.length; j++) { + if (linkList[j].innerHTML === "") { + linkList[j].setAttribute('aria-hidden', 'true'); + } + } + } +}); diff --git a/radiant.data/docs/articles/pkgdown/pivotr_files/anchor-sections-1.0/anchor-sections.css b/radiant.data/docs/articles/pkgdown/pivotr_files/anchor-sections-1.0/anchor-sections.css new file mode 100644 index 0000000000000000000000000000000000000000..07aee5fcb8398a53ea2189cff95cbe6504116d96 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/pivotr_files/anchor-sections-1.0/anchor-sections.css @@ -0,0 +1,4 @@ +/* Styles for section anchors */ +a.anchor-section {margin-left: 10px; visibility: hidden; color: inherit;} +a.anchor-section::before {content: '#';} +.hasAnchor:hover a.anchor-section {visibility: visible;} diff --git a/radiant.data/docs/articles/pkgdown/pivotr_files/anchor-sections-1.0/anchor-sections.js b/radiant.data/docs/articles/pkgdown/pivotr_files/anchor-sections-1.0/anchor-sections.js new file mode 100644 index 0000000000000000000000000000000000000000..570f99a0a8775e26c9dac3b1dd7b82cbe6dbfae3 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/pivotr_files/anchor-sections-1.0/anchor-sections.js @@ -0,0 +1,33 @@ +// Anchor sections v1.0 written by Atsushi Yasumoto on Oct 3rd, 2020. +document.addEventListener('DOMContentLoaded', function() { + // Do nothing if AnchorJS is used + if (typeof window.anchors === 'object' && anchors.hasOwnProperty('hasAnchorJSLink')) { + return; + } + + const h = document.querySelectorAll('h1, h2, h3, h4, h5, h6'); + + // Do nothing if sections are already anchored + if (Array.from(h).some(x => x.classList.contains('hasAnchor'))) { + return null; + } + + // Use section id when pandoc runs with --section-divs + const section_id = function(x) { + return ((x.classList.contains('section') || (x.tagName === 'SECTION')) + ? x.id : ''); + }; + + // Add anchors + h.forEach(function(x) { + const id = x.id || section_id(x.parentElement); + if (id === '') { + return null; + } + let anchor = document.createElement('a'); + anchor.href = '#' + id; + anchor.classList = ['anchor-section']; + x.classList.add('hasAnchor'); + x.appendChild(anchor); + }); +}); diff --git a/radiant.data/docs/articles/pkgdown/pivotr_files/header-attrs-2.1/header-attrs.js b/radiant.data/docs/articles/pkgdown/pivotr_files/header-attrs-2.1/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/pivotr_files/header-attrs-2.1/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/pivotr_files/header-attrs-2.2/header-attrs.js b/radiant.data/docs/articles/pkgdown/pivotr_files/header-attrs-2.2/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/pivotr_files/header-attrs-2.2/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/pivotr_files/header-attrs-2.3/header-attrs.js b/radiant.data/docs/articles/pkgdown/pivotr_files/header-attrs-2.3/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/pivotr_files/header-attrs-2.3/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/report_r.html b/radiant.data/docs/articles/pkgdown/report_r.html new file mode 100644 index 0000000000000000000000000000000000000000..fccf885ebc5713ec2b1911508ef5c21a4d51d885 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/report_r.html @@ -0,0 +1,276 @@ + + + + + + + +Create a reproducible report using R (Report > R) • radiant.data + + + + + + + + + + + + + + +
+
+ + + + +
+
+
+

Create a reproducible report using R (Report +> R)

+

Vincent R. +Nijs, Rady School of Management (UCSD)

+ + + Source: vignettes/pkgdown/report_r.Rmd + + +
+ + + +
+

Create a (reproducible) report using R

+
+

The Report > R tab allows you to run R-code with access +to all functions and data in Radiant. By clicking the +Knit report (R) button, the code will be evaluated and the +output will be shown on the right of the Report > R page. To +evaluate only a part of the code use the cursor to select a section and +press CTRL-enter (CMD-enter on mac).

+

You can load an R-code file into Radiant by clicking the +Load report button and selecting an .r or .R file. If you +started Radiant from Rstudio you can save a report in HTML, Word, or PDF +format by selecting the desired format from the drop-down menu and +clicking Save report. To save just the code choose +R from the dropdown and press the Save report +button.

+

If you started Radiant from Rstudio, you can also click the +Read files button to browse for files and generate code to +read it into Radiant. For example, read rda, rds, xls, yaml, and feather +and add them to the Datasets dropdown. If the file type you +want to load is not currently supported, the path to the file will be +returned. The file path used will be relative to the Rstudio-project +root. Paths to files synced to a local Dropbox or Google Drive folder +will use the find_dropbox and find_gdrive +functions to enhances reproducibility.

+

As an example you can copy-and-paste the code below into the editor +and press Knit report (R) to generate results.

+
+## get the active dataset and show the first few observations
+.get_data() %>%
+  head()
+
+## access a dataset
+diamonds %>%
+  select(price, clarity) %>%
+  head()
+
+## add a variable to the diamonds data
+diamonds <- mutate(diamonds, log_price = log(price))
+
+## show the first observations in the price and log_price columns
+diamonds %>%
+  select(price, log_price) %>%
+  head()
+
+## create a histogram of prices
+diamonds %>%
+  ggplot(aes(x = price)) +
+    geom_histogram()
+
+## and a histogram of log-prices using radiant.data::visualize
+visualize(diamonds, xvar = "log_price", custom = TRUE)
+
+## open help in the R-studio viewer from Radiant
+help(package = "radiant.data")
+
+## If you are familiar with Shiny you can call reactives when the code
+## is evaluated inside a Shiny app. For example, if you transformed
+## some variables in Data > Transform you can call the transform_main
+## reacive to see the latest result. Very useful for debugging
+# transform_main() %>% head()
+head()
+
+

Options +

+

The editor used in Report > Rmd and Report > +R has several options that can be set in +.Rprofile.

+
+options(radiant.ace_vim.keys = FALSE)
+options(radiant.ace_theme = "cobalt")
+options(radiant.ace_tabSize = 2)
+options(radiant.ace_useSoftTabs = TRUE)
+options(radiant.ace_showInvisibles = TRUE)
+options(radiant.ace_autoComplete = "live")
+

Notes:

+
    +
  • +vim.keys enables a set of special keyboard short-cuts. +If you have never used VIM you probably don’t want this
    • +
  • For an overview of available editor themes see: +shinyAce::getAceThemes() +
    • +
  • Tabs are converted to 2 spaces by default (i.e., ‘soft’ tabs). You +can change the number of spaces used from 2 to, for example, 4
    • +
  • +showInvisibles shows tabs and spaces in the editor
    • +
  • Autocomplete has options “live”, “enabled”, and “disabled”
    • +
+
+

R-functions +

+

For an overview of related R-functions used by Radiant to generate +reproducible reports see +Report

+

© Vincent Nijs (2023) +Creative Commons License

+
+
+
+ + + +
+ + + +
+

+

Developed by Vincent Nijs, Niklas von Hertzen.

+
+ +
+

+

Site built with pkgdown 2.0.7.

+
+ +
+
+ + + + + diff --git a/radiant.data/docs/articles/pkgdown/report_r_files/accessible-code-block-0.0.1/empty-anchor.js b/radiant.data/docs/articles/pkgdown/report_r_files/accessible-code-block-0.0.1/empty-anchor.js new file mode 100644 index 0000000000000000000000000000000000000000..ca349fd6a570108bde9d7daace534cd651c5f042 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/report_r_files/accessible-code-block-0.0.1/empty-anchor.js @@ -0,0 +1,15 @@ +// Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> +// v0.0.1 +// Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. + +document.addEventListener('DOMContentLoaded', function() { + const codeList = document.getElementsByClassName("sourceCode"); + for (var i = 0; i < codeList.length; i++) { + var linkList = codeList[i].getElementsByTagName('a'); + for (var j = 0; j < linkList.length; j++) { + if (linkList[j].innerHTML === "") { + linkList[j].setAttribute('aria-hidden', 'true'); + } + } + } +}); diff --git a/radiant.data/docs/articles/pkgdown/report_r_files/anchor-sections-1.0/anchor-sections.css b/radiant.data/docs/articles/pkgdown/report_r_files/anchor-sections-1.0/anchor-sections.css new file mode 100644 index 0000000000000000000000000000000000000000..07aee5fcb8398a53ea2189cff95cbe6504116d96 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/report_r_files/anchor-sections-1.0/anchor-sections.css @@ -0,0 +1,4 @@ +/* Styles for section anchors */ +a.anchor-section {margin-left: 10px; visibility: hidden; color: inherit;} +a.anchor-section::before {content: '#';} +.hasAnchor:hover a.anchor-section {visibility: visible;} diff --git a/radiant.data/docs/articles/pkgdown/report_r_files/anchor-sections-1.0/anchor-sections.js b/radiant.data/docs/articles/pkgdown/report_r_files/anchor-sections-1.0/anchor-sections.js new file mode 100644 index 0000000000000000000000000000000000000000..570f99a0a8775e26c9dac3b1dd7b82cbe6dbfae3 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/report_r_files/anchor-sections-1.0/anchor-sections.js @@ -0,0 +1,33 @@ +// Anchor sections v1.0 written by Atsushi Yasumoto on Oct 3rd, 2020. +document.addEventListener('DOMContentLoaded', function() { + // Do nothing if AnchorJS is used + if (typeof window.anchors === 'object' && anchors.hasOwnProperty('hasAnchorJSLink')) { + return; + } + + const h = document.querySelectorAll('h1, h2, h3, h4, h5, h6'); + + // Do nothing if sections are already anchored + if (Array.from(h).some(x => x.classList.contains('hasAnchor'))) { + return null; + } + + // Use section id when pandoc runs with --section-divs + const section_id = function(x) { + return ((x.classList.contains('section') || (x.tagName === 'SECTION')) + ? x.id : ''); + }; + + // Add anchors + h.forEach(function(x) { + const id = x.id || section_id(x.parentElement); + if (id === '') { + return null; + } + let anchor = document.createElement('a'); + anchor.href = '#' + id; + anchor.classList = ['anchor-section']; + x.classList.add('hasAnchor'); + x.appendChild(anchor); + }); +}); diff --git a/radiant.data/docs/articles/pkgdown/report_r_files/header-attrs-2.1/header-attrs.js b/radiant.data/docs/articles/pkgdown/report_r_files/header-attrs-2.1/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/report_r_files/header-attrs-2.1/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/report_r_files/header-attrs-2.2/header-attrs.js b/radiant.data/docs/articles/pkgdown/report_r_files/header-attrs-2.2/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/report_r_files/header-attrs-2.2/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/report_r_files/header-attrs-2.3/header-attrs.js b/radiant.data/docs/articles/pkgdown/report_r_files/header-attrs-2.3/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/report_r_files/header-attrs-2.3/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/report_rmd.html b/radiant.data/docs/articles/pkgdown/report_rmd.html new file mode 100644 index 0000000000000000000000000000000000000000..ebbe0e965bd000037cbc14af0f305d00c74bad3d --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/report_rmd.html @@ -0,0 +1,326 @@ + + + + + + + +Create a reproducible report using Rmarkdown (Report > Rmd) • radiant.data + + + + + + + + + + + + + + +
+
+ + + + +
+
+
+

Create a reproducible report using Rmarkdown +(Report > Rmd)

+

Vincent R. +Nijs, Rady School of Management (UCSD)

+ + + Source: vignettes/pkgdown/report_rmd.Rmd + + +
+ + + +
+

Create a (reproducible) report using Rmarkdown

+
+

The best way to store your work in Radiant is to use the Report +> Rmd feature and save a state file with all your results and +settings. The report feature in Radiant should be used in conjunction +with the icons shown +on the bottom left of your screen on most pages.

+

The editor shown on the left in Report > Rmd shows past +commands in R-code chunks. These chunks can +include R-code you typed or R-code generated by Radiant and added to the +report after clicking an + icon. All code chunks +start with ```{r} and are closed by ```

+

By default Radiant will add the R-code generated for the analysis you +just completed to the bottom of the report. After clicking a + icon Radiant will, by +default, switch to the Report > Rmd tab. Click inside the +editor window on the left and scroll down to see the generated +commands.

+

If you want more control over where the R-code generated by Radiant +is put into your report, choose Manual paste instead or +Auto paste from the appropriate drop-down in the Report +> Rmd tab. When Manual paste is selected, the code +is put into the clipboard when you click + and you can paste it +where you want in the editor window.

+

If you started Radiant from Rstudio, you can also choose to have +commands sent to an Rmarkdown (R-code) document open in Rstudio by +selecting To Rmd (To R) instead of +Auto paste or Manual paste. If you choose +To Rmd the editor in Report > Rmd will be +hidden (i.e., “Preview only”) and clicking on +Knit report (Rmd) will source the text and code directly +from Rstudio.

+

By default, the app will switch to the Report > Rmd tab +after you click the +icon. However, if you don’t want to switch tabs after clicking a + icon, choose +Don't switch tab from the appropriate drop-down in the +Report > Rmd tab. Don't switch tab is the +default option when you choose To Rmd.

+

You can add text or additional commands to create an Rmarkdown +document. An Rmarkdown file (extension .Rmd) is a plain text file that +can be opened in Notepad (Windows), TextEdit (Mac), Rstudio, Sublime +Text, or any other text editor. Please do not use Word +to edit Rmarkdown files.

+

Using Rmarkdown is extremely powerful because you can replicate your +entire analysis quickly without having to generate all the required +R-code again. By clicking the Knit report (Rmd) button on +the top-left of your screen, the output from the analysis will be +(re)created and shown on the right of the Report > Rmd page. +To evaluate only a part of the report use the cursor to select a section +and press CTRL-enter (CMD-enter on mac) to +create the (partial) output.

+

You can add text, bullets, headers, etc. around the code chunks to +describe and explain the results using +markdown. +For an interactive markdown tutorial visit +commonmark.org.

+

If you started Radiant from Rstudio you can save the report in +various formats (i.e., Notebook, HTML, Word, Powerpoint, or PDF). For +more on generating powerpoint presentation see +https://bookdown.org/yihui/rmarkdown/powerpoint-presentation.html. +To save the Rmarkdown file open in the editor select Rmd +(or Rmd + Data (zip)) and press Save report. +Previously saved Rmarkdown files can be loaded into Radiant by using the +Load report button. For more

+

You can also click the Read files button to browse for +files and generate code to read it into Radiant. For example, read rda, +rds, xls, yaml, and feather and add them to the Datasets +dropdown. You can also read images, R-code, and text (e.g., Rmd or md) +to include in your report. If the file type you want to load is not +currently supported, the path to the file will be returned. If Radiant +was started from an Rstudio project, the file paths used will be +relative to the project root. Paths to files synced to local Dropbox or +Google Drive folder will use the find_dropbox and +find_gdrive functions to enhances reproducibility.

+
+

State +

+

The best way to save your analyses and settings is to save the +state of the application to a file by clicking on the + icon in the navbar and then +clicking on Save radiant state file. The state file +(extension rda) will contain (1) the data loaded in Radiant, (2) +settings for the analyses you were working on, (3) and any reports or +code from the Report > Rmd and Report > R. Save +the state file to your hard-disk and, when you are ready to continue, +simply load it by icon in the +navbar and then clicking on Load radiant state file

+

If you are using Radiant for a class I suggest you use the Report +> Rmd feature to complete assignments and cases. When you are +done, generate an (HTML) Notebook (or Word or PDF) report by clicking +the Save report button. Submit both the report and your +state file.

+
+
+

Options +

+

The editor used in Report > Rmd and Report > +R has several options that can be set in .Rprofile. +You can use usethis::edit_r_profile() to alter the settings +in .Rprofile

+
+options(radiant.ace_vim.keys = FALSE)
+options(radiant.ace_theme = "cobalt")
+options(radiant.ace_tabSize = 2)
+options(radiant.ace_useSoftTabs = TRUE)
+options(radiant.ace_showInvisibles = TRUE)
+options(radiant.ace_autoComplete = "live")
+options(radiant.powerpoint_style = "~/Dropbox/rmd-styles/style.potx")
+options(radiant.word_style = "~/Dropbox/rmd-styles/style.docx")
+

Notes:

+
    +
  • +vim.keys enables a set of special keyboard short-cuts. +If you have never used VIM you probably don’t want this
    • +
  • For an overview of available editor themes see: +shinyAce::getAceThemes() +
    • +
  • Tabs are converted to 2 spaces by default (i.e., ‘soft’ tabs). You +can change the number of spaces used from 2 to, for example, 4
    • +
  • +showInvisibles shows tabs and spaces in the editor
    • +
  • Autocomplete has options “live”, “enabled”, and “disabled”
    • +
  • Radiant has default styles for Word and Powerpoint files. These can +be replaced with styles files you created however. Click the links below +to download the style files used in Radiant to your computer. Edit the +files and use options as shown above to tell Radiant where +to find the style files you want to use. + +
    • +
+
+

R-functions +

+

For an overview of related R-functions used by Radiant to generate +reproducible reports see +Report

+

© Vincent Nijs (2023) +Creative Commons License

+
+
+
+ + + +
+ + + +
+

+

Developed by Vincent Nijs, Niklas von Hertzen.

+
+ +
+

+

Site built with pkgdown 2.0.7.

+
+ +
+
+ + + + + diff --git a/radiant.data/docs/articles/pkgdown/report_rmd_files/accessible-code-block-0.0.1/empty-anchor.js b/radiant.data/docs/articles/pkgdown/report_rmd_files/accessible-code-block-0.0.1/empty-anchor.js new file mode 100644 index 0000000000000000000000000000000000000000..ca349fd6a570108bde9d7daace534cd651c5f042 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/report_rmd_files/accessible-code-block-0.0.1/empty-anchor.js @@ -0,0 +1,15 @@ +// Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> +// v0.0.1 +// Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. + +document.addEventListener('DOMContentLoaded', function() { + const codeList = document.getElementsByClassName("sourceCode"); + for (var i = 0; i < codeList.length; i++) { + var linkList = codeList[i].getElementsByTagName('a'); + for (var j = 0; j < linkList.length; j++) { + if (linkList[j].innerHTML === "") { + linkList[j].setAttribute('aria-hidden', 'true'); + } + } + } +}); diff --git a/radiant.data/docs/articles/pkgdown/report_rmd_files/anchor-sections-1.0/anchor-sections.css b/radiant.data/docs/articles/pkgdown/report_rmd_files/anchor-sections-1.0/anchor-sections.css new file mode 100644 index 0000000000000000000000000000000000000000..07aee5fcb8398a53ea2189cff95cbe6504116d96 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/report_rmd_files/anchor-sections-1.0/anchor-sections.css @@ -0,0 +1,4 @@ +/* Styles for section anchors */ +a.anchor-section {margin-left: 10px; visibility: hidden; color: inherit;} +a.anchor-section::before {content: '#';} +.hasAnchor:hover a.anchor-section {visibility: visible;} diff --git a/radiant.data/docs/articles/pkgdown/report_rmd_files/anchor-sections-1.0/anchor-sections.js b/radiant.data/docs/articles/pkgdown/report_rmd_files/anchor-sections-1.0/anchor-sections.js new file mode 100644 index 0000000000000000000000000000000000000000..570f99a0a8775e26c9dac3b1dd7b82cbe6dbfae3 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/report_rmd_files/anchor-sections-1.0/anchor-sections.js @@ -0,0 +1,33 @@ +// Anchor sections v1.0 written by Atsushi Yasumoto on Oct 3rd, 2020. +document.addEventListener('DOMContentLoaded', function() { + // Do nothing if AnchorJS is used + if (typeof window.anchors === 'object' && anchors.hasOwnProperty('hasAnchorJSLink')) { + return; + } + + const h = document.querySelectorAll('h1, h2, h3, h4, h5, h6'); + + // Do nothing if sections are already anchored + if (Array.from(h).some(x => x.classList.contains('hasAnchor'))) { + return null; + } + + // Use section id when pandoc runs with --section-divs + const section_id = function(x) { + return ((x.classList.contains('section') || (x.tagName === 'SECTION')) + ? x.id : ''); + }; + + // Add anchors + h.forEach(function(x) { + const id = x.id || section_id(x.parentElement); + if (id === '') { + return null; + } + let anchor = document.createElement('a'); + anchor.href = '#' + id; + anchor.classList = ['anchor-section']; + x.classList.add('hasAnchor'); + x.appendChild(anchor); + }); +}); diff --git a/radiant.data/docs/articles/pkgdown/report_rmd_files/header-attrs-2.1/header-attrs.js b/radiant.data/docs/articles/pkgdown/report_rmd_files/header-attrs-2.1/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/report_rmd_files/header-attrs-2.1/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/report_rmd_files/header-attrs-2.2/header-attrs.js b/radiant.data/docs/articles/pkgdown/report_rmd_files/header-attrs-2.2/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/report_rmd_files/header-attrs-2.2/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/report_rmd_files/header-attrs-2.3/header-attrs.js b/radiant.data/docs/articles/pkgdown/report_rmd_files/header-attrs-2.3/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/report_rmd_files/header-attrs-2.3/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/state.html b/radiant.data/docs/articles/pkgdown/state.html new file mode 100644 index 0000000000000000000000000000000000000000..89872ba5249a6f7d30a102c57d28639ec78e98c5 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/state.html @@ -0,0 +1,217 @@ + + + + + + + +Loading and Saving the State of the application • radiant.data + + + + + + + + + + + + + + +
+
+ + + + +
+
+
+

Loading and Saving the State of the +application

+

Vincent R. +Nijs, Rady School of Management (UCSD)

+ + + Source: vignettes/pkgdown/state.Rmd + + +
+ + + +
+

Save, load, share, or view state

+
+

It is convenient to work with state files if you want complete your +work at another time, perhaps on another computer, or to review previous +work you completed using Radiant. You can save and load the state of the +Radiant app just as you would a data file. The state file (extension +.rda) will contain (1) the data loaded in Radiant, (2) +settings for the analyses you were working on, (3) and any reports or +code from the Report menu. To save the current state of the app +to your hard-disk click the icon +in the navbar and then click Save radiant state file. To +load load a previous state click the + icon in the navbar and the click +Load radiant state file.

+

You can also share a state file with others that would like to +replicate your analyses. As an example, download and then load the state +file +radiant-example.state.rda +as described above. You will navigate automatically to the Data > +Visualize tab and will see a plot. See also the Data > +View tab for some additional settings loaded from the state file. +There is also a report in Report > Rmd created using the +Radiant interface. The html file +radiant-example.nb.html +contains the output created by clicking the Knit report +button.

+

Loading and saving state also works with Rstudio. If you start +Radiant from Rstudio and use + and then click +Stop, the r_data environment and the +r_info and r_state lists will be put into +Rstudio’s global workspace. If you start radiant again from the +Addins menu it will use r_data, +r_info, and r_state to restore state. Also, if +you load a state file directly into Rstudio it will be used when you +start Radiant.

+

Use Refresh in the + menu in the navbar to +return to a clean/new state.

+

© Vincent Nijs (2023) +Creative Commons License

+
+ + + +
+ + + +
+

+

Developed by Vincent Nijs, Niklas von Hertzen.

+
+ +
+

+

Site built with pkgdown 2.0.7.

+
+ +
+
+ + + + + diff --git a/radiant.data/docs/articles/pkgdown/state_files/accessible-code-block-0.0.1/empty-anchor.js b/radiant.data/docs/articles/pkgdown/state_files/accessible-code-block-0.0.1/empty-anchor.js new file mode 100644 index 0000000000000000000000000000000000000000..ca349fd6a570108bde9d7daace534cd651c5f042 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/state_files/accessible-code-block-0.0.1/empty-anchor.js @@ -0,0 +1,15 @@ +// Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> +// v0.0.1 +// Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. + +document.addEventListener('DOMContentLoaded', function() { + const codeList = document.getElementsByClassName("sourceCode"); + for (var i = 0; i < codeList.length; i++) { + var linkList = codeList[i].getElementsByTagName('a'); + for (var j = 0; j < linkList.length; j++) { + if (linkList[j].innerHTML === "") { + linkList[j].setAttribute('aria-hidden', 'true'); + } + } + } +}); diff --git a/radiant.data/docs/articles/pkgdown/state_files/anchor-sections-1.0/anchor-sections.css b/radiant.data/docs/articles/pkgdown/state_files/anchor-sections-1.0/anchor-sections.css new file mode 100644 index 0000000000000000000000000000000000000000..07aee5fcb8398a53ea2189cff95cbe6504116d96 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/state_files/anchor-sections-1.0/anchor-sections.css @@ -0,0 +1,4 @@ +/* Styles for section anchors */ +a.anchor-section {margin-left: 10px; visibility: hidden; color: inherit;} +a.anchor-section::before {content: '#';} +.hasAnchor:hover a.anchor-section {visibility: visible;} diff --git a/radiant.data/docs/articles/pkgdown/state_files/anchor-sections-1.0/anchor-sections.js b/radiant.data/docs/articles/pkgdown/state_files/anchor-sections-1.0/anchor-sections.js new file mode 100644 index 0000000000000000000000000000000000000000..570f99a0a8775e26c9dac3b1dd7b82cbe6dbfae3 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/state_files/anchor-sections-1.0/anchor-sections.js @@ -0,0 +1,33 @@ +// Anchor sections v1.0 written by Atsushi Yasumoto on Oct 3rd, 2020. +document.addEventListener('DOMContentLoaded', function() { + // Do nothing if AnchorJS is used + if (typeof window.anchors === 'object' && anchors.hasOwnProperty('hasAnchorJSLink')) { + return; + } + + const h = document.querySelectorAll('h1, h2, h3, h4, h5, h6'); + + // Do nothing if sections are already anchored + if (Array.from(h).some(x => x.classList.contains('hasAnchor'))) { + return null; + } + + // Use section id when pandoc runs with --section-divs + const section_id = function(x) { + return ((x.classList.contains('section') || (x.tagName === 'SECTION')) + ? x.id : ''); + }; + + // Add anchors + h.forEach(function(x) { + const id = x.id || section_id(x.parentElement); + if (id === '') { + return null; + } + let anchor = document.createElement('a'); + anchor.href = '#' + id; + anchor.classList = ['anchor-section']; + x.classList.add('hasAnchor'); + x.appendChild(anchor); + }); +}); diff --git a/radiant.data/docs/articles/pkgdown/state_files/header-attrs-2.1/header-attrs.js b/radiant.data/docs/articles/pkgdown/state_files/header-attrs-2.1/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/state_files/header-attrs-2.1/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/state_files/header-attrs-2.2/header-attrs.js b/radiant.data/docs/articles/pkgdown/state_files/header-attrs-2.2/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/state_files/header-attrs-2.2/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/state_files/header-attrs-2.3/header-attrs.js b/radiant.data/docs/articles/pkgdown/state_files/header-attrs-2.3/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/state_files/header-attrs-2.3/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/transform.html b/radiant.data/docs/articles/pkgdown/transform.html new file mode 100644 index 0000000000000000000000000000000000000000..68e746597c08a94d0ff05bd91db4ffc2f361732c --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/transform.html @@ -0,0 +1,778 @@ + + + + + + + +Transform variables (Data > Transform) • radiant.data + + + + + + + + + + + + + + +
+
+ + + + +
+
+
+

Transform variables (Data > Transform)

+

Vincent R. +Nijs, Rady School of Management (UCSD)

+ + + Source: vignettes/pkgdown/transform.Rmd + + +
+ + + +
+

Transform variables

+
+
+

Transform command log +

+

All transformations applied in the Data > Transform tab +can be logged. If, for example, you apply a +Ln (natural log) transformation to numeric variables the +following code is generated and put in the +Transform command log window at the bottom of your screen +when you click the Store button.

+
+## transform variable
+diamonds <- mutate_ext(
+  diamonds, 
+  .vars = vars(price, carat), 
+  .funs = log, 
+  .ext = "_ln"
+)
+

This is an important feature if you want to re-run a report with new, +but similar, data. Even more important is that there is a record of the +steps taken to transform the data and to generate results, i.e., your +work is now reproducible.

+

To add commands contained in the command log window to a report in +Report +> Rmd click the + icon.

+
+
+

Filter data +

+

Even if a filter has been specified it will be ignored for (most) +functions available in Data > Transform. To create a new +dataset based on a filter navigate to the +Data +> View tab and click the Store button. +Alternatively, to create a new dataset based on a filter, select +Split data > Holdout sample from the +Transformation type dropdown.

+
+
+

Hide summaries +

+

For larger datasets, or when summaries are not needed, it can useful +to click Hide summariesbefore selecting the transformation +type and specifying how you want to alter the data. If you do want to +see summaries make sure that Hide summaries is not +checked.

+
+
+

Change variables +

+
+

Bin +

+

The Bin command is a convenience function for the +xtile command discussed below when you want to create +multiple quintile/decile/… variables. To calculate quintiles enter +5 as the Nr bins. The reverse +option replaces 1 by 5, 2 by 4, …, 5 by 1. Choose an appropriate +extension for the new variable(s).

+
+
+

Change type +

+

When you select Type from the +Transformation type drop-down another drop-down menu is +shown that will allow you to change the type (or class) of one or more +variables. For example, you can change a variable of type integer to a +variable of type factor. Click the Store button to commit +the changes to the data set. A description of the transformation options +is provided below.

+
    +
  1. As factor: convert a variable to type factor (i.e., a categorical +variable)
    2. +
  2. As number: convert a variable to type numeric
    3. +
  3. As integer: convert a variable to type integer
    4. +
  4. As character: convert a variable to type character (i.e., +strings)
    5. +
  5. As times series: convert a variable to type ts
    6. +
  6. As date (mdy): convert a variable to a date if the dates are +structured as month-day-year
    7. +
  7. As date (dmy): convert a variable to a date if the dates are +structured as day-month-year
    8. +
  8. As date (ymd): convert a variable to a date if the dates are +structured as year-month-day
    9. +
  9. As date/time (mdy_hms): convert a variable to a date if the dates +are structured as month-day-year-hour-minute-second
    10. +
  10. As date/time (mdy_hm): convert a variable to a date if the dates are +structured as month-day-year-hour-minute
    11. +
  11. As date/time (dmy_hms): convert a variable to a date if the dates +are structured as day-month-year-hour-minute-second
    12. +
  12. As date/time (dmy_hm): convert a variable to a date if the dates are +structured as day-month-year-hour-minute
    13. +
  13. As date/time (ymd_hms): convert a variable to a date if the dates +are structured as year-month-day-hour-minute-second
    14. +
  14. As date/time (ymd_hm): convert a variable to a date if the dates are +structured as year-month-day-hour-minute
    15. +
+

Note: When converting a variable to type +ts (i.e., time series) you should, at least, specify a +starting period and the frequency data. For example, for weekly data +that starts in the 4th week of the year, enter 4 as the +Start period and set Frequency to +52.

+
+
+

Normalize +

+

Choose Normalize from the +Transformation type drop-down to standardize one or more +variables. For example, in the diamonds data we may want to express +price of a diamond per-carat. Select carat as the +Normalizing variable and price in the +Select variable(s) box. You will see summary statistics for +the new variable (e.g., price_carat) in the main panel. +Commit changes to the data by clicking the Store +button.

+
+
+

Recode +

+

To use the recode feature select the variable you want to change and +choose Recode from the Transformation type +drop-down. Provide one or more recode commands, separated by a +;, and press return to see information about the changed +variable. Note that you can specify a name for the recoded variable in +the Recoded variable name input box (press return to submit +changes). Finally, click Store to add the recoded variable +to the data. Some examples are given below.

+
    +
  1. Set values below 20 to Low and all others to +High +
    2. +
+
lo:20 = 'Low'; else = 'High'
+
    +
  1. Set above 20 to High and all others to +Low +
    2. +
+
20:hi = 'High'; else = 'Low'
+
    +
  1. Set values 1 through 12 to A, 13:24 to B, +and the remainder to C +
    2. +
+
1:12 = 'A'; 13:24 = 'B'; else = 'C'
+
    +
  1. Collapse age categories for a +Basics +> Tables > Cross-tabs cross-tab analysis. In the example +below <25 and 25-34 are recoded to +<35, 35-44 and 35-44 are +recoded to 35-54, and 55-64 and +>64 are recoded to >54 +
    2. +
+
+'<25' = '<35'; '25-34' = '<35'; '35-44' = '35-54'; '45-54' = '35-54'; '55-64' = '>54'; '>64' = '>54'
+
    +
  1. To exclude a particular value (e.g., an outlier in the data) for +subsequent analyses we can recode it to a missing value. For example, if +we want to remove the maximum value from a variable called +sales that is equal to 400 we would (1) select the variable +sales in the Select variable(s) box and enter +the command below in the Recode box. Press +return and Store to add the recoded variable +to the data
    2. +
+
+400 = NA
+
    +
  1. To recode specific numeric values (e.g., carat) to a new value (1) +select the variable carat in the +Select variable(s) box and enter the command below in the +Recode box to set the value for carat to 2 in all rows +where carat is currently larger than or equal to 2. Press +return and Store to add the recoded variable +to the data
    2. +
+
+2:hi = 2
+

Note: Do not use = in a variable label +when using the recode function (e.g., 50:hi = '>= 50') +as this will cause an error.

+
+
+

Reorder or remove levels +

+

If a (single) variable of type factor is selected in +Select variable(s), choose +Reorder/Remove levels from the +Transformation type drop-down to reorder and/or remove +levels. Drag-and-drop levels to reorder them or click the \(\times\) to remove them. Note that, by +default, removing one or more levels will introduce missing values in +the data. If you prefer to recode the removed levels into a new level, +for example “other”, simply type “other” in the +Replacement level name input box and press +return. If the resulting factor levels appear as intended, +press Store to commit the changes. To temporarily exclude +levels from the data use the Filter data box (see the help +file linked in the +Data +> View tab).

+
+
+

Rename +

+

Choose Rename from the Transformation type +drop-down, select one or more variables, and enter new names for them in +the Rename box. Separate names by a ,. Press +return to see summaries for the renamed variables on screen and press +Store to alter the variable names in the data.

+
+
+

Replace +

+

Choose Replace from the Transformation type +drop-down if you want to replace existing variables in the data with new +ones created using, for example, Create, +Transform, Clipboard, etc.. Select one or more +variables to overwrite and the same number of replacement variables. +Press Store to alter the data.

+
+
+

Transform +

+

When you select Transform from the +Transformation type drop-down another drop-down menu is +shown you can use to apply common transformations to one or more +variables in the data. For example, to take the (natural) log of a +variable select the variable(s) you want to transform and choose +Ln (natural log) from the Apply function +drop-down. The transformed variable will have the extension specified in +the Variable name extension input (e.g,. _ln). +Make sure to press return after changing the extension. +Click the Store button to add the (changed) variable(s) to +the data set. A description of the transformation functions included in +Radiant is provided below.

+
    +
  1. Ln: create a natural log-transformed version of the selected +variable (i.e., log(x) or ln(x))
    2. +
  2. Square: multiply a variable by itself (i.e., x^2 or square(x))
    3. +
  3. Square-root: take the square-root of a variable (i.e., x^.5)
    4. +
  4. Absolute: Absolute value of a variable (i.e., abs(x))
    5. +
  5. Center: create a new variable with a mean of zero (i.e., x - +mean(x))
    6. +
  6. Standardize: create a new variable with a mean of zero and standard +deviation of one (i.e., (x - mean(x))/sd(x))
    7. +
  7. Inverse: 1/x
    8. +
+
+
+
+

Create new variable(s) +

+
+

Clipboard +

+

Although not recommended, you can manipulate your data in a +spreadsheet (e.g., Excel or Google sheets) and copy-and-paste the data +back into Radiant. If you don’t have the original data in a spreadsheet +already use the clipboard feature in +Data +> Manage so you can paste it into the spreadsheet or click +the download icon on the top right of your screen in the +Data +> View tab. Apply your transformations in the spreadsheet +program and then copy the new variable(s), with a header label, to the +clipboard (i.e., CTRL-C on windows and CMD-C on mac). Select +Clipboard from the Transformation type +drop-down and paste the new data into the +Paste from spreadsheet box. It is key that new variable(s) +have the same number of observations as the data in Radiant. To add the +new variables to the data click Store.

+
+

Note: Using the clipboard feature for data +transformation is discouraged because it is not reproducible.

+
+
+
+

Create +

+

Choose Create from the Transformation type +drop-down. This is the most flexible command to create new or transform +existing variables. However, it also requires some basic knowledge of +R-syntax. A new variable can be any function of other variables in the +(active) dataset. Some examples are given below. In each example the +name to the left of the = sign is the name of the new +variable. To the right of the = sign you can include other +variable names and basic R-functions. After you type the command press +return to see summary statistics for the new variable. If +the result is as expected press Store to add it to the +dataset.

+
+

Note: If one or more variables is selected from the +Select variables list they will be used to group +the data before creating the new variable (see example 1. below). If +this is not the intended result make sure that no variables are selected +when creating new variables

+
+
    +
  1. Create a new variable z that is equal to the mean of +price. To calculate the mean of price per group (e.g., per level of +clarity) select clarity from the +Select variables list before creating z +
    2. +
+
+z = mean(price)
+
    +
  1. Create a new variable z that is the difference between +variables x and y
    2. +
+
+z = x - y
+
    +
  1. Create a new variable z that is a transformation of +variable x with mean equal to zero (see also +Transform > Center):
    2. +
+
+z = x - mean(x)
+
    +
  1. Create a new _logical) variable z that takes on the +value TRUE when x > y and FALSE otherwise
    2. +
+
+z = x > y
+
    +
  1. Create a new logical z that takes on the value +TRUE when x is equal to y and FALSE +otherwise
    2. +
+
+z = x == y
+
    +
  1. Create a variable z that is equal to x +lagged by 3 periods
    2. +
+
+z = lag(x,3)
+
    +
  1. Create a categorical variable with two levels (i.e., +smaller and bigger)
    2. +
+
+z = ifelse(x < y, 'smaller', 'bigger')
+
    +
  1. Create a categorical variable with three levels. An alternative +approach would be to use the Recode function described +below
    2. +
+
+z = ifelse(x < 60, '< 60', ifelse(x > 65, '> 65', '60-65'))
+
    +
  1. Convert an outlier to a missing value. For example, if we want to +remove the maximum value from a variable called sales that +is equal to 400 we could use an ifelse statement and enter +the command below in the Create box. Press +return and Store to add the +sales_rc to the data. Note that if we had entered +sales on the left-hand side of the = sign the +original variable would have been overwritten
    2. +
+
+sales_rc = ifelse(sales > 400, NA, sales)
+
    +
  1. If a respondent with ID 3 provided information on the wrong scale in +a survey (e.g., income in $1s rather than in $1000s) we could use an +ifelse statement and enter the command below in the +Create box. As before, press return and +Store to add sales_rc to the data
    2. +
+
+income_rc = ifelse(ID == 3, income/1000, income)
+
    +
  1. If multiple respondents made the same scaling mistake (e.g., those +with ID 1, 3, and 15) we again use Create and enter:
    2. +
+
+income_rc = ifelse(ID %in% c(1, 3, 15), income/1000, income)
+
    +
  1. If a date variable is in a format not available through the +Type menu you can use the parse_date_time +function. For a date formatted as 2-1-14 you would specify +the command below (note that this format will also be parsed correctly +by the mdy function in the Type menu)
    2. +
+
+date = parse_date_time(x, '%m%d%y')
+
    +
  1. Determine the time difference between two dates/times in +seconds
    2. +
+
+tdiff = as_duration(time2 - time1)
+
    +
  1. Extract the month from a date variable
    2. +
+
+m = month(date)
+
    +
  1. Other attributes that can be extracted from a date or date-time +variable are minute, hour, day, +week, quarter, year, +wday (for weekday). For wday and +month it can be convenient to add label = TRUE +to the call. For example, to extract the weekday from a date variable +and use a label rather than a number
    2. +
+
+wd = wday(date, label = TRUE)
+
    +
  1. Calculate the distance between two locations using lat-long +information
    2. +
+
+dist = as_distance(lat1, long1, lat2, long2)
+
    +
  1. Calculate quintiles for a variable recency by using the +xtile command. To create deciles replace 5 by +10.
    2. +
+
+rec_iq = xtile(recency, 5)
+
    +
  1. To reverse the ordering of the quintiles created in 17 above use +rev = TRUE +
    2. +
+
+rec_iq = xtile(recency, 5, rev = TRUE)
+
    +
  1. To remove text from entries in a character or factor variable use +sub to remove only the first instance or gsub +to remove all instances. For example, suppose each row for a variable +bk_score has the letters “clv” before a number (e.g., +“clv150”). We could replace each occurrence of “clv” by “” as +follows:
    2. +
+
+bk_score = sub("clv", "", bk_score)
+

Note: For examples 7, 8, and 15 above you may need to change the new +variable to type factor before using it for further +analysis (see also Change type above)

+
+
+
+

Clean data +

+
+

Remove missing values +

+

Choose Remove missing from the +Transformation type drop-down to eliminate rows with one or +more missing values. Rows with missing values for +Select variables will be removed. Press Store +to change the data. If missing values were present you will see the +number of observations in the data summary change (i.e., the value of +n changes) as variables are selected.

+
+
+

Reorder or remove variables +

+

Choose Reorder/Remove variables from the +Transformation type drop-down. Drag-and-drop variables to +reorder them in the data. To remove a variable click the \(\times\) symbol next to the label. Press +Store to commit the changes.

+
+
+

Remove duplicates +

+

It is common to have one or more variables in a dataset that have +only unique values (i.e., no duplicates). Customer IDs, for example, +should be unique unless the dataset contains multiple orders for the +same customer. To remove duplicates select one or more variables to +determine uniqueness. Choose Remove duplicates +from the Transformation type drop-down and check how the +displayed summary statistics change. Press Store to change +the data. If there are duplicate rows you will see the number of +observations in the data summary change (i.e., the value of n +and n_distinct will change).

+
+
+

Show duplicates +

+

If there are duplicates in the data use Show duplicates +to get a better sense for the data points that have the same value in +multiple rows. If you want to explore duplicates using the +Data +> View tab make sure to Store them in a +different dataset (i.e., make sure not to overwrite the +data you are working on). If you choose to show duplicates based on all +columns in the data only one of the duplicate rows will be shown. These +rows are exactly the same so showing 2 or 3 isn’t +helpful. If, however, we are looking for duplicates based on a subset of +the available variables Radiant will generate a dataset with +all relevant rows.

+
+
+
+

Expand data +

+
+

Expand grid +

+

Create a dataset with all combinations of values for a selection of +variables. This is useful to generate datasets for prediction in, for +example, +Model +> Estimate > Linear regression (OLS) or +Model +> Estimate > Logistic regression (GLM). Suppose you want +to create a dataset with all possible combinations of values for +cut and color of a diamond. By selecting +Expand grid from the Transformation type +dropdown and cut and color in the +Select variable(s) box we can see in the screenshot below +that there are 35 possible combinations (i.e., cut has 5 +unique values and color has 7 unique values so 5 x 7 +combinations are possible). Choose a name for the new dataset (e.g., +diamonds_expand) and click the Store button to add it to +the Datasets dropdown.

+

+

+
+
+

Table-to-data +

+

Turn a frequency table into a dataset. The number of rows will equal +the sum of all frequencies.

+
+
+
+

Split data +

+
+

Holdout sample +

+

To create a holdout sample based on a filter, select +Holdout sample from the Transformation type +dropdown. By default the opposite of the active filter is used. +For example, if analysis is conducted on observations with +date < '2014-12-13' then the holdout sample will contain +rows with date >= '2014-12-13' if the +Reverse filter box is checked.

+
+
+

Training variable +

+

To create a variable that can be used to (randomly) filter a dataset +for model training and testing, select Training variable +from the Transformation type dropdown. Specify either the +number of observations to use for training (e.g., set Size +to 2000) or a proportion of observations to select (e.g., set +Size to .7). The new variable will have a value +1 for training and 0 test data.

+

It is also possible to select one or morel variables for +blocking in random assignment to the training and test +samples. This can help ensure that, for example, the proportion of +positive and negative and negative cases (e.g., “buy” vs “no buy”) for a +variable of interest is (almost) identical in the training and test +sample.

+
+
+
+

Tidy data +

+
+

Gather columns +

+

Combine multiple variables into one column. If you have the +diamonds dataset loaded, select cut and +color in the Select variable(s) box after +selecting Gather columns from the +Transformation type dropdown. This will create new +variables key and value. key has +two levels (i.e., cut and color) and +value captures all values in cut and +color.

+
+
+

Spread column +

+

Spread one column into multiple columns. The opposite of +gather. For a detailed discussion about tidy data +see the +tidy-data +vignette.

+
+
+
+

R-functions +

+

For an overview of related R-functions used by Radiant to transform +data see +Data +> Transform

+

© Vincent Nijs (2023) +Creative Commons License

+
+
+ + + +
+ + + +
+

+

Developed by Vincent Nijs, Niklas von Hertzen.

+
+ +
+

+

Site built with pkgdown 2.0.7.

+
+ +
+
+ + + + + diff --git a/radiant.data/docs/articles/pkgdown/transform_files/accessible-code-block-0.0.1/empty-anchor.js b/radiant.data/docs/articles/pkgdown/transform_files/accessible-code-block-0.0.1/empty-anchor.js new file mode 100644 index 0000000000000000000000000000000000000000..ca349fd6a570108bde9d7daace534cd651c5f042 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/transform_files/accessible-code-block-0.0.1/empty-anchor.js @@ -0,0 +1,15 @@ +// Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> +// v0.0.1 +// Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. + +document.addEventListener('DOMContentLoaded', function() { + const codeList = document.getElementsByClassName("sourceCode"); + for (var i = 0; i < codeList.length; i++) { + var linkList = codeList[i].getElementsByTagName('a'); + for (var j = 0; j < linkList.length; j++) { + if (linkList[j].innerHTML === "") { + linkList[j].setAttribute('aria-hidden', 'true'); + } + } + } +}); diff --git a/radiant.data/docs/articles/pkgdown/transform_files/anchor-sections-1.0/anchor-sections.css b/radiant.data/docs/articles/pkgdown/transform_files/anchor-sections-1.0/anchor-sections.css new file mode 100644 index 0000000000000000000000000000000000000000..07aee5fcb8398a53ea2189cff95cbe6504116d96 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/transform_files/anchor-sections-1.0/anchor-sections.css @@ -0,0 +1,4 @@ +/* Styles for section anchors */ +a.anchor-section {margin-left: 10px; visibility: hidden; color: inherit;} +a.anchor-section::before {content: '#';} +.hasAnchor:hover a.anchor-section {visibility: visible;} diff --git a/radiant.data/docs/articles/pkgdown/transform_files/anchor-sections-1.0/anchor-sections.js b/radiant.data/docs/articles/pkgdown/transform_files/anchor-sections-1.0/anchor-sections.js new file mode 100644 index 0000000000000000000000000000000000000000..570f99a0a8775e26c9dac3b1dd7b82cbe6dbfae3 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/transform_files/anchor-sections-1.0/anchor-sections.js @@ -0,0 +1,33 @@ +// Anchor sections v1.0 written by Atsushi Yasumoto on Oct 3rd, 2020. +document.addEventListener('DOMContentLoaded', function() { + // Do nothing if AnchorJS is used + if (typeof window.anchors === 'object' && anchors.hasOwnProperty('hasAnchorJSLink')) { + return; + } + + const h = document.querySelectorAll('h1, h2, h3, h4, h5, h6'); + + // Do nothing if sections are already anchored + if (Array.from(h).some(x => x.classList.contains('hasAnchor'))) { + return null; + } + + // Use section id when pandoc runs with --section-divs + const section_id = function(x) { + return ((x.classList.contains('section') || (x.tagName === 'SECTION')) + ? x.id : ''); + }; + + // Add anchors + h.forEach(function(x) { + const id = x.id || section_id(x.parentElement); + if (id === '') { + return null; + } + let anchor = document.createElement('a'); + anchor.href = '#' + id; + anchor.classList = ['anchor-section']; + x.classList.add('hasAnchor'); + x.appendChild(anchor); + }); +}); diff --git a/radiant.data/docs/articles/pkgdown/transform_files/header-attrs-2.1/header-attrs.js b/radiant.data/docs/articles/pkgdown/transform_files/header-attrs-2.1/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/transform_files/header-attrs-2.1/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/transform_files/header-attrs-2.2/header-attrs.js b/radiant.data/docs/articles/pkgdown/transform_files/header-attrs-2.2/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/transform_files/header-attrs-2.2/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/transform_files/header-attrs-2.3/header-attrs.js b/radiant.data/docs/articles/pkgdown/transform_files/header-attrs-2.3/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/transform_files/header-attrs-2.3/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/view.html b/radiant.data/docs/articles/pkgdown/view.html new file mode 100644 index 0000000000000000000000000000000000000000..414951947c56a2b1554c7785183205c257ac2e57 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/view.html @@ -0,0 +1,443 @@ + + + + + + + +View data in an interactive table (Data > View) • radiant.data + + + + + + + + + + + + + + +
+
+ + + + +
+
+
+

View data in an interactive table (Data > +View)

+

Vincent R. +Nijs, Rady School of Management (UCSD)

+ + + Source: vignettes/pkgdown/view.Rmd + + +
+ + + +
+

Show data as an interactive table

+
+
+

Datasets +

+

Choose one of the datasets from the Datasets dropdown. +Files are loaded into Radiant through the Data > Manage +tab.

+
+
+

Filter data +

+

There are several ways to select a subset of the data to view. The +Filter data box on the left (click the check-box) can be +used with > and < symbols. You can also +combine subset commands, for example, x > 3 & y == 2 +would show only those rows for which the variable x has +values larger than 3 AND for which y is +equal to 2. Note that in R, and most other programming languages, += is used to assign a value and == to +determine if values are equal to each other. In contrast, +!= is used to determine if two values are unequal. +You can also use expressions that have an OR condition. +For example, to select rows where Salary is smaller than +$100,000 OR larger than $20,000 use +Salary > 20000 | Salary < 100000. | is +the symbol for OR and & is the symbol +for AND

+

It is also possible to filter using dates. For example, to select +rows with dates before June 1st, 2014 enter +date < "2014-6-1" into the filter box and press +return.

+

You can also use string matching to select rows. For example, type +grepl('ood', cut) to select rows with Good or +Very good cut. This search is case sensitive by default. +For case insensitive search use +grepl("GOOD", cut, ignore.case = TRUE). Type your statement +in the Filter box and press return to see the result on +screen or an error below the box if the expression is invalid.

+

It is important to note that these filters are persistent +and will be applied to any analysis conducted through in Radiant. To +deactivate a filter un-check the Filter data check-box. To +remove a filter simply delete it.

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+Operator + +Description + +Example +
+< + +less than + +price < 5000 +
+<= + +less than or equal to + +carat <= 2 +
+> + +greater than + +price > 1000 +
+>= + +greater than or equal to + +carat >= 2 +
+== + +exactly equal to + +cut == 'Fair' +
+!= + +not equal to + +cut != 'Fair' +
+| + +x OR y + +price > 10000 | cut == 'Premium' +
+& + +x AND y + +carat < 2 & cut == 'Fair' +
+%in% + +x is one of y + +cut %in% c('Fair', 'Good') +
+is.na + +is missing + +is.na(price) +
+

Filters can also be used with R-code to quickly view a sample from +the selected dataset. For example, runif(n()) > .9 could +be used to sample approximately 10% of the rows in the data and +1:n() < 101 would select only the first 100 rows in the +data.

+
+
+

Select variables to show +

+

By default all columns in the data are shown. Click on any variable +to focus on it alone. To select several variables use the SHIFT and +ARROW keys on your keyboard. On a mac the CMD key can also be used to +select multiple variables. The same effect is achieved on windows using +the CTRL key. To select all variable use CTRL-A (or CMD-A on mac).

+
+
+

Browse the data +

+

By default only 10 rows of data are shown at a time. You can change +this setting through the Show ... entries dropdown. Press +the Next and Previous buttons at the +bottom-right of the screen to page through the data.

+
+
+

Sort +

+

Click on a column header in the table to sort the data. Clicking +again will toggle between sorting in ascending and descending order. To +sort on multiple columns at once press shift and then click on the 2nd, +3rd, etc. column to sort by.

+
+
+ +

For variables that have a limited number of different values (i.e., a +factor) you can select the levels to keep from the column filter below +the variable name. For example, to filter on rows with ideal cut click +in the box below the cut column header and select +Ideal from the dropdown menu shown. You can also type a +string into these column filters and then press return. Note that +matching is case-insensitive. In fact, typing eal would +produce the same result because the search will match any part of a +string. Similarly, you can type a string to select rows based on +character variables (e.g., street names).

+

For numeric variables the column filter boxes have some special +features that make them almost as powerful as the +Filter data box. For numeric and integer variables you can +use ... to indicate a range. For example, to select +price values between $500 and $2000 type +500 ... 2000 and press return. The range is inclusive of +the values typed. Furthermore, if we want to filter on +carat 0.32 ... will show only diamonds with +carat values larger than or equal to 0.32. Numeric variables also have a +slider that you can use to define the range of values to keep.

+

If you want to get really fancy you can use the search box +on the top right to search across all columns in the data using +regular expressions. For example, to find all rows that +have an entry in any column ending with the number 72 type +72$ (i.e., the $ sign is used to indicate the +end of an entry). For all rows with entries that start with 60 use +^60 (i.e., the ^ is used to indicate the first +character in an entry). Regular expressions are incredibly powerful for +search but this is a big topic area. To learn more about +regular expressions see this +tutorial.

+
+
+

Store filters +

+

It is important to note that column sorting, column filters, and +search are not persistent. To store these settings for +use in other parts of Radiant press the Store button. You +can store the data and settings under a different dataset name by +changing the value in the text input to the left of the +Store button. This feature can also be used to select a +subset of variables to keep. Just select the ones you want to keep and +press the Store button. For more control over the variables +you want to keep or remove and to specify their order in the dataset use +the Data > Transform tab.

+

To download the data in csv format click the + icon on the top right of +your screen.

+

Click the report () +icon on the bottom left of your screen or press ALT-enter +on your keyboard to add the filter and sort commands used by Radiant to +a (reproducible) report in +Report +> Rmd.

+
+
+

R-functions +

+

For an overview of related R-functions used by Radiant to view, +search, and filter data see +Data +> View

+

© Vincent Nijs (2023) +Creative Commons License

+
+
+ + + +
+ + + +
+

+

Developed by Vincent Nijs, Niklas von Hertzen.

+
+ +
+

+

Site built with pkgdown 2.0.7.

+
+ +
+
+ + + + + diff --git a/radiant.data/docs/articles/pkgdown/view_files/accessible-code-block-0.0.1/empty-anchor.js b/radiant.data/docs/articles/pkgdown/view_files/accessible-code-block-0.0.1/empty-anchor.js new file mode 100644 index 0000000000000000000000000000000000000000..ca349fd6a570108bde9d7daace534cd651c5f042 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/view_files/accessible-code-block-0.0.1/empty-anchor.js @@ -0,0 +1,15 @@ +// Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> +// v0.0.1 +// Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. + +document.addEventListener('DOMContentLoaded', function() { + const codeList = document.getElementsByClassName("sourceCode"); + for (var i = 0; i < codeList.length; i++) { + var linkList = codeList[i].getElementsByTagName('a'); + for (var j = 0; j < linkList.length; j++) { + if (linkList[j].innerHTML === "") { + linkList[j].setAttribute('aria-hidden', 'true'); + } + } + } +}); diff --git a/radiant.data/docs/articles/pkgdown/view_files/anchor-sections-1.0/anchor-sections.css b/radiant.data/docs/articles/pkgdown/view_files/anchor-sections-1.0/anchor-sections.css new file mode 100644 index 0000000000000000000000000000000000000000..07aee5fcb8398a53ea2189cff95cbe6504116d96 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/view_files/anchor-sections-1.0/anchor-sections.css @@ -0,0 +1,4 @@ +/* Styles for section anchors */ +a.anchor-section {margin-left: 10px; visibility: hidden; color: inherit;} +a.anchor-section::before {content: '#';} +.hasAnchor:hover a.anchor-section {visibility: visible;} diff --git a/radiant.data/docs/articles/pkgdown/view_files/anchor-sections-1.0/anchor-sections.js b/radiant.data/docs/articles/pkgdown/view_files/anchor-sections-1.0/anchor-sections.js new file mode 100644 index 0000000000000000000000000000000000000000..570f99a0a8775e26c9dac3b1dd7b82cbe6dbfae3 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/view_files/anchor-sections-1.0/anchor-sections.js @@ -0,0 +1,33 @@ +// Anchor sections v1.0 written by Atsushi Yasumoto on Oct 3rd, 2020. +document.addEventListener('DOMContentLoaded', function() { + // Do nothing if AnchorJS is used + if (typeof window.anchors === 'object' && anchors.hasOwnProperty('hasAnchorJSLink')) { + return; + } + + const h = document.querySelectorAll('h1, h2, h3, h4, h5, h6'); + + // Do nothing if sections are already anchored + if (Array.from(h).some(x => x.classList.contains('hasAnchor'))) { + return null; + } + + // Use section id when pandoc runs with --section-divs + const section_id = function(x) { + return ((x.classList.contains('section') || (x.tagName === 'SECTION')) + ? x.id : ''); + }; + + // Add anchors + h.forEach(function(x) { + const id = x.id || section_id(x.parentElement); + if (id === '') { + return null; + } + let anchor = document.createElement('a'); + anchor.href = '#' + id; + anchor.classList = ['anchor-section']; + x.classList.add('hasAnchor'); + x.appendChild(anchor); + }); +}); diff --git a/radiant.data/docs/articles/pkgdown/view_files/header-attrs-2.1/header-attrs.js b/radiant.data/docs/articles/pkgdown/view_files/header-attrs-2.1/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/view_files/header-attrs-2.1/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/view_files/header-attrs-2.2/header-attrs.js b/radiant.data/docs/articles/pkgdown/view_files/header-attrs-2.2/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/view_files/header-attrs-2.2/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/view_files/header-attrs-2.3/header-attrs.js b/radiant.data/docs/articles/pkgdown/view_files/header-attrs-2.3/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/view_files/header-attrs-2.3/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/visualize.html b/radiant.data/docs/articles/pkgdown/visualize.html new file mode 100644 index 0000000000000000000000000000000000000000..8c22813a70b7396f6401add4644ca6c68ab196a4 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/visualize.html @@ -0,0 +1,450 @@ + + + + + + + +Visualize data (Data > Visualize) • radiant.data + + + + + + + + + + + + + + +
+
+ + + + +
+
+
+

Visualize data (Data > Visualize)

+

Vincent R. +Nijs, Rady School of Management (UCSD)

+ + + Source: vignettes/pkgdown/visualize.Rmd + + +
+ + + +
+

Visualize data

+
+
+

Filter data +

+

Use the Filter data box to select (or omit) specific +sets of rows from the data. See the help file for +Data +> View for details.

+
+
+

Plot-type +

+

Select the plot type you want. For example, with the +diamonds data loaded select Distribution and +all (X) variables (use CTRL-a or CMD-a). This will create a histogram +for all numeric variables and a bar-plot for all categorical variables +in the data set. Density plots can only be used with numeric variables. +Scatter plots are used to visualize the relationship between two +variables. Select one or more variables to plot on the Y-axis and one or +more variables to plot on the X-axis. If one of the variables is +categorical (i.e., a {factor}) it should be specified as an X-variable. +Information about additional variables can be added through the +Color or Size dropdown. Line plots are similar +to scatter plots but they connect-the-dots and are particularly useful +for time-series data. Surface plots are similar to +Heat maps and require 3 input variables: X, Y, and Fill. +Bar plots are used to show the relationship between a categorical (or +integer) variable (X) and the (mean) value of a numeric variable (Y). +Box-plots are also used when we have a numeric Y-variable and a +categorical X-variable. They are more informative than bar charts but +also require a bit more effort to evaluate.

+
+

Note that when a categorical variable (factor) is +selected as the Y-variable in a Bar chart it will be +converted to a numeric variable if required for the selected function. +If the factor levels are numeric these will be used in all calculations. +Since the mean, standard deviation, etc. are not relevant for non-binary +categorical variables, these will be converted to 0-1 (binary) variables +where the first level is coded as 1 and all other levels as 0. For +example, if we select color from the diamonds +data as the Y-variable, and mean as the function to apply, +then each bar will represent the proportion of observations with the +value D.

+
+
+
+

Box plots +

+

The upper and lower “hinges” of the box correspond to the first and +third quartiles (the 25th and 75th percentiles) in the data. The middle +hinge is the median value of the data. The upper whisker extends from +the upper hinge (i.e., the top of the box) to the highest value in the +data that is within 1.5 x IQR of the upper hinge. IQR is the +inter-quartile range, or distance, between the 25th and 75th percentile. +The lower whisker extends from the lower hinge to the lowest value in +the data within 1.5 x IQR of the lower hinge. Data beyond the end of the +whiskers could be outliers and are plotted as points (as suggested by +Tukey).

+

In sum: 1. The lower whisker extends from Q1 to max(min(data), Q1 - +1.5 x IQR) 2. The upper whisker extends from Q3 to min(max(data), Q3 + +1.5 x IQR)

+

where Q1 is the 25th percentile and Q3 is the 75th percentile. You +may have to read the two bullets above a few times before it sinks in. +The plot below should help to explain the structure of the box plot.

+

+

+

Source

+
+
+

Sub-plots and heat-maps +

+

Facet row and Facet column can be used to +split the data into different groups and create separate plots for each +group.

+

If you select a scatter or line plot a Color drop-down +will be shown. Selecting a Color variable will create a +type of heat-map where the colors are linked to the values of the +Color variable. Selecting a categorical variable from the +Color dropdown for a line plot will split the data into +groups and will show a line of a different color for each group.

+
+
+

Line, loess, and jitter +

+

To add a linear or non-linear regression line to a scatter plot check +the Line and/or Loess boxes. If your data take +on a limited number of values, Jitter can be useful to get +a better feel for where most of the data points are located. +Jitter-ing simply adds a small random value to each data +point so they do not overlap completely in the plot(s).

+
+
+

Axis scale +

+

The relationship between variables depicted in a scatter plot may be +non-linear. There are numerous transformations we might apply to the +data so this relationship becomes (approximately) linear (see +Data +> Transform) and easier to estimate using, for example, +Model +> Estimate > Linear regression (OLS). Perhaps the most +common data transformation applied to business data is the (natural) +logarithm. To see if log transformation(s) may be appropriate for your +data check the Log X and/or Log Y boxes (e.g., +for a scatter or bar plot).

+

By default the scale of the Y-axis is the same across sub-plots when +using Facet row. To allow the Y-axis to be specific to each +sub-plot click the Scale-y check-box.

+
+
+

Flip axes +

+

To switch the variables on the X- and Y-axis check the +Flip box.

+
+
+

Plot height and width +

+

To make plots bigger or smaller adjust the values in the height and +width boxes on the bottom left of the screen.

+
+
+

Keep plots +

+

The best way to keep/store plots is to generate a +visualize command by clicking the report +() icon on the bottom +left of your screen or by pressing ALT-enter on your +keyboard. Alternatively, click the + icon on the top right of +your screen to save a png-file to disk.

+
+
+

Customizing plots in Report > Rmd +

+

To customize a plot first generate the visualize command +by clicking the report +() icon on the bottom +left of your screen or by pressing ALT-enter on your +keyboard. The example below illustrates how to customize a command in +the +Report +> Rmd tab. Notice that custom is set to +TRUE.

+
+visualize(diamonds, yvar = "price", xvar = "carat", type = "scatter", custom = TRUE) +
+  labs(
+    title = "A scatterplot", 
+    y = "Price in $",
+    x = "Carats"
+  )
+

The default resolution for plots is 144 dots per inch (dpi). You can +change this setting up or down in Report > Rmd. For example, +the code-chunk header below ensures the plot will be 7” wide, 3.5” tall, +with a resolution of 600 dpi.

+

```{r fig.width = 7, fig.height = 3.5, dpi = 600}

+

If you have the svglite package installed, the +code-chunk header below will produce graphs in high quality +svg format.

+

```{r fig.width = 7, fig.height = 3.5, dev = "svglite"}

+

Some common customization commands:

+
    +
  • Add a title: + labs(title = "my title") +
    • +
  • Add a sub-title: + labs(subtitle = "my sub-title") +
    • +
  • Add a caption below figure: ++ labs(caption = "Based on data from ...") +
    • +
  • Change label: + labs(x = "my X-axis label") or ++ labs(y = "my Y-axis label") +
    • +
  • Remove all legends: ++ theme(legend.position = "none") +
    • +
  • Change legend title: + labs(color = "New legend title") +or + labs(fill = "New legend title") +
    • +
  • Rotate tick labels: ++ theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
    • +
  • Set plot limits: + ylim(5000, 8000) or ++ xlim("VS1","VS2") +
    • +
  • Remove size legend: + scale_size(guide = "none") +
    • +
  • Change size range: + scale_size(range=c(1,6)) +
    • +
  • Draw a horizontal line: ++ geom_hline(yintercept = 0.1) +
    • +
  • Draw a vertical line: + geom_vline(xintercept = 8) +
    • +
  • Scale the y-axis as a percentage: ++ scale_y_continuous(labels = scales::percent) +
    • +
  • Scale the y-axis in millions: ++ scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6)) +
    • +
  • Display y-axis in $’s: ++ scale_y_continuous(labels = scales::dollar_format()) +
    • +
  • Use , as a thousand separator for the y-axis: ++ scale_y_continuous(labels = scales::comma) +
    • +
+

For more on how to customize plots for communication see +http://r4ds.had.co.nz/graphics-for-communication.html.

+

See also the ggplot2 documentation site +https://ggplot2.tidyverse.org.

+

Suppose we create a set of three bar charts in Data > +Visualize using the Diamond data. To add a title above +the group of plots and impose a one-column layout we could use +patchwork as follows:

+
+plot_list <- visualize(
+  diamonds, 
+  xvar = c("clarity", "cut", "color"), 
+  yvar = "price", 
+  type = "bar", 
+  custom = TRUE
+) 
+wrap_plots(plot_list, ncol = 1) + plot_annotation(title = "Three bar plots")
+

See the patchwork +documentation site for additional information on how to customize +groups of plots.

+
+
+

Making plots interactive in Report > Rmd +

+

It is possible to transform (most) plots generated in Radiant into +interactive graphics using the plotly library. After +setting custom = TRUE you can use the ggplotly +function to convert a single plot. See example below:

+
+visualize(diamonds, xvar = c("price", "carat", "clarity", "cut"), custom = TRUE) %>%
+  ggplotly() %>%
+  render()
+

If more than one plot is created, you can use the +subplot function from the plotly package. +Provide a value for the nrows argument to setup the plot +layout grid. In the example below four plots are created. Because +nrow = 2 the plots will be displayed in a 2 X 2 grid.

+
+visualize(diamonds, xvar = c("carat", "clarity", "cut", "color"), custom = TRUE) %>%
+  subplot(nrows = 2) %>%
+  render()
+

For additional information on the plotly library see the +links below:

+ +
+
+

R-functions +

+

For an overview of related R-functions used by Radiant to visualize +data see +Data +> Visualize

+

© Vincent Nijs (2023) +Creative Commons License

+
+
+ + + +
+ + + +
+

+

Developed by Vincent Nijs, Niklas von Hertzen.

+
+ +
+

+

Site built with pkgdown 2.0.7.

+
+ +
+
+ + + + + diff --git a/radiant.data/docs/articles/pkgdown/visualize_files/accessible-code-block-0.0.1/empty-anchor.js b/radiant.data/docs/articles/pkgdown/visualize_files/accessible-code-block-0.0.1/empty-anchor.js new file mode 100644 index 0000000000000000000000000000000000000000..ca349fd6a570108bde9d7daace534cd651c5f042 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/visualize_files/accessible-code-block-0.0.1/empty-anchor.js @@ -0,0 +1,15 @@ +// Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> +// v0.0.1 +// Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. + +document.addEventListener('DOMContentLoaded', function() { + const codeList = document.getElementsByClassName("sourceCode"); + for (var i = 0; i < codeList.length; i++) { + var linkList = codeList[i].getElementsByTagName('a'); + for (var j = 0; j < linkList.length; j++) { + if (linkList[j].innerHTML === "") { + linkList[j].setAttribute('aria-hidden', 'true'); + } + } + } +}); diff --git a/radiant.data/docs/articles/pkgdown/visualize_files/anchor-sections-1.0/anchor-sections.css b/radiant.data/docs/articles/pkgdown/visualize_files/anchor-sections-1.0/anchor-sections.css new file mode 100644 index 0000000000000000000000000000000000000000..07aee5fcb8398a53ea2189cff95cbe6504116d96 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/visualize_files/anchor-sections-1.0/anchor-sections.css @@ -0,0 +1,4 @@ +/* Styles for section anchors */ +a.anchor-section {margin-left: 10px; visibility: hidden; color: inherit;} +a.anchor-section::before {content: '#';} +.hasAnchor:hover a.anchor-section {visibility: visible;} diff --git a/radiant.data/docs/articles/pkgdown/visualize_files/anchor-sections-1.0/anchor-sections.js b/radiant.data/docs/articles/pkgdown/visualize_files/anchor-sections-1.0/anchor-sections.js new file mode 100644 index 0000000000000000000000000000000000000000..570f99a0a8775e26c9dac3b1dd7b82cbe6dbfae3 --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/visualize_files/anchor-sections-1.0/anchor-sections.js @@ -0,0 +1,33 @@ +// Anchor sections v1.0 written by Atsushi Yasumoto on Oct 3rd, 2020. +document.addEventListener('DOMContentLoaded', function() { + // Do nothing if AnchorJS is used + if (typeof window.anchors === 'object' && anchors.hasOwnProperty('hasAnchorJSLink')) { + return; + } + + const h = document.querySelectorAll('h1, h2, h3, h4, h5, h6'); + + // Do nothing if sections are already anchored + if (Array.from(h).some(x => x.classList.contains('hasAnchor'))) { + return null; + } + + // Use section id when pandoc runs with --section-divs + const section_id = function(x) { + return ((x.classList.contains('section') || (x.tagName === 'SECTION')) + ? x.id : ''); + }; + + // Add anchors + h.forEach(function(x) { + const id = x.id || section_id(x.parentElement); + if (id === '') { + return null; + } + let anchor = document.createElement('a'); + anchor.href = '#' + id; + anchor.classList = ['anchor-section']; + x.classList.add('hasAnchor'); + x.appendChild(anchor); + }); +}); diff --git a/radiant.data/docs/articles/pkgdown/visualize_files/header-attrs-2.1/header-attrs.js b/radiant.data/docs/articles/pkgdown/visualize_files/header-attrs-2.1/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/visualize_files/header-attrs-2.1/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/visualize_files/header-attrs-2.2/header-attrs.js b/radiant.data/docs/articles/pkgdown/visualize_files/header-attrs-2.2/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/visualize_files/header-attrs-2.2/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/articles/pkgdown/visualize_files/header-attrs-2.3/header-attrs.js b/radiant.data/docs/articles/pkgdown/visualize_files/header-attrs-2.3/header-attrs.js new file mode 100644 index 0000000000000000000000000000000000000000..dd57d92e02028785163a821c31bca8743a8ab59a --- /dev/null +++ b/radiant.data/docs/articles/pkgdown/visualize_files/header-attrs-2.3/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/radiant.data/docs/authors.html b/radiant.data/docs/authors.html new file mode 100644 index 0000000000000000000000000000000000000000..3ca8b925e2a69cec11c8367607087966d626933e --- /dev/null +++ b/radiant.data/docs/authors.html @@ -0,0 +1,163 @@ + +Authors and Citation • radiant.data + + +
+
+ + + +
+
+
+
+

Authors

+
+ + +
  • +

    Vincent Nijs. Author, maintainer. +

    +
    • +
  • +

    Niklas von Hertzen. Author. +
    html2canvas library

    +
    • +
+
+
+

Citation

+ Source: DESCRIPTION +
+
+ + +

Nijs V, von Hertzen N (2023). +radiant.data: Data Menu for Radiant: Business Analytics using R and Shiny. +https://github.com/radiant-rstats/radiant.data/, +https://radiant-rstats.github.io/radiant.data/, +https://radiant-rstats.github.io/docs/. +

+ 
@Manual{,
+  title = {radiant.data: Data Menu for Radiant: Business Analytics using R and Shiny},
+  author = {Vincent Nijs and Niklas {von Hertzen}},
+  year = {2023},
+  note = {https://github.com/radiant-rstats/radiant.data/,
+https://radiant-rstats.github.io/radiant.data/,
+https://radiant-rstats.github.io/docs/},
+}
+ +
+ +
+ + + +
+

Developed by Vincent Nijs, Niklas von Hertzen.

+
+ +
+

Site built with pkgdown 2.0.7.

+
+ +
+ + + + diff --git a/radiant.data/docs/bootstrap-toc.css b/radiant.data/docs/bootstrap-toc.css new file mode 100644 index 0000000000000000000000000000000000000000..5a859415c1f7eacfd94920968bc910e2f1f1427e --- /dev/null +++ b/radiant.data/docs/bootstrap-toc.css @@ -0,0 +1,60 @@ +/*! + * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/) + * Copyright 2015 Aidan Feldman + * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */ + +/* modified from https://github.com/twbs/bootstrap/blob/94b4076dd2efba9af71f0b18d4ee4b163aa9e0dd/docs/assets/css/src/docs.css#L548-L601 */ + +/* All levels of nav */ +nav[data-toggle='toc'] .nav > li > a { + display: block; + padding: 4px 20px; + font-size: 13px; + font-weight: 500; + color: #767676; +} +nav[data-toggle='toc'] .nav > li > a:hover, +nav[data-toggle='toc'] .nav > li > a:focus { + padding-left: 19px; + color: #563d7c; + text-decoration: none; + background-color: transparent; + border-left: 1px solid #563d7c; +} +nav[data-toggle='toc'] .nav > .active > a, +nav[data-toggle='toc'] .nav > .active:hover > a, +nav[data-toggle='toc'] .nav > .active:focus > a { + padding-left: 18px; + font-weight: bold; + color: #563d7c; + background-color: transparent; + border-left: 2px solid #563d7c; +} + +/* Nav: second level (shown on .active) */ +nav[data-toggle='toc'] .nav .nav { + display: none; /* Hide by default, but at >768px, show it */ + padding-bottom: 10px; +} +nav[data-toggle='toc'] .nav .nav > li > a { + padding-top: 1px; + padding-bottom: 1px; + padding-left: 30px; + font-size: 12px; + font-weight: normal; +} +nav[data-toggle='toc'] .nav .nav > li > a:hover, +nav[data-toggle='toc'] .nav .nav > li > a:focus { + padding-left: 29px; +} +nav[data-toggle='toc'] .nav .nav > .active > a, +nav[data-toggle='toc'] .nav .nav > .active:hover > a, +nav[data-toggle='toc'] .nav .nav > .active:focus > a { + padding-left: 28px; + font-weight: 500; +} + +/* from https://github.com/twbs/bootstrap/blob/e38f066d8c203c3e032da0ff23cd2d6098ee2dd6/docs/assets/css/src/docs.css#L631-L634 */ +nav[data-toggle='toc'] .nav > .active > ul { + display: block; +} diff --git a/radiant.data/docs/bootstrap-toc.js b/radiant.data/docs/bootstrap-toc.js new file mode 100644 index 0000000000000000000000000000000000000000..1cdd573b20f53b3ebe31c021e154c4338ca456af --- /dev/null +++ b/radiant.data/docs/bootstrap-toc.js @@ -0,0 +1,159 @@ +/*! + * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/) + * Copyright 2015 Aidan Feldman + * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */ +(function() { + 'use strict'; + + window.Toc = { + helpers: { + // return all matching elements in the set, or their descendants + findOrFilter: function($el, selector) { + // http://danielnouri.org/notes/2011/03/14/a-jquery-find-that-also-finds-the-root-element/ + // http://stackoverflow.com/a/12731439/358804 + var $descendants = $el.find(selector); + return $el.filter(selector).add($descendants).filter(':not([data-toc-skip])'); + }, + + generateUniqueIdBase: function(el) { + var text = $(el).text(); + var anchor = text.trim().toLowerCase().replace(/[^A-Za-z0-9]+/g, '-'); + return anchor || el.tagName.toLowerCase(); + }, + + generateUniqueId: function(el) { + var anchorBase = this.generateUniqueIdBase(el); + for (var i = 0; ; i++) { + var anchor = anchorBase; + if (i > 0) { + // add suffix + anchor += '-' + i; + } + // check if ID already exists + if (!document.getElementById(anchor)) { + return anchor; + } + } + }, + + generateAnchor: function(el) { + if (el.id) { + return el.id; + } else { + var anchor = this.generateUniqueId(el); + el.id = anchor; + return anchor; + } + }, + + createNavList: function() { + return $('
    '); + }, + + createChildNavList: function($parent) { + var $childList = this.createNavList(); + $parent.append($childList); + return $childList; + }, + + generateNavEl: function(anchor, text) { + var $a = $(''); + $a.attr('href', '#' + anchor); + $a.text(text); + var $li = $('
  • '); + $li.append($a); + return $li; + }, + + generateNavItem: function(headingEl) { + var anchor = this.generateAnchor(headingEl); + var $heading = $(headingEl); + var text = $heading.data('toc-text') || $heading.text(); + return this.generateNavEl(anchor, text); + }, + + // Find the first heading level (`

    `, then `

    `, etc.) that has more than one element. Defaults to 1 (for `

    `). + getTopLevel: function($scope) { + for (var i = 1; i <= 6; i++) { + var $headings = this.findOrFilter($scope, 'h' + i); + if ($headings.length > 1) { + return i; + } + } + + return 1; + }, + + // returns the elements for the top level, and the next below it + getHeadings: function($scope, topLevel) { + var topSelector = 'h' + topLevel; + + var secondaryLevel = topLevel + 1; + var secondarySelector = 'h' + secondaryLevel; + + return this.findOrFilter($scope, topSelector + ',' + secondarySelector); + }, + + getNavLevel: function(el) { + return parseInt(el.tagName.charAt(1), 10); + }, + + populateNav: function($topContext, topLevel, $headings) { + var $context = $topContext; + var $prevNav; + + var helpers = this; + $headings.each(function(i, el) { + var $newNav = helpers.generateNavItem(el); + var navLevel = helpers.getNavLevel(el); + + // determine the proper $context + if (navLevel === topLevel) { + // use top level + $context = $topContext; + } else if ($prevNav && $context === $topContext) { + // create a new level of the tree and switch to it + $context = helpers.createChildNavList($prevNav); + } // else use the current $context + + $context.append($newNav); + + $prevNav = $newNav; + }); + }, + + parseOps: function(arg) { + var opts; + if (arg.jquery) { + opts = { + $nav: arg + }; + } else { + opts = arg; + } + opts.$scope = opts.$scope || $(document.body); + return opts; + } + }, + + // accepts a jQuery object, or an options object + init: function(opts) { + opts = this.helpers.parseOps(opts); + + // ensure that the data attribute is in place for styling + opts.$nav.attr('data-toggle', 'toc'); + + var $topContext = this.helpers.createChildNavList(opts.$nav); + var topLevel = this.helpers.getTopLevel(opts.$scope); + var $headings = this.helpers.getHeadings(opts.$scope, topLevel); + this.helpers.populateNav($topContext, topLevel, $headings); + } + }; + + $(function() { + $('nav[data-toggle="toc"]').each(function(i, el) { + var $nav = $(el); + Toc.init($nav); + }); + }); +})(); diff --git a/radiant.data/docs/docsearch.css b/radiant.data/docs/docsearch.css new file mode 100644 index 0000000000000000000000000000000000000000..e5f1fe1dfa2c34c51fe941829b511acd8c763301 --- /dev/null +++ b/radiant.data/docs/docsearch.css @@ -0,0 +1,148 @@ +/* Docsearch -------------------------------------------------------------- */ +/* + Source: https://github.com/algolia/docsearch/ + License: MIT +*/ + +.algolia-autocomplete { + display: block; + -webkit-box-flex: 1; + -ms-flex: 1; + flex: 1 +} + +.algolia-autocomplete .ds-dropdown-menu { + width: 100%; + min-width: none; + max-width: none; + padding: .75rem 0; + background-color: #fff; + background-clip: padding-box; + border: 1px solid rgba(0, 0, 0, .1); + box-shadow: 0 .5rem 1rem rgba(0, 0, 0, .175); +} + +@media (min-width:768px) { + .algolia-autocomplete .ds-dropdown-menu { + width: 175% + } +} + +.algolia-autocomplete .ds-dropdown-menu::before { + display: none +} + +.algolia-autocomplete .ds-dropdown-menu [class^=ds-dataset-] { + padding: 0; + background-color: rgb(255,255,255); + border: 0; + max-height: 80vh; +} + +.algolia-autocomplete .ds-dropdown-menu .ds-suggestions { + margin-top: 0 +} + +.algolia-autocomplete .algolia-docsearch-suggestion { + padding: 0; + overflow: visible +} + +.algolia-autocomplete .algolia-docsearch-suggestion--category-header { + padding: .125rem 1rem; + margin-top: 0; + font-size: 1.3em; + font-weight: 500; + color: #00008B; + border-bottom: 0 +} + +.algolia-autocomplete .algolia-docsearch-suggestion--wrapper { + float: none; + padding-top: 0 +} + +.algolia-autocomplete .algolia-docsearch-suggestion--subcategory-column { + float: none; + width: auto; + padding: 0; + text-align: left +} + +.algolia-autocomplete .algolia-docsearch-suggestion--content { + float: none; + width: auto; + padding: 0 +} + +.algolia-autocomplete .algolia-docsearch-suggestion--content::before { + display: none +} + +.algolia-autocomplete .ds-suggestion:not(:first-child) .algolia-docsearch-suggestion--category-header { + padding-top: .75rem; + margin-top: .75rem; + border-top: 1px solid rgba(0, 0, 0, .1) +} + +.algolia-autocomplete .ds-suggestion .algolia-docsearch-suggestion--subcategory-column { + display: block; + padding: .1rem 1rem; + margin-bottom: 0.1; + font-size: 1.0em; + font-weight: 400 + /* display: none */ +} + +.algolia-autocomplete .algolia-docsearch-suggestion--title { + display: block; + padding: .25rem 1rem; + margin-bottom: 0; + font-size: 0.9em; + font-weight: 400 +} + +.algolia-autocomplete .algolia-docsearch-suggestion--text { + padding: 0 1rem .5rem; + margin-top: -.25rem; + font-size: 0.8em; + font-weight: 400; + line-height: 1.25 +} + +.algolia-autocomplete .algolia-docsearch-footer { + width: 110px; + height: 20px; + z-index: 3; + margin-top: 10.66667px; + float: right; + font-size: 0; + line-height: 0; +} + +.algolia-autocomplete .algolia-docsearch-footer--logo { + background-image: url("data:image/svg+xml;utf8,"); + background-repeat: no-repeat; + background-position: 50%; + background-size: 100%; + overflow: hidden; + text-indent: -9000px; + width: 100%; + height: 100%; + display: block; + transform: translate(-8px); +} + +.algolia-autocomplete .algolia-docsearch-suggestion--highlight { + color: #FF8C00; + background: rgba(232, 189, 54, 0.1) +} + + +.algolia-autocomplete .algolia-docsearch-suggestion--text .algolia-docsearch-suggestion--highlight { + box-shadow: inset 0 -2px 0 0 rgba(105, 105, 105, .5) +} + +.algolia-autocomplete .ds-suggestion.ds-cursor .algolia-docsearch-suggestion--content { + background-color: rgba(192, 192, 192, .15) +} diff --git a/radiant.data/docs/docsearch.js b/radiant.data/docs/docsearch.js new file mode 100644 index 0000000000000000000000000000000000000000..b35504cd3a282816130a16881f3ebeead9c1bcb4 --- /dev/null +++ b/radiant.data/docs/docsearch.js @@ -0,0 +1,85 @@ +$(function() { + + // register a handler to move the focus to the search bar + // upon pressing shift + "/" (i.e. "?") + $(document).on('keydown', function(e) { + if (e.shiftKey && e.keyCode == 191) { + e.preventDefault(); + $("#search-input").focus(); + } + }); + + $(document).ready(function() { + // do keyword highlighting + /* modified from https://jsfiddle.net/julmot/bL6bb5oo/ */ + var mark = function() { + + var referrer = document.URL ; + var paramKey = "q" ; + + if (referrer.indexOf("?") !== -1) { + var qs = referrer.substr(referrer.indexOf('?') + 1); + var qs_noanchor = qs.split('#')[0]; + var qsa = qs_noanchor.split('&'); + var keyword = ""; + + for (var i = 0; i < qsa.length; i++) { + var currentParam = qsa[i].split('='); + + if (currentParam.length !== 2) { + continue; + } + + if (currentParam[0] == paramKey) { + keyword = decodeURIComponent(currentParam[1].replace(/\+/g, "%20")); + } + } + + if (keyword !== "") { + $(".contents").unmark({ + done: function() { + $(".contents").mark(keyword); + } + }); + } + } + }; + + mark(); + }); +}); + +/* Search term highlighting ------------------------------*/ + +function matchedWords(hit) { + var words = []; + + var hierarchy = hit._highlightResult.hierarchy; + // loop to fetch from lvl0, lvl1, etc. + for (var idx in hierarchy) { + words = words.concat(hierarchy[idx].matchedWords); + } + + var content = hit._highlightResult.content; + if (content) { + words = words.concat(content.matchedWords); + } + + // return unique words + var words_uniq = [...new Set(words)]; + return words_uniq; +} + +function updateHitURL(hit) { + + var words = matchedWords(hit); + var url = ""; + + if (hit.anchor) { + url = hit.url_without_anchor + '?q=' + escape(words.join(" ")) + '#' + hit.anchor; + } else { + url = hit.url + '?q=' + escape(words.join(" ")); + } + + return url; +} diff --git a/radiant.data/docs/docsearch.json b/radiant.data/docs/docsearch.json new file mode 100644 index 0000000000000000000000000000000000000000..715937648ea49c8f2e3f10d27fa5c14b75d844a8 --- /dev/null +++ b/radiant.data/docs/docsearch.json @@ -0,0 +1,95 @@ +{ + "index_name": "radiant_data", + "start_urls": [ + { + "url": "https://radiant-rstats.github.io/radiant.data/index.html", + "selectors_key": "homepage", + "tags": [ + "homepage" + ] + }, + { + "url": "https://radiant-rstats.github.io/radiant.data/reference", + "selectors_key": "reference", + "tags": [ + "reference" + ] + }, + { + "url": "https://radiant-rstats.github.io/radiant.data/articles", + "selectors_key": "articles", + "tags": [ + "articles" + ] + } + ], + "stop_urls": [ + "/reference/$", + "/reference/index.html", + "/articles/$", + "/articles/index.html" + ], + "sitemap_urls": [ + "https://radiant-rstats.github.io/radiant.data/sitemap.xml" + ], + "selectors": { + "homepage": { + "lvl0": { + "selector": ".contents h1", + "default_value": "radiant.data Home page" + }, + "lvl1": { + "selector": ".contents h2" + }, + "lvl2": { + "selector": ".contents h3", + "default_value": "Context" + }, + "lvl3": ".ref-arguments td, .ref-description", + "text": ".contents p, .contents li, .contents .pre" + }, + "reference": { + "lvl0": { + "selector": ".contents h1" + }, + "lvl1": { + "selector": ".contents .name", + "default_value": "Argument" + }, + "lvl2": { + "selector": ".ref-arguments th", + "default_value": "Description" + }, + "lvl3": ".ref-arguments td, .ref-description", + "text": ".contents p, .contents li" + }, + "articles": { + "lvl0": { + "selector": ".contents h1" + }, + "lvl1": { + "selector": ".contents .name" + }, + "lvl2": { + "selector": ".contents h2, .contents h3", + "default_value": "Context" + }, + "text": ".contents p, .contents li" + } + }, + "selectors_exclude": [ + ".dont-index" + ], + "min_indexed_level": 2, + "custom_settings": { + "separatorsToIndex": "_", + "attributesToRetrieve": [ + "hierarchy", + "content", + "anchor", + "url", + "url_without_anchor" + ] + } +} + diff --git a/radiant.data/docs/index.html b/radiant.data/docs/index.html new file mode 100644 index 0000000000000000000000000000000000000000..3c25a5ddaedeb3ee2c75f8e391faa7ade42fa79d --- /dev/null +++ b/radiant.data/docs/index.html @@ -0,0 +1,365 @@ + + + + + + + +Data Menu for Radiant: Business Analytics using R and Shiny • radiant.data + + + + + + + + + + + + + + +
    +
    + + + + +
    +
    +
    +

    Radiant - Business analytics using R and Shiny +

    + + +

    CRAN_Status_Badge

    +

    Radiant is an open-source platform-independent browser-based interface for business analytics in R. The application is based on the Shiny package and can be run locally or on a server. Radiant was developed by Vincent Nijs. Please use the issue tracker on GitHub to suggest enhancements or report problems: https://github.com/radiant-rstats/radiant.data/issues. For other questions and comments please use .

    +
    +

    Key features +

    +
      +
    • Explore: Quickly and easily summarize, visualize, and analyze your data
      • +
    • Cross-platform: It runs in a browser on Windows, Mac, and Linux
      • +
    • Reproducible: Recreate results and share work with others as a state file or an Rmarkdown report
      • +
    • Programming: Integrate Radiant’s analysis functions with your own R-code
      • +
    • Context: Data and examples focus on business applications
      • +
    + +
    +

    Playlists +

    +

    There are two youtube playlists with video tutorials. The first provides a general introduction to key features in Radiant. The second covers topics relevant in a course on business analytics (i.e., Probability, Decision Analysis, Hypothesis Testing, Linear Regression, and Simulation).

    + +
    +
    +

    Explore +

    +

    Radiant is interactive. Results update immediately when inputs are changed (i.e., no separate dialog boxes) and/or when a button is pressed (e.g., Estimate in Model > Estimate > Logistic regression (GLM)). This facilitates rapid exploration and understanding of the data.

    +
    +
    +

    Cross-platform +

    +

    Radiant works on Windows, Mac, or Linux. It can run without an Internet connection and no data will leave your computer. You can also run the app as a web application on a server.

    +
    +
    +

    Reproducible +

    +

    To conduct high-quality analysis, simply saving output is not enough. You need the ability to reproduce results for the same data and/or when new data become available. Moreover, others may want to review your analysis and results. Save and load the state of the application to continue your work at a later time or on another computer. Share state files with others and create reproducible reports using Rmarkdown. See also the section on Saving and loading state below

    +

    If you are using Radiant on a server you can even share the URL (include the SSUID) with others so they can see what you are working on. Thanks for this feature go to Joe Cheng.

    +
    +
    +

    Programming +

    +

    Although Radiant’s web-interface can handle quite a few data and analysis tasks, you may prefer to write your own R-code. Radiant provides a bridge to programming in R(studio) by exporting the functions used for analysis (i.e., you can conduct your analysis using the Radiant web-interface or by calling Radiant’s functions directly from R-code). For more information about programming with Radiant see the programming page on the documentation site.

    +
    +
    +

    Context +

    +

    Radiant focuses on business data and decisions. It offers tools, examples, and documentation relevant for that context, effectively reducing the business analytics learning curve.

    +
    +
    +
    +

    How to install Radiant +

    +
      +
    • Required: R version 4.0.0 or later
      • +
    • Required: Rstudio +
      • +
    +

    In Rstudio you can start and update Radiant through the Addins menu at the top of the screen. To install the latest version of Radiant for Windows or Mac, with complete documentation for off-line access, open R(studio) and copy-and-paste the command below:

    +
    +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org"))
+install.packages("radiant")
    +

    Once all packages are installed, select Start radiant from the Addins menu in Rstudio or use the command below to launch the app:

    +
    +radiant::radiant()
    +

    To launch Radiant in Rstudio’s viewer pane use the command below:

    +
    +radiant::radiant_viewer()
    +

    To launch Radiant in an Rstudio Window use the command below:

    +
    +radiant::radiant_window()
    +

    To easily update Radiant and the required packages, install the radiant.update package using:

    +
    +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org"))
+install.packages("remotes")
+remotes::install_github("radiant-rstats/radiant.update", upgrade = "never")
    +

    Then select Update radiant from the Addins menu in Rstudio or use the command below:

    +
    +radiant.update::radiant.update()
    +

    See the installing radiant page additional for details.

    +

    Optional: You can also create a launcher on your Desktop to start Radiant by typing radiant::launcher() in the R(studio) console and pressing return. A file called radiant.bat (windows) or radiant.command (mac) will be created that you can double-click to start Radiant in your default browser. The launcher command will also create a file called update_radiant.bat (windows) or update_radiant.command (mac) that you can double-click to update Radiant to the latest release.

    +

    When Radiant starts you will see data on diamond prices. To close the application click the icon in the navigation bar and then click Stop. The Radiant process will stop and the browser window will close (Chrome) or gray-out.

    +
    +
    +

    Documentation +

    +

    Documentation and tutorials are available at https://radiant-rstats.github.io/docs/ and in the Radiant web interface (the icons on each page and the icon in the navigation bar).

    +

    Individual Radiant packages also each have their own pkgdown sites:

    + +

    Want some help getting started? Watch the tutorials on the documentation site.

    +
    +
    +

    Reporting issues +

    +

    Please use the GitHub issue tracker at github.com/radiant-rstats/radiant/issues if you have any problems using Radiant.

    +
    +
    +

    Try Radiant online +

    +

    Not ready to install Radiant on your computer? Try it online at the link below:

    +

    https://vnijs.shinyapps.io/radiant

    +

    Do not upload sensitive data to this public server. The size of data upload has been restricted to 10MB for security reasons.

    +
    +
    +

    Running Radiant on shinyapps.io +

    +

    To run your own instance of Radiant on shinyapps.io first install Radiant and its dependencies. Then clone the radiant repo and ensure you have the latest version of the Radiant packages installed by running radiant/inst/app/for.shinyapps.io.R. Finally, open radiant/inst/app/ui.R and deploy the application.

    +
    +
    +

    Running Radiant on shiny-server +

    +

    You can also host Radiant using shiny-server. First, install radiant on the server using the command below:

    +
    +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org"))
+install.packages("radiant")
    +

    Then clone the radiant repo and point shiny-server to the inst/app/ directory. As a courtesy, please let me know if you intend to use Radiant on a server.

    +

    When running Radiant on a server, by default, file uploads are limited to 10MB and R-code in Report > Rmd and Report > R will not be evaluated for security reasons. If you have sudo access to the server and have appropriate security in place you can change these settings by adding the following lines to .Rprofile for the shiny user on the server.

    +
    options(radiant.maxRequestSize = -1)  ## no file size limit
+options(radiant.report = TRUE)
    +
    +
    +

    Running Radiant in the cloud (e.g., AWS) +

    +

    To run radiant in the cloud you can use the customized Docker container. See https://github.com/radiant-rstats/docker for details

    +
    +
    +

    Saving and loading state +

    +

    To save your analyses save the state of the app to a file by clicking on the icon in the navbar and then on Save radiant state file (see also the Data > Manage tab). You can open this state file at a later time or on another computer to continue where you left off. You can also share the file with others that may want to replicate your analyses. As an example, load the state file radiant-example.state.rda by clicking on the icon in the navbar and then on Load radiant state file. Go to Data > View and Data > Visualize to see some of the settings from the previous “state” of the app. There is also a report in Report > Rmd that was created using the Radiant interface. The html file radiant-example.nb.html contains the output.

    +

    A related feature in Radiant is that state is maintained if you accidentally navigate to another web page, close (and reopen) the browser, and/or hit refresh. Use Refresh in the menu in the navigation bar to return to a clean/new state.

    +

    Loading and saving state also works with Rstudio. If you start Radiant from Rstudio and use > Stop to stop the app, lists called r_data, r_info, and r_state will be put into Rstudio’s global workspace. If you start radiant again using radiant::radiant() it will use these lists to restore state. Also, if you load a state file directly into Rstudio it will be used when you start Radiant to recreate a previous state.

    +

    Technical note: Loading state works as follows in Radiant: When an input is initialized in a Shiny app you set a default value in the call to, for example, numericInput. In Radiant, when a state file has been loaded and an input is initialized it looks to see if there is a value for an input of that name in a list called r_state. If there is, this value is used. The r_state list is created when saving state using reactiveValuesToList(input). An example of a call to numericInput is given below where the state_init function from radiant.R is used to check if a value from r_state can be used.

    +
    +numericInput("sm_comp_value", "Comparison value:", state_init("sm_comp_value", 0))
    +
    +
    +

    Source code +

    +

    The source code for the radiant application is available on GitHub at https://github.com/radiant-rstats. radiant.data, offers tools to load, save, view, visualize, summarize, combine, and transform data. radiant.design builds on radiant.data and adds tools for experimental design, sampling, and sample size calculation. radiant.basics covers the basics of statistical analysis (e.g., comparing means and proportions, cross-tabs, correlation, etc.) and includes a probability calculator. radiant.model covers model estimation (e.g., logistic regression and neural networks), model evaluation (e.g., gains chart, profit curve, confusion matrix, etc.), and decision tools (e.g., decision analysis and simulation). Finally, radiant.multivariate includes tools to generate brand maps and conduct cluster, factor, and conjoint analysis.

    +

    These tools are used in the Business Analytics, Quantitative Analysis, Research for Marketing Decisions, Applied Market Research, Consumer Behavior, Experiments in Firms, Pricing, Pricing Analytics, and Customer Analytics classes at the Rady School of Management (UCSD).

    +
    +
    +

    Credits +

    +

    Radiant would not be possible without R and Shiny. I would like to thank Joe Cheng, Winston Chang, and Yihui Xie for answering questions, providing suggestions, and creating amazing tools for the R community. Other key components used in Radiant are ggplot2, dplyr, tidyr, magrittr, broom, shinyAce, shinyFiles, rmarkdown, and DT. For an overview of other packages that Radiant relies on please see the about page.

    +
    +
    +

    License +

    +

    Radiant is licensed under the AGPLv3. As a summary, the AGPLv3 license requires, attribution, including copyright and license information in copies of the software, stating changes if the code is modified, and disclosure of all source code. Details are in the COPYING file.

    +

    The documentation, images, and videos for the radiant.data package are licensed under the creative commons attribution and share-alike license CC-BY-SA. All other documentation and videos on this site, as well as the help files for radiant.design, radiant.basics, radiant.model, and radiant.multivariate, are licensed under the creative commons attribution, non-commercial, share-alike license CC-NC-SA.

    +

    If you are interested in using any of the radiant packages please email me at

    +

    © Vincent Nijs (2023) Creative Commons License

    +
    +
    +
    + + +
    + + +
    +

    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    +

    Site built with pkgdown 2.0.7.

    +
    + +
    +
    + + + + + diff --git a/radiant.data/docs/link.svg b/radiant.data/docs/link.svg new file mode 100644 index 0000000000000000000000000000000000000000..88ad82769b87f10725c57dca6fcf41b4bffe462c --- /dev/null +++ b/radiant.data/docs/link.svg @@ -0,0 +1,12 @@ + + + + + + diff --git a/radiant.data/docs/news/index.html b/radiant.data/docs/news/index.html new file mode 100644 index 0000000000000000000000000000000000000000..82cfa04db83273ec8c0e4369d9df25cb8517e3c8 --- /dev/null +++ b/radiant.data/docs/news/index.html @@ -0,0 +1,727 @@ + +Changelog • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Changelog

    + Source: NEWS.md +
    + +
    +

    radiant.data 1.5.62023-04-23

    +
    • Address deprecation issues in markdown >= 1.5
      • +
    +
    +

    radiant.data 1.5.12023-01-09

    +
    • Added features in the UI to facilitate persistent filters for filtered, sorted, and sliced data
      • +
    • Improvements to screenshot feature: +
      • Navigation bar is omitted and the image is adjusted to the length of the UI.
        • +
      • html2canvas.js is now included so users can take screenshot when offline
        • +
      • +
    • Added a convenience function add_description to add a description attribute to a data.frame in markdown format
      • +
    • Line graphs treated more similarly to bar-graphs: +
      • Can have a binary factor variable on the y-axis
        • +
      • Y-variable only line are now also possible
        • +
      • +
    • Removed all references to aes_string which is being deprecated in ggplot soon
      • +
    • Improved cleanup after Radiant UI is closed
      • +
    +
    +

    radiant.data 1.4.7

    +
    • Code cleanup in different areas
      • +
    +
    +

    radiant.data 1.4.6

    +
    • gsub(“[-]”, ““, text) is no longer valid in R 4.2.0 and above. Non-asci symbols will now be escaped using stringi::stri_trans_general when needed
      • +
    +
    +

    radiant.data 1.4.52022-09-08

    +
    • Add scrolling for dropdown menus that might extend past the edge of the screen
      • +
    • Addressed warning messages about Font Awesome icons not existing
      • +
    • gsub(“[-]”, ““, text) is no longer valid in R 4.2.0 and above. Non-asci symbols will now be escaped using stringi when needed
      • +
    +
    +

    radiant.data 1.4.42022-07-19

    +
    • Added option to create screenshots of settings on a page. Approach is inspired by the snapper package by @yonicd
      • +
    • Added contact request for users on Radiant startup
      • +
    • Fix issue with R_ZIPCMD when 7zip is on the path but not being recognized by R
      • +
    +
    +

    radiant.data 1.4.22022-05-25

    +
    • Use all for is.null and is.na if object length can be greater than 1 as required in R 4.2.0
      • +
    +
    +

    radiant.data 1.4.12021-11-12

    +
    +
    +

    radiant.data 1.3.122020-11-27

    +
    • Fixes related to breaking changes in magrittr +
      • +
    • Fixes related to changes in readr argument names
      • +
    • Fix to launch radiant in a “windows”
      • +
    +
    +

    radiant.data 1.3.102020-08-07

    +
    • Add Google Drive to the default set of directories to explore if available
      • +
    • Add back functionality to convert a column to type ts in Data > Transform now that this is again supported by dplyr 1.0.1
      • +
    +
    +

    radiant.data 1.3.92020-06-16

    +
    • Fix for using the date function from the lubridate package in a filter
      • +
    • Removed functionality to convert a column to type ts as this is not supported by dplyr 1.0.0 and vctrs 0.3.1
      • +
    • Updated documentation using https://github.com/r-lib/roxygen2/pull/1109 +
      • +
    +
    +

    radiant.data 1.3.6

    +
    • Updated styling for formatting for modals (e.g., help pages) that will also allow improved sizing of the (shinyFiles) file browser
      • +
    • Fix for \r line-endings in Report > Rmd on Windows. Issue was most likely to occur when copy-and-pasting text from PDF into Report > Rmd.
      • +
    +
    +

    radiant.data 1.3.42020-03-23

    +
    • Minor adjustments in anticipation of dplyr 1.0.0
      • +
    +
    +

    radiant.data 1.3.3

    +
    • Function to calculate “mode”
      • +
    • Fix for “spread” in Data > Transform with column name includes “.”
      • +
    +
    +

    radiant.data 1.3.1

    +
    • If radiant is not opened from an Rstudio project, use the working directory at launch as the base directory for the application
      • +
    +
    +

    radiant.data 1.3.0

    +
    • Updated styling of Notebook and HTML reports (cosmo + zenburn)
      • +
    • Documentation updates to link to new video tutorials
      • +
    • Use patchwork for grouping multiple plots together
      • +
    • Apply refactor to any type in the Data > Transform UI
      • +
    • Fix for weighted.sd when missing values differ for x and weights
      • +
    • Avoid resetting the “Column header” to its default value in Data > Explore when other settings are changed.
      • +
    +
    +

    radiant.data 1.2.3

    +
    • Fix for Data > Transform > Spread when no variables are selected
      • +
    • Set debounce to 0 for all shinyAce editors
      • +
    +
    +

    radiant.data 1.2.2

    +
    • Use zenburn for code highlighting in Notebook and HTML report from Report > Rmd +
      • +
    • Clean up “sf_volumes” from the when radiant is stopped
      • +
    +
    +

    radiant.data 1.2.0

    +
    • Update action buttons that initiate a calculation when one or more relevant inputs are changed. For example, when a model should be re-estimated because the set of explanatory variables was changed by the user, a spinning “refresh” icon will be shown
      • +
    +
    +

    radiant.data 1.1.8

    +
    • Changed default quantile algorithm used in the xtile function from number 2 to 7. See the help for stats::quantile for details
      • +
    • Added me and meprop functions to calculate the margin of error for a mean and a proportion. Functions are accessible from Data > Pivot and Data > Explore +
      • +
    +
    +

    radiant.data 1.1.6

    +
    • Improvements for wrapping generated code to Report > Rmd or Report > R +
      • +
    • +Data > Transform > Training now uses the randomizr package to allow blocking variables when creating a training variables.
      • +
    +
    +

    radiant.data 1.1.3

    +
    • Guard against using Data > Transform > Reorder/remove levels with too many levels (i.e., > 100)
      • +
    • Guard against using Data > Transform > Reorder/remove variables with too many variables (i.e., > 100)
      • +
    • Fix for DT table callbacks when shiny 1.4 hits CRAN (see https://github.com/rstudio/DT/issues/146#issuecomment-534319155)
      • +
    • Tables from Data > Pivot and Data > Explore now have nr set to Inf by default (i.e., show all rows). The user can change this to the number of desired rows to show (e.g., select 3 rows in a sorted table)
      • +
    • Fix for example numbering in the help file for Data > Transform +
      • +
    • Numerous small code changes to support enhanced auto-completion, tooltips, and annotations in shinyAce 0.4.1
      • +
    +
    +

    radiant.data 1.0.62019-08-22

    +
    • Fix for Data > Transform > Change type +
      • +
    • Option to fix_names to lower case
      • +
    • Keyboard shortcut (Enter) to load remove csv and rds files
      • +
    • Use a shinyAce input to generate data descriptions
      • +
    • Allow custom initial dataset list
      • +
    • Fix for latex formulas in Report > Rmd on Windows
      • +
    • Updated requirements for markdown and Rmarkdown
      • +
    • Fix for radiant.init.data with shiny-server
      • +
    • Improvements to setup to allow access to server-side files by adding options to .Rprofile: +
      • Add options(radiant.report = TRUE) to allow report generation in Report > Rmd and Report > R +
        • +
      • Add options(radiant.shinyFiles = TRUE) to allow server-side access to files
        • +
      • List specific directories you want to use with radiant using, for example, options(radiant.sf_volumes = c(Git = "/home/jovyan/git")) +
        • +
      • +
    +
    +

    radiant.data 1.0.02019-07-18

    +
    • Support for series of class ts (e.g., Data > Transform > Change type > Time series)
      • +
    • Require shinyAce 0.4.0
      • +
    • Vertical jitter set to 0 by default
      • +
    +
    +

    radiant.data 0.9.9.0

    +
    • Added option to save Report > Rmd as a powerpoint file using Rmarkdown +
      • +
    • Removed dependency on summarytools due to breaking changes
      • +
    • Fix for interaction (iterm) and non-linear term (qterm) creation if character strings rather than integers are passed to the function
      • +
    • Remove specific symbols from reports in Report > Rmd to avoid issues when generating HTML or PDF documents
      • +
    • Keyboard shortcuts, i.e., CTRL-O and CTRL-S (CMD-O and CMD-S on macOS) to open and save data files in the Data > Manage tab
      • +
    • Various fixes to address breaking changes in dplyr 0.8.0
      • +
    • Added radiant_ prefix to all attributes, except description, to avoid conflicts with other packages (e.g., vars in dplyr)
      • +
    +
    +

    radiant.data 0.9.8.6

    +
    • Use stringi::stri_trans_general to replace special symbols in Rmarkdown that may cause problems
      • +
    • Add empty line before and after code chunks when saving reports to Rmarkdown
      • +
    • Use rio to load sav, dta, or sas7bdat files through the read files button in Report > Rmd and Report > R.
      • +
    • Create a qscatter plot similar to the function of the same name in Stata
      • +
    • New radiant icon
      • +
    • Fix for setting where both xlim and ylim are set in visualize function
      • +
    • Use an expandable shinyAce input for the R-code log in Data > Transform +
      • +
    +
    +

    radiant.data 0.9.8.0

    +
    • Added an “autosave” options. Use options(radiant.autosave = c(10, 180)); radiant::radiant() to auto-save the application state to the ~/.radiant.session folder every 10 minutes for the next 180 minutes. This can be useful if radiant is being used during an exam, for example.
      • +
    • Emergency backups are now saved to ~/.radiant.session/r_some_id.state.rda. The files should be automatically loaded when needed but can also be loaded as a regular radiant state file
      • +
    • Replace option to load an .rda from from a URL in Data > Manage to load .rds files instead
      • +
    • Ensure variable and dataset names are valid for R (i.e., no spaces or symbols), “fixing” the input as needed
      • +
    • Fix to visualize now ggplot::labs no longer accepts a list as input
      • +
    • Add option to generate square and cubed terms for use in linear and logistic regression in radiant.model +
      • +
    • Fix for error when trying to save invalid predictions in radiant.model. This action now generates a pop-up in the browser interface
      • +
    • Add a specified description to a data.frame immediately on register +
      • +
    • Option to pass additional arguments to shiny::runApp when starting radiant such as the port to use. For example, radiant.data::radiant.data(“https://github.com/radiant-rstats/docs/raw/gh-pages/examples/demo-dvd-rnd.state.rda”, port = 8080)
      • +
    • Option for automatic cleanup of deprecated code in both Report > Rmd and Report > R +
      • +
    • Avoid attempt to fix deprecated code in Report > Rmd if pred_data = "" +
      • +
    • Fix for download icon linked to downloading of a state file after upgrade to shiny 1.2
      • +
    • Update documentation for Data > Combine +
      • +
    • Fix for format_df when the data.frame contains missing values. This fix is relevant for several summary functions run in Report > Rmd or Report > R +
      • +
    • Fix for directory set when using Knit report in Report > Rmd and Report > R without an Rstudio project. Will now correctly default to the working directory used in R(studio)
      • +
    • Added option to change smooth setting for histograms with a density plot
      • +
    • Similar to pmin and pmax, pfun et al. calculate summary statistics elementwise across multiple vectors
      • +
    • Add Desktop as a default directory to show in the shinyFiles file browser
      • +
    • Load a state file on startup by providing a (relative) file path or a url. For example, radiant.data::radiant.data(“https://github.com/radiant-rstats/docs/raw/gh-pages/examples/demo-dvd-rnd.state.rda”) or radiant.data::radiant.data(“assignment.state.rda”)
      • +
    • Update example report in Report > Rmd +
      • +
    • Add deregister function to remove data in radiant from memory and the datasets dropdown list
      • +
    • Fix for invalid column names if used in Data > Pivot +
      • +
    +
    +

    radiant.data 0.9.7.0

    +
    • Use summarytools to generate summary information for datasets in Data > Manage +
      • +
    • Show modal with warning about non-writable working directory when saving reports in Report > Rmd or Report > R +
      • +
    • Apply radiant.data::fix_names to files loaded into radiant to ensure valid R-object names
      • +
    • Use the content of the Store filtered data as input to name the csv download in Data > View +
      • +
    • Add “txt” as a recognized file type for Read files in Report > Rmd and Report > R +
      • +
    • Allow multiple lines or loess curves based on a selected color variable for scatter plots in Data > Visualize +
      • +
    • Indicate that a plot in Data > Visualize should be updated when plot labels are changed
      • +
    • Fix for #81 when variables used in Data > Pivot contain dots
      • +
    • Fix for radiant.project_dir when no Rstudio project is used which could cause incorrect relative paths to be used
      • +
    • Fix code formatting for Report > Rmd when arguments include a list (e.g., ggplot labels)
      • +
    • On Linux use a modal to show code in Report > Rmd and Report > R when reporting is set to “manual”
      • +
    • Use is_double to ensure dates are not treated as numeric variables in Data > View +
      • +
    • Make sort and filter state of tables in Data > Explore and Data > Pivot available in Report > Rmd
      • +
    • Fix names for data sets loaded using the Read files button in Report > Rmd or Report > R
      • +
    • Cleanup environment after closing app
      • +
    • Fix column names with spaces, etc. when reading csv files
      • +
    • Additional styling and labeling options for Data > Visualize are now available in the browser interface
      • +
    • Fix for code generation related to DT filters
      • +
    +
    +

    radiant.data 0.9.6.14

    +
    +

    Major changes

    +
    • Using shinyFiles to provide convenient access to data located on a server
      • +
    • Avoid XQuartz requirement
      • +
    +
    +

    Minor changes

    +
    • Load data(...) into the current environment rather than defaulting only to the global environment
      • +
    • +file.rename failed using docker on windows when saving a report. Using file.copy instead
      • +
    • Fix for sf_volumes used to set the root directories to load and save files
      • +
    • Set default locale to “en_US.UTF-8” when using shiny-server unless Sys.getlocale(category = "LC_ALL") what set to something other than “C”
      • +
    • Modal shown if and Rmd (R) file is not available when using “To Rstudio (Rmd)” in Report > Rmd or “To Rstudio (R)” in Report > R +
      • +
    • Track progress loading (state) files
      • +
    • Fix for radiant.sf_volumes used for the shinyFiles file browser
      • +
    • Improvements for sending code from Radiant to Rstudio
      • +
    • Better support for paths when using radiant on a server (i.e., revert to home directory using radiant.data::find_home())
      • +
    • Revert from svg to png for plots in _Report > Rmd_ and _Report > R_.svg` scatter plots with many point get to big for practical use on servers that have to transfer images to a local browser
      • +
    • Removed dependency on methods package
      • +
    +
    +
    +

    radiant.data 0.9.5.3

    +
    • Fix smart comma’s in data descriptions
      • +
    • Search and replace desc(n) in reports and replace by desc(n_obs) +
      • +
    • Revert to storing the r_data environment as a list on stop to avoid reference problems (@josh1400)
      • +
    • Fix for plot type in Data > Pivot in older state files (@josh1400)
      • +
    • Used all declared imports (CRAN)
      • +
    +
    +

    radiant.data 0.9.5.0

    +
    • Fix for radiant.data::explore when variable names contain an underscore
      • +
    • Fix for find_gdrive when drive is not being synced
      • +
    • Fixes in Report > Rmd and Report > R to accommodate for pandoc > 2
      • +
    +
    +

    radiant.data 0.9.4.6

    +
    • Don’t update a reactive binding for an object if the binding already exists. See issue https://github.com/rstudio/shiny/issues/2065 +
      • +
    • Fix to accommodate changes in deparse in R 3.5
      • +
    • Fix for saving data in Data > Manage and generating the relevant R-code
      • +
    +
    +

    radiant.data 0.9.3.5

    +
    +

    Minor changes

    +
    • Use dev = "svg" for plots in Report > Rmd and Report > R +
      • +
    +
    +
    +

    radiant.data 0.9.3.4

    +
    +

    Minor changes

    +
    • Add argument to dtab.data.frame to format specified columns as a percentage
      • +
    +
    +

    Bug fixes

    +
    • Round to the specified number of decimal places even if input if not of type integer (e.g., 2.0)
      • +
    +
    +
    +

    radiant.data 0.9.3.3

    +
    +

    Major changes

    +
    • When using radiant with Rstudio Viewer or in an Rstudio Window, loading and saving data through Data > Manage generates R-code the user can add to Report > Rmd or Report > R. Clicking the Show R-code checkbox displays the R-code used to load or save the current dataset
      • +
    • Various changes to the code to accommodate the use of shiny::makeReactiveBinding. The advantage is that the code generated for Report > Rmd and Report > R will no longer have to use a list (r_data) to store and access data. This means that code generated and used in the Radiant browser interface will be directly usable without the browser interface as well
      • +
    • Removed loadr, saver, load_csv, loadcsv_url, loadrds_url, and make_funs functions as they are no longer needed
      • +
    • Deprecated mean_rm, median_rm, min_rm, max_rm,sd_rm,var_rm, and sum_rm functions as they are no longer needed
      • +
    +
    +

    Minor changes

    +
    • Added load_clip and save_clip to load and save data to the clipboard on Windows and macOS
      • +
    • Improved auto completion in Report > Rmd and Report > R +
      • +
    • Maintain, store, and clean the settings of the interactive table in Data > View +
      • +
    • Address closing Rstudio Window issue (https://github.com/rstudio/shiny/issues/2033)
      • +
    +
    +
    +

    radiant.data 0.9.2.3

    +
    +

    Major changes

    +
    • +Report > Rmd and Report > R will now be evaluated the r_data environment. This means that the return value from ls() will be much cleaner
      • +
    +
    +

    Minor changes

    +
    • Add option to load files with extension .rdata or .tsv using loadr which add that data to the Datasets dropdown
      • +
    • +visualize will default to a scatter plot if xvar and yvar are specified but no plot type is provided in the function call
      • +
    • Improvements to read_files function to interactively generate R-code (or Rmarkdown code-chunks) to read files in various format (e.g., SQLite, rds, csv, xlsx, css, jpg, etc.). Supports relative paths and uses find_dropbox() and find_gdrive() when applicable
      • +
    +
    +
    +

    radiant.data 0.9.2.2

    +
    +

    Minor changes

    +
    • Require shinyAce 0.3.0
      • +
    • Export read_files function to interactively generate R-code or Rmarkdown code-chunks to read files in various format (e.g., SQLite, rds, csv, xlsx, css, jpg, etc.). Supports relative paths and uses find_dropbox() and find_gdrive() when applicable
      • +
    +
    +
    +

    radiant.data 0.9.2.0

    +
    +

    Minor changes

    +
    • Addins option to start app in Rstudio window
      • +
    • Upload and download data using the Rstudio file browser. Allows using relative paths to files (e.g., data or images inside an Rstudio project)
      • +
    +
    +
    +

    CHANGES IN radiant.data 0.9.0.22

    +
    +

    Bug fixes

    +
    • Fix for #43 where scatter plot was not shown for a dataset with less than 1,000 rows
      • +
    • Fix for Report > Rmd and Report > R when R-code or Rmarkdown is being pulled from the Rstudio editor
      • +
    +
    +

    Minor changes

    +
    • Updated equation example in Report > Rmd +
      • +
    +
    +
    +

    radiant.data 0.9.0.17

    +
    +

    Minor changes

    +
    • Use thousand separator for summary.pivotr and summary.explore +
      • +
    • Fix in code-generation for table2data +
      • +
    +
    +
    +

    radiant.data 0.9.0.16

    +
    +

    Minor changes

    +
    • Changed license for help files and images for radiant.data to CC-BY-SA +
      • +
    +
    +
    +

    radiant.data 0.9.0.15

    +
    +

    Minor changes

    +
    • Allow all textarea inputs and multi-select inputs to be resized manually by the user
      • +
    • Use 200 dpi for plots in Report > Rmd and Report > R +
      • +
    • +Data > Visualize now has an option to select a sample of data for scatter plots (e.g., 1K, 5K, 10K, or All)
      • +
    +
    +

    Bug fixes

    +
    • Fix for rounddf to ignore dates
      • +
    +
    +
    +

    radiant.data 0.9.0.13

    +
    +

    Minor changes

    +
    • Apply fixMS to replace curly quotes, em dash, etc. when using Data > Transform > Create +
      • +
    • Option to set number of decimals to show in Data > View +
      • +
    • Improved number formatting in interactive tables in Data > View, Data > Pivot, and Data > Explore +
      • +
    • Option to include an interactive view of a dataset in Report > Rmd. By default, the number of rows is set to 100 as, most likely, the user will not want to embed a large dataset in save HTML report
      • +
    • +Data > Transform will leave variables selected, unless switching to Create or Spread +
      • +
    • Switch focus to editor in Report > Rmd and Report > R when no other input has focus
      • +
    +
    +

    Bug fixes

    +
    • Fix for decimals to show in interactive tables Report > Rmd and saved HTML reports
      • +
    • Better error messages for xtile and when binning data with too many groups
      • +
    • Fix for variable type warnings in Data > Pivot when filtering the table
      • +
    • Fix for  in equations in Report > Rmd +
      • +
    +
    +
    +

    radiant.data 0.9.0.7

    +
    +

    Minor changes

    +
    • Allow response variables with NA values in Model > Logistic regression and other classification models
      • +
    • Support logicals in code generation from Data > View +
      • +
    • Track window size using input$get_screen_width +
      • +
    • Focus on editor when switching to Report > Rmd or Report > R so generated code is shown immediately and the user can navigate and type in the editor without having to click first
      • +
    • Add information about the first level when plotting a bar chart with a categorical variable on the Y-axis (e.g., mean(buyer {yes}))
      • +
    +
    +

    Bug fixes

    +
    • Cleanup now also occurs when the stop button is used in Rstudio to close the app
      • +
    • Fix to include DiagrammeR based plots in Rmarkdown reports
      • +
    • Fix in read_files for SQLite data names
      • +
    • De-activate spell check auto correction in selectizeInput in Rstudio Viewer shiny #1916 +
      • +
    • Fix to allow selecting and copying text output from Report > Rmd and Report > R +
      • +
    • Remove “fancy” quotes from filters
      • +
    • Known issue: The Rstudio viewer may not always close the viewer window when trying to stop the application with the Stop link in the navbar. As a work-around, use Rstudio’s stop buttons instead.
      • +
    +
    +
    +

    radiant.data 0.9.0.0

    +
    +

    Major changes

    +
    • If Rstudio project is used Report > Rmd and Report > R will use the project directory as base. This allows users to use relative paths and making it easier to share (reproducible) code
      • +
    • Specify options in .Rprofile for upload memory limit and running Report > Rmd on server
      • +
    • +find_project function based on rstudioapi +
      • +
    • +Report > Rmd Read button to generate code to load various types of data (e.g., rda, rds, xls, yaml, feather)
      • +
    • +Report > Rmd Read button to generate code to load various types of files in report (e.g., jpg, png, md, Rmd, R). If Radiant was started from an Rstudio project, the file paths used will be relative to the project root. Paths to files synced to local Dropbox or Google Drive folder will use the find_dropbox and find_gdrive functions to enhances reproducibility.
      • +
    • +Report > Rmd Load Report button can be used to load Rmarkdown file in the editor. It will also extract the source code from Notebook and HTML files with embedded Rmarkdown
      • +
    • +Report > Rmd will read Rmd directly from Rstudio when “To Rstudio (Rmd)” is selected. This will make it possible to use Rstudio Server Pro’s Share project option for realtime collaboration in Radiant
      • +
    • Long lines of code generated for Report > Rmd will be wrapped to enhance readability
      • +
    • +Report > R is now equivalent to Report > Rmd but in R-code format
      • +
    • +Report > Rmd option to view Editor, Preview, or Both
      • +
    • Show Rstudio project information in navbar if available
      • +
    +
    +

    Minor changes

    +
    • Overflow pre and code blocks in HTML reports generated in Report > Rmd +
      • +
    • Read rdata files through Data > Manage +
      • +
    • Enhanced keyboard shortcuts
      • +
    • Enhanced editing features in Report > Rmd and Report > R based on updates to shinyAce +
      • +
    +
    +
    +

    radiant.data 0.8.7.8

    +
    +

    Minor changes

    +
    • Added preview options to Data > Manage based on https://github.com/radiant-rstats/radiant/issues/30 +
      • +
    • Add selected dataset name as default table download name in Data > View, Data > Pivot, and Data > Explore +
      • +
    • Use “stack” as the default for histograms and frequency charts in Data > Visualize +
      • +
    • Cleanup Stop & Report option in navbar
      • +
    • Upgraded tidyr dependency to 0.7
      • +
    • Upgraded dplyr dependency to 0.7.1
      • +
    +
    +

    Bug fixes

    +
    • Fix for large numbers in Data > Explore that could cause an integer overflow
      • +
    +
    +
    +

    radiant.data 0.8.6.0

    +
    +

    Minor changes

    +
    • Export ggplotly from plotly for interactive plots in Report > Rmd +
      • +
    • Export subplot from plotly for grids of interactive plots in Report > Rmd +
      • +
    • Set default res = 96 for renderPlot and dpi = 96 for knitr::opts_chunk +
      • +
    • Add fillcol, linecol, and pointcol to visualize to set plot colors when no fill or color variable has been selected
      • +
    • Reverse legend ordering in Data > Visualize when axes are flipped using coor_flip() +
      • +
    • Added functions to choose.files and choose.dir. Uses JavaScript on Mac, utils::choose.files and utils::choose.dir on Windows, and reverts to file.choose on Linux
      • +
    • Added find_gdrive to determine the path to a user’s local Google Drive folder if available
      • +
    • +fixMs for encoding in reports on Windows
      • +
    +
    +

    Bug fixes

    +
    • Chi-square results were not displayed correctly in Data > Pivot +
      • +
    • Fix for state_multiple +
      • +
    +
    +
    +

    radiant.data 0.8.1.0

    +
    +

    Minor changes

    +
    • Specify the maximum number of rows to load for a csv and csv (url) file through Data > Manage +
      • +
    • Support for loading and saving feather files, including specifying the maximum number of rows to load through Data > Manage +
      • +
    • Added author and year arguments to help modals in inst/app/radiant.R (thanks @kmezhoud)
      • +
    • Added size argument for scatter plots to create bubble charts (thanks @andrewsali)
      • +
    • Example and CSS formatting for tables in Report > Rmd +
      • +
    • Added seed argument to make_train +
      • +
    • Added prop, sdprop, etc. for working with proportions
      • +
    • Set ylim in visualize for multiple plots
      • +
    • Show progress indicator when saving reports from Report > Rmd +
      • +
    • +copy_attr convenience function
      • +
    • +refactor function to keep only a subset of levels in a factor and recode the remaining (and first) level to, for example, other
      • +
    • +register function to add a (transformed) dataset to the dataset dropdown
      • +
    • Remember name of state files loaded and suggest that name when re-saving the state
      • +
    • Show dataset name in output if dataframe passed directly to analysis function
      • +
    • R-notebooks are now the default option for output saved from Report > Rmd and Report > R +
      • +
    • Improved documentation on how to customize plots in Report > Rmd +
      • +
    • Keyboard short-cut to put code into Report > Rmd (ALT-enter)
      • +
    +
    +

    Bug fixes

    +
    • When clicking the rename button, without changing the name, the dataset was set to NULL (thanks @kmezhoud, https://github.com/radiant-rstats/radiant/issues/5)
      • +
    • Replace ext with .ext in mutate_each function call
      • +
    • Variance estimation in Data > Explore would cause an error with unit cell-frequencies (thanks @kmezhoud, https://github.com/radiant-rstats/radiant/issues/6)
      • +
    • Fix for as_integer when factor levels are characters
      • +
    • Fix for integer conversion in explore
      • +
    • Remove \r and special characters from strings in r_data and r_state
      • +
    • Fix sorting in Report > Rmd for tables created using Data > Pivot and Data > Explore when column headers contain symbols or spaces (thanks @4kammer)
      • +
    • Set error = TRUE for rmarkdown for consistency with knitr as used in Report > Rmd +
      • +
    • Correctly handle decimal indicators when loading csv files in Data > Manage +
      • +
    • Don’t overwrite a dataset to combine if combine generates an error when user sets the the name of the combined data to that of an already selected dataset
      • +
    • When multiple variables were selected, data were not correctly summarized in Data > Transform
      • +
    • Add (function) label to bar plot when x-variable is an integer
      • +
    • Maintain order of variables in Data > Visualize when using “color”, “fill”, “comby”, or “combx”
      • +
    • Avoid warning when switching datasets in Data > Transform and variables being summarized do not exists in the new dataset
      • +
    • which.pmax produced a list but needed to be integer
      • +
    • To customized predictions in radiant.model indexr must be able to customize the prediction dataframe
      • +
    • describe now correctly resets the working directory on exit
      • +
    • removed all calls to summarise_each and mutate_each from dplyr
      • +
    +
    +

    Deprecated

    +
    • varp_rm has been deprecated in favor of varpop
      • +
    • sdp_rm has been deprecated in favor of sdpop
      • +
    • mutate_each has been deprecated in favor of mutate_at, mutate_all, and radiant.data::mutate_ext
      • +
    +
    +
    + + + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/pkgdown.css b/radiant.data/docs/pkgdown.css new file mode 100644 index 0000000000000000000000000000000000000000..80ea5b838a4d8f24ae023bbf3582a8079aadbf66 --- /dev/null +++ b/radiant.data/docs/pkgdown.css @@ -0,0 +1,384 @@ +/* Sticky footer */ + +/** + * Basic idea: https://philipwalton.github.io/solved-by-flexbox/demos/sticky-footer/ + * Details: https://github.com/philipwalton/solved-by-flexbox/blob/master/assets/css/components/site.css + * + * .Site -> body > .container + * .Site-content -> body > .container .row + * .footer -> footer + * + * Key idea seems to be to ensure that .container and __all its parents__ + * have height set to 100% + * + */ + +html, body { + height: 100%; +} + +body { + position: relative; +} + +body > .container { + display: flex; + height: 100%; + flex-direction: column; +} + +body > .container .row { + flex: 1 0 auto; +} + +footer { + margin-top: 45px; + padding: 35px 0 36px; + border-top: 1px solid #e5e5e5; + color: #666; + display: flex; + flex-shrink: 0; +} +footer p { + margin-bottom: 0; +} +footer div { + flex: 1; +} +footer .pkgdown { + text-align: right; +} +footer p { + margin-bottom: 0; +} + +img.icon { + float: right; +} + +/* Ensure in-page images don't run outside their container */ +.contents img { + max-width: 100%; + height: auto; +} + +/* Fix bug in bootstrap (only seen in firefox) */ +summary { + display: list-item; +} + +/* Typographic tweaking ---------------------------------*/ + +.contents .page-header { + margin-top: calc(-60px + 1em); +} + +dd { + margin-left: 3em; +} + +/* Section anchors ---------------------------------*/ + +a.anchor { + display: none; + margin-left: 5px; + width: 20px; + height: 20px; + + background-image: url(./link.svg); + background-repeat: no-repeat; + background-size: 20px 20px; + background-position: center center; +} + +h1:hover .anchor, +h2:hover .anchor, +h3:hover .anchor, +h4:hover .anchor, +h5:hover .anchor, +h6:hover .anchor { + display: inline-block; +} + +/* Fixes for fixed navbar --------------------------*/ + +.contents h1, .contents h2, .contents h3, .contents h4 { + padding-top: 60px; + margin-top: -40px; +} + +/* Navbar submenu --------------------------*/ + +.dropdown-submenu { + position: relative; +} + +.dropdown-submenu>.dropdown-menu { + top: 0; + left: 100%; + margin-top: -6px; + margin-left: -1px; + border-radius: 0 6px 6px 6px; +} + +.dropdown-submenu:hover>.dropdown-menu { + display: block; +} + +.dropdown-submenu>a:after { + display: block; + content: " "; + float: right; + width: 0; + height: 0; + border-color: transparent; + border-style: solid; + border-width: 5px 0 5px 5px; + border-left-color: #cccccc; + margin-top: 5px; + margin-right: -10px; +} + +.dropdown-submenu:hover>a:after { + border-left-color: #ffffff; +} + +.dropdown-submenu.pull-left { + float: none; +} + +.dropdown-submenu.pull-left>.dropdown-menu { + left: -100%; + margin-left: 10px; + border-radius: 6px 0 6px 6px; +} + +/* Sidebar --------------------------*/ + +#pkgdown-sidebar { + margin-top: 30px; + position: -webkit-sticky; + position: sticky; + top: 70px; +} + +#pkgdown-sidebar h2 { + font-size: 1.5em; + margin-top: 1em; +} + +#pkgdown-sidebar h2:first-child { + margin-top: 0; +} + +#pkgdown-sidebar .list-unstyled li { + margin-bottom: 0.5em; +} + +/* bootstrap-toc tweaks ------------------------------------------------------*/ + +/* All levels of nav */ + +nav[data-toggle='toc'] .nav > li > a { + padding: 4px 20px 4px 6px; + font-size: 1.5rem; + font-weight: 400; + color: inherit; +} + +nav[data-toggle='toc'] .nav > li > a:hover, +nav[data-toggle='toc'] .nav > li > a:focus { + padding-left: 5px; + color: inherit; + border-left: 1px solid #878787; +} + +nav[data-toggle='toc'] .nav > .active > a, +nav[data-toggle='toc'] .nav > .active:hover > a, +nav[data-toggle='toc'] .nav > .active:focus > a { + padding-left: 5px; + font-size: 1.5rem; + font-weight: 400; + color: inherit; + border-left: 2px solid #878787; +} + +/* Nav: second level (shown on .active) */ + +nav[data-toggle='toc'] .nav .nav { + display: none; /* Hide by default, but at >768px, show it */ + padding-bottom: 10px; +} + +nav[data-toggle='toc'] .nav .nav > li > a { + padding-left: 16px; + font-size: 1.35rem; +} + +nav[data-toggle='toc'] .nav .nav > li > a:hover, +nav[data-toggle='toc'] .nav .nav > li > a:focus { + padding-left: 15px; +} + +nav[data-toggle='toc'] .nav .nav > .active > a, +nav[data-toggle='toc'] .nav .nav > .active:hover > a, +nav[data-toggle='toc'] .nav .nav > .active:focus > a { + padding-left: 15px; + font-weight: 500; + font-size: 1.35rem; +} + +/* orcid ------------------------------------------------------------------- */ + +.orcid { + font-size: 16px; + color: #A6CE39; + /* margins are required by official ORCID trademark and display guidelines */ + margin-left:4px; + margin-right:4px; + vertical-align: middle; +} + +/* Reference index & topics ----------------------------------------------- */ + +.ref-index th {font-weight: normal;} + +.ref-index td {vertical-align: top; min-width: 100px} +.ref-index .icon {width: 40px;} +.ref-index .alias {width: 40%;} +.ref-index-icons .alias {width: calc(40% - 40px);} +.ref-index .title {width: 60%;} + +.ref-arguments th {text-align: right; padding-right: 10px;} +.ref-arguments th, .ref-arguments td {vertical-align: top; min-width: 100px} +.ref-arguments .name {width: 20%;} +.ref-arguments .desc {width: 80%;} + +/* Nice scrolling for wide elements --------------------------------------- */ + +table { + display: block; + overflow: auto; +} + +/* Syntax highlighting ---------------------------------------------------- */ + +pre, code, pre code { + background-color: #f8f8f8; + color: #333; +} +pre, pre code { + white-space: pre-wrap; + word-break: break-all; + overflow-wrap: break-word; +} + +pre { + border: 1px solid #eee; +} + +pre .img, pre .r-plt { + margin: 5px 0; +} + +pre .img img, pre .r-plt img { + background-color: #fff; +} + +code a, pre a { + color: #375f84; +} + +a.sourceLine:hover { + text-decoration: none; +} + +.fl {color: #1514b5;} +.fu {color: #000000;} /* function */ +.ch,.st {color: #036a07;} /* string */ +.kw {color: #264D66;} /* keyword */ +.co {color: #888888;} /* comment */ + +.error {font-weight: bolder;} +.warning {font-weight: bolder;} + +/* Clipboard --------------------------*/ + +.hasCopyButton { + position: relative; +} + +.btn-copy-ex { + position: absolute; + right: 0; + top: 0; + visibility: hidden; +} + +.hasCopyButton:hover button.btn-copy-ex { + visibility: visible; +} + +/* headroom.js ------------------------ */ + +.headroom { + will-change: transform; + transition: transform 200ms linear; +} +.headroom--pinned { + transform: translateY(0%); +} +.headroom--unpinned { + transform: translateY(-100%); +} + +/* mark.js ----------------------------*/ + +mark { + background-color: rgba(255, 255, 51, 0.5); + border-bottom: 2px solid rgba(255, 153, 51, 0.3); + padding: 1px; +} + +/* vertical spacing after htmlwidgets */ +.html-widget { + margin-bottom: 10px; +} + +/* fontawesome ------------------------ */ + +.fab { + font-family: "Font Awesome 5 Brands" !important; +} + +/* don't display links in code chunks when printing */ +/* source: https://stackoverflow.com/a/10781533 */ +@media print { + code a:link:after, code a:visited:after { + content: ""; + } +} + +/* Section anchors --------------------------------- + Added in pandoc 2.11: https://github.com/jgm/pandoc-templates/commit/9904bf71 +*/ + +div.csl-bib-body { } +div.csl-entry { + clear: both; +} +.hanging-indent div.csl-entry { + margin-left:2em; + text-indent:-2em; +} +div.csl-left-margin { + min-width:2em; + float:left; +} +div.csl-right-inline { + margin-left:2em; + padding-left:1em; +} +div.csl-indent { + margin-left: 2em; +} diff --git a/radiant.data/docs/pkgdown.js b/radiant.data/docs/pkgdown.js new file mode 100644 index 0000000000000000000000000000000000000000..6f0eee40bc3c69061d33fbed1bc9644f47c0eb8a --- /dev/null +++ b/radiant.data/docs/pkgdown.js @@ -0,0 +1,108 @@ +/* http://gregfranko.com/blog/jquery-best-practices/ */ +(function($) { + $(function() { + + $('.navbar-fixed-top').headroom(); + + $('body').css('padding-top', $('.navbar').height() + 10); + $(window).resize(function(){ + $('body').css('padding-top', $('.navbar').height() + 10); + }); + + $('[data-toggle="tooltip"]').tooltip(); + + var cur_path = paths(location.pathname); + var links = $("#navbar ul li a"); + var max_length = -1; + var pos = -1; + for (var i = 0; i < links.length; i++) { + if (links[i].getAttribute("href") === "#") + continue; + // Ignore external links + if (links[i].host !== location.host) + continue; + + var nav_path = paths(links[i].pathname); + + var length = prefix_length(nav_path, cur_path); + if (length > max_length) { + max_length = length; + pos = i; + } + } + + // Add class to parent
  • , and enclosing
  • if in dropdown + if (pos >= 0) { + var menu_anchor = $(links[pos]); + menu_anchor.parent().addClass("active"); + menu_anchor.closest("li.dropdown").addClass("active"); + } + }); + + function paths(pathname) { + var pieces = pathname.split("/"); + pieces.shift(); // always starts with / + + var end = pieces[pieces.length - 1]; + if (end === "index.html" || end === "") + pieces.pop(); + return(pieces); + } + + // Returns -1 if not found + function prefix_length(needle, haystack) { + if (needle.length > haystack.length) + return(-1); + + // Special case for length-0 haystack, since for loop won't run + if (haystack.length === 0) { + return(needle.length === 0 ? 0 : -1); + } + + for (var i = 0; i < haystack.length; i++) { + if (needle[i] != haystack[i]) + return(i); + } + + return(haystack.length); + } + + /* Clipboard --------------------------*/ + + function changeTooltipMessage(element, msg) { + var tooltipOriginalTitle=element.getAttribute('data-original-title'); + element.setAttribute('data-original-title', msg); + $(element).tooltip('show'); + element.setAttribute('data-original-title', tooltipOriginalTitle); + } + + if(ClipboardJS.isSupported()) { + $(document).ready(function() { + var copyButton = ""; + + $("div.sourceCode").addClass("hasCopyButton"); + + // Insert copy buttons: + $(copyButton).prependTo(".hasCopyButton"); + + // Initialize tooltips: + $('.btn-copy-ex').tooltip({container: 'body'}); + + // Initialize clipboard: + var clipboardBtnCopies = new ClipboardJS('[data-clipboard-copy]', { + text: function(trigger) { + return trigger.parentNode.textContent.replace(/\n#>[^\n]*/g, ""); + } + }); + + clipboardBtnCopies.on('success', function(e) { + changeTooltipMessage(e.trigger, 'Copied!'); + e.clearSelection(); + }); + + clipboardBtnCopies.on('error', function() { + changeTooltipMessage(e.trigger,'Press Ctrl+C or Command+C to copy'); + }); + }); + } +})(window.jQuery || window.$) diff --git a/radiant.data/docs/pkgdown.yml b/radiant.data/docs/pkgdown.yml new file mode 100644 index 0000000000000000000000000000000000000000..82dcd1aec89bf60d1afe2474cced81f065f892a0 --- /dev/null +++ b/radiant.data/docs/pkgdown.yml @@ -0,0 +1,19 @@ +pandoc: 3.1.2 +pkgdown: 2.0.7 +pkgdown_sha: ~ +articles: + combine: pkgdown/combine.html + explore: pkgdown/explore.html + manage: pkgdown/manage.html + pivotr: pkgdown/pivotr.html + report_r: pkgdown/report_r.html + report_rmd: pkgdown/report_rmd.html + state: pkgdown/state.html + transform: pkgdown/transform.html + view: pkgdown/view.html + visualize: pkgdown/visualize.html +last_built: 2023-09-06T05:57Z +urls: + reference: https://radiant-rstats.github.io/radiant.data/reference + article: https://radiant-rstats.github.io/radiant.data/articles + diff --git a/radiant.data/docs/reference/Rplot001.png b/radiant.data/docs/reference/Rplot001.png new file mode 100644 index 0000000000000000000000000000000000000000..17a358060aed2a86950757bbd25c6f92c08c458f Binary files /dev/null and b/radiant.data/docs/reference/Rplot001.png differ diff --git a/radiant.data/docs/reference/Rplot002.png b/radiant.data/docs/reference/Rplot002.png new file mode 100644 index 0000000000000000000000000000000000000000..00e8eeb4cf69d41c98c7d30a01ec410ca03cd2a3 Binary files /dev/null and b/radiant.data/docs/reference/Rplot002.png differ diff --git a/radiant.data/docs/reference/Rplot003.png b/radiant.data/docs/reference/Rplot003.png new file mode 100644 index 0000000000000000000000000000000000000000..bbeadf957a8191dd2a5117b8b4012be186522bc5 Binary files /dev/null and b/radiant.data/docs/reference/Rplot003.png differ diff --git a/radiant.data/docs/reference/Rplot004.png b/radiant.data/docs/reference/Rplot004.png new file mode 100644 index 0000000000000000000000000000000000000000..e102d5374d8e7fcaaa0629e9f4a5782e9f30d03a Binary files /dev/null and b/radiant.data/docs/reference/Rplot004.png differ diff --git a/radiant.data/docs/reference/Rplot005.png b/radiant.data/docs/reference/Rplot005.png new file mode 100644 index 0000000000000000000000000000000000000000..a5a1301b07f149a1117399cf4cfbdbc17905ec8c Binary files /dev/null and b/radiant.data/docs/reference/Rplot005.png differ diff --git a/radiant.data/docs/reference/Rplot006.png b/radiant.data/docs/reference/Rplot006.png new file mode 100644 index 0000000000000000000000000000000000000000..4538d9d120cb695ad1b78fabcc61e5518da8e2ce Binary files /dev/null and b/radiant.data/docs/reference/Rplot006.png differ diff --git a/radiant.data/docs/reference/Rplot007.png b/radiant.data/docs/reference/Rplot007.png new file mode 100644 index 0000000000000000000000000000000000000000..4e587045a2a7075fcca8b73ae53bd6c7a706c14d Binary files /dev/null and b/radiant.data/docs/reference/Rplot007.png differ diff --git a/radiant.data/docs/reference/Rplot008.png b/radiant.data/docs/reference/Rplot008.png new file mode 100644 index 0000000000000000000000000000000000000000..28502aaf39dd50e49a16bcda02fc1db3ca3c2a0e Binary files /dev/null and b/radiant.data/docs/reference/Rplot008.png differ diff --git a/radiant.data/docs/reference/add_class.html b/radiant.data/docs/reference/add_class.html new file mode 100644 index 0000000000000000000000000000000000000000..f38bd1dc7a013c3d6f3baf52a8f1ee38afc1e509 --- /dev/null +++ b/radiant.data/docs/reference/add_class.html @@ -0,0 +1,157 @@ + +Convenience function to add a class — add_class • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Convenience function to add a class

    + Source: R/radiant.R + +
    + +
    +

    Convenience function to add a class

    +
    + +
    + 
    add_class(x, cl)
    +
    + +
    +

    Arguments

    +
    x
    +

    Object

    + + +
    cl
    +

    Vector of class labels to add

    + +
    + +
    +

    Examples

    + 
    foo <- "some text" %>% add_class("text")
+foo <- "some text" %>% add_class(c("text", "another class"))
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/add_description.html b/radiant.data/docs/reference/add_description.html new file mode 100644 index 0000000000000000000000000000000000000000..4a2fdc1aa5caf0ab53893c33a990e1c5adc2774c --- /dev/null +++ b/radiant.data/docs/reference/add_description.html @@ -0,0 +1,168 @@ + +Convenience function to add a markdown description to a data.frame — add_description • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Convenience function to add a markdown description to a data.frame

    + Source: R/radiant.R + +
    + +
    +

    Convenience function to add a markdown description to a data.frame

    +
    + +
    + 
    add_description(df, md = "", path = "")
    +
    + +
    +

    Arguments

    +
    df
    +

    A data.frame or tibble

    + + +
    md
    +

    Data description in markdown format

    + + +
    path
    +

    Path to a text file with the data description in markdown format

    + +
    +
    +

    See also

    +

    See also register

    +
    + +
    +

    Examples

    + 
    if (interactive()) {
+  mt <- mtcars |> add_description(md = "# MTCARS\n\nThis data.frame contains information on ...")
+  describe(mt)
+}
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/arrange_data.html b/radiant.data/docs/reference/arrange_data.html new file mode 100644 index 0000000000000000000000000000000000000000..32a7012a4571647dbcd47364957f8b412e1c0eb9 --- /dev/null +++ b/radiant.data/docs/reference/arrange_data.html @@ -0,0 +1,161 @@ + +Arrange data with user-specified expression — arrange_data • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Arrange data with user-specified expression

    + Source: R/view.R + +
    + +
    +

    Arrange data with user-specified expression

    +
    + +
    + 
    arrange_data(dataset, expr = NULL)
    +
    + +
    +

    Arguments

    +
    dataset
    +

    Data frame to arrange

    + + +
    expr
    +

    Expression to use arrange rows from the specified dataset

    + +
    +
    +

    Value

    + + +

    Arranged data frame

    +
    +
    +

    Details

    +

    Arrange data, likely in combination with slicing

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/as_character.html b/radiant.data/docs/reference/as_character.html new file mode 100644 index 0000000000000000000000000000000000000000..7565a806511223e0c568e9118469fd1792720dce --- /dev/null +++ b/radiant.data/docs/reference/as_character.html @@ -0,0 +1,147 @@ + +Wrapper for as.character — as_character • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Wrapper for as.character

    + Source: R/transform.R + +
    + +
    +

    Wrapper for as.character

    +
    + +
    + 
    as_character(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input vector

    + +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/as_distance.html b/radiant.data/docs/reference/as_distance.html new file mode 100644 index 0000000000000000000000000000000000000000..3fda3044716aba1c17f4c34e559ba2da9cff558f --- /dev/null +++ b/radiant.data/docs/reference/as_distance.html @@ -0,0 +1,194 @@ + +Distance in kilometers or miles between two locations based on lat-long +Function based on http://www.movable-type.co.uk/scripts/latlong.html. Uses the haversine formula — as_distance • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Distance in kilometers or miles between two locations based on lat-long +Function based on http://www.movable-type.co.uk/scripts/latlong.html. Uses the haversine formula

    + Source: R/transform.R + +
    + +
    +

    Distance in kilometers or miles between two locations based on lat-long +Function based on http://www.movable-type.co.uk/scripts/latlong.html. Uses the haversine formula

    +
    + +
    + 
    as_distance(
+  lat1,
+  long1,
+  lat2,
+  long2,
+  unit = "km",
+  R = c(km = 6371, miles = 3959)[[unit]]
+)
    +
    + +
    +

    Arguments

    +
    lat1
    +

    Latitude of location 1

    + + +
    long1
    +

    Longitude of location 1

    + + +
    lat2
    +

    Latitude of location 2

    + + +
    long2
    +

    Longitude of location 2

    + + +
    unit
    +

    Measure kilometers ("km", default) or miles ("miles")

    + + +
    R
    +

    Radius of the earth

    + +
    +
    +

    Value

    + + +

    Distance between two points

    +
    + +
    +

    Examples

    + 
    as_distance(32.8245525, -117.0951632, 40.7033127, -73.979681, unit = "km")
+#> [1] 3898.601
+as_distance(32.8245525, -117.0951632, 40.7033127, -73.979681, unit = "miles")
+#> [1] 2422.628
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/as_dmy.html b/radiant.data/docs/reference/as_dmy.html new file mode 100644 index 0000000000000000000000000000000000000000..7ec1e5452d71306803aaffaf5fb8d2806acdf180 --- /dev/null +++ b/radiant.data/docs/reference/as_dmy.html @@ -0,0 +1,160 @@ + +Convert input in day-month-year format to date — as_dmy • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Convert input in day-month-year format to date

    + Source: R/transform.R + +
    + +
    +

    Convert input in day-month-year format to date

    +
    + +
    + 
    as_dmy(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + +
    +
    +

    Value

    + + +

    Date variable of class Date

    +
    + +
    +

    Examples

    + 
    as_dmy("1-2-2014")
+#> [1] "2014-02-01"
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/as_dmy_hm.html b/radiant.data/docs/reference/as_dmy_hm.html new file mode 100644 index 0000000000000000000000000000000000000000..ad46ffcf4f640072413ac4da47ef6a30a1e3a8af --- /dev/null +++ b/radiant.data/docs/reference/as_dmy_hm.html @@ -0,0 +1,159 @@ + +Convert input in day-month-year-hour-minute format to date-time — as_dmy_hm • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Convert input in day-month-year-hour-minute format to date-time

    + Source: R/transform.R + +
    + +
    +

    Convert input in day-month-year-hour-minute format to date-time

    +
    + +
    + 
    as_dmy_hm(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + +
    +
    +

    Value

    + + +

    Date-time variable of class Date

    +
    + +
    +

    Examples

    + 
    as_mdy_hm("1-1-2014 12:15")
+#> [1] "2014-01-01 12:15:00 UTC"
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/as_dmy_hms.html b/radiant.data/docs/reference/as_dmy_hms.html new file mode 100644 index 0000000000000000000000000000000000000000..cba428f32336aec11bcd3fd8fcae2cf47b878aaf --- /dev/null +++ b/radiant.data/docs/reference/as_dmy_hms.html @@ -0,0 +1,159 @@ + +Convert input in day-month-year-hour-minute-second format to date-time — as_dmy_hms • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Convert input in day-month-year-hour-minute-second format to date-time

    + Source: R/transform.R + +
    + +
    +

    Convert input in day-month-year-hour-minute-second format to date-time

    +
    + +
    + 
    as_dmy_hms(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + +
    +
    +

    Value

    + + +

    Date-time variable of class Date

    +
    + +
    +

    Examples

    + 
    as_mdy_hms("1-1-2014 12:15:01")
+#> [1] "2014-01-01 12:15:01 UTC"
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/as_duration.html b/radiant.data/docs/reference/as_duration.html new file mode 100644 index 0000000000000000000000000000000000000000..deaa0bf624724d3edb8ed455f2f6823ae59118a9 --- /dev/null +++ b/radiant.data/docs/reference/as_duration.html @@ -0,0 +1,147 @@ + +Wrapper for lubridate's as.duration function. Result converted to numeric — as_duration • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Wrapper for lubridate's as.duration function. Result converted to numeric

    + Source: R/transform.R + +
    + +
    +

    Wrapper for lubridate's as.duration function. Result converted to numeric

    +
    + +
    + 
    as_duration(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Time difference

    + +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/as_factor.html b/radiant.data/docs/reference/as_factor.html new file mode 100644 index 0000000000000000000000000000000000000000..5f363087c01c7bb76fa15f9da6ff2669d1f5e55a --- /dev/null +++ b/radiant.data/docs/reference/as_factor.html @@ -0,0 +1,151 @@ + +Wrapper for factor with ordered = FALSE — as_factor • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Wrapper for factor with ordered = FALSE

    + Source: R/transform.R + +
    + +
    +

    Wrapper for factor with ordered = FALSE

    +
    + +
    + 
    as_factor(x, ordered = FALSE)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input vector

    + + +
    ordered
    +

    Order factor levels (TRUE, FALSE)

    + +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/as_hm.html b/radiant.data/docs/reference/as_hm.html new file mode 100644 index 0000000000000000000000000000000000000000..7837c5ccc81b22957438cc3b413403e4bb00ac15 --- /dev/null +++ b/radiant.data/docs/reference/as_hm.html @@ -0,0 +1,162 @@ + +Convert input in hour-minute format to time — as_hm • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Convert input in hour-minute format to time

    + Source: R/transform.R + +
    + +
    +

    Convert input in hour-minute format to time

    +
    + +
    + 
    as_hm(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + +
    +
    +

    Value

    + + +

    Time variable of class Period

    +
    + +
    +

    Examples

    + 
    as_hm("12:45")
+#> [1] "12H 45M 0S"
+if (FALSE) {
+as_hm("12:45") %>% minute()
+}
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/as_hms.html b/radiant.data/docs/reference/as_hms.html new file mode 100644 index 0000000000000000000000000000000000000000..6217942ddbd8bb63ffd7eceb6bbb56f5b76b0d3d --- /dev/null +++ b/radiant.data/docs/reference/as_hms.html @@ -0,0 +1,163 @@ + +Convert input in hour-minute-second format to time — as_hms • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Convert input in hour-minute-second format to time

    + Source: R/transform.R + +
    + +
    +

    Convert input in hour-minute-second format to time

    +
    + +
    + 
    as_hms(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + +
    +
    +

    Value

    + + +

    Time variable of class Period

    +
    + +
    +

    Examples

    + 
    as_hms("12:45:00")
+#> [1] "12H 45M 0S"
+if (FALSE) {
+as_hms("12:45:00") %>% hour()
+as_hms("12:45:00") %>% second()
+}
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/as_integer.html b/radiant.data/docs/reference/as_integer.html new file mode 100644 index 0000000000000000000000000000000000000000..dbb458e7f665de278b169aaabc552f9fea0c0cde --- /dev/null +++ b/radiant.data/docs/reference/as_integer.html @@ -0,0 +1,173 @@ + +Convert variable to integer avoiding potential issues with factors — as_integer • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Convert variable to integer avoiding potential issues with factors

    + Source: R/transform.R + +
    + +
    +

    Convert variable to integer avoiding potential issues with factors

    +
    + +
    + 
    as_integer(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + +
    +
    +

    Value

    + + +

    Integer

    +
    + +
    +

    Examples

    + 
    as_integer(rnorm(10))
+#>  [1] 0 0 0 0 1 0 0 1 0 1
+as_integer(letters)
+#>  [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
+#> [26] 26
+as_integer(as.factor(5:10))
+#> [1]  5  6  7  8  9 10
+as.integer(as.factor(5:10))
+#> [1] 1 2 3 4 5 6
+as_integer(c("a", "b"))
+#> [1] 1 2
+as_integer(c("0", "1"))
+#> [1] 0 1
+as_integer(as.factor(c("0", "1")))
+#> [1] 0 1
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/as_mdy.html b/radiant.data/docs/reference/as_mdy.html new file mode 100644 index 0000000000000000000000000000000000000000..1f8ada1e22338c70a2b5e1e2ca3fd0a8158f882b --- /dev/null +++ b/radiant.data/docs/reference/as_mdy.html @@ -0,0 +1,168 @@ + +Convert input in month-day-year format to date — as_mdy • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Convert input in month-day-year format to date

    + Source: R/transform.R + +
    + +
    +

    Convert input in month-day-year format to date

    +
    + +
    + 
    as_mdy(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + +
    +
    +

    Value

    + + +

    Date variable of class Date

    +
    +
    +

    Details

    +

    Use as.character if x is a factor

    +
    + +
    +

    Examples

    + 
    as_mdy("2-1-2014")
+#> [1] "2014-02-01"
+if (FALSE) {
+as_mdy("2-1-2014") %>% month(label = TRUE)
+as_mdy("2-1-2014") %>% week()
+as_mdy("2-1-2014") %>% wday(label = TRUE)
+}
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/as_mdy_hm.html b/radiant.data/docs/reference/as_mdy_hm.html new file mode 100644 index 0000000000000000000000000000000000000000..045065d7a07d573ef6f26506015dd050ff4bbb65 --- /dev/null +++ b/radiant.data/docs/reference/as_mdy_hm.html @@ -0,0 +1,159 @@ + +Convert input in month-day-year-hour-minute format to date-time — as_mdy_hm • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Convert input in month-day-year-hour-minute format to date-time

    + Source: R/transform.R + +
    + +
    +

    Convert input in month-day-year-hour-minute format to date-time

    +
    + +
    + 
    as_mdy_hm(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + +
    +
    +

    Value

    + + +

    Date-time variable of class Date

    +
    + +
    +

    Examples

    + 
    as_mdy_hm("1-1-2014 12:15")
+#> [1] "2014-01-01 12:15:00 UTC"
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/as_mdy_hms.html b/radiant.data/docs/reference/as_mdy_hms.html new file mode 100644 index 0000000000000000000000000000000000000000..c19b759c0324ecc425f1b688f367893485794b85 --- /dev/null +++ b/radiant.data/docs/reference/as_mdy_hms.html @@ -0,0 +1,159 @@ + +Convert input in month-day-year-hour-minute-second format to date-time — as_mdy_hms • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Convert input in month-day-year-hour-minute-second format to date-time

    + Source: R/transform.R + +
    + +
    +

    Convert input in month-day-year-hour-minute-second format to date-time

    +
    + +
    + 
    as_mdy_hms(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + +
    +
    +

    Value

    + + +

    Date-time variable of class Date

    +
    + +
    +

    Examples

    + 
    as_mdy_hms("1-1-2014 12:15:01")
+#> [1] "2014-01-01 12:15:01 UTC"
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/as_numeric.html b/radiant.data/docs/reference/as_numeric.html new file mode 100644 index 0000000000000000000000000000000000000000..60af005bc5182a39d1977ba9a4e77d6410f6efb9 --- /dev/null +++ b/radiant.data/docs/reference/as_numeric.html @@ -0,0 +1,174 @@ + +Convert variable to numeric avoiding potential issues with factors — as_numeric • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Convert variable to numeric avoiding potential issues with factors

    + Source: R/transform.R + +
    + +
    +

    Convert variable to numeric avoiding potential issues with factors

    +
    + +
    + 
    as_numeric(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + +
    +
    +

    Value

    + + +

    Numeric

    +
    + +
    +

    Examples

    + 
    as_numeric(rnorm(10))
+#>  [1] -1.66539524  0.84589239 -0.14666561  1.15801832  0.47822510  0.15957457
+#>  [7] -0.42560129 -1.27584256  0.02811642 -0.40987108
+as_numeric(letters)
+#>  [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
+#> [26] 26
+as_numeric(as.factor(5:10))
+#> [1]  5  6  7  8  9 10
+as.numeric(as.factor(5:10))
+#> [1] 1 2 3 4 5 6
+as_numeric(c("a", "b"))
+#> [1] 1 2
+as_numeric(c("3", "4"))
+#> [1] 3 4
+as_numeric(as.factor(c("3", "4")))
+#> [1] 3 4
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/as_tibble.html b/radiant.data/docs/reference/as_tibble.html new file mode 100644 index 0000000000000000000000000000000000000000..97aefecf2d9ad8a30e14125f4439d972bf29ca61 --- /dev/null +++ b/radiant.data/docs/reference/as_tibble.html @@ -0,0 +1,215 @@ + + + + + + + + +Exporting as_tibble from tibble — as_tibble • radiant.data + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + +
    + +
    +
    +
    +

    Exporting as_tibble from tibble

    + Source: R/aaa.R + +
    + +
    +

    Exporting as_tibble from tibble

    +
    + + + +

    Details

    + +

    See as_tibble in the tibble package for more details

    + +
    + +
    + +
    +
    +

    Developed by Vincent Nijs.

    +
    + +
    +

    Site built with pkgdown 1.3.0.

    +
    +
    +
    + + + + + + + + + diff --git a/radiant.data/docs/reference/as_ymd.html b/radiant.data/docs/reference/as_ymd.html new file mode 100644 index 0000000000000000000000000000000000000000..dc469d86576961b148090173fa6e9cd94bd7a482 --- /dev/null +++ b/radiant.data/docs/reference/as_ymd.html @@ -0,0 +1,160 @@ + +Convert input in year-month-day format to date — as_ymd • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Convert input in year-month-day format to date

    + Source: R/transform.R + +
    + +
    +

    Convert input in year-month-day format to date

    +
    + +
    + 
    as_ymd(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + +
    +
    +

    Value

    + + +

    Date variable of class Date

    +
    + +
    +

    Examples

    + 
    as_ymd("2013-1-1")
+#> [1] "2013-01-01"
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/as_ymd_hm.html b/radiant.data/docs/reference/as_ymd_hm.html new file mode 100644 index 0000000000000000000000000000000000000000..e2c4fcbbef8490b4077c44287662f872259437d7 --- /dev/null +++ b/radiant.data/docs/reference/as_ymd_hm.html @@ -0,0 +1,159 @@ + +Convert input in year-month-day-hour-minute format to date-time — as_ymd_hm • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Convert input in year-month-day-hour-minute format to date-time

    + Source: R/transform.R + +
    + +
    +

    Convert input in year-month-day-hour-minute format to date-time

    +
    + +
    + 
    as_ymd_hm(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + +
    +
    +

    Value

    + + +

    Date-time variable of class Date

    +
    + +
    +

    Examples

    + 
    as_ymd_hm("2014-1-1 12:15")
+#> [1] "2014-01-01 12:15:00 UTC"
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/as_ymd_hms.html b/radiant.data/docs/reference/as_ymd_hms.html new file mode 100644 index 0000000000000000000000000000000000000000..ff323cb239a3b694267701c92d9b68d179aec660 --- /dev/null +++ b/radiant.data/docs/reference/as_ymd_hms.html @@ -0,0 +1,164 @@ + +Convert input in year-month-day-hour-minute-second format to date-time — as_ymd_hms • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Convert input in year-month-day-hour-minute-second format to date-time

    + Source: R/transform.R + +
    + +
    +

    Convert input in year-month-day-hour-minute-second format to date-time

    +
    + +
    + 
    as_ymd_hms(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + +
    +
    +

    Value

    + + +

    Date-time variable of class Date

    +
    + +
    +

    Examples

    + 
    as_ymd_hms("2014-1-1 12:15:01")
+#> [1] "2014-01-01 12:15:01 UTC"
+if (FALSE) {
+as_ymd_hms("2014-1-1 12:15:01") %>% as.Date()
+as_ymd_hms("2014-1-1 12:15:01") %>% month()
+as_ymd_hms("2014-1-1 12:15:01") %>% hour()
+}
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/avengers.html b/radiant.data/docs/reference/avengers.html new file mode 100644 index 0000000000000000000000000000000000000000..eb259d2f6738ba7e8904acd6ef66388f41ff24d8 --- /dev/null +++ b/radiant.data/docs/reference/avengers.html @@ -0,0 +1,149 @@ + +Avengers — avengers • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Avengers

    + Source: R/aaa.R + +
    + +
    +

    Avengers

    +
    + +
    + 
    data(avengers)
    +
    + +
    +

    Format

    +

    A data frame with 7 rows and 4 variables

    +
    +
    +

    Details

    +

    List of avengers. The dataset is used to illustrate data merging / joining. Description provided in attr(avengers,"description")

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/center.html b/radiant.data/docs/reference/center.html new file mode 100644 index 0000000000000000000000000000000000000000..214936327e2f9515f799c7b3887dd367ba7411fa --- /dev/null +++ b/radiant.data/docs/reference/center.html @@ -0,0 +1,157 @@ + +Center — center • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Center

    + Source: R/transform.R + +
    + +
    +

    Center

    +
    + +
    + 
    center(x, na.rm = TRUE)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + + +
    na.rm
    +

    If TRUE missing values are removed before calculation

    + +
    +
    +

    Value

    + + +

    If x is a numeric variable return x - mean(x)

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/choose_dir.html b/radiant.data/docs/reference/choose_dir.html new file mode 100644 index 0000000000000000000000000000000000000000..a8b4a5fc3deeb48470745366208dea4bc59863cc --- /dev/null +++ b/radiant.data/docs/reference/choose_dir.html @@ -0,0 +1,165 @@ + +Choose a directory interactively — choose_dir • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Choose a directory interactively

    + Source: R/radiant.R + +
    + +
    +

    Choose a directory interactively

    +
    + +
    + 
    choose_dir(...)
    +
    + +
    +

    Arguments

    +
    ...
    +

    Arguments passed to utils::choose.dir on Windows

    + +
    +
    +

    Value

    + + +

    Path to the directory selected by the user

    +
    +
    +

    Details

    +

    Open a file dialog to select a directory. Uses JavaScript on Mac, utils::choose.dir on Windows, and dirname(file.choose()) on Linux

    +
    + +
    +

    Examples

    + 
    if (FALSE) {
+choose_dir()
+}
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/choose_files.html b/radiant.data/docs/reference/choose_files.html new file mode 100644 index 0000000000000000000000000000000000000000..9bf1532530530df22cfeb55f4d47237a87046f27 --- /dev/null +++ b/radiant.data/docs/reference/choose_files.html @@ -0,0 +1,165 @@ + +Choose files interactively — choose_files • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Choose files interactively

    + Source: R/radiant.R + +
    + +
    +

    Choose files interactively

    +
    + +
    + 
    choose_files(...)
    +
    + +
    +

    Arguments

    +
    ...
    +

    Strings used to indicate which file types should be available for selection (e.g., "csv" or "pdf")

    + +
    +
    +

    Value

    + + +

    Vector of paths to files selected by the user

    +
    +
    +

    Details

    +

    Open a file dialog. Uses JavaScript on Mac, utils::choose.files on Windows, and file.choose() on Linux

    +
    + +
    +

    Examples

    + 
    if (FALSE) {
+choose_files("pdf", "csv")
+}
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/ci_label.html b/radiant.data/docs/reference/ci_label.html new file mode 100644 index 0000000000000000000000000000000000000000..2ce7c0311677b32058cf972ce6377bee758e21bd --- /dev/null +++ b/radiant.data/docs/reference/ci_label.html @@ -0,0 +1,171 @@ + +Labels for confidence intervals — ci_label • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Labels for confidence intervals

    + Source: R/radiant.R + +
    + +
    +

    Labels for confidence intervals

    +
    + +
    + 
    ci_label(alt = "two.sided", cl = 0.95, dec = 3)
    +
    + +
    +

    Arguments

    +
    alt
    +

    Type of hypothesis ("two.sided","less","greater")

    + + +
    cl
    +

    Confidence level

    + + +
    dec
    +

    Number of decimals to show

    + +
    +
    +

    Value

    + + +

    A character vector with labels for a confidence interval

    +
    + +
    +

    Examples

    + 
    ci_label("less", .95)
+#> [1] "0%"  "95%"
+ci_label("two.sided", .95)
+#> [1] "2.5%"  "97.5%"
+ci_label("greater", .9)
+#> [1] "10%"  "100%"
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/ci_perc.html b/radiant.data/docs/reference/ci_perc.html new file mode 100644 index 0000000000000000000000000000000000000000..6a0aa8f82edead99e620d0b2119c24548b9f1ada --- /dev/null +++ b/radiant.data/docs/reference/ci_perc.html @@ -0,0 +1,174 @@ + +Values at confidence levels — ci_perc • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Values at confidence levels

    + Source: R/radiant.R + +
    + +
    +

    Values at confidence levels

    +
    + +
    + 
    ci_perc(dat, alt = "two.sided", cl = 0.95)
    +
    + +
    +

    Arguments

    +
    dat
    +

    Data

    + + +
    alt
    +

    Type of hypothesis ("two.sided","less","greater")

    + + +
    cl
    +

    Confidence level

    + +
    +
    +

    Value

    + + +

    A vector with values at a confidence level

    +
    + +
    +

    Examples

    + 
    ci_perc(0:100, "less", .95)
+#> 5% 
+#>  5 
+ci_perc(0:100, "greater", .95)
+#> 95% 
+#>  95 
+ci_perc(0:100, "two.sided", .80)
+#> 10% 90% 
+#>  10  90 
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/combine_data.html b/radiant.data/docs/reference/combine_data.html new file mode 100644 index 0000000000000000000000000000000000000000..22f19c1dc036b1d199b3840d9e39f7dce29f1cec --- /dev/null +++ b/radiant.data/docs/reference/combine_data.html @@ -0,0 +1,287 @@ + +Combine datasets using dplyr's bind and join functions — combine_data • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Combine datasets using dplyr's bind and join functions

    + Source: R/combine.R + +
    + +
    +

    Combine datasets using dplyr's bind and join functions

    +
    + +
    + 
    combine_data(
+  x,
+  y,
+  by = "",
+  add = "",
+  type = "inner_join",
+  data_filter = "",
+  arr = "",
+  rows = NULL,
+  envir = parent.frame(),
+  ...
+)
    +
    + +
    +

    Arguments

    +
    x
    +

    Dataset

    + + +
    y
    +

    Dataset to combine with x

    + + +
    by
    +

    Variables used to combine `x` and `y`

    + + +
    add
    +

    Variables to add from `y`

    + + +
    type
    +

    The main bind and join types from the dplyr package are provided. inner_join returns all rows from x with matching values in y, and all columns from x and y. If there are multiple matches between x and y, all match combinations are returned. left_join returns all rows from x, and all columns from x and y. If there are multiple matches between x and y, all match combinations are returned. right_join is equivalent to a left join for datasets y and x. full_join combines two datasets, keeping rows and columns that appear in either. semi_join returns all rows from x with matching values in y, keeping just columns from x. A semi join differs from an inner join because an inner join will return one row of x for each matching row of y, whereas a semi join will never duplicate rows of x. anti_join returns all rows from x without matching values in y, keeping only columns from x. bind_rows and bind_cols are also included, as are intersect, union, and setdiff. See https://radiant-rstats.github.io/docs/data/combine.html for further details

    + + +
    data_filter
    +

    Expression used to filter the dataset. This should be a string (e.g., "price > 10000")

    + + +
    arr
    +

    Expression to arrange (sort) the data on (e.g., "color, desc(price)")

    + + +
    rows
    +

    Rows to select from the specified dataset

    + + +
    envir
    +

    Environment to extract data from

    + + +
    ...
    +

    further arguments passed to or from other methods

    + +
    +
    +

    Value

    + + +

    Combined dataset

    +
    +
    +

    Details

    +

    See https://radiant-rstats.github.io/docs/data/combine.html for an example in Radiant

    +
    + +
    +

    Examples

    + 
    avengers %>% combine_data(superheroes, type = "bind_cols")
+#> New names:
+#> • `name` -> `name...1`
+#> • `alignment` -> `alignment...2`
+#> • `gender` -> `gender...3`
+#> • `publisher` -> `publisher...4`
+#> • `name` -> `name...5`
+#> • `alignment` -> `alignment...6`
+#> • `gender` -> `gender...7`
+#> • `publisher` -> `publisher...8`
+#> # A tibble: 7 × 8
+#>   name...1        alignment...2 gender...3 publisher...4 name...5 alignment...6
+#>   <chr>           <chr>         <chr>      <chr>         <chr>    <chr>        
+#> 1 Thor            good          male       Marvel        Magneto  bad          
+#> 2 Iron Man        good          male       Marvel        Storm    good         
+#> 3 Hulk            good          male       Marvel        Mystique bad          
+#> 4 Hawkeye         good          male       Marvel        Batman   good         
+#> 5 Black Widow     good          female     Marvel        Joker    bad          
+#> 6 Captain America good          male       Marvel        Catwoman bad          
+#> 7 Magneto         bad           male       Marvel        Hellboy  good         
+#> # ℹ 2 more variables: gender...7 <chr>, publisher...8 <chr>
+combine_data(avengers, superheroes, type = "bind_cols")
+#> New names:
+#> • `name` -> `name...1`
+#> • `alignment` -> `alignment...2`
+#> • `gender` -> `gender...3`
+#> • `publisher` -> `publisher...4`
+#> • `name` -> `name...5`
+#> • `alignment` -> `alignment...6`
+#> • `gender` -> `gender...7`
+#> • `publisher` -> `publisher...8`
+#> # A tibble: 7 × 8
+#>   name...1        alignment...2 gender...3 publisher...4 name...5 alignment...6
+#>   <chr>           <chr>         <chr>      <chr>         <chr>    <chr>        
+#> 1 Thor            good          male       Marvel        Magneto  bad          
+#> 2 Iron Man        good          male       Marvel        Storm    good         
+#> 3 Hulk            good          male       Marvel        Mystique bad          
+#> 4 Hawkeye         good          male       Marvel        Batman   good         
+#> 5 Black Widow     good          female     Marvel        Joker    bad          
+#> 6 Captain America good          male       Marvel        Catwoman bad          
+#> 7 Magneto         bad           male       Marvel        Hellboy  good         
+#> # ℹ 2 more variables: gender...7 <chr>, publisher...8 <chr>
+avengers %>% combine_data(superheroes, type = "bind_rows")
+#> # A tibble: 14 × 4
+#>    name            alignment gender publisher        
+#>    <chr>           <chr>     <chr>  <chr>            
+#>  1 Thor            good      male   Marvel           
+#>  2 Iron Man        good      male   Marvel           
+#>  3 Hulk            good      male   Marvel           
+#>  4 Hawkeye         good      male   Marvel           
+#>  5 Black Widow     good      female Marvel           
+#>  6 Captain America good      male   Marvel           
+#>  7 Magneto         bad       male   Marvel           
+#>  8 Magneto         bad       male   Marvel           
+#>  9 Storm           good      female Marvel           
+#> 10 Mystique        bad       female Marvel           
+#> 11 Batman          good      male   DC               
+#> 12 Joker           bad       male   DC               
+#> 13 Catwoman        bad       female DC               
+#> 14 Hellboy         good      male   Dark Horse Comics
+avengers %>% combine_data(superheroes, add = "publisher", type = "bind_rows")
+#> # A tibble: 14 × 4
+#>    name            alignment gender publisher        
+#>    <chr>           <chr>     <chr>  <chr>            
+#>  1 Thor            good      male   Marvel           
+#>  2 Iron Man        good      male   Marvel           
+#>  3 Hulk            good      male   Marvel           
+#>  4 Hawkeye         good      male   Marvel           
+#>  5 Black Widow     good      female Marvel           
+#>  6 Captain America good      male   Marvel           
+#>  7 Magneto         bad       male   Marvel           
+#>  8 Magneto         bad       male   Marvel           
+#>  9 Storm           good      female Marvel           
+#> 10 Mystique        bad       female Marvel           
+#> 11 Batman          good      male   DC               
+#> 12 Joker           bad       male   DC               
+#> 13 Catwoman        bad       female DC               
+#> 14 Hellboy         good      male   Dark Horse Comics
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/copy_all.html b/radiant.data/docs/reference/copy_all.html new file mode 100644 index 0000000000000000000000000000000000000000..71c3a0628f7ff36be7bcb2689a72762f23bbe1f3 --- /dev/null +++ b/radiant.data/docs/reference/copy_all.html @@ -0,0 +1,156 @@ + +Source all package functions — copy_all • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Source all package functions

    + Source: R/radiant.R + +
    + +
    +

    Source all package functions

    +
    + +
    + 
    copy_all(.from)
    +
    + +
    +

    Arguments

    +
    .from
    +

    The package to pull the function from

    + +
    +
    +

    Details

    +

    Equivalent of source with local=TRUE for all package functions. Adapted from functions by smbache, author of the import package. See https://github.com/rticulate/import/issues/4/ for a discussion. This function will be deprecated when (if) it is included in https://github.com/rticulate/import/

    +
    + +
    +

    Examples

    + 
    copy_all(radiant.data)
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/copy_attr.html b/radiant.data/docs/reference/copy_attr.html new file mode 100644 index 0000000000000000000000000000000000000000..78dfd9cb3ce21458f9a73ad0416f77eb60c6313e --- /dev/null +++ b/radiant.data/docs/reference/copy_attr.html @@ -0,0 +1,155 @@ + +Copy attributes from one object to another — copy_attr • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Copy attributes from one object to another

    + Source: R/radiant.R + +
    + +
    +

    Copy attributes from one object to another

    +
    + +
    + 
    copy_attr(to, from, attr)
    +
    + +
    +

    Arguments

    +
    to
    +

    Object to copy attributes to

    + + +
    from
    +

    Object to copy attributes from

    + + +
    attr
    +

    Vector of attributes. If missing all attributes will be copied

    + +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/copy_from.html b/radiant.data/docs/reference/copy_from.html new file mode 100644 index 0000000000000000000000000000000000000000..195eb3547b5fb0e0c51aa9396b7a4e5f2fa18905 --- /dev/null +++ b/radiant.data/docs/reference/copy_from.html @@ -0,0 +1,160 @@ + +Source for package functions — copy_from • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Source for package functions

    + Source: R/radiant.R + +
    + +
    +

    Source for package functions

    +
    + +
    + 
    copy_from(.from, ...)
    +
    + +
    +

    Arguments

    +
    .from
    +

    The package to pull the function from

    + + +
    ...
    +

    Functions to pull

    + +
    +
    +

    Details

    +

    Equivalent of source with local=TRUE for package functions. Written by smbache, author of the import package. See https://github.com/rticulate/import/issues/4/ for a discussion. This function will be deprecated when (if) it is included in https://github.com/rticulate/import/

    +
    + +
    +

    Examples

    + 
    copy_from(radiant.data, get_data)
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/cv.html b/radiant.data/docs/reference/cv.html new file mode 100644 index 0000000000000000000000000000000000000000..eaf7dd01c740de419ffa91455251ef4c5458c394 --- /dev/null +++ b/radiant.data/docs/reference/cv.html @@ -0,0 +1,164 @@ + +Coefficient of variation — cv • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Coefficient of variation

    + Source: R/explore.R + +
    + +
    +

    Coefficient of variation

    +
    + +
    + 
    cv(x, na.rm = TRUE)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + + +
    na.rm
    +

    If TRUE missing values are removed before calculation

    + +
    +
    +

    Value

    + + +

    Coefficient of variation

    +
    + +
    +

    Examples

    + 
    cv(runif(100))
+#> [1] 0.5724333
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/deregister.html b/radiant.data/docs/reference/deregister.html new file mode 100644 index 0000000000000000000000000000000000000000..ae9557fe80dfeda82858f82dd06c6edcc5dcfff5 --- /dev/null +++ b/radiant.data/docs/reference/deregister.html @@ -0,0 +1,164 @@ + +Deregister a data.frame or list in Radiant — deregister • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Deregister a data.frame or list in Radiant

    + Source: R/radiant.R + +
    + +
    +

    Deregister a data.frame or list in Radiant

    +
    + +
    + 
    deregister(
+  dataset,
+  shiny = shiny::getDefaultReactiveDomain(),
+  envir = r_data,
+  info = r_info
+)
    +
    + +
    +

    Arguments

    +
    dataset
    +

    String containing the name of the data.frame to deregister

    + + +
    shiny
    +

    Check if function is called from a shiny application

    + + +
    envir
    +

    Environment to remove data from

    + + +
    info
    +

    Reactive list with information about available data in radiant

    + +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/describe.html b/radiant.data/docs/reference/describe.html new file mode 100644 index 0000000000000000000000000000000000000000..1f233220cba04380f88c59ab200900215aa0ccfa --- /dev/null +++ b/radiant.data/docs/reference/describe.html @@ -0,0 +1,155 @@ + +Show dataset description — describe • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Show dataset description

    + Source: R/radiant.R + +
    + +
    +

    Show dataset description

    +
    + +
    + 
    describe(dataset, envir = parent.frame())
    +
    + +
    +

    Arguments

    +
    dataset
    +

    Dataset with "description" attribute

    + + +
    envir
    +

    Environment to extract data from

    + +
    +
    +

    Details

    +

    Show dataset description, if available, in html form in Rstudio viewer or the default browser. The description should be in markdown format, attached to a data.frame as an attribute with the name "description"

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/diamonds.html b/radiant.data/docs/reference/diamonds.html new file mode 100644 index 0000000000000000000000000000000000000000..88d3f8f8e2499dfd833e483696c19cf93b3502f4 --- /dev/null +++ b/radiant.data/docs/reference/diamonds.html @@ -0,0 +1,149 @@ + +Diamond prices — diamonds • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Diamond prices

    + Source: R/aaa.R + +
    + +
    +

    Diamond prices

    +
    + +
    + 
    data(diamonds)
    +
    + +
    +

    Format

    +

    A data frame with 3000 rows and 10 variables

    +
    +
    +

    Details

    +

    A sample of 3,000 from the diamonds dataset bundled with ggplot2. Description provided in attr(diamonds,"description")

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/does_vary.html b/radiant.data/docs/reference/does_vary.html new file mode 100644 index 0000000000000000000000000000000000000000..a22b584730390d1a5e91e7686027280e98f8f2f5 --- /dev/null +++ b/radiant.data/docs/reference/does_vary.html @@ -0,0 +1,164 @@ + +Does a vector have non-zero variability? — does_vary • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Does a vector have non-zero variability?

    + Source: R/explore.R + +
    + +
    +

    Does a vector have non-zero variability?

    +
    + +
    + 
    does_vary(x, na.rm = TRUE)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + + +
    na.rm
    +

    If TRUE missing values are removed before calculation

    + +
    +
    +

    Value

    + + +

    Logical. TRUE is there is variability

    +
    + +
    +

    Examples

    + 
    summarise_all(diamonds, does_vary) %>% as.logical()
+#>  [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/dtab.data.frame.html b/radiant.data/docs/reference/dtab.data.frame.html new file mode 100644 index 0000000000000000000000000000000000000000..323579ad7b5b9407e8434158ae137e9a35a905a6 --- /dev/null +++ b/radiant.data/docs/reference/dtab.data.frame.html @@ -0,0 +1,242 @@ + +Create an interactive table to view, search, sort, and filter data — dtab.data.frame • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Create an interactive table to view, search, sort, and filter data

    + Source: R/view.R + +
    + +
    +

    Create an interactive table to view, search, sort, and filter data

    +
    + +
    + 
    # S3 method for data.frame
+dtab(
+  object,
+  vars = "",
+  filt = "",
+  arr = "",
+  rows = NULL,
+  nr = NULL,
+  na.rm = FALSE,
+  dec = 3,
+  perc = "",
+  filter = "top",
+  pageLength = 10,
+  dom = "",
+  style = "bootstrap4",
+  rownames = FALSE,
+  caption = NULL,
+  envir = parent.frame(),
+  ...
+)
    +
    + +
    +

    Arguments

    +
    object
    +

    Data.frame to display

    + + +
    vars
    +

    Variables to show (default is all)

    + + +
    filt
    +

    Filter to apply to the specified dataset. For example "price > 10000" if dataset is "diamonds" (default is "")

    + + +
    arr
    +

    Expression to arrange (sort) the data on (e.g., "color, desc(price)")

    + + +
    rows
    +

    Select rows in the specified dataset. For example "1:10" for the first 10 rows or "n()-10:n()" for the last 10 rows (default is NULL)

    + + +
    nr
    +

    Number of rows of data to include in the table. This function will be mainly used in reports so it is best to keep this number small

    + + +
    na.rm
    +

    Remove rows with missing values (default is FALSE)

    + + +
    dec
    +

    Number of decimal places to show. Default is no rounding (NULL)

    + + +
    perc
    +

    Vector of column names to be displayed as a percentage

    + + +
    filter
    +

    Show column filters in DT table. Options are "none", "top", "bottom"

    + + +
    pageLength
    +

    Number of rows to show in table

    + + +
    dom
    +

    Table control elements to show on the page. See https://datatables.net/reference/option/dom

    + + +
    style
    +

    Table formatting style ("bootstrap" or "default")

    + + +
    rownames
    +

    Show data.frame rownames. Default is FALSE

    + + +
    caption
    +

    Table caption

    + + +
    envir
    +

    Environment to extract data from

    + + +
    ...
    +

    Additional arguments

    + +
    +
    +

    Details

    +

    View, search, sort, and filter a data.frame. For styling options see https://rstudio.github.io/DT/functions.html

    +
    + +
    +

    Examples

    + 
    if (FALSE) {
+dtab(mtcars)
+}
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/dtab.explore.html b/radiant.data/docs/reference/dtab.explore.html new file mode 100644 index 0000000000000000000000000000000000000000..d7282e8d55c183e4f50adf9c1c3e344cb0c18324 --- /dev/null +++ b/radiant.data/docs/reference/dtab.explore.html @@ -0,0 +1,199 @@ + +Make an interactive table of summary statistics — dtab.explore • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Make an interactive table of summary statistics

    + Source: R/explore.R + +
    + +
    +

    Make an interactive table of summary statistics

    +
    + +
    + 
    # S3 method for explore
+dtab(
+  object,
+  dec = 3,
+  searchCols = NULL,
+  order = NULL,
+  pageLength = NULL,
+  caption = NULL,
+  ...
+)
    +
    + +
    +

    Arguments

    +
    object
    +

    Return value from explore

    + + +
    dec
    +

    Number of decimals to show

    + + +
    searchCols
    +

    Column search and filter

    + + +
    order
    +

    Column sorting

    + + +
    pageLength
    +

    Page length

    + + +
    caption
    +

    Table caption

    + + +
    ...
    +

    further arguments passed to or from other methods

    + +
    +
    +

    Details

    +

    See https://radiant-rstats.github.io/docs/data/explore.html for an example in Radiant

    +
    +
    +

    See also

    +

    pivotr to create a pivot table

    +

    summary.pivotr to show summaries

    +
    + +
    +

    Examples

    + 
    if (FALSE) {
+tab <- explore(diamonds, "price:x") %>% dtab()
+tab <- explore(diamonds, "price", byvar = "cut", fun = c("n_obs", "skew"), top = "byvar") %>%
+  dtab()
+}
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/dtab.html b/radiant.data/docs/reference/dtab.html new file mode 100644 index 0000000000000000000000000000000000000000..f09598f55c77e59b9ff994ff06c39148fa977ffc --- /dev/null +++ b/radiant.data/docs/reference/dtab.html @@ -0,0 +1,157 @@ + +Method to create datatables — dtab • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Method to create datatables

    + Source: R/view.R + +
    + +
    +

    Method to create datatables

    +
    + +
    + 
    dtab(object, ...)
    +
    + +
    +

    Arguments

    +
    object
    +

    Object of relevant class to render

    + + +
    ...
    +

    Additional arguments

    + +
    +
    +

    See also

    +

    See dtab.data.frame to create an interactive table from a data.frame

    +

    See dtab.explore to create an interactive table from an explore object

    +

    See dtab.pivotr to create an interactive table from a pivotr object

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/dtab.pivotr.html b/radiant.data/docs/reference/dtab.pivotr.html new file mode 100644 index 0000000000000000000000000000000000000000..b864cd9c79058cd17b429c9898df2c8113608e87 --- /dev/null +++ b/radiant.data/docs/reference/dtab.pivotr.html @@ -0,0 +1,210 @@ + +Make an interactive pivot table — dtab.pivotr • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Make an interactive pivot table

    + Source: R/pivotr.R + +
    + +
    +

    Make an interactive pivot table

    +
    + +
    + 
    # S3 method for pivotr
+dtab(
+  object,
+  format = "none",
+  perc = FALSE,
+  dec = 3,
+  searchCols = NULL,
+  order = NULL,
+  pageLength = NULL,
+  caption = NULL,
+  ...
+)
    +
    + +
    +

    Arguments

    +
    object
    +

    Return value from pivotr

    + + +
    format
    +

    Show Color bar ("color_bar"), Heat map ("heat"), or None ("none")

    + + +
    perc
    +

    Display numbers as percentages (TRUE or FALSE)

    + + +
    dec
    +

    Number of decimals to show

    + + +
    searchCols
    +

    Column search and filter

    + + +
    order
    +

    Column sorting

    + + +
    pageLength
    +

    Page length

    + + +
    caption
    +

    Table caption

    + + +
    ...
    +

    further arguments passed to or from other methods

    + +
    +
    +

    Details

    +

    See https://radiant-rstats.github.io/docs/data/pivotr.html for an example in Radiant

    +
    +
    +

    See also

    +

    pivotr to create the pivot table

    +

    summary.pivotr to print the table

    +
    + +
    +

    Examples

    + 
    if (FALSE) {
+pivotr(diamonds, cvars = "cut") %>% dtab()
+pivotr(diamonds, cvars = c("cut", "clarity")) %>% dtab(format = "color_bar")
+pivotr(diamonds, cvars = c("cut", "clarity"), normalize = "total") %>%
+  dtab(format = "color_bar", perc = TRUE)
+}
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/empty_level.html b/radiant.data/docs/reference/empty_level.html new file mode 100644 index 0000000000000000000000000000000000000000..0e243fc7d3c5937bc86c537c9505e5155cf9c1bb --- /dev/null +++ b/radiant.data/docs/reference/empty_level.html @@ -0,0 +1,153 @@ + +Convert categorical variables to factors and deal with empty/missing values — empty_level • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Convert categorical variables to factors and deal with empty/missing values

    + Source: R/explore.R + +
    + +
    +

    Convert categorical variables to factors and deal with empty/missing values

    +
    + +
    + 
    empty_level(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Categorical variable used in table

    + +
    +
    +

    Value

    + + +

    Variable with updated levels

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/explore.html b/radiant.data/docs/reference/explore.html new file mode 100644 index 0000000000000000000000000000000000000000..9c5855fed1e194f275cf289e51838817f03ba899 --- /dev/null +++ b/radiant.data/docs/reference/explore.html @@ -0,0 +1,270 @@ + +Explore and summarize data — explore • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Explore and summarize data

    + Source: R/explore.R + +
    + +
    +

    Explore and summarize data

    +
    + +
    + 
    explore(
+  dataset,
+  vars = "",
+  byvar = "",
+  fun = c("mean", "sd"),
+  top = "fun",
+  tabfilt = "",
+  tabsort = "",
+  tabslice = "",
+  nr = Inf,
+  data_filter = "",
+  arr = "",
+  rows = NULL,
+  envir = parent.frame()
+)
    +
    + +
    +

    Arguments

    +
    dataset
    +

    Dataset to explore

    + + +
    vars
    +

    (Numeric) variables to summarize

    + + +
    byvar
    +

    Variable(s) to group data by

    + + +
    fun
    +

    Functions to use for summarizing

    + + +
    top
    +

    Use functions ("fun"), variables ("vars"), or group-by variables as column headers

    + + +
    tabfilt
    +

    Expression used to filter the table (e.g., "Total > 10000")

    + + +
    tabsort
    +

    Expression used to sort the table (e.g., "desc(Total)")

    + + +
    tabslice
    +

    Expression used to filter table (e.g., "1:5")

    + + +
    nr
    +

    Number of rows to display

    + + +
    data_filter
    +

    Expression used to filter the dataset before creating the table (e.g., "price > 10000")

    + + +
    arr
    +

    Expression to arrange (sort) the data on (e.g., "color, desc(price)")

    + + +
    rows
    +

    Rows to select from the specified dataset

    + + +
    envir
    +

    Environment to extract data from

    + +
    +
    +

    Value

    + + +

    A list of all variables defined in the function as an object of class explore

    +
    +
    +

    Details

    +

    See https://radiant-rstats.github.io/docs/data/explore.html for an example in Radiant

    +
    +
    +

    See also

    +

    See summary.explore to show summaries

    +
    + +
    +

    Examples

    + 
    explore(diamonds, c("price", "carat")) %>% str()
+#> List of 13
+#>  $ tab        :'data.frame':	2 obs. of  3 variables:
+#>   ..$ variable: Factor w/ 2 levels "price","carat": 1 2
+#>   ..$ mean    : num [1:2] 3907.186 0.794
+#>   ..$ sd      : num [1:2] 3956.915 0.474
+#>   ..- attr(*, "radiant_nrow")= int 2
+#>  $ df_name    : chr "diamonds"
+#>  $ vars       : chr [1:2] "price" "carat"
+#>  $ byvar      : NULL
+#>  $ fun        : chr [1:2] "mean" "sd"
+#>  $ top        : chr "fun"
+#>  $ tabfilt    : chr ""
+#>  $ tabsort    : chr ""
+#>  $ tabslice   : chr ""
+#>  $ nr         : num Inf
+#>  $ data_filter: chr ""
+#>  $ arr        : chr ""
+#>  $ rows       : NULL
+#>  - attr(*, "class")= chr [1:2] "explore" "list"
+explore(diamonds, "price:x")$tab
+#>   variable         mean           sd
+#> 1    price 3.907186e+03 3956.9154001
+#> 2    carat 7.942833e-01    0.4738263
+#> 3  clarity 1.333333e-02    0.1147168
+#> 4      cut 3.366667e-02    0.1803998
+#> 5    color 1.273333e-01    0.3334016
+#> 6    depth 6.175267e+01    1.4460279
+#> 7    table 5.746533e+01    2.2411022
+#> 8        x 5.721823e+00    1.1240545
+explore(diamonds, c("price", "carat"), byvar = "cut", fun = c("n_missing", "skew"))$tab
+#>          cut variable n_missing      skew
+#> 1       Fair    price         0 1.5741334
+#> 2       Fair    carat         0 0.9285670
+#> 3       Good    price         0 1.4885765
+#> 4       Good    carat         0 1.0207909
+#> 5  Very Good    price         0 1.6007752
+#> 6  Very Good    carat         0 0.9370738
+#> 7    Premium    price         0 1.4131786
+#> 8    Premium    carat         0 0.9299567
+#> 9      Ideal    price         0 1.7986601
+#> 10     Ideal    carat         0 1.3654745
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/filter_data.html b/radiant.data/docs/reference/filter_data.html new file mode 100644 index 0000000000000000000000000000000000000000..1f2788e9794b70d2ac58d9cfeb7bae84e24fe4ae --- /dev/null +++ b/radiant.data/docs/reference/filter_data.html @@ -0,0 +1,192 @@ + +Filter data with user-specified expression — filter_data • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Filter data with user-specified expression

    + Source: R/view.R + +
    + +
    +

    Filter data with user-specified expression

    +
    + +
    + 
    filter_data(dataset, filt = "", drop = TRUE)
    +
    + +
    +

    Arguments

    +
    dataset
    +

    Data frame to filter

    + + +
    filt
    +

    Filter expression to apply to the specified dataset

    + + +
    drop
    +

    Drop unused factor levels after filtering (default is TRUE)

    + +
    +
    +

    Value

    + + +

    Filtered data frame

    +
    +
    +

    Details

    +

    Filters can be used to view a sample from a selected dataset. For example, runif(nrow(.)) > .9 could be used to sample approximately 10

    +
    + +
    +

    Examples

    + 
    select(diamonds, 1:3) %>% filter_data(filt = "price > max(.$price) - 100")
+#> # A tibble: 2 × 3
+#>   price carat clarity
+#>   <int> <dbl> <fct>  
+#> 1 18791  2.15 SI2    
+#> 2 18745  2.36 SI2    
+select(diamonds, 1:3) %>% filter_data(filt = "runif(nrow(.)) > .995")
+#> # A tibble: 13 × 3
+#>    price carat clarity
+#>    <int> <dbl> <fct>  
+#>  1  1895  0.51 VVS2   
+#>  2  2100  0.5  VS2    
+#>  3  6062  1.06 SI1    
+#>  4  1087  0.42 VS2    
+#>  5  7091  1.12 VVS2   
+#>  6  1240  0.4  VVS2   
+#>  7  4155  1    SI2    
+#>  8  4641  1    VS1    
+#>  9   794  0.36 SI1    
+#> 10  5939  1.01 SI1    
+#> 11  4405  1.15 SI2    
+#> 12  1300  0.38 IF     
+#> 13  5483  1.13 SI1    
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/find_dropbox.html b/radiant.data/docs/reference/find_dropbox.html new file mode 100644 index 0000000000000000000000000000000000000000..21206159c8c442aba9528ad54c461e076a1a7548 --- /dev/null +++ b/radiant.data/docs/reference/find_dropbox.html @@ -0,0 +1,157 @@ + +Find Dropbox folder — find_dropbox • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Find Dropbox folder

    + Source: R/radiant.R + +
    + +
    +

    Find Dropbox folder

    +
    + +
    + 
    find_dropbox(account = 1)
    +
    + +
    +

    Arguments

    +
    account
    +

    Integer. If multiple accounts exist, specify which one to use. By default, the first account listed is used

    + +
    +
    +

    Value

    + + +

    Path to Dropbox account

    +
    +
    +

    Details

    +

    Find the path for Dropbox if available

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/find_gdrive.html b/radiant.data/docs/reference/find_gdrive.html new file mode 100644 index 0000000000000000000000000000000000000000..bcc95030d5160a5ae80217da4e7d4397a7ba10e0 --- /dev/null +++ b/radiant.data/docs/reference/find_gdrive.html @@ -0,0 +1,151 @@ + +Find Google Drive folder — find_gdrive • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Find Google Drive folder

    + Source: R/radiant.R + +
    + +
    +

    Find Google Drive folder

    +
    + +
    + 
    find_gdrive()
    +
    + +
    +

    Value

    + + +

    Path to Google Drive folder

    +
    +
    +

    Details

    +

    Find the path for Google Drive if available

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/find_home.html b/radiant.data/docs/reference/find_home.html new file mode 100644 index 0000000000000000000000000000000000000000..7d2e9e1d88307091250e8a30506c90730acca25c --- /dev/null +++ b/radiant.data/docs/reference/find_home.html @@ -0,0 +1,145 @@ + +Find user directory — find_home • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Find user directory

    + Source: R/radiant.R + +
    + +
    +

    Find user directory

    +
    + +
    + 
    find_home()
    +
    + +
    +

    Details

    +

    Returns /Users/x and not /Users/x/Documents

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/find_project.html b/radiant.data/docs/reference/find_project.html new file mode 100644 index 0000000000000000000000000000000000000000..2e8dec87b202eea1fe4f8d19d2073be4dbd5d3ce --- /dev/null +++ b/radiant.data/docs/reference/find_project.html @@ -0,0 +1,157 @@ + +Find the Rstudio project folder — find_project • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Find the Rstudio project folder

    + Source: R/radiant.R + +
    + +
    +

    Find the Rstudio project folder

    +
    + +
    + 
    find_project(mess = TRUE)
    +
    + +
    +

    Arguments

    +
    mess
    +

    Show or hide messages (default mess = TRUE)

    + +
    +
    +

    Value

    + + +

    Path to Rstudio project folder if available or else and empty string. The returned path is normalized

    +
    +
    +

    Details

    +

    Find the path for the Rstudio project folder if available. The returned path is normalized (see normalizePath)

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/fix_names.html b/radiant.data/docs/reference/fix_names.html new file mode 100644 index 0000000000000000000000000000000000000000..6ab52dcb28114d7688e1294030cc7333d29f6fdc --- /dev/null +++ b/radiant.data/docs/reference/fix_names.html @@ -0,0 +1,161 @@ + +Ensure column names are valid — fix_names • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Ensure column names are valid

    + Source: R/manage.R + +
    + +
    +

    Ensure column names are valid

    +
    + +
    + 
    fix_names(x, lower = FALSE)
    +
    + +
    +

    Arguments

    +
    x
    +

    Data.frame or vector of (column) names

    + + +
    lower
    +

    Set letters to lower case (TRUE or FALSE)

    + +
    +
    +

    Details

    +

    Remove symbols, trailing and leading spaces, and convert to valid R column names. Opinionated version of make.names

    +
    + +
    +

    Examples

    + 
    fix_names(c(" var-name ", "$amount spent", "100"))
+#> [1] "var_name"     "amount_spent" "X100"        
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/fix_smart.html b/radiant.data/docs/reference/fix_smart.html new file mode 100644 index 0000000000000000000000000000000000000000..6c1c3f4ad5b269fdbd4f549892819e9563b26206 --- /dev/null +++ b/radiant.data/docs/reference/fix_smart.html @@ -0,0 +1,151 @@ + +Replace smart quotes etc. — fix_smart • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Replace smart quotes etc.

    + Source: R/radiant.R + +
    + +
    +

    Replace smart quotes etc.

    +
    + +
    + 
    fix_smart(text, all = FALSE)
    +
    + +
    +

    Arguments

    +
    text
    +

    Text to be parsed

    + + +
    all
    +

    Should all non-ascii characters be removed? Default is FALSE

    + +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/flip.html b/radiant.data/docs/reference/flip.html new file mode 100644 index 0000000000000000000000000000000000000000..2a401302719d659901e480ce26cfb828bdd79844 --- /dev/null +++ b/radiant.data/docs/reference/flip.html @@ -0,0 +1,185 @@ + +Flip the DT table to put Function, Variable, or Group by on top — flip • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Flip the DT table to put Function, Variable, or Group by on top

    + Source: R/explore.R + +
    + +
    +

    Flip the DT table to put Function, Variable, or Group by on top

    +
    + +
    + 
    flip(expl, top = "fun")
    +
    + +
    +

    Arguments

    +
    expl
    +

    Return value from explore

    + + +
    top
    +

    The variable (type) to display at the top of the table ("fun" for Function, "var" for Variable, and "byvar" for Group by. "fun" is the default

    + +
    +
    +

    Details

    +

    See https://radiant-rstats.github.io/docs/data/explore.html for an example in Radiant

    +
    +
    +

    See also

    +

    explore to calculate summaries

    +

    summary.explore to show summaries

    +

    dtab.explore to create the DT table

    +
    + +
    +

    Examples

    + 
    explore(diamonds, "price:x", top = "var") %>% summary()
+#> Explore
+#> Data        : diamonds 
+#> Functions   : mean, sd 
+#> Top         : Variables 
+#> 
+#>  .function     price carat clarity   cut color  depth  table     x
+#>       mean 3,907.186 0.794   0.013 0.034 0.127 61.753 57.465 5.722
+#>         sd 3,956.915 0.474   0.115 0.180 0.333  1.446  2.241 1.124
+explore(diamonds, "price", byvar = "cut", fun = c("n_obs", "skew"), top = "byvar") %>% summary()
+#> Explore
+#> Data        : diamonds 
+#> Grouped by  : cut 
+#> Functions   : n_obs, skew 
+#> Top         : Group by 
+#> 
+#>  variable function.    Fair    Good Very_Good Premium     Ideal
+#>     price     n_obs 101.000 275.000   677.000 771.000 1,176.000
+#>     price      skew   1.574   1.489     1.601   1.413     1.799
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/format_df.html b/radiant.data/docs/reference/format_df.html new file mode 100644 index 0000000000000000000000000000000000000000..eb9956dbdb8ffb9f423241c4b4cf8093a11ae842 --- /dev/null +++ b/radiant.data/docs/reference/format_df.html @@ -0,0 +1,193 @@ + +Format a data.frame with a specified number of decimal places — format_df • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Format a data.frame with a specified number of decimal places

    + Source: R/radiant.R + +
    + +
    +

    Format a data.frame with a specified number of decimal places

    +
    + +
    + 
    format_df(tbl, dec = NULL, perc = FALSE, mark = "", na.rm = FALSE, ...)
    +
    + +
    +

    Arguments

    +
    tbl
    +

    Data.frame

    + + +
    dec
    +

    Number of decimals to show

    + + +
    perc
    +

    Display numbers as percentages (TRUE or FALSE)

    + + +
    mark
    +

    Thousand separator

    + + +
    na.rm
    +

    Remove missing values

    + + +
    ...
    +

    Additional arguments for format_nr

    + +
    +
    +

    Value

    + + +

    Data.frame for printing

    +
    + +
    +

    Examples

    + 
    data.frame(x = c("a", "b"), y = c(1L, 2L), z = c(-0.0005, 3)) %>%
+  format_df(dec = 4)
+#>   x y       z
+#> 1 a 1 -0.0005
+#> 2 b 2  3.0000
+data.frame(x = c(1L, 2L), y = c(0.06, 0.8)) %>%
+  format_df(dec = 2, perc = TRUE)
+#>   x      y
+#> 1 1  6.00%
+#> 2 2 80.00%
+data.frame(x = c(1L, 2L, NA), y = c(NA, 1.008, 2.8)) %>%
+  format_df(dec = 2)
+#>    x    y
+#> 1  1   NA
+#> 2  2 1.01
+#> 3 NA 2.80
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/format_nr.html b/radiant.data/docs/reference/format_nr.html new file mode 100644 index 0000000000000000000000000000000000000000..8a4b67ffedcab11a6374c5cabb32b8f32b8bcb1d --- /dev/null +++ b/radiant.data/docs/reference/format_nr.html @@ -0,0 +1,201 @@ + +Format a number with a specified number of decimal places, thousand sep, and a symbol — format_nr • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Format a number with a specified number of decimal places, thousand sep, and a symbol

    + Source: R/radiant.R + +
    + +
    +

    Format a number with a specified number of decimal places, thousand sep, and a symbol

    +
    + +
    + 
    format_nr(x, sym = "", dec = 2, perc = FALSE, mark = ",", na.rm = TRUE, ...)
    +
    + +
    +

    Arguments

    +
    x
    +

    Number or vector

    + + +
    sym
    +

    Symbol to use

    + + +
    dec
    +

    Number of decimals to show

    + + +
    perc
    +

    Display number as a percentage

    + + +
    mark
    +

    Thousand separator

    + + +
    na.rm
    +

    Remove missing values

    + + +
    ...
    +

    Additional arguments passed to formatC

    + +
    +
    +

    Value

    + + +

    Character (vector) in the desired format

    +
    + +
    +

    Examples

    + 
    format_nr(2000, "$")
+#> [1] "$2,000.00"
+format_nr(2000, dec = 4)
+#> [1] "2,000.0000"
+format_nr(.05, perc = TRUE)
+#> [1] "5.00%"
+format_nr(c(.1, .99), perc = TRUE)
+#> [1] "10.00%" "99.00%"
+format_nr(data.frame(a = c(.1, .99)), perc = TRUE)
+#> [1] "10.00%" "99.00%"
+format_nr(data.frame(a = 1:10), sym = "$", dec = 0)
+#>  [1] "$1"  "$2"  "$3"  "$4"  "$5"  "$6"  "$7"  "$8"  "$9"  "$10"
+format_nr(c(1, 1.9, 1.008, 1.00))
+#> [1] "1.00" "1.90" "1.01" "1.00"
+format_nr(c(1, 1.9, 1.008, 1.00), drop0trailing = TRUE)
+#> [1] "1"    "1.9"  "1.01" "1"   
+format_nr(NA)
+#> [1] ""
+format_nr(NULL)
+#> [1] ""
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/get_class.html b/radiant.data/docs/reference/get_class.html new file mode 100644 index 0000000000000000000000000000000000000000..53b3860c658ca93ca41decc5bf957ac52e0cbd35 --- /dev/null +++ b/radiant.data/docs/reference/get_class.html @@ -0,0 +1,166 @@ + +Get variable class — get_class • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Get variable class

    + Source: R/radiant.R + +
    + +
    +

    Get variable class

    +
    + +
    + 
    get_class(dat)
    +
    + +
    +

    Arguments

    +
    dat
    +

    Dataset to evaluate

    + +
    +
    +

    Value

    + + +

    Vector with class information for each variable

    +
    +
    +

    Details

    +

    Get variable class information for each column in a data.frame

    +
    + +
    +

    Examples

    + 
    get_class(mtcars)
+#>       mpg       cyl      disp        hp      drat        wt      qsec        vs 
+#> "numeric" "numeric" "numeric" "numeric" "numeric" "numeric" "numeric" "numeric" 
+#>        am      gear      carb 
+#> "numeric" "numeric" "numeric" 
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/get_data.html b/radiant.data/docs/reference/get_data.html new file mode 100644 index 0000000000000000000000000000000000000000..e9b3d1f2830b19104c1d4eff867f45f7886de480 --- /dev/null +++ b/radiant.data/docs/reference/get_data.html @@ -0,0 +1,230 @@ + +Select variables and filter data — get_data • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Select variables and filter data

    + Source: R/radiant.R + +
    + +
    +

    Select variables and filter data

    +
    + +
    + 
    get_data(
+  dataset,
+  vars = "",
+  filt = "",
+  arr = "",
+  rows = NULL,
+  data_view_rows = NULL,
+  na.rm = TRUE,
+  rev = FALSE,
+  envir = c()
+)
    +
    + +
    +

    Arguments

    +
    dataset
    +

    Dataset or name of the data.frame

    + + +
    vars
    +

    Variables to extract from the data.frame

    + + +
    filt
    +

    Filter to apply to the specified dataset

    + + +
    arr
    +

    Expression to use to arrange (sort) the specified dataset

    + + +
    rows
    +

    Select rows in the specified dataset

    + + +
    data_view_rows
    +

    Vector of rows to select. Only used by Data > View in Radiant. Users should use "rows" instead

    + + +
    na.rm
    +

    Remove rows with missing values (default is TRUE)

    + + +
    rev
    +

    Reverse filter and row selection (i.e., get the remainder)

    + + +
    envir
    +

    Environment to extract data from

    + +
    +
    +

    Value

    + + +

    Data.frame with specified columns and rows

    +
    +
    +

    Details

    +

    Function is used in radiant to select variables and filter data based on user input in string form

    +
    + +
    +

    Examples

    + 
    get_data(mtcars, vars = "cyl:vs", filt = "mpg > 25")
+#>                cyl  disp  hp drat    wt  qsec vs
+#> Fiat 128         4  78.7  66 4.08 2.200 19.47  1
+#> Honda Civic      4  75.7  52 4.93 1.615 18.52  1
+#> Toyota Corolla   4  71.1  65 4.22 1.835 19.90  1
+#> Fiat X1-9        4  79.0  66 4.08 1.935 18.90  1
+#> Porsche 914-2    4 120.3  91 4.43 2.140 16.70  0
+#> Lotus Europa     4  95.1 113 3.77 1.513 16.90  1
+get_data(mtcars, vars = c("mpg", "cyl"), rows = 1:10)
+#>                    mpg cyl
+#> Mazda RX4         21.0   6
+#> Mazda RX4 Wag     21.0   6
+#> Datsun 710        22.8   4
+#> Hornet 4 Drive    21.4   6
+#> Hornet Sportabout 18.7   8
+#> Valiant           18.1   6
+#> Duster 360        14.3   8
+#> Merc 240D         24.4   4
+#> Merc 230          22.8   4
+#> Merc 280          19.2   6
+get_data(mtcars, vars = c("mpg", "cyl"), arr = "desc(mpg)", rows = "1:5")
+#>                 mpg cyl
+#> Toyota Corolla 33.9   4
+#> Fiat 128       32.4   4
+#> Honda Civic    30.4   4
+#> Lotus Europa   30.4   4
+#> Fiat X1-9      27.3   4
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/get_summary.html b/radiant.data/docs/reference/get_summary.html new file mode 100644 index 0000000000000000000000000000000000000000..412dfadf37a0492bdc415e4792816a084f7fdb9e --- /dev/null +++ b/radiant.data/docs/reference/get_summary.html @@ -0,0 +1,159 @@ + +Create data.frame summary — get_summary • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Create data.frame summary

    + Source: R/transform.R + +
    + +
    +

    Create data.frame summary

    +
    + +
    + 
    get_summary(dataset, dc = get_class(dataset), dec = 3)
    +
    + +
    +

    Arguments

    +
    dataset
    +

    Data.frame

    + + +
    dc
    +

    Class for each variable

    + + +
    dec
    +

    Number of decimals to show

    + +
    +
    +

    Details

    +

    Used in Radiant's Data > Transform tab

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/ggplotly.html b/radiant.data/docs/reference/ggplotly.html new file mode 100644 index 0000000000000000000000000000000000000000..b000c981bd310c130c8c0c46c7e3a33e1c1e2a8d --- /dev/null +++ b/radiant.data/docs/reference/ggplotly.html @@ -0,0 +1,151 @@ + +Work around to avoid (harmless) messages from ggplotly — ggplotly • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Work around to avoid (harmless) messages from ggplotly

    + Source: R/radiant.R + +
    + +
    +

    Work around to avoid (harmless) messages from ggplotly

    +
    + +
    + 
    ggplotly(...)
    +
    + +
    +

    Arguments

    +
    ...
    +

    Arguments to pass to the ggplotly function in the plotly package

    + +
    +
    +

    See also

    +

    See the ggplotly function in the plotly package for details (?plotly::ggplotly)

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/glance.html b/radiant.data/docs/reference/glance.html new file mode 100644 index 0000000000000000000000000000000000000000..3c0cd08458a3ae7b7276f511b9b6d5864be5d3eb --- /dev/null +++ b/radiant.data/docs/reference/glance.html @@ -0,0 +1,215 @@ + + + + + + + + +Exporting glance from broom — glance • radiant.data + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + +
    + +
    +
    +
    +

    Exporting glance from broom

    + Source: R/aaa.R + +
    + +
    +

    Exporting glance from broom

    +
    + + + +

    Details

    + +

    See glance in the broom package for more details

    + +
    + +
    + +
    +
    +

    Developed by Vincent Nijs.

    +
    + +
    +

    Site built with pkgdown 1.3.0.

    +
    +
    +
    + + + + + + + + + diff --git a/radiant.data/docs/reference/glue.html b/radiant.data/docs/reference/glue.html new file mode 100644 index 0000000000000000000000000000000000000000..8b532e025e293ef38e6ecd9979e40a2402ce3a27 --- /dev/null +++ b/radiant.data/docs/reference/glue.html @@ -0,0 +1,215 @@ + + + + + + + + +Exporting glue from glue — glue • radiant.data + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + +
    + +
    +
    +
    +

    Exporting glue from glue

    + Source: R/aaa.R + +
    + +
    +

    Exporting glue from glue

    +
    + + + +

    Details

    + +

    See glue in the glue package for more details

    + +
    + +
    + +
    +
    +

    Developed by Vincent Nijs.

    +
    + +
    +

    Site built with pkgdown 1.3.0.

    +
    +
    +
    + + + + + + + + + diff --git a/radiant.data/docs/reference/glue_collapse.html b/radiant.data/docs/reference/glue_collapse.html new file mode 100644 index 0000000000000000000000000000000000000000..f743380bcb1922e55990f88ede3450381d43e6d5 --- /dev/null +++ b/radiant.data/docs/reference/glue_collapse.html @@ -0,0 +1,215 @@ + + + + + + + + +Exporting glue_collapse from glue — glue_collapse • radiant.data + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + +
    + +
    +
    +
    +

    Exporting glue_collapse from glue

    + Source: R/aaa.R + +
    + +
    +

    Exporting glue_collapse from glue

    +
    + + + +

    Details

    + +

    See glue::glue_collapse() in the glue package for more details

    + +
    + +
    + +
    +
    +

    Developed by Vincent Nijs.

    +
    + +
    +

    Site built with pkgdown 1.3.0.

    +
    +
    +
    + + + + + + + + + diff --git a/radiant.data/docs/reference/glue_data.html b/radiant.data/docs/reference/glue_data.html new file mode 100644 index 0000000000000000000000000000000000000000..559e72603bb58a2cac9105863cfd00b97b1c9922 --- /dev/null +++ b/radiant.data/docs/reference/glue_data.html @@ -0,0 +1,215 @@ + + + + + + + + +Exporting glue_data from glue — glue_data • radiant.data + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + +
    + +
    +
    +
    +

    Exporting glue_data from glue

    + Source: R/aaa.R + +
    + +
    +

    Exporting glue_data from glue

    +
    + + + +

    Details

    + +

    See glue::glue_data() in the glue package for more details

    + +
    + +
    + +
    +
    +

    Developed by Vincent Nijs.

    +
    + +
    +

    Site built with pkgdown 1.3.0.

    +
    +
    +
    + + + + + + + + + diff --git a/radiant.data/docs/reference/index.html b/radiant.data/docs/reference/index.html new file mode 100644 index 0000000000000000000000000000000000000000..eabeb48976ada5b2b61a57d993c930692c2a186e --- /dev/null +++ b/radiant.data/docs/reference/index.html @@ -0,0 +1,720 @@ + +Function reference • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Reference

    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +

    Data > Manage

    +

    Functions used with Data > Manage

    +
    +

    choose_dir()

    +

    Choose a directory interactively

    +

    choose_files()

    +

    Choose files interactively

    +

    describe()

    +

    Show dataset description

    +

    find_dropbox()

    +

    Find Dropbox folder

    +

    find_gdrive()

    +

    Find Google Drive folder

    +

    find_home()

    +

    Find user directory

    +

    find_project()

    +

    Find the Rstudio project folder

    +

    fix_names()

    +

    Ensure column names are valid

    +

    get_data()

    +

    Select variables and filter data

    +

    load_clip()

    +

    Load data through clipboard on Windows or macOS

    +

    parse_path()

    +

    Parse file path into useful components

    +

    read_files()

    +

    Generate code to read a file

    +

    save_clip()

    +

    Save data to clipboard on Windows or macOS

    +

    write_parquet()

    +

    Workaround to store description file together with a parquet data file

    +

    to_fct()

    +

    Convert characters to factors

    +

    Data > View

    +

    Functions used with Data > View

    +
    +

    dtab()

    +

    Method to create datatables

    +

    dtab(<data.frame>)

    +

    Create an interactive table to view, search, sort, and filter data

    +

    filter_data()

    +

    Filter data with user-specified expression

    +

    make_arrange_cmd()

    +

    Generate arrange commands from user input

    +

    arrange_data()

    +

    Arrange data with user-specified expression

    +

    slice_data()

    +

    Slice data with user-specified expression

    +

    search_data()

    +

    Search for a pattern in all columns of a data.frame

    +

    view_data()

    +

    View data in a shiny-app

    +

    Data > Visualize

    +

    Function used with Data > Visualize

    +
    +

    visualize()

    +

    Visualize data using ggplot2 https://ggplot2.tidyverse.org/

    +

    qscatter()

    +

    Create a qscatter plot similar to Stata

    +

    ggplotly()

    +

    Work around to avoid (harmless) messages from ggplotly

    +

    subplot()

    +

    Work around to avoid (harmless) messages from subplot

    +

    Data > Pivot

    +

    Functions used with Data > Pivot

    +
    +

    pivotr()

    +

    Create a pivot table

    +

    summary(<pivotr>)

    +

    Summary method for pivotr

    +

    dtab(<pivotr>)

    +

    Make an interactive pivot table

    +

    plot(<pivotr>)

    +

    Plot method for the pivotr function

    +

    Data > Explore

    +

    Functions used with Data > Pivot

    +
    +

    explore()

    +

    Explore and summarize data

    +

    summary(<explore>)

    +

    Summary method for the explore function

    +

    dtab(<explore>)

    +

    Make an interactive table of summary statistics

    +

    flip()

    +

    Flip the DT table to put Function, Variable, or Group by on top

    +

    Data > Transform

    +

    Functions used with Data > Transform

    +
    +

    as_character()

    +

    Wrapper for as.character

    +

    as_distance()

    +

    Distance in kilometers or miles between two locations based on lat-long +Function based on http://www.movable-type.co.uk/scripts/latlong.html. Uses the haversine formula

    +

    as_dmy()

    +

    Convert input in day-month-year format to date

    +

    as_dmy_hm()

    +

    Convert input in day-month-year-hour-minute format to date-time

    +

    as_dmy_hms()

    +

    Convert input in day-month-year-hour-minute-second format to date-time

    +

    as_duration()

    +

    Wrapper for lubridate's as.duration function. Result converted to numeric

    +

    as_factor()

    +

    Wrapper for factor with ordered = FALSE

    +

    as_hm()

    +

    Convert input in hour-minute format to time

    +

    as_hms()

    +

    Convert input in hour-minute-second format to time

    +

    as_integer()

    +

    Convert variable to integer avoiding potential issues with factors

    +

    as_mdy()

    +

    Convert input in month-day-year format to date

    +

    as_mdy_hm()

    +

    Convert input in month-day-year-hour-minute format to date-time

    +

    as_mdy_hms()

    +

    Convert input in month-day-year-hour-minute-second format to date-time

    +

    as_numeric()

    +

    Convert variable to numeric avoiding potential issues with factors

    +

    as_ymd()

    +

    Convert input in year-month-day format to date

    +

    as_ymd_hm()

    +

    Convert input in year-month-day-hour-minute format to date-time

    +

    as_ymd_hms()

    +

    Convert input in year-month-day-hour-minute-second format to date-time

    +

    center()

    +

    Center

    +

    cv()

    +

    Coefficient of variation

    +

    inverse()

    +

    Calculate inverse of a variable

    +

    is.empty()

    +

    Is a variable empty

    +

    is_not()

    +

    Convenience function for is.null or is.na

    +

    is_double()

    +

    Is input a double (and not a date type)?

    +

    is_string()

    +

    Is input a string?

    +

    level_list()

    +

    Generate list of levels and unique values

    +

    ln()

    +

    Natural log

    +

    make_train()

    +

    Generate a variable used to selected a training sample

    +

    month()

    +

    Add ordered argument to lubridate::month

    +

    mutate_ext()

    +

    Add transformed variables to a data frame with the option to include a custom variable name extension

    +

    n_missing()

    +

    Number of missing values

    +

    n_obs()

    +

    Number of observations

    +

    normalize()

    +

    Normalize a variable x by a variable y

    +

    make_vec()

    +

    Convert a string of numbers into a vector

    +

    me()

    +

    Margin of error

    +

    meprop()

    +

    Margin of error for proportion

    +

    modal()

    +

    Calculate the mode (modal value) and return a label

    +

    p01() p025() p05() p10() p25() p75() p90() p95() p975() p99()

    +

    Calculate percentiles

    +

    prop()

    +

    Calculate proportion

    +

    refactor()

    +

    Remove/reorder levels

    +

    sdpop()

    +

    Standard deviation for the population

    +

    sdprop()

    +

    Standard deviation for proportion

    +

    se()

    +

    Standard error

    +

    seprop()

    +

    Standard error for proportion

    +

    show_duplicated()

    +

    Show all rows with duplicated values (not just the first or last)

    +

    square()

    +

    Calculate square of a variable

    +

    standardize()

    +

    Standardize

    +

    store()

    +

    Method to store variables in a dataset in Radiant

    +

    table2data()

    +

    Create data.frame from a table

    +

    varpop()

    +

    Variance for the population

    +

    varprop()

    +

    Variance for proportion

    +

    wday()

    +

    Add ordered argument to lubridate::wday

    +

    weighted.sd()

    +

    Weighted standard deviation

    +

    which.pmax()

    +

    Index of the maximum per row

    +

    which.pmin()

    +

    Index of the minimum per row

    +

    pfun() psum() pmean() pmedian() psd() pvar() pcv() pp01() pp025() pp05() pp10() pp25() pp75() pp95() pp975() pp99()

    +

    Summarize a set of numeric vectors per row

    +

    xtile()

    +

    Split a numeric variable into a number of bins and return a vector of bin numbers

    +

    Data > Combine

    +

    Functions used with Data > Combine

    +
    +

    combine_data()

    +

    Combine datasets using dplyr's bind and join functions

    +

    Report

    +

    Functions used with Report > Rmd and Report > R

    +
    +

    fix_smart()

    +

    Replace smart quotes etc.

    +

    format_df()

    +

    Format a data.frame with a specified number of decimal places

    +

    format_nr()

    +

    Format a number with a specified number of decimal places, thousand sep, and a symbol

    +

    round_df()

    +

    Round doubles in a data.frame to a specified number of decimal places

    +

    register()

    +

    Register a data.frame or list in Radiant

    +

    deregister()

    +

    Deregister a data.frame or list in Radiant

    +

    render()

    +

    Base method used to render htmlwidgets

    +

    render(<datatables>)

    +

    Method to render DT tables

    +

    render(<plotly>)

    +

    Method to render plotly plots

    +

    Convenience functions

    +

    Convenience functions

    +
    +

    add_class()

    +

    Convenience function to add a class

    +

    add_description()

    +

    Convenience function to add a markdown description to a data.frame

    +

    get_class()

    +

    Get variable class

    +

    ci_label()

    +

    Labels for confidence intervals

    +

    ci_perc()

    +

    Values at confidence levels

    +

    copy_all()

    +

    Source all package functions

    +

    copy_attr()

    +

    Copy attributes from one object to another

    +

    copy_from()

    +

    Source for package functions

    +

    does_vary()

    +

    Does a vector have non-zero variability?

    +

    empty_level()

    +

    Convert categorical variables to factors and deal with empty/missing values

    +

    get_summary()

    +

    Create data.frame summary

    +

    indexr()

    +

    Find index corrected for missing values and filters

    +

    install_webshot()

    +

    Install webshot and phantomjs

    +

    iterms()

    +

    Create a vector of interaction terms for linear and logistic regression

    +

    qterms()

    +

    Create a vector of quadratic and cubed terms for use in linear and logistic regression

    +

    set_attr()

    +

    Alias used to add an attribute

    +

    sig_stars()

    +

    Add stars based on p.values

    +

    sshh()

    +

    Hide warnings and messages and return invisible

    +

    sshhr()

    +

    Hide warnings and messages and return result

    +

    Starting radiant.data

    +

    Functions used to start radiant shiny apps

    +
    +

    launch()

    +

    Launch radiant apps

    +

    radiant.data()

    +

    radiant.data

    +

    radiant.data_url()

    +

    Start radiant.data app but do not open a browser

    +

    radiant.data_viewer()

    +

    Launch the radiant.data app in the Rstudio viewer

    +

    radiant.data_window()

    +

    Launch the radiant.data app in an Rstudio window

    +

    Re-exported

    +

    Functions exported from other packages

    +
    +

    reexports theme_version bs_theme wrap_plots plot_annotation writePNG glue glue_data glue_collapse knit_print rownames_to_column tibble as_tibble tidy glance kurtosi skew date

    +

    Objects exported from other packages

    +

    Data sets

    +

    Data sets bundled with radiant.data

    +
    +

    avengers

    +

    Avengers

    +

    diamonds

    +

    Diamond prices

    +

    publishers

    +

    Comic publishers

    +

    superheroes

    +

    Super heroes

    +

    titanic

    +

    Survival data for the Titanic

    +

    Deprecated

    +

    Deprecated

    +
    +

    mean_rm()

    +

    Deprecated function(s) in the radiant.data package

    +

    store(<pivotr>)

    +

    Deprecated: Store method for the pivotr function

    +

    store(<explore>)

    +

    Deprecated: Store method for the explore function

    + + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/indexr.html b/radiant.data/docs/reference/indexr.html new file mode 100644 index 0000000000000000000000000000000000000000..969b8cd54ac750080062e66b46dd6feaf7831d46 --- /dev/null +++ b/radiant.data/docs/reference/indexr.html @@ -0,0 +1,167 @@ + +Find index corrected for missing values and filters — indexr • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Find index corrected for missing values and filters

    + Source: R/radiant.R + +
    + +
    +

    Find index corrected for missing values and filters

    +
    + +
    + 
    indexr(dataset, vars = "", filt = "", arr = "", rows = NULL, cmd = "")
    +
    + +
    +

    Arguments

    +
    dataset
    +

    Dataset

    + + +
    vars
    +

    Variables to select

    + + +
    filt
    +

    Data filter

    + + +
    arr
    +

    Expression to arrange (sort) the data on (e.g., "color, desc(price)")

    + + +
    rows
    +

    Selected rows

    + + +
    cmd
    +

    A command used to customize the data

    + +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/install_webshot.html b/radiant.data/docs/reference/install_webshot.html new file mode 100644 index 0000000000000000000000000000000000000000..a9bca37723090eea81cdcbc15cebf9a497a0101f --- /dev/null +++ b/radiant.data/docs/reference/install_webshot.html @@ -0,0 +1,141 @@ + +Install webshot and phantomjs — install_webshot • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Install webshot and phantomjs

    + Source: R/radiant.R + +
    + +
    +

    Install webshot and phantomjs

    +
    + +
    + 
    install_webshot()
    +
    + + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/inverse.html b/radiant.data/docs/reference/inverse.html new file mode 100644 index 0000000000000000000000000000000000000000..7ea07f45cea370c3aa4c9b41a81d57ecd63636e3 --- /dev/null +++ b/radiant.data/docs/reference/inverse.html @@ -0,0 +1,153 @@ + +Calculate inverse of a variable — inverse • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Calculate inverse of a variable

    + Source: R/transform.R + +
    + +
    +

    Calculate inverse of a variable

    +
    + +
    + 
    inverse(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + +
    +
    +

    Value

    + + +

    1/x

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/is.empty.html b/radiant.data/docs/reference/is.empty.html new file mode 100644 index 0000000000000000000000000000000000000000..f0efd1151b3756edf3db8bb4702c46462145a3c8 --- /dev/null +++ b/radiant.data/docs/reference/is.empty.html @@ -0,0 +1,187 @@ + +Is a variable empty — is.empty • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Is a variable empty

    + Source: R/radiant.R + +
    + +
    +

    Is a variable empty

    +
    + +
    + 
    is.empty(x, empty = "\\s*")
    +
    + +
    +

    Arguments

    +
    x
    +

    Character value to evaluate

    + + +
    empty
    +

    Indicate what 'empty' means. Default is empty string (i.e., "")

    + +
    +
    +

    Value

    + + +

    TRUE if empty, else FALSE

    +
    +
    +

    Details

    +

    Is a variable empty

    +
    + +
    +

    Examples

    + 
    is.empty("")
+#> [1] TRUE
+is.empty(NULL)
+#> [1] TRUE
+is.empty(NA)
+#> [1] TRUE
+is.empty(c())
+#> [1] TRUE
+is.empty("none", empty = "none")
+#> [1] TRUE
+is.empty("")
+#> [1] TRUE
+is.empty("   ")
+#> [1] TRUE
+is.empty(" something  ")
+#> [1] FALSE
+is.empty(c("", "something"))
+#> [1] FALSE
+is.empty(c(NA, 1:100))
+#> [1] FALSE
+is.empty(mtcars)
+#> [1] FALSE
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/is_double.html b/radiant.data/docs/reference/is_double.html new file mode 100644 index 0000000000000000000000000000000000000000..8f583c99a4c10ec553ef5dd3e8d240a01795c395 --- /dev/null +++ b/radiant.data/docs/reference/is_double.html @@ -0,0 +1,153 @@ + +Is input a double (and not a date type)? — is_double • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Is input a double (and not a date type)?

    + Source: R/radiant.R + +
    + +
    +

    Is input a double (and not a date type)?

    +
    + +
    + 
    is_double(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input

    + +
    +
    +

    Value

    + + +

    TRUE if double and not a type of date, else FALSE

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/is_empty.html b/radiant.data/docs/reference/is_empty.html new file mode 100644 index 0000000000000000000000000000000000000000..d08974d6a0e83af8060741f41387e009ec868d68 --- /dev/null +++ b/radiant.data/docs/reference/is_empty.html @@ -0,0 +1,182 @@ + +Is a character variable defined — is_empty • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Is a character variable defined

    + Source: R/radiant.R + +
    + +
    +

    Is a character variable defined

    +
    + +
    + 
    is_empty(x, empty = "\\s*")
    +
    + +
    +

    Arguments

    +
    x
    +

    Character value to evaluate

    +
    empty
    +

    Indicate what 'empty' means. Default is empty string (i.e., "")

    +
    +
    +

    Value

    +

    TRUE if empty, else FALSE

    +
    +
    +

    Details

    +

    Is a variable NULL or an empty string

    +
    + +
    +

    Examples

    + 
    is_empty("")
+#> [1] TRUE
+is_empty(NULL)
+#> [1] TRUE
+is_empty(NA)
+#> [1] TRUE
+is_empty(c())
+#> [1] TRUE
+is_empty("none", empty = "none")
+#> [1] TRUE
+is_empty("")
+#> [1] TRUE
+is_empty("   ")
+#> [1] TRUE
+is_empty(" something  ")
+#> [1] FALSE
+is_empty(c("", "something"))
+#> [1] FALSE
+is_empty(c(NA, 1:100))
+#> [1] FALSE
+is_empty(mtcars)
+#> [1] FALSE
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs.

    +
    + +
    +

    Site built with pkgdown 2.0.3.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/is_not.html b/radiant.data/docs/reference/is_not.html new file mode 100644 index 0000000000000000000000000000000000000000..a34501f1a78f555d92149a3218c3cd6df4000966 --- /dev/null +++ b/radiant.data/docs/reference/is_not.html @@ -0,0 +1,161 @@ + +Convenience function for is.null or is.na — is_not • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Convenience function for is.null or is.na

    + Source: R/radiant.R + +
    + +
    +

    Convenience function for is.null or is.na

    +
    + +
    + 
    is_not(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input

    + +
    + +
    +

    Examples

    + 
    is_not(NA)
+#> [1] TRUE
+is_not(NULL)
+#> [1] TRUE
+is_not(c())
+#> [1] TRUE
+is_not(list())
+#> [1] TRUE
+is_not(data.frame())
+#> [1] TRUE
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/is_string.html b/radiant.data/docs/reference/is_string.html new file mode 100644 index 0000000000000000000000000000000000000000..25e60e7ae6ab6e6a728e9342d31d3fd5a57e6118 --- /dev/null +++ b/radiant.data/docs/reference/is_string.html @@ -0,0 +1,167 @@ + +Is input a string? — is_string • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Is input a string?

    + Source: R/radiant.R + +
    + +
    +

    Is input a string?

    +
    + +
    + 
    is_string(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input

    + +
    +
    +

    Value

    + + +

    TRUE if string, else FALSE

    +
    + +
    +

    Examples

    + 
    is_string("   ")
+#> [1] FALSE
+is_string("data")
+#> [1] TRUE
+is_string(c("data", ""))
+#> [1] FALSE
+is_string(NULL)
+#> [1] FALSE
+is_string(NA)
+#> [1] FALSE
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/iterms.html b/radiant.data/docs/reference/iterms.html new file mode 100644 index 0000000000000000000000000000000000000000..a822c942502fd065c43fcc0ea38b44813621509e --- /dev/null +++ b/radiant.data/docs/reference/iterms.html @@ -0,0 +1,171 @@ + +Create a vector of interaction terms for linear and logistic regression — iterms • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Create a vector of interaction terms for linear and logistic regression

    + Source: R/radiant.R + +
    + +
    +

    Create a vector of interaction terms for linear and logistic regression

    +
    + +
    + 
    iterms(vars, nway = 2, sep = ":")
    +
    + +
    +

    Arguments

    +
    vars
    +

    Labels to use

    + + +
    nway
    +

    2-way (2) or 3-way (3) interaction labels to create

    + + +
    sep
    +

    Separator to use between variable names (e.g., :)

    + +
    +
    +

    Value

    + + +

    Character vector of interaction term labels

    +
    + +
    +

    Examples

    + 
    paste0("var", 1:3) %>% iterms(2)
+#> [1] "var1:var2" "var1:var3" "var2:var3"
+paste0("var", 1:3) %>% iterms(3)
+#> [1] "var1:var2"      "var1:var3"      "var2:var3"      "var1:var2:var3"
+paste0("var", 1:3) %>% iterms(2, sep = ".")
+#> [1] "var1.var2" "var1.var3" "var2.var3"
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/knit_print.html b/radiant.data/docs/reference/knit_print.html new file mode 100644 index 0000000000000000000000000000000000000000..fc71b1071aefe65dc31af6895e619849d916b956 --- /dev/null +++ b/radiant.data/docs/reference/knit_print.html @@ -0,0 +1,215 @@ + + + + + + + + +Exporting knit_print from knitr — knit_print • radiant.data + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + +
    + +
    +
    +
    +

    Exporting knit_print from knitr

    + Source: R/aaa.R + +
    + +
    +

    Exporting knit_print from knitr

    +
    + + + +

    Details

    + +

    See knit_print in the knitr package for more details

    + +
    + +
    + +
    +
    +

    Developed by Vincent Nijs.

    +
    + +
    +

    Site built with pkgdown 1.3.0.

    +
    +
    +
    + + + + + + + + + diff --git a/radiant.data/docs/reference/kurtosi.re.html b/radiant.data/docs/reference/kurtosi.re.html new file mode 100644 index 0000000000000000000000000000000000000000..c43f4f077def4c22fe168ef68c6886e126cd16a7 --- /dev/null +++ b/radiant.data/docs/reference/kurtosi.re.html @@ -0,0 +1,215 @@ + + + + + + + + +Exporting kurtosi from psych — kurtosi • radiant.data + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + +
    + +
    +
    +
    +

    Exporting kurtosi from psych

    + Source: R/aaa.R + +
    + +
    +

    Exporting kurtosi from psych

    +
    + + + +

    Details

    + +

    See kurtosi in the psych package for more details

    + +
    + +
    + +
    +
    +

    Developed by Vincent Nijs.

    +
    + +
    +

    Site built with pkgdown 1.3.0.

    +
    +
    +
    + + + + + + + + + diff --git a/radiant.data/docs/reference/launch.html b/radiant.data/docs/reference/launch.html new file mode 100644 index 0000000000000000000000000000000000000000..1b88a89e532cea12faef934a20c5c7b4aa3d0065 --- /dev/null +++ b/radiant.data/docs/reference/launch.html @@ -0,0 +1,174 @@ + +Launch radiant apps — launch • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Launch radiant apps

    + Source: R/radiant.R + +
    + +
    +

    Launch radiant apps

    +
    + +
    + 
    launch(package = "radiant.data", run = "viewer", state, ...)
    +
    + +
    +

    Arguments

    +
    package
    +

    Radiant package to start. One of "radiant.data", "radiant.design", "radiant.basics", "radiant.model", "radiant.multivariate", or "radiant"

    + + +
    run
    +

    Run a radiant app in an external browser ("browser"), an Rstudio window ("window"), or in the Rstudio viewer ("viewer")

    + + +
    state
    +

    Path to statefile to load

    + + +
    ...
    +

    additional arguments to pass to shiny::runApp (e.g, port = 8080)

    + +
    +
    +

    Details

    +

    See https://radiant-rstats.github.io/docs/ for radiant documentation and tutorials

    +
    + +
    +

    Examples

    + 
    if (FALSE) {
+launch()
+launch(run = "viewer")
+launch(run = "window")
+launch(run = "browser")
+}
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/level_list.html b/radiant.data/docs/reference/level_list.html new file mode 100644 index 0000000000000000000000000000000000000000..bdf0153f3a9114bef159d296fdaf89155ee90219 --- /dev/null +++ b/radiant.data/docs/reference/level_list.html @@ -0,0 +1,171 @@ + +Generate list of levels and unique values — level_list • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Generate list of levels and unique values

    + Source: R/transform.R + +
    + +
    +

    Generate list of levels and unique values

    +
    + +
    + 
    level_list(dataset, ...)
    +
    + +
    +

    Arguments

    +
    dataset
    +

    A data.frame

    + + +
    ...
    +

    Unquoted variable names to evaluate

    + +
    + +
    +

    Examples

    + 
    data.frame(a = c(rep("a", 5), rep("b", 5)), b = c(rep(1, 5), 6:10)) %>% level_list()
+#> $a
+#> [1] "a" "b"
+#> 
+#> $b
+#> [1]  1  6  7  8  9 10
+#> 
+level_list(mtcars, mpg, cyl)
+#> $mpg
+#>  [1] 21.0 22.8 21.4 18.7 18.1 14.3 24.4 19.2 17.8 16.4 17.3 15.2 10.4 14.7 32.4
+#> [16] 30.4 33.9 21.5 15.5 13.3 27.3 26.0 15.8 19.7 15.0
+#> 
+#> $cyl
+#> [1] 6 4 8
+#> 
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/ln.html b/radiant.data/docs/reference/ln.html new file mode 100644 index 0000000000000000000000000000000000000000..6fa224ac8cdae16a4cabf807ec4ca78951423ee3 --- /dev/null +++ b/radiant.data/docs/reference/ln.html @@ -0,0 +1,165 @@ + +Natural log — ln • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Natural log

    + Source: R/explore.R + +
    + +
    +

    Natural log

    +
    + +
    + 
    ln(x, na.rm = TRUE)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + + +
    na.rm
    +

    Remove missing values (default is TRUE)

    + +
    +
    +

    Value

    + + +

    Natural log of vector

    +
    + +
    +

    Examples

    + 
    ln(runif(10, 1, 2))
+#>  [1] 0.4846652 0.6214164 0.5995395 0.4299635 0.3771382 0.2102091 0.5922178
+#>  [8] 0.2149426 0.5359432 0.2461529
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/load_clip.html b/radiant.data/docs/reference/load_clip.html new file mode 100644 index 0000000000000000000000000000000000000000..9f95a9892e34387c0ee03995779e8866405c24a7 --- /dev/null +++ b/radiant.data/docs/reference/load_clip.html @@ -0,0 +1,163 @@ + +Load data through clipboard on Windows or macOS — load_clip • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Load data through clipboard on Windows or macOS

    + Source: R/manage.R + +
    + +
    +

    Load data through clipboard on Windows or macOS

    +
    + +
    + 
    load_clip(delim = "\t", text, suppress = TRUE)
    +
    + +
    +

    Arguments

    +
    delim
    +

    Delimiter to use (tab is the default)

    + + +
    text
    +

    Text input to convert to table

    + + +
    suppress
    +

    Suppress warnings

    + +
    +
    +

    Details

    +

    Extract data from the clipboard into a data.frame on Windows or macOS

    +
    +
    +

    See also

    +

    See the save_clip

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/make_arrange_cmd.html b/radiant.data/docs/reference/make_arrange_cmd.html new file mode 100644 index 0000000000000000000000000000000000000000..c2aa3276fa241bd002bd653ffb8177779557f75f --- /dev/null +++ b/radiant.data/docs/reference/make_arrange_cmd.html @@ -0,0 +1,161 @@ + +Generate arrange commands from user input — make_arrange_cmd • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Generate arrange commands from user input

    + Source: R/view.R + +
    + +
    +

    Generate arrange commands from user input

    +
    + +
    + 
    make_arrange_cmd(expr, dataset = "")
    +
    + +
    +

    Arguments

    +
    expr
    +

    Expression to use arrange rows from the specified dataset

    + + +
    dataset
    +

    String with dataset name

    + +
    +
    +

    Value

    + + +

    Arrange command

    +
    +
    +

    Details

    +

    Form arrange command from user input

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/make_train.html b/radiant.data/docs/reference/make_train.html new file mode 100644 index 0000000000000000000000000000000000000000..4b682edb388cb7845448385bb936d12fb6fcbc2f --- /dev/null +++ b/radiant.data/docs/reference/make_train.html @@ -0,0 +1,192 @@ + +Generate a variable used to selected a training sample — make_train • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Generate a variable used to selected a training sample

    + Source: R/transform.R + +
    + +
    +

    Generate a variable used to selected a training sample

    +
    + +
    + 
    make_train(n = 0.7, nr = NULL, blocks = NULL, seed = 1234)
    +
    + +
    +

    Arguments

    +
    n
    +

    Number (or fraction) of observations to label as training

    + + +
    nr
    +

    Number of rows in the dataset

    + + +
    blocks
    +

    A vector to use for blocking or a data.frame from which to construct a blocking vector

    + + +
    seed
    +

    Random seed

    + +
    +
    +

    Value

    + + +

    0/1 variables for filtering

    +
    + +
    +

    Examples

    + 
    make_train(.5, 10)
+#>  [1] 1 1 0 0 0 1 0 1 1 0
+make_train(.5, 10) %>% table()
+#> .
+#> 0 1 
+#> 5 5 
+make_train(100, 1000) %>% table()
+#> .
+#>   0   1 
+#> 900 100 
+make_train(.15, blocks = mtcars$vs) %>% table() / nrow(mtcars)
+#> .
+#>       0       1 
+#> 0.84375 0.15625 
+make_train(.10, blocks = iris$Species) %>% table() / nrow(iris)
+#> .
+#>   0   1 
+#> 0.9 0.1 
+make_train(.5, blocks = iris[, c("Petal.Width", "Species")]) %>% table()
+#> .
+#>  0  1 
+#> 75 75 
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/make_vec.html b/radiant.data/docs/reference/make_vec.html new file mode 100644 index 0000000000000000000000000000000000000000..9239d95e8f64cc00c9a55cc7f56fed674dd1bb5e --- /dev/null +++ b/radiant.data/docs/reference/make_vec.html @@ -0,0 +1,157 @@ + +Convert a string of numbers into a vector — make_vec • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Convert a string of numbers into a vector

    + Source: R/transform.R + +
    + +
    +

    Convert a string of numbers into a vector

    +
    + +
    + 
    make_vec(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    A string of numbers that may include fractions

    + +
    + +
    +

    Examples

    + 
    make_vec("1 2 4")
+#> [1] 1 2 4
+make_vec("1/2 2/3 4/5")
+#> [1] 1/2 2/3 4/5
+make_vec(0.1)
+#> [1] 0.1
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/me.html b/radiant.data/docs/reference/me.html new file mode 100644 index 0000000000000000000000000000000000000000..9492525709bcaeae26ba63c7da65399852e83459 --- /dev/null +++ b/radiant.data/docs/reference/me.html @@ -0,0 +1,168 @@ + +Margin of error — me • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Margin of error

    + Source: R/explore.R + +
    + +
    +

    Margin of error

    +
    + +
    + 
    me(x, conf_lev = 0.95, na.rm = TRUE)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + + +
    conf_lev
    +

    Confidence level. The default is 0.95

    + + +
    na.rm
    +

    If TRUE missing values are removed before calculation

    + +
    +
    +

    Value

    + + +

    Margin of error

    +
    + +
    +

    Examples

    + 
    me(rnorm(100))
+#> [1] 0.2048265
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/meprop.html b/radiant.data/docs/reference/meprop.html new file mode 100644 index 0000000000000000000000000000000000000000..aab1483e0f48e849e9f56eb95a90ec508e2ecd3f --- /dev/null +++ b/radiant.data/docs/reference/meprop.html @@ -0,0 +1,168 @@ + +Margin of error for proportion — meprop • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Margin of error for proportion

    + Source: R/explore.R + +
    + +
    +

    Margin of error for proportion

    +
    + +
    + 
    meprop(x, conf_lev = 0.95, na.rm = TRUE)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + + +
    conf_lev
    +

    Confidence level. The default is 0.95

    + + +
    na.rm
    +

    If TRUE missing values are removed before calculation

    + +
    +
    +

    Value

    + + +

    Margin of error

    +
    + +
    +

    Examples

    + 
    meprop(c(rep(1L, 10), rep(0L, 10)))
+#> [1] 0.2191306
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/modal.html b/radiant.data/docs/reference/modal.html new file mode 100644 index 0000000000000000000000000000000000000000..3705658ef8a76b942597f99690fdd97b4315cb6d --- /dev/null +++ b/radiant.data/docs/reference/modal.html @@ -0,0 +1,169 @@ + +Calculate the mode (modal value) and return a label — modal • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Calculate the mode (modal value) and return a label

    + Source: R/explore.R + +
    + +
    +

    Calculate the mode (modal value) and return a label

    +
    + +
    + 
    modal(x, na.rm = TRUE)
    +
    + +
    +

    Arguments

    +
    x
    +

    A vector

    + + +
    na.rm
    +

    If TRUE missing values are removed before calculation

    + +
    +
    +

    Details

    +

    From https://www.tutorialspoint.com/r/r_mean_median_mode.htm

    +
    + +
    +

    Examples

    + 
    modal(c("a", "b", "b"))
+#> [1] "b"
+modal(c(1:10, 5))
+#> [1] 5
+modal(as.factor(c(letters, "b")))
+#> [1] b
+#> Levels: a b c d e f g h i j k l m n o p q r s t u v w x y z
+modal(runif(100) > 0.5)
+#> [1] TRUE
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/month.html b/radiant.data/docs/reference/month.html new file mode 100644 index 0000000000000000000000000000000000000000..a39ad6a664e38dc260bf7b55cc52d08fc2456175 --- /dev/null +++ b/radiant.data/docs/reference/month.html @@ -0,0 +1,163 @@ + +Add ordered argument to lubridate::month — month • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Add ordered argument to lubridate::month

    + Source: R/transform.R + +
    + +
    +

    Add ordered argument to lubridate::month

    +
    + +
    + 
    month(x, label = FALSE, abbr = TRUE, ordered = FALSE)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input date vector

    + + +
    label
    +

    Month as label (TRUE, FALSE)

    + + +
    abbr
    +

    Abbreviate label (TRUE, FALSE)

    + + +
    ordered
    +

    Order factor (TRUE, FALSE)

    + +
    +
    +

    See also

    +

    See the month function in the lubridate package for additional details

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/mutate_ext.html b/radiant.data/docs/reference/mutate_ext.html new file mode 100644 index 0000000000000000000000000000000000000000..e76ab15944f2606eac7d820a6e6f23bddd475b5e --- /dev/null +++ b/radiant.data/docs/reference/mutate_ext.html @@ -0,0 +1,473 @@ + +Add transformed variables to a data frame with the option to include a custom variable name extension — mutate_ext • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Add transformed variables to a data frame with the option to include a custom variable name extension

    + Source: R/transform.R + +
    + +
    +

    Add transformed variables to a data frame with the option to include a custom variable name extension

    +
    + +
    + 
    mutate_ext(.tbl, .funs, ..., .ext = "", .vars = c())
    +
    + +
    +

    Arguments

    +
    .tbl
    +

    Data frame to add transformed variables to

    + + +
    .funs
    +

    Function(s) to apply (e.g., log)

    + + +
    ...
    +

    Variables to transform

    + + +
    .ext
    +

    Extension to add for each variable

    + + +
    .vars
    +

    A list of columns generated by dplyr::vars(), or a character vector of column names, or a numeric vector of column positions.

    + +
    +
    +

    Details

    +

    Wrapper for dplyr::mutate_at that allows custom variable name extensions

    +
    + +
    +

    Examples

    + 
    mutate_ext(mtcars, .funs = log, mpg, cyl, .ext = "_ln")
+#>                      mpg cyl  disp  hp drat    wt  qsec vs am gear carb
+#> Mazda RX4           21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4
+#> Mazda RX4 Wag       21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4
+#> Datsun 710          22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1
+#> Hornet 4 Drive      21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
+#> Hornet Sportabout   18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
+#> Valiant             18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1
+#> Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4
+#> Merc 240D           24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2
+#> Merc 230            22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2
+#> Merc 280            19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4
+#> Merc 280C           17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4
+#> Merc 450SE          16.4   8 275.8 180 3.07 4.070 17.40  0  0    3    3
+#> Merc 450SL          17.3   8 275.8 180 3.07 3.730 17.60  0  0    3    3
+#> Merc 450SLC         15.2   8 275.8 180 3.07 3.780 18.00  0  0    3    3
+#> Cadillac Fleetwood  10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4
+#> Lincoln Continental 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4
+#> Chrysler Imperial   14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4
+#> Fiat 128            32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1
+#> Honda Civic         30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2
+#> Toyota Corolla      33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1
+#> Toyota Corona       21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1
+#> Dodge Challenger    15.5   8 318.0 150 2.76 3.520 16.87  0  0    3    2
+#> AMC Javelin         15.2   8 304.0 150 3.15 3.435 17.30  0  0    3    2
+#> Camaro Z28          13.3   8 350.0 245 3.73 3.840 15.41  0  0    3    4
+#> Pontiac Firebird    19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2
+#> Fiat X1-9           27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1
+#> Porsche 914-2       26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2
+#> Lotus Europa        30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
+#> Ford Pantera L      15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4
+#> Ferrari Dino        19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6
+#> Maserati Bora       15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8
+#> Volvo 142E          21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2
+#>                       mpg_ln   cyl_ln
+#> Mazda RX4           3.044522 1.791759
+#> Mazda RX4 Wag       3.044522 1.791759
+#> Datsun 710          3.126761 1.386294
+#> Hornet 4 Drive      3.063391 1.791759
+#> Hornet Sportabout   2.928524 2.079442
+#> Valiant             2.895912 1.791759
+#> Duster 360          2.660260 2.079442
+#> Merc 240D           3.194583 1.386294
+#> Merc 230            3.126761 1.386294
+#> Merc 280            2.954910 1.791759
+#> Merc 280C           2.879198 1.791759
+#> Merc 450SE          2.797281 2.079442
+#> Merc 450SL          2.850707 2.079442
+#> Merc 450SLC         2.721295 2.079442
+#> Cadillac Fleetwood  2.341806 2.079442
+#> Lincoln Continental 2.341806 2.079442
+#> Chrysler Imperial   2.687847 2.079442
+#> Fiat 128            3.478158 1.386294
+#> Honda Civic         3.414443 1.386294
+#> Toyota Corolla      3.523415 1.386294
+#> Toyota Corona       3.068053 1.386294
+#> Dodge Challenger    2.740840 2.079442
+#> AMC Javelin         2.721295 2.079442
+#> Camaro Z28          2.587764 2.079442
+#> Pontiac Firebird    2.954910 2.079442
+#> Fiat X1-9           3.306887 1.386294
+#> Porsche 914-2       3.258097 1.386294
+#> Lotus Europa        3.414443 1.386294
+#> Ford Pantera L      2.760010 2.079442
+#> Ferrari Dino        2.980619 1.791759
+#> Maserati Bora       2.708050 2.079442
+#> Volvo 142E          3.063391 1.386294
+mutate_ext(mtcars, .funs = log, .ext = "_ln")
+#>                      mpg cyl  disp  hp drat    wt  qsec vs am gear carb
+#> Mazda RX4           21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4
+#> Mazda RX4 Wag       21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4
+#> Datsun 710          22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1
+#> Hornet 4 Drive      21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
+#> Hornet Sportabout   18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
+#> Valiant             18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1
+#> Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4
+#> Merc 240D           24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2
+#> Merc 230            22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2
+#> Merc 280            19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4
+#> Merc 280C           17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4
+#> Merc 450SE          16.4   8 275.8 180 3.07 4.070 17.40  0  0    3    3
+#> Merc 450SL          17.3   8 275.8 180 3.07 3.730 17.60  0  0    3    3
+#> Merc 450SLC         15.2   8 275.8 180 3.07 3.780 18.00  0  0    3    3
+#> Cadillac Fleetwood  10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4
+#> Lincoln Continental 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4
+#> Chrysler Imperial   14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4
+#> Fiat 128            32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1
+#> Honda Civic         30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2
+#> Toyota Corolla      33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1
+#> Toyota Corona       21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1
+#> Dodge Challenger    15.5   8 318.0 150 2.76 3.520 16.87  0  0    3    2
+#> AMC Javelin         15.2   8 304.0 150 3.15 3.435 17.30  0  0    3    2
+#> Camaro Z28          13.3   8 350.0 245 3.73 3.840 15.41  0  0    3    4
+#> Pontiac Firebird    19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2
+#> Fiat X1-9           27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1
+#> Porsche 914-2       26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2
+#> Lotus Europa        30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
+#> Ford Pantera L      15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4
+#> Ferrari Dino        19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6
+#> Maserati Bora       15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8
+#> Volvo 142E          21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2
+#>                       mpg_ln   cyl_ln  disp_ln    hp_ln  drat_ln     wt_ln
+#> Mazda RX4           3.044522 1.791759 5.075174 4.700480 1.360977 0.9631743
+#> Mazda RX4 Wag       3.044522 1.791759 5.075174 4.700480 1.360977 1.0560527
+#> Datsun 710          3.126761 1.386294 4.682131 4.532599 1.348073 0.8415672
+#> Hornet 4 Drive      3.063391 1.791759 5.552960 4.700480 1.124930 1.1678274
+#> Hornet Sportabout   2.928524 2.079442 5.886104 5.164786 1.147402 1.2354715
+#> Valiant             2.895912 1.791759 5.416100 4.653960 1.015231 1.2412686
+#> Duster 360          2.660260 2.079442 5.886104 5.501258 1.166271 1.2725656
+#> Merc 240D           3.194583 1.386294 4.988390 4.127134 1.305626 1.1600209
+#> Merc 230            3.126761 1.386294 4.947340 4.553877 1.366092 1.1474025
+#> Merc 280            2.954910 1.791759 5.121580 4.812184 1.366092 1.2354715
+#> Merc 280C           2.879198 1.791759 5.121580 4.812184 1.366092 1.2354715
+#> Merc 450SE          2.797281 2.079442 5.619676 5.192957 1.121678 1.4036430
+#> Merc 450SL          2.850707 2.079442 5.619676 5.192957 1.121678 1.3164082
+#> Merc 450SLC         2.721295 2.079442 5.619676 5.192957 1.121678 1.3297240
+#> Cadillac Fleetwood  2.341806 2.079442 6.156979 5.323010 1.075002 1.6582281
+#> Lincoln Continental 2.341806 2.079442 6.131226 5.370638 1.098612 1.6908336
+#> Chrysler Imperial   2.687847 2.079442 6.086775 5.438079 1.172482 1.6761615
+#> Fiat 128            3.478158 1.386294 4.365643 4.189655 1.406097 0.7884574
+#> Honda Civic         3.414443 1.386294 4.326778 3.951244 1.595339 0.4793350
+#> Toyota Corolla      3.523415 1.386294 4.264087 4.174387 1.439835 0.6070445
+#> Toyota Corona       3.068053 1.386294 4.788325 4.574711 1.308333 0.9021918
+#> Dodge Challenger    2.740840 2.079442 5.762051 5.010635 1.015231 1.2584610
+#> AMC Javelin         2.721295 2.079442 5.717028 5.010635 1.147402 1.2340169
+#> Camaro Z28          2.587764 2.079442 5.857933 5.501258 1.316408 1.3454724
+#> Pontiac Firebird    2.954910 2.079442 5.991465 5.164786 1.124930 1.3467736
+#> Fiat X1-9           3.306887 1.386294 4.369448 4.189655 1.406097 0.6601073
+#> Porsche 914-2       3.258097 1.386294 4.789989 4.510860 1.488400 0.7608058
+#> Lotus Europa        3.414443 1.386294 4.554929 4.727388 1.327075 0.4140944
+#> Ford Pantera L      2.760010 2.079442 5.860786 5.575949 1.439835 1.1537316
+#> Ferrari Dino        2.980619 1.791759 4.976734 5.164786 1.286474 1.0188473
+#> Maserati Bora       2.708050 2.079442 5.707110 5.814131 1.264127 1.2725656
+#> Volvo 142E          3.063391 1.386294 4.795791 4.691348 1.413423 1.0224509
+#>                      qsec_ln vs_ln am_ln  gear_ln   carb_ln
+#> Mazda RX4           2.800933  -Inf     0 1.386294 1.3862944
+#> Mazda RX4 Wag       2.834389  -Inf     0 1.386294 1.3862944
+#> Datsun 710          2.923699     0     0 1.386294 0.0000000
+#> Hornet 4 Drive      2.967333     0  -Inf 1.098612 0.0000000
+#> Hornet Sportabout   2.834389  -Inf  -Inf 1.098612 0.6931472
+#> Valiant             3.006672     0  -Inf 1.098612 0.0000000
+#> Duster 360          2.762538  -Inf  -Inf 1.098612 1.3862944
+#> Merc 240D           2.995732     0  -Inf 1.386294 0.6931472
+#> Merc 230            3.131137     0  -Inf 1.386294 0.6931472
+#> Merc 280            2.906901     0  -Inf 1.386294 1.3862944
+#> Merc 280C           2.939162     0  -Inf 1.386294 1.3862944
+#> Merc 450SE          2.856470  -Inf  -Inf 1.098612 1.0986123
+#> Merc 450SL          2.867899  -Inf  -Inf 1.098612 1.0986123
+#> Merc 450SLC         2.890372  -Inf  -Inf 1.098612 1.0986123
+#> Cadillac Fleetwood  2.889260  -Inf  -Inf 1.098612 1.3862944
+#> Lincoln Continental 2.880321  -Inf  -Inf 1.098612 1.3862944
+#> Chrysler Imperial   2.857619  -Inf  -Inf 1.098612 1.3862944
+#> Fiat 128            2.968875     0     0 1.386294 0.0000000
+#> Honda Civic         2.918851     0     0 1.386294 0.6931472
+#> Toyota Corolla      2.990720     0     0 1.386294 0.0000000
+#> Toyota Corona       2.996232     0  -Inf 1.098612 0.0000000
+#> Dodge Challenger    2.825537  -Inf  -Inf 1.098612 0.6931472
+#> AMC Javelin         2.850707  -Inf  -Inf 1.098612 0.6931472
+#> Camaro Z28          2.735017  -Inf  -Inf 1.098612 1.3862944
+#> Pontiac Firebird    2.836150  -Inf  -Inf 1.098612 0.6931472
+#> Fiat X1-9           2.939162     0     0 1.386294 0.0000000
+#> Porsche 914-2       2.815409  -Inf     0 1.609438 0.6931472
+#> Lotus Europa        2.827314     0     0 1.609438 0.6931472
+#> Ford Pantera L      2.674149  -Inf     0 1.609438 1.3862944
+#> Ferrari Dino        2.740840  -Inf     0 1.609438 1.7917595
+#> Maserati Bora       2.681022  -Inf     0 1.609438 2.0794415
+#> Volvo 142E          2.923162     0     0 1.386294 0.6931472
+mutate_ext(mtcars, .funs = log)
+#>                          mpg      cyl     disp       hp     drat        wt
+#> Mazda RX4           3.044522 1.791759 5.075174 4.700480 1.360977 0.9631743
+#> Mazda RX4 Wag       3.044522 1.791759 5.075174 4.700480 1.360977 1.0560527
+#> Datsun 710          3.126761 1.386294 4.682131 4.532599 1.348073 0.8415672
+#> Hornet 4 Drive      3.063391 1.791759 5.552960 4.700480 1.124930 1.1678274
+#> Hornet Sportabout   2.928524 2.079442 5.886104 5.164786 1.147402 1.2354715
+#> Valiant             2.895912 1.791759 5.416100 4.653960 1.015231 1.2412686
+#> Duster 360          2.660260 2.079442 5.886104 5.501258 1.166271 1.2725656
+#> Merc 240D           3.194583 1.386294 4.988390 4.127134 1.305626 1.1600209
+#> Merc 230            3.126761 1.386294 4.947340 4.553877 1.366092 1.1474025
+#> Merc 280            2.954910 1.791759 5.121580 4.812184 1.366092 1.2354715
+#> Merc 280C           2.879198 1.791759 5.121580 4.812184 1.366092 1.2354715
+#> Merc 450SE          2.797281 2.079442 5.619676 5.192957 1.121678 1.4036430
+#> Merc 450SL          2.850707 2.079442 5.619676 5.192957 1.121678 1.3164082
+#> Merc 450SLC         2.721295 2.079442 5.619676 5.192957 1.121678 1.3297240
+#> Cadillac Fleetwood  2.341806 2.079442 6.156979 5.323010 1.075002 1.6582281
+#> Lincoln Continental 2.341806 2.079442 6.131226 5.370638 1.098612 1.6908336
+#> Chrysler Imperial   2.687847 2.079442 6.086775 5.438079 1.172482 1.6761615
+#> Fiat 128            3.478158 1.386294 4.365643 4.189655 1.406097 0.7884574
+#> Honda Civic         3.414443 1.386294 4.326778 3.951244 1.595339 0.4793350
+#> Toyota Corolla      3.523415 1.386294 4.264087 4.174387 1.439835 0.6070445
+#> Toyota Corona       3.068053 1.386294 4.788325 4.574711 1.308333 0.9021918
+#> Dodge Challenger    2.740840 2.079442 5.762051 5.010635 1.015231 1.2584610
+#> AMC Javelin         2.721295 2.079442 5.717028 5.010635 1.147402 1.2340169
+#> Camaro Z28          2.587764 2.079442 5.857933 5.501258 1.316408 1.3454724
+#> Pontiac Firebird    2.954910 2.079442 5.991465 5.164786 1.124930 1.3467736
+#> Fiat X1-9           3.306887 1.386294 4.369448 4.189655 1.406097 0.6601073
+#> Porsche 914-2       3.258097 1.386294 4.789989 4.510860 1.488400 0.7608058
+#> Lotus Europa        3.414443 1.386294 4.554929 4.727388 1.327075 0.4140944
+#> Ford Pantera L      2.760010 2.079442 5.860786 5.575949 1.439835 1.1537316
+#> Ferrari Dino        2.980619 1.791759 4.976734 5.164786 1.286474 1.0188473
+#> Maserati Bora       2.708050 2.079442 5.707110 5.814131 1.264127 1.2725656
+#> Volvo 142E          3.063391 1.386294 4.795791 4.691348 1.413423 1.0224509
+#>                         qsec   vs   am     gear      carb
+#> Mazda RX4           2.800933 -Inf    0 1.386294 1.3862944
+#> Mazda RX4 Wag       2.834389 -Inf    0 1.386294 1.3862944
+#> Datsun 710          2.923699    0    0 1.386294 0.0000000
+#> Hornet 4 Drive      2.967333    0 -Inf 1.098612 0.0000000
+#> Hornet Sportabout   2.834389 -Inf -Inf 1.098612 0.6931472
+#> Valiant             3.006672    0 -Inf 1.098612 0.0000000
+#> Duster 360          2.762538 -Inf -Inf 1.098612 1.3862944
+#> Merc 240D           2.995732    0 -Inf 1.386294 0.6931472
+#> Merc 230            3.131137    0 -Inf 1.386294 0.6931472
+#> Merc 280            2.906901    0 -Inf 1.386294 1.3862944
+#> Merc 280C           2.939162    0 -Inf 1.386294 1.3862944
+#> Merc 450SE          2.856470 -Inf -Inf 1.098612 1.0986123
+#> Merc 450SL          2.867899 -Inf -Inf 1.098612 1.0986123
+#> Merc 450SLC         2.890372 -Inf -Inf 1.098612 1.0986123
+#> Cadillac Fleetwood  2.889260 -Inf -Inf 1.098612 1.3862944
+#> Lincoln Continental 2.880321 -Inf -Inf 1.098612 1.3862944
+#> Chrysler Imperial   2.857619 -Inf -Inf 1.098612 1.3862944
+#> Fiat 128            2.968875    0    0 1.386294 0.0000000
+#> Honda Civic         2.918851    0    0 1.386294 0.6931472
+#> Toyota Corolla      2.990720    0    0 1.386294 0.0000000
+#> Toyota Corona       2.996232    0 -Inf 1.098612 0.0000000
+#> Dodge Challenger    2.825537 -Inf -Inf 1.098612 0.6931472
+#> AMC Javelin         2.850707 -Inf -Inf 1.098612 0.6931472
+#> Camaro Z28          2.735017 -Inf -Inf 1.098612 1.3862944
+#> Pontiac Firebird    2.836150 -Inf -Inf 1.098612 0.6931472
+#> Fiat X1-9           2.939162    0    0 1.386294 0.0000000
+#> Porsche 914-2       2.815409 -Inf    0 1.609438 0.6931472
+#> Lotus Europa        2.827314    0    0 1.609438 0.6931472
+#> Ford Pantera L      2.674149 -Inf    0 1.609438 1.3862944
+#> Ferrari Dino        2.740840 -Inf    0 1.609438 1.7917595
+#> Maserati Bora       2.681022 -Inf    0 1.609438 2.0794415
+#> Volvo 142E          2.923162    0    0 1.386294 0.6931472
+mutate_ext(mtcars, .funs = log, .ext = "_ln", .vars = vars(mpg, cyl))
+#>                      mpg cyl  disp  hp drat    wt  qsec vs am gear carb
+#> Mazda RX4           21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4
+#> Mazda RX4 Wag       21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4
+#> Datsun 710          22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1
+#> Hornet 4 Drive      21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
+#> Hornet Sportabout   18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
+#> Valiant             18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1
+#> Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4
+#> Merc 240D           24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2
+#> Merc 230            22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2
+#> Merc 280            19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4
+#> Merc 280C           17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4
+#> Merc 450SE          16.4   8 275.8 180 3.07 4.070 17.40  0  0    3    3
+#> Merc 450SL          17.3   8 275.8 180 3.07 3.730 17.60  0  0    3    3
+#> Merc 450SLC         15.2   8 275.8 180 3.07 3.780 18.00  0  0    3    3
+#> Cadillac Fleetwood  10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4
+#> Lincoln Continental 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4
+#> Chrysler Imperial   14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4
+#> Fiat 128            32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1
+#> Honda Civic         30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2
+#> Toyota Corolla      33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1
+#> Toyota Corona       21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1
+#> Dodge Challenger    15.5   8 318.0 150 2.76 3.520 16.87  0  0    3    2
+#> AMC Javelin         15.2   8 304.0 150 3.15 3.435 17.30  0  0    3    2
+#> Camaro Z28          13.3   8 350.0 245 3.73 3.840 15.41  0  0    3    4
+#> Pontiac Firebird    19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2
+#> Fiat X1-9           27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1
+#> Porsche 914-2       26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2
+#> Lotus Europa        30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
+#> Ford Pantera L      15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4
+#> Ferrari Dino        19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6
+#> Maserati Bora       15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8
+#> Volvo 142E          21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2
+#>                       mpg_ln   cyl_ln
+#> Mazda RX4           3.044522 1.791759
+#> Mazda RX4 Wag       3.044522 1.791759
+#> Datsun 710          3.126761 1.386294
+#> Hornet 4 Drive      3.063391 1.791759
+#> Hornet Sportabout   2.928524 2.079442
+#> Valiant             2.895912 1.791759
+#> Duster 360          2.660260 2.079442
+#> Merc 240D           3.194583 1.386294
+#> Merc 230            3.126761 1.386294
+#> Merc 280            2.954910 1.791759
+#> Merc 280C           2.879198 1.791759
+#> Merc 450SE          2.797281 2.079442
+#> Merc 450SL          2.850707 2.079442
+#> Merc 450SLC         2.721295 2.079442
+#> Cadillac Fleetwood  2.341806 2.079442
+#> Lincoln Continental 2.341806 2.079442
+#> Chrysler Imperial   2.687847 2.079442
+#> Fiat 128            3.478158 1.386294
+#> Honda Civic         3.414443 1.386294
+#> Toyota Corolla      3.523415 1.386294
+#> Toyota Corona       3.068053 1.386294
+#> Dodge Challenger    2.740840 2.079442
+#> AMC Javelin         2.721295 2.079442
+#> Camaro Z28          2.587764 2.079442
+#> Pontiac Firebird    2.954910 2.079442
+#> Fiat X1-9           3.306887 1.386294
+#> Porsche 914-2       3.258097 1.386294
+#> Lotus Europa        3.414443 1.386294
+#> Ford Pantera L      2.760010 2.079442
+#> Ferrari Dino        2.980619 1.791759
+#> Maserati Bora       2.708050 2.079442
+#> Volvo 142E          3.063391 1.386294
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/n_missing.html b/radiant.data/docs/reference/n_missing.html new file mode 100644 index 0000000000000000000000000000000000000000..a41456b12a3b655d8964ab1f7a800bc43f307f1e --- /dev/null +++ b/radiant.data/docs/reference/n_missing.html @@ -0,0 +1,164 @@ + +Number of missing values — n_missing • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Number of missing values

    + Source: R/explore.R + +
    + +
    +

    Number of missing values

    +
    + +
    + 
    n_missing(x, ...)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + + +
    ...
    +

    Additional arguments

    + +
    +
    +

    Value

    + + +

    number of missing values

    +
    + +
    +

    Examples

    + 
    n_missing(c("a", "b", NA))
+#> [1] 1
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/n_obs.html b/radiant.data/docs/reference/n_obs.html new file mode 100644 index 0000000000000000000000000000000000000000..5f3ab9747401385906e5cce575a5426a49584e1f --- /dev/null +++ b/radiant.data/docs/reference/n_obs.html @@ -0,0 +1,164 @@ + +Number of observations — n_obs • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Number of observations

    + Source: R/explore.R + +
    + +
    +

    Number of observations

    +
    + +
    + 
    n_obs(x, ...)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + + +
    ...
    +

    Additional arguments

    + +
    +
    +

    Value

    + + +

    number of observations

    +
    + +
    +

    Examples

    + 
    n_obs(c("a", "b", NA))
+#> [1] 3
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/normalize.html b/radiant.data/docs/reference/normalize.html new file mode 100644 index 0000000000000000000000000000000000000000..1e9ec123583d0c84fb9179437c21f83dcb9f0801 --- /dev/null +++ b/radiant.data/docs/reference/normalize.html @@ -0,0 +1,157 @@ + +Normalize a variable x by a variable y — normalize • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Normalize a variable x by a variable y

    + Source: R/transform.R + +
    + +
    +

    Normalize a variable x by a variable y

    +
    + +
    + 
    normalize(x, y)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + + +
    y
    +

    Normalizing variable

    + +
    +
    +

    Value

    + + +

    x/y

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/parse_path.html b/radiant.data/docs/reference/parse_path.html new file mode 100644 index 0000000000000000000000000000000000000000..4b2b34428038b8e6d2bbac5ba027289d217b756d --- /dev/null +++ b/radiant.data/docs/reference/parse_path.html @@ -0,0 +1,183 @@ + +Parse file path into useful components — parse_path • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Parse file path into useful components

    + Source: R/radiant.R + +
    + +
    +

    Parse file path into useful components

    +
    + +
    + 
    parse_path(path, chr = "", pdir = getwd(), mess = TRUE)
    +
    + +
    +

    Arguments

    +
    path
    +

    Path to be parsed

    + + +
    chr
    +

    Character to wrap around path for display

    + + +
    pdir
    +

    Project directory if available

    + + +
    mess
    +

    Print messages if Dropbox or Google Drive not found

    + +
    +
    +

    Details

    +

    Parse file path into useful components (i.e., file name, file extension, relative path, etc.)

    +
    + +
    +

    Examples

    + 
    list.files(".", full.names = TRUE)[1] %>% parse_path()
+#> $path
+#> [1] "/Users/vnijs/gh/radiant.data/docs/reference/Rplot001.png"
+#> 
+#> $rpath
+#> Rplot001.png
+#> 
+#> $filename
+#> [1] "Rplot001.png"
+#> 
+#> $fext
+#> [1] "png"
+#> 
+#> $objname
+#> [1] "Rplot001"
+#> 
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/percentiles.html b/radiant.data/docs/reference/percentiles.html new file mode 100644 index 0000000000000000000000000000000000000000..bc2a55a6afaf00d30ca668e21a7fe3d246c1d6aa --- /dev/null +++ b/radiant.data/docs/reference/percentiles.html @@ -0,0 +1,177 @@ + +Calculate percentiles — p01 • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Calculate percentiles

    + Source: R/explore.R + +
    + +
    +

    Calculate percentiles

    +
    + +
    + 
    p01(x, na.rm = TRUE)
+
+p025(x, na.rm = TRUE)
+
+p05(x, na.rm = TRUE)
+
+p10(x, na.rm = TRUE)
+
+p25(x, na.rm = TRUE)
+
+p75(x, na.rm = TRUE)
+
+p90(x, na.rm = TRUE)
+
+p95(x, na.rm = TRUE)
+
+p975(x, na.rm = TRUE)
+
+p99(x, na.rm = TRUE)
    +
    + +
    +

    Arguments

    +
    x
    +

    Numeric vector

    + + +
    na.rm
    +

    If TRUE missing values are removed before calculation

    + +
    + +
    +

    Examples

    + 
    p01(0:100)
+#> 1% 
+#>  1 
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/pfun.html b/radiant.data/docs/reference/pfun.html new file mode 100644 index 0000000000000000000000000000000000000000..42995a6c2371b9303d3654a80b71c85484a0cdc9 --- /dev/null +++ b/radiant.data/docs/reference/pfun.html @@ -0,0 +1,207 @@ + +Summarize a set of numeric vectors per row — pfun • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Summarize a set of numeric vectors per row

    + Source: R/radiant.R + +
    + +
    +

    Summarize a set of numeric vectors per row

    +
    + +
    + 
    pfun(..., fun, na.rm = TRUE)
+
+psum(..., na.rm = TRUE)
+
+pmean(..., na.rm = TRUE)
+
+pmedian(..., na.rm = TRUE)
+
+psd(..., na.rm = TRUE)
+
+pvar(..., na.rm = TRUE)
+
+pcv(..., na.rm = TRUE)
+
+pp01(..., na.rm = TRUE)
+
+pp025(..., na.rm = TRUE)
+
+pp05(..., na.rm = TRUE)
+
+pp10(..., na.rm = TRUE)
+
+pp25(..., na.rm = TRUE)
+
+pp75(..., na.rm = TRUE)
+
+pp95(..., na.rm = TRUE)
+
+pp975(..., na.rm = TRUE)
+
+pp99(..., na.rm = TRUE)
    +
    + +
    +

    Arguments

    +
    ...
    +

    Numeric vectors of the same length

    + + +
    fun
    +

    Function to apply

    + + +
    na.rm
    +

    a logical indicating whether missing values should be removed.

    + +
    +
    +

    Value

    + + +

    A vector of 'parallel' summaries of the argument vectors.

    +
    +
    +

    Details

    +

    Calculate summary statistics of the input vectors per row (or 'parallel')

    +
    +
    +

    See also

    +

    See also pmin and pmax

    +
    + +
    +

    Examples

    + 
    pfun(1:10, fun = mean)
+#>  [1]  1  2  3  4  5  6  7  8  9 10
+psum(1:10, 10:1)
+#>  [1] 11 11 11 11 11 11 11 11 11 11
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/pivotr.html b/radiant.data/docs/reference/pivotr.html new file mode 100644 index 0000000000000000000000000000000000000000..a357abc387506202c2f9544e4bdc74502066e34a --- /dev/null +++ b/radiant.data/docs/reference/pivotr.html @@ -0,0 +1,338 @@ + +Create a pivot table — pivotr • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Create a pivot table

    + Source: R/pivotr.R + +
    + +
    +

    Create a pivot table

    +
    + +
    + 
    pivotr(
+  dataset,
+  cvars = "",
+  nvar = "None",
+  fun = "mean",
+  normalize = "None",
+  tabfilt = "",
+  tabsort = "",
+  tabslice = "",
+  nr = Inf,
+  data_filter = "",
+  arr = "",
+  rows = NULL,
+  envir = parent.frame()
+)
    +
    + +
    +

    Arguments

    +
    dataset
    +

    Dataset to tabulate

    + + +
    cvars
    +

    Categorical variables

    + + +
    nvar
    +

    Numerical variable

    + + +
    fun
    +

    Function to apply to numerical variable

    + + +
    normalize
    +

    Normalize the table by row total, column totals, or overall total

    + + +
    tabfilt
    +

    Expression used to filter the table (e.g., "Total > 10000")

    + + +
    tabsort
    +

    Expression used to sort the table (e.g., "desc(Total)")

    + + +
    tabslice
    +

    Expression used to filter table (e.g., "1:5")

    + + +
    nr
    +

    Number of rows to display

    + + +
    data_filter
    +

    Expression used to filter the dataset before creating the table (e.g., "price > 10000")

    + + +
    arr
    +

    Expression to arrange (sort) the data on (e.g., "color, desc(price)")

    + + +
    rows
    +

    Rows to select from the specified dataset

    + + +
    envir
    +

    Environment to extract data from

    + +
    +
    +

    Details

    +

    Create a pivot-table. See https://radiant-rstats.github.io/docs/data/pivotr.html for an example in Radiant

    +
    + +
    +

    Examples

    + 
    pivotr(diamonds, cvars = "cut") %>% str()
+#> List of 18
+#>  $ cni        : logi [1:2] FALSE FALSE
+#>  $ cn         : chr [1:2] "cut" "n_obs"
+#>  $ tab_freq   : tibble [6 × 2] (S3: tbl_df/tbl/data.frame)
+#>   ..$ cut  : Factor w/ 6 levels "Fair","Good",..: 1 2 3 4 5 6
+#>   ..$ n_obs: int [1:6] 101 275 677 771 1176 3000
+#>  $ tab        :'data.frame':	6 obs. of  2 variables:
+#>   ..$ cut  : Factor w/ 6 levels "Fair","Good",..: 1 2 3 4 5 6
+#>   ..$ n_obs: int [1:6] 101 275 677 771 1176 3000
+#>   ..- attr(*, "radiant_nrow")= num 5
+#>  $ df_name    : chr "diamonds"
+#>  $ fill       : int 0
+#>  $ vars       : chr "cut"
+#>  $ cvars      : chr "cut"
+#>  $ nvar       : chr "n_obs"
+#>  $ fun        : chr "mean"
+#>  $ normalize  : chr "None"
+#>  $ tabfilt    : chr ""
+#>  $ tabsort    : chr ""
+#>  $ tabslice   : chr ""
+#>  $ nr         : num Inf
+#>  $ data_filter: chr ""
+#>  $ arr        : chr ""
+#>  $ rows       : NULL
+#>  - attr(*, "class")= chr [1:2] "pivotr" "list"
+pivotr(diamonds, cvars = "cut")$tab
+#>         cut n_obs
+#> 1      Fair   101
+#> 2      Good   275
+#> 3 Very Good   677
+#> 4   Premium   771
+#> 5     Ideal  1176
+#> 6     Total  3000
+pivotr(diamonds, cvars = c("cut", "clarity", "color"))$tab
+#>    clarity color Fair Good Very_Good Premium Ideal Total
+#> 1       I1     D    0    1         0       3     0     4
+#> 2       I1     E    1    1         2       1     0     5
+#> 3       I1     F    2    1         2       2     4    11
+#> 4       I1     G    1    1         1       2     0     5
+#> 5       I1     H    3    0         1       3     1     8
+#> 6       I1     I    4    0         0       1     0     5
+#> 7       I1     J    1    0         0       1     0     2
+#> 8      SI2     D    8   14        18      13    15    68
+#> 9      SI2     E    5   16        30      25    30   106
+#> 10     SI2     F    1   11        24      23    34    93
+#> 11     SI2     G    5    7        29      35    21    97
+#> 12     SI2     H    4    7        14      31    30    86
+#> 13     SI2     I    2    2         7      21    14    46
+#> 14     SI2     J    3    5        10       9     6    33
+#> 15     SI1     D    4    9        21      38    39   111
+#> 16     SI1     E    5   22        37      47    36   147
+#> 17     SI1     F    4   14        40      25    42   125
+#> 18     SI1     G    5   10        23      26    31    95
+#> 19     SI1     H    9   13        21      31    43   117
+#> 20     SI1     I    1   14        18      20    23    76
+#> 21     SI1     J    1   11        11       9    18    50
+#> 22     VS2     D    2    3        17      12    55    89
+#> 23     VS2     E    2   15        26      41    55   139
+#> 24     VS2     F    4   12        23      36    53   128
+#> 25     VS2     G    2    8        17      42    50   119
+#> 26     VS2     H    2   10        20      25    31    88
+#> 27     VS2     I    2    2        16      17    19    56
+#> 28     VS2     J    0    2        12      12    16    42
+#> 29     VS1     D    0    3        10      13    24    50
+#> 30     VS1     E    0    5         9      13    25    52
+#> 31     VS1     F    4    8        25      17    29    83
+#> 32     VS1     G    2    7        22      30    51   112
+#> 33     VS1     H    3    3        19      23    22    70
+#> 34     VS1     I    2    5        11      14    18    50
+#> 35     VS1     J    2    2         3      10     8    25
+#> 36    VVS2     D    0    4         8       9    20    41
+#> 37    VVS2     E    1    1        25       7    22    56
+#> 38    VVS2     F    0    0        14       6    29    49
+#> 39    VVS2     G    1    3        21      10    43    78
+#> 40    VVS2     H    0    3        12       5    13    33
+#> 41    VVS2     I    0    1         1       4    14    20
+#> 42    VVS2     J    0    0         2       2     3     7
+#> 43    VVS1     D    1    1         2       4     9    17
+#> 44    VVS1     E    0    2         7       7    21    37
+#> 45    VVS1     F    1    7         4       4    29    45
+#> 46    VVS1     G    0    3        16       9    42    70
+#> 47    VVS1     H    0    1         6      11    14    32
+#> 48    VVS1     I    0    1         4       3    12    20
+#> 49    VVS1     J    0    0         1       1     1     3
+#> 50      IF     D    0    0         1       0     1     2
+#> 51      IF     E    0    0         4       3     5    12
+#> 52      IF     F    1    2         4       6    18    31
+#> 53      IF     G    0    1         2       2    16    21
+#> 54      IF     H    0    0         2       3    15    20
+#> 55      IF     I    0    1         2       3     5    11
+#> 56      IF     J    0    0         0       1     1     2
+#> 57   Total Total  101  275       677     771  1176  3000
+pivotr(diamonds, cvars = "cut:clarity", nvar = "price")$tab
+#>   clarity     Fair     Good Very_Good  Premium    Ideal    Total
+#> 1      I1 2730.167 4333.500  3864.167 4932.231 6078.200 4194.775
+#> 2     SI2 5893.964 5280.919  5045.621 5568.019 4435.673 5100.189
+#> 3     SI1 4273.069 3757.022  4277.544 4113.811 3758.125 3998.577
+#> 4     VS2 3292.000 3925.481  3950.947 4522.914 3306.290 3822.967
+#> 5     VS1 5110.769 3740.697  3889.475 4461.333 3189.362 3789.181
+#> 6    VVS2 2030.500 4378.167  2525.193 3580.581 3665.181 3337.820
+#> 7    VVS1 6761.500 3889.333  1945.875 1426.692 2960.594 2608.460
+#> 8      IF 3205.000  817.250  4675.867 2361.333 1961.344 2411.697
+#> 9   Total 4505.238 4130.433  3959.916 4369.409 3470.224 3907.186
+pivotr(diamonds, cvars = "cut", nvar = "price")$tab
+#>         cut    price
+#> 1      Fair 4505.238
+#> 2      Good 4130.433
+#> 3 Very Good 3959.916
+#> 4   Premium 4369.409
+#> 5     Ideal 3470.224
+#> 6     Total 3907.186
+pivotr(diamonds, cvars = "cut", normalize = "total")$tab
+#>         cut      n_obs
+#> 1      Fair 0.03366667
+#> 2      Good 0.09166667
+#> 3 Very Good 0.22566667
+#> 4   Premium 0.25700000
+#> 5     Ideal 0.39200000
+#> 6     Total 1.00000000
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/plot.pivotr-1.png b/radiant.data/docs/reference/plot.pivotr-1.png new file mode 100644 index 0000000000000000000000000000000000000000..b103934b534cd17cfb224b1df7a1faa777bf08cd Binary files /dev/null and b/radiant.data/docs/reference/plot.pivotr-1.png differ diff --git a/radiant.data/docs/reference/plot.pivotr-2.png b/radiant.data/docs/reference/plot.pivotr-2.png new file mode 100644 index 0000000000000000000000000000000000000000..048881073e4ade0e9bf12ede03f34baadcfc2d66 Binary files /dev/null and b/radiant.data/docs/reference/plot.pivotr-2.png differ diff --git a/radiant.data/docs/reference/plot.pivotr-3.png b/radiant.data/docs/reference/plot.pivotr-3.png new file mode 100644 index 0000000000000000000000000000000000000000..ece85eede48a360b02d80b95969f360bb52ab743 Binary files /dev/null and b/radiant.data/docs/reference/plot.pivotr-3.png differ diff --git a/radiant.data/docs/reference/plot.pivotr.html b/radiant.data/docs/reference/plot.pivotr.html new file mode 100644 index 0000000000000000000000000000000000000000..44d7274c8f8d5b9553b172016a419cf40433a7b5 --- /dev/null +++ b/radiant.data/docs/reference/plot.pivotr.html @@ -0,0 +1,200 @@ + +Plot method for the pivotr function — plot.pivotr • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Plot method for the pivotr function

    + Source: R/pivotr.R + +
    + +
    +

    Plot method for the pivotr function

    +
    + +
    + 
    # S3 method for pivotr
+plot(
+  x,
+  type = "dodge",
+  perc = FALSE,
+  flip = FALSE,
+  fillcol = "blue",
+  opacity = 0.5,
+  ...
+)
    +
    + +
    +

    Arguments

    +
    x
    +

    Return value from pivotr

    + + +
    type
    +

    Plot type to use ("fill" or "dodge" (default))

    + + +
    perc
    +

    Use percentage on the y-axis

    + + +
    flip
    +

    Flip the axes in a plot (FALSE or TRUE)

    + + +
    fillcol
    +

    Fill color for bar-plot when only one categorical variable has been selected (default is "blue")

    + + +
    opacity
    +

    Opacity for plot elements (0 to 1)

    + + +
    ...
    +

    further arguments passed to or from other methods

    + +
    +
    +

    Details

    +

    See https://radiant-rstats.github.io/docs/data/pivotr for an example in Radiant

    +
    +
    +

    See also

    +

    pivotr to generate summaries

    +

    summary.pivotr to show summaries

    +
    + +
    +

    Examples

    + 
    pivotr(diamonds, cvars = "cut") %>% plot()
+
+pivotr(diamonds, cvars = c("cut", "clarity")) %>% plot()
+
+pivotr(diamonds, cvars = c("cut", "clarity", "color")) %>% plot()
+
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/print.gtable.html b/radiant.data/docs/reference/print.gtable.html new file mode 100644 index 0000000000000000000000000000000000000000..925632b90176ae598a3d4bda5fed82edc92d2ee9 --- /dev/null +++ b/radiant.data/docs/reference/print.gtable.html @@ -0,0 +1,234 @@ + + + + + + + + +Print/draw method for grobs produced by gridExtra — print.gtable • radiant.data + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + +
    + +
    +
    +
    +

    Print/draw method for grobs produced by gridExtra

    + Source: R/radiant.R + +
    + +
    +

    Print/draw method for grobs produced by gridExtra

    +
    + + 
    # S3 method for gtable
+print(x, ...)
    + +

    Arguments

    + + + + + + + + + + +
    x

    a gtable object

    ...

    further arguments passed to or from other methods

    + +

    Value

    + +

    A plot

    +

    Details

    + +

    Print method for grobs created using grid.arrange

    + +
    + +
    + +
    +
    +

    Developed by Vincent Nijs.

    +
    + +
    +

    Site built with pkgdown 1.3.0.

    +
    +
    +
    + + + + + + + + + diff --git a/radiant.data/docs/reference/prop.html b/radiant.data/docs/reference/prop.html new file mode 100644 index 0000000000000000000000000000000000000000..f8e61559cb95f2170b613877847d019acc383f87 --- /dev/null +++ b/radiant.data/docs/reference/prop.html @@ -0,0 +1,170 @@ + +Calculate proportion — prop • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Calculate proportion

    + Source: R/explore.R + +
    + +
    +

    Calculate proportion

    +
    + +
    + 
    prop(x, na.rm = TRUE)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + + +
    na.rm
    +

    If TRUE missing values are removed before calculation

    + +
    +
    +

    Value

    + + +

    Proportion of first level for a factor and of the maximum value for numeric

    +
    + +
    +

    Examples

    + 
    prop(c(rep(1L, 10), rep(0L, 10)))
+#> [1] 0.5
+prop(c(rep(4, 10), rep(2, 10)))
+#> [1] 0.5
+prop(rep(0, 10))
+#> [1] 0
+prop(factor(c(rep("a", 20), rep("b", 10))))
+#> [1] 0.6666667
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/publishers.html b/radiant.data/docs/reference/publishers.html new file mode 100644 index 0000000000000000000000000000000000000000..73657df38705b7643f94b9078ee07b4c24c49c8a --- /dev/null +++ b/radiant.data/docs/reference/publishers.html @@ -0,0 +1,149 @@ + +Comic publishers — publishers • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Comic publishers

    + Source: R/aaa.R + +
    + +
    +

    Comic publishers

    +
    + +
    + 
    data(publishers)
    +
    + +
    +

    Format

    +

    A data frame with 3 rows and 2 variables

    +
    +
    +

    Details

    +

    List of comic publishers from https://stat545.com/join-cheatsheet.html. The dataset is used to illustrate data merging / joining. Description provided in attr(publishers,"description")

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/qscatter-1.png b/radiant.data/docs/reference/qscatter-1.png new file mode 100644 index 0000000000000000000000000000000000000000..e3e29315fbb8198b5442f1ee44419ad7789f456b Binary files /dev/null and b/radiant.data/docs/reference/qscatter-1.png differ diff --git a/radiant.data/docs/reference/qscatter-2.png b/radiant.data/docs/reference/qscatter-2.png new file mode 100644 index 0000000000000000000000000000000000000000..e9f974894c4112bd1654889467922fbd4e15af94 Binary files /dev/null and b/radiant.data/docs/reference/qscatter-2.png differ diff --git a/radiant.data/docs/reference/qscatter.html b/radiant.data/docs/reference/qscatter.html new file mode 100644 index 0000000000000000000000000000000000000000..3ad615a20133bbba63e20f46133c339941f67415 --- /dev/null +++ b/radiant.data/docs/reference/qscatter.html @@ -0,0 +1,176 @@ + +Create a qscatter plot similar to Stata — qscatter • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Create a qscatter plot similar to Stata

    + Source: R/visualize.R + +
    + +
    +

    Create a qscatter plot similar to Stata

    +
    + +
    + 
    qscatter(dataset, xvar, yvar, lev = "", fun = "mean", bins = 20)
    +
    + +
    +

    Arguments

    +
    dataset
    +

    Data to plot (data.frame or tibble)

    + + +
    xvar
    +

    Character indicating the variable to display along the X-axis of the plot

    + + +
    yvar
    +

    Character indicating the variable to display along the Y-axis of the plot

    + + +
    lev
    +

    Level in yvar to use if yvar is of type character of factor. If lev is empty then the first level is used

    + + +
    fun
    +

    Summary measure to apply to both the x and y variable

    + + +
    bins
    +

    Number of bins to use

    + +
    + +
    +

    Examples

    + 
    qscatter(diamonds, "price", "carat")
+
+qscatter(titanic, "age", "survived")
+
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/qterms.html b/radiant.data/docs/reference/qterms.html new file mode 100644 index 0000000000000000000000000000000000000000..ffb19f2efad6f8699e7ad3810950c321863708b8 --- /dev/null +++ b/radiant.data/docs/reference/qterms.html @@ -0,0 +1,165 @@ + +Create a vector of quadratic and cubed terms for use in linear and logistic regression — qterms • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Create a vector of quadratic and cubed terms for use in linear and logistic regression

    + Source: R/radiant.R + +
    + +
    +

    Create a vector of quadratic and cubed terms for use in linear and logistic regression

    +
    + +
    + 
    qterms(vars, nway = 2)
    +
    + +
    +

    Arguments

    +
    vars
    +

    Variables labels to use

    + + +
    nway
    +

    quadratic (2) or cubic (3) term labels to create

    + +
    +
    +

    Value

    + + +

    Character vector of (regression) term labels

    +
    + +
    +

    Examples

    + 
    qterms(c("a", "b"), 3)
+#> [1] "I(a^2)" "I(b^2)" "I(a^3)" "I(b^3)"
+qterms(c("a", "b"), 2)
+#> [1] "I(a^2)" "I(b^2)"
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/radiant.data-deprecated.html b/radiant.data/docs/reference/radiant.data-deprecated.html new file mode 100644 index 0000000000000000000000000000000000000000..edae6e0d38d7f1e519209878f39e4f364b5499be --- /dev/null +++ b/radiant.data/docs/reference/radiant.data-deprecated.html @@ -0,0 +1,173 @@ + +Deprecated function(s) in the radiant.data package — radiant.data-deprecated • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Deprecated function(s) in the radiant.data package

    + Source: R/deprecated.R + +
    + +
    +

    These functions are provided for compatibility with previous versions of +radiant but will be removed

    +
    + +
    + 
    mean_rm(...)
    +
    + +
    +

    Arguments

    +
    ...
    +

    Parameters to be passed to the updated functions

    + +
    +
    +

    Details

    + + +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/radiant.data.html b/radiant.data/docs/reference/radiant.data.html new file mode 100644 index 0000000000000000000000000000000000000000..5796ea32b884ec7a3c93eb06599d0e96b6d4c0e5 --- /dev/null +++ b/radiant.data/docs/reference/radiant.data.html @@ -0,0 +1,160 @@ + +radiant.data — radiant.data • radiant.data + + +
    +
    + + + +
    +
    +
    +

    radiant.data

    + Source: R/aaa.R, R/radiant.R + +
    + +
    +

    Launch the radiant.data app in the default web browser

    +
    + +
    + 
    radiant.data(state, ...)
    +
    + +
    +

    Arguments

    +
    state
    +

    Path to statefile to load

    + + +
    ...
    +

    additional arguments to pass to shiny::runApp (e.g, port = 8080)

    + +
    + +
    +

    Examples

    + 
    if (FALSE) {
+radiant.data()
+radiant.data("https://github.com/radiant-rstats/docs/raw/gh-pages/examples/demo-dvd-rnd.state.rda")
+radiant.data("viewer")
+}
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/radiant.data_url.html b/radiant.data/docs/reference/radiant.data_url.html new file mode 100644 index 0000000000000000000000000000000000000000..be0c3f2d39adcaa300943e09ba42885c542bf958 --- /dev/null +++ b/radiant.data/docs/reference/radiant.data_url.html @@ -0,0 +1,158 @@ + +Start radiant.data app but do not open a browser — radiant.data_url • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Start radiant.data app but do not open a browser

    + Source: R/radiant.R + +
    + +
    +

    Start radiant.data app but do not open a browser

    +
    + +
    + 
    radiant.data_url(state, ...)
    +
    + +
    +

    Arguments

    +
    state
    +

    Path to statefile to load

    + + +
    ...
    +

    additional arguments to pass to shiny::runApp (e.g, port = 8080)

    + +
    + +
    +

    Examples

    + 
    if (FALSE) {
+radiant.data_url()
+}
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/radiant.data_viewer.html b/radiant.data/docs/reference/radiant.data_viewer.html new file mode 100644 index 0000000000000000000000000000000000000000..fd971286c8f54865a22a39764f35b9c77f82a4cf --- /dev/null +++ b/radiant.data/docs/reference/radiant.data_viewer.html @@ -0,0 +1,158 @@ + +Launch the radiant.data app in the Rstudio viewer — radiant.data_viewer • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Launch the radiant.data app in the Rstudio viewer

    + Source: R/radiant.R + +
    + +
    +

    Launch the radiant.data app in the Rstudio viewer

    +
    + +
    + 
    radiant.data_viewer(state, ...)
    +
    + +
    +

    Arguments

    +
    state
    +

    Path to statefile to load

    + + +
    ...
    +

    additional arguments to pass to shiny::runApp (e.g, port = 8080)

    + +
    + +
    +

    Examples

    + 
    if (FALSE) {
+radiant.data_viewer()
+}
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/radiant.data_window.html b/radiant.data/docs/reference/radiant.data_window.html new file mode 100644 index 0000000000000000000000000000000000000000..a022815651ab70de807f3cf7f6577261e616d7b3 --- /dev/null +++ b/radiant.data/docs/reference/radiant.data_window.html @@ -0,0 +1,158 @@ + +Launch the radiant.data app in an Rstudio window — radiant.data_window • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Launch the radiant.data app in an Rstudio window

    + Source: R/radiant.R + +
    + +
    +

    Launch the radiant.data app in an Rstudio window

    +
    + +
    + 
    radiant.data_window(state, ...)
    +
    + +
    +

    Arguments

    +
    state
    +

    Path to statefile to load

    + + +
    ...
    +

    additional arguments to pass to shiny::runApp (e.g, port = 8080)

    + +
    + +
    +

    Examples

    + 
    if (FALSE) {
+radiant.data_window()
+}
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/read_files.html b/radiant.data/docs/reference/read_files.html new file mode 100644 index 0000000000000000000000000000000000000000..ac08f55e936bcc80366a92ecbcc997d0a1ec3a62 --- /dev/null +++ b/radiant.data/docs/reference/read_files.html @@ -0,0 +1,185 @@ + +Generate code to read a file — read_files • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Generate code to read a file

    + Source: R/radiant.R + +
    + +
    +

    Generate code to read a file

    +
    + +
    + 
    read_files(
+  path,
+  pdir = "",
+  type = "rmd",
+  to = "",
+  clipboard = TRUE,
+  radiant = FALSE
+)
    +
    + +
    +

    Arguments

    +
    path
    +

    Path to file. If empty, a file browser will be opened

    + + +
    pdir
    +

    Project dir

    + + +
    type
    +

    Generate code for _Report > Rmd_ ("rmd") or _Report > R_ ("r")

    + + +
    to
    +

    Name to use for object. If empty, will use file name to derive an object name

    + + +
    clipboard
    +

    Return code to clipboard (not available on Linux)

    + + +
    radiant
    +

    Should returned code be formatted for use with other code generated by Radiant?

    + +
    +
    +

    Details

    +

    Return code to read a file at the specified path. Will open a file browser if no path is provided

    +
    + +
    +

    Examples

    + 
    if (interactive()) {
+  read_files(clipboard = FALSE)
+}
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/reexports.html b/radiant.data/docs/reference/reexports.html new file mode 100644 index 0000000000000000000000000000000000000000..a54ba158868b47164b7c0b8be898ee058e44420d --- /dev/null +++ b/radiant.data/docs/reference/reexports.html @@ -0,0 +1,214 @@ + +Objects exported from other packages — reexports • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Objects exported from other packages

    + Source: R/aaa.R + +
    + +
    +

    These objects are imported from other packages. Follow the links +below to see their documentation.

    +
    broom
    +

    glance, tidy

    + + +
    bslib
    +

    bs_theme, theme_version

    + + +
    glue
    +

    glue, glue_collapse, glue_data

    + + +
    knitr
    +

    knit_print

    + + +
    lubridate
    +

    date

    + + +
    patchwork
    +

    plot_annotation, wrap_plots

    + + +
    png
    +

    writePNG

    + + +
    psych
    +

    kurtosi, skew

    + + +
    tibble
    +

    as_tibble, rownames_to_column, tibble

    + + +
    + + + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/refactor.html b/radiant.data/docs/reference/refactor.html new file mode 100644 index 0000000000000000000000000000000000000000..ac0fb6a612b37a8857a995d410605f4f4e2bb98f --- /dev/null +++ b/radiant.data/docs/reference/refactor.html @@ -0,0 +1,170 @@ + +Remove/reorder levels — refactor • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Remove/reorder levels

    + Source: R/transform.R + +
    + +
    +

    Remove/reorder levels

    +
    + +
    + 
    refactor(x, levs = levels(x), repl = NA)
    +
    + +
    +

    Arguments

    +
    x
    +

    Character or Factor

    + + +
    levs
    +

    Set of levels to use

    + + +
    repl
    +

    String (or NA) used to replace missing levels

    + +
    +
    +

    Details

    +

    Keep only a specific set of levels in a factor. By removing levels the base for comparison in, e.g., regression analysis, becomes the first level. To relabel the base use, for example, repl = 'other'

    +
    + +
    +

    Examples

    + 
    refactor(diamonds$cut, c("Premium", "Ideal")) %>% head()
+#> [1] Ideal   <NA>    <NA>    Ideal   Premium Ideal  
+#> Levels: Premium Ideal
+refactor(diamonds$cut, c("Premium", "Ideal"), "Other") %>% head()
+#> [1] Ideal   Other   Other   Ideal   Premium Ideal  
+#> Levels: Other Premium Ideal
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/register.html b/radiant.data/docs/reference/register.html new file mode 100644 index 0000000000000000000000000000000000000000..94b44f9fc556dde7b511fb8ce15af5d0087a80c0 --- /dev/null +++ b/radiant.data/docs/reference/register.html @@ -0,0 +1,174 @@ + +Register a data.frame or list in Radiant — register • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Register a data.frame or list in Radiant

    + Source: R/radiant.R + +
    + +
    +

    Register a data.frame or list in Radiant

    +
    + +
    + 
    register(
+  new,
+  org = "",
+  descr = "",
+  shiny = shiny::getDefaultReactiveDomain(),
+  envir = r_data
+)
    +
    + +
    +

    Arguments

    +
    new
    +

    String containing the name of the data.frame to register

    + + +
    org
    +

    Name of the original data.frame if a (working) copy is being made

    + + +
    descr
    +

    Data description in markdown format

    + + +
    shiny
    +

    Check if function is called from a shiny application

    + + +
    envir
    +

    Environment to assign data to

    + +
    +
    +

    See also

    +

    See also add_description to add a description in markdown format + to a data.frame

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/render.datatables.html b/radiant.data/docs/reference/render.datatables.html new file mode 100644 index 0000000000000000000000000000000000000000..42b315b4c60d0c138b4b6431dddca40b7a21a580 --- /dev/null +++ b/radiant.data/docs/reference/render.datatables.html @@ -0,0 +1,156 @@ + +Method to render DT tables — render.datatables • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Method to render DT tables

    + Source: R/radiant.R + +
    + +
    +

    Method to render DT tables

    +
    + +
    + 
    # S3 method for datatables
+render(object, shiny = shiny::getDefaultReactiveDomain(), ...)
    +
    + +
    +

    Arguments

    +
    object
    +

    DT table

    + + +
    shiny
    +

    Check if function is called from a shiny application

    + + +
    ...
    +

    Additional arguments

    + +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/render.html b/radiant.data/docs/reference/render.html new file mode 100644 index 0000000000000000000000000000000000000000..8b01a3f2f9ee05489f34323a446466b6ab1b630f --- /dev/null +++ b/radiant.data/docs/reference/render.html @@ -0,0 +1,151 @@ + +Base method used to render htmlwidgets — render • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Base method used to render htmlwidgets

    + Source: R/radiant.R + +
    + +
    +

    Base method used to render htmlwidgets

    +
    + +
    + 
    render(object, ...)
    +
    + +
    +

    Arguments

    +
    object
    +

    Object of relevant class to render

    + + +
    ...
    +

    Additional arguments

    + +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/render.plotly.html b/radiant.data/docs/reference/render.plotly.html new file mode 100644 index 0000000000000000000000000000000000000000..7c9c6df318dcee452e678345dec4bd58c34858e3 --- /dev/null +++ b/radiant.data/docs/reference/render.plotly.html @@ -0,0 +1,156 @@ + +Method to render plotly plots — render.plotly • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Method to render plotly plots

    + Source: R/radiant.R + +
    + +
    +

    Method to render plotly plots

    +
    + +
    + 
    # S3 method for plotly
+render(object, shiny = shiny::getDefaultReactiveDomain(), ...)
    +
    + +
    +

    Arguments

    +
    object
    +

    plotly object

    + + +
    shiny
    +

    Check if function is called from a shiny application

    + + +
    ...
    +

    Additional arguments

    + +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/round_df.html b/radiant.data/docs/reference/round_df.html new file mode 100644 index 0000000000000000000000000000000000000000..a442b68060e3fcb1e0e2f971755af3aa93ea10e2 --- /dev/null +++ b/radiant.data/docs/reference/round_df.html @@ -0,0 +1,166 @@ + +Round doubles in a data.frame to a specified number of decimal places — round_df • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Round doubles in a data.frame to a specified number of decimal places

    + Source: R/radiant.R + +
    + +
    +

    Round doubles in a data.frame to a specified number of decimal places

    +
    + +
    + 
    round_df(tbl, dec = 3)
    +
    + +
    +

    Arguments

    +
    tbl
    +

    Data frame

    + + +
    dec
    +

    Number of decimals to show

    + +
    +
    +

    Value

    + + +

    Data frame with rounded doubles

    +
    + +
    +

    Examples

    + 
    data.frame(x = as.factor(c("a", "b")), y = c(1L, 2L), z = c(-0.0005, 3.1)) %>%
+  round_df(dec = 2)
+#>   x y   z
+#> 1 a 1 0.0
+#> 2 b 2 3.1
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/rownames_to_column.html b/radiant.data/docs/reference/rownames_to_column.html new file mode 100644 index 0000000000000000000000000000000000000000..993305ffa21d88db7c2648ecc9dae0f1ee5ca0f5 --- /dev/null +++ b/radiant.data/docs/reference/rownames_to_column.html @@ -0,0 +1,215 @@ + + + + + + + + +Exporting rownames_to_column from tibble — rownames_to_column • radiant.data + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + +
    + +
    +
    +
    +

    Exporting rownames_to_column from tibble

    + Source: R/aaa.R + +
    + +
    +

    Exporting rownames_to_column from tibble

    +
    + + + +

    Details

    + +

    See rownames in the tibble package for more details

    + +
    + +
    + +
    +
    +

    Developed by Vincent Nijs.

    +
    + +
    +

    Site built with pkgdown 1.3.0.

    +
    +
    +
    + + + + + + + + + diff --git a/radiant.data/docs/reference/save_clip.html b/radiant.data/docs/reference/save_clip.html new file mode 100644 index 0000000000000000000000000000000000000000..970acc024901a21a8d2c1eea795b28805c1271ff --- /dev/null +++ b/radiant.data/docs/reference/save_clip.html @@ -0,0 +1,155 @@ + +Save data to clipboard on Windows or macOS — save_clip • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Save data to clipboard on Windows or macOS

    + Source: R/manage.R + +
    + +
    +

    Save data to clipboard on Windows or macOS

    +
    + +
    + 
    save_clip(dataset)
    +
    + +
    +

    Arguments

    +
    dataset
    +

    Dataset to save to clipboard

    + +
    +
    +

    Details

    +

    Save a data.frame or tibble to the clipboard on Windows or macOS

    +
    +
    +

    See also

    +

    See the load_clip

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/sdpop.html b/radiant.data/docs/reference/sdpop.html new file mode 100644 index 0000000000000000000000000000000000000000..55b93065fca67d04e635af112ad50d8c586d5ade --- /dev/null +++ b/radiant.data/docs/reference/sdpop.html @@ -0,0 +1,164 @@ + +Standard deviation for the population — sdpop • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Standard deviation for the population

    + Source: R/explore.R + +
    + +
    +

    Standard deviation for the population

    +
    + +
    + 
    sdpop(x, na.rm = TRUE)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + + +
    na.rm
    +

    If TRUE missing values are removed before calculation

    + +
    +
    +

    Value

    + + +

    Standard deviation for the population

    +
    + +
    +

    Examples

    + 
    sdpop(rnorm(100))
+#> [1] 0.9326249
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/sdprop.html b/radiant.data/docs/reference/sdprop.html new file mode 100644 index 0000000000000000000000000000000000000000..79e79fae80bb6dd60be668c26a1007e313c7bf3a --- /dev/null +++ b/radiant.data/docs/reference/sdprop.html @@ -0,0 +1,164 @@ + +Standard deviation for proportion — sdprop • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Standard deviation for proportion

    + Source: R/explore.R + +
    + +
    +

    Standard deviation for proportion

    +
    + +
    + 
    sdprop(x, na.rm = TRUE)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + + +
    na.rm
    +

    If TRUE missing values are removed before calculation

    + +
    +
    +

    Value

    + + +

    Standard deviation for proportion

    +
    + +
    +

    Examples

    + 
    sdprop(c(rep(1L, 10), rep(0L, 10)))
+#> [1] 0.5
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/se.html b/radiant.data/docs/reference/se.html new file mode 100644 index 0000000000000000000000000000000000000000..665fa2ffa7072d2719517358f15af2e299132b61 --- /dev/null +++ b/radiant.data/docs/reference/se.html @@ -0,0 +1,164 @@ + +Standard error — se • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Standard error

    + Source: R/explore.R + +
    + +
    +

    Standard error

    +
    + +
    + 
    se(x, na.rm = TRUE)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + + +
    na.rm
    +

    If TRUE missing values are removed before calculation

    + +
    +
    +

    Value

    + + +

    Standard error

    +
    + +
    +

    Examples

    + 
    se(rnorm(100))
+#> [1] 0.1073877
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/search_data.html b/radiant.data/docs/reference/search_data.html new file mode 100644 index 0000000000000000000000000000000000000000..becc7ab64e38a2a57f42fea1952105f9481af49c --- /dev/null +++ b/radiant.data/docs/reference/search_data.html @@ -0,0 +1,172 @@ + +Search for a pattern in all columns of a data.frame — search_data • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Search for a pattern in all columns of a data.frame

    + Source: R/view.R + +
    + +
    +

    Search for a pattern in all columns of a data.frame

    +
    + +
    + 
    search_data(dataset, pattern, ignore.case = TRUE, fixed = FALSE)
    +
    + +
    +

    Arguments

    +
    dataset
    +

    Data.frame to search

    + + +
    pattern
    +

    String to match

    + + +
    ignore.case
    +

    Should search be case sensitive or not (default is FALSE)

    + + +
    fixed
    +

    Allow regular expressions or not (default is FALSE)

    + +
    +
    +

    See also

    +

    See grepl for a detailed description of the function arguments

    +
    + +
    +

    Examples

    + 
    publishers %>% filter(search_data(., "^m"))
+#> # A tibble: 1 × 2
+#>   publisher yr_founded
+#>   <chr>          <int>
+#> 1 Marvel          1939
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/seprop.html b/radiant.data/docs/reference/seprop.html new file mode 100644 index 0000000000000000000000000000000000000000..f99b9a757d75f5548bd9ac2c066da5a42e0e02bf --- /dev/null +++ b/radiant.data/docs/reference/seprop.html @@ -0,0 +1,164 @@ + +Standard error for proportion — seprop • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Standard error for proportion

    + Source: R/explore.R + +
    + +
    +

    Standard error for proportion

    +
    + +
    + 
    seprop(x, na.rm = TRUE)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + + +
    na.rm
    +

    If TRUE missing values are removed before calculation

    + +
    +
    +

    Value

    + + +

    Standard error for proportion

    +
    + +
    +

    Examples

    + 
    seprop(c(rep(1L, 10), rep(0L, 10)))
+#> [1] 0.1118034
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/set_attr.html b/radiant.data/docs/reference/set_attr.html new file mode 100644 index 0000000000000000000000000000000000000000..0f17d8133ae8f8544fa10d03d034841c3094394c --- /dev/null +++ b/radiant.data/docs/reference/set_attr.html @@ -0,0 +1,160 @@ + +Alias used to add an attribute — set_attr • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Alias used to add an attribute

    + Source: R/radiant.R + +
    + +
    +

    Alias used to add an attribute

    +
    + +
    + 
    set_attr(x, which, value)
    +
    + +
    +

    Arguments

    +
    x
    +

    Object

    + + +
    which
    +

    Attribute name

    + + +
    value
    +

    Value to set

    + +
    + +
    +

    Examples

    + 
    foo <- data.frame(price = 1:5) %>% set_attr("description", "price set in experiment ...")
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/show_duplicated.html b/radiant.data/docs/reference/show_duplicated.html new file mode 100644 index 0000000000000000000000000000000000000000..4f76379523bcd8eb00f0506f2ddd1126875bfdb4 --- /dev/null +++ b/radiant.data/docs/reference/show_duplicated.html @@ -0,0 +1,186 @@ + +Show all rows with duplicated values (not just the first or last) — show_duplicated • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Show all rows with duplicated values (not just the first or last)

    + Source: R/transform.R + +
    + +
    +

    Show all rows with duplicated values (not just the first or last)

    +
    + +
    + 
    show_duplicated(.tbl, ...)
    +
    + +
    +

    Arguments

    +
    .tbl
    +

    Data frame to add transformed variables to

    + + +
    ...
    +

    Variables used to evaluate row uniqueness

    + +
    +
    +

    Details

    +

    If an entire row is duplicated use "duplicated" to show only one of the duplicated rows. When using a subset of variables to establish uniqueness it may be of interest to show all rows that have (some) duplicate elements

    +
    + +
    +

    Examples

    + 
    bind_rows(mtcars, mtcars[c(1, 5, 7), ]) %>%
+  show_duplicated(mpg, cyl)
+#> # A tibble: 15 × 12
+#>      mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb nr_dup
+#>    <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>  <int>
+#>  1  10.4     8 472     205  2.93  5.25  18.0     0     0     3     4      1
+#>  2  10.4     8 460     215  3     5.42  17.8     0     0     3     4      2
+#>  3  14.3     8 360     245  3.21  3.57  15.8     0     0     3     4      1
+#>  4  14.3     8 360     245  3.21  3.57  15.8     0     0     3     4      2
+#>  5  15.2     8 276.    180  3.07  3.78  18       0     0     3     3      1
+#>  6  15.2     8 304     150  3.15  3.44  17.3     0     0     3     2      2
+#>  7  18.7     8 360     175  3.15  3.44  17.0     0     0     3     2      1
+#>  8  18.7     8 360     175  3.15  3.44  17.0     0     0     3     2      2
+#>  9  21       6 160     110  3.9   2.62  16.5     0     1     4     4      1
+#> 10  21       6 160     110  3.9   2.88  17.0     0     1     4     4      2
+#> 11  21       6 160     110  3.9   2.62  16.5     0     1     4     4      3
+#> 12  22.8     4 108      93  3.85  2.32  18.6     1     1     4     1      1
+#> 13  22.8     4 141.     95  3.92  3.15  22.9     1     0     4     2      2
+#> 14  30.4     4  75.7    52  4.93  1.62  18.5     1     1     4     2      1
+#> 15  30.4     4  95.1   113  3.77  1.51  16.9     1     1     5     2      2
+bind_rows(mtcars, mtcars[c(1, 5, 7), ]) %>%
+  show_duplicated()
+#>                    mpg cyl disp  hp drat   wt  qsec vs am gear carb
+#> Mazda RX4         21.0   6  160 110 3.90 2.62 16.46  0  1    4    4
+#> Hornet Sportabout 18.7   8  360 175 3.15 3.44 17.02  0  0    3    2
+#> Duster 360        14.3   8  360 245 3.21 3.57 15.84  0  0    3    4
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/sig_stars.html b/radiant.data/docs/reference/sig_stars.html new file mode 100644 index 0000000000000000000000000000000000000000..2e64b9ac9c6bd73c5db05aa1651c315a38bd9ce3 --- /dev/null +++ b/radiant.data/docs/reference/sig_stars.html @@ -0,0 +1,159 @@ + +Add stars based on p.values — sig_stars • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Add stars based on p.values

    + Source: R/radiant.R + +
    + +
    +

    Add stars based on p.values

    +
    + +
    + 
    sig_stars(pval)
    +
    + +
    +

    Arguments

    +
    pval
    +

    Vector of p-values

    + +
    +
    +

    Value

    + + +

    A vector of stars

    +
    + +
    +

    Examples

    + 
    sig_stars(c(.0009, .049, .009, .4, .09))
+#> [1] "***" "*"   "**"  ""    "."  
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/skew.re.html b/radiant.data/docs/reference/skew.re.html new file mode 100644 index 0000000000000000000000000000000000000000..31a2ddaca57f4320310da7ad6d588c5e89355515 --- /dev/null +++ b/radiant.data/docs/reference/skew.re.html @@ -0,0 +1,215 @@ + + + + + + + + +Exporting skew from psych — skew • radiant.data + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + +
    + +
    +
    +
    +

    Exporting skew from psych

    + Source: R/aaa.R + +
    + +
    +

    Exporting skew from psych

    +
    + + + +

    Details

    + +

    See skew in the psych package for more details

    + +
    + +
    + +
    +
    +

    Developed by Vincent Nijs.

    +
    + +
    +

    Site built with pkgdown 1.3.0.

    +
    +
    +
    + + + + + + + + + diff --git a/radiant.data/docs/reference/slice_data.html b/radiant.data/docs/reference/slice_data.html new file mode 100644 index 0000000000000000000000000000000000000000..a0798302a6ffcbdbe19847c427444681698235e1 --- /dev/null +++ b/radiant.data/docs/reference/slice_data.html @@ -0,0 +1,165 @@ + +Slice data with user-specified expression — slice_data • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Slice data with user-specified expression

    + Source: R/view.R + +
    + +
    +

    Slice data with user-specified expression

    +
    + +
    + 
    slice_data(dataset, expr = NULL, drop = TRUE)
    +
    + +
    +

    Arguments

    +
    dataset
    +

    Data frame to slice

    + + +
    expr
    +

    Expression to use select rows from the specified dataset

    + + +
    drop
    +

    Drop unused factor levels after filtering (default is TRUE)

    + +
    +
    +

    Value

    + + +

    Sliced data frame

    +
    +
    +

    Details

    +

    Select only a slice of the data to work with

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/square.html b/radiant.data/docs/reference/square.html new file mode 100644 index 0000000000000000000000000000000000000000..ed1a62cc9821f950cc0f0a5841c51b5aaaf00ec9 --- /dev/null +++ b/radiant.data/docs/reference/square.html @@ -0,0 +1,153 @@ + +Calculate square of a variable — square • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Calculate square of a variable

    + Source: R/transform.R + +
    + +
    +

    Calculate square of a variable

    +
    + +
    + 
    square(x)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + +
    +
    +

    Value

    + + +

    x^2

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/sshh.html b/radiant.data/docs/reference/sshh.html new file mode 100644 index 0000000000000000000000000000000000000000..43046232a3cc778f8ecfddcf4a33a14f24f51e1d --- /dev/null +++ b/radiant.data/docs/reference/sshh.html @@ -0,0 +1,156 @@ + +Hide warnings and messages and return invisible — sshh • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Hide warnings and messages and return invisible

    + Source: R/radiant.R + +
    + +
    +

    Hide warnings and messages and return invisible

    +
    + +
    + 
    sshh(...)
    +
    + +
    +

    Arguments

    +
    ...
    +

    Inputs to keep quite

    + +
    +
    +

    Details

    +

    Hide warnings and messages and return invisible

    +
    + +
    +

    Examples

    + 
    sshh(library(dplyr))
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/sshhr.html b/radiant.data/docs/reference/sshhr.html new file mode 100644 index 0000000000000000000000000000000000000000..873b045cc280a2355a3c6e407e4b3ee1ead67343 --- /dev/null +++ b/radiant.data/docs/reference/sshhr.html @@ -0,0 +1,156 @@ + +Hide warnings and messages and return result — sshhr • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Hide warnings and messages and return result

    + Source: R/radiant.R + +
    + +
    +

    Hide warnings and messages and return result

    +
    + +
    + 
    sshhr(...)
    +
    + +
    +

    Arguments

    +
    ...
    +

    Inputs to keep quite

    + +
    +
    +

    Details

    +

    Hide warnings and messages and return result

    +
    + +
    +

    Examples

    + 
    sshhr(library(dplyr))
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/standardize.html b/radiant.data/docs/reference/standardize.html new file mode 100644 index 0000000000000000000000000000000000000000..1cb9fc5eb50606c5009211485b00b5c089d89098 --- /dev/null +++ b/radiant.data/docs/reference/standardize.html @@ -0,0 +1,157 @@ + +Standardize — standardize • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Standardize

    + Source: R/transform.R + +
    + +
    +

    Standardize

    +
    + +
    + 
    standardize(x, na.rm = TRUE)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + + +
    na.rm
    +

    If TRUE missing values are removed before calculation

    + +
    +
    +

    Value

    + + +

    If x is a numeric variable return (x - mean(x)) / sd(x)

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/store.explore.html b/radiant.data/docs/reference/store.explore.html new file mode 100644 index 0000000000000000000000000000000000000000..c5b626cb40e992e77e3d1ff7d662184a0b0e5d32 --- /dev/null +++ b/radiant.data/docs/reference/store.explore.html @@ -0,0 +1,168 @@ + +Deprecated: Store method for the explore function — store.explore • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Deprecated: Store method for the explore function

    + Source: R/explore.R + +
    + +
    +

    Deprecated: Store method for the explore function

    +
    + +
    + 
    # S3 method for explore
+store(dataset, object, name, ...)
    +
    + +
    +

    Arguments

    +
    dataset
    +

    Dataset

    + + +
    object
    +

    Return value from explore

    + + +
    name
    +

    Name to assign to the dataset

    + + +
    ...
    +

    further arguments passed to or from other methods

    + +
    +
    +

    Details

    +

    Return the summarized data. See https://radiant-rstats.github.io/docs/data/explore.html for an example in Radiant

    +
    +
    +

    See also

    +

    explore to generate summaries

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/store.html b/radiant.data/docs/reference/store.html new file mode 100644 index 0000000000000000000000000000000000000000..cbd5b6e4f38c514bfb3d9c1a7088b786772e1144 --- /dev/null +++ b/radiant.data/docs/reference/store.html @@ -0,0 +1,155 @@ + +Method to store variables in a dataset in Radiant — store • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Method to store variables in a dataset in Radiant

    + Source: R/radiant.R + +
    + +
    +

    Method to store variables in a dataset in Radiant

    +
    + +
    + 
    store(dataset, object = "deprecated", ...)
    +
    + +
    +

    Arguments

    +
    dataset
    +

    Dataset

    + + +
    object
    +

    Object of relevant class that has information to be stored

    + + +
    ...
    +

    Additional arguments

    + +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/store.pivotr.html b/radiant.data/docs/reference/store.pivotr.html new file mode 100644 index 0000000000000000000000000000000000000000..e97c5a9f65a35113aefb97f77423cc31721075bf --- /dev/null +++ b/radiant.data/docs/reference/store.pivotr.html @@ -0,0 +1,168 @@ + +Deprecated: Store method for the pivotr function — store.pivotr • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Deprecated: Store method for the pivotr function

    + Source: R/pivotr.R + +
    + +
    +

    Deprecated: Store method for the pivotr function

    +
    + +
    + 
    # S3 method for pivotr
+store(dataset, object, name, ...)
    +
    + +
    +

    Arguments

    +
    dataset
    +

    Dataset

    + + +
    object
    +

    Return value from pivotr

    + + +
    name
    +

    Name to assign to the dataset

    + + +
    ...
    +

    further arguments passed to or from other methods

    + +
    +
    +

    Details

    +

    Return the summarized data. See https://radiant-rstats.github.io/docs/data/pivotr.html for an example in Radiant

    +
    +
    +

    See also

    +

    pivotr to generate summaries

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/subplot.html b/radiant.data/docs/reference/subplot.html new file mode 100644 index 0000000000000000000000000000000000000000..7019d256d57b332943e220a963ed7a4ced866852 --- /dev/null +++ b/radiant.data/docs/reference/subplot.html @@ -0,0 +1,155 @@ + +Work around to avoid (harmless) messages from subplot — subplot • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Work around to avoid (harmless) messages from subplot

    + Source: R/radiant.R + +
    + +
    +

    Work around to avoid (harmless) messages from subplot

    +
    + +
    + 
    subplot(..., margin = 0.04)
    +
    + +
    +

    Arguments

    +
    ...
    +

    Arguments to pass to the subplot function in the plotly packages

    + + +
    margin
    +

    Default margin to use between plots

    + +
    +
    +

    See also

    +

    See the subplot in the plotly package for details (?plotly::subplot)

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/summary.explore.html b/radiant.data/docs/reference/summary.explore.html new file mode 100644 index 0000000000000000000000000000000000000000..1ca2ca8bce6873f78e28f5aff76b321371e0af96 --- /dev/null +++ b/radiant.data/docs/reference/summary.explore.html @@ -0,0 +1,256 @@ + +Summary method for the explore function — summary.explore • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Summary method for the explore function

    + Source: R/explore.R + +
    + +
    +

    Summary method for the explore function

    +
    + +
    + 
    # S3 method for explore
+summary(object, dec = 3, ...)
    +
    + +
    +

    Arguments

    +
    object
    +

    Return value from explore

    + + +
    dec
    +

    Number of decimals to show

    + + +
    ...
    +

    further arguments passed to or from other methods

    + +
    +
    +

    Details

    +

    See https://radiant-rstats.github.io/docs/data/explore.html for an example in Radiant

    +
    +
    +

    See also

    +

    explore to generate summaries

    +
    + +
    +

    Examples

    + 
    result <- explore(diamonds, "price:x")
+summary(result)
+#> Explore
+#> Data        : diamonds 
+#> Functions   : mean, sd 
+#> Top         : Function 
+#> 
+#>  variable      mean        sd
+#>     price 3,907.186 3,956.915
+#>     carat     0.794     0.474
+#>   clarity     0.013     0.115
+#>       cut     0.034     0.180
+#>     color     0.127     0.333
+#>     depth    61.753     1.446
+#>     table    57.465     2.241
+#>         x     5.722     1.124
+result <- explore(diamonds, "price", byvar = "cut", fun = c("n_obs", "skew"))
+summary(result)
+#> Explore
+#> Data        : diamonds 
+#> Grouped by  : cut 
+#> Functions   : n_obs, skew 
+#> Top         : Function 
+#> 
+#>        cut variable n_obs  skew
+#>       Fair    price   101 1.574
+#>       Good    price   275 1.489
+#>  Very Good    price   677 1.601
+#>    Premium    price   771 1.413
+#>      Ideal    price 1,176 1.799
+explore(diamonds, "price:x", byvar = "color") %>% summary()
+#> Explore
+#> Data        : diamonds 
+#> Grouped by  : color 
+#> Functions   : mean, sd 
+#> Top         : Function 
+#> 
+#>  color variable      mean        sd
+#>      D    price 3,217.003 3,278.276
+#>      D    carat     0.665     0.365
+#>      D  clarity     0.010     0.102
+#>      D      cut     0.039     0.194
+#>      D    depth    61.705     1.452
+#>      D    table    57.438     2.269
+#>      D        x     5.437     0.943
+#>      E    price 3,284.596 3,610.872
+#>      E    carat     0.679     0.391
+#>      E  clarity     0.009     0.095
+#>      E      cut     0.025     0.157
+#>      E    depth    61.768     1.391
+#>      E    table    57.548     2.262
+#>      E        x     5.455     0.999
+#>      F    price 3,654.492 3,779.511
+#>      F    carat     0.728     0.405
+#>      F  clarity     0.019     0.138
+#>      F      cut     0.030     0.171
+#>      F    depth    61.686     1.396
+#>      F    table    57.428     2.275
+#>      F        x     5.590     1.016
+#>      G    price 3,970.573 4,002.082
+#>      G    carat     0.774     0.451
+#>      G  clarity     0.008     0.091
+#>      G      cut     0.027     0.162
+#>      G    depth    61.669     1.404
+#>      G    table    57.341     2.133
+#>      G        x     5.686     1.094
+#>      H    price 4,250.302 4,063.648
+#>      H    carat     0.880     0.503
+#>      H  clarity     0.018     0.132
+#>      H      cut     0.046     0.210
+#>      H    depth    61.841     1.463
+#>      H    table    57.464     2.208
+#>      H        x     5.914     1.186
+#>      I    price 4,869.190 4,570.572
+#>      I    carat     1.001     0.573
+#>      I  clarity     0.018     0.132
+#>      I      cut     0.039     0.193
+#>      I    depth    61.938     1.620
+#>      I    table    57.446     2.160
+#>      I        x     6.163     1.251
+#>      J    price 5,642.012 4,574.576
+#>      J    carat     1.193     0.602
+#>      J  clarity     0.012     0.110
+#>      J      cut     0.043     0.203
+#>      J    depth    61.779     1.549
+#>      J    table    57.863     2.563
+#>      J        x     6.578     1.237
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/summary.pivotr.html b/radiant.data/docs/reference/summary.pivotr.html new file mode 100644 index 0000000000000000000000000000000000000000..035719b3e3a29a006f32b3d71e324879d9d65129 --- /dev/null +++ b/radiant.data/docs/reference/summary.pivotr.html @@ -0,0 +1,239 @@ + +Summary method for pivotr — summary.pivotr • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Summary method for pivotr

    + Source: R/pivotr.R + +
    + +
    +

    Summary method for pivotr

    +
    + +
    + 
    # S3 method for pivotr
+summary(object, perc = FALSE, dec = 3, chi2 = FALSE, shiny = FALSE, ...)
    +
    + +
    +

    Arguments

    +
    object
    +

    Return value from pivotr

    + + +
    perc
    +

    Display numbers as percentages (TRUE or FALSE)

    + + +
    dec
    +

    Number of decimals to show

    + + +
    chi2
    +

    If TRUE calculate the chi-square statistic for the (pivot) table

    + + +
    shiny
    +

    Did the function call originate inside a shiny app

    + + +
    ...
    +

    further arguments passed to or from other methods

    + +
    +
    +

    Details

    +

    See https://radiant-rstats.github.io/docs/data/pivotr.html for an example in Radiant

    +
    +
    +

    See also

    +

    pivotr to create the pivot-table using dplyr

    +
    + +
    +

    Examples

    + 
    pivotr(diamonds, cvars = "cut") %>% summary(chi2 = TRUE)
+#> Pivot table
+#> Data        : diamonds 
+#> Categorical : cut 
+#> 
+#>        cut n_obs
+#>       Fair   101
+#>       Good   275
+#>  Very Good   677
+#>    Premium   771
+#>      Ideal 1,176
+#>      Total 3,000
+#> 
+#> Chi-squared: 1202.62 df(4), p.value < .001
+#> 0.0% of cells have expected values below 5
+pivotr(diamonds, cvars = "cut", tabsort = "desc(n_obs)") %>% summary()
+#> Pivot table
+#> Data        : diamonds 
+#> Table sorted: desc(n_obs) 
+#> Categorical : cut 
+#> 
+#>        cut n_obs
+#>      Ideal 1,176
+#>    Premium   771
+#>  Very Good   677
+#>       Good   275
+#>       Fair   101
+#>      Total 3,000
+#> 
+pivotr(diamonds, cvars = "cut", tabfilt = "n_obs > 700") %>% summary()
+#> Pivot table
+#> Data        : diamonds 
+#> Table filter: n_obs > 700 
+#> Categorical : cut 
+#> 
+#>      cut n_obs
+#>  Premium   771
+#>    Ideal 1,176
+#>    Total 3,000
+#> 
+pivotr(diamonds, cvars = "cut:clarity", nvar = "price") %>% summary()
+#> Pivot table
+#> Data        : diamonds 
+#> Categorical : cut clarity 
+#> Numeric     : price 
+#> Function    : mean 
+#> 
+#>  clarity      Fair      Good Very_Good   Premium     Ideal     Total
+#>       I1 2,730.167 4,333.500 3,864.167 4,932.231 6,078.200 4,194.775
+#>      SI2 5,893.964 5,280.919 5,045.621 5,568.019 4,435.673 5,100.189
+#>      SI1 4,273.069 3,757.022 4,277.544 4,113.811 3,758.125 3,998.577
+#>      VS2 3,292.000 3,925.481 3,950.947 4,522.914 3,306.290 3,822.967
+#>      VS1 5,110.769 3,740.697 3,889.475 4,461.333 3,189.362 3,789.181
+#>     VVS2 2,030.500 4,378.167 2,525.193 3,580.581 3,665.181 3,337.820
+#>     VVS1 6,761.500 3,889.333 1,945.875 1,426.692 2,960.594 2,608.460
+#>       IF 3,205.000   817.250 4,675.867 2,361.333 1,961.344 2,411.697
+#>    Total 4,505.238 4,130.433 3,959.916 4,369.409 3,470.224 3,907.186
+#> 
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/superheroes.html b/radiant.data/docs/reference/superheroes.html new file mode 100644 index 0000000000000000000000000000000000000000..9c5225893639bc7d070393143c10468762385187 --- /dev/null +++ b/radiant.data/docs/reference/superheroes.html @@ -0,0 +1,149 @@ + +Super heroes — superheroes • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Super heroes

    + Source: R/aaa.R + +
    + +
    +

    Super heroes

    +
    + +
    + 
    data(superheroes)
    +
    + +
    +

    Format

    +

    A data frame with 7 rows and 4 variables

    +
    +
    +

    Details

    +

    List of super heroes from https://stat545.com/join-cheatsheet.html. The dataset is used to illustrate data merging / joining. Description provided in attr(superheroes,"description")

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/table2data.html b/radiant.data/docs/reference/table2data.html new file mode 100644 index 0000000000000000000000000000000000000000..dc40cf54db91436dd11b7d6465ea02b2e7ef57d7 --- /dev/null +++ b/radiant.data/docs/reference/table2data.html @@ -0,0 +1,170 @@ + +Create data.frame from a table — table2data • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Create data.frame from a table

    + Source: R/transform.R + +
    + +
    +

    Create data.frame from a table

    +
    + +
    + 
    table2data(dataset, freq = tail(colnames(dataset), 1))
    +
    + +
    +

    Arguments

    +
    dataset
    +

    Data.frame

    + + +
    freq
    +

    Column name with frequency information

    + +
    + +
    +

    Examples

    + 
    data.frame(price = c("$200", "$300"), sale = c(10, 2)) %>% table2data()
+#>     price
+#> 1    $200
+#> 1.1  $200
+#> 1.2  $200
+#> 1.3  $200
+#> 1.4  $200
+#> 1.5  $200
+#> 1.6  $200
+#> 1.7  $200
+#> 1.8  $200
+#> 1.9  $200
+#> 2    $300
+#> 2.1  $300
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/tibble.html b/radiant.data/docs/reference/tibble.html new file mode 100644 index 0000000000000000000000000000000000000000..a0a763860ec829f09d96faa6aabc20c25200e217 --- /dev/null +++ b/radiant.data/docs/reference/tibble.html @@ -0,0 +1,215 @@ + + + + + + + + +Exporting tibble from tibble — tibble • radiant.data + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + +
    + +
    +
    +
    +

    Exporting tibble from tibble

    + Source: R/aaa.R + +
    + +
    +

    Exporting tibble from tibble

    +
    + + + +

    Details

    + +

    See tibble in the tibble package for more details

    + +
    + +
    + +
    +
    +

    Developed by Vincent Nijs.

    +
    + +
    +

    Site built with pkgdown 1.3.0.

    +
    +
    +
    + + + + + + + + + diff --git a/radiant.data/docs/reference/tidy.html b/radiant.data/docs/reference/tidy.html new file mode 100644 index 0000000000000000000000000000000000000000..c9e45ec553e416563f679c2a97fcc7f5eae324dc --- /dev/null +++ b/radiant.data/docs/reference/tidy.html @@ -0,0 +1,215 @@ + + + + + + + + +Exporting tidy from broom — tidy • radiant.data + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + +
    + +
    +
    +
    +

    Exporting tidy from broom

    + Source: R/aaa.R + +
    + +
    +

    Exporting tidy from broom

    +
    + + + +

    Details

    + +

    See tidy in the broom package for more details

    + +
    + +
    + +
    +
    +

    Developed by Vincent Nijs.

    +
    + +
    +

    Site built with pkgdown 1.3.0.

    +
    +
    +
    + + + + + + + + + diff --git a/radiant.data/docs/reference/titanic.html b/radiant.data/docs/reference/titanic.html new file mode 100644 index 0000000000000000000000000000000000000000..9b463f51485072e57f076fda25c533e5167b1a3c --- /dev/null +++ b/radiant.data/docs/reference/titanic.html @@ -0,0 +1,149 @@ + +Survival data for the Titanic — titanic • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Survival data for the Titanic

    + Source: R/aaa.R + +
    + +
    +

    Survival data for the Titanic

    +
    + +
    + 
    data(titanic)
    +
    + +
    +

    Format

    +

    A data frame with 1043 rows and 10 variables

    +
    +
    +

    Details

    +

    Survival data for the Titanic. Description provided in attr(titanic,"description")

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/to_fct.html b/radiant.data/docs/reference/to_fct.html new file mode 100644 index 0000000000000000000000000000000000000000..8bca1da76175f8890cc2fb00c699ac9af57d3705 --- /dev/null +++ b/radiant.data/docs/reference/to_fct.html @@ -0,0 +1,173 @@ + +Convert characters to factors — to_fct • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Convert characters to factors

    + Source: R/radiant.R + +
    + +
    +

    Convert characters to factors

    +
    + +
    + 
    to_fct(dataset, safx = 30, nuniq = 100, n = 100)
    +
    + +
    +

    Arguments

    +
    dataset
    +

    Data frame

    + + +
    safx
    +

    Ratio of number of rows to number of unique values

    + + +
    nuniq
    +

    Cutoff for number of unique values

    + + +
    n
    +

    Cutoff for small dataset

    + +
    +
    +

    Details

    +

    Convert columns of type character to factors based on a set of rules. By default columns will be converted for small datasets (<= 100 rows) with more rows than unique values. For larger datasets, columns are converted only when the number of unique values is <= 100 and there are 30 or more rows in the data for every unique value

    +
    + +
    +

    Examples

    + 
    tibble(a = c("a", "b"), b = c("a", "a"), c = 1:2) %>% to_fct()
+#> # A tibble: 2 × 3
+#>   a     b         c
+#>   <chr> <fct> <int>
+#> 1 a     a         1
+#> 2 b     a         2
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/varpop.html b/radiant.data/docs/reference/varpop.html new file mode 100644 index 0000000000000000000000000000000000000000..ed59e8847d69843e6a3738a69079cb2f133cf97b --- /dev/null +++ b/radiant.data/docs/reference/varpop.html @@ -0,0 +1,164 @@ + +Variance for the population — varpop • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Variance for the population

    + Source: R/explore.R + +
    + +
    +

    Variance for the population

    +
    + +
    + 
    varpop(x, na.rm = TRUE)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + + +
    na.rm
    +

    If TRUE missing values are removed before calculation

    + +
    +
    +

    Value

    + + +

    Variance for the population

    +
    + +
    +

    Examples

    + 
    varpop(rnorm(100))
+#> [1] 1.184664
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/varprop.html b/radiant.data/docs/reference/varprop.html new file mode 100644 index 0000000000000000000000000000000000000000..86f47dc8560ae44ed1721b1dd6dc218d80720e9c --- /dev/null +++ b/radiant.data/docs/reference/varprop.html @@ -0,0 +1,164 @@ + +Variance for proportion — varprop • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Variance for proportion

    + Source: R/explore.R + +
    + +
    +

    Variance for proportion

    +
    + +
    + 
    varprop(x, na.rm = TRUE)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input variable

    + + +
    na.rm
    +

    If TRUE missing values are removed before calculation

    + +
    +
    +

    Value

    + + +

    Variance for proportion

    +
    + +
    +

    Examples

    + 
    varprop(c(rep(1L, 10), rep(0L, 10)))
+#> [1] 0.25
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/view_data.html b/radiant.data/docs/reference/view_data.html new file mode 100644 index 0000000000000000000000000000000000000000..ac41b4b06c7766af225baf29b38abb125773d97c --- /dev/null +++ b/radiant.data/docs/reference/view_data.html @@ -0,0 +1,200 @@ + +View data in a shiny-app — view_data • radiant.data + + +
    +
    + + + +
    +
    +
    +

    View data in a shiny-app

    + Source: R/view.R + +
    + +
    +

    View data in a shiny-app

    +
    + +
    + 
    view_data(
+  dataset,
+  vars = "",
+  filt = "",
+  arr = "",
+  rows = NULL,
+  na.rm = FALSE,
+  dec = 3,
+  envir = parent.frame()
+)
    +
    + +
    +

    Arguments

    +
    dataset
    +

    Data.frame or name of the dataframe to view

    + + +
    vars
    +

    Variables to show (default is all)

    + + +
    filt
    +

    Filter to apply to the specified dataset

    + + +
    arr
    +

    Expression to arrange (sort) data

    + + +
    rows
    +

    Select rows in the specified dataset

    + + +
    na.rm
    +

    Remove rows with missing values (default is FALSE)

    + + +
    dec
    +

    Number of decimals to show

    + + +
    envir
    +

    Environment to extract data from

    + +
    +
    +

    Details

    +

    View, search, sort, etc. your data

    +
    +
    +

    See also

    +

    See get_data and filter_data

    +
    + +
    +

    Examples

    + 
    if (FALSE) {
+view_data(mtcars)
+}
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/visualize-1.png b/radiant.data/docs/reference/visualize-1.png new file mode 100644 index 0000000000000000000000000000000000000000..2de24b5a01a74d2f6b8e1eecfcfb0173fe03416a Binary files /dev/null and b/radiant.data/docs/reference/visualize-1.png differ diff --git a/radiant.data/docs/reference/visualize-2.png b/radiant.data/docs/reference/visualize-2.png new file mode 100644 index 0000000000000000000000000000000000000000..87b3bff4ee0a69dfddcf7dc2c55d4aaf642f2bbc Binary files /dev/null and b/radiant.data/docs/reference/visualize-2.png differ diff --git a/radiant.data/docs/reference/visualize-3.png b/radiant.data/docs/reference/visualize-3.png new file mode 100644 index 0000000000000000000000000000000000000000..2d849bee2cd6533eeaf03d0a46d68fb1f7bfda3c Binary files /dev/null and b/radiant.data/docs/reference/visualize-3.png differ diff --git a/radiant.data/docs/reference/visualize-4.png b/radiant.data/docs/reference/visualize-4.png new file mode 100644 index 0000000000000000000000000000000000000000..60bdd5db36d340a7941fbc8c5b3d2ac492c98e26 Binary files /dev/null and b/radiant.data/docs/reference/visualize-4.png differ diff --git a/radiant.data/docs/reference/visualize-5.png b/radiant.data/docs/reference/visualize-5.png new file mode 100644 index 0000000000000000000000000000000000000000..4236918291663a028702fe6b127768b0cfb16afe Binary files /dev/null and b/radiant.data/docs/reference/visualize-5.png differ diff --git a/radiant.data/docs/reference/visualize-6.png b/radiant.data/docs/reference/visualize-6.png new file mode 100644 index 0000000000000000000000000000000000000000..052fc839c31cd02fca21e4dba8e5c61acd112774 Binary files /dev/null and b/radiant.data/docs/reference/visualize-6.png differ diff --git a/radiant.data/docs/reference/visualize-7.png b/radiant.data/docs/reference/visualize-7.png new file mode 100644 index 0000000000000000000000000000000000000000..ec74ef7be821d59903fa6d1c56b9fde2c8af1828 Binary files /dev/null and b/radiant.data/docs/reference/visualize-7.png differ diff --git a/radiant.data/docs/reference/visualize-8.png b/radiant.data/docs/reference/visualize-8.png new file mode 100644 index 0000000000000000000000000000000000000000..87388bee6d2d964d73fcbaf374b4b37dd6fd8143 Binary files /dev/null and b/radiant.data/docs/reference/visualize-8.png differ diff --git a/radiant.data/docs/reference/visualize.html b/radiant.data/docs/reference/visualize.html new file mode 100644 index 0000000000000000000000000000000000000000..bd0cb4c8955d8492b8bf3fb7757e3160f19e6cfe --- /dev/null +++ b/radiant.data/docs/reference/visualize.html @@ -0,0 +1,357 @@ + +Visualize data using ggplot2 https://ggplot2.tidyverse.org/ — visualize • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Visualize data using ggplot2 https://ggplot2.tidyverse.org/

    + Source: R/visualize.R + +
    + +
    +

    Visualize data using ggplot2 https://ggplot2.tidyverse.org/

    +
    + +
    + 
    visualize(
+  dataset,
+  xvar,
+  yvar = "",
+  comby = FALSE,
+  combx = FALSE,
+  type = ifelse(is.empty(yvar), "dist", "scatter"),
+  nrobs = -1,
+  facet_row = ".",
+  facet_col = ".",
+  color = "none",
+  fill = "none",
+  size = "none",
+  fillcol = "blue",
+  linecol = "black",
+  pointcol = "black",
+  bins = 10,
+  smooth = 1,
+  fun = "mean",
+  check = "",
+  axes = "",
+  alpha = 0.5,
+  theme = "theme_gray",
+  base_size = 11,
+  base_family = "",
+  labs = list(),
+  xlim = NULL,
+  ylim = NULL,
+  data_filter = "",
+  arr = "",
+  rows = NULL,
+  shiny = FALSE,
+  custom = FALSE,
+  envir = parent.frame()
+)
    +
    + +
    +

    Arguments

    +
    dataset
    +

    Data to plot (data.frame or tibble)

    + + +
    xvar
    +

    One or more variables to display along the X-axis of the plot

    + + +
    yvar
    +

    Variable to display along the Y-axis of the plot (default = "none")

    + + +
    comby
    +

    Combine yvars in plot (TRUE or FALSE, FALSE is the default)

    + + +
    combx
    +

    Combine xvars in plot (TRUE or FALSE, FALSE is the default)

    + + +
    type
    +

    Type of plot to create. One of Distribution ('dist'), Density ('density'), Scatter ('scatter'), Surface ('surface'), Line ('line'), Bar ('bar'), or Box-plot ('box')

    + + +
    nrobs
    +

    Number of data points to show in scatter plots (-1 for all)

    + + +
    facet_row
    +

    Create vertically arranged subplots for each level of the selected factor variable

    + + +
    facet_col
    +

    Create horizontally arranged subplots for each level of the selected factor variable

    + + +
    color
    +

    Adds color to a scatter plot to generate a 'heat map'. For a line plot one line is created for each group and each is assigned a different color

    + + +
    fill
    +

    Display bar, distribution, and density plots by group, each with a different color. Also applied to surface plots to generate a 'heat map'

    + + +
    size
    +

    Numeric variable used to scale the size of scatter-plot points

    + + +
    fillcol
    +

    Color used for bars, boxes, etc. when no color or fill variable is specified

    + + +
    linecol
    +

    Color for lines when no color variable is specified

    + + +
    pointcol
    +

    Color for points when no color variable is specified

    + + +
    bins
    +

    Number of bins used for a histogram (1 - 50)

    + + +
    smooth
    +

    Adjust the flexibility of the loess line for scatter plots

    + + +
    fun
    +

    Set the summary measure for line and bar plots when the X-variable is a factor (default is "mean"). Also used to plot an error bar in a scatter plot when the X-variable is a factor. Options are "mean" and/or "median"

    + + +
    check
    +

    Add a regression line ("line"), a loess line ("loess"), or jitter ("jitter") to a scatter plot

    + + +
    axes
    +

    Flip the axes in a plot ("flip") or apply a log transformation (base e) to the y-axis ("log_y") or the x-axis ("log_x")

    + + +
    alpha
    +

    Opacity for plot elements (0 to 1)

    + + +
    theme
    +

    ggplot theme to use (e.g., "theme_gray" or "theme_classic")

    + + +
    base_size
    +

    Base font size to use (default = 11)

    + + +
    base_family
    +

    Base font family to use (e.g., "Times" or "Helvetica")

    + + +
    labs
    +

    Labels to use for plots

    + + +
    xlim
    +

    Set limit for x-axis (e.g., c(0, 1))

    + + +
    ylim
    +

    Set limit for y-axis (e.g., c(0, 1))

    + + +
    data_filter
    +

    Expression used to filter the dataset. This should be a string (e.g., "price > 10000")

    + + +
    arr
    +

    Expression used to sort the data. Likely used in combination for `rows`

    + + +
    rows
    +

    Rows to select from the specified dataset

    + + +
    shiny
    +

    Logical (TRUE, FALSE) to indicate if the function call originate inside a shiny app

    + + +
    custom
    +

    Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and https://ggplot2.tidyverse.org for options.

    + + +
    envir
    +

    Environment to extract data from

    + +
    +
    +

    Value

    + + +

    Generated plots

    +
    +
    +

    Details

    +

    See https://radiant-rstats.github.io/docs/data/visualize.html for an example in Radiant

    +
    + +
    +

    Examples

    + 
    visualize(diamonds, "price:cut", type = "dist", fillcol = "red")
+
+visualize(diamonds, "carat:cut",
+  yvar = "price", type = "scatter",
+  pointcol = "blue", fun = c("mean", "median"), linecol = c("red", "green")
+)
+
+visualize(diamonds,
+  yvar = "price", xvar = c("cut", "clarity"),
+  type = "bar", fun = "median"
+)
+
+visualize(diamonds,
+  yvar = "price", xvar = c("cut", "clarity"),
+  type = "line", fun = "max"
+)
+
+visualize(diamonds,
+  yvar = "price", xvar = "carat", type = "scatter",
+  size = "table", custom = TRUE
+) + scale_size(range = c(1, 10), guide = "none")
+
+visualize(diamonds, yvar = "price", xvar = "carat", type = "scatter", custom = TRUE) +
+  labs(title = "A scatterplot", x = "price in $")
+
+visualize(diamonds, xvar = "price:carat", custom = TRUE) %>%
+  wrap_plots(ncol = 2) + plot_annotation(title = "Histograms")
+
+visualize(diamonds,
+  xvar = "cut", yvar = "price", type = "bar",
+  facet_row = "cut", fill = "cut"
+)
+
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/wday.html b/radiant.data/docs/reference/wday.html new file mode 100644 index 0000000000000000000000000000000000000000..4deda951259e49abab5aa13ae3fe02d90658ea78 --- /dev/null +++ b/radiant.data/docs/reference/wday.html @@ -0,0 +1,163 @@ + +Add ordered argument to lubridate::wday — wday • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Add ordered argument to lubridate::wday

    + Source: R/transform.R + +
    + +
    +

    Add ordered argument to lubridate::wday

    +
    + +
    + 
    wday(x, label = FALSE, abbr = TRUE, ordered = FALSE)
    +
    + +
    +

    Arguments

    +
    x
    +

    Input date vector

    + + +
    label
    +

    Weekday as label (TRUE, FALSE)

    + + +
    abbr
    +

    Abbreviate label (TRUE, FALSE)

    + + +
    ordered
    +

    Order factor (TRUE, FALSE)

    + +
    +
    +

    See also

    +

    See the lubridate::wday() function in the lubridate package for additional details

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/weighted.sd.html b/radiant.data/docs/reference/weighted.sd.html new file mode 100644 index 0000000000000000000000000000000000000000..9e1c0b4f16db338f41f372cd8503d3cc0b8a7a36 --- /dev/null +++ b/radiant.data/docs/reference/weighted.sd.html @@ -0,0 +1,159 @@ + +Weighted standard deviation — weighted.sd • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Weighted standard deviation

    + Source: R/transform.R + +
    + +
    +

    Weighted standard deviation

    +
    + +
    + 
    weighted.sd(x, wt, na.rm = TRUE)
    +
    + +
    +

    Arguments

    +
    x
    +

    Numeric vector

    + + +
    wt
    +

    Numeric vector of weights

    + + +
    na.rm
    +

    Remove missing values (default is TRUE)

    + +
    +
    +

    Details

    +

    Calculate weighted standard deviation

    +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/which.pmax.html b/radiant.data/docs/reference/which.pmax.html new file mode 100644 index 0000000000000000000000000000000000000000..ec96c5610c2152f9a0f17377b4b8842717b4b569 --- /dev/null +++ b/radiant.data/docs/reference/which.pmax.html @@ -0,0 +1,171 @@ + +Index of the maximum per row — which.pmax • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Index of the maximum per row

    + Source: R/radiant.R + +
    + +
    +

    Index of the maximum per row

    +
    + +
    + 
    which.pmax(...)
    +
    + +
    +

    Arguments

    +
    ...
    +

    Numeric or character vectors of the same length

    + +
    +
    +

    Value

    + + +

    Vector of rankings

    +
    +
    +

    Details

    +

    Determine the index of the maximum of the input vectors per row. Extension of which.max

    +
    +
    +

    See also

    +

    See also which.max and which.pmin

    +
    + +
    +

    Examples

    + 
    which.pmax(1:10, 10:1)
+#>  [1] 2 2 2 2 2 1 1 1 1 1
+which.pmax(2, 10:1)
+#>  [1] 2 2 2 2 2 2 2 2 1 1
+which.pmax(mtcars)
+#>  [1] 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 4 3 4 4 3
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/which.pmin.html b/radiant.data/docs/reference/which.pmin.html new file mode 100644 index 0000000000000000000000000000000000000000..40c8cfa8a33ec15da80126394d270aec19fe2833 --- /dev/null +++ b/radiant.data/docs/reference/which.pmin.html @@ -0,0 +1,171 @@ + +Index of the minimum per row — which.pmin • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Index of the minimum per row

    + Source: R/radiant.R + +
    + +
    +

    Index of the minimum per row

    +
    + +
    + 
    which.pmin(...)
    +
    + +
    +

    Arguments

    +
    ...
    +

    Numeric or character vectors of the same length

    + +
    +
    +

    Value

    + + +

    Vector of rankings

    +
    +
    +

    Details

    +

    Determine the index of the minimum of the input vectors per row. Extension of which.min

    +
    +
    +

    See also

    +

    See also which.min and which.pmax

    +
    + +
    +

    Examples

    + 
    which.pmin(1:10, 10:1)
+#>  [1] 1 1 1 1 1 2 2 2 2 2
+which.pmin(2, 10:1)
+#>  [1] 1 1 1 1 1 1 1 1 1 2
+which.pmin(mtcars)
+#>  [1] 8 8 8 9 8 9 8 9 9 9 9 8 8 8 8 8 8 8 8 8 9 8 8 8 8 8 8 8 8 8 8 8
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/write_parquet.html b/radiant.data/docs/reference/write_parquet.html new file mode 100644 index 0000000000000000000000000000000000000000..e513b3ff883a1e1500195a036cfacb7d3d9bcf31 --- /dev/null +++ b/radiant.data/docs/reference/write_parquet.html @@ -0,0 +1,155 @@ + +Workaround to store description file together with a parquet data file — write_parquet • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Workaround to store description file together with a parquet data file

    + Source: R/radiant.R + +
    + +
    +

    Workaround to store description file together with a parquet data file

    +
    + +
    + 
    write_parquet(x, file, description = attr(x, "description"))
    +
    + +
    +

    Arguments

    +
    x
    +

    A data frame to write to disk

    + + +
    file
    +

    Path to store parquet file

    + + +
    description
    +

    Data description

    + +
    + +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/reference/xtile.html b/radiant.data/docs/reference/xtile.html new file mode 100644 index 0000000000000000000000000000000000000000..9f226174ce41b60ab4d73a133f655b6021cdab01 --- /dev/null +++ b/radiant.data/docs/reference/xtile.html @@ -0,0 +1,174 @@ + +Split a numeric variable into a number of bins and return a vector of bin numbers — xtile • radiant.data + + +
    +
    + + + +
    +
    +
    +

    Split a numeric variable into a number of bins and return a vector of bin numbers

    + Source: R/transform.R + +
    + +
    +

    Split a numeric variable into a number of bins and return a vector of bin numbers

    +
    + +
    + 
    xtile(x, n = 5, rev = FALSE, type = 7)
    +
    + +
    +

    Arguments

    +
    x
    +

    Numeric variable

    + + +
    n
    +

    number of bins to create

    + + +
    rev
    +

    Reverse the order of the bin numbers

    + + +
    type
    +

    An integer between 1 and 9 to select one of the quantile algorithms described in the help for the stats::quantile function

    + +
    +
    +

    See also

    +

    See quantile for a description of the different algorithm types

    +
    + +
    +

    Examples

    + 
    xtile(1:10, 5)
+#>  [1] 1 1 2 2 3 3 4 4 5 5
+xtile(1:10, 5, rev = TRUE)
+#>  [1] 5 5 4 4 3 3 2 2 1 1
+xtile(c(rep(1, 6), 7:10), 5)
+#>  [1] 1 1 1 1 1 1 4 4 5 5
+
+
    +
    +
    + +
    + + +
    +

    Developed by Vincent Nijs, Niklas von Hertzen.

    +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + diff --git a/radiant.data/docs/sitemap.xml b/radiant.data/docs/sitemap.xml new file mode 100644 index 0000000000000000000000000000000000000000..a1783438c528cdd90706055cb55406be6761de1d --- /dev/null +++ b/radiant.data/docs/sitemap.xml @@ -0,0 +1,495 @@ + + + + https://radiant-rstats.github.io/radiant.data/404.html + + + https://radiant-rstats.github.io/radiant.data/LICENSE-text.html + + + https://radiant-rstats.github.io/radiant.data/articles/index.html + + + https://radiant-rstats.github.io/radiant.data/articles/pkgdown/combine.html + + + https://radiant-rstats.github.io/radiant.data/articles/pkgdown/explore.html + + + https://radiant-rstats.github.io/radiant.data/articles/pkgdown/manage.html + + + https://radiant-rstats.github.io/radiant.data/articles/pkgdown/pivotr.html + + + https://radiant-rstats.github.io/radiant.data/articles/pkgdown/report_r.html + + + https://radiant-rstats.github.io/radiant.data/articles/pkgdown/report_rmd.html + + + https://radiant-rstats.github.io/radiant.data/articles/pkgdown/state.html + + + https://radiant-rstats.github.io/radiant.data/articles/pkgdown/transform.html + + + https://radiant-rstats.github.io/radiant.data/articles/pkgdown/view.html + + + https://radiant-rstats.github.io/radiant.data/articles/pkgdown/visualize.html + + + https://radiant-rstats.github.io/radiant.data/authors.html + + + https://radiant-rstats.github.io/radiant.data/index.html + + + https://radiant-rstats.github.io/radiant.data/news/index.html + + + https://radiant-rstats.github.io/radiant.data/reference/add_class.html + + + https://radiant-rstats.github.io/radiant.data/reference/add_description.html + + + https://radiant-rstats.github.io/radiant.data/reference/arrange_data.html + + + https://radiant-rstats.github.io/radiant.data/reference/as_character.html + + + https://radiant-rstats.github.io/radiant.data/reference/as_distance.html + + + https://radiant-rstats.github.io/radiant.data/reference/as_dmy.html + + + https://radiant-rstats.github.io/radiant.data/reference/as_dmy_hm.html + + + https://radiant-rstats.github.io/radiant.data/reference/as_dmy_hms.html + + + https://radiant-rstats.github.io/radiant.data/reference/as_duration.html + + + https://radiant-rstats.github.io/radiant.data/reference/as_factor.html + + + https://radiant-rstats.github.io/radiant.data/reference/as_hm.html + + + https://radiant-rstats.github.io/radiant.data/reference/as_hms.html + + + https://radiant-rstats.github.io/radiant.data/reference/as_integer.html + + + https://radiant-rstats.github.io/radiant.data/reference/as_mdy.html + + + https://radiant-rstats.github.io/radiant.data/reference/as_mdy_hm.html + + + https://radiant-rstats.github.io/radiant.data/reference/as_mdy_hms.html + + + https://radiant-rstats.github.io/radiant.data/reference/as_numeric.html + + + https://radiant-rstats.github.io/radiant.data/reference/as_tibble.html + + + https://radiant-rstats.github.io/radiant.data/reference/as_ymd.html + + + https://radiant-rstats.github.io/radiant.data/reference/as_ymd_hm.html + + + https://radiant-rstats.github.io/radiant.data/reference/as_ymd_hms.html + + + https://radiant-rstats.github.io/radiant.data/reference/avengers.html + + + https://radiant-rstats.github.io/radiant.data/reference/center.html + + + https://radiant-rstats.github.io/radiant.data/reference/choose_dir.html + + + https://radiant-rstats.github.io/radiant.data/reference/choose_files.html + + + https://radiant-rstats.github.io/radiant.data/reference/ci_label.html + + + https://radiant-rstats.github.io/radiant.data/reference/ci_perc.html + + + https://radiant-rstats.github.io/radiant.data/reference/combine_data.html + + + https://radiant-rstats.github.io/radiant.data/reference/copy_all.html + + + https://radiant-rstats.github.io/radiant.data/reference/copy_attr.html + + + https://radiant-rstats.github.io/radiant.data/reference/copy_from.html + + + https://radiant-rstats.github.io/radiant.data/reference/cv.html + + + https://radiant-rstats.github.io/radiant.data/reference/deregister.html + + + https://radiant-rstats.github.io/radiant.data/reference/describe.html + + + https://radiant-rstats.github.io/radiant.data/reference/diamonds.html + + + https://radiant-rstats.github.io/radiant.data/reference/does_vary.html + + + https://radiant-rstats.github.io/radiant.data/reference/dtab.data.frame.html + + + https://radiant-rstats.github.io/radiant.data/reference/dtab.explore.html + + + https://radiant-rstats.github.io/radiant.data/reference/dtab.html + + + https://radiant-rstats.github.io/radiant.data/reference/dtab.pivotr.html + + + https://radiant-rstats.github.io/radiant.data/reference/empty_level.html + + + https://radiant-rstats.github.io/radiant.data/reference/explore.html + + + https://radiant-rstats.github.io/radiant.data/reference/filter_data.html + + + https://radiant-rstats.github.io/radiant.data/reference/find_dropbox.html + + + https://radiant-rstats.github.io/radiant.data/reference/find_gdrive.html + + + https://radiant-rstats.github.io/radiant.data/reference/find_home.html + + + https://radiant-rstats.github.io/radiant.data/reference/find_project.html + + + https://radiant-rstats.github.io/radiant.data/reference/fix_names.html + + + https://radiant-rstats.github.io/radiant.data/reference/fix_smart.html + + + https://radiant-rstats.github.io/radiant.data/reference/flip.html + + + https://radiant-rstats.github.io/radiant.data/reference/format_df.html + + + https://radiant-rstats.github.io/radiant.data/reference/format_nr.html + + + https://radiant-rstats.github.io/radiant.data/reference/get_class.html + + + https://radiant-rstats.github.io/radiant.data/reference/get_data.html + + + https://radiant-rstats.github.io/radiant.data/reference/get_summary.html + + + https://radiant-rstats.github.io/radiant.data/reference/ggplotly.html + + + https://radiant-rstats.github.io/radiant.data/reference/glance.html + + + https://radiant-rstats.github.io/radiant.data/reference/glue.html + + + https://radiant-rstats.github.io/radiant.data/reference/glue_collapse.html + + + https://radiant-rstats.github.io/radiant.data/reference/glue_data.html + + + https://radiant-rstats.github.io/radiant.data/reference/index.html + + + https://radiant-rstats.github.io/radiant.data/reference/indexr.html + + + https://radiant-rstats.github.io/radiant.data/reference/install_webshot.html + + + https://radiant-rstats.github.io/radiant.data/reference/inverse.html + + + https://radiant-rstats.github.io/radiant.data/reference/is.empty.html + + + https://radiant-rstats.github.io/radiant.data/reference/is_double.html + + + https://radiant-rstats.github.io/radiant.data/reference/is_empty.html + + + https://radiant-rstats.github.io/radiant.data/reference/is_not.html + + + https://radiant-rstats.github.io/radiant.data/reference/is_string.html + + + https://radiant-rstats.github.io/radiant.data/reference/iterms.html + + + https://radiant-rstats.github.io/radiant.data/reference/knit_print.html + + + https://radiant-rstats.github.io/radiant.data/reference/kurtosi.re.html + + + https://radiant-rstats.github.io/radiant.data/reference/launch.html + + + https://radiant-rstats.github.io/radiant.data/reference/level_list.html + + + https://radiant-rstats.github.io/radiant.data/reference/ln.html + + + https://radiant-rstats.github.io/radiant.data/reference/load_clip.html + + + https://radiant-rstats.github.io/radiant.data/reference/make_arrange_cmd.html + + + https://radiant-rstats.github.io/radiant.data/reference/make_train.html + + + https://radiant-rstats.github.io/radiant.data/reference/make_vec.html + + + https://radiant-rstats.github.io/radiant.data/reference/me.html + + + https://radiant-rstats.github.io/radiant.data/reference/meprop.html + + + https://radiant-rstats.github.io/radiant.data/reference/modal.html + + + https://radiant-rstats.github.io/radiant.data/reference/month.html + + + https://radiant-rstats.github.io/radiant.data/reference/mutate_ext.html + + + https://radiant-rstats.github.io/radiant.data/reference/n_missing.html + + + https://radiant-rstats.github.io/radiant.data/reference/n_obs.html + + + https://radiant-rstats.github.io/radiant.data/reference/normalize.html + + + https://radiant-rstats.github.io/radiant.data/reference/parse_path.html + + + https://radiant-rstats.github.io/radiant.data/reference/percentiles.html + + + https://radiant-rstats.github.io/radiant.data/reference/pfun.html + + + https://radiant-rstats.github.io/radiant.data/reference/pivotr.html + + + https://radiant-rstats.github.io/radiant.data/reference/plot.pivotr.html + + + https://radiant-rstats.github.io/radiant.data/reference/print.gtable.html + + + https://radiant-rstats.github.io/radiant.data/reference/prop.html + + + https://radiant-rstats.github.io/radiant.data/reference/publishers.html + + + https://radiant-rstats.github.io/radiant.data/reference/qscatter.html + + + https://radiant-rstats.github.io/radiant.data/reference/qterms.html + + + https://radiant-rstats.github.io/radiant.data/reference/radiant.data-deprecated.html + + + https://radiant-rstats.github.io/radiant.data/reference/radiant.data.html + + + https://radiant-rstats.github.io/radiant.data/reference/radiant.data_url.html + + + https://radiant-rstats.github.io/radiant.data/reference/radiant.data_viewer.html + + + https://radiant-rstats.github.io/radiant.data/reference/radiant.data_window.html + + + https://radiant-rstats.github.io/radiant.data/reference/read_files.html + + + https://radiant-rstats.github.io/radiant.data/reference/reexports.html + + + https://radiant-rstats.github.io/radiant.data/reference/refactor.html + + + https://radiant-rstats.github.io/radiant.data/reference/register.html + + + https://radiant-rstats.github.io/radiant.data/reference/render.datatables.html + + + https://radiant-rstats.github.io/radiant.data/reference/render.html + + + https://radiant-rstats.github.io/radiant.data/reference/render.plotly.html + + + https://radiant-rstats.github.io/radiant.data/reference/round_df.html + + + https://radiant-rstats.github.io/radiant.data/reference/rownames_to_column.html + + + https://radiant-rstats.github.io/radiant.data/reference/save_clip.html + + + https://radiant-rstats.github.io/radiant.data/reference/sdpop.html + + + https://radiant-rstats.github.io/radiant.data/reference/sdprop.html + + + https://radiant-rstats.github.io/radiant.data/reference/se.html + + + https://radiant-rstats.github.io/radiant.data/reference/search_data.html + + + https://radiant-rstats.github.io/radiant.data/reference/seprop.html + + + https://radiant-rstats.github.io/radiant.data/reference/set_attr.html + + + https://radiant-rstats.github.io/radiant.data/reference/show_duplicated.html + + + https://radiant-rstats.github.io/radiant.data/reference/sig_stars.html + + + https://radiant-rstats.github.io/radiant.data/reference/skew.re.html + + + https://radiant-rstats.github.io/radiant.data/reference/slice_data.html + + + https://radiant-rstats.github.io/radiant.data/reference/square.html + + + https://radiant-rstats.github.io/radiant.data/reference/sshh.html + + + https://radiant-rstats.github.io/radiant.data/reference/sshhr.html + + + https://radiant-rstats.github.io/radiant.data/reference/standardize.html + + + https://radiant-rstats.github.io/radiant.data/reference/store.explore.html + + + https://radiant-rstats.github.io/radiant.data/reference/store.html + + + https://radiant-rstats.github.io/radiant.data/reference/store.pivotr.html + + + https://radiant-rstats.github.io/radiant.data/reference/subplot.html + + + https://radiant-rstats.github.io/radiant.data/reference/summary.explore.html + + + https://radiant-rstats.github.io/radiant.data/reference/summary.pivotr.html + + + https://radiant-rstats.github.io/radiant.data/reference/superheroes.html + + + https://radiant-rstats.github.io/radiant.data/reference/table2data.html + + + https://radiant-rstats.github.io/radiant.data/reference/tibble.html + + + https://radiant-rstats.github.io/radiant.data/reference/tidy.html + + + https://radiant-rstats.github.io/radiant.data/reference/titanic.html + + + https://radiant-rstats.github.io/radiant.data/reference/to_fct.html + + + https://radiant-rstats.github.io/radiant.data/reference/varpop.html + + + https://radiant-rstats.github.io/radiant.data/reference/varprop.html + + + https://radiant-rstats.github.io/radiant.data/reference/view_data.html + + + https://radiant-rstats.github.io/radiant.data/reference/visualize.html + + + https://radiant-rstats.github.io/radiant.data/reference/wday.html + + + https://radiant-rstats.github.io/radiant.data/reference/weighted.sd.html + + + https://radiant-rstats.github.io/radiant.data/reference/which.pmax.html + + + https://radiant-rstats.github.io/radiant.data/reference/which.pmin.html + + + https://radiant-rstats.github.io/radiant.data/reference/write_parquet.html + + + https://radiant-rstats.github.io/radiant.data/reference/xtile.html + + diff --git a/radiant.data/inst/app/global.R b/radiant.data/inst/app/global.R new file mode 100644 index 0000000000000000000000000000000000000000..20c01a17a9fcef6d07c289b64baedf0d912bafea --- /dev/null +++ b/radiant.data/inst/app/global.R @@ -0,0 +1,658 @@ +library(shiny.i18n) +# file with translations +i18n <- Translator$new(translation_csvs_path = "../translations") +# change this to zh +i18n$set_translation_language("zh") + +## based on https://github.com/rstudio/shiny/issues/1237 +suppressWarnings( + try( + rm("registerShinyDebugHook", envir = as.environment("tools:rstudio")), + silent = TRUE + ) +) + +# options(shiny.trace = TRUE) +# options(radiant.autosave = c(1, 5)) + +## set volumes if sf_volumes was preset (e.g., on a server) or +## we are running in Rstudio or if we are running locally +if (isTRUE(getOption("radiant.sf_volumes", "") != "") || + isTRUE(getOption("radiant.shinyFiles", FALSE)) || + isTRUE(Sys.getenv("RSTUDIO") != "") || + isTRUE(Sys.getenv("SHINY_PORT") == "")) { + if (isTRUE(getOption("radiant.sf_volumes", "") != "")) { + sf_volumes <- getOption("radiant.sf_volumes") + if (length(names(sf_volumes)) == 0) { + warning("\nOption radiant.sf_volumes should be a named vector set in .Rprofile\n\n") + options(radiant.sf_volumes = "") + } else if (any(sapply(sf_volumes, function(x) !dir.exists(x)))) { + warning("\nOne or more directories listed in option radiant.sf_volumes do not exists. Please fix the option in .Rprofile and restart radiant.\n\n") + options(radiant.sf_volumes = "") + } + rm(sf_volumes) + } + + if (isTRUE(getOption("radiant.sf_volumes", "") == "")) { + sf_volumes <- c(Home = radiant.data::find_home()) + if (dir.exists(paste0(sf_volumes["Home"], "/Desktop"))) { + sf_volumes <- c(sf_volumes, Desktop = paste0(sf_volumes["Home"], "/Desktop")) + } + if (dir.exists(paste0(sf_volumes["Home"], "/Downloads"))) { + sf_volumes <- c(sf_volumes, Downloads = paste0(sf_volumes["Home"], "/Downloads")) + } + Dropbox <- try(radiant.data::find_dropbox(), silent = TRUE) + if (!inherits(Dropbox, "try-error")) { + sf_volumes <- c(sf_volumes, Dropbox = Dropbox) + } + GoogleDrive <- try(radiant.data::find_gdrive(), silent = TRUE) + if (!inherits(GoogleDrive, "try-error")) { + sf_volumes <- c(sf_volumes, `Google Drive` = GoogleDrive) + } + sf_volumes <- c(sf_volumes, shinyFiles::getVolumes()()) + options(radiant.sf_volumes = sf_volumes) + } + options(radiant.shinyFiles = TRUE) +} else { + options(radiant.shinyFiles = FALSE) +} + +## determining how radiant was launched +## should this be set in global? +if (is.null(getOption("radiant.launch"))) { + ## also use Rstudio's file dialog if opening in Window + if (exists(".rs.readUiPref")) { + if (is.null(.rs.readUiPref("shiny_viewer_type"))) { + .rs.writeUiPref("shiny_viewer_type", 2) + options(radiant.launch = "viewer") + } else if (.rs.readUiPref("shiny_viewer_type") == 2) { + options(radiant.launch = "viewer") + } else if (.rs.readUiPref("shiny_viewer_type") == 3) { + options(radiant.launch = "window") + } else { + # options(radiant.launch = "external") + options(radiant.launch = "browser") + } + } else { + options(radiant.launch = "browser") + } +} + +## function to load/import required packages and functions +import_fs <- function(ns, libs = c(), incl = c(), excl = c()) { + tmp <- sapply(libs, library, character.only = TRUE) + rm(tmp) + if (length(incl) > 0 || length(excl) > 0) { + import_list <- getNamespaceImports(ns) + if (length(incl) == 0) { + import_list[names(import_list) %in% c("base", "methods", "stats", "utils", libs, excl)] <- NULL + } else { + import_list <- import_list[names(import_list) %in% incl] + } + import_names <- names(import_list) + + for (i in seq_len(length(import_list))) { + fun <- import_list[[i]] + lib <- import_names[[i]] + ## replace with character.only option when new version of import is posted to CRAN + ## https://github.com/smbache/import/issues/11 + eval( + parse( + text = paste0("import::from(", lib, ", '", paste0(fun, collapse = "', '"), "')") + ) + ) + } + } + invisible() +} + +## list of function to suggest during autocomplete in Report > Rmd and Report > R +## moved to init.R +init_data <- function(env = r_data) { + ## Based on discussion with Joe Cheng: Datasets can change over time + ## so the data needs to be reactive value so the other reactive + ## functions and outputs that depend on these datasets will know when + ## they are changed + + ## Using an environment to assign data + ## http://adv-r.had.co.nz/Environments.html#explicit-envs + + ## using a reactiveValues list to keep track of relevant app info + ## that needs to be reactive + r_info <- reactiveValues() + + strip_ext <- function(x) sub(paste0("\\.", tools::file_ext(x), "$"), "", x) + datasetlist <- c() + df_names <- getOption("radiant.init.data") + if (length(df_names) == 0) df_names <- c("diamonds", "titanic") + for (dn in df_names) { + if (file.exists(dn)) { + df <- load(dn) %>% get() + if (!inherits(df, "data.frame")) next # only keep data.frames + dn_path <- dn + dn <- basename(dn) %>% strip_ext() + r_info[[paste0(dn, "_lcmd")]] <- glue::glue('{dn} <- load("{dn_path}") %>% get()\nregister("{dn}")') + } else { + df <- data(list = dn, package = "radiant.data", envir = environment()) %>% get() + r_info[[paste0(dn, "_lcmd")]] <- glue::glue('{dn} <- data({dn}, package = "radiant.data", envir = environment()) %>% get()\nregister("{dn}")') + } + env[[dn]] <- df + if (!bindingIsActive(as.symbol(dn), env = env)) { + makeReactiveBinding(dn, env = env) + } + r_info[[paste0(dn, "_descr")]] <- attr(df, "description") + datasetlist <- c(datasetlist, dn) + } + r_info[["datasetlist"]] <- datasetlist + r_info[["url"]] <- NULL + r_info +} + +## running local, on a server, or from JupyterLab +if (getOption("radiant.jupyter", default = FALSE)) { + options(radiant.local = FALSE) + options(radiant.report = getOption("radiant.report", default = TRUE)) + ## no limit to file size when launched through jupyter + options(shiny.maxRequestSize = getOption("radiant.maxRequestSize", default = -1)) +} else if (Sys.getenv("SHINY_PORT") == "") { + options(radiant.local = TRUE) + options(radiant.report = getOption("radiant.report", default = TRUE)) + ## no limit to file size locally + options(shiny.maxRequestSize = getOption("radiant.maxRequestSize", default = -1)) +} else { + options(radiant.local = FALSE) + options(radiant.report = getOption("radiant.report", default = FALSE)) + ## limit upload file size on server (10MB) + options(shiny.maxRequestSize = getOption("radiant.maxRequestSize", default = 10 * 1024^2)) + if (Sys.getlocale(category = "LC_ALL") == "C") { + ret <- Sys.setlocale("LC_CTYPE", "en_US.UTF-8") + rm(ret) + } +} + +## encoding +options(radiant.encoding = "UTF-8") + +## hack for rmarkdown from Report > Rmd and Report > R +options(radiant.rmarkdown = FALSE) + +## path to use for local or server use +options( + radiant.path.data = + ifelse(grepl("radiant.data", getwd()) && file.exists("../../inst"), "..", system.file(package = "radiant.data")) +) + +## import required functions and packages +## if radiant.data is not in search main function from dplyr etc. won't be available +if (!"package:radiant.data" %in% search() && + # isTRUE(Sys.getenv("SHINY_PORT") == "") && + isTRUE(getOption("radiant.development")) && + getOption("radiant.path.data") == "..") { + import_fs("radiant.data", libs = c("magrittr", "ggplot2", "lubridate", "tidyr", "dplyr", "broom", "tibble", "glue")) + options(radiant.from.package = FALSE) +} else { + options(radiant.from.package = TRUE) + library(radiant.data) +} + +## basic options when run on server +if (getOption("width") != 250) { + options( + width = max(getOption("width"), 250), + scipen = max(getOption("scipen"), 100), + max.print = max(getOption("max.print"), 5000), + stringsAsFactors = FALSE + ) +} + +options(dctrl = if (getRversion() > "3.4.4") c("keepNA", "niceNames") else "keepNA") + +options( + radiant.functions = list( + "样本量（n_obs）" = "n_obs", "缺失值数（n_missing）" = "n_missing", "唯一值数（n_distinct）" = "n_distinct", + "均值（mean）" = "mean", "中位数（median）" = "median", "众数（modal）" = "modal", "最小值（min）" = "min", "最大值（max）" = "max", + "总和（sum）" = "sum", "方差（var）" = "var", "标准差（sd）" = "sd", "标准误（se）" = "se", "误差边际（me）" = "me", "变异系数（cv）" = "cv", + "比例（prop）" = "prop", "比例方差（varprop）" = "varprop", "比例标准差（sdprop）" = "sdprop", "比例标准误（seprop）" = "seprop", + "比例误差边际（meprop）" = "meprop", "总体方差（varpop）" = "varpop", "总体标准差（sdpop）" = "sdpop", "1%分位数（p01）" = "p01", + "2.5%分位数（p025）" = "p025", "5%分位数（p05）" = "p05", "10%分位数（p10）" = "p10", "25%分位数（p25）" = "p25", "75%分位数（p75）" = "p75", + "90%分位数（p90）" = "p90", "95%分位数（p95）" = "p95", "97.5%分位数（p975）" = "p975", "99%分位数（p99）" = "p99", "偏度（skew）" = "skew", + "峰度（kurtosi）" = "kurtosi", "四分位距（IQR）" = "IQR" + ) +) + +## see https://github.com/tidyverse/ggplot2/issues/2655 +## requires XQuartz! +# if(!identical(getOption("bitmapType"), "cairo") && isTRUE(capabilities()[["cairo"]])) { +# options(bitmapType = "cairo") +# } + +## for report and code in menu R +knitr::opts_knit$set(progress = TRUE) +knitr::opts_chunk$set( + echo = FALSE, + comment = NA, + # fig.cap = "", + cache = FALSE, + message = FALSE, + warning = FALSE, + error = TRUE, + # fig.path = normalizePath(tempdir(), winslash = "/"), + dpi = 144, + screenshot.force = FALSE + # dev = "svg" ## too slow with big scatter plots on server-side +) + +## environment to hold session information +r_sessions <- new.env(parent = emptyenv()) + +## create directory to hold session files +"~/.radiant.sessions" %>% + (function(x) if (!file.exists(x)) dir.create(x)) + +## adding the figures path to avoid making a copy of all figures in www/figures +addResourcePath("www", file.path(getOption("radiant.path.data"), "app/www/")) +addResourcePath("figures", file.path(getOption("radiant.path.data"), "app/tools/help/figures/")) +addResourcePath("imgs", file.path(getOption("radiant.path.data"), "app/www/imgs/")) +addResourcePath("js", file.path(getOption("radiant.path.data"), "app/www/js/")) + +## cdn.mathjax.org has been retired +## use local MathJax if available +## doesn't current work on Linux +local_mathjax <- Sys.getenv("RMARKDOWN_MATHJAX_PATH") +## from https://github.com/rstudio/rmarkdown/blob/master/R/shiny.R +if (Sys.info()["sysname"] != "Linux" && nzchar(local_mathjax)) { + addResourcePath("latest", local_mathjax) + options(radiant.mathjax.path = "latest") + ## override shiny::withMathJax to use local MathJax + withMathJax <- function(...) { + path <- "latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML" + tagList( + tags$head(singleton(tags$script(src = path, type = "text/javascript"))), + ..., tags$script(HTML("if (window.MathJax) MathJax.Hub.Queue([\"Typeset\", MathJax.Hub]);")) + ) + } +} else { + options(radiant.mathjax.path = "https://mathjax.rstudio.com/latest") +} +rm(local_mathjax) + +get_zip_info <- function() { + flags <- "-r9X" + zip_util <- Sys.getenv("R_ZIPCMD", "zip") + if (Sys.info()["sysname"] == "Windows") { + wz <- suppressWarnings(system("where zip", intern = TRUE)) + if (!isTRUE(grepl("zip", wz))) { + wz <- suppressWarnings(system("where 7z", intern = TRUE)) + if (isTRUE(grepl("7z", wz))) { + zip_util <- "7z" + flags <- "a" + if (Sys.getenv("R_ZIPCMD") == "") { + Sys.setenv(R_ZIPCMD = wz) + } + } else { + zip_util <- "" + flags <- "" + } + } else { + if (Sys.getenv("R_ZIPCMD") == "") { + Sys.setenv(R_ZIPCMD = wz) + } + } + } + options(radiant.zip = c(flags, zip_util)) +} +get_zip_info() +rm(get_zip_info) + +## function to generate help, must be in global because used in ui.R +help_menu <- function(hlp) { + tagList( + navbarMenu( + "", + icon = icon("question-circle", verify_fa = FALSE), +# tabPanel(i18n$t("Help"), uiOutput(hlp), icon = icon("question", verify_fa = FALSE)), + tabPanel(actionLink("help_keyboard", i18n$t("Keyboard shortcuts"), icon = icon("keyboard", verify_fa = FALSE))) + #tabPanel("Videos", uiOutput("help_videos"), icon = icon("film")), +# tabPanel(tags$a( +# "", +# href = "https://radiant-rstats.github.io/docs/tutorials.html", target = "_blank", +# list(icon("film", verify_fa = FALSE), i18n$t("Videos")) +# )), +# tabPanel(i18n$t("About"), uiOutput("help_about"), icon = icon("info", verify_fa = FALSE)), +# tabPanel(tags$a( +# "", +# href = "https://radiant-rstats.github.io/docs/", target = "_blank", +# list(icon("globe", verify_fa = FALSE), i18n$t("Radiant docs")) +# )), +# tabPanel(tags$a( +# "", +# href = "https://github.com/radiant-rstats/radiant/issues", target = "_blank", +# list(icon("github", verify_fa = FALSE), i18n$t("Report issue")) +# )) + ), + # bslib::nav_item(checkboxInput("dark_mode", label = "Dark Mode", width="100px")), + tags$head( + tags$script(src = "js/session.js"), + tags$script(src = "js/returnTextAreaBinding.js"), + tags$script(src = "js/returnTextInputBinding.js"), + tags$script(src = "js/video_reset.js"), + tags$script(src = "js/run_return.js"), + # tags$script('TogetherJSConfig_hubBase = "https://togetherjs-hub.glitch.me/"; TogetherJSConfig_cloneClicks = true;'), + # tags$script(src = "https://togetherjs.com/togetherjs-min.js"), + # tags$script(src = "js/message-handler.js"), + # tags$script(src = "js/draggable_modal.js"), + tags$link(rel = "stylesheet", type = "text/css", href = "www/style.css"), + tags$link(rel = "shortcut icon", href = "imgs/icon.png") + ) + ) +} + + + +## copy-right text +options(radiant.help.cc = "© Vincent Nijs (2023) Creative Commons License
    ") +options(radiant.help.cc.sa = "© Vincent Nijs (2023) Creative Commons License
    ") + +##################################### +## url processing to share results +##################################### + +## relevant links +# http://stackoverflow.com/questions/25306519/shiny-saving-url-state-subpages-and-tabs/25385474#25385474 +# https://groups.google.com/forum/#!topic/shiny-discuss/Xgxq08N8HBE +# https://gist.github.com/jcheng5/5427d6f264408abf3049 + +## try http://127.0.0.1:3174/?url=multivariate/conjoint/plot/&SSUID=local +options( + radiant.url.list = + list("Data" = list("tabs_data" = list( + "Manage" = "data/", + "View" = "data/view/", + "Visualize" = "data/visualize/", + "Pivot" = "data/pivot/", + "Explore" = "data/explore/", + "Transform" = "data/transform/", + "Combine" = "data/combine/", + "Rmd" = "report/rmd/", + "R" = "report/r/" + ))) +) + +make_url_patterns <- function(url_list = getOption("radiant.url.list"), + url_patterns = list()) { + for (i in names(url_list)) { + res <- url_list[[i]] + if (!is.list(res)) { + url_patterns[[res]] <- list("nav_radiant" = i) + } else { + tabs <- names(res) + for (j in names(res[[tabs]])) { + url <- res[[tabs]][[j]] + url_patterns[[url]] <- setNames(list(i, j), c("nav_radiant", tabs)) + } + } + } + url_patterns +} + +## generate url patterns +options(radiant.url.patterns = make_url_patterns()) + +## installed packages versions +tmp <- grep("radiant\\.", installed.packages()[, "Package"], value = TRUE) +if ("radiant" %in% installed.packages()) { + tmp <- c("radiant" = "radiant", tmp) +} + +if (length(tmp) > 0) { + radiant.versions <- sapply(names(tmp), function(x) paste(x, paste(packageVersion(x), sep = "."))) %>% unique() + if ("shiny" %in% installed.packages()) { + radiant.versions <- c(radiant.versions, paste("shiny ", packageVersion("shiny"))) + } +} else { + radiant.versions <- "Unknown" +} + +options(radiant.versions = paste(radiant.versions, collapse = ", ")) +rm(tmp, radiant.versions) + +if (is.null(getOption("radiant.theme", default = NULL))) { + options(radiant.theme = bslib::bs_theme(version = 4)) +} + +## bslib theme and version +has_bslib_theme <- function() { + if (rlang::is_installed("bslib")) bslib::is_bs_theme(getOption("radiant.theme")) else FALSE +} + +bslib_current_version <- function() { + if (rlang::is_installed("bslib")) bslib::theme_version(getOption("radiant.theme", default = bslib::bs_theme(version = 4))) +} + +navbar_proj <- function(navbar) { + pdir <- radiant.data::find_project(mess = FALSE) + if (radiant.data::is.empty(pdir)) { + if (getOption("radiant.shinyFiles", FALSE) && !radiant.data::is.empty(getOption("radiant.sf_volumes", ""))) { + proj <- paste0(i18n$t("Base dir: "), names(getOption("radiant.sf_volumes"))[1]) + } else { + proj <- "Project: (None)" + } + options(radiant.project_dir = NULL) + } else { + proj <- paste0("Project: ", basename(pdir)) %>% + { + if (nchar(.) > 35) paste0(strtrim(., 31), " ...") else . + } + options(radiant.project_dir = pdir) + options(radiant.launch_dir = pdir) + } + + proj_brand <- tags$span(class = "nav navbar-brand navbar-right", proj) + navbar_ <- htmltools::tagQuery(navbar)$find(".navbar-collapse")$append(proj_brand)$allTags() + htmltools::attachDependencies(navbar_, htmltools::findDependencies(navbar)) +} + +if (getOption("radiant.shinyFiles", FALSE)) { + if (!radiant.data::is.empty(getOption("radiant.sf_volumes", "")) && radiant.data::is.empty(getOption("radiant.project_dir"))) { + launch_dir <- getOption("radiant.launch_dir", default = radiant.data::find_home()) + if (!launch_dir %in% getOption("radiant.sf_volumes", "")) { + sf_volumes <- c(setNames(launch_dir, basename(launch_dir)), getOption("radiant.sf_volumes", "")) + options(radiant.sf_volumes = sf_volumes) + rm(sf_volumes) + } else if (!launch_dir == getOption("radiant.sf_volumes", "")[1]) { + dir_ind <- which(getOption("radiant.sf_volumes") == launch_dir)[1] + options(radiant.sf_volumes = c(getOption("radiant.sf_volumes")[dir_ind], getOption("radiant.sf_volumes")[-dir_ind])) + rm(dir_ind) + } + rm(launch_dir) + } + if (radiant.data::is.empty(getOption("radiant.launch_dir"))) { + if (radiant.data::is.empty(getOption("radiant.project_dir"))) { + options(radiant.launch_dir = radiant.data::find_home()) + options(radiant.project_dir = getOption("radiant.launch_dir")) + } else { + options(radiant.launch_dir = getOption("radiant.project_dir")) + } + } + + if (radiant.data::is.empty(getOption("radiant.project_dir"))) { + options(radiant.project_dir = getOption("radiant.launch_dir")) + } else { + options(radiant.launch_dir = getOption("radiant.project_dir")) + } + + dbdir <- try(radiant.data::find_dropbox(), silent = TRUE) + dbdir <- if (inherits(dbdir, "try-error")) "" else paste0(dbdir, "/") + options(radiant.dropbox_dir = dbdir) + rm(dbdir) + + gddir <- try(radiant.data::find_gdrive(), silent = TRUE) + gddir <- if (inherits(gddir, "try-error")) "" else paste0(gddir, "/") + options(radiant.gdrive_dir = gddir) + rm(gddir) +} else { + options(radiant.launch_dir = radiant.data::find_home()) + options(radiant.project_dir = getOption("radiant.launch_dir")) +} + +## formatting data.frames printed in Report > Rmd and Report > R +knit_print.data.frame <- function(x, ...) { + paste(c("", "", knitr::kable(x)), collapse = "\n") %>% + knitr::asis_output() +} + +## not clear why this doesn't work +# knit_print.data.frame = function(x, ...) { +# res <- rmarkdown:::print.paged_df(x) +# knitr::asis_output(res) +# knitr::asis_output( +# rmarkdown:::paged_table_html(x), +# meta = list(dependencies = rmarkdown:::html_dependency_pagedtable()) +# ) +# } + +## not clear why this doesn't work +## https://github.com/yihui/knitr/issues/1399 +# knit_print.datatables <- function(x, ...) { +# res <- shiny::knit_print.shiny.render.function( +# DT::renderDataTable(x) +# ) +# knitr::asis_output(res) +# } + +# registerS3method("knitknit_print", "datatables", knit_print.datatables) +# knit_print.datatables <- function(x, ...) { +# # res <- shiny::knit_print.shiny.render.function( +# # shiny::knit_print.shiny.render.function( +# DT::renderDataTable(x) +# # ) +# # knitr::asis_output(res) +# } + +# knit_print.datatables <- function(x, ...) { +# # shiny::knit_print.shiny.render.function( +# res <- shiny::knit_print.shiny.render.function( +# DT::renderDataTable(x) +# ) +# knitr::asis_output(res) +# } + +load_html2canvas <- function() { + # adapted from https://github.com/yonicd/snapper/blob/master/R/load.R + # SRC URL "https://html2canvas.hertzen.com/dist/html2canvas.min.js" + asset_src <- "assets/html2canvas/" + asset_script <- "html2canvas.min.js" + dir.exists(asset_src) + shiny::tagList( + htmltools::htmlDependency( + name = "html2canvas-js", + version = "1.4.1", + src = asset_src, + script = asset_script, + package = "radiant.data" + ) + ) +} + +options( + radiant.nav_ui = + list( + windowTitle = i18n$t("Radiant for R"), + id = "nav_radiant", + theme = getOption("radiant.theme"), + inverse = TRUE, + collapsible = TRUE, + position = "fixed-top", + tabPanel(i18n$t("Data"), withMathJax(), uiOutput("ui_data"), load_html2canvas()) + ) +) + +options( + radiant.shared_ui = + tagList( + navbarMenu( + i18n$t("Report"), + tabPanel("Rmd", + uiOutput("rmd_view"), + uiOutput("report_rmd"), + icon = icon("edit", verify_fa = FALSE) + ), + tabPanel("R", + uiOutput("r_view"), + uiOutput("report_r"), + icon = icon("code", verify_fa = FALSE) + ) + ), + navbarMenu("", + icon = icon("save", verify_fa = FALSE), + ## inspiration for uploading state https://stackoverflow.com/a/11406690/1974918 + ## see also function in www/js/run_return.js + "Server", + tabPanel(actionLink("state_save_link", i18n$t("Save radiant state file"), icon = icon("download", verify_fa = FALSE))), + tabPanel(actionLink("state_load_link", i18n$t("Load radiant state file"), icon = icon("upload", verify_fa = FALSE))), + tabPanel(actionLink("state_share", i18n$t("Share radiant state"), icon = icon("share", verify_fa = FALSE))), + tabPanel(i18n$t("View radiant state"), uiOutput("state_view"), icon = icon("user", verify_fa = FALSE)), + "----", "Local", + tabPanel(downloadLink("state_download", tagList(icon("download", verify_fa = FALSE), i18n$t("Download radiant state file")))), + tabPanel(actionLink("state_upload_link", i18n$t("Upload radiant state file"), icon = icon("upload", verify_fa = FALSE))) + ), + + ## stop app *and* close browser window + navbarMenu("", + icon = icon("power-off", verify_fa = FALSE), + tabPanel( + actionLink( + "stop_radiant", i18n$t("Stop"), + icon = icon("stop", verify_fa = FALSE), + onclick = "setTimeout(function(){window.close();}, 100);" + ) + ), + tabPanel(tags$a( + id = "refresh_radiant", href = "#", class = "action-button", + list(icon("sync", verify_fa = FALSE), i18n$t("Refresh")), onclick = "window.location.reload();" + )), + ## had to remove class = "action-button" to make this work + tabPanel(tags$a( + id = "new_session", href = "./", target = "_blank", + list(icon("plus", verify_fa = FALSE), i18n$t("New session")) + )) + ) + ) +) + +## cleanup the global environment if stop button is pressed in Rstudio +## based on barbara's reply to +## https://community.rstudio.com/t/rstudio-viewer-window-not-closed-on-shiny-stopapp/4158/7?u=vnijs +onStop(function() { + ## don't run if the stop button was pressed in Radiant + if (!exists("r_data")) { + unlink("~/r_figures/", recursive = TRUE) + clean_up_list <- c( + "r_sessions", "help_menu", "make_url_patterns", "import_fs", + "init_data", "navbar_proj", "knit_print.data.frame", "withMathJax", + "Dropbox", "sf_volumes", "GoogleDrive", "bslib_current_version", + "has_bslib_theme", "load_html2canvas" + ) + suppressWarnings( + suppressMessages({ + res <- try(sapply(clean_up_list, function(x) if (exists(x, envir = .GlobalEnv)) rm(list = x, envir = .GlobalEnv)), silent = TRUE) + rm(res) + }) + ) + options(radiant.launch_dir = NULL) + options(radiant.project_dir = NULL) + message("Stopped Radiant\n") + stopApp() + } +}) + +## Show NA and Inf in DT tables +## https://github.com/rstudio/DT/pull/513 +## See also https://github.com/rstudio/DT/issues/533 +## Waiting for DT.OPTION for TOJSON_ARGS +# options(htmlwidgets.TOJSON_ARGS = list(na = "string")) +# options("DT.TOJSON_ARGS" = list(na = "string")) +## Sorting on client-side would be as a string, not a numeric +## https://github.com/rstudio/DT/pull/536#issuecomment-385223433 + +if (getRversion() < "4.4.0") `%||%` <- function(x, y) if (is.null(x)) y else x diff --git a/radiant.data/inst/app/init.R b/radiant.data/inst/app/init.R new file mode 100644 index 0000000000000000000000000000000000000000..207e4a4b3c03bd936fedd480c9683ef2754c958c --- /dev/null +++ b/radiant.data/inst/app/init.R @@ -0,0 +1,364 @@ +################################################################################ +## functions to set initial values and take information from r_state +## when available +################################################################################ + +## useful options for debugging +# options(shiny.trace = TRUE) +# options(shiny.error = recover) +# options(warn = 2) + +if (isTRUE(getOption("radiant.shinyFiles", FALSE))) { + if (isTRUE(Sys.getenv("RSTUDIO") == "") && isTRUE(Sys.getenv("SHINY_PORT") != "")) { + ## Users not on Rstudio will only get access to pre-specified volumes + sf_volumes <- getOption("radiant.sf_volumes", "") + } else { + if (getOption("radiant.project_dir", "") == "") { + sf_volumes <- getOption("radiant.launch_dir") %>% + { + set_names(., basename(.)) + } + } else { + sf_volumes <- getOption("radiant.project_dir") %>% + { + set_names(., basename(.)) + } + } + home <- radiant.data::find_home() + if (home != sf_volumes) { + sf_volumes <- c(sf_volumes, home) %>% set_names(c(names(sf_volumes), "Home")) + } else { + sf_volumes <- c(Home = home) + } + if (sum(nzchar(getOption("radiant.sf_volumes", ""))) > 0) { + sf_volumes <- getOption("radiant.sf_volumes") %>% + { + c(sf_volumes, .[!. %in% sf_volumes]) + } + } + missing_names <- is.na(names(sf_volumes)) + if (sum(missing_names) > 0) { + sf_volumes[missing_names] <- basename(sf_volumes[missing_names]) + } + } +} + +remove_session_files <- function(st = Sys.time()) { + fl <- list.files( + normalizePath("~/.radiant.sessions/"), + pattern = "*.state.rda", + full.names = TRUE + ) + + for (f in fl) { + if (difftime(st, file.mtime(f), units = "days") > 7) { + unlink(f, force = TRUE) + } + } +} + +remove_session_files() + +## from Joe Cheng's https://github.com/jcheng5/shiny-resume/blob/master/session.R +isolate({ + prevSSUID <- parseQueryString(session$clientData$url_search)[["SSUID"]] +}) + +most_recent_session_file <- function() { + fl <- list.files( + normalizePath("~/.radiant.sessions/"), + pattern = "*.state.rda", + full.names = TRUE + ) + + if (length(fl) > 0) { + data.frame(fn = fl, dt = file.mtime(fl), stringsAsFactors = FALSE) %>% + arrange(desc(dt)) %>% + slice(1) %>% + .[["fn"]] %>% + as.character() %>% + basename() %>% + gsub("r_(.*).state.rda", "\\1", .) + } else { + NULL + } +} + +## set the session id +r_ssuid <- if (getOption("radiant.local")) { + if (is.null(prevSSUID)) { + mrsf <- most_recent_session_file() + paste0("local-", shiny:::createUniqueId(3)) + } else { + mrsf <- "0000" + prevSSUID + } +} else { + ifelse(is.null(prevSSUID), shiny:::createUniqueId(5), prevSSUID) +} + +## (re)start the session and push the id into the url +session$sendCustomMessage("session_start", r_ssuid) + +## identify the shiny environment +## deprecated - will be removed in future version +r_environment <- session$token + +r_info_legacy <- function() { + r_info_elements <- c( + "datasetlist", "dtree_list", "pvt_rows", "nav_radiant", + "plot_height", "plot_width", "filter_error", "cmb_error" + ) %>% + c(paste0(r_data[["datasetlist"]], "_descr")) + r_info <- reactiveValues() + for (i in r_info_elements) { + r_info[[i]] <- r_data[[i]] + } + suppressWarnings(rm(list = r_info_elements, envir = r_data)) + r_info +} + +## load for previous state if available but look in global memory first +if (isTRUE(getOption("radiant.local")) && exists("r_data", envir = .GlobalEnv)) { + r_data <- if (is.list(r_data)) list2env(r_data, envir = new.env()) else r_data + if (exists("r_info")) { + r_info <- do.call(reactiveValues, r_info) + } else { + r_info <- r_info_legacy() + } + r_state <- if (exists("r_state")) r_state else list() + suppressWarnings(rm(r_data, r_state, r_info, envir = .GlobalEnv)) +} else if (isTRUE(getOption("radiant.local")) && !is.null(r_sessions[[r_ssuid]]$r_data)) { + r_data <- r_sessions[[r_ssuid]]$r_data %>% + { + if (is.list(.)) list2env(., envir = new.env()) else . + } + if (is.null(r_sessions[[r_ssuid]]$r_info)) { + r_info <- r_info_legacy() + } else { + r_info <- do.call(reactiveValues, r_sessions[[r_ssuid]]$r_info) + } + r_state <- r_sessions[[r_ssuid]]$r_state +} else if (file.exists(paste0("~/.radiant.sessions/r_", r_ssuid, ".state.rda"))) { + ## read from file if not in global + fn <- paste0(normalizePath("~/.radiant.sessions"), "/r_", r_ssuid, ".state.rda") + rs <- new.env(emptyenv()) + try(load(fn, envir = rs), silent = TRUE) + if (inherits(rs, "try-error")) { + r_data <- new.env() + r_info <- init_data(env = r_data) + r_state <- list() + } else { + if (length(rs$r_data) == 0) { + r_data <- new.env() + r_info <- init_data(env = r_data) + } else { + r_data <- rs$r_data %>% + { + if (is.list(.)) list2env(., envir = new.env()) else . + } + if (is.null(rs$r_info)) { + r_info <- r_info_legacy() + } else { + r_info <- do.call(reactiveValues, rs$r_info) + } + } + if (length(rs$r_state) == 0) { + r_state <- list() + } else { + r_state <- rs$r_state + } + } + + unlink(fn, force = TRUE) + rm(rs) +} else if (isTRUE(getOption("radiant.local")) && file.exists(paste0("~/.radiant.sessions/r_", mrsf, ".state.rda"))) { + ## restore from local folder but assign new ssuid + fn <- paste0(normalizePath("~/.radiant.sessions"), "/r_", mrsf, ".state.rda") + rs <- new.env(emptyenv()) + try(load(fn, envir = rs), silent = TRUE) + if (inherits(rs, "try-error")) { + r_data <- new.env() + r_info <- init_data(env = r_data) + r_state <- list() + } else { + if (length(rs$r_data) == 0) { + r_data <- new.env() + r_info <- init_data(env = r_data) + } else { + r_data <- rs$r_data %>% + { + if (is.list(.)) list2env(., envir = new.env()) else . + } + r_info <- if (length(rs$r_info) == 0) { + r_info <- r_info_legacy() + } else { + do.call(reactiveValues, rs$r_info) + } + } + r_state <- if (length(rs$r_state) == 0) list() else rs$r_state + } + + ## don't navigate to same tab in case the app locks again + r_state$nav_radiant <- NULL + unlink(fn, force = TRUE) + rm(rs) +} else { + r_data <- new.env() + r_info <- init_data(env = r_data) + r_state <- list() +} + +isolate({ + for (ds in r_info[["datasetlist"]]) { + if (exists(ds, envir = r_data) && !bindingIsActive(as.symbol(ds), env = r_data)) { + shiny::makeReactiveBinding(ds, env = r_data) + } + } + for (dt in r_info[["dtree_list"]]) { + if (exists(dt, envir = r_data)) { + r_data[[dt]] <- add_class(r_data[[dt]], "dtree") + if (!bindingIsActive(as.symbol(dt), env = r_data)) { + shiny::makeReactiveBinding(dt, env = r_data) + } + } + } +}) + +## legacy, to deal with state files created before +## Report > Rmd and Report > R name change +if (isTRUE(r_state$nav_radiant == "Code")) { + r_state$nav_radiant <- "R" +} else if (isTRUE(r_state$nav_radiant == "Report")) { + r_state$nav_radiant <- "Rmd" +} + +## legacy, to deal with radio buttons that were in Data > Pivot +if (!is.null(r_state$pvt_type)) { + if (isTRUE(r_state$pvt_type == "fill")) { + r_state$pvt_type <- TRUE + } else { + r_state$pvt_type <- FALSE + } +} + +## legacy, to deal with state files created before +## name change to rmd_edit +if (!is.null(r_state$rmd_report) && is.null(r_state$rmd_edit)) { + r_state$rmd_edit <- r_state$rmd_report + r_state$rmd_report <- NULL +} + +if (length(r_state$rmd_edit) > 0) { + r_state$rmd_edit <- r_state$rmd_edit %>% radiant.data::fix_smart() +} + +## legacy, to deal with state files created before +## name change to rmd_edit +if (!is.null(r_state$rcode_edit) && is.null(r_state$r_edit)) { + r_state$r_edit <- r_state$rcode_edit + r_state$rcode_edit <- NULL +} + +## parse the url and use updateTabsetPanel to navigate to the desired tab +## currently only works with a new or refreshed session +observeEvent(session$clientData$url_search, { + url_query <- parseQueryString(session$clientData$url_search) + if ("url" %in% names(url_query)) { + r_info[["url"]] <- url_query$url + } else if (is.empty(r_info[["url"]])) { + return() + } + + ## create an observer and suspend when done + url_observe <- observe({ + if (is.null(input$dataset)) { + return() + } + url <- getOption("radiant.url.patterns")[[r_info[["url"]]]] + if (is.null(url)) { + ## if pattern not found suspend observer + url_observe$suspend() + return() + } + ## move through the url + for (u in names(url)) { + if (is.null(input[[u]])) { + return() + } + if (input[[u]] != url[[u]]) { + updateTabsetPanel(session, u, selected = url[[u]]) + } + if (names(tail(url, 1)) == u) url_observe$suspend() + } + }) +}) + +## keeping track of the main tab we are on +observeEvent(input$nav_radiant, { + if (!input$nav_radiant %in% c("Refresh", "Stop")) { + r_info[["nav_radiant"]] <- input$nav_radiant + } +}) + +## Jump to the page you were on +## only goes two layers deep at this point +if (!is.null(r_state$nav_radiant)) { + ## don't return-to-the-spot if that was quit or stop + if (r_state$nav_radiant %in% c("Refresh", "Stop")) { + return() + } + + ## naming the observer so we can suspend it when done + nav_observe <- observe({ + ## needed to avoid errors when no data is available yet + if (is.null(input$dataset)) { + return() + } + updateTabsetPanel(session, "nav_radiant", selected = r_state$nav_radiant) + + ## check if shiny set the main tab to the desired value + if (is.null(input$nav_radiant)) { + return() + } + if (input$nav_radiant != r_state$nav_radiant) { + return() + } + nav_radiant_tab <- getOption("radiant.url.list")[[r_state$nav_radiant]] %>% + names() + + if (!is.null(nav_radiant_tab) && !is.null(r_state[[nav_radiant_tab]])) { + updateTabsetPanel(session, nav_radiant_tab, selected = r_state[[nav_radiant_tab]]) + } + + ## once you arrive at the desired tab suspend the observer + nav_observe$suspend() + }) +} + +isolate({ + if (is.null(r_info[["plot_height"]])) r_info[["plot_height"]] <- 650 + if (is.null(r_info[["plot_width"]])) r_info[["plot_width"]] <- 650 +}) + +if (getOption("radiant.from.package", default = TRUE)) { + ## launch using installed radiant.data package + # radiant.data::copy_all("radiant.data") + cat("\nGetting radiant.data from package ...\n") +} else { + ## for shiny-server and development + for (file in list.files("../../R", pattern = "\\.(r|R)$", full.names = TRUE)) { + source(file, encoding = getOption("radiant.encoding", "UTF-8"), local = TRUE) + } + cat("\nGetting radiant.data from source ...\n") +} + +## Getting screen width ... +## https://github.com/rstudio/rstudio/issues/1870 +## https://community.rstudio.com/t/rstudio-resets-width-option-when-running-shiny-app-in-viewer/3661 +observeEvent(input$get_screen_width, { + if (getOption("width", default = 250) != 250) options(width = 250) +}) + + +radiant.data::copy_from(radiant.data, register, deregister) diff --git a/radiant.data/inst/app/radiant.R b/radiant.data/inst/app/radiant.R new file mode 100644 index 0000000000000000000000000000000000000000..202656858a478f849a2e50d7bb1603a3c15069f6 --- /dev/null +++ b/radiant.data/inst/app/radiant.R @@ -0,0 +1,1034 @@ +################################################################################ +## function to save app state on refresh or crash +################################################################################ + +## drop NULLs in list +toList <- function(x) reactiveValuesToList(x) %>% .[!sapply(., is.null)] + +## from https://gist.github.com/hadley/5434786 +env2list <- function(x) mget(ls(x), x) + +is_active <- function(env = r_data) { + sapply(ls(envir = env), function(x) bindingIsActive(as.symbol(x), env = env)) +} + +## remove non-active bindings +rem_non_active <- function(env = r_data) { + iact <- is_active(env = r_data) + rm(list = names(iact)[!iact], envir = env) +} + +active2list <- function(env = r_data) { + iact <- is_active(env = r_data) %>% (function(x) names(x)[x]) + if (length(iact) > 0) { + mget(iact, env) + } else { + list() + } +} + +## deal with https://github.com/rstudio/shiny/issues/2065 +MRB <- function(x, env = parent.frame(), init = FALSE) { + if (exists(x, envir = env)) { + ## if the object exists and has a binding, don't do anything + if (!bindingIsActive(as.symbol(x), env = env)) { + shiny::makeReactiveBinding(x, env = env) + } + } else if (init) { + ## initialize a binding (and value) if object doesn't exist yet + shiny::makeReactiveBinding(x, env = env) + } +} + +saveSession <- function(session = session, timestamp = FALSE, path = "~/.radiant.sessions") { + if (!exists("r_sessions")) { + return() + } + if (!dir.exists(path)) dir.create(path) + isolate({ + LiveInputs <- toList(input) + r_state[names(LiveInputs)] <- LiveInputs + + ## removing the non-active bindings + rem_non_active() + + r_data <- env2list(r_data) + r_info <- toList(r_info) + + r_sessions[[r_ssuid]] <- list( + r_data = r_data, + r_info = r_info, + r_state = r_state, + timestamp = Sys.time() + ) + + ## saving session information to state file + if (timestamp) { + fn <- paste0(normalizePath(path), "/r_", r_ssuid, "-", gsub("( |:)", "-", Sys.time()), ".state.rda") + } else { + fn <- paste0(normalizePath(path), "/r_", r_ssuid, ".state.rda") + } + save(r_data, r_info, r_state, file = fn) + }) +} + +observeEvent(input$refresh_radiant, { + if (isTRUE(getOption("radiant.local"))) { + fn <- normalizePath("~/.radiant.sessions") + file.remove(list.files(fn, full.names = TRUE)) + } else { + fn <- paste0(normalizePath("~/.radiant.sessions"), "/r_", r_ssuid, ".state.rda") + if (file.exists(fn)) unlink(fn, force = TRUE) + } + + try(r_ssuid <- NULL, silent = TRUE) +}) + +saveStateOnRefresh <- function(session = session) { + session$onSessionEnded(function() { + isolate({ + url_query <- parseQueryString(session$clientData$url_search) + if (not_pressed(input$refresh_radiant) && + not_pressed(input$stop_radiant) && + not_pressed(input$state_load) && + not_pressed(input$state_upload) && + !"fixed" %in% names(url_query)) { + saveSession(session) + } else { + if (not_pressed(input$state_load) && not_pressed(input$state_upload)) { + if (exists("r_sessions")) { + sshhr(try(r_sessions[[r_ssuid]] <- NULL, silent = TRUE)) + sshhr(try(rm(r_ssuid), silent = TRUE)) + } + } + } + }) + }) +} + +################################################################ +## functions used across tools in radiant +################################################################ + +## get active dataset and apply data-filter if available +.get_data <- reactive({ + req(input$dataset) + + filter_cmd <- input$data_filter %>% + gsub("\\n", "", .) %>% + gsub("\"", "\'", .) %>% + fix_smart() + + arrange_cmd <- input$data_arrange + if (!is.empty(arrange_cmd)) { + arrange_cmd <- arrange_cmd %>% + strsplit(., split = "(&|,|\\s+)") %>% + unlist() %>% + .[!. == ""] %>% + paste0(collapse = ", ") %>% + (function(x) glue("arrange(x, {x})")) + } + + slice_cmd <- input$data_rows + + if ((is.empty(filter_cmd) && is.empty(arrange_cmd) && is.empty(slice_cmd)) || input$show_filter == FALSE) { + isolate(r_info[["filter_error"]] <- "") + } else if (grepl("([^=!<>])=([^=])", filter_cmd)) { + isolate(r_info[["filter_error"]] <- "Invalid filter: Never use = in a filter! Use == instead (e.g., city == 'San Diego'). Update or remove the expression") + } else { + ## %>% needed here so . will be available + seldat <- try( + r_data[[input$dataset]] %>% + (function(x) if (!is.empty(filter_cmd)) x %>% filter(!!rlang::parse_expr(filter_cmd)) else x) %>% + (function(x) if (!is.empty(arrange_cmd)) eval(parse(text = arrange_cmd)) else x) %>% + (function(x) if (!is.empty(slice_cmd)) x %>% slice(!!rlang::parse_expr(slice_cmd)) else x), + silent = TRUE + ) + if (inherits(seldat, "try-error")) { + isolate(r_info[["filter_error"]] <- paste0("Invalid input: \"", attr(seldat, "condition")$message, "\". Update or remove the expression(x)")) + } else { + isolate(r_info[["filter_error"]] <- "") + if ("grouped_df" %in% class(seldat)) { + return(droplevels(ungroup(seldat))) + } else { + return(droplevels(seldat)) + } + } + } + if ("grouped_df" %in% class(r_data[[input$dataset]])) { + ungroup(r_data[[input$dataset]]) + } else { + r_data[[input$dataset]] + } +}) + +## using a regular function to avoid a full data copy +.get_data_transform <- function(dataset = input$dataset) { + if (is.null(dataset)) { + return() + } + if ("grouped_df" %in% class(r_data[[dataset]])) { + ungroup(r_data[[dataset]]) + } else { + r_data[[dataset]] + } +} + +.get_class <- reactive({ + get_class(.get_data()) +}) + +groupable_vars <- reactive({ + .get_data() %>% + summarise_all( + list( + ~ is.factor(.) || is.logical(.) || lubridate::is.Date(.) || + is.integer(.) || is.character(.) || + ((length(unique(.)) / n()) < 0.30) + ) + ) %>% + (function(x) which(x == TRUE)) %>% + varnames()[.] +}) + +groupable_vars_nonum <- reactive({ + .get_data() %>% + summarise_all( + list( + ~ is.factor(.) || is.logical(.) || + lubridate::is.Date(.) || is.integer(.) || + is.character(.) + ) + ) %>% + (function(x) which(x == TRUE)) %>% + varnames()[.] +}) + +## used in compare proportions, logistic, etc. +two_level_vars <- reactive({ + two_levs <- function(x) { + if (is.factor(x)) { + length(levels(x)) + } else { + length(unique(na.omit(x))) + } + } + .get_data() %>% + summarise_all(two_levs) %>% + (function(x) x == 2) %>% + which(.) %>% + varnames()[.] +}) + +## used in visualize - don't plot Y-variables that don't vary +varying_vars <- reactive({ + .get_data() %>% + summarise_all(does_vary) %>% + as.logical() %>% + which() %>% + varnames()[.] +}) + +## getting variable names in active dataset and their class +varnames <- reactive({ + var_class <- .get_class() + req(var_class) + names(var_class) %>% + set_names(., paste0(., " {", var_class, "}")) +}) + +## cleaning up the arguments for data_filter and defaults passed to report +clean_args <- function(rep_args, rep_default = list()) { + if (!is.null(rep_args$data_filter)) { + if (rep_args$data_filter == "") { + rep_args$data_filter <- NULL + } else { + rep_args$data_filter %<>% gsub("\\n", "", .) %>% gsub("\"", "\'", .) + } + } + if (is.empty(rep_args$rows)) { + rep_args$rows <- NULL + } + if (is.empty(rep_args$arr)) { + rep_args$arr <- NULL + } + + if (length(rep_default) == 0) rep_default[names(rep_args)] <- "" + + ## removing default arguments before sending to report feature + for (i in names(rep_args)) { + if (!is.language(rep_args[[i]]) && !is.call(rep_args[[i]]) && all(is.na(rep_args[[i]]))) { + rep_args[[i]] <- NULL + next + } + if (!is.symbol(rep_default[[i]]) && !is.call(rep_default[[i]]) && all(is_not(rep_default[[i]]))) next + if (length(rep_args[[i]]) == length(rep_default[[i]]) && !is.name(rep_default[[i]]) && all(rep_args[[i]] == rep_default[[i]])) { + rep_args[[i]] <- NULL + } + } + + rep_args +} + +## check if a variable is null or not in the selected data.frame +not_available <- function(x) any(is.null(x)) || (sum(x %in% varnames()) < length(x)) + +## check if a variable is null or not in the selected data.frame +available <- function(x) !not_available(x) + +## check if a button was pressed +pressed <- function(x) !is.null(x) && (is.list(x) || x > 0) + +## check if a button was NOT pressed +not_pressed <- function(x) !pressed(x) + +## check for duplicate entries +has_duplicates <- function(x) length(unique(x)) < length(x) + +## is x some type of date variable +is_date <- function(x) inherits(x, c("Date", "POSIXlt", "POSIXct")) + +## drop elements from .._args variables obtained using formals +r_drop <- function(x, drop = c("dataset", "data_filter", "arr", "rows", "envir")) x[!x %in% drop] + +## show a few rows of a dataframe +show_data_snippet <- function(dataset = input$dataset, nshow = 7, title = "", filt = "", arr = "", rows = "") { + if (is.character(dataset) && length(dataset) == 1) dataset <- get_data(dataset, filt = filt, arr = arr, rows = rows, na.rm = FALSE, envir = r_data) + nr <- nrow(dataset) + ## avoid slice with variables outside of the df in case a column with the same + ## name exists + dataset[1:min(nshow, nr), , drop = FALSE] %>% + mutate_if(is_date, as.character) %>% + mutate_if(is.character, list(~ strtrim(., 40))) %>% + xtable::xtable(.) %>% + print( + type = "html", print.results = FALSE, include.rownames = FALSE, + sanitize.text.function = identity, + html.table.attributes = "class='table table-condensed table-hover snippet'" + ) %>% + paste0(title, .) %>% + (function(x) if (nr <= nshow) x else paste0(x, "\n")) %>% + enc2utf8() +} + +suggest_data <- function(text = "", df_name = "diamonds") { + paste0(text, "要获取示例数据集，请转到数据 > 管理，从加载数据类型'下拉菜单中选择'示例'，\n然后点击'加载'按钮,选择 '", df_name, "' 数据集。") +} + +## function written by @wch https://github.com/rstudio/shiny/issues/781#issuecomment-87135411 +capture_plot <- function(expr, env = parent.frame()) { + structure( + list(expr = substitute(expr), env = env), + class = "capture_plot" + ) +} + +## function written by @wch https://github.com/rstudio/shiny/issues/781#issuecomment-87135411 +print.capture_plot <- function(x, ...) { + eval(x$expr, x$env) +} + +################################################################ +## functions used to create Shiny in and outputs +################################################################ + +## textarea where the return key submits the content +returnTextAreaInput <- function(inputId, label = NULL, rows = 2, + placeholder = NULL, resize = "vertical", + value = "") { + ## avoid all sorts of 'helpful' behavior from your browser + ## see https://stackoverflow.com/a/35514029/1974918 + tagList( + tags$div( + # using containing element based on + # https://github.com/niklasvh/html2canvas/issues/2008#issuecomment-1445503369 + tags$label(label, `for` = inputId), br(), + tags$textarea( + value, + id = inputId, + type = "text", + rows = rows, + placeholder = placeholder, + resize = resize, + autocomplete = "off", + autocorrect = "off", + autocapitalize = "off", + spellcheck = "false", + class = "returnTextArea form-control" + ) + ) + ) +} + +## from https://github.com/rstudio/shiny/blob/master/R/utils.R +`%AND%` <- function(x, y) { + if (!all(is.null(x)) && !all(is.na(x))) { + if (!all(is.null(y)) && !all(is.na(y))) { + return(y) + } + } + return(NULL) +} + +## using a custom version of textInput to avoid browser "smartness" +textInput <- function(inputId, label, value = "", width = NULL, + placeholder = NULL, autocomplete = "off", + autocorrect = "off", autocapitalize = "off", + spellcheck = "false", ...) { + value <- restoreInput(id = inputId, default = value) + div( + class = "form-group shiny-input-container", + style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"), + label %AND% tags$label(label, `for` = inputId), + tags$input( + id = inputId, + type = "text", + class = "form-control", + value = value, + placeholder = placeholder, + autocomplete = autocomplete, + autocorrect = autocorrect, + autocapitalize = autocapitalize, + spellcheck = spellcheck, + ... + ) + ) +} + +## using a custom version of textAreaInput to avoid browser "smartness" +textAreaInput <- function(inputId, label, value = "", width = NULL, + height = NULL, cols = NULL, rows = NULL, + placeholder = NULL, resize = NULL, + autocomplete = "off", autocorrect = "off", + autocapitalize = "off", spellcheck = "true", + ...) { + value <- restoreInput(id = inputId, default = value) + if (!is.null(resize)) { + resize <- match.arg( + resize, + c("both", "none", "vertical", "horizontal") + ) + } + style <- paste(if (!is.null(width)) { + paste0("width: ", validateCssUnit(width), ";") + }, if (!is.null(height)) { + paste0("height: ", validateCssUnit(height), ";") + }, if (!is.null(resize)) { + paste0("resize: ", resize, ";") + }) + if (length(style) == 0) { + style <- NULL + } + div( + class = "form-group shiny-input-container", + label %AND% tags$label(label, `for` = inputId), + tags$textarea( + id = inputId, + class = "form-control", + placeholder = placeholder, + style = style, + rows = rows, + cols = cols, + autocomplete = autocomplete, + autocorrect = autocorrect, + autocapitalize = autocapitalize, + spellcheck = spellcheck, + ..., + value + ) + ) +} + +## avoid all sorts of 'helpful' behavior from your browser +## based on https://stackoverflow.com/a/35514029/1974918 +returnTextInput <- function(inputId, label = NULL, + placeholder = NULL, value = "") { + tagList( + tags$label(label, `for` = inputId), + tags$input( + id = inputId, + type = "text", + value = value, + placeholder = placeholder, + autocomplete = "off", + autocorrect = "off", + autocapitalize = "off", + spellcheck = "false", + class = "returnTextInput form-control" + ) + ) +} + +if (getOption("radiant.shinyFiles", FALSE)) { + download_link <- function(id) { + uiOutput(paste0("ui_", id)) + } + + download_button <- function(id, ...) { + uiOutput(paste0("ui_", id)) + } + + download_handler <- function(id, label = "", fun = id, fn, type = "csv", caption = "Save to csv", + class = "", ic = "download", btn = "link", onclick = "function() none;", ...) { + ## create observer + shinyFiles::shinyFileSave(input, id, roots = sf_volumes, session = session) + + ## create renderUI + if (btn == "link") { + output[[paste0("ui_", id)]] <- renderUI({ + if (is.function(fn)) fn <- fn() + if (is.function(type)) type <- type() + shinyFiles::shinySaveLink( + id, label, caption, + filename = fn, filetype = type, + class = "alignright", icon = icon(ic, verify_fa = FALSE), onclick = onclick + ) + }) + } else { + output[[paste0("ui_", id)]] <- renderUI({ + if (is.function(fn)) fn <- fn() + if (is.function(type)) type <- type() + shinyFiles::shinySaveButton( + id, label, caption, + filename = fn, filetype = type, + class = class, icon = icon("download", verify_fa = FALSE), onclick = onclick + ) + }) + } + + observeEvent(input[[id]], { + if (is.integer(input[[id]])) { + return() + } + path <- shinyFiles::parseSavePath(sf_volumes, input[[id]]) + if (!inherits(path, "try-error") && !is.empty(path$datapath)) { + fun(path$datapath, ...) + } + }) + } +} else { + download_link <- function(id, ...) { + downloadLink(id, "", class = "fa fa-download alignright", ...) + } + download_button <- function(id, label = "Save", ic = "download", class = "", ...) { + downloadButton(id, label, class = class, ...) + } + download_handler <- function(id, label = "", fun = id, fn, type = "csv", caption = "Save to csv", + class = "", ic = "download", btn = "link", ...) { + output[[id]] <- downloadHandler( + filename = function() { + if (is.function(fn)) fn <- fn() + if (is.function(type)) type <- type() + paste0(fn, ".", type) + }, + content = function(path) { + fun(path, ...) + } + ) + } +} + +plot_width <- function() { + if (is.null(input$viz_plot_width)) r_info[["plot_width"]] else input$viz_plot_width +} + +plot_height <- function() { + if (is.null(input$viz_plot_height)) r_info[["plot_height"]] else input$viz_plot_height +} + +download_handler_plot <- function(path, plot, width = plot_width, height = plot_height) { + plot <- try(plot(), silent = TRUE) + if (inherits(plot, "try-error") || is.character(plot) || is.null(plot)) { + plot <- ggplot() + + labs(title = "Plot not available") + inp <- c(500, 100, 96) + } else { + inp <- 5 * c(width(), height(), 96) + } + + png(file = path, width = inp[1], height = inp[2], res = inp[3]) + print(plot) + dev.off() +} + +## fun_name is a string of the main function name +## rfun_name is a string of the reactive wrapper that calls the main function +## out_name is the name of the output, set to fun_name by default +register_print_output <- function(fun_name, rfun_name, out_name = fun_name) { + ## Generate output for the summary tab + output[[out_name]] <- renderPrint({ + ## when no analysis was conducted (e.g., no variables selected) + fun <- get(rfun_name)() + if (is.character(fun)) { + cat(fun, "\n") + } else { + rm(fun) + } + }) + return(invisible()) +} + +## fun_name is a string of the main function name +## rfun_name is a string of the reactive wrapper that calls the main function +## out_name is the name of the output, set to fun_name by default +register_plot_output <- function(fun_name, rfun_name, out_name = fun_name, + width_fun = "plot_width", height_fun = "plot_height") { + ## Generate output for the plots tab + output[[out_name]] <- renderPlot( + { + ## when no analysis was conducted (e.g., no variables selected) + p <- get(rfun_name)() + if (is_not(p) || is.empty(p)) p <- "Nothing to plot ...\nSelect plots to show or re-run the calculations" + if (is.character(p)) { + plot( + x = 1, type = "n", main = paste0("\n\n\n\n\n\n\n\n", p), + axes = FALSE, xlab = "", ylab = "", cex.main = .9 + ) + } else { + print(p) + } + }, + width = get(width_fun), + height = get(height_fun), + res = 96 + ) + + return(invisible()) +} + +stat_tab_panel <- function(menu, tool, tool_ui, output_panels, + data = input$dataset) { + sidebarLayout( + sidebarPanel( + wellPanel( + HTML(paste("
    ")), + HTML(paste("
    ")), + if (!is.null(data)) { + HTML(paste("")) + } + ), + uiOutput(tool_ui) + ), + mainPanel( + output_panels + ) + ) +} + +################################################################ +## functions used for app help +################################################################ +help_modal <- function(modal_title, link, help_file, + author = "Vincent Nijs", + year = lubridate::year(lubridate::now()), + lic = "by-nc-sa") { + sprintf( + " + ", + link, link, link, modal_title, help_file, author, year, lic, lic, link + ) %>% + enc2utf8() %>% + HTML() +} + +help_and_report <- function(modal_title, fun_name, help_file, + author = "Vincent Nijs", + year = lubridate::year(lubridate::now()), + lic = "by-nc-sa") { + sprintf( + " + + + +
    ", + fun_name, fun_name, fun_name, modal_title, help_file, author, year, lic, lic, fun_name, fun_name, fun_name, fun_name, fun_name + ) %>% + enc2utf8() %>% + HTML() %>% + withMathJax() +} + +## function to render .md files to html +inclMD <- function(path) { + paste(readLines(path, warn = FALSE), collapse = "\n") %>% + markdown::mark_html(text = ., template = FALSE, meta = list(css = ""), output = FALSE) +} + +## function to render .Rmd files to html +inclRmd <- function(path) { + paste(readLines(path, warn = FALSE), collapse = "\n") %>% + knitr::knit2html( + text = ., template = FALSE, quiet = TRUE, + envir = r_data, meta = list(css = ""), output = FALSE + ) %>% + HTML() %>% + withMathJax() +} + +## capture the state of a dt table +dt_state <- function(fun, vars = "", tabfilt = "", tabsort = "", nr = 0) { + ## global search + search <- input[[paste0(fun, "_state")]]$search$search + if (is.null(search)) search <- "" + + ## table ordering + order <- input[[paste0(fun, "_state")]]$order + if (length(order) == 0) { + order <- "NULL" + } else { + order <- list(order) + } + + ## column filters, gsub needed for factors + sc <- input[[paste0(fun, "_search_columns")]] %>% gsub("\\\"", "'", .) + sci <- which(sc != "") + nr_sc <- length(sci) + if (nr_sc > 0) { + sc <- list(lapply(sci, function(i) list(i, sc[i]))) + } else if (nr_sc == 0) { + sc <- "NULL" + } + + dat <- get(paste0(".", fun))()$tab %>% + (function(x) { + nr <<- nrow(x) + x[1, , drop = FALSE] + }) + + if (order != "NULL" || sc != "NULL") { + ## get variable class and name + gc <- get_class(dat) %>% + (function(x) if (is.empty(vars[1])) x else x[vars]) + cn <- names(gc) + + if (length(cn) > 0) { + if (order != "NULL") { + tabsort <- c() + for (i in order[[1]]) { + cname <- cn[i[[1]] + 1] %>% gsub("^\\s+|\\s+$", "", .) + if (grepl("[^0-9a-zA-Z_\\.]", cname) || grepl("^[0-9]", cname)) { + cname <- paste0("`", cname, "`") + } + if (i[[2]] == "desc") cname <- paste0("desc(", cname, ")") + tabsort <- c(tabsort, cname) + } + tabsort <- paste0(tabsort, collapse = ", ") + } + + if (sc != "NULL") { + tabfilt <- c() + for (i in sc[[1]]) { + cname <- cn[i[[1]]] + type <- gc[cname] + if (type == "factor") { + cname <- paste0(cname, " %in% ", sub("\\[", "c(", i[[2]]) %>% sub("\\]", ")", .)) + } else if (type %in% c("numeric", "integer", "ts")) { + bnd <- strsplit(i[[2]], "...", fixed = TRUE)[[1]] + cname <- paste0(cname, " >= ", bnd[1], " & ", cname, " <= ", bnd[2]) %>% gsub(" ", " ", .) + } else if (type %in% c("date", "period")) { + bnd <- strsplit(i[[2]], "...", fixed = TRUE)[[1]] %>% gsub(" ", "", .) + cname <- paste0(cname, " >= '", bnd[1], "' & ", cname, " <= '", bnd[2], "'") %>% gsub(" ", " ", .) + } else if (type == "character") { + cname <- paste0("grepl('", i[[2]], "', ", cname, ", ignore.case = TRUE)") + } else if (type == "logical") { + cname <- paste0(cname, " == ", toupper(sub("\\['(true|false)'\\]", "\\1", i[[2]]))) + } else { + message("Variable ", cname, " has type ", type, ". This type is not currently supported to generate code for Report > Rmd or Report > R") + next + } + tabfilt <- c(tabfilt, cname) + } + tabfilt <- paste0(tabfilt, collapse = " & ") + } + } + } + + list(search = search, order = order, sc = sc, tabsort = tabsort, tabfilt = tabfilt, nr = nr) +} + +## use the value in the input list if available and update r_state +state_init <- function(var, init = "", na.rm = TRUE) { + isolate({ + ivar <- input[[var]] + if (var %in% names(input) || length(ivar) > 0) { + ivar <- input[[var]] + if ((na.rm && is.empty(ivar)) || length(ivar) == 0) { + r_state[[var]] <<- NULL + } + } else { + ivar <- .state_init(var, init, na.rm) + } + ivar + }) +} + +## need a separate function for checkboxGroupInputs +state_group <- function(var, init = "") { + isolate({ + ivar <- input[[var]] + if (var %in% names(input) || length(ivar) > 0) { + ivar <- input[[var]] + if (is.empty(ivar)) r_state[[var]] <<- NULL + } else { + ivar <- .state_init(var, init) + r_state[[var]] <<- NULL ## line that differs for CBG inputs + } + ivar + }) +} + +.state_init <- function(var, init = "", na.rm = TRUE) { + rs <- r_state[[var]] + if ((na.rm && is.empty(rs)) || length(rs) == 0) init else rs +} + +state_single <- function(var, vals, init = character(0)) { + isolate({ + ivar <- input[[var]] + if (var %in% names(input) && is.null(ivar)) { + r_state[[var]] <<- NULL + ivar + } else if (available(ivar) && all(ivar %in% vals)) { + if (length(ivar) > 0) r_state[[var]] <<- ivar + ivar + } else if (available(ivar) && any(ivar %in% vals)) { + ivar[ivar %in% vals] + } else { + if (length(ivar) > 0 && all(ivar %in% c("None", "none", ".", ""))) { + r_state[[var]] <<- ivar + } + .state_single(var, vals, init = init) + } + }) +} + +.state_single <- function(var, vals, init = character(0)) { + rs <- r_state[[var]] + if (is.empty(rs)) init else vals[vals == rs] +} + +state_multiple <- function(var, vals, init = character(0)) { + isolate({ + ivar <- input[[var]] + if (var %in% names(input) && is.null(ivar)) { + r_state[[var]] <<- NULL + ivar + } else if (available(ivar) && all(ivar %in% vals)) { + if (length(ivar) > 0) r_state[[var]] <<- ivar + ivar + } else if (available(ivar) && any(ivar %in% vals)) { + ivar[ivar %in% vals] + } else { + if (length(ivar) > 0 && all(ivar %in% c("None", "none", ".", ""))) { + r_state[[var]] <<- ivar + } + .state_multiple(var, vals, init = init) + } + }) +} + +.state_multiple <- function(var, vals, init = character(0)) { + rs <- r_state[[var]] + r_state[[var]] <<- NULL + + ## "a" %in% character(0) --> FALSE, letters[FALSE] --> character(0) + if (is.empty(rs)) vals[vals %in% init] else vals[vals %in% rs] +} + +## cat to file +## use with tail -f ~/r_cat.txt in a terminal +# cf <- function(...) { +# cat(paste0("\n--- called from: ", environmentName(parent.frame()), " (", lubridate::now(), ")\n"), file = "~/r_cat.txt", append = TRUE) +# out <- paste0(capture.output(...), collapse = "\n") +# cat("--\n", out, "\n--", sep = "\n", file = "~/r_cat.txt", append = TRUE) +# } + +## autosave option +## provide a list with (1) the save interval in minutes, (2) the total duration in minutes, and (3) the path to use +# options(radiant.autosave = list(1, 5, "~/.radiant.sessions")) +# options(radiant.autosave = list(.1, 1, "~/Desktop/radiant.sessions")) +# options(radiant.autosave = list(10, 180, "~/Desktop/radiant.sessions")) +if (length(getOption("radiant.autosave", default = NULL)) > 0) { + start_time <- Sys.time() + interval <- getOption("radiant.autosave")[[1]] * 60000 + max_duration <- getOption("radiant.autosave")[[2]] + autosave_path <- getOption("radiant.autosave")[[3]] + autosave_path <- ifelse(length(autosave_path) == 0, "~/.radiant.sessions", autosave_path) + autosave_poll <- reactivePoll( + interval, + session, + checkFunc = function() { + curr_time <- Sys.time() + diff_time <- difftime(curr_time, start_time, units = "mins") + if (diff_time < max_duration) { + saveSession(session, timestamp = TRUE, autosave_path) + options(radiant.autosave = list(interval, max_duration - diff_time, autosave_path)) + message("Radiant state was auto-saved at ", curr_time) + } else { + if (length(getOption("radiant.autosave", default = NULL)) > 0) { + showModal( + modalDialog( + title = "Radiant state autosave", + span(glue("The autosave feature has been turned off. Time to save and submit your work by clicking + on the 'Save' icon in the navigation bar and then on 'Save radiant state file'. To clean the + state files that were auto-saved, run the following command from the R(studio) console: + unlink('{autosave_path}/*.state.rda', force = TRUE)")), + footer = modalButton("OK"), + size = "m", + easyClose = TRUE + ) + ) + options(radiant.autosave = NULL) + } + } + }, + valueFunc = function() { + return() + } + ) +} + +## update "run" button when relevant inputs are changed +run_refresh <- function(args, pre, init = "evar", tabs = "", + label = "Estimate model", relabel = label, + inputs = NULL, data = TRUE) { + observe({ + ## dep on most inputs + if (data) { + input$data_filter + input$data_arrange + input$data_rows + input$show_filter + } + sapply(r_drop(names(args)), function(x) input[[paste0(pre, "_", x)]]) + + ## adding dependence in more inputs + if (length(inputs) > 0) { + sapply(inputs, function(x) input[[paste0(pre, "_", x)]]) + } + + run <- isolate(input[[paste0(pre, "_run")]]) %>% pressed() + check_null <- function(init) { + all(sapply(init, function(x) is.null(input[[paste0(pre, "_", x)]]))) + } + if (isTRUE(check_null(init))) { + if (!is.empty(tabs)) { + updateTabsetPanel(session, paste0(tabs, " "), selected = "Summary") + } + updateActionButton(session, paste0(pre, "_run"), label, icon = icon("play", verify_fa = FALSE)) + } else if (run) { + updateActionButton(session, paste0(pre, "_run"), relabel, icon = icon("sync", class = "fa-spin", verify_fa = FALSE)) + } else { + updateActionButton(session, paste0(pre, "_run"), label, icon = icon("play", verify_fa = FALSE)) + } + }) + + observeEvent(input[[paste0(pre, "_run")]], { + updateActionButton(session, paste0(pre, "_run"), label, icon = icon("play", verify_fa = FALSE)) + }) +} + +radiant_screenshot_modal <- function(report_on = "") { + add_button <- function() { + if (is.empty(report_on)) { + "" + } else { + actionButton(report_on, i18n$t("Report"), icon = icon("edit", verify_fa = FALSE), class = "btn-success") + } + } + showModal( + modalDialog( + title = i18n$t("Radiant screenshot"), + span(shiny::tags$div(id = "screenshot_preview")), + span(HTML("
    要在报告中包含截图，请先点击保存按钮将截图保存到磁盘。然后点击报告按钮，将截图引用插入到报告 > Rmd中。")), + footer = tagList( + tags$table( + tags$td(download_button("screenshot_save", i18n$t("Save"), ic = "download")), + tags$td(add_button()), + tags$td(modalButton(i18n$t("Cancel"))), + align = "right" + ) + ), + size = "l", + easyClose = TRUE + ) + ) +} + +observeEvent(input$screenshot_link, { + radiant_screenshot_modal() +}) + +render_screenshot <- function() { + plt <- sub("data:.+base64,", "", input$img_src) + png::readPNG(base64enc::base64decode(what = plt)) +} + +download_handler_screenshot <- function(path, plot, ...) { + plot <- try(plot(), silent = TRUE) + if (inherits(plot, "try-error") || is.character(plot) || is.null(plot)) { + plot <- ggplot() + + labs(title = "Plot not available") + png(file = path, width = 500, height = 100, res = 96) + print(plot) + dev.off() + } else { + ppath <- parse_path(path, pdir = getOption("radiant.launch_dir", find_home()), mess = FALSE) + # r_info[["latest_screenshot"]] <- glue("![]({ppath$rpath})") + # r_info[["latest_screenshot"]] <- glue("
    \nClick to show screenshot\nRadiant screenshot\n
    ") + r_info[["latest_screenshot"]] <- glue("\n
    \nClick to show screenshot with Radiant settings to generate output shown below\n\n![]({ppath$rpath})\n

    \n") + png::writePNG(plot, path, dpi = 144) + } +} + +observe({ + if (length(input$nav_radiant) > 0) { + tabset <- names(getOption("radiant.url.list")[[input$nav_radiant]]) + rtn <- if (length(tabset) > 0) { + paste0(input$nav_radiant, " ", input[[tabset]]) + } else { + input$nav_radiant + } + r_info[["radiant_tab_name"]] <- gsub("[ ]+", "-", rtn) %>% + gsub("(\\(|\\))", "", .) %>% + gsub("[-]{2,}", "-", .) %>% + tolower() + } +}) + +download_handler( + id = "screenshot_save", + fun = download_handler_screenshot, + fn = function() paste0(r_info[["radiant_tab_name"]], "-screenshot"), + type = "png", + caption = "Save radiant screenshot", + plot = render_screenshot, + btn = "button", + label = i18n$t("Save"), + class = "btn-primary", + onclick = "get_img_src();" +) diff --git a/radiant.data/inst/app/rsconnect/rsm-compute-dev2.ucsd.edu/vnijs/radiantdata.dcf b/radiant.data/inst/app/rsconnect/rsm-compute-dev2.ucsd.edu/vnijs/radiantdata.dcf new file mode 100644 index 0000000000000000000000000000000000000000..cc792e03d770985126468e94f174fc176b27b9ca --- /dev/null +++ b/radiant.data/inst/app/rsconnect/rsm-compute-dev2.ucsd.edu/vnijs/radiantdata.dcf @@ -0,0 +1,12 @@ +name: radiantdata +title: radiant.data +username: vnijs +account: vnijs +server: rsm-compute-dev2.ucsd.edu +hostUrl: https://rsm-compute-dev2.ucsd.edu/__api__ +appId: 1 +bundleId: 1 +url: https://rsm-compute-dev2.ucsd.edu/content/3013458f-8bc6-48c1-8b5f-a20d81684d7a/ +version: 1 +asMultiple: FALSE +asStatic: FALSE diff --git a/radiant.data/inst/app/server.R b/radiant.data/inst/app/server.R new file mode 100644 index 0000000000000000000000000000000000000000..a904171808d51d5932614f7e7834c7ddfec63a8e --- /dev/null +++ b/radiant.data/inst/app/server.R @@ -0,0 +1,28 @@ +shinyServer(function(input, output, session) { + enc <- getOption("radiant.encoding", "UTF-8") + + ## source shared functions + source("init.R", encoding = enc, local = TRUE) + source("radiant.R", encoding = enc, local = TRUE) + + ## packages to use for example data + options(radiant.example.data = "radiant.data") + + ## source data & analysis tools + for (file in list.files(c("tools/app", "tools/data"), pattern = "\\.(r|R)$", full.names = TRUE)) { + source(file, encoding = enc, local = TRUE) + } + + # dataviewer_proxy <- DT::dataTableProxy("dataviewer", session) + + # observe(session$setCurrentTheme( + # if (isTRUE(input$dark_mode)) { + # bslib::bs_theme(version = 4, bg = "black", fg = "white") + # } else { + # bslib::bs_theme(version = 4) + # } + # )) + + ## save state on refresh or browser close + saveStateOnRefresh(session) +}) diff --git a/radiant.data/inst/app/tools/app/about.md b/radiant.data/inst/app/tools/app/about.md new file mode 100644 index 0000000000000000000000000000000000000000..01a64c26c3bf62907a03b5f72b74f403eb3a1121 --- /dev/null +++ b/radiant.data/inst/app/tools/app/about.md @@ -0,0 +1,184 @@ +# Radiant - 使用R和Shiny进行商业分析 + + + +[![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/radiant)](https://CRAN.R-project.org/package=radiant) + + +Radiant是一个开源的、与平台无关的、基于浏览器的[R ](https://www.r-project.org/)商业分析界面。该应用程序基于[Shiny ](https://shiny.posit.co/)包构建，可以在本地或服务器上运行。Radiant由Vincent Nijs开发。请使用GitHub上的问题跟踪器提出改进建议或报告问题：[https://github.com/radiant-rstats/radiant/issues。其他问题和评论请使用radiant@rady.ucsd.edu。 ](https://github.com/radiant-rstats/radiant/issues。其他问题和评论请使用radiant@rady.ucsd.edu。) + +## 主要特性 + +- **探索**：快速轻松地汇总、可视化和分析您的数据 +- **跨平台**：它在Windows、Mac和Linux上的浏览器中运行 +- **可重现**：通过状态文件或[Rmarkdown ](https://rmarkdown.rstudio.com/)报告重新创建结果并与他人共享工作 +- **编程**：将Radiant的分析功能与您自己的R代码集成 +- **上下文**：数据和示例侧重于商业应用 + + + +#### 播放列表 + +有两个包含视频教程的YouTube播放列表。第一个提供了Radiant关键特性的总体介绍。第二个涵盖了商业分析课程中相关的主题（即概率、决策分析、假设检验、线性回归和模拟）。 + +* Radiant入门 +* Radiant教程系列 + +#### 探索 + +Radiant是交互式的。当输入更改时（即，没有单独的对话框）和/或按下按钮时（例如，_Model > Estimate > Logistic regression (GLM)_中的`Estimate`），结果会立即更新。这有助于快速探索和理解数据。 + +#### 跨平台 + +Radiant可在Windows、Mac或Linux上工作。它可以在没有互联网连接的情况下运行，并且没有数据会离开您的计算机。您也可以在服务器上将应用程序作为Web应用程序运行。 + +#### 可重现 + +要进行高质量分析，仅仅保存输出是不够的。您需要能够针对相同数据和/或当新数据可用时重现结果。此外，其他人可能希望查看您的分析和结果。保存和加载应用程序状态，以便稍后或在另一台计算机上继续工作。与他人共享状态文件，并使用[Rmarkdown ](https://rmarkdown.rstudio.com/)创建可重现的报告。另请参阅下面的"保存和加载状态"部分。 + +如果您在服务器上使用Radiant，您甚至可以与他人共享URL（包含SSUID），以便他们可以看到您正在处理的内容。感谢[Joe Cheng ](https://github.com/jcheng5)提供此功能。 + +#### 编程 + +尽管Radiant的Web界面可以处理相当多的数据和分析任务，但您可能更喜欢编写自己的R代码。Radiant通过导出用于分析的函数，为R(studio)编程提供了桥梁（即，您可以使用Radiant Web界面进行分析，也可以直接从R代码调用Radiant的函数）。有关使用Radiant进行编程的更多信息，请参阅文档网站上的[编程 ](https://radiant-rstats.github.io/docs/programming.html)页面。 + +#### 上下文 + +Radiant专注于商业数据和决策。它提供了与该上下文相关的工具、示例和文档，有效降低了商业分析的学习曲线。 + +## 如何安装Radiant + +- 必需：[R ](https://cran.r-project.org/)版本4.0.0或更高 +- 必需：[Rstudio ](https://posit.co/download/rstudio-server/) + +在Rstudio中，您可以通过屏幕顶部的`Addins`菜单启动和更新Radiant。要为Windows或Mac安装最新版本的Radiant（包含完整的离线文档），请打开R(studio)并复制粘贴以下命令： + +```r +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org")) +install.packages("radiant") +``` + +安装完所有包后，从Rstudio中的`Addins`菜单选择`Start radiant`，或使用以下命令启动应用程序： + +```r +radiant::radiant() +``` + +要在Rstudio的查看器窗格中启动Radiant，请使用以下命令： + +```r +radiant::radiant_viewer() +``` + +要在Rstudio窗口中启动Radiant，请使用以下命令： + +```r +radiant::radiant_window() +``` + +要轻松更新Radiant和所需包，请使用以下命令安装`radiant.update`包： + +```r +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org")) +install.packages("remotes") +remotes::install_github("radiant-rstats/radiant.update", upgrade = "never") +``` + +然后从Rstudio中的`Addins`菜单选择`Update radiant`，或使用以下命令： + +```r +radiant.update::radiant.update() +``` + +有关更多详细信息，请参阅[安装radiant ](https://radiant-rstats.github.io/docs/install.html)页面。 + +**可选：** 您还可以通过在R(studio)控制台中键入`radiant::launcher()`并按回车键，在桌面上创建启动器来启动Radiant。将创建一个名为`radiant.bat`（Windows）或`radiant.command`（Mac）的文件，您可以双击该文件在默认浏览器中启动Radiant。`launcher`命令还将创建一个名为`update_radiant.bat`（Windows）或`update_radiant.command`（Mac）的文件，您可以双击该文件将Radiant更新到最新版本。 + +当Radiant启动时，您将看到有关钻石价格的数据。要关闭应用程序，请单击导航栏中的图标，然后单击`Stop`。Radiant进程将停止，浏览器窗口将关闭（Chrome）或变灰。 + +## 文档 + +文档和教程可在<[https://radiant-rstats.github.io/docs/ ](https://radiant-rstats.github.io/docs/) >获取，并在Radiant Web界面中（每页上的图标和导航栏中的图标）。 + +各个Radiant包也有自己的[pkgdown ](https://github.com/r-lib/pkgdown)网站： + +* http://radiant-rstats.github.io/radiant +* http://radiant-rstats.github.io/radiant.data +* http://radiant-rstats.github.io/radiant.design +* http://radiant-rstats.github.io/radiant.basics +* http://radiant-rstats.github.io/radiant.model +* http://radiant-rstats.github.io/radiant.multivariate + +需要一些入门帮助吗？观看[文档网站 ](https://radiant-rstats.github.io/docs/tutorials.html)上的教程。 + +## 报告问题 + +如果您在使用Radiant时遇到任何问题，请使用GitHub问题跟踪器：github.com/radiant-rstats/radiant/issues。 + +## 在线试用Radiant + +还没有准备好在计算机上安装Radiant？在以下链接在线试用： + +https://vnijs.shinyapps.io/radiant + +请**不要**将敏感数据上传到此公共服务器。出于安全原因，数据上传大小已限制为10MB。 + +## 在shinyapps.io上运行Radiant + +要在shinyapps.io上运行您自己的Radiant实例，首先安装Radiant及其依赖项。然后克隆radiant仓库，并通过运行`radiant/inst/app/for.shinyapps.io.R`确保您已安装最新版本的Radiant包。最后，打开`radiant/inst/app/ui.R`并[部署 ](https://shiny.posit.co/articles/shinyapps.html)应用程序。 + +## 在shiny-server上运行Radiant + +您也可以使用[shiny-server ](https://posit.co/download/shiny-server/)托管Radiant。首先，使用以下命令在服务器上安装radiant： + +```r +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org")) +install.packages("radiant") +``` + +然后克隆radiant仓库，并将shiny-server指向`inst/app/`目录。如果您打算在服务器上使用Radiant，请告知我，我将不胜感激。 + +在服务器上运行Radiant时，默认情况下，文件上传限制为10MB，并且出于安全原因，_Report > Rmd_和_Report > R_中的R代码不会被评估。如果您拥有服务器的`sudo`访问权限并有适当的安全措施，可以通过向服务器上`shiny`用户的`.Rprofile`添加以下行来更改这些设置。 + +```bash +options(radiant.maxRequestSize = -1) ## no file size limit +options(radiant.report = TRUE) +``` + +## 在云中运行Radiant（例如，AWS） + +要在云中运行radiant，您可以使用自定义Docker容器。详情请参见https://github.com/radiant-rstats/docker + +## 保存和加载状态 + +要保存您的分析，请单击导航栏中的图标，然后单击`Save radiant state file`（另请参见_Data > Manage_选项卡）将应用程序状态保存到文件中。您可以稍后或在另一台计算机上打开此状态文件，继续您之前的工作。您也可以与希望复制您分析的其他人共享该文件。例如，单击导航栏中的图标，然后单击`Load radiant state file`，加载状态文件[`radiant-example.state.rda` ](https://radiant-rstats.github.io/docs/examples/radiant-example.state.rda)。转到_Data > View_和_Data > Visualize_查看应用程序先前"状态"的一些设置。_Report > Rmd_中还有一个使用Radiant界面创建的报告。html文件`radiant-example.nb.html`包含输出。 + +Radiant中的一个相关功能是，如果您意外导航到另一个网页、关闭（并重新打开）浏览器和/或点击刷新，状态将保持不变。在导航栏中的菜单中使用`Refresh`返回到干净/新的状态。 + +加载和保存状态也适用于Rstudio。如果您从Rstudio启动Radiant并使用 > `Stop`停止应用程序，则名为`r_data`、`r_info`和`r_state`的列表将放入Rstudio的全局工作空间中。如果您再次使用`radiant::radiant()`启动radiant，它将使用这些列表来恢复状态。此外，如果您直接将状态文件加载到Rstudio中，启动Radiant时将使用该文件重新创建先前的状态。 + +**技术说明**：Radiant中的状态加载工作方式如下：当在Shiny应用程序中初始化输入时，您在调用（例如，numericInput）中设置默认值。在Radiant中，当加载状态文件并初始化输入时，它会查看名为`r_state`的列表中是否有该名称的输入值。如果有，则使用该值。`r_state`列表是在使用`reactiveValuesToList(input)`保存状态时创建的。下面给出了调用`numericInput`的示例，其中使用了来自`radiant.R`的`state_init`函数来检查是否可以使用来自`r_state`的值。 + +```r +numericInput("sm_comp_value", "Comparison value:", state_init("sm_comp_value", 0)) +``` + +## 源代码 + +Radiant应用程序的源代码可在GitHub上获取：<[https://github.com/radiant-rstats ](https://github.com/radiant-rstats) >。`radiant.data`提供工具来加载、保存、查看、可视化、汇总、组合和转换数据。`radiant.design`基于`radiant.data`构建，并添加了用于实验设计、抽样和样本量计算的工具。`radiant.basics`涵盖了统计分析的基础知识（例如，比较均值和比例、交叉表、相关性等），并包括一个概率计算器。`radiant.model`涵盖了模型估计（例如，逻辑回归和神经网络）、模型评估（例如，增益图、利润曲线、混淆矩阵等）和决策工具（例如，决策分析和模拟）。最后，`radiant.multivariate`包括生成品牌地图以及进行聚类、因子和联合分析的工具。 + +这些工具用于加州大学圣地亚哥分校Rady管理学院的_Business Analytics_、*Quantitative Analysis*、*Research for Marketing Decisions*、*Applied Market Research*、*Consumer Behavior*、*Experiments in Firms*、*Pricing*、_Pricing Analytics_和_Customer Analytics_课程。 + +## 致谢 + +没有[R ](https://cran.r-project.org/)和[Shiny ](https://shiny.posit.co/)，Radiant是不可能实现的。我要感谢[Joe Cheng ](https://github.com/jcheng5)、[Winston Chang ](https://github.com/wch)和[Yihui Xie ](https://github.com/yihui)回答问题、提供建议并为R社区创建出色的工具。Radiant中使用的其他关键组件包括ggplot2、dplyr、tidyr、magrittr、broom、shinyAce、shinyFiles、rmarkdown和DT。有关Radiant所依赖的其他包的概述，请参阅关于页面。 + +## 许可证 + +Radiant根据AGPLv3许可。简而言之，AGPLv3许可证要求：归属，包括软件副本中的版权声明和许可信息，如果代码被修改则说明更改，以及披露所有源代码。详情请参见COPYING文件。 + +`radiant.data`包的文档、图像和视频根据知识共享署名和相同方式共享许可CC-BY-SA许可。本网站上的所有其他文档和视频，以及`radiant.design`、`radiant.basics`、`radiant.model`和`radiant.multivariate`的帮助文件，均根据知识共享署名、非商业性、相同方式共享许可CC-NC-SA许可。 + +如果您有兴趣使用任何radiant包，请通过[radiant@rady.ucsd.edu ](mailto:radiant@rady.ucsd.edu)给我发邮件。 + +© Vincent Nijs (2024) Creative Commons License diff --git a/radiant.data/inst/app/tools/app/help.R b/radiant.data/inst/app/tools/app/help.R new file mode 100644 index 0000000000000000000000000000000000000000..0fcac28c923a08c1381bc572c9c56fe32643ea97 --- /dev/null +++ b/radiant.data/inst/app/tools/app/help.R @@ -0,0 +1,138 @@ +####################################### +## Other elements in help menu +####################################### +output$help_videos <- renderUI({ + file.path(getOption("radiant.path.data"), "app/tools/app/tutorials.md") %>% inclMD() %>% HTML() +}) + +output$help_about <- renderUI({ + file.path(getOption("radiant.path.data"), "app/tools/app/about.md") %>% inclMD() %>% HTML() +}) + +output$help_text <- renderUI({ + wellPanel( + HTML("Help is available on each page by clicking the icon on the bottom left of your screen.

    Versions: ", getOption("radiant.versions", default = "Unknown")) + ) +}) + +####################################### +## Main function of help menu +####################################### +append_help <- function(help_str, help_path, lic = "nc", Rmd = TRUE) { + if (length(input[[help_str]]) == 0) return() + help_block <- get(help_str) + local_hd <- help_block[which(help_block %in% input[[help_str]])] + all_help <- c() + for (i in names(local_hd)) { + all_help <- paste( + all_help, paste0("

    ", i, "

    "), + inclRmd(file.path(help_path, local_hd[i])), + sep = "\n" + ) + } + mathjax_script <- ifelse(Rmd, "", "") + + if (lic == "nc") { + cc <- getOption("radiant.help.cc", default = "") + } else { + cc <- getOption("radiant.help.cc.sa", default = "") + } + + ## remove ` from report.md + paste( + gsub("(\"> )`", "\\1", all_help) %>% + gsub("`( )", "\\1", .), + "\n", mathjax_script, "\n", cc + ) %>% HTML() +} + +help_switch <- function(help_all, help_str, help_on = TRUE) { + if (is.null(help_all) || help_all == 0) return() + help_choices <- help_init <- get(help_str) + init <- "" + if (help_on) init <- help_init + updateCheckboxGroupInput( + session, help_str, + label = NULL, + choices = help_choices, + selected = init, inline = TRUE + ) +} + +help_data <- c( + "Manage" = "manage.md", "View" = "view.md", "Visualize" = "visualize.md", + "Pivot" = "pivotr.md", "Explore" = "explore.md", "Transform" = "transform.md", + "Combine" = "combine.md", "Report > Rmd" = "report_rmd.md", "Report > R" = "report_r.md" +) +output$help_data <- reactive( + append_help("help_data", file.path(getOption("radiant.path.data"), "app/tools/help/")) +) + +observeEvent(input$help_data_all, { + help_switch(input$help_data_all, "help_data") +}) +observeEvent(input$help_data_none, { + help_switch(input$help_data_none, "help_data", help_on = FALSE) +}) + +help_data_panel <- + wellPanel( + HTML( + "" + ), + checkboxGroupInput("help_data", NULL, help_data, selected = state_group("help_data"), inline = TRUE) + ) + +output$help_data_ui <- renderUI({ + sidebarLayout( + sidebarPanel( + help_data_panel, + uiOutput("help_text"), + width = 3 + ), + mainPanel( + HTML(paste0("

    Select help files to show and search

    ")), + htmlOutput("help_data") + ) + ) +}) + +observeEvent(input$help_keyboard, { + showModal( + modalDialog( + title = i18n$t("Keyboard shortcuts"), + h4(i18n$t("General")), + ## based on https://github.com/swarm-lab/editR/blob/master/inst/app/bits/keyboard.R + withTags( + table(style = "width: 80%; margin-left: 10%;", + tr(class = "border_bottom", + td(b(i18n$t("Function"))), td(b("Mac")), td(b("Windows & Linux"))), + tr(class = "padding_top", + td(i18n$t("Save state")), td("Shift-CMD-s"), td("Shift-CTRL-s")), + tr(class = "padding_top", + td(i18n$t("Open state")), td("Shift-CMD-o"), td("Shift-CTRL-o")), + tr(class = "border_bottom padding_bottom", + td(i18n$t("Show help")), td("F1"), td("F1")), + tr(class = "border_bottom padding_bottom", + td(i18n$t("Generate screenshot")), td("CMD-p"), td("CTRL-p")), + tr(class = "border_bottom padding_bottom", + td(i18n$t("Generate code")), td("ALT-return"), td("ALT-return")), + tr(class = "border_bottom padding_bottom", + td(i18n$t("Estimate/Run (green button)")), td("CMD-enter"), td("CTRL-enter")), + tr(class = "border_bottom padding_bottom", + td(i18n$t("Save (blue button)")), td("CMD-s"), td("CTRL-s")), + tr(class = "border_bottom padding_bottom", + td(i18n$t("Download (blue icon)")), td("CMD-s"), td("CTRL-s")), + tr(class = "border_bottom padding_bottom", + td(i18n$t("Load (blue button)")), td("CMD-o"), td("CTRL-o")) + # tr(class = "border_bottom padding_bottom", + # td("Viewer pane full screen"), td("Shift-CTRL-9"), td("Shift-CTRL-9")) + ) + ), + footer = modalButton("OK"), + size = "l", + easyClose = TRUE + ) + ) +}) diff --git a/radiant.data/inst/app/tools/app/report_funs.R b/radiant.data/inst/app/tools/app/report_funs.R new file mode 100644 index 0000000000000000000000000000000000000000..023d8f60f1ad86483b3231a5041e9897d0271212 --- /dev/null +++ b/radiant.data/inst/app/tools/app/report_funs.R @@ -0,0 +1,850 @@ +file_upload_button <- function(inputId, label = "", multiple = FALSE, + accept = NULL, buttonLabel = "Load", title = "Load data", + class = "", icn = "upload", progress = FALSE) { + if (getOption("radiant.shinyFiles", FALSE)) { + shinyFiles::shinyFileChoose( + input = input, + id = inputId, + session = session, + roots = sf_volumes, + filetype = gsub(".", "", accept, fixed = TRUE) + ) + + # actionButton(inputId, buttonLabel, icon = icon(icn), class = class) + shinyFiles::shinyFilesButton( + inputId, buttonLabel, label, + title = title, multiple = FALSE, + class = class, icon = icon(icn, verify_fa = FALSE) + ) + } else { + if (length(accept) > 0) { + accept <- paste(accept, collapse = ",") + } else { + accept <- "" + } + + if (!is.empty(label)) { + label <- paste0("

    ") + } + + btn <- paste0(label, " + + ") + + if (progress) { + btn <- paste0(btn, "\n
    +
    +
    ") + } + + HTML(btn) + } +} + +## Thanks to @timelyportfolio for this comment/fix +## https://github.com/timelyportfolio/functionplotR/issues/1#issuecomment-224369431 +## needed to include deps in saved reports rendered using rmarkdown +getdeps <- function() { + htmltools::attachDependencies( + htmltools::tagList(), + c( + htmlwidgets:::getDependency("DiagrammeR", "DiagrammeR"), + htmlwidgets:::getDependency("plotly", "plotly") + ) + ) +} + +## get information from rstudio editor +rstudio_context <- function(type = "rmd") { + rse <- rstudioapi::getSourceEditorContext() + path <- rse$path + ext <- tools::file_ext(path) + + if (is.empty(path) || !file.exists(path) || tolower(ext) != type) { + ## path will be empty of new file hasn't been save yet + list(path = "", rpath = "", base = "", base_name = "", ext = "", content = "") + } else { + path <- normalizePath(path, winslash = "/") + pdir <- getOption("radiant.project_dir", default = radiant.data::find_home()) + + sel <- rse$selection[[1]][["text"]] + if (is.empty(sel)) { + content <- paste0(rse$content, collapse = "\n") + } else { + content <- paste0(sel, collapse = "\n") + } + + base <- basename(path) + base_name <- sub(paste0(".", ext), "", base) + + rpath <- if (is.empty(pdir)) { + path + } else { + sub(paste0(pdir, "/"), "", path) + } + + list( + path = path, + rpath = rpath, + base = base, + base_name = sub(paste0(".", ext, "$"), "", base), + ext = tolower(ext), + content = content + ) + } +} + +scrub <- . %>% + gsub("<!--/html_preserve-->", "", .) %>% + gsub("<!--html_preserve-->", "", .) %>% + gsub("<!–html_preserve–>", "", .) %>% + gsub("<!–/html_preserve–>", "", .) ## knitr adds this + +setup_report <- function(report, ech, add_yml = TRUE, type = "rmd", + save_type = "Notebook", lib = "radiant") { + report <- fix_smart(report) %>% + gsub("^```\\s*\\{", "\n\n```{", .) %>% + gsub("^```\\s*\n", "```\n\n", .) %>% + sub("^---\n(.*?)\n---", "", .) %>% + sub("", "", .) + + ## screenshot option + sopts <- ifelse(save_type == "PDF", ",\n screenshot.opts = list(vheight = 1200)", "") + + if (add_yml) { + if (save_type %in% c("PDF", "Word", "Powerpoint")) { + yml <- "" + } else if (save_type == "HTML") { + yml <- "---\npagetitle: HTML report\noutput:\n html_document:\n highlight: zenburn\n theme: cosmo\n df_print: paged\n toc: yes\n---\n\n" + } else if (save_type %in% c("Rmd", "Rmd + Data (zip)")) { + yml <- "---\npagetitle: Rmd report\noutput:\n html_document:\n highlight: zenburn\n theme: cosmo\n df_print: paged\n toc: yes\n code_folding: hide\n code_download: true\n---\n\n" + } else { + yml <- "---\npagetitle: Notebook report\noutput:\n html_notebook:\n highlight: zenburn\n theme: cosmo\n toc: yes\n code_folding: hide\n---\n\n" + } + } else { + yml <- "" + } + + if (missing(ech)) { + ech <- if (save_type %in% c("PDF", "Word", "Powerpoint", "HTML")) "FALSE" else "TRUE" + } + + if (grepl("```{r r_setup, include = FALSE}\n", report, fixed = TRUE)) { + report + } else { + paste0(yml, "```{r r_setup, include = FALSE} +## initial settings +knitr::opts_chunk$set( + comment = NA, + echo = ", ech, ", + error = TRUE, + cache = FALSE, + message = FALSE,\n + dpi = 96, + warning = FALSE", sopts, " +) + +## width to use when printing tables etc. +options( + width = 250, + scipen = 100, + max.print = 5000, + stringsAsFactors = FALSE +) + +## make all required libraries available by loading radiant package if needed +if (is.null(shiny::getDefaultReactiveDomain())) library(", lib, ") + +## include code to load the data you require +## for interactive use attach the r_data environment +# attach(r_data) +``` + +\n\n", report) + } +} + +## Based on http://stackoverflow.com/a/31797947/1974918 +## as of 12/30/2017 doesn't seem to work anymore +knit_it_save <- function(report) { + ## Read input and convert to Markdown + md <- knitr::knit(text = report, envir = r_data) + + ## Get dependencies from knitr + deps <- knitr::knit_meta() + + ## Convert script dependencies into data URIs, and stylesheet + ## dependencies into inline stylesheets + dep_scripts <- + lapply(deps, function(x) { + lapply(x$script, function(script) file.path(x$src$file, script)) + }) %>% + unlist() %>% + unique() + dep_stylesheets <- + lapply(deps, function(x) { + lapply(x$stylesheet, function(stylesheet) file.path(x$src$file, stylesheet)) + }) %>% + unlist() %>% + unique() + dep_html <- c( + sapply(dep_scripts, function(script) { + sprintf( + '', + base64enc::dataURI(file = script) + ) + }), + sapply(dep_stylesheets, function(sheet) { + sprintf( + "", + paste(sshhr(readLines(sheet)), collapse = "\n") + ) + }) + ) + + ## Extract the bits + preserved <- htmltools::extractPreserveChunks(md) + + ## Render the HTML, and then restore the preserved chunks + markdown::mark_html( + text = preserved$value, + header = dep_html, + options = c("mathjax", "base64_images"), + meta = list(css = file.path(getOption("radiant.path.data"), "app/www/bootstrap.min.css")) + ) %>% + htmltools::restorePreserveChunks(preserved$chunks) %>% + gsub("", "
    ", .) +} + +report_clean <- function(report) { + withProgress(message = "Cleaning report", value = 1, { + report <- gsub("\nr_data\\[\\[\"([^\n]+?)\"\\]\\] \\%>\\%(.*?)\\%>\\%\\s*?store\\(\"(.*?)\", (\".*?\")\\)", "\n\\3 <- \\1 %>%\\2\nregister(\"\\3\", \\4)", report) %>% + gsub("r_data\\[\\[\"([^\"]+?)\"\\]\\]", "\\1", .) %>% + gsub("r_data\\$", "", .) %>% + gsub("\"mean_rm\"", "\"mean\"", .) %>% + gsub("\"median_rm\"", "\"median\"", .) %>% + gsub("\"min_rm\"", "\"min\"", .) %>% + gsub("\"max_rm\"", "\"max\"", .) %>% + gsub("\"sd_rm\"", "\"sd\"", .) %>% + gsub("\"var_rm\"", "\"var\"", .) %>% + gsub("\"sum_rm\"", "\"sum\"", .) %>% + gsub("\"length\"", "\"n_obs\"", .) %>% + gsub("tabsort = \"desc\\(n\\)\"", "tabsort = \"desc\\(n_obs\\)\"", .) %>% + gsub("Search\\(\"(.*?)\",\\s*?.\\)", "search_data(., \"\\1\")", .) %>% + gsub("toFct\\(\\)", "to_fct()", .) %>% + gsub("rounddf\\(", "round_df(", .) %>% + gsub("formatnr\\(", "format_nr(", .) %>% + gsub("formatdf\\(", "format_df(", .) %>% + gsub("dataset\\s*=\\s*\"([^\"]+)\",", "\\1,", .) %>% + gsub("store\\(pred, data\\s*=\\s*\"([^\"]+)\"", "\\1 <- store(\\1, pred", .) %>% + gsub("pred_data\\s*=\\s*\"([^\"]+)\"", "pred_data = \\1", .) %>% + gsub("(combinedata\\(\\s*?x\\s*?=\\s*?)\"([^\"]+?)\",(\\s*?y\\s*?=\\s*?)\"([^\"]+?)\",", "\\1\\2,\\3\\4,", .) %>% + gsub("(combinedata\\((.|\n)*?),\\s*?name\\s*?=\\s*?\"([^\"`]+?)\"([^\\)]+?)\\)", "\\3 <- \\1\\4)\nregister(\"\\3\")", .) %>% + gsub("combinedata\\(", "combine_data(", .) %>% + gsub("result\\s*<-\\s*(simulater\\((.|\n)*?),\\s*name+\\s*=\\s*\"([^\"`]*?)\"([^\\)]*?)\\)", "\\3 <- \\1\\4)\nregister(\"\\3\")", .) %>% + gsub("data\\s*=\\s*\"([^\"]+)\",", "data = \\1,", .) %>% + gsub("(simulater\\((\n|.)*?)(register\\(\"(.*?)\"\\))\nsummary\\(result", "\\1\\3\nsummary(\\4", .) %>% + gsub("(simulater\\((\n|.)*?)(register\\(\"(.*?)\"\\))\n(summary.*?)\nplot\\(result", "\\1\\3\n\\5\nplot(\\4", .) %>% + gsub("result\\s*<-\\s*(repeater\\((.|\n)*?),\\s*name+\\s*=\\s*\"([^\"`]*?)\"([^\\)]*?)\\)", "\\3 <- \\1\\4)\nregister(\"\\3\")", .) %>% + gsub("(repeater\\((\n|.)*?)(register\\(\"(.*?)\"\\))\nsummary\\(result", "\\1\\3\nsummary(\\4", .) %>% + gsub("(repeater\\((\n|.)*?)(register\\(\"(.*?)\"\\))\n(summary.*?)\nplot\\(result", "\\1\\3\n\\5\nplot(\\4", .) %>% + gsub("repeater\\(((.|\n)*?),\\s*sim+\\s*=\\s*\"([^\"`]*?)\"([^\\)]*?)\\)", "repeater(\n \\3,\\1\\4)", .) %>% + gsub("(```\\{r.*?\\})(\nresult <- pivotr(\n|.)*?)(\\s*)store\\(result, name = \"(.*?)\"\\)", "\\1\\2\\4\\5 <- result$tab; register(\"\\5\")\\6", .) %>% + gsub("(```\\{r.*?\\})(\nresult <- explore(\n|.)*?)(\\s*)store\\(result, name = \"(.*?)\"\\)", "\\1\\2\\4\\5 <- result$tab; register(\"\\5\")\\6", .) %>% + gsub("store\\(result,\\s*name\\s*=\\s*\"(.*?)\",\\s*type\\s*=\\s*\"((P|I)W)\"\\)", "\\1 <- result$\\2; register(\"\\1\")", .) + }) + + # if ("styler" %in% installed.packages()) { + # withProgress(message = "Styling report code", value = 1, { + # tmp_dir <- tempdir() + # tmp_fn <- tempfile(pattern = "report-to-style", tmpdir = tmp_dir, fileext = ".Rmd") + # cat(paste(report, "\n"), file = tmp_fn) + # ret <- styler::style_file(tmp_fn) + # report <- paste0(readLines(tmp_fn), collapse = "\n") + # }) + # } + removeModal() + fix_smart(report) +} + +observeEvent(input$report_clean_r, { + shinyAce::updateAceEditor( + session, "r_edit", + value = report_clean(input$r_edit) + ) +}) + +observeEvent(input$report_clean_rmd, { + shinyAce::updateAceEditor( + session, "rmd_edit", + value = report_clean(input$rmd_edit) + ) +}) + +observeEvent(input$report_ignore, { + r_info[["report_ignore"]] <- TRUE + removeModal() +}) + +## Knit for report in Radiant +knit_it <- function(report, type = "rmd") { + ## may be needed on windows when text has been copy-and-pasted + ## from a pdf + report <- gsub("\r\n", "\n", report) %>% + gsub("\r", "\n", .) + + if (type == "rmd") { + report <- gsub("\\\\\\\\\\s*\n", "\\\\\\\\\\\\\\\\\n", report) + } + + if ( + !isTRUE(r_info[["report_ignore"]]) && + (grepl("\\s*r_data\\[\\[\".*?\"\\]\\]", report) || + grepl("\\s*r_data\\$", report) || + grepl("\n(\\#|\\s)*store\\(result,\\s*name", report) || + grepl("store\\(pred,\\s*data\\s*=\\s*\"", report) || + grepl("\\s+data\\s*=\\s*\".*?\",", report) || + grepl("\\s+dataset\\s*=\\s*\".*?\",", report) || + grepl("\\s+pred_data\\s*=\\s*\"[^\"]+?\",", report) || + grepl("result\\s*<-\\s*simulater\\(", report) || + grepl("result\\s*<-\\s*repeater\\(", report) || + grepl("combinedata\\(\\s*x\\s*=\\s*\"[^\"]+?\"", report) || + grepl("formatnr\\(", report) || + grepl("formatdf\\(", report) || + grepl("rounddf\\(", report) || + grepl("tabsort = \"desc\\(n\\)\"", report) || + grepl("(mean_rm|median_rm|min_rm|max_rm|sd_rm|var_rm|sum_rm)", report)) + ) { + showModal( + modalDialog( + title = "The report contains deprecated code", + span( + "The use of, e.g., r_data[[...]], dataset = \"...\", etc. in your report is + deprecated. Click the 'Clean report' button to remove references that are no + longer needed.", br(), br(), "Warning: It may not be possible to update all code + to the latest standard automatically. For example, the use of 'store(...)' + functions has changed and not all forms can be automatically updated. If this + applies to your report a message should be shown when you Knit the report + demonstrating how the code should be changed. You can, of course, also use the + browser interface to recreate the code you need or use the help function in R or + Rstudio for more information (e.g., ?radiant.model::store.model, + ?radiant.model::store.model.predict, or ?radiant.model::simulater)", br(), br(), + "To avoid the code-cleaning step click 'Cancel' or, if you believe the code is + correct as-is, click the 'Ignore' button and continue to Knit your report" + ), + footer = tagList( + modalButton("Cancel"), + actionButton("report_ignore", "Ignore", title = "Ignore cleaning popup", class = "btn-primary"), + actionButton(paste0("report_clean_", type), "Clean report", title = "Clean report", class = "btn-success") + ), + size = "m", + easyClose = TRUE + ) + ) + return(invisible()) + } + + ## fragment also available with rmarkdown + ## https://rmarkdown.rstudio.com/html_fragment_format.html + + ## setting the working directory to use + ldir <- getOption("radiant.launch_dir", default = radiant.data::find_home()) + pdir <- getOption("radiant.project_dir", default = ldir) + + tdir <- tempdir() + owd <- ifelse(is.empty(pdir), setwd(tdir), setwd(pdir)) + on.exit(setwd(owd)) + + ## sizing issue with ggplotly and knitr + ## see https://github.com/ropensci/plotly/issues/1171 + ## see also below unsuccessful fix setting height to 100% + # if (grepl("ggplotly\\(\\)", report)) { + # message("\n\nHeight of ggplotly objects may not be correct in Preview. The height will be correctly displayed in saved reports however.\n\n") + # } + + ## remove yaml headers and html comments and convert to md + report <- sub("^---\n(.*?)\n---", "", report) %>% + sub("", "", .) + + if (!grepl("```{r r_setup, include = FALSE}\n", report, fixed = TRUE)) { + report <- paste0("```{r knit_it_setup, include = FALSE}\noptions(width = 250, scipen = 100, max.print = 5000, stringsAsFactors = FALSE)\n```\n\n", report) + } + + ## convert to md + md <- knitr::knit( + text = report, + envir = r_data, + quiet = TRUE + ) + + ## removing fig.caps for unnamed chunks + md <- gsub("

    plot of chunk unnamed-chunk-[0-9]+

    ", "", md) + + ## add basic styling to tables + paste( + markdown::mark_html(text = md, template = FALSE, meta = list(css = ""), output = FALSE), + paste0(""), + "", + sep = "\n" + ) %>% + gsub("
    ", "
    ", .) %>% + ## makes plots full height of screen (i.e., WAY too big) + # gsub("style=\"width:100%; height:400px; \" class=\"plotly html-widget", + # "style=\"width:100%; height:100%; \" class=\"plotly html-widget", ., fixed = TRUE) %>% + scrub() %>% + HTML() +} + +sans_ext <- function(path) { + sub( + "(\\.state\\.rda|\\.rda$|\\.rds$|\\.rmd$|\\.r$|\\.rdata$|\\.html|\\.nb\\.html|\\.pdf|\\.docx|\\.pptx|\\.rmd|\\.zip)", "", + tolower(path), + ignore.case = TRUE + ) +} + +report_name <- function(type = "rmd", out = "report", full.name = FALSE) { + ldir <- getOption("radiant.launch_dir", default = radiant.data::find_home()) + pdir <- getOption("radiant.project_dir", default = ldir) + + ## generate report name based on state or project name + if (input[[paste0(type, "_generate")]] %in% c("To Rmd", "To R")) { + fn <- r_state[[paste0("radiant_", type, "_name")]] + } else { + fn <- "" + } + + if (is.empty(fn)) { + fn <- state_name() + fn <- sans_ext(fn) %>% + sub("-state", paste0("-", out), .) + + r_state[[paste0("radiant_", type, "_name")]] <<- + paste(fn, sep = ".", switch(type, + rmd = "Rmd", + r = "R" + )) + } else { + fn <- basename(fn) %>% + sans_ext() + } + + if (full.name) { + file.path(pdir, fn) + } else { + fn + } +} + +report_save_filename <- function(type = "rmd", full.name = TRUE) { + req(input[[paste0(type, "_generate")]]) + + if (input[[paste0(type, "_generate")]] %in% c("To Rmd", "To R")) { + cnt <- rstudio_context(type = type) + if (!is.empty(cnt$path)) { + if (cnt$path != cnt$rpath) { + r_state[[paste0("radiant_", type, "_name")]] <<- cnt$rpath + } else { + r_state[[paste0("radiant_", type, "_name")]] <<- cnt$path + } + + if (full.name) { + fn <- cnt$path + } else { + fn <- cnt$base_name + } + } else { + fn <- report_name(type = type, full.name = full.name) + } + } else { + fn <- report_name(type = type, full.name = full.name) + } + + fn <- sans_ext(fn) + + paste(fn, sep = ".", switch(input[[paste0(type, "_save_type")]], + Notebook = "nb.html", + HTML = "html", + PDF = "pdf", + Word = "docx", + Powerpoint = "pptx", + Rmd = "Rmd", + `Rmd + Data (zip)` = "zip", + R = "R", + `R + Data (zip)` = "zip" + )) +} + +report_save_content <- function(file, type = "rmd") { + if (isTRUE(getOption("radiant.report"))) { + isolate({ + ldir <- getOption("radiant.launch_dir", default = radiant.data::find_home()) + pdir <- getOption("radiant.project_dir", default = ldir) + + tdir <- tempdir() + owd <- ifelse(is.empty(pdir), setwd(tdir), setwd(pdir)) + on.exit(setwd(owd)) + + save_type <- input[[paste0(type, "_save_type")]] + generate <- input[[paste0(type, "_generate")]] + + zip_info <- getOption("radiant.zip") + if (save_type %in% c("Rmd + Data (zip)", "R + Data (zip)")) { + if (is.empty(zip_info)) { + ## No zip warning + showModal( + modalDialog( + title = "ZIP attempt failed", + span( + "There is no zip utility in the path on this system. Please install a zip utility (e.g., 7-zip) and try again" + ), + footer = modalButton("OK"), + size = "m", + easyClose = TRUE + ) + ) + return(invisible()) + } + } + + lib <- if ("radiant" %in% installed.packages()) "radiant" else "radiant.data" + + if (generate %in% c("To Rmd", "To R")) { + cnt <- rstudio_context(type) + if (is.empty(cnt$path) || !cnt$ext == type) { + if (generate == "To Rmd") { + report <- "#### Radiant is set to use an rmarkdown document in Rstudio ('To Rmd').\n#### Please check that you have an .Rmd file open in Rstudio and that the file has been saved to disk.\n#### If you want to use the editor in Radiant instead, change 'To Rmd' to 'Auto paste' or 'Manual paste'." + } else { + report <- "#### Radiant is set to use an R-code document in Rstudio ('To R').\n#### Please check that you have an .R file open in Rstudio and that the file has been saved to disk.\n#### If you want to use the editor in Radiant instead, change 'To R' to 'Auto paste' or 'Manual paste'." + } + } else { + report <- cnt$content + } + } else { + report <- input[[paste0(type, "_edit")]] + } + + if (save_type == "Rmd + Data (zip)") { + withProgress(message = "Preparing Rmd + Data zip file", value = 1, { + ## don't want to write to current dir + currdir <- setwd(tempdir()) + save(list = ls(envir = r_data), envir = r_data, file = "r_data.rda") + + setup_report(report, save_type = "Rmd", lib = lib) %>% + fix_smart() %>% + cat(file = "report.Rmd", sep = "\n") + + zip(file, c("report.Rmd", "r_data.rda"), + flags = zip_info[1], zip = zip_info[2] + ) + setwd(currdir) + }) + } else if (save_type == "R + Data (zip)") { + withProgress(message = "Preparing R + Data zip file", value = 1, { + ## don't want to write to current dir + currdir <- setwd(tempdir()) + save(list = ls(envir = r_data), envir = r_data, file = "r_data.rda") + + cat(report, file = "report.R", sep = "\n") + + zip(file, c("report.R", "r_data.rda"), + flags = zip_info[1], zip = zip_info[2] + ) + setwd(currdir) + }) + } else if (save_type == "Rmd") { + setup_report(report, save_type = "Rmd", lib = lib) %>% + fix_smart() %>% + cat(file = file, sep = "\n") + } else if (save_type == "R") { + cat(report, file = file, sep = "\n") + } else { + if (file.access(getwd(), mode = 2) == -1) { + ## A writable working directory is required to save reports + showModal( + modalDialog( + title = "Working directory is not writable", + HTML( + paste0( + " + The working directory used by radiant (\"", getwd(), "\") is not writable. This is required to save a report. + To save reports, restart radiant from a writable directory. Preferaby by setting up an Rstudio + project folder. See + https://support.posit.co/hc/en-us/articles/200526207-Using-Projects for more information + " + ) + ), + footer = modalButton("OK"), + size = "m", + easyClose = TRUE + ) + ) + return(invisible()) + } + + ## hack for rmarkdown from Report > Rmd and Report > R + options(radiant.rmarkdown = TRUE) + + if (type == "r") { + report <- paste0("\n```{r echo = TRUE}\n", report, "\n```\n") + } + + init <- setup_report(report, save_type = save_type, lib = lib) %>% + fix_smart() + + ## on linux ensure you have you have pandoc > 1.14 installed + ## you may need to use http://pandoc.org/installing.html#installing-from-source + ## also check the logs to make sure its not complaining about missing files + withProgress(message = paste0("Saving report to ", save_type), value = 1, { + if (isTRUE(rmarkdown::pandoc_available())) { + ## have to use current dir so (relative) paths work properly + tmp_fn <- tempfile(pattern = "report-", tmpdir = ".", fileext = ".Rmd") + cat(init, file = tmp_fn, sep = "\n") + + if (!save_type %in% c("Notebook", "HTML")) { + oop <- knitr::opts_chunk$get()$screenshot.force + knitr::opts_chunk$set(screenshot.force = TRUE) + on.exit(knitr::opts_chunk$set(screenshot.force = oop)) + } + + out <- rmarkdown::render( + tmp_fn, + switch(save_type, + Notebook = rmarkdown::html_notebook(highlight = "zenburn", theme = "cosmo", code_folding = "hide"), + HTML = rmarkdown::html_document(highlight = "zenburn", theme = "cosmo", code_download = TRUE, df_print = "paged"), + PDF = rmarkdown::pdf_document(), + Word = rmarkdown::word_document( + reference_docx = getOption("radiant.word_style", default = file.path(system.file(package = "radiant.data"), "app/www/style.docx")), + ), + Powerpoint = rmarkdown::powerpoint_presentation( + reference_doc = getOption("radiant.powerpoint_style", default = file.path(system.file(package = "radiant.data"), "app/www/style.potx")) + ) + ), + envir = r_data, quiet = TRUE, encoding = "UTF-8", + output_options = list(pandoc_args = "--quiet") + ) + ## no using file.rename as it may fail to overwrite even if confirmed by the users + file.copy(out, file, overwrite = TRUE) + file.remove(out, tmp_fn) + } else { + ## still needed because rmarkdown requires pandoc + setup_report(report, add_yml = FALSE, type = save_type, lib = lib) %>% + fix_smart() %>% + knit_it_save() %>% + cat(file = file, sep = "\n") + } + }) + + ## hack for rmarkdown from Report > Rmd and Report > R + options(radiant.rmarkdown = FALSE) + } + }) + } +} + +## updating the report when called +update_report <- function(inp_main = "", fun_name = "", inp_out = list("", ""), + cmd = "", pre_cmd = "result <- ", post_cmd = "", + xcmd = "", outputs = c("summary", "plot"), inp = "result", + wrap, figs = TRUE, fig.width = 7, fig.height = 7) { + ## determine number of characters for main command for wrapping + if (missing(wrap)) { + lng <- nchar(pre_cmd) + nchar(fun_name) + nchar(post_cmd) + 2 + if (!is.empty(inp_main)) { + lng <- lng + sum(nchar(inp_main)) + + sum(nchar(names(inp_main))) + + length(inp_main) * 5 - 1 + } + wrap <- ifelse(lng > 70, TRUE, FALSE) + } + + dctrl <- getOption("dctrl") + + ## wrapping similar to styler + depr <- function(x, wrap = FALSE) { + cutoff <- ifelse(wrap, 20L, 55L) + for (i in names(x)) { + tmp <- x[[i]] + wco <- ifelse(max(nchar(tmp)) > cutoff, cutoff, 55L) + if (inherits(tmp, "fractions")) { + if (length(tmp) > 1) { + tmp <- paste0("c(", paste(tmp, collapse = ", "), ")") + } else { + tmp <- as.character(tmp) + } + } else { + tmp <- deparse(tmp, control = dctrl, width.cutoff = wco) + } + if ((nchar(i) + sum(nchar(tmp)) < 70) | (length(tmp) == 2 & tmp[2] == ")")) { + tmp <- paste0(tmp, collapse = "") + } + if (length(tmp) > 1) { + if (grepl("^c\\(", tmp[1])) { + tmp <- c("c(", sub("^c\\(", "", tmp)) + } else { + tmp <- c("list(", sub("^list\\(", "", tmp)) + } + if (tail(tmp, 1) != ")") { + tmp <- c(sub("\\)$", "", tmp), ")") + } + } + x[[i]] <- sub("^\\s+", "", tmp) %>% + paste0(collapse = "\n ") %>% + sub("[ ]+\\)", " \\)", .) + } + + if (wrap) { + x <- paste0(paste0(paste0("\n ", names(x)), " = ", x), collapse = ", ") + x <- paste0("list(", x, "\n)") + } else { + x <- paste0(paste0(names(x), " = ", x), collapse = ", ") + x <- paste0("list(", x, ")") + } + x + } + + if (inp_main[1] != "") { + cmd <- depr(inp_main, wrap = wrap) %>% + sub("list", fun_name, .) %>% + paste0(pre_cmd, .) %>% + paste0(., post_cmd) %>% + sub("dataset = \"([^\"]+)\"", "\\1", .) + } + + lout <- length(outputs) + if (lout > 0) { + for (i in seq_len(lout)) { + if (inp %in% names(inp_out[[i]])) { + inp_rep <- inp + inp <- inp_out[[i]][[inp]] + inp_out[[i]][inp_rep] <- NULL + } + if (!is.empty(outputs[i])) { + if (inp_out[i] != "" && length(inp_out[[i]]) > 0) { + if (sum(nchar(inp_out[[i]])) > 40L) { + cmd <- depr(inp_out[[i]], wrap = TRUE) %>% + sub("list\\(", paste0(outputs[i], "\\(\n ", inp, ", "), .) %>% + paste0(cmd, "\n", .) + } else { + cmd <- deparse(inp_out[[i]], control = dctrl, width.cutoff = 500L) %>% + sub("list\\(", paste0(outputs[i], "\\(", inp, ", "), .) %>% + paste0(cmd, "\n", .) + } + } else { + cmd <- paste0(cmd, "\n", outputs[i], "(", inp, ")") + } + } + } + } + + if (xcmd != "") cmd <- paste0(cmd, "\n", xcmd) + + ## make into chunks if needed + if (length(input$rmd_generate) == 0) { + type <- ifelse(state_init("r_generate", "Use Rmd") == "Use Rmd", "rmd", "r") + } else { + type <- ifelse(state_init("rmd_generate", "auto") == "Use R", "r", "rmd") + } + + if (type == "r") { + update_report_fun(cmd, type = "r") + } else { + if (figs) { + cmd <- paste0("\n```{r fig.width = ", round(7 * fig.width / 650, 2), ", fig.height = ", round(7 * fig.height / 650, 2), ", dpi = 96}\n", cmd, "\n```\n") + } else { + cmd <- paste0("\n```{r}\n", cmd, "\n```\n") + } + if (!is.empty(r_info[["latest_screenshot"]])) { + cmd <- paste0(r_info[["latest_screenshot"]], "\n", cmd) + } + update_report_fun(cmd, type = "rmd") + } +} + +update_report_fun <- function(cmd, type = "rmd", rfiles = FALSE) { + isolate({ + generate <- paste0(type, "_generate") + sinit <- state_init(generate, "auto") + editor <- paste0(type, "_edit") + sel <- ifelse(type == "rmd", "Rmd", "R") + if (sinit == "manual") { + os_type <- Sys.info()["sysname"] + if (os_type == "Windows") { + withProgress(message = "Putting command in clipboard", value = 1, { + cat(cmd, file = "clipboard") + }) + } else if (os_type == "Darwin") { + withProgress(message = "Putting command in clipboard", value = 1, { + out <- pipe("pbcopy") + cat(cmd, file = out) + close(out) + }) + } else if (os_type == "Linux") { + showModal( + modalDialog( + title = "Copy-and-paste the code shown below", + pre(cmd), + footer = modalButton("Cancel"), + size = "m", + easyClose = TRUE + ) + ) + } + } else if (sinit == "To Rmd") { + withProgress(message = "Putting code chunk in Rstudio", value = 1, { + rstudioapi::insertText(Inf, fix_smart(cmd)) + }) + } else if (sinit == "To R") { + withProgress(message = "Putting R-code in Rstudio", value = 1, { + gsub("(```\\{.*\\}\n)|(```\n)", "", fix_smart(paste0("\n", cmd, "\n"))) %>% + rstudioapi::insertText(Inf, .) + }) + } else { + if (is.empty(r_state[[editor]])) { + r_state[[editor]] <<- paste0("## Your report title\n\n", cmd) + } else { + r_state[[editor]] <<- paste0(fix_smart(r_state[[editor]]), "\n", cmd) + } + withProgress(message = paste0("Updating Report > ", sel), value = 1, { + shinyAce::updateAceEditor( + session, editor, + value = fix_smart(r_state[[editor]]) + ) + }) + } + + if (!rfiles) { + if (state_init(paste0(type, "_switch"), "switch") == "switch") { + updateTabsetPanel(session, "nav_radiant", selected = sel) + } + } + }) +} diff --git a/radiant.data/inst/app/tools/app/report_r.R b/radiant.data/inst/app/tools/app/report_r.R new file mode 100644 index 0000000000000000000000000000000000000000..0e70a338817ba621bbf3126c58f7050040ecd68a --- /dev/null +++ b/radiant.data/inst/app/tools/app/report_r.R @@ -0,0 +1,454 @@ +################################################################ +# Run R-code within Radiant using the shinyAce editor +################################################################ +r_switch <- c( + "切换选项卡" = "switch", + "不切换选项卡" = "no_switch" +) +r_generate <- c( + "自动粘贴(R)" = "auto", + "手动粘贴(R)" = "manual" +) +r_save_type <- c( + "Notebook", "HTML", "PDF", "Word", "R" +) + +r_set <- c("To R", "auto", "manual") +r_set_rstudio <- c("To Rmd", "To R") + +if (rstudioapi::isAvailable()) { + r_generate <- c( + "自动粘贴" = "auto", + "手动粘贴" = "manual", + "导出到Rstudio (R)" = "To R", + "使用报告 > Rmd" = "Use Rmd" + ) +} else if (!isTRUE(rmarkdown::pandoc_available())) { + r_save_type <- c("HTML", "R") +} + +## can still save report, code, and data without permission to run code +if (!isTRUE(getOption("radiant.report"))) { + r_save_type <- "R" +} + +if (Sys.getenv("R_ZIPCMD") != "") { + r_save_type <- c(r_save_type, "R + Data (zip)") +} + +r_view_options <- c( + "双重视图" = "dual", + "仅预览" = "pr_only", + "仅编译" = "ed_only" +) + +r_example <- "## get the active dataset and show the first few observations +.get_data() %>% + head() + +## access a dataset +diamonds %>% + select(price, clarity) %>% + head() + +## add a variable to the diamonds data +diamonds <- mutate(diamonds, log_price = log(price)) + +## show the first observations in the price and log_price columns +diamonds %>% + select(price, log_price) %>% + head() + +## create a histogram of prices +diamonds %>% + ggplot(aes(x = price)) + + geom_histogram() + +## and a histogram of log-prices using radiant.data::visualize +visualize(diamonds, xvar = \"log_price\", custom = TRUE) + +## open help in the R-studio viewer from Radiant +# help(package = \"radiant.data\") + +## If you are familiar with Shiny you can call reactives when the code +## is evaluated inside a Shiny app. For example, if you transformed +## some variables in Data > Transform you can call the transform_main +## reacive to see the latest result. Very useful for debugging +# transform_main() %>% head()" + +## allow running code through button or keyboard shortcut +report_r <- reactiveValues(report = 0, knit_button = 0, clear = 0) + +output$ui_r_generate <- renderUI({ + isolate({ + init <- ifelse(state_init("rmd_generate", "Use R") != "Use R", "Use Rmd", "auto") + }) + selectInput( + inputId = "r_generate", + label = NULL, + choices = r_generate, + selected = state_init("r_generate", init), + multiple = FALSE, + selectize = FALSE, + width = "160px" + ) +}) + +output$ui_r_view <- renderUI({ + req(input$r_generate) + selectInput( + "r_view", + label = NULL, choices = r_view_options, + selected = state_init("r_view", "dual"), + multiple = FALSE, selectize = FALSE, width = "120px" + ) +}) + +observeEvent(input$r_generate, { + if (state_init("r_generate", "Use Rmd") == "Use Rmd") { + if (state_init("rmd_generate", "auto") == "Use R") { + updateSelectInput(session, "rmd_generate", selected = "auto") + } + } else { + updateSelectInput(session, "rmd_generate", selected = "Use R") + + if (state_init("r_generate", "Use Rmd") == "To R") { + updateSelectInput(session, "r_switch", selected = "no_switch") + updateSelectInput(session, "r_view", selected = "pr_only") + ## popup to suggest user create an .Rmd file + no_r <- function() { + showModal( + modalDialog( + title = "Radiant to R (Rstudio)", + span( + "Radiant is set to use an R document in Rstudio + ('To Rstudio (R)'). However, the active document in + Rstudio does not seem to be of type .R. Please open an + existing .R file or create a new one in Rstudio. The + file must be saved to disk before it can be accessed. If + you want to use the editor in Radiant instead, change + 'To Rstudio (R)' to 'Auto paste' or 'Manual paste'." + ), + footer = modalButton("OK"), + size = "m", + easyClose = TRUE + ) + ) + } + ## get info from rstudio editor + cnt <- rstudio_context(type = "r") + if (is.empty(cnt$path) || cnt$ext != "r") { + rcode <- r_state$radiant_r_name + if (!is.empty(rcode)) { + if (file.exists(rcode)) { + ## useful if you are not using an Rstudio project + rstudioapi::navigateToFile(rcode) + } else { + pdir <- getOption("radiant.project_dir", default = radiant.data::find_home()) + path <- file.path(pdir, rcode) + if (file.exists(path)) { + rstudioapi::navigateToFile(path) + } else { + no_r() + } + } + } else { + no_r() + } + } + } else { + updateSelectInput(session, "r_switch", selected = "switch") + updateSelectInput(session, "r_view", selected = "dual") + } + } +}) + +output$ui_r_switch <- renderUI({ + req(input$r_generate) + selectInput( + inputId = "r_switch", label = NULL, + choices = r_switch, + selected = state_init("r_switch", "switch"), + multiple = FALSE, selectize = FALSE, + width = "140px" + ) +}) + +output$ui_r_save_type <- renderUI({ + selectInput( + inputId = "r_save_type", label = NULL, + choices = r_save_type, + selected = state_init("r_save", r_save_type[1]), + multiple = FALSE, selectize = FALSE, + width = "140px" + ) +}) + +output$ui_r_load <- renderUI({ + file_upload_button( + "r_load", + accept = c(".R", ".r", ".html"), + buttonLabel = i18n$t("Load report"), + title = i18n$t("Load report"), + class = "btn-default" + ) +}) + +if (getOption("radiant.shinyFiles", FALSE)) { + output$ui_r_read_files <- renderUI({ + shinyFiles::shinyFilesButton( + "r_read_files", i18n$t("Read files"), "Generate code to read selected file", + multiple = FALSE, icon = icon("book", verify_fa = FALSE), class = "btn-primary" + ) + }) + sf_r_read_files <- shinyFiles::shinyFileChoose( + input = input, + id = "r_read_files", + session = session, + roots = sf_volumes + ) +} + +output$report_r <- renderUI({ + tagList( + with( + tags, + table( + td(help_modal("Report > R", "r_help", inclMD(file.path(getOption("radiant.path.data"), "app/tools/help/report_r.md")), lic = "by-sa")), + td(HTML("  ")), + td(actionButton("r_knit", i18n$t("Knit report (R)"), icon = icon("play", verify_fa = FALSE), class = "btn-success"), class = "top_small"), + td(uiOutput("ui_r_generate"), class = "top_small"), + td(uiOutput("ui_r_view"), class = "top_small"), + td(uiOutput("ui_r_switch"), class = "top_small"), + td(uiOutput("ui_r_save_type"), class = "top_small"), + td(conditional_save_report("r_save"), class = "top_small"), + td(uiOutput("ui_r_load"), class = "top_small"), + td(conditional_read_files("r_read_files"), class = "top_small"), + td(actionButton("r_clear", i18n$t("Clear output"), icon = icon("trash", verify_fa = FALSE), class = "btn-danger"), class = "top_small") + ) + ), + shinyAce::aceEditor( + "r_edit", + selectionId = "selection", + mode = "r", + theme = getOption("radiant.ace_theme", default = "tomorrow"), + wordWrap = TRUE, + debounce = 0, + height = "auto", + value = state_init("r_edit", r_example) %>% fix_smart(), + placeholder = "Enter R-code for analysis here and press the Knit report button to run it.\nClick the ? icon on the top left of your screen for more information", + vimKeyBinding = getOption("radiant.ace_vim.keys", default = FALSE), + code_hotkeys = list("r", list(hotkey = list(win = "CTRL-ENTER|SHIFT-ENTER", mac = "CMD-ENTER|SHIFT-ENTER"))), + tabSize = getOption("radiant.ace_tabSize", 2), + useSoftTabs = getOption("radiant.ace_useSoftTabs", TRUE), + showInvisibles = getOption("radiant.ace_showInvisibles", FALSE), + autoComplete = getOption("radiant.ace_autoComplete", "enable"), + autoCompleters = c("static", "rlang"), + autoCompleteList = isolate(radiant_auto_complete()) + ), + htmlOutput("r_knitted"), + getdeps() + ) +}) + +radiant_r_annotater <- shinyAce::aceAnnotate("r_edit") +radiant_r_tooltip <- shinyAce::aceTooltip("r_edit") +radiant_r_ac <- shinyAce::aceAutocomplete("r_edit") + +## auto completion of available R functions, datasets, and variables +observe({ + ## don't need to run until report generated + req(report_r$report > 1) + shinyAce::updateAceEditor( + session, "r_edit", + autoCompleters = c("static", "rlang"), + autoCompleteList = radiant_auto_complete() + ) +}) + +observeEvent(input$r_knit, { + ## hack to allow processing current line + report_r$knit_button <- 1 +}) + +observeEvent(input$r_clear, { + ## hack to allow clearing output + ## see https://groups.google.com/d/msg/shiny-discuss/PiU6PzQ_iSc/NsJkSDDCmlwJ + report_r$clear <- 1 +}) + +observe({ + input$r_edit_hotkey + if (!is.null(input$r_knit)) { + isolate({ + report_r$report <- report_r$report + 1 + report_r$clear <- 0 + }) + } +}) + +output$r_view <- renderUI({ + req(input$r_view) + if (input$r_view == "ed_only") { + tags$head(tags$style( + HTML("#r_edit {right: 0; left: 0;} #r_knitted {left: 200%; right: -100%;}") + )) + } else if (input$r_view == "pr_only") { + tags$head(tags$style( + HTML("#r_edit {right: 200%; left: -100%;} #r_knitted {left: 0; right: 0;}") + )) + } else { + tags$head(tags$style( + HTML("#r_edit {right: 50%; left: 0;} #r_knitted {left: 50%; right: 0;}") + )) + } +}) + +output$r_knitted <- renderUI({ + ## rmd > 0 will re-run on refresh so keep != 1 + req(report_r$report != 1 && report_r$clear == 0) + isolate({ + if (!isTRUE(getOption("radiant.report"))) { + HTML("

    Report was not evaluated. If you have sudo access to the server set options(radiant.report = TRUE) in .Rprofile for the shiny user

    ") + } else { + report <- "" + withProgress(message = "Knitting report", value = 1, { + if (isTRUE(input$r_generate == "To R")) { + cnt <- rstudio_context(type = "r") + if (is.empty(cnt$path) || is.empty(cnt$ext, "rmd")) { + + ## popup to suggest user create an .Rmd file + showModal( + modalDialog( + title = "Report Rstudio (R)", + span( + "Report > R is set to use an R code file in Rstudio + ('To Rstudio (R)'). Please check that you have an .R file + open in Rstudio and that the file has been saved to disk. + If you want to use the editor in Radiant instead, change + 'To Rstudio (R)' to 'Auto paste' or 'Manual paste'." + ), + footer = modalButton("OK"), + size = "m", + easyClose = TRUE + ) + ) + report <- "" + } else { + if (cnt$path != cnt$rpath) { + r_state$radiant_r_name <<- cnt$rpath + } else { + r_state$radiant_r_name <<- cnt$path + } + report <- cnt$content + } + } else if (!is.empty(input$r_edit)) { + if (!is.empty(input$r_edit_selection, "")) { + report <- input$r_edit_selection + } else if (!is.empty(input$r_edit_hotkey$line, "") && report_r$knit_button == 0) { + report <- input$r_edit_hotkey$line + } else { + report <- input$r_edit + ## hack to allow processing current line + report_r$knit_button <- 0 + } + } + report <- paste0("\n```{r echo = TRUE}\n", report, "\n```\n") + knit_it(report, type = "r") + }) + } + }) +}) + +report_save_filename_r <- function() { + report_save_filename(type = "r", full.name = FALSE) +} + +download_handler( + id = "r_save", + fun = function(x, type = "r") report_save_content(x, type), + fn = function() report_save_filename_r() %>% sans_ext(), + type = function() { + report_save_filename_r() %>% + { + if (grepl("nb\\.html", .)) "nb.html" else tools::file_ext(.) + } + }, + btn = "button", + label = i18n$t("Save report"), + caption = i18n$t("Save report"), + class = "btn-primary" +) + +## loading r-code from disk +observeEvent(input$r_load, { + + ## loading report from disk + if (getOption("radiant.shinyFiles", FALSE)) { + if (is.integer(input$r_load)) { + return() + } + inFile <- shinyFiles::parseFilePaths(sf_volumes, input$r_load) + if (nrow(inFile) == 0) { + return() + } + path <- inFile$datapath + pp <- parse_path(path, pdir = getOption("radiant.project_dir", radiant.data::find_home()), chr = "", mess = FALSE) + } else { + inFile <- input$r_load + path <- inFile$datapath + pp <- list( + path = path, + filename = inFile$name, + fext = tools::file_ext(inFile$name) + ) + } + + if (!inherits(path, "try-error") && !is.empty(path)) { + if (pp$fext == "html") { + ## based on https://rmarkdown.rstudio.com/r_notebook_format.html + rmd <- try(rmarkdown::parse_html_notebook(pp$path), silent = TRUE) + if (!inherits(rmd, "try-error")) { + rmd <- paste0(rmd$rmd, collapse = "\n") + rmd <- knitr::purl(text = rmd) + r_state$radiant_r_name <<- sub("(\\.nb\\.html|\\.html)", ".R", pp$path) + } else { + rmd <- "#### The selected html file could not be parsed and does not contain R content" + } + } else { + rmd <- paste0(readLines(pp$path), collapse = "\n") + if (getOption("radiant.shinyFiles", FALSE)) { + r_state$radiant_r_name <<- pp$path + } else { + r_state$radiant_r_name <<- pp$filename + } + } + + ## update editor and remove yaml header if present + shinyAce::updateAceEditor(session, "r_edit", + value = sub("^---\n(.*?)\n---\n*", "", rmd) + ) + } +}) + +observeEvent(input$r_read_files, { + if (is.integer(input$r_read_files)) { + return() + } + path <- shinyFiles::parseFilePaths(sf_volumes, input$r_read_files) + if (inherits(path, "try-error") || is.empty(path$datapath)) { + return() + } + ldir <- getOption("radiant.launch_dir", default = radiant.data::find_home()) + pdir <- getOption("radiant.project_dir", default = ldir) + + cmd <- read_files(path$datapath, pdir = pdir, type = "r", clipboard = FALSE, radiant = TRUE) + + if (!is.empty(cmd)) { + update_report_fun(cmd, type = "r", rfiles = TRUE) + } +}) + +observeEvent(input$r_edit, { + r_state$r_edit <<- fix_smart(input$r_edit) +}) \ No newline at end of file diff --git a/radiant.data/inst/app/tools/app/report_rmd.R b/radiant.data/inst/app/tools/app/report_rmd.R new file mode 100644 index 0000000000000000000000000000000000000000..4aafdacd13257d56a1bb1337a8d35a32be40a79a --- /dev/null +++ b/radiant.data/inst/app/tools/app/report_rmd.R @@ -0,0 +1,541 @@ +################################################################ +# Create dynamic reports using Radiant and the shinyAce editor +################################################################ +rmd_switch <- c( + "切换选项卡" = "switch", + "不切换选项卡" = "no_switch" +) +rmd_generate <- c( + "自动粘贴" = "auto", + "手动粘贴" = "manual" +) +rmd_save_type <- c("Notebook", "HTML", "PDF", "Word", "Powerpoint", "Rmd") +rmd_set <- c("To Rmd", "auto", "manual") +rmd_set_rstudio <- c("To Rmd", "To R") + +if (rstudioapi::isAvailable()) { + rmd_generate <- c( + "自动粘贴" = "auto", + "手动粘贴" = "manual", + "导出到Rstudio (Rmd)" = "To Rmd", + "使用报告 > R" = "Use R" + ) +} else if (!isTRUE(rmarkdown::pandoc_available())) { + rmd_save_type <- c("HTML", "Rmd") +} + +## can still save report, code, and data without permission to run code +if (!isTRUE(getOption("radiant.report"))) { + rmd_save_type <- "Rmd" +} + +if (Sys.getenv("R_ZIPCMD") != "") { + rmd_save_type <- c(rmd_save_type, "Rmd + Data (zip)") +} + +rmd_view_options <- c( + "双重视图" = "dual", + "仅预览" = "pr_only", + "仅编译" = "ed_only" +) + +rmd_example <- "## Sample report + +This is an example of the type of report you can write in Radiant. + +* You can create +* bullet lists + +1. And numbered +2. lists + +Note: Markdown is used to format the report. Go to [commonmark.org](http://commonmark.org/help/) for an interactive tutorial. + +### Math + +You can even include math if you want: + +$$ +\\begin{aligned} + y_t &= \\alpha + \\beta x_t + \\epsilon_{yt}, \\\\ + z_t &= 3 \\times 9 + y_t + \\epsilon_{zt}. +\\end{aligned} +$$ + +To show the output, press the `Knit report (Rmd)` button. + +### Tables + +To generate a table that will display properly in both PDF and HTML you can use a layout similar to the example below: + +Year | Outcome | Prior probability +:---- | --------: | :----------------------: +2013 | Win | 0.30 +2014 | Loss | 0.25 +2015 | Win | 0.20 + +Note that the columns are left-aligned, right-aligned, and centered using a `:`. Alternatively you can create a `tibble` with the information to be put in the table and use the `kable` function from the `knitr` package to generate the desired output. See example below: + +```{r} +tbl <- tibble::tibble( + Year = c(2013L, 2014L, 2015L), + Outcome = c(\"Win\", \"Loss\", \"Win\"), + `Prior probability` = c(0.30, 0.25, 0.20) +) + +knitr::kable(tbl, align = \"ccc\") +``` + +To align the columns, use `l` for left, `r` for right, and `c` for center. In the example above each column is centered. For additional information about formatting tables see +https://www.rforge.net/doc/packages/knitr/kable.html + +It is also possible to generate interactive tables using the DT package. In Radiant you can use the `dtab` function to display a data.frame as a nicely formatted table: + +```{r} +dtab(tbl) %>% render() +``` + +### Documenting analysis results in Radiant + +The report feature in Radiant should be used in conjunction with the icons shown at the bottom of the side bar on (almost) all pages. When that icon is clicked the command used to create the output is copied into the editor in the _Report > Rmd_ tab. By default Radiant will paste the code generated for the analysis you just completed at the bottom of the report (i.e., `Auto paste`). However, you can turn off that feature by selecting `Manual paste` from the dropown. With manual paste on, the code is put in the clipboard when you click a report icon and you can paste it where you want in the _Report > Rmd_ editor window. + +By clicking the `Knit report (Rmd)` button or pressing CTRL-enter (CMD-enter on Mac), the output from the analysis will be (re)created. You can add text, bullets, headers, etc. around the code chunks to describe and explain the results using markdown. You can also select part of the report you want to render. + +Below is some code generated by Radiant to produce a scatterplot / heatmap of the price of diamonds versus carats. The colors in the plot reflect the clarity of the diamond. + +```{r fig.width = 7, fig.height = 5, dpi = 96} +visualize( + diamonds, + xvar = \"carat\", + yvar = \"price\", + type = \"scatter\", + nrobs = 1000, + color = \"clarity\", + labs = list(title = \"Diamond prices\", x = \"Carats\", y = \"Price ($)\"), + custom = FALSE +) +``` + +> **Put your own code here or delete this sample report and create your own** + +" + +## allow running code through button or keyboard shortcut +report_rmd <- reactiveValues(report = 0, knit_button = 0, clear = 0) + +output$ui_rmd_generate <- renderUI({ + isolate({ + init <- ifelse(state_init("r_generate", "Use Rmd") != "Use Rmd", "Use R", "auto") + }) + selectInput( + inputId = "rmd_generate", + label = NULL, + choices = rmd_generate, + selected = state_init("rmd_generate", init), + multiple = FALSE, + selectize = FALSE, + width = "140px" + ) +}) + +output$ui_rmd_view <- renderUI({ + req(input$rmd_generate) + selectInput( + "rmd_view", + label = NULL, choices = rmd_view_options, + selected = state_init("rmd_view", "dual"), + multiple = FALSE, selectize = FALSE, width = "120px" + ) +}) + +observeEvent(input$rmd_generate, { + if (isTRUE(input$rmd_generate == "To Rmd")) { + updateSelectInput(session, "rmd_switch", selected = "no_switch") + updateSelectInput(session, "rmd_view", selected = "pr_only") + report_rmd$clear <- 1 + + no_rmd <- function() { + ## popup to suggest user create an .Rmd file + showModal( + modalDialog( + title = "Radiant to Rmd (Rstudio)", + span( + "Radiant is set to use an rmarkdown document in Rstudio + ('To Rstudio (Rmd)'). However, the active document in + Rstudio does not seem to be of type .Rmd. Please open an + existing .Rmd file or create a new one in Rstudio. The + file must be saved to disk before it can be accessed. If + you want to use the editor in Radiant instead, change + 'To Rstudio (Rmd)' to 'Auto paste' or 'Manual paste'." + ), + footer = modalButton("OK"), + size = "m", + easyClose = TRUE + ) + ) + } + + ## get info from rstudio editor + cnt <- rstudio_context(type = "rmd") + if (is.empty(cnt$path) || cnt$ext != "rmd") { + rmd <- r_state$radiant_rmd_name + if (!is.empty(rmd)) { + if (file.exists(rmd)) { + ## useful if you are not using an Rstudio project + rstudioapi::navigateToFile(rmd) + } else { + pdir <- getOption("radiant.project_dir", default = radiant.data::find_home()) + path <- file.path(pdir, rmd) + if (file.exists(path)) { + rstudioapi::navigateToFile(path) + } else { + no_rmd() + } + } + } else { + no_rmd() + } + } + } else if (state_init("rmd_generate", "auto") == "Use R") { + if (state_init("r_generate", "auto") == "Use Rmd") { + updateSelectInput(session, "r_generate", selected = "auto") + } + } else { + updateSelectInput(session, "r_generate", selected = "Use Rmd") + updateSelectInput(session, "rmd_switch", selected = "switch") + updateSelectInput(session, "rmd_view", selected = "dual") + } +}) + +output$ui_rmd_switch <- renderUI({ + req(input$rmd_generate) + selectInput( + inputId = "rmd_switch", label = NULL, + choices = rmd_switch, + selected = state_init("rmd_switch", "switch"), + multiple = FALSE, selectize = FALSE, + width = "140px" + ) +}) + +output$ui_rmd_save_type <- renderUI({ + selectInput( + inputId = "rmd_save_type", label = NULL, + choices = rmd_save_type, + selected = state_init("rmd_save_type", rmd_save_type[1]), + multiple = FALSE, selectize = FALSE, + width = "140px" + ) +}) + +conditional_save_report <- function(id) { + if (isTRUE(getOption("radiant.report"))) { + download_button(id, i18n$t("Save report"), class = "btn-primary") + } else { + invisible() + } +} + +conditional_read_files <- function(id) { + if (getOption("radiant.shinyFiles", FALSE)) { + download_button(id, i18n$t("Read files"), class = "btn-primary") + } else { + invisible() + } +} + +output$ui_rmd_load <- renderUI({ + file_upload_button( + "rmd_load", + accept = c(".Rmd", ".rmd", ".md", ".html"), + buttonLabel = i18n$t("Load report"), + title = i18n$t("Load report"), + class = "btn-default" + ) +}) + +if (getOption("radiant.shinyFiles", FALSE)) { + output$ui_rmd_read_files <- renderUI({ + shinyFiles::shinyFilesButton( + "rmd_read_files", i18n$t("Read files"), "Generate code to read selected file", + multiple = FALSE, icon = icon("book", verify_fa = FALSE), class = "btn-primary" + ) + }) + sf_rmd_read_files <- shinyFiles::shinyFileChoose( + input = input, + id = "rmd_read_files", + session = session, + roots = sf_volumes + ) +} + +radiant_auto_complete <- reactive({ + req(input$dataset) + comps <- list(r_info[["datasetlist"]], as.vector(varnames())) + names(comps) <- c("{datasets}", paste0("{", input$dataset, "}")) + comps +}) + +output$report_rmd <- renderUI({ + tagList( + with( + tags, + table( + td( + help_modal( + "Report > Rmd", "rmd_help", + inclMD(file.path(getOption("radiant.path.data"), "app/tools/help/report_rmd.md")), + lic = "by-sa" + ) + ), + td(HTML("  ")), + td( + actionButton( + "rmd_knit", i18n$t("Knit report (Rmd)"), + icon = icon("play", verify_fa = FALSE), + class = "btn-success" + ), + class = "top_small" + ), + td(uiOutput("ui_rmd_generate"), class = "top_small"), + td(uiOutput("ui_rmd_view"), class = "top_small"), + td(uiOutput("ui_rmd_switch"), class = "top_small"), + td(uiOutput("ui_rmd_save_type"), class = "top_small"), + td(conditional_save_report("rmd_save"), class = "top_small"), + td(uiOutput("ui_rmd_load"), class = "top_small"), + td(conditional_read_files("rmd_read_files"), class = "top_small"), + td(actionButton("rmd_clear", i18n$t("Clear output"), icon = icon("trash", verify_fa = FALSE), class = "btn-danger"), class = "top_small") + ) + ), + shinyAce::aceEditor( + "rmd_edit", + selectionId = "selection", + mode = "markdown", + theme = getOption("radiant.ace_theme", default = "tomorrow"), + wordWrap = TRUE, + debounce = 0, + height = "auto", + value = state_init("rmd_edit", rmd_example) %>% fix_smart(), + placeholder = "Type text for your report using markdown to format it\n(http://commonmark.org/help/). Add R-code to include\nyour analysis results in the report as well. Click the ?\nicon on the top left of your screen for more information", + vimKeyBinding = getOption("radiant.ace_vim.keys", default = FALSE), + code_hotkeys = list("r", list(hotkey = list(win = "CTRL-ENTER|SHIFT-ENTER", mac = "CMD-ENTER|SHIFT-ENTER"))), + tabSize = getOption("radiant.ace_tabSize", 2), + useSoftTabs = getOption("radiant.ace_useSoftTabs", TRUE), + showInvisibles = getOption("radiant.ace_showInvisibles", FALSE), + autoComplete = getOption("radiant.ace_autoComplete", "enable"), + # autoCompleters = c("static", "text", "rlang"), + autoCompleters = c("static", "rlang"), + autoCompleteList = isolate(radiant_auto_complete()) + ), + htmlOutput("rmd_knitted"), + getdeps() + ) +}) + +# radiant_rmd_annotater <- shinyAce::aceAnnotate("rmd_edit") +radiant_rmd_tooltip <- shinyAce::aceTooltip("rmd_edit") +radiant_rmd_ac <- shinyAce::aceAutocomplete("rmd_edit") + +## auto completion of available R functions, datasets, and variables +observe({ + ## don't need to run until report generated + req(report_rmd$report > 1) + shinyAce::updateAceEditor( + session, "rmd_edit", + # autoCompleters = c("static", "text", "rlang"), + autoCompleters = c("static", "rlang"), + autoCompleteList = radiant_auto_complete() + ) +}) + +observeEvent(input$rmd_knit, { + ## hack to allow processing current line + report_rmd$knit_button <- 1 +}) + +observeEvent(input$rmd_clear, { + ## hack to allow clearing output + ## see https://groups.google.com/d/msg/shiny-discuss/PiU6PzQ_iSc/NsJkSDDCmlwJ + report_rmd$clear <- 1 +}) + +observe({ + input$rmd_edit_hotkey + if (!is.null(input$rmd_knit)) { + isolate({ + report_rmd$report <- report_rmd$report + 1 + report_rmd$clear <- 0 + }) + } +}) + +output$rmd_view <- renderUI({ + req(input$rmd_generate, input$rmd_view) + if (input$rmd_view == "ed_only") { + tags$head(tags$style( + HTML("#rmd_edit {right: 0; left: 0;} #rmd_knitted {left: 200%; right: -100%;}") + )) + } else if (input$rmd_view == "pr_only") { + tags$head(tags$style( + HTML("#rmd_edit {right: 200%; left: -100%;} #rmd_knitted {left: 0; right: 0;}") + )) + } else { + tags$head(tags$style( + HTML("#rmd_edit {right: 50%; left: 0;} #rmd_knitted {left: 50%; right: 0;}") + )) + } +}) + +rmd_knitted <- eventReactive(report_rmd$report != 1, { + if (!isTRUE(getOption("radiant.report"))) { + HTML("

    Report was not evaluated. If you have sudo access to the server set options(radiant.report = TRUE) in .Rprofile for the shiny user

    ") + } else { + report <- "" + report_type <- "full report" + if (isTRUE(input$rmd_generate == "To Rmd")) { + cnt <- rstudio_context(type = "rmd") + if (is.empty(cnt$path) || is.empty(cnt$ext, "r")) { + ## popup to suggest user create an .Rmd file + showModal( + modalDialog( + title = "Report Rstudio (Rmd)", + span( + "Report is set to use an rmarkdown document in Rstudio + ('To Rstudio (Rmd)'). Please check that you have an .Rmd file + open in Rstudio and that the file has been saved to disk. + If you want to use the editor in Radiant instead, change + 'To Rstudio (Rmd)' to 'Auto paste' or 'Manual paste'." + ), + footer = modalButton("OK"), + size = "m", + easyClose = TRUE + ) + ) + report_type <- "nothing" + report <- "" + } else { + if (cnt$path != cnt$rpath) { + r_state$radiant_rmd_name <<- cnt$rpath + } else { + r_state$radiant_rmd_name <<- cnt$path + } + + report_type <- "Rmarkdown file in Rstudio" + report <- cnt$content + } + } else if (!is.empty(input$rmd_edit)) { + if (!is.empty(input$rmd_edit_selection, "")) { + report <- input$rmd_edit_selection + report_type <- "report selection" + } else if (!is.empty(input$rmd_edit_hotkey$line, "") && report_rmd$knit_button == 0) { + report <- input$rmd_edit_hotkey$line + report_type <- "report selection" + } else { + report <- input$rmd_edit + ## hack to allow processing current line + report_rmd$knit_button <- 0 + } + } + + withProgress(message = glue("Knitting {report_type}"), value = 1, { + knit_it(report, type = "rmd") + }) + } +}) + +output$rmd_knitted <- renderUI({ + req(report_rmd$report != 1 && report_rmd$clear == 0) + rmd_knitted() +}) + +report_save_filename_rmd <- function() { + report_save_filename(type = "rmd", full.name = FALSE) +} + +download_handler( + id = "rmd_save", + label = i18n$t("Save report"), + fun = function(x, type = "rmd") report_save_content(x, type), + fn = function() report_save_filename_rmd() %>% sans_ext(), + type = function() { + report_save_filename_rmd() %>% + { + if (grepl("nb\\.html", .)) "nb.html" else tools::file_ext(.) + } + }, + caption = i18n$t("Save report"), + btn = "button", + class = "btn-primary" +) + +observeEvent(input$rmd_load, { + ## loading report from disk + if (getOption("radiant.shinyFiles", FALSE)) { + if (is.integer(input$rmd_load)) { + return() + } + inFile <- shinyFiles::parseFilePaths(sf_volumes, input$rmd_load) + if (nrow(inFile) == 0) { + return() + } + path <- inFile$datapath + pp <- parse_path(path, pdir = getOption("radiant.project_dir", radiant.data::find_home()), chr = "", mess = FALSE) + } else { + inFile <- input$rmd_load + path <- inFile$datapath + pp <- list( + path = path, + filename = inFile$name, + fext = tools::file_ext(inFile$name) + ) + } + + if (!inherits(path, "try-error") && !is.empty(path)) { + if (pp$fext == "html") { + ## based on https://rmarkdown.rstudio.com/r_notebook_format.html + rmd <- try(rmarkdown::parse_html_notebook(pp$path), silent = TRUE) + if (!inherits(rmd, "try-error")) { + rmd <- paste0(rmd$rmd, collapse = "\n") + r_state$radiant_rmd_name <<- sub("(\\.nb\\.html|\\.html)", ".Rmd", pp$path) + } else { + rmd <- "#### The selected html file could not be parsed and does not contain rmarkdown content" + } + } else { + rmd <- paste0(readLines(pp$path), collapse = "\n") + if (getOption("radiant.shinyFiles", FALSE)) { + r_state$radiant_rmd_name <<- pp$path + } else { + r_state$radiant_rmd_name <<- pp$filename + } + } + + rmd <- sub("^---\n(.*?)\n---\n*", "", rmd) + r_state$rmd_edit <- radiant.data::fix_smart(rmd) + + ## update editor and remove yaml header if present + shinyAce::updateAceEditor(session, "rmd_edit", + value = r_state$rmd_edit + ) + } +}) + +observeEvent(input$rmd_read_files, { + if (is.integer(input$rmd_read_files)) { + return() + } + path <- shinyFiles::parseFilePaths(sf_volumes, input$rmd_read_files) + if (inherits(path, "try-error") || is.empty(path$datapath)) { + return() + } + ldir <- getOption("radiant.launch_dir", default = radiant.data::find_home()) + pdir <- getOption("radiant.project_dir", default = ldir) + + cmd <- read_files(path$datapath, pdir = pdir, type = "rmd", clipboard = FALSE, radiant = TRUE) + if (!is.empty(cmd)) { + update_report_fun(cmd, type = "rmd", rfiles = TRUE) + } +}) + +observeEvent(input$rmd_edit, { + r_state$rmd_edit <<- fix_smart(input$rmd_edit) +}) diff --git a/radiant.data/inst/app/tools/app/state.R b/radiant.data/inst/app/tools/app/state.R new file mode 100644 index 0000000000000000000000000000000000000000..50f6376d8431a9a148741bfff5ccd3bea87d52e1 --- /dev/null +++ b/radiant.data/inst/app/tools/app/state.R @@ -0,0 +1,142 @@ +####################################### +# State menu +####################################### +output$state_view <- renderUI({ + sidebarLayout( + sidebarPanel( + wellPanel( + checkboxInput("show_input", "Show input", FALSE), + checkboxInput("show_data", "Show r_data", FALSE), + checkboxInput("show_info", "Show r_info", FALSE), + checkboxInput("show_state", "Show r_state", FALSE) + # checkboxInput("show_session", "Show session", FALSE) + ), + help_modal( + "View state", "state_help", + inclMD(file.path(getOption("radiant.path.data"), "app/tools/help/state.md")), + lic = "by-sa" + ) + ), + mainPanel( + conditionalPanel( + condition = "input.show_input == true", + verbatimTextOutput("show_input") + ), + conditionalPanel( + condition = "input.show_data == true", + verbatimTextOutput("show_data") + ), + conditionalPanel( + condition = "input.show_info == true", + verbatimTextOutput("show_info") + ), + conditionalPanel( + condition = "input.show_state == true", + verbatimTextOutput("show_state") + ), + conditionalPanel( + condition = "input.show_session == true", + verbatimTextOutput("show_session") + ) + ) + ) +}) + +state_name <- function(out = paste0("radiant-", Sys.Date(), ".state.rda"), full.name = FALSE) { + rsn <- r_state$radiant_state_name + ldir <- getOption("radiant.launch_dir", default = radiant.data::find_home()) + pdir <- getOption("radiant.project_dir", default = ldir) + ## legacy + if (is.empty(rsn)) rsn <- r_state$state_name + if (!is.empty(rsn)) { + fn <- rsn + } else { + if (!is.empty(pdir)) { + fn <- paste0(basename(pdir), ".state.rda") + r_state$radiant_state_name <<- fn + } else { + fn <- out + } + } + + ## legacy + # if (tools::file_ext(fn) != "rda") { + # fn <- paste0(fn, ".rda") + # } + # ## legacy + # if (!grepl("state", fn)) { + # fn <- sub("\\.rda$", ".state.rda", fn) + # } + + if (full.name) { + file.path(pdir, fn) + } else { + fn + } +} + +observeEvent(input$state_share, { + withProgress(message = "Preparing session sharing", value = 1, { + saveSession(session) + }) +}) + +output$state_download <- downloadHandler( + filename = function() { + fn <- state_name_dlh() %>% sans_ext() + type <- state_name_dlh() %>% + { + if (grepl("\\.state\\.rda", .)) "state.rda" else tools::file_ext(.) + } + paste0(fn, ".", type) + }, + content = function(path) { + saveState(path) + } +) + +output$show_session <- renderPrint({ + input$show_session ## only update when you toggle the checkbox + isolate({ + cat("Session list:\n") + s <- toList(session$clientData) + str(s[sort(names(s))]) + }) +}) + +output$show_input <- renderPrint({ + input$show_input ## only update when you toggle the checkbox + isolate({ + cat("input list:\n") + inp <- toList(input) + str(inp[sort(names(inp))]) + }) +}) + +output$show_data <- renderPrint({ + input$show_data ## only update when you toggle the checkbox + isolate({ + cat("r_data environment:\n") + ls.str(r_data) + }) +}) + +output$show_info <- renderPrint({ + input$show_info ## only update when you toggle the checkbox + isolate({ + cat("r_info list:\n") + toList(r_info) %>% + { + str(.[sort(names(.))]) + } + }) +}) + +output$show_state <- renderPrint({ + if (length(r_state) == 0) { + cat("r_state list: [empty]") + } else { + cat("r_state list:\n") + str(r_state[sort(names(r_state))]) + } +}) \ No newline at end of file diff --git a/radiant.data/inst/app/tools/app/stop.R b/radiant.data/inst/app/tools/app/stop.R new file mode 100644 index 0000000000000000000000000000000000000000..777671254d242c95a10ea9fafee88e85d56a7ba5 --- /dev/null +++ b/radiant.data/inst/app/tools/app/stop.R @@ -0,0 +1,49 @@ +####################################### +# Stop menu +####################################### +observeEvent(input$stop_radiant, { + if (isTRUE(getOption("radiant.local"))) stop_radiant() +}) + +stop_radiant <- function() { + ## quit R, unless you are running an interactive session + if (interactive()) { + ## flush input and r_data into Rgui or Rstudio + isolate({ + LiveInputs <- toList(input) + r_state[names(LiveInputs)] <- LiveInputs + r_state$nav_radiant <- r_info[["nav_radiant"]] + assign("r_state", r_state, envir = .GlobalEnv) + ## convert environment to a list and then back to an environment + ## again to remove active bindings https://github.com/rstudio/shiny/issues/1905 + ## using an environment so you can "attach" and access data easily + rem_non_active() ## keep only the active bindings (i.e., data, datalist, etc.) + + ## to env on stop causes reference problems + assign("r_data", env2list(r_data), envir = .GlobalEnv) + assign("r_info", toList(r_info), envir = .GlobalEnv) + ## removing r_sessions and functions defined in global.R + unlink("~/r_figures/", recursive = TRUE) + clean_up_list <- c( + "r_sessions", "help_menu", "make_url_patterns", "import_fs", + "init_data", "navbar_proj", "knit_print.data.frame", "withMathJax", + "Dropbox", "sf_volumes", "GoogleDrive", "bslib_current_version", + "has_bslib_theme", "load_html2canvas" + ) + suppressWarnings( + suppressMessages({ + res <- try(sapply(clean_up_list, function(x) if (exists(x, envir = .GlobalEnv)) rm(list = x, envir = .GlobalEnv)), silent = TRUE) + rm(res) + }) + ) + options(radiant.launch_dir = NULL) + options(radiant.project_dir = NULL) + options(radiant.autosave = NULL) + message("\nStopped Radiant. State information is available in the r_state and r_info lists and the r_data environment. Use attach(r_data) to access data loaded into Radiant.\n") + stopApp() + }) + } else { + stopApp() + q("no") + } +} diff --git a/radiant.data/inst/app/tools/app/tutorials.md b/radiant.data/inst/app/tools/app/tutorials.md new file mode 100644 index 0000000000000000000000000000000000000000..11281c86461e08e55abefc67b242502704747168 --- /dev/null +++ b/radiant.data/inst/app/tools/app/tutorials.md @@ -0,0 +1,87 @@ +# Radiant - Business analytics using R and Shiny + + +## Introduction to Radiant + + + +## Installing R, Rstudio, and Radiant on Windows + +For Windows, download and run the all-in-one installer for R, Rstudio, and Radiant. For a video tutorial see the `Install Radiant on Windows` video below: + + + +> Note: Some users have reported that the Malwarebytes software can inappropriately block R-packages from being installed or updated. If you use Malwarebytes and are experiencing problems you can try (temporarily) turning it off during the install process or when upgrading. + +> Credits: Thanks go to Brandon Salas at the Rady School of Management for creating the Windows installer + +## Installing R, Rstudio, and Radiant on macOS + +For Mac, first download and install R from https://cran.r-project.org/bin/macosx/. Download the .pkg file, double-click, and follow the prompts. After R has been installed, open R, copy-and-paste the command below into R, and press return. Accept all default settings during the install process: + +```r +source("https://raw.githubusercontent.com/radiant-rstats/minicran/gh-pages/install.R") +``` + +For a video tutorial see the `Installing R, Rstudio, and Radiant on macOS` video below: + + + +## Starting, stopping, and updating + + + +## Getting help + + + +## Getting data in and out + + + +## Fast and efficient analysis + + + +## Reproducible analysis + + + +## Using Radiant for Model Evaluation + +The state file used in the demo is available for download from [GitHub](https://radiant-rstats.github.io/docs/examples/demo-dvd-rnd.state.rda) + + + +## Radiant Tutorial Series + +For additional video tutorials see the **Radiant Tutorial Series** playlist linked below that covers: + +* Decision Analysis (_Model > Decision analysis_) +* Probability calculator (_Basics > Probability calculator_) +* Hypothesis testing: + - _Basics > Single mean_ + - _Basics > Single proportion_ + - _Basics > Compare proportions_ + - _Basics > Compare means_ + - _Basics > Cross-tabs_ +* Linear regression (_Model > Linear regression_) +* Simulation (_Model > Simulation_) + +https://www.youtube.com/playlist?list=PLNhtaetb48EdKRIY7MewCyvb_1x7dV3xw + + + +## License + + +Radiant is licensed under the AGPLv3. As a summary, the AGPLv3 license requires, attribution, including copyright and license information in copies of the software, stating changes if the code is modified, and disclosure of all source code. Details are in the COPYING file. + +The documentation, images, and videos for the `radiant.data` package are licensed under the creative commons attribution and share-alike license CC-BY-SA. All other documentation and videos on this site, as well as the help files for `radiant.design`, `radiant.basics`, `radiant.model`, and `radiant.multivariate`, are licensed under the creative commons attribution, non-commercial, share-alike license CC-NC-SA. + +If you are interested in using any of the radiant packages please email me at radiant@rady.ucsd.edu + +© Vincent Nijs (2024) Creative Commons License diff --git a/radiant.data/inst/app/tools/data/combine_ui.R b/radiant.data/inst/app/tools/data/combine_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..8786205f4660ebfce4273e793d74381931c36a43 --- /dev/null +++ b/radiant.data/inst/app/tools/data/combine_ui.R @@ -0,0 +1,213 @@ +####################################### +# Combine datasets +####################################### +## list of function arguments +cmb_args <- as.list(formals(combine_data)) + +## list of function inputs selected by user +cmb_inputs <- reactive({ + cmb_args$data_filter <- ifelse(input$show_filter, input$data_filter, "") + cmb_args$arr <- ifelse(input$show_filter, input$data_arrange, "") + cmb_args$rows <- ifelse(input$show_filter, input$data_rows, "") + cmb_args$x <- as.name(input$dataset) + cmb_args$y <- as.name(input$cmb_y) + + ## loop needed because reactive values don't allow single bracket indexing + for (i in r_drop(names(cmb_args), drop = c("x", "y", "data_filter", "arr", "rows"))) { + cmb_args[[i]] <- input[[paste0("cmb_", i)]] + } + + ## only need cmb_by when using a join method + if (!grepl("_join", cmb_args$type)) cmb_args$by <- "" + cmb_args +}) + +output$ui_cmb_y <- renderUI({ + datasetlist <- r_info[["datasetlist"]] + req(length(datasetlist) > 1) + cmb_datasets <- datasetlist[-which(input$dataset == datasetlist)] + selectInput( + inputId = "cmb_y", label = i18n$t("Combine with:"), + choices = cmb_datasets, selected = state_init("cmb_y"), multiple = FALSE + ) +}) + +output$ui_cmb_by <- renderUI({ + req(input$cmb_y) + x <- varnames() + y <- colnames(r_data[[input$cmb_y]]) + vars <- intersect(x, y) + if (length(vars) == 0) { + return() + } + vars <- x[x %in% vars] ## need variable labels from varnames() + selectInput( + "cmb_by", + i18n$t("Join by:"), + choices = vars, + selected = state_multiple("cmb_by", vars, vars), + multiple = TRUE, + size = min(5, length(vars)), + selectize = FALSE + ) +}) + +output$ui_cmb_add <- renderUI({ + req(input$cmb_y) + vars <- colnames(r_data[[input$cmb_y]]) + selectInput( + "cmb_add", + i18n$t("Variables to add:"), + choices = vars, + selected = state_multiple("cmb_add", vars, vars), + multiple = TRUE, + size = min(5, length(vars)), + selectize = FALSE + ) +}) + +cmb_type <- setNames( + c( + "inner_join", "left_join", "right_join", "full_join", + "semi_join", "anti_join", "bind_rows", "bind_cols", + "intersect", "union", "setdiff" + ), + i18n$t(c( + "Inner join", "Left join", "Right join", "Full join", + "Semi join", "Anti join", "Bind rows", "Bind columns", + "Intersect", "Union", "Set difference" + )) +) + +output$ui_cmb_store <- renderUI({ + ## updates when dataset changes + req(input$dataset) + actionButton("cmb_store", i18n$t("Combine"), icon = icon("plus", verify_fa = FALSE), class = "btn-success") +}) + +output$ui_Combine <- renderUI({ + tagList( + wellPanel( + uiOutput("ui_cmb_y"), + conditionalPanel( + condition = "output.ui_cmb_y == null", + HTML(i18n$t("")) + ), + uiOutput("ui_cmb_by"), + uiOutput("ui_cmb_add"), + selectInput( + "cmb_type", i18n$t("Combine type:"), + choices = cmb_type, + selected = state_single("cmb_type", cmb_type, "inner_join"), + multiple = FALSE + ), + tags$table( + tags$td(textInput("cmb_name", i18n$t("Combined dataset:"), paste0(input$dataset, "_cmb"))), + tags$td(uiOutput("ui_cmb_store"), class = "top") + ) + ), + help_and_report( + modal_title = i18n$t("Combine"), + fun_name = "combine", + help_file = inclMD(file.path(getOption("radiant.path.data"), "app/tools/help/combine.md")), + lic = "by-sa" + ) + ) +}) + +observeEvent(input$cmb_store, { + ## combining datasets + req(length(r_info[["datasetlist"]]) > 1) + result <- try(do.call(combine_data, cmb_inputs(), envir = r_data), silent = TRUE) + if (inherits(result, "try-error")) { + r_info[["cmb_error"]] <- attr(result, "condition")$message + } else { + r_info[["cmb_error"]] <- "" + dataset <- fix_names(input$cmb_name) + if (input$cmb_name != dataset) { + updateTextInput(session, inputId = "cmb_name", value = dataset) + } + r_data[[dataset]] <- result + register(dataset, descr = attr(result, "description")) + updateSelectInput(session = session, inputId = "dataset", selected = input$dataset) + updateSelectInput(session = session, inputId = "cmb_y", selected = input$cmd_y) + } +}) + +combine_report <- function() { + req(input$cmb_y) + inp <- clean_args(cmb_inputs(), cmb_args) + if (identical(inp$add, colnames(r_data[[input$cmb_y]]))) { + inp$add <- NULL + } + dataset <- fix_names(input$cmb_name) + if (input$cmb_name != dataset) { + updateTextInput(session, inputId = "cmb_name", value = dataset) + } + xcmd <- paste0("register(\"", dataset, "\")") + update_report( + inp_main = inp, + fun_name = "combine_data", + outputs = character(0), + pre_cmd = paste0(dataset, " <- "), + xcmd = xcmd, + figs = FALSE + ) +} + +output$cmb_data1 <- renderText({ + req(input$dataset) + filt <- if (input$show_filter) input$data_filter else "" + arr <- if (input$show_filter) input$data_arrange else "" + rows <- if (input$show_filter) input$data_rows else "" + show_data_snippet(title = paste(i18n$t("

    Dataset 1:"), input$dataset, "

    "), filt = filt, arr = arr, rows = rows) +}) + +output$cmb_data2 <- renderText({ + req(input$cmb_y) + show_data_snippet(input$cmb_y, title = paste(i18n$t("

    Dataset 2:"), input$cmb_y, "

    ")) +}) + +output$cmb_possible <- renderText({ + req(length(r_info[["datasetlist"]]) > 1) + if (is.empty(input$cmb_by) && !is.empty(input$cmb_type) && grepl("_join", input$cmb_type)) { + i18n$t("

    No matching variables selected

    ") + } +}) + +output$cmb_data <- renderText({ + req(length(r_info[["datasetlist"]]) > 1) + req(input$cmb_store) ## dependence is needed to update cmb_type when result doesn't change + if (is.empty(input$cmb_name)) { + dataset <- paste0("cmb_", isolate(input$dataset)) + } else { + dataset <- fix_names(input$cmb_name) + if (input$cmb_name != dataset) { + updateTextInput(session, inputId = "cmb_name", value = dataset) + } + } + + if (!is.empty(r_info[["cmb_error"]])) { + HTML(paste0(i18n$t("

    Combining data failed. The error message was:

    \""), r_info[["cmb_error"]], "\"

    ")) + } else if (!is.null(r_data[[dataset]])) { + show_data_snippet(dataset, nshow = 15, title = paste0( + i18n$t("

    Combined dataset: "), + dataset, " [", isolate(input$cmb_type), "]

    " + )) + } +}) + +observeEvent(input$combine_report, { + r_info[["latest_screenshot"]] <- NULL + combine_report() +}) + +observeEvent(input$combine_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_combine_screenshot") +}) + +observeEvent(input$modal_combine_screenshot, { + combine_report() + removeModal() +}) diff --git a/radiant.data/inst/app/tools/data/data_ui.R b/radiant.data/inst/app/tools/data/data_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..6fa7d8fcda2f7c065649b19613274a85f79a691a --- /dev/null +++ b/radiant.data/inst/app/tools/data/data_ui.R @@ -0,0 +1,119 @@ +####################################### +# Shiny interface for data tabs +####################################### + +## show error message from filter dialog +output$ui_filter_error <- renderUI({ + if (is.empty(r_info[["filter_error"]])) { + return() + } + helpText(r_info[["filter_error"]]) +}) + +## data ui and tabs +## state is not available in global environment +## neither are the state_... functions +output$ui_data <- renderUI({ + tagList( + sidebarLayout( + sidebarPanel( + wellPanel( + uiOutput("ui_datasets"), + conditionalPanel( + "input.tabs_data != 'Manage'", + checkboxInput("show_filter", i18n$t("Filter data"), value = state_init("show_filter", FALSE)), + conditionalPanel( + "input.show_filter == true", + returnTextAreaInput("data_filter", + label = i18n$t("Data filter:"), + value = state_init("data_filter"), + placeholder = i18n$t("Provide a filter (e.g., price > 5000) and press return") + ), + returnTextAreaInput("data_arrange", + label = i18n$t("Data arrange (sort):"), + value = state_init("data_arrange"), + placeholder = i18n$t("Arrange (e.g., color, desc(price)) and press return") + ), + returnTextAreaInput("data_rows", + label = i18n$t("Data slice (rows):"), + rows = 1, + value = state_init("data_rows"), + placeholder = i18n$t("e.g., 1:50 and press return") + ), + uiOutput("ui_filter_error") + ) + ) + ), + conditionalPanel("input.tabs_data == 'Manage'", uiOutput("ui_Manage")), + conditionalPanel("input.tabs_data == 'View'", uiOutput("ui_View")), + conditionalPanel("input.tabs_data == 'Visualize'", uiOutput("ui_Visualize")), + conditionalPanel("input.tabs_data == 'Pivot'", uiOutput("ui_Pivotr")), + conditionalPanel("input.tabs_data == 'Explore'", uiOutput("ui_Explore")), + conditionalPanel("input.tabs_data == 'Transform'", uiOutput("ui_Transform")), + conditionalPanel("input.tabs_data == 'Combine'", uiOutput("ui_Combine")) + ), + mainPanel( + tabsetPanel( + id = "tabs_data", + tabPanel( + i18n$t("Manage"), value = "Manage", + conditionalPanel("input.dman_preview == 'preview'", h2(i18n$t("Data preview")), htmlOutput("man_example")), + conditionalPanel("input.dman_preview == 'str'", h2(i18n$t("Data structure")), verbatimTextOutput("man_str")), + # conditionalPanel("input.dman_preview == 'summary'", h2("Data summary"), htmlOutput("man_summary")), + conditionalPanel("input.dman_preview == 'summary'", h2(i18n$t("Data summary")), verbatimTextOutput("man_summary")), + conditionalPanel( + condition = "input.man_show_log == true", + h2(i18n$t("Data load and save commands")), + uiOutput("ui_man_log") + ), + conditionalPanel("input.man_add_descr == false", uiOutput("man_descr_html")), + conditionalPanel("input.man_add_descr == true", uiOutput("man_descr_md")) + ), + tabPanel( + i18n$t("View"), value = "View", + download_link("dl_view_tab"), + DT::dataTableOutput("dataviewer") + ), + tabPanel( + i18n$t("Visualize"), value = "Visualize", + download_link("dlp_visualize"), + plotOutput("visualize", width = "100%", height = "100%") + ), + tabPanel( + i18n$t("Pivot"), value = "Pivot", + conditionalPanel( + "input.pvt_tab == true", + download_link("dl_pivot_tab"), + DT::dataTableOutput("pivotr") + ), + conditionalPanel("input.pvt_chi2 == true", htmlOutput("pivotr_chi2")), + conditionalPanel( + "input.pvt_plot == true", br(), br(), + download_link("dlp_pivot"), + plotOutput("plot_pivot", width = "100%", height = "100%") + ) + ), + tabPanel( + i18n$t("Explore"), value = "Explore", + download_link("dl_explore_tab"), + DT::dataTableOutput("explore") + ), + tabPanel( + i18n$t("Transform"), value = "Transform", + htmlOutput("transform_data"), + verbatimTextOutput("transform_summary"), + uiOutput("ui_tr_log") + ), + tabPanel( + i18n$t("Combine"), value = "Combine", + htmlOutput("cmb_data1"), + htmlOutput("cmb_data2"), + htmlOutput("cmb_possible"), + htmlOutput("cmb_data") + ) + ) + ) + ) + ) +}) + diff --git a/radiant.data/inst/app/tools/data/explore_ui.R b/radiant.data/inst/app/tools/data/explore_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..a155fb64a2caa69a327349819d6699201b3f2fb3 --- /dev/null +++ b/radiant.data/inst/app/tools/data/explore_ui.R @@ -0,0 +1,356 @@ +####################################### +## Explore datasets +####################################### + +default_funs <- c("n_obs", "mean", "sd", "min", "max") +expl_args <- as.list(formals(explore)) + +## list of function inputs selected by user +expl_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + expl_args$data_filter <- if (input$show_filter) input$data_filter else "" + expl_args$arr <- if (input$show_filter) input$data_arrange else "" + expl_args$rows <- if (input$show_filter) input$data_rows else "" + expl_args$dataset <- input$dataset + for (i in r_drop(names(expl_args))) { + expl_args[[i]] <- input[[paste0("expl_", i)]] + } + + expl_args +}) + +expl_sum_args <- as.list(if (exists("summary.explore")) { + formals(summary.explore) +} else { + formals(radiant.data:::summary.explore) +}) + +## list of function inputs selected by user +expl_sum_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(expl_sum_args)) { + expl_sum_args[[i]] <- input[[paste0("expl_", i)]] + } + expl_sum_args +}) + +## UI-elements for explore +output$ui_expl_vars <- renderUI({ + # isNum <- .get_class() %in% c("integer", "numeric", "ts", "factor", "logical") + # vars <- varnames()[isNum] + vars <- varnames() + req(available(vars)) + selectInput( + "expl_vars", + label = i18n$t("Numeric variable(s):"), choices = vars, + selected = state_multiple("expl_vars", vars, isolate(input$expl_vars)), multiple = TRUE, + size = min(8, length(vars)), selectize = FALSE + ) +}) + +output$ui_expl_byvar <- renderUI({ + withProgress(message = i18n$t("Acquiring variable information"), value = 1, { + vars <- groupable_vars() + }) + req(available(vars)) + + if (any(vars %in% input$expl_vars)) { + vars <- base::setdiff(vars, input$expl_vars) + names(vars) <- varnames() %>% + (function(x) x[match(vars, x)]) %>% + names() + } + + isolate({ + ## if nothing is selected expl_byvar is also null + if ("expl_byvar" %in% names(input) && is.null(input$expl_byvar)) { + r_state$expl_byvar <<- NULL + } else { + if (available(r_state$expl_byvar) && all(r_state$expl_byvar %in% vars)) { + vars <- unique(c(r_state$expl_byvar, vars)) + names(vars) <- varnames() %>% + (function(x) x[match(vars, x)]) %>% + names() + } + } + }) + + selectizeInput( + "expl_byvar", + label = i18n$t("Group by:"), choices = vars, + selected = state_multiple("expl_byvar", vars, isolate(input$expl_byvar)), + multiple = TRUE, + options = list( + placeholder = i18n$t("Select group-by variable"), + plugins = list("remove_button", "drag_drop") + ) + ) +}) + +output$ui_expl_fun <- renderUI({ + r_funs <- getOption("radiant.functions") + isolate({ + sel <- if (is.empty(input$expl_fun)) { + state_multiple("expl_fun", r_funs, default_funs) + } else { + input$expl_fun + } + }) + selectizeInput( + "expl_fun", + label = i18n$t("Apply function(s):"), + choices = r_funs, selected = sel, multiple = TRUE, + options = list( + placeholder = i18n$t("Select functions"), + plugins = list("remove_button", "drag_drop") + ) + ) +}) + +output$ui_expl_top <- renderUI({ + if (is.empty(input$expl_vars)) { + return() + } + top_var <- setNames( + c("fun", "var", "byvar"), + c(i18n$t("Function"), i18n$t("Variables"), i18n$t("Group by")) + ) + if (is.empty(input$expl_byvar)) top_var <- top_var[1:2] + selectizeInput( + "expl_top", + label = i18n$t("Column header:"), + choices = top_var, + selected = state_single("expl_top", top_var, isolate(input$expl_top)), + multiple = FALSE + ) +}) + +output$ui_expl_name <- renderUI({ + req(input$dataset) + textInput("expl_name", i18n$t("Store as:"), "", placeholder = i18n$t("Provide a table name")) +}) + +output$ui_expl_run <- renderUI({ + ## updates when dataset changes + req(input$dataset) + actionButton("expl_run", i18n$t("Create table"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") +}) + +## add a spinning refresh icon if the table needs to be (re)calculated +run_refresh(expl_args, "expl", init = "vars", label = i18n$t("Create table"), relabel = i18n$t("Update table")) + +output$ui_Explore <- renderUI({ + tagList( + wellPanel( + uiOutput("ui_expl_run") + ), + wellPanel( + # actionLink("expl_clear", "Clear settings", icon = icon("sync", verify_fa = FALSE), style="color:black"), + uiOutput("ui_expl_vars"), + uiOutput("ui_expl_byvar"), + uiOutput("ui_expl_fun"), + uiOutput("ui_expl_top"), + returnTextAreaInput("expl_tab_slice", + label = i18n$t("Table slice (rows):"), + rows = 1, + value = state_init("expl_tab_slice"), + placeholder = i18n$t("e.g., 1:5 and press return") + ), + numericInput("expl_dec", label = i18n$t("Decimals:"), value = state_init("expl_dec", 3), min = 0) + ), + wellPanel( + tags$table( + tags$td(uiOutput("ui_expl_name")), + tags$td(actionButton("expl_store", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ), + help_and_report( + modal_title = i18n$t("Explore"), fun_name = "explore", + help_file = inclMD(file.path(getOption("radiant.path.data"), "app/tools/help/explore.md")), + lic = "by-sa" + ) + ) +}) + +.explore <- eventReactive(input$expl_run, { + if (not_available(input$expl_vars) || is.null(input$expl_top)) { + return() + } else if (!is.empty(input$expl_byvar) && not_available(input$expl_byvar)) { + return() + } else if (available(input$expl_byvar) && any(input$expl_byvar %in% input$expl_vars)) { + return() + } + expli <- expl_inputs() + expli$envir <- r_data + sshhr(do.call(explore, expli)) +}) + +observeEvent(input$explore_search_columns, { + r_state$explore_search_columns <<- input$explore_search_columns +}) + +observeEvent(input$explore_state, { + r_state$explore_state <<- input$explore_state +}) + +expl_reset <- function(var, ncol) { + if (!identical(r_state[[var]], input[[var]])) { + r_state[[var]] <<- input[[var]] + r_state$explore_state <<- list() + r_state$explore_search_columns <<- rep("", ncol) + } +} + +output$explore <- DT::renderDataTable({ + input$expl_run + withProgress(message = i18n$t("Generating explore table"), value = 1, { + isolate({ + expl <- .explore() + req(!is.null(expl)) + expl$shiny <- TRUE + + ## resetting DT when changes occur + nc <- ncol(expl$tab) + expl_reset("expl_vars", nc) + expl_reset("expl_byvar", nc) + expl_reset("expl_fun", nc) + if (!is.null(r_state$expl_top) && + !is.null(input$expl_top) && + !identical(r_state$expl_top, input$expl_top)) { + r_state$expl_top <<- input$expl_top + r_state$explore_state <<- list() + r_state$explore_search_columns <<- rep("", nc) + } + + searchCols <- lapply(r_state$explore_search_columns, function(x) list(search = x)) + order <- r_state$explore_state$order + pageLength <- r_state$explore_state$length + }) + + caption <- if (is.empty(input$expl_tab_slice)) NULL else glue("Table slice {input$expl_tab_slice} will be applied on Download, Store, or Report") + dtab( + expl, + dec = input$expl_dec, searchCols = searchCols, order = order, + pageLength = pageLength, + caption = caption + ) + }) +}) + +dl_explore_tab <- function(path) { + dat <- try(.explore(), silent = TRUE) + if (inherits(dat, "try-error") || is.null(dat)) { + write.csv(tibble::tibble("Data" = "[Empty]"), path, row.names = FALSE) + } else { + rows <- input$explore_rows_all + dat$tab %>% + (function(x) if (is.null(rows)) x else x[rows, , drop = FALSE]) %>% + (function(x) if (is.empty(input$expl_tab_slice)) x else slice_data(x, input$expl_tab_slice)) %>% + write.csv(path, row.names = FALSE) + } +} + +download_handler( + id = "dl_explore_tab", + fun = dl_explore_tab, + fn = function() paste0(input$dataset, "_expl"), + type = "csv" +) + +# observeEvent(input$expl_clear, { +# r_state$explore_state <<- list() +# updateCheckboxInput(session = session, inputId = "show_filter", value = FALSE) +# }) + +observeEvent(input$expl_store, { + req(input$expl_name) + dat <- .explore() + if (is.null(dat)) { + return() + } + dataset <- fix_names(input$expl_name) + if (input$expl_name != dataset) { + updateTextInput(session, inputId = "expl_name", value = dataset) + } + rows <- input$explore_rows_all + dat$tab <- dat$tab %>% + (function(x) if (is.null(rows)) x else x[rows, , drop = FALSE]) %>% + (function(x) if (is.empty(input$expl_tab_slice)) x else slice_data(x, input$expl_tab_slice)) + r_data[[dataset]] <- dat$tab + register(dataset) + updateSelectInput(session, "dataset", selected = input$dataset) + + ## See https://shiny.posit.co/reference/shiny/latest/modalDialog.html + showModal( + modalDialog( + title = i18n$t("Data Stored"), + span( + i18n$t( + "Dataset '{dataset}' was successfully added to the datasets dropdown. Add code to Report > Rmd or Report > R to (re)create the results by clicking the report icon on the bottom left of your screen.", + dataset = dataset + ) + ), + footer = modalButton(i18n$t("OK")), + size = "m", + easyClose = TRUE + ) + ) +}) + +explore_report <- function() { + ## get the state of the dt table + ts <- dt_state("explore") + xcmd <- "# summary(result)\ndtab(result" + if (!is.empty(input$expl_dec, 3)) { + xcmd <- paste0(xcmd, ", dec = ", input$expl_dec) + } + if (!is.empty(r_state$explore_state$length, 10)) { + xcmd <- paste0(xcmd, ", pageLength = ", r_state$explore_state$length) + } + xcmd <- paste0(xcmd, ", caption = \"\") %>% render()") + if (!is.empty(input$expl_name)) { + dataset <- fix_names(input$expl_name) + if (input$expl_name != dataset) { + updateTextInput(session, inputId = "expl_name", value = dataset) + } + xcmd <- paste0(xcmd, "\n", dataset, " <- result$tab\nregister(\"", dataset, "\")") + } + + inp_main <- clean_args(expl_inputs(), expl_args) + if (ts$tabsort != "") inp_main <- c(inp_main, tabsort = ts$tabsort) + if (ts$tabfilt != "") inp_main <- c(inp_main, tabfilt = ts$tabfilt) + if (is.empty(inp_main$rows)) { + inp_main$rows <- NULL + } + if (is.empty(input$expl_tab_slice)) { + inp_main <- c(inp_main, nr = Inf) + } else { + inp_main$tabslice <- input$expl_tab_slice + } + + inp_out <- list(clean_args(expl_sum_inputs(), expl_sum_args[-1])) + + update_report( + inp_main = inp_main, + fun_name = "explore", + inp_out = inp_out, + outputs = c(), + figs = FALSE, + xcmd = xcmd + ) +} + +observeEvent(input$explore_report, { + r_info[["latest_screenshot"]] <- NULL + explore_report() +}) + +observeEvent(input$explore_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_explore_screenshot") +}) + +observeEvent(input$modal_explore_screenshot, { + explore_report() + removeModal() +}) diff --git a/radiant.data/inst/app/tools/data/manage.R b/radiant.data/inst/app/tools/data/manage.R new file mode 100644 index 0000000000000000000000000000000000000000..583b24ad4afffd07f19295ccf04817c41eaac3c4 --- /dev/null +++ b/radiant.data/inst/app/tools/data/manage.R @@ -0,0 +1,237 @@ +descr_out <- function(descr, ret_type = "html") { + ## if there is no data description + if (is.empty(descr)) { + return("") + } + + ## if there is a data description and we want html output + if (ret_type == "html") { + markdown::mark_html(text = descr, template = FALSE, meta = list(css = ""), output = FALSE) + } else { + descr + } +} + +## create an empty data.frame and return error message as description +upload_error_handler <- function(objname, ret) { + r_data[[objname]] <- data.frame(matrix(rep("", 12), nrow = 2), stringsAsFactors = FALSE) %>% + set_attr("description", ret) +} + +load_csv <- function(file, delim = ",", col_names = TRUE, dec = ".", + n_max = Inf, saf = TRUE, safx = 30) { + n_max <- if (is_not(n_max) || n_max < 0) Inf else n_max + dataset <- sshhr(try( + readr::read_delim( + file, + delim = delim, locale = readr::locale(decimal_mark = dec, grouping_mark = delim), + col_names = col_names, n_max = n_max, trim_ws = TRUE + ), + silent = TRUE + )) + if (inherits(dataset, "try-error")) { + i18n$t("#### There was an error loading the data. Please make sure the data are in csv format") + } else { + prb <- readr::problems(dataset) + if (nrow(prb) > 0) { + tab_big <- "class='table table-condensed table-hover' style='width:70%;'" + rprob <- knitr::kable( + prb[1:(min(nrow(prb):10)), , drop = FALSE], + align = "l", + format = "html", + table.attr = tab_big, + caption = i18n$t("Read issues (max 10 rows shown):") + ) + } else { + rprob <- "" + } + + if (saf) dataset <- to_fct(dataset, safx) + as.data.frame(dataset, stringsAsFactors = FALSE) %>% + { + set_colnames(., fix_names(colnames(.))) + } %>% + set_attr("description", rprob) + } +} + +load_user_data <- function(fname, uFile, ext, header = TRUE, + man_str_as_factor = TRUE, sep = ",", + dec = ".", n_max = Inf, xlsx_sheet = 1, xlsx_header = TRUE) { + filename <- basename(fname) + fext <- tools::file_ext(filename) %>% tolower() + + ## switch extension if needed + ext <- case_when( + fext == ext ~ ext, + fext == "rdata" ~ "rdata", + fext == "rds" && ext == "rda" ~ "rds", + fext == "rda" && ext == "rds" ~ "rda", + fext == "txt" && ext == "csv" ~ "txt", + fext == "tsv" && ext == "csv" ~ "tsv", + fext %in% c("xls", "xlsx") ~ "xlsx", + TRUE ~ ext + ) + + + ## objname is used as the name of the data.frame, make case insensitive + objname <- sub(glue("\\.{ext}$"), "", filename, ignore.case = TRUE) + + ## if ext isn't in the filename nothing was replaced and so ... + if (objname == filename && !fext %in% c("xls", "xlsx")) { + ret <- glue(i18n$t('#### The filename extension "{fext}" does not match the specified \\ + file-type "{ext}". Please specify the file type you are trying to upload')) + upload_error_handler(objname, ret) + ext <- "---" + } + + ldir <- getOption("radiant.launch_dir", default = radiant.data::find_home()) + pdir <- getOption("radiant.project_dir", default = ldir) + cmd <- NULL + + pp <- suppressMessages( + radiant.data::parse_path( + uFile, + pdir = pdir, + chr = "\"", + mess = FALSE + ) + ) + + ## can't have spaces, dashes, etc. in objectname + objname <- radiant.data::fix_names(objname) + + if (ext %in% c("rda", "rdata")) { + ## objname will hold the name of the object(s) inside the R datafile + robjname <- try(load(uFile), silent = TRUE) + if (inherits(robjname, "try-error")) { + upload_error_handler(objname, i18n$t("#### There was an error loading the data. Please make sure the data are in rda format.")) + } else if (length(robjname) > 1) { + if (sum(robjname %in% c("r_state", "r_data", "r_info")) > 1) { + upload_error_handler(objname, i18n$t("#### To restore state select 'radiant state file' from the 'Load data of type' drowdown before loading the file")) + ## need to remove the local copies of r_state, r_data, and r_info + suppressWarnings(rm(r_state, r_data, r_info)) + } else { + upload_error_handler(objname, i18n$t("#### More than one R object contained in the data.")) + } + } else { + r_data[[objname]] <- as.data.frame(get(robjname), stringsAsFactors = FALSE) + cmd <- glue("{objname} <- load({pp$rpath}) %>% get()") + } + } else if (ext == "rds") { + ## objname will hold the name of the object(s) inside the R datafile + robj <- try(readRDS(uFile), silent = TRUE) + if (inherits(robj, "try-error")) { + upload_error_handler(objname, i18n$t("#### There was an error loading the data. Please make sure the data are in rds format.")) + } else { + r_data[[objname]] <- as.data.frame(robj, stringsAsFactors = FALSE) + cmd <- glue("{objname} <- readr::read_rds({pp$rpath})") + } + } else if (ext == "parquet") { + if (!requireNamespace("arrow", quietly = TRUE)) { + stop(i18n$t("The 'arrow' package is not installed. Please install it and try again.")) + upload_error_handler(objname, i18n$t("#### The arrow package required to work with data in parquet format is not installed. Please use install.packages('arrow')")) + } else { + robj <- arrow::read_parquet(uFile) # %>% set_attr("description", feather::feather_metadata(uFile)$description) + if (inherits(robj, "try-error")) { + upload_error_handler(objname, i18n$t("#### There was an error loading the data. Please make sure the data are in parquet format.")) + } else { + r_data[[objname]] <- as.data.frame(robj, stringsAsFactors = FALSE) + cmd <- glue("{objname} <- arrow::read_parquet({pp$rpath})") + } + } + }else if (ext == "xlsx") { + if (!requireNamespace("readxl", quietly = TRUE)) { + ret <- i18n$t("#### 读取xlsx文件需要readxl包") + upload_error_handler(objname, ret) + } else { + # 用readxl读取xlsx + robj <- try(readxl::read_excel( + path = uFile, + sheet = xlsx_sheet, # 对应UI的“工作表索引” + col_names = xlsx_header# 对应UI的“第一行为表头” + ), silent = TRUE) + + if (inherits(robj, "try-error")) { + upload_error_handler(objname, i18n$t("#### 读取xlsx文件失败，请检查文件是否损坏或格式正确")) + } else { + # 转换为data.frame并处理因子 + r_data[[objname]] <- as.data.frame(robj, stringsAsFactors = FALSE) %>% + {if (man_str_as_factor) radiant.data::to_fct(.) else .} + # 生成R代码 + cmd <- glue(' + {objname} <- readxl::read_excel( + {pp$rpath}, + sheet = {xlsx_sheet}, + col_names = {xlsx_header} + ) %>% + as.data.frame(stringsAsFactors = FALSE) + {if (man_str_as_factor) paste0(objname, " <- radiant.data::to_fct(", objname, ")") else ""} + register("{objname}") + ') + } + } + }else if (ext %in% c("tsv", "csv", "txt")) { + r_data[[objname]] <- load_csv( + uFile, + delim = sep, col_names = header, n_max = n_max, + dec = dec, saf = man_str_as_factor + ) %>% + (function(x) if (is.character(x)) upload_error_handler(objname, i18n$t("#### There was an error loading the data")) else x) + n_max <- if (is_not(n_max) || n_max < 0) Inf else n_max + if (ext == "csv" && sep == "," && dec == "." && header) { + cmd <- glue("{objname} <- readr::read_csv({pp$rpath}, n_max = {n_max})") + } else { + cmd <- glue(' + {objname} <- readr::read_delim( + {pp$rpath}, + delim = "{sep}", col_names = {header}, n_max = {n_max}, + locale = readr::locale(decimal_mark = "{dec}", grouping_mark = "{sep}") + )') + } + ## make sure all columns names are "fixed" + cmd <- paste0(cmd, " %>%\n fix_names()") + if (man_str_as_factor) cmd <- paste0(cmd, " %>%\n to_fct()") + } else if (ext != "---") { + ret <- glue(i18n$t("#### The selected filetype is not currently supported ({fext})")) + upload_error_handler(objname, ret) + } + + if (exists(objname, envir = r_data) && !bindingIsActive(as.symbol(objname), env = r_data)) { + shiny::makeReactiveBinding(objname, env = r_data) + } + + r_info[[glue("{objname}_descr")]] <- attr(r_data[[objname]], "description") + if (!is.empty(cmd)) { + cn <- colnames(r_data[[objname]]) + fn <- radiant.data::fix_names(cn) + if (!identical(cn, fn)) { + colnames(r_data[[objname]]) <- fn + cmd <- paste0(cmd, " %>%\n fix_names()") + } + cmd <- glue('{cmd}\nregister("{objname}")') + } + r_info[[glue("{objname}_lcmd")]] <- cmd + r_info[["datasetlist"]] <- c(objname, r_info[["datasetlist"]]) %>% unique() +} + +load_description <- function(fname, uFile, objname) { + ldir <- getOption("radiant.launch_dir", default = radiant.data::find_home()) + pdir <- getOption("radiant.project_dir", default = ldir) + cmd <- NULL + + pp <- suppressMessages( + radiant.data::parse_path( + uFile, + pdir = pdir, + chr = "\"", + mess = FALSE + ) + ) + + descr <- readLines(pp$path, warn = FALSE) %>% paste0(collapse = "\n") + cmd <- glue("register(\"{objname}\", descr = paste0(readLines({pp$rpath}, warn = FALSE), collapse = \"\\n\"))") + attr(r_data[[objname]], "description") <- descr + r_info[[glue("{objname}_descr")]] <- descr + r_info[[glue("{objname}_lcmd")]] <- sub(glue('register("{objname}")'), cmd, r_info[[glue("{objname}_lcmd")]], fixed = TRUE) +} diff --git a/radiant.data/inst/app/tools/data/manage_ui.R b/radiant.data/inst/app/tools/data/manage_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..4bf94985e971a0a75c49ea1e74a5c83053221eb7 --- /dev/null +++ b/radiant.data/inst/app/tools/data/manage_ui.R @@ -0,0 +1,1064 @@ +####################################### +# Manage datasets in/out of Radiant +####################################### + +output$ui_state_load <- renderUI({ + if (getOption("radiant.shinyFiles", FALSE)) { + tagList( + HTML(i18n$t("
    ")), + shinyFiles::shinyFilesButton( + "state_load", i18n$t("Load"), i18n$t("Load radiant state file"), + multiple = FALSE, icon = icon("upload", verify_fa = FALSE) + ) + ) + } else { + fileInput("state_load", i18n$t("Load radiant state file:"), accept = ".rda") + } +}) + +make_uploadfile <- function(accept) { + if (getOption("radiant.shinyFiles", FALSE)) { + shinyFiles::shinyFilesButton("uploadfile", i18n$t("Load"), i18n$t("Load data"), multiple = TRUE, icon = icon("upload", verify_fa = FALSE)) + } else { + fileInput("uploadfile", NULL, multiple = TRUE, accept = accept) + } +} + +make_description_uploadfile <- function(accept) { + if (getOption("radiant.shinyFiles", FALSE)) { + shinyFiles::shinyFilesButton("upload_description", i18n$t("Description"), i18n$t("Load description"), multiple = FALSE, icon = icon("upload", verify_fa = FALSE)) + } else { + fileInput("upload_description", i18n$t("Description"), multiple = False, accept = accept) + } +} + +output$ui_fileUpload <- renderUI({ + req(input$dataType) + if (input$dataType == "csv") { + make_uploadfile( + accept = c( + "text/csv", "text/comma-separated-values", + "text/tab-separated-values", "text/plain", ".csv", ".tsv" + ) + ) + } else if (input$dataType %in% c("rda", "rds")) { + make_uploadfile(accept = c(".rda", ".rds", ".rdata")) + } else if (input$dataType == "parquet") { + tagList( + make_uploadfile(accept = ".parquet"), + make_description_uploadfile(accept = c(".md", ".txt")) + ) + } else if (input$dataType == "xlsx") { + tagList( + make_uploadfile(accept = c(".xlsx", ".xls")), + make_description_uploadfile(accept = c(".md", ".txt")) + ) + } else if (input$dataType == "url_rds") { + with(tags, table( + tr( + td(textInput("url_rds", NULL, "")), + td(actionButton("url_rds_load", i18n$t("Load"), icon = icon("upload", verify_fa = FALSE)), class = "top_small") + ) + )) + } else if (input$dataType == "url_csv") { + with(tags, table( + tr( + td(textInput("url_csv", NULL, "")), + td(actionButton("url_csv_load", i18n$t("Load"), icon = icon("upload", verify_fa = FALSE)), class = "top_small") + ) + )) + } +}) + + +output$ui_clipboard_load <- renderUI({ + if (Sys.info()["sysname"] != "Linux") { + actionButton("loadClipData", i18n$t("Paste"), icon = icon("paste", verify_fa = FALSE)) + } else { + tagList( + textAreaInput( + "load_cdata", i18n$t("Copy-and-paste data below:"), + rows = 5, resize = "vertical", value = "", + placeholder = i18n$t("Copy-and-paste data with a header row from a spreadsheet") + ), + br(), + actionButton("loadClipData", i18n$t("Paste"), icon = icon("paste", verify_fa = FALSE)) + ) + } +}) + +output$ui_clipboard_save <- renderUI({ + if (Sys.info()["sysname"] != "Linux") { + actionButton("man_save_clip", i18n$t("Copy data"), icon = icon("copy", verify_fa = FALSE)) + } else { + textAreaInput( + "man_save_clip_text_area", i18n$t("Copy-and-paste data shown below:"), + rows = 5, resize = "vertical", + value = capture.output( + write.table(r_data[[input$dataset]], file = "", row.names = FALSE, sep = "\t") + ) %>% paste(collapse = "\n") + ) + } +}) + +output$ui_from_global <- renderUI({ + req(input$dataType) + df_list <- sapply(mget(ls(envir = .GlobalEnv), envir = .GlobalEnv), is.data.frame) %>% + (function(x) names(x[x])) + + tagList( + selectInput( + "from_global", + label = i18n$t("Data.frames in Global Env:"), + df_list, selected = df_list, multiple = TRUE, selectize = FALSE, + size = min(5, length(df_list)) + ), + radioButtons("from_global_move", NULL, + choices = setNames(c("copy", "move"), c(i18n$t("copy"), i18n$t("move"))), + selected = "copy", + inline = TRUE + ), + br(), + actionButton("from_global_load", i18n$t("Load"), icon = icon("upload", verify_fa = FALSE)) + ) +}) + +output$ui_to_global <- renderUI({ + tagList( + radioButtons("to_global_move", NULL, + choices = setNames(c("copy", "move"), c(i18n$t("copy"), i18n$t("move"))), + selected = "copy", + inline = TRUE + ), + br(), + actionButton("to_global_save", i18n$t("Save"), icon = icon("download", verify_fa = FALSE)) + ) +}) + +observeEvent(input$from_global_load, { + dfs <- input$from_global + req(dfs) + r_info[["datasetlist"]] <- c(dfs, r_info[["datasetlist"]]) %>% unique() + for (df in dfs) { + r_data[[df]] <- get(df, envir = .GlobalEnv) + if (!bindingIsActive(as.symbol(df), env = r_data)) { + shiny::makeReactiveBinding(df, env = r_data) + } + r_info[[paste0(df, "_lcmd")]] <- glue('{df} <- get("{df}", envir = .GlobalEnv)\nregister("{df}")') + if (input$from_global_move == "move") { + rm(list = df, envir = .GlobalEnv) + r_info[[paste0(df, "_lcmd")]] <- paste0("# ", r_info[[paste0(df, "_lcmd")]]) + } + r_info[[paste0(df, "_descr")]] <- attr(r_data[[df]], "description") %>% + (function(x) if (is.null(x)) i18n$t("No description provided. Please use Radiant to add an overview of the data in markdown format.\nCheck the 'Add/edit data description' box on the top-left of your screen") else x) %>% + fix_smart() + } + updateSelectInput( + session, "dataset", + label = i18n$t("Datasets:"), + choices = r_info[["datasetlist"]], + selected = r_info[["datasetlist"]][1] + ) +}) + +observeEvent(input$to_global_save, { + df <- input$dataset + req(df) + assign(df, r_data[[df]], envir = .GlobalEnv) + if (input$to_global_move == "move" && length(r_info[["datasetlist"]]) > 1) { + r_info[["datasetlist"]] %<>% base::setdiff(df) + r_info[[paste0(df, "_descr")]] <- NULL + r_info[[paste0(df, "_lcmd")]] <- NULL + r_info[[paste0(df, "_scmd")]] <- NULL + } else { + ## only useful if dataset is still available in radiant + r_info[[paste0(df, "_scmd")]] <- glue("assign({df}, envir = .GlobalEnv)") + } + + updateSelectInput( + session, "dataset", + label = i18n$t("Datasets:"), + choices = r_info[["datasetlist"]], + selected = r_info[["datasetlist"]][1] + ) +}) + +output$ui_Manage <- renderUI({ + data_types_in <- setNames( + c("rds", "parquet", "xlsx","csv", "clipboard", "examples", "url_rds", "url_csv", "from_global", "state"), + c(i18n$t("rds | rda | rdata"), i18n$t("parquet"), i18n$t("xlsx"), i18n$t("csv"), i18n$t("clipboard"), + i18n$t("examples"), i18n$t("rds (url)"), i18n$t("csv (url)"), i18n$t("from global workspace"), + i18n$t("radiant state file")) + ) + data_types_out <- setNames( + c("rds", "rda", "parquet", "csv", "clipboard", "to_global", "state"), + c(i18n$t("rds"), i18n$t("rda"), i18n$t("parquet"), i18n$t("csv"), i18n$t("clipboard"), + i18n$t("to global workspace"), i18n$t("radiant state file")) + ) + if (!isTRUE(getOption("radiant.local"))) { + data_types_in <- data_types_in[-which(data_types_in == "from_global")] + data_types_out <- data_types_out[-which(data_types_out == "to_global")] + } + if (!requireNamespace("arrow", quietly = TRUE)) { + data_types_in <- data_types_in[-which(data_types_in == "parquet")] + data_types_out <- data_types_out[-which(data_types_out == "parquet")] + } + + tagList( + wellPanel( + selectInput("dataType", label = i18n$t("Load data of type:"), data_types_in, selected = "rds"), + conditionalPanel( + condition = "input.dataType != 'clipboard' && input.dataType != 'examples'", + conditionalPanel( + "input.dataType == 'csv' || input.dataType == 'url_csv'", + with(tags, table( + td(checkboxInput("man_header", i18n$t("Header"), TRUE)), + td(HTML("  ")), + td(checkboxInput("man_str_as_factor", i18n$t("Str. as Factor"), TRUE)) + )), + with(tags, table( + td(selectInput("man_sep", i18n$t("Separator:"), c(Comma = ",", Semicolon = ";", Tab = "\t"), ",", width = "100%")), + td(selectInput("man_dec", i18n$t("Decimal:"), c(Period = ".", Comma = ","), ".", width = "100%")), + width = "100%" + )), + numericInput( + "man_n_max", + label = i18n$t("Maximum rows to read:"), + value = Inf, max = Inf, step = 1000 + ) + ), + conditionalPanel( + "input.dataType == 'xlsx'", + numericInput( + "xlsx_sheet", + label = i18n$t("Sheet index (1-based):"), + value = 1, min = 1, step = 1 + ), + checkboxInput( + "xlsx_header", + label = i18n$t("First row as header"), + value = TRUE + ) + ), + uiOutput("ui_fileUpload") + ), + + conditionalPanel( + condition = "input.dataType == 'clipboard'", + uiOutput("ui_clipboard_load") + ), + conditionalPanel( + condition = "input.dataType == 'from_global'", + uiOutput("ui_from_global") + ), + conditionalPanel( + condition = "input.dataType == 'examples'", + actionButton("loadExampleData", i18n$t("Load"), icon = icon("upload", verify_fa = FALSE)) + ), + conditionalPanel( + condition = "input.dataType == 'state'", + uiOutput("ui_state_load"), + uiOutput("ui_state_upload"), + uiOutput("refreshOnLoad") + ) + ), + wellPanel( + selectInput("saveAs", label = i18n$t("Save data to type:"), data_types_out, selected = "rds"), + conditionalPanel( + condition = "input.saveAs == 'clipboard'", + uiOutput("ui_clipboard_save") + ), + conditionalPanel( + condition = "input.saveAs == 'state'", + HTML(i18n$t("
    ")), + uiOutput("ui_state_save") + ), + conditionalPanel( + condition = "input.saveAs == 'to_global'", + uiOutput("ui_to_global") + ), + conditionalPanel( + condition = "input.saveAs != 'clipboard' && + input.saveAs != 'state' && + input.saveAs != 'to_global'", + download_button("man_save_data", i18n$t("Save"), ic = "download") + ) + ), + wellPanel( + checkboxInput("man_show_log", i18n$t("Show R-code"), FALSE) + ), + wellPanel( + checkboxInput("man_show_remove", i18n$t("Remove data from memory"), FALSE), + conditionalPanel( + condition = "input.man_show_remove == true", + uiOutput("uiRemoveDataset"), + actionButton("removeDataButton", i18n$t("Remove data"), icon = icon("trash", verify_fa = FALSE), class = "btn-danger") + ) + ), + help_and_report( + modal_title = i18n$t("Manage"), + fun_name = "manage", + help_file = inclMD(file.path(getOption("radiant.path.data"), "app/tools/help/manage.md")), + lic = "by-sa" + ) + ) +}) + +## updating the dataset description +observeEvent(input$updateDescr, { + descr <- fix_smart(input$man_data_descr) + r_info[[paste0(input$dataset, "_descr")]] <- descr + attr(r_data[[input$dataset]], "description") <- descr + updateCheckboxInput( + session = session, "man_add_descr", + i18n$t("Add/edit data description"), FALSE + ) +}) + +output$man_descr_html <- renderUI({ + r_info[[paste0(input$dataset, "_descr")]] %>% + descr_out("html") %>% + HTML() +}) + +output$man_descr_md <- renderUI({ + tagList( + HTML(i18n$t("
    ")), + shinyAce::aceEditor( + "man_data_descr", + mode = "markdown", + theme = getOption("radiant.ace_theme", default = "tomorrow"), + wordWrap = TRUE, + debounce = 0, + value = descr_out(r_info[[paste0(input$dataset, "_descr")]], "md"), + placeholder = i18n$t("Type text to describe the data using markdown to format it.\nSee http://commonmark.org/help/ for more information"), + vimKeyBinding = getOption("radiant.ace_vim.keys", default = FALSE), + tabSize = getOption("radiant.ace_tabSize", 2), + useSoftTabs = getOption("radiant.ace_useSoftTabs", TRUE), + showInvisibles = getOption("radiant.ace_showInvisibles", FALSE), + autoScrollEditorIntoView = TRUE, + minLines = 15, + maxLines = 30 + ) + ) +}) + +## removing datasets +output$uiRemoveDataset <- renderUI({ + selectInput( + inputId = "removeDataset", + label = NULL, + choices = r_info[["datasetlist"]], + selected = NULL, + multiple = TRUE, + size = length(r_info[["datasetlist"]]), + selectize = FALSE + ) +}) + +observeEvent(input$removeDataButton, { + ## only remove datasets if 1 or more were selected - without this line + ## all files would be removed when the removeDataButton is pressed + if (is.null(input$removeDataset)) { + return() + } + datasets <- r_info[["datasetlist"]] + if (length(datasets) > 1) { ## have to leave at least one dataset + removeDataset <- input$removeDataset + if (length(datasets) == length(removeDataset)) { + removeDataset <- removeDataset[-1] + } + + ## Must use single string to index into reactivevalues so loop is necessary + for (rem in removeDataset) { + r_info[[paste0(rem, "_descr")]] <- NULL + r_info[[paste0(rem, "_lcmd")]] <- NULL + r_info[[paste0(rem, "_scmd")]] <- NULL + } + suppressWarnings(rm(list = removeDataset, envir = r_data)) + r_info[["datasetlist"]] <- datasets[-which(datasets %in% removeDataset)] + } +}) + +## 'saving' data to clipboard +observeEvent(input$man_save_clip, { + radiant.data::save_clip(r_data[[input$dataset]]) + r_info[[paste0(input$dataset, "_scmd")]] <- glue("save_clip({input$dataset})") +}) + +man_save_data <- function(file) { + ext <- input$saveAs + robj <- input$dataset + ldir <- getOption("radiant.launch_dir", default = radiant.data::find_home()) + pdir <- getOption("radiant.project_dir", default = ldir) + pp <- suppressMessages( + radiant.data::parse_path( + file, + pdir = pdir, + chr = "\"", + mess = FALSE + ) + ) + + withProgress(message = "Saving ...", value = 1, { + if (ext == "csv") { + readr::write_csv(r_data[[robj]], file = file) + r_info[[paste0(robj, "_scmd")]] <- glue("readr::write_csv({robj}, file = {pp$rpath})") + } else { + if (!is.empty(input$man_data_descr)) { + attr(r_data[[robj]], "description") <- fix_smart(r_info[[paste0(robj, "_descr")]]) + } + + if (ext == "rds") { + readr::write_rds(r_data[[robj]], file = file) + r_info[[paste0(robj, "_scmd")]] <- glue("readr::write_rds({robj}, file = {pp$rpath})") + } else if (ext == "parquet") { + radiant.data::write_parquet(r_data[[robj]], file = file) + r_info[[paste0(robj, "_scmd")]] <- glue("radiant.data::write_parquet({robj}, file = {pp$rpath})") + } else { + save(list = robj, file = file, envir = r_data) + r_info[[paste0(robj, "_scmd")]] <- glue("save({robj}, file = {pp$rpath})") + } + } + }) +} + +if (getOption("radiant.shinyFiles", FALSE)) { + sf_filetypes <- function() { + if (length(input$dataType) == 0) { + "" + } else if (input$dataType == "csv") { + c("csv", "tsv") + } else if (input$dataType %in% c("rda", "rds")) { + c("rda", "rds", "rdata") + } else if (input$dataType == "parquet") { + "parquet" + } else if (input$dataType == "xlsx") { + c("xlsx", "xls") + }else { + "" + } + } + + sf_uploadfile <- shinyFiles::shinyFileChoose( + input = input, + id = "uploadfile", + session = session, + roots = sf_volumes, + filetype = sf_filetypes + ) + + sf_descr_uploadfile <- shinyFiles::shinyFileChoose( + input = input, + id = "upload_description", + session = session, + roots = sf_volumes, + filetype = c("md", "txt") + ) + + sf_state_load <- shinyFiles::shinyFileChoose( + input = input, + id = "state_load", + session = session, + roots = sf_volumes, + filetype = c("rda", "state.rda") + ) +} else { + output$ui_state_save <- renderUI({ + download_button("state_save", i18n$t("Save"), ic = "download") + }) +} + +state_name_dlh <- function() state_name(full.name = FALSE) + +download_handler( + id = "state_save", + label = i18n$t("Save"), + fun = saveState, + fn = function() state_name_dlh() %>% sans_ext(), + type = function() { + state_name_dlh() %>% + { + if (grepl("\\.state\\.rda", .)) "state.rda" else tools::file_ext(.) + } + }, + btn = "button", + caption = i18n$t("Save radiant state file") +) + +## need to set suspendWhenHidden to FALSE so that the href for the +## download handler is set and keyboard shortcuts will work +## see https://shiny.posit.co/reference/shiny/0.11/outputOptions.html +## see https://stackoverflow.com/questions/48117501/click-link-in-navbar-menu +## https://stackoverflow.com/questions/3871358/get-all-the-href-attributes-of-a-web-site +outputOptions(output, "ui_state_save", suspendWhenHidden = FALSE) + +download_handler( + id = "man_save_data", + fun = man_save_data, + fn = function() input$dataset, + type = function() input$saveAs, + caption = i18n$t("Save data"), + btn = "button", + label = i18n$t("Save") +) + +observeEvent(input$uploadfile, { + if (getOption("radiant.shinyFiles", FALSE)) { + if (is.integer(input$uploadfile)) return() + inFile <- shinyFiles::parseFilePaths(sf_volumes, input$uploadfile) + if (nrow(inFile) == 0) return() + } else { + inFile <- input$uploadfile + } + + withProgress(message = "Loading ...", value = 1, { + for (i in 1:nrow(inFile)) { + # 区分文件类型，传递对应参数 + if (input$dataType == "xlsx") { + # 调用load_user_data，传递xlsx专属参数 + load_user_data( + fname = as.character(inFile[i, "name"]), + uFile = as.character(inFile[i, "datapath"]), + ext = "xlsx", # 明确指定ext为xlsx + xlsx_sheet = input$xlsx_sheet, # 从UI获取工作表索引 + xlsx_header = input$xlsx_header, # 从UI获取表头设置 + man_str_as_factor = TRUE # xlsx也支持“字符串转因子” + ) + } else if (input$dataType %in% c("csv", "url_csv")) { + # 原有CSV参数传递 + load_user_data( + fname = as.character(inFile[i, "name"]), + uFile = as.character(inFile[i, "datapath"]), + ext = "csv", + header = input$man_header, + man_str_as_factor = input$man_str_as_factor, + sep = input$man_sep, + dec = input$man_dec, + n_max = input$man_n_max + ) + } else { + load_user_data( + fname = as.character(inFile[i, "name"]), + uFile = as.character(inFile[i, "datapath"]), + ext = input$dataType + ) + } + } + }) + + updateSelectInput( + session, "dataset", + label = i18n$t("Datasets:"), + choices = r_info[["datasetlist"]], + selected = r_info[["datasetlist"]][1] + ) +}) + +observeEvent(input$upload_description, { + if (getOption("radiant.shinyFiles", FALSE)) { + if (is.integer(input$uploadfile)) { + return() + } + inFile <- shinyFiles::parseFilePaths(sf_volumes, input$upload_description) + if (nrow(inFile) == 0) { + return() + } + } else { + inFile <- input$upload_description + } + + ## iterating through the files to upload + withProgress(message = i18n$t("Loading ..."), value = 1, { + load_description( + as.character(inFile["name"]), + as.character(inFile["datapath"]), + input$dataset + ) + }) +}) + +observeEvent(input$url_rds_load, { + ## loading rds file from url, example https://radiant-rstats.github.io/docs/examples/houseprices.rds + # input <- list(url_rds = "https://raw.githubusercontent.com/radiant-rstats/docs/gh-pages/examples/sales.rds") + # url_rds <- "https://www.dropbox.com/s/jetbhuconwn6mdb/price_sales.rds?raw=1" + # url_rds <- "https://radiant-rstats.github.io/docs/examples/houseprices.rds" + if (is.empty(input$url_rds)) { + return() + } + url_rds <- gsub("^\\s+|\\s+$", "", input$url_rds) + + objname <- basename(url_rds) %>% + sub("\\.rds", "", .) %>% + sub("\\?.*$", "", .) + + if (!objname == radiant.data::fix_names(objname)) { + objname <- "rds_url" + } + + robj <- try(readr::read_rds(url(url_rds)), silent = TRUE) + cmd <- "" + if (inherits(robj, "try-error")) { + upload_error_handler(objname, i18n$t("#### There was an error loading the r-data file from the provided url.")) + } else { + r_data[[objname]] <- as.data.frame(robj, stringsAsFactors = FALSE) + cmd <- glue('{objname} <- readr::read_rds(url("{url_rds}"))\nregister("{objname}")') + } + + if (exists(objname, envir = r_data) && !bindingIsActive(as.symbol(objname), env = r_data)) { + shiny::makeReactiveBinding(objname, env = r_data) + } + r_info[["datasetlist"]] <- c(objname, r_info[["datasetlist"]]) %>% unique() + r_info[[paste0(objname, "_descr")]] <- fix_smart(attr(r_data[[objname]], "description")) + r_info[[paste0(objname, "_lcmd")]] <- cmd + + updateSelectInput( + session, "dataset", + label = i18n$t("Datasets:"), + choices = r_info[["datasetlist"]], + selected = r_info[["datasetlist"]][1] + ) +}) + +observeEvent(input$url_csv_load, { + ## loading csv file from url, example https://radiant-rstats.github.io/docs/examples/houseprices.csv + if (is.empty(input$url_csv)) { + return() + } + url_csv <- gsub("^\\s+|\\s+$", "", input$url_csv) + + objname <- basename(url_csv) %>% + sub("\\.csv", "", .) %>% + sub("\\?.*$", "", .) + if (!objname == radiant.data::fix_names(objname)) { + objname <- "csv_url" + } + + dataset <- try(load_csv( + url(url_csv), + delim = input$man_sep, + col_names = input$man_header, + n_max = input$man_n_max, + dec = input$man_dec, + saf = input$man_str_as_factor + ), silent = TRUE) + + cmd <- "" + if (inherits(dataset, "try-error") || is.character(dataset)) { + upload_error_handler(objname, i18n$t("#### There was an error loading the csv file from the provided url")) + } else { + r_data[[objname]] <- dataset + ## generate command + delim <- input$man_sep + col_names <- input$man_header + dec <- input$man_dec + saf <- input$man_str_as_factor + n_max <- input$man_n_max + n_max <- if (is_not(n_max) || n_max < 0) Inf else n_max + if (delim == "," && dec == "." && col_names == FALSE) { + cmd <- glue(' + {objname} <- readr::read_csv( + "{url_csv}", + n_max = {n_max} + )') + } else { + cmd <- glue(' + {objname} <- readr::read_delim( + "{url_csv}", + delim = "{delim}", col_names = {col_names}, n_max = {n_max}, + locale = readr::locale(decimal_mark = "{dec}", grouping_mark = "{delim}") + )') + } + cmd <- paste0(cmd, " %>%\n fix_names()") + if (saf) cmd <- paste0(cmd, " %>%\n to_fct()") + cmd <- glue('{cmd}\nregister("{objname}")') + } + + if (exists(objname, envir = r_data) && !bindingIsActive(as.symbol(objname), env = r_data)) { + shiny::makeReactiveBinding(objname, env = r_data) + } + r_info[["datasetlist"]] <- c(objname, r_info[["datasetlist"]]) %>% unique() + r_info[[paste0(objname, "_descr")]] <- fix_smart(attr(r_data[[objname]], "description")) + r_info[[paste0(objname, "_lcmd")]] <- cmd + + updateSelectInput( + session, "dataset", + label = i18n$t("Datasets:"), + choices = r_info[["datasetlist"]], + selected = r_info[["datasetlist"]][1] + ) +}) + +## loading all examples files (linked to help files) +observeEvent(input$loadExampleData, { + ## data.frame of example datasets + exdat <- data(package = getOption("radiant.example.data"))$results[, c("Package", "Item")] + for (i in seq_len(nrow(exdat))) { + item <- exdat[i, "Item"] + data(list = item, package = exdat[i, "Package"], envir = r_data) + if (exists(item, envir = r_data) && !bindingIsActive(as.symbol(item), env = r_data)) { + shiny::makeReactiveBinding(item, env = r_data) + } + if (is.data.frame(get(item, envir = r_data))) { + r_info[["datasetlist"]] <- c(item, r_info[["datasetlist"]]) %>% unique() + r_info[[paste0(item, "_descr")]] <- fix_smart(attr(r_data[[item]], "description")) + r_info[[paste0(item, "_lcmd")]] <- glue('{item} <- data({item}, package = "{exdat[i, "Package"]}", envir = environment()) %>% get()\nregister("{item}")') + } else { + r_info[["dtree_list"]] <- c(item, r_info[["dtree_list"]]) %>% unique() + } + } + + ## sorting files alphabetically + r_info[["datasetlist"]] <- sort(r_info[["datasetlist"]]) + + updateSelectInput( + session, "dataset", + label = i18n$t("Datasets:"), + choices = r_info[["datasetlist"]], + selected = r_info[["datasetlist"]][1] + ) +}) + +observeEvent(input$loadClipData, { + ## reading data from clipboard + objname <- "from_clipboard" + dataset <- radiant.data::load_clip("\t", input$load_cdata) + if (inherits(dataset, "try-error") || length(dim(dataset)) < 2 || nrow(dataset) == 0) { + ret <- i18n$t("#### Data in clipboard was not well formatted. Try exporting the data to csv format") + upload_error_handler(objname, ret) + } else { + cmd <- glue("{objname} <- load_clip()") + ret <- glue(i18n$t("#### Clipboard data\nData copied from clipboard on {lubridate::now()}")) + cn <- colnames(dataset) + fn <- radiant.data::fix_names(cn) + if (!identical(cn, fn)) { + colnames(dataset) <- fn + cmd <- paste0(cmd, " %>% fix_names()") + } + r_data[[objname]] <- dataset + r_info[[paste0(objname, "_lcmd")]] <- glue('{cmd}\nregister("{objname}")') + } + if (exists(objname, envir = r_data) && !bindingIsActive(as.symbol(objname), env = r_data)) { + shiny::makeReactiveBinding(objname, env = r_data) + } + r_info[[paste0(objname, "_descr")]] <- ret + r_info[["datasetlist"]] <- c(objname, r_info[["datasetlist"]]) %>% unique() + updateSelectInput( + session, "dataset", + label = i18n$t("Datasets:"), + choices = r_info[["datasetlist"]], + selected = objname + ) +}) + +####################################### +# Load previous state +####################################### +output$refreshOnLoad <- renderUI({ + # req(input$state_load) + req(pressed(input$state_load) || pressed(input$state_upload)) + + if (pressed(input$state_load)) { + if (getOption("radiant.shinyFiles", FALSE)) { + if (is.integer(input$state_load)) { + return() + } + path <- shinyFiles::parseFilePaths(sf_volumes, input$state_load) + if (inherits(path, "try-error") || is.empty(path$datapath)) { + return() + } + path <- path$datapath + sname <- basename(path) + } else { + path <- input$state_load$datapath + sname <- input$state_load$name + } + } else { + path <- input$state_upload$datapath + sname <- input$state_upload$name + } + + if (is.empty(path)) { + invisible() + } else { + withProgress(message = i18n$t("Loading state file"), value = 1, { + refreshOnLoad(path, sname) + }) + ## Joe Cheng: https://groups.google.com/forum/#!topic/shiny-discuss/Olr8m0JwMTo + tags$script("window.location.reload();") + } +}) + +output$ui_state_upload <- renderUI({ + fileInput("state_upload", i18n$t("Upload radiant state file:"), accept = ".rda") +}) + +refreshOnLoad <- function(path, sname) { + tmpEnv <- new.env(parent = emptyenv()) + load(path, envir = tmpEnv) + + if (is.null(tmpEnv$r_state) && is.null(tmpEnv$r_data)) { + ## don't destroy session when attempting to load a + ## file that is not a state file + showModal( + modalDialog( + title = i18n$t("Restore radiant state failed"), + span( + i18n$t("Unable to restore radiant state from the selected file. + Choose another state file or select 'rds | rda | rdata' from the 'Load + data of type' dropdown to load an R-data file and try again") + ), + footer = modalButton(i18n$t("OK")), + size = "m", + easyClose = TRUE + ) + ) + return(invisible()) + } + + ## remove characters that may cause problems in shinyAce from r_state + ## https://stackoverflow.com/questions/22549146/ace-text-editor-displays-text-characters-in-place-of-spaces + if (!is.null(tmpEnv$r_state)) { + for (i in names(tmpEnv$r_state)) { + if (is.character(tmpEnv$r_state[[i]])) { + tmpEnv$r_state[[i]] %<>% fix_smart() + } + } + } + + ## remove characters that may cause problems in shinyAce from r_data + if (!is.null(tmpEnv$r_data)) { + for (i in names(tmpEnv$r_data)) { + if (is.character(tmpEnv$r_data[[i]])) { + tmpEnv$r_data[[i]] %<>% fix_smart() + } + } + } + + ## remove characters that may cause problems in shinyAce from r_info + if (!is.null(tmpEnv$r_info)) { + for (i in names(tmpEnv$r_info)) { + if (is.character(tmpEnv$r_info[[i]])) { + tmpEnv$r_info[[i]] %<>% fix_smart() + } + } + } + + ## storing statename for later use if needed + tmpEnv$r_state$radiant_state_name <- sname + + r_sessions[[r_ssuid]] <- list( + r_data = tmpEnv$r_data, + r_info = tmpEnv$r_info, + r_state = tmpEnv$r_state, + timestamp = Sys.time() + ) + + rm(tmpEnv) +} + +## need to set suspendWhenHidden to FALSE so that the href for the +## these outputs is available on startup and keyboard shortcuts will work +## see https://shiny.posit.co/reference/shiny/0.11/outputOptions.html +## see https://stackoverflow.com/questions/48117501/click-link-in-navbar-menu +## https://stackoverflow.com/questions/3871358/get-all-the-href-attributes-of-a-web-site +outputOptions(output, "refreshOnLoad", suspendWhenHidden = FALSE) +outputOptions(output, "ui_state_load", suspendWhenHidden = FALSE) +outputOptions(output, "ui_state_upload", suspendWhenHidden = FALSE) + +####################################### +# Save state +####################################### +saveState <- function(filename) { + withProgress( + message = i18n$t("Preparing radiant state file"), value = 1, + isolate({ + LiveInputs <- toList(input) + r_state[names(LiveInputs)] <- LiveInputs + r_data <- active2list(r_data) + r_info <- toList(r_info) + save(r_state, r_data, r_info, file = filename) + }) + ) +} + +observeEvent(input$renameButton, { + req(!is.empty(input$data_rename)) + req(!identical(input$dataset, input$data_rename)) + ## use lobstr::object_size to see that the size of the list doesn't change + ## when you assign a list element another name + r_data[[input$data_rename]] <- r_data[[input$dataset]] + if (!bindingIsActive(as.symbol(input$data_rename), env = r_data)) { + shiny::makeReactiveBinding(input$data_rename, env = r_data) + } + r_data[[input$dataset]] <- NULL + r_info[[paste0(input$data_rename, "_descr")]] <- r_info[[paste0(input$dataset, "_descr")]] + r_info[[paste0(input$dataset, "_descr")]] <- NULL + lcmd <- r_info[[paste0(input$dataset, "_lcmd")]] %>% + sub(glue("^{input$dataset} <- "), glue("{input$data_rename} <- "), .) %>% + sub( + glue('register\\("{input$dataset}"\\)'), + glue('register\\("{input$data_rename}"\\)'), + . + ) + r_info[[paste0(input$data_rename, "_lcmd")]] <- lcmd + r_info[[paste0(input$dataset, "_lcmd")]] <- NULL + scmd <- r_info[[paste0(input$dataset, "_scmd")]] %>% + sub(input$dataset, input$data_rename, .) + r_info[[paste0(input$data_rename, "_scmd")]] <- scmd + r_info[[paste0(input$dataset, "_scmd")]] <- NULL + ind <- which(input$dataset == r_info[["datasetlist"]]) + r_info[["datasetlist"]][ind] <- input$data_rename + r_info[["datasetlist"]] %<>% unique() + + updateSelectInput( + session, "dataset", + label = i18n$t("Datasets:"), + choices = r_info[["datasetlist"]], + selected = input$data_rename + ) +}) + +output$ui_datasets <- renderUI({ + ## Drop-down selection of active dataset + tagList( + selectInput( + inputId = "dataset", + label = i18n$t("Datasets:"), + choices = r_info[["datasetlist"]], + selected = state_init("dataset"), + multiple = FALSE + ), + conditionalPanel( + condition = "input.tabs_data == 'Manage'", + checkboxInput("man_add_descr", i18n$t("Add/edit data description"), FALSE), + conditionalPanel( + condition = "input.man_add_descr == true", + actionButton("updateDescr", i18n$t("Update description")) + ), + checkboxInput("man_rename_data", i18n$t("Rename data"), FALSE), + conditionalPanel( + condition = "input.man_rename_data == true", + uiOutput("uiRename") + ), + radioButtons( + "dman_preview", i18n$t("Display:"), + choices = setNames( + c("preview", "str", "summary"), + c(i18n$t("preview"), i18n$t("str"), i18n$t("summary")) + ), + selected = "preview", + inline = TRUE + ) + ) + ) +}) + +output$uiRename <- renderUI({ + tags$table( + tags$td(textInput("data_rename", NULL, placeholder = input$dataset)), + tags$td(actionButton("renameButton", i18n$t("Rename")), class = "top_small") + ) +}) + +output$man_example <- renderText({ + req(input$dataset) + req(!is.null(r_data[[input$dataset]])) + ## Show only the first 10 (or 20) rows + show_data_snippet(nshow = 10) +}) + +output$man_str <- renderPrint({ + req(is.data.frame(r_data[[input$dataset]])) + str(r_data[[input$dataset]]) +}) + +# output$man_summary <- renderUI({ +# req(is.data.frame(r_data[[input$dataset]])) +# summarytools::dfSummary(r_data[[input$dataset]], style = 'grid', plain.ascii = FALSE, graph.magnif = 0.85) %>% +# print(method = 'render', omit.headings = TRUE) +# }) + +output$man_summary <- renderPrint({ + req(is.data.frame(r_data[[input$dataset]])) + get_summary(r_data[[input$dataset]]) +}) + +man_show_log <- reactive({ + if (getOption("radiant.shinyFiles", FALSE)) { + lcmd <- r_info[[paste0(input$dataset, "_lcmd")]] + cmd <- "" + if (!is.empty(lcmd)) { + cmd <- paste0(i18n$t("## Load commands"), lcmd) + } + scmd <- r_info[[paste0(input$dataset, "_scmd")]] + if (!is.empty(scmd)) { + cmd <- paste0(cmd, i18n$t("\n\n## Save commands\n"), scmd) + } + cmd + } else { + i18n$t("## No R-code available") + } +}) + +output$ui_man_log <- renderUI({ + tags$textarea( + isolate(man_show_log()), + id = "man_log", + type = "text", + rows = 5, + autocomplete = "off", + autocorrect = "off", + autocapitalize = "off", + spellcheck = "false", + class = "form-control" + ) +}) + +observe({ + input$man_show_log + updateTextAreaInput(session, "man_log", value = i18n$t(man_show_log())) +}) + +man_show_log_modal <- function() { + showModal( + modalDialog( + title = i18n$t("Generating R-code to load and save data"), + span( + i18n$t("R-code to load and save data is not generated and reported + when using radiant from (shiny) server. This is due to the + fact that the web browser's file dialog does not provide + file path information for security reasons."), + br(), br(), + i18n$t("To generate R-code to load and save data, start Radiant from + Rstudio.") + ), + footer = modalButton(i18n$t("OK")), + size = "m", + easyClose = TRUE + ) + ) +} + +manage_report <- function() { + if (getOption("radiant.shinyFiles", FALSE)) { + update_report(cmd = man_show_log(), outputs = NULL, figs = FALSE) + } else { + man_show_log_modal() + } +} + +observeEvent(input$manage_report, { + r_info[["latest_screenshot"]] <- NULL + manage_report() +}) + +observeEvent(input$manage_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_manage_screenshot") +}) + +observeEvent(input$modal_manage_screenshot, { + manage_report() + removeModal() +}) diff --git a/radiant.data/inst/app/tools/data/pivotr_ui.R b/radiant.data/inst/app/tools/data/pivotr_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..b84471b03d271b59023adbc7e0275be924f15536 --- /dev/null +++ b/radiant.data/inst/app/tools/data/pivotr_ui.R @@ -0,0 +1,561 @@ +############################################ +## Pivotr - combination of Explore and View +############################################ +pvt_normalize <- setNames( + c("None", "row", "column", "total"), + c(i18n$t("None"), i18n$t("Row"), i18n$t("Column"), i18n$t("Total")) +) +pvt_format <- setNames( + c("none", "color_bar", "heat"), + c(i18n$t("None"), i18n$t("Color bar"), i18n$t("Heat map")) +) + +## list of function arguments +pvt_args <- as.list(formals(pivotr)) + +## list of function inputs selected by user +pvt_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + pvt_args$data_filter <- if (input$show_filter) input$data_filter else "" + pvt_args$arr <- if (isTRUE(input$show_filter)) input$data_arrange else "" + pvt_args$rows <- if (isTRUE(input$show_filter)) input$data_rows else "" + pvt_args$dataset <- input$dataset + for (i in r_drop(names(pvt_args))) { + pvt_args[[i]] <- input[[paste0("pvt_", i)]] + } + + pvt_args +}) + +pvt_sum_args <- as.list(if (exists("summary.pivotr")) { + formals(summary.pivotr) +} else { + formals(radiant.data:::summary.pivotr) +}) + +## list of function inputs selected by user +pvt_sum_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(pvt_sum_args)) { + pvt_sum_args[[i]] <- input[[paste0("pvt_", i)]] + } + pvt_sum_args +}) + +pvt_plot_args <- as.list(if (exists("plot.pivotr")) { + formals(plot.pivotr) +} else { + formals(radiant.data:::plot.pivotr) +}) + +## list of function inputs selected by user +pvt_plot_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(pvt_plot_args)) { + pvt_plot_args[[i]] <- input[[paste0("pvt_", i)]] + } + pvt_plot_args$type <- ifelse(isTRUE(pvt_plot_args$type), "fill", "dodge") + pvt_plot_args +}) + +## UI-elements for pivotr +output$ui_pvt_cvars <- renderUI({ + withProgress(message = i18n$t("Acquiring variable information"), value = 1, { + vars <- groupable_vars() + }) + req(available(vars)) + + isolate({ + ## if nothing is selected pvt_cvars is also null + if ("pvt_cvars" %in% names(input) && is.null(input$pvt_cvars)) { + r_state$pvt_cvars <<- NULL + } else { + if (available(r_state$pvt_cvars) && all(r_state$pvt_cvars %in% vars)) { + vars <- unique(c(r_state$pvt_cvars, vars)) + names(vars) <- varnames() %>% + (function(x) x[match(vars, x)]) %>% + names() + } + } + }) + + selectizeInput( + "pvt_cvars", + label = i18n$t("Categorical variables:"), choices = vars, + selected = state_multiple("pvt_cvars", vars, isolate(input$pvt_cvars)), + multiple = TRUE, + options = list( + placeholder = i18n$t("Select categorical variables"), + plugins = list("remove_button", "drag_drop") + ) + ) +}) + +output$ui_pvt_nvar <- renderUI({ + # isNum <- .get_class() %in% c("integer", "numeric", "ts", "factor", "logical") + # vars <- c("None", varnames()[isNum]) + vars <- c("None", varnames()) + + if (any(vars %in% input$pvt_cvars)) { + vars <- base::setdiff(vars, input$pvt_cvars) + names(vars) <- varnames() %>% + (function(x) x[which(x %in% vars)]) %>% + (function(x) c("None", names(x))) + } + + selectizeInput( + "pvt_nvar", + label = i18n$t("Numeric variable:"), choices = vars, + selected = state_single("pvt_nvar", vars, "None"), + multiple = FALSE, options = list(placeholder = i18n$t("Select numeric variable")) + ) +}) + +output$ui_pvt_fun <- renderUI({ + r_funs <- getOption("radiant.functions") + selectizeInput( + "pvt_fun", + i18n$t("Apply function:"), + choices = r_funs, + selected = state_single("pvt_fun", r_funs, isolate(input$pvt_fun)), + multiple = FALSE + ) +}) + +observeEvent(input$pvt_nvar, { + if (input$pvt_nvar == "None") { + updateSelectInput(session, "pvt_fun", selected = "mean") + } +}) + +output$ui_pvt_normalize <- renderUI({ + selectizeInput( + "pvt_normalize", + label = i18n$t("Normalize by:"), + choices = pvt_normalize, + selected = state_single("pvt_normalize", pvt_normalize, "None"), + multiple = FALSE + ) +}) + +observeEvent(input$pvt_cvars, { + if (length(input$pvt_cvars) == 1) { + sel <- ifelse(input$pvt_normalize %in% pvt_normalize[2:3], "None", input$pvt_normalize) + pvt_normalize <- pvt_normalize[-(2:3)] + } else { + sel <- input$pvt_normalize + } + updateSelectInput(session, "pvt_normalize", choices = pvt_normalize, selected = sel) +}) + +output$ui_pvt_format <- renderUI({ + selectizeInput( + "pvt_format", + label = i18n$t("Conditional formatting:"), + choices = pvt_format, + selected = state_single("pvt_format", pvt_format, "none"), + multiple = FALSE + ) +}) + +output$ui_pvt_name <- renderUI({ + req(input$dataset) + textInput("pvt_name", i18n$t("Store as:"), "", placeholder = i18n$t("Provide a table name")) +}) + +output$ui_pvt_run <- renderUI({ + ## updates when dataset changes + req(input$dataset) + actionButton( + "pvt_run", i18n$t("Create pivot table"), + width = "100%", icon = icon("play", verify_fa = FALSE), + class = "btn-success" + ) +}) + +## add a spinning refresh icon if the table needs to be (re)calculated +run_refresh(pvt_args, "pvt", init = "cvars", label = i18n$t("Create pivot table"), relabel = i18n$t("Update pivot table")) + +output$ui_Pivotr <- renderUI({ + tagList( + wellPanel( + uiOutput("ui_pvt_run") + ), + wellPanel( + # actionLink("pvt_clear", "Clear settings", icon = icon("sync", verify_fa = FALSE), style="color:black"), + uiOutput("ui_pvt_cvars"), + uiOutput("ui_pvt_nvar"), + conditionalPanel("input.pvt_nvar != 'None'", uiOutput("ui_pvt_fun")), + uiOutput("ui_pvt_normalize"), + uiOutput("ui_pvt_format"), + returnTextAreaInput("pvt_tab_slice", + label = i18n$t("Table slice (rows):"), + rows = 1, + value = state_init("pvt_tab_slice"), + placeholder = i18n$t("e.g., 1:5 and press return") + ), + numericInput( + "pvt_dec", i18n$t("Decimals:"), + value = state_init("pvt_dec", 3), + min = 0 + ), + with(tags, table( + tr( + td(checkboxInput("pvt_tab", i18n$t("Show table "), value = state_init("pvt_tab", TRUE))), + td(HTML("  ")), + td(checkboxInput("pvt_plot", i18n$t("Show plot "), value = state_init("pvt_plot", FALSE))) + ), + tr( + td(checkboxInput("pvt_perc", i18n$t("Percentage"), value = state_init("pvt_perc", FALSE))), + td(HTML("  ")), + td(conditionalPanel( + "input.pvt_nvar == 'None'", + checkboxInput("pvt_chi2", i18n$t("Chi-square"), value = state_init("pvt_chi2", FALSE)) + )) + ) + )) + ), + conditionalPanel( + "input.pvt_plot == true", + wellPanel( + HTML(paste0("")), + tags$table( + tags$td(checkboxInput("pvt_type", i18n$t("Fill"), value = state_init("pvt_type", FALSE))), + tags$td(checkboxInput("pvt_flip", i18n$t("Flip"), value = state_init("pvt_flip", FALSE))), + width = "50%" + ) + ) + ), + wellPanel( + tags$table( + tags$td(uiOutput("ui_pvt_name")), + tags$td(actionButton("pvt_store", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ), + help_and_report( + modal_title = i18n$t("Pivotr"), + fun_name = "pivotr", + help_file = inclMD(file.path(getOption("radiant.path.data"), "app/tools/help/pivotr.md")), + lic = "by-sa" + ) + ) +}) + +observeEvent(input$pvt_nvar, { + ## only allow chi2 if frequencies are shown + if (input$pvt_nvar != "None") { + updateCheckboxInput(session, "pvt_chi2", value = FALSE) + } +}) + +.pivotr <- eventReactive(input$pvt_run, { + ## reset r_state value as needed + if (!available(input$pvt_cvars)) r_state$pvt_cvars <<- input$pvt_cvars + + req(available(input$pvt_cvars)) + req(!any(input$pvt_nvar %in% input$pvt_cvars)) + + pvti <- pvt_inputs() + if (is.empty(input$pvt_fun)) pvti$fun <- "n_obs" + if (is.empty(input$pvt_nvar)) pvti$nvar <- "None" + + if (!is.empty(pvti$nvar, "None")) { + req(available(pvti$nvar)) + } + pvti$envir <- r_data + sshhr(do.call(pivotr, pvti)) +}) + +observeEvent(input$pivotr_search_columns, { + r_state$pivotr_search_columns <<- input$pivotr_search_columns +}) + +observeEvent(input$pivotr_state, { + r_state$pivotr_state <<- if (is.null(input$pivotr_state)) list() else input$pivotr_state +}) + +output$pivotr <- DT::renderDataTable({ + input$pvt_run + withProgress(message = i18n$t("Generating pivot table"), value = 1, { + isolate({ + pvt <- .pivotr() + req(!is.null(pvt)) + if (!identical(r_state$pvt_cvars, input$pvt_cvars)) { + r_state$pvt_cvars <<- input$pvt_cvars + r_state$pivotr_state <<- list() + r_state$pivotr_search_columns <<- rep("", ncol(pvt$tab)) + } + searchCols <- lapply(r_state$pivotr_search_columns, function(x) list(search = x)) + order <- r_state$pivotr_state$order + pageLength <- r_state$pivotr_state$length + }) + # caption <- if (is.empty(input$pvt_tab_slice)) NULL else htmltools::tags$caption(glue("Table slice {input$pvt_tab_slice} will be applied on Download, Store, or Report")) + caption <- if (is.empty(input$pvt_tab_slice)) NULL else glue("Table slice {input$pvt_tab_slice} will be applied on Download, Store, or Report") + dtab( + pvt, + format = input$pvt_format, + perc = input$pvt_perc, + dec = input$pvt_dec, + searchCols = searchCols, + order = order, + pageLength = pageLength, + caption = caption + ) + }) +}) + +output$pivotr_chi2 <- renderPrint({ + req(input$pvt_chi2, input$pvt_dec) + .pivotr() %>% + { + if (is.null(.)) { + return(invisible()) + } else { + summary(., chi2 = TRUE, dec = input$pvt_dec, shiny = TRUE) + } + } +}) + +dl_pivot_tab <- function(file) { + dat <- try(.pivotr(), silent = TRUE) + if (inherits(dat, "try-error") || is.null(dat)) { + write.csv(tibble::tibble("Data" = "[Empty]"), file, row.names = FALSE) + } else { + rows <- isolate(r_info[["pvt_rows"]]) + dat$tab[-nrow(dat$tab)] %>% + (function(x) if (is.null(rows)) x else x[rows, , drop = FALSE]) %>% + (function(x) if (is.empty(input$pvt_tab_slice)) x else slice_data(x, input$pvt_tab_slice)) %>% + bind_rows(dat$tab[nrow(dat$tab), , drop = FALSE]) %>% + write.csv(file, row.names = FALSE) + } +} + +download_handler(id = "dl_pivot_tab", fun = dl_pivot_tab, fn = function() paste0(input$dataset, "_pivot")) + +pvt_plot_width <- function() 750 + +## based on https://stackoverflow.com/a/40182833/1974918 +pvt_plot_height <- reactive({ + req(available(input$pvt_cvars)) + pvt <- .pivotr() + if (is.null(pvt)) { + return(400) + } + pvt <- pvt_sorter(pvt, rows = r_info[["pvt_rows"]]) + if (length(input$pvt_cvars) > 2) { + pvt$tab %>% + .[[input$pvt_cvars[3]]] %>% + as.factor() %>% + levels() %>% + length() %>% + (function(x) x * 200) + } else if (input$pvt_flip) { + if (length(input$pvt_cvars) == 2) { + max(400, ncol(pvt$tab) * 15) + } else { + max(400, nrow(pvt$tab) * 15) + } + } else { + 400 + } +}) + +pvt_sorter <- function(pvt, rows = NULL) { + if (is.null(rows)) { + return(pvt) + } + cvars <- pvt$cvars + tab <- pvt$tab %>% + (function(x) filter(x, x[[1]] != "Total")) + + if (length(cvars) > 1) { + tab %<>% select(-which(colnames(.) == "Total")) + } + + tab <- tab[rows, , drop = FALSE] + cvars <- if (length(cvars) == 1) cvars else cvars[-1] + + ## order factors as set in the sorted data + for (i in cvars) { + tab[[i]] %<>% factor(., levels = unique(.)) + } + + pvt$tab <- tab + pvt +} + +observeEvent(input$pivotr_rows_all, { + req(!identical(r_info[["pvt_rows"]], input$pivotr_rows_all)) + r_info[["pvt_rows"]] <- input$pivotr_rows_all +}) + +.plot_pivot <- eventReactive( + { + c(input$pvt_run, input$pvt_flip, input$pvt_type, input$pvt_perc, req(input$pivotr_state)) + }, + { + pvt <- .pivotr() + req(pvt) + if (!is.empty(input$pvt_tab, FALSE)) { + pvt <- pvt_sorter(pvt, rows = r_info[["pvt_rows"]]) + } + withProgress(message = i18n$t("Making plot"), value = 1, { + pvt_plot_inputs() %>% + (function(x) do.call(plot, c(list(x = pvt), x))) + }) + } +) + +output$plot_pivot <- renderPlot( + { + if (is.empty(input$pvt_plot, FALSE)) { + return(invisible()) + } + validate( + need(length(input$pvt_cvars) < 4, i18n$t("Plots created for at most 3 categorical variables")) + ) + .plot_pivot() + }, + width = pvt_plot_width, + height = pvt_plot_height, + res = 96 +) + +# observeEvent(input$pvt_clear, { +# r_state$pivotr_state <<- list() +# updateCheckboxInput(session = session, inputId = "show_filter", value = FALSE) +# }) + +observeEvent(input$pvt_store, { + req(input$pvt_name) + dat <- try(.pivotr(), silent = TRUE) + if (inherits(dat, "try-error") || is.null(dat)) { + return() + } + + dataset <- fix_names(input$pvt_name) + if (input$pvt_name != dataset) { + updateTextInput(session, inputId = "pvt_name", value = dataset) + } + + rows <- input$pivotr_rows_all + dat$tab <- dat$tab %>% + (function(x) if (is.null(rows)) x else x[rows, , drop = FALSE]) %>% + (function(x) if (is.empty(input$pvt_tab_slice)) x else slice_data(x, input$pvt_tab_slice)) %>% + droplevels() + r_data[[dataset]] <- dat$tab + register(dataset) + updateSelectInput(session, "dataset", selected = input$dataset) + + ## See https://shiny.posit.co/reference/shiny/latest/modalDialog.html + showModal( + modalDialog( + title = i18n$t("Data Stored"), + span( + i18n$t( + paste0( + "Dataset '", dataset, "' was successfully added to the ", + "datasets dropdown. Add code to Report > Rmd or ", + "Report > R to (re)create the results by clicking the ", + "report icon on the bottom left of your screen." + ) + ) + ), + footer = modalButton(i18n$t("OK")), + size = "m", + easyClose = TRUE + ) + ) +}) + +pivot_report <- function() { + inp_out <- list("", "") + inp_out[[1]] <- clean_args(pvt_sum_inputs(), pvt_sum_args[-1]) + + if (input$pvt_plot == TRUE) { + inp_out[[2]] <- clean_args(pvt_plot_inputs(), pvt_plot_args[-1]) + outputs <- c("", "plot") + figs <- TRUE + } else { + outputs <- c() + figs <- FALSE + } + + ## get the state of the dt table + ts <- dt_state("pivotr") + xcmd <- paste0("# summary(result)\ndtab(result") + if (!is.empty(input$pvt_format, "none")) { + xcmd <- paste0(xcmd, ", format = \"", input$pvt_format, "\"") + } + if (isTRUE(input$pvt_perc)) { + xcmd <- paste0(xcmd, ", perc = ", input$pvt_perc) + } + if (!is.empty(input$pvt_dec, 3)) { + xcmd <- paste0(xcmd, ", dec = ", input$pvt_dec) + } + if (!is.empty(r_state$pivotr_state$length, 10)) { + xcmd <- paste0(xcmd, ", pageLength = ", r_state$pivotr_state$length) + } + xcmd <- paste0(xcmd, ", caption = \"\") %>% render()") + if (!is.empty(input$pvt_name)) { + dataset <- fix_names(input$pvt_name) + if (input$pvt_name != dataset) { + updateTextInput(session, inputId = "pvt_name", value = dataset) + } + xcmd <- paste0(xcmd, "\n", dataset, " <- result$tab\nregister(\"", dataset, "\")") + } + + inp_main <- clean_args(pvt_inputs(), pvt_args) + if (ts$tabsort != "") { + inp_main <- c(inp_main, tabsort = ts$tabsort) + } + if (ts$tabfilt != "") { + inp_main <- c(inp_main, tabfilt = ts$tabfilt) + } + if (is.empty(inp_main$rows)) { + inp_main$rows <- NULL + } + if (is.empty(input$pvt_tab_slice)) { + inp_main <- c(inp_main, nr = Inf) + } else { + inp_main$tabslice <- input$pvt_tab_slice + } + + ## update Report > Rmd or Report > R + update_report( + inp_main = inp_main, + fun_name = "pivotr", + outputs = outputs, + inp_out = inp_out, + figs = figs, + fig.width = pvt_plot_width(), + fig.height = pvt_plot_height(), + xcmd = xcmd + ) +} + +download_handler( + id = "dlp_pivot", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_pivot"), + type = "png", + caption = "Save pivot plot", + plot = .plot_pivot, + width = pvt_plot_width, + height = pvt_plot_height +) + +observeEvent(input$pivotr_report, { + r_info[["latest_screenshot"]] <- NULL + pivot_report() +}) + +observeEvent(input$pivotr_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_pivotr_screenshot") +}) + +observeEvent(input$modal_pivotr_screenshot, { + pivot_report() + removeModal() +}) diff --git a/radiant.data/inst/app/tools/data/transform_ui.R b/radiant.data/inst/app/tools/data/transform_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..033819c71027d5f355ab11161de3a6bf3c3099d3 --- /dev/null +++ b/radiant.data/inst/app/tools/data/transform_ui.R @@ -0,0 +1,1463 @@ +## UI-elements for transform +output$ui_tr_vars <- renderUI({ + vars <- varnames() + req(available(vars)) + selectInput( + "tr_vars", i18n$t("Select variable(s):"), + choices = vars, + multiple = TRUE, + size = min(8, length(vars)), + selectize = FALSE + ) +}) + +output$ui_tr_replace <- renderUI({ + validate( + need(available(input$tr_vars), i18n$t("Select one or more variables to replace")) + ) + vars <- varnames() + selectInput( + "tr_replace", i18n$t("Select replacement variables:"), + choices = vars, + multiple = TRUE, size = min(2, length(vars)), selectize = FALSE + ) +}) + +output$ui_tr_normalizer <- renderUI({ + isNum <- .get_class() %in% c("numeric", "integer", "ts") + vars <- varnames()[isNum] + if (length(vars) == 0) { + return() + } + selectInput( + "tr_normalizer", i18n$t("Normalizing variable:"), + choices = setNames( + c("none", vars), + c(i18n$t("None"), vars) + ), + selected = "none" + ) +}) + +output$ui_tr_tab2dat <- renderUI({ + isNum <- .get_class() %in% c("numeric", "integer", "ts") + vars <- varnames()[isNum] + selectInput( + "tr_tab2dat", i18n$t("Frequency variable:"), + choices = setNames( + c("none", vars), + c(i18n$t("None"), vars) + ), + selected = "none" + ) +}) + +output$ui_tr_gather <- renderUI({ + tagList( + tags$table( + tags$td(returnTextInput("tr_gather_key", i18n$t("Key name:"), value = "key")), + tags$td(returnTextInput("tr_gather_value", i18n$t("Value name:"), value = "value")) + ) + ) +}) + +output$ui_tr_spread <- renderUI({ + req(input$tr_change_type) + vars <- c("None" = "none", varnames()) + tagList( + selectizeInput( + "tr_spread_key", i18n$t("Key(s):"), + choices = vars[-1], + selected = NULL, multiple = TRUE, + options = list(placeholder = i18n$t("None"), plugins = list("remove_button", "drag_drop")) + ), + selectInput("tr_spread_value", i18n$t("Value:"), choices = vars, selected = "none", multiple = FALSE), + numericInput("tr_spread_fill", i18n$t("Fill:"), value = NA) + ) +}) + +output$ui_tr_reorg_vars <- renderUI({ + req(input$tr_change_type) + vars <- varnames() + validate( + need(length(vars) < 101, i18n$t("Interactive re-ordering is only supported up to 100 variables. See ?dplyr::select for information on how to re-order variables in R")) + ) + selectizeInput( + "tr_reorg_vars", i18n$t("Reorder/remove variables:"), + choices = vars, + selected = vars, multiple = TRUE, + options = list(placeholder = i18n$t("Select variable(s)"), plugins = list("remove_button", "drag_drop")) + ) +}) + +output$ui_tr_reorg_levs <- renderUI({ + req(input$tr_change_type) + validate( + need(available(input$tr_vars), i18n$t("Select a single variable of type factor or character")) + ) + fctCol <- input$tr_vars[1] + fct <- .get_data_transform()[[fctCol]] + levs <- if (is.factor(fct)) levels(fct) else levels(as_factor(fct)) + validate( + need(length(levs) < 101, i18n$t("Interactive re-ordering is only supported up to 100 levels. See ?radiant.data::refactor for information on how to re-order levels in R")) + ) + tagList( + selectizeInput( + "tr_reorg_levs", i18n$t("Reorder/remove levels:"), + choices = levs, + selected = levs, multiple = TRUE, + options = list(placeholder = i18n$t("Select level(s)"), plugins = list("remove_button", "drag_drop")) + ), + textInput( + "tr_rorepl", i18n$t("Replacement level name:"), + placeholder = i18n$t("Provide name for missing levels"), + value = NA + ) + ) +}) + +transform_auto_complete <- reactive({ + req(input$dataset) + comps <- list(r_info[["datasetlist"]][input$dataset], as.vector(varnames())) + names(comps) <- c("{datasets}", paste0("{", input$dataset, "}")) + comps +}) + +output$ui_tr_log <- renderUI({ + tagList( + HTML(paste0("
    ")), + shinyAce::aceEditor( + "tr_log", + mode = "r", + theme = getOption("radiant.ace_theme", default = "tomorrow"), + wordWrap = TRUE, + debounce = 0, + value = state_init("tr_log", "") %>% fix_smart(), + vimKeyBinding = getOption("radiant.ace_vim.keys", default = FALSE), + tabSize = getOption("radiant.ace_tabSize", 2), + useSoftTabs = getOption("radiant.ace_useSoftTabs", TRUE), + showInvisibles = getOption("radiant.ace_showInvisibles", FALSE), + autoScrollEditorIntoView = TRUE, + autoComplete = getOption("radiant.ace_autoComplete", "enable"), + autoCompleters = c("static", "rlang"), + autoCompleteList = isolate(transform_auto_complete()), + minLines = 5, + maxLines = 15 + ) + ) +}) + +transform_annotater <- shinyAce::aceAnnotate("tr_log") +transform_tooltip <- shinyAce::aceTooltip("tr_log") +transform_ac <- shinyAce::aceAutocomplete("tr_log") + +observe({ + shinyAce::updateAceEditor( + session, "tr_log", + autoCompleters = c("static", "rlang"), + autoCompleteList = transform_auto_complete() + ) +}) + + +ext_options <- list( + "none" = "", "log" = "_ln", "exp" = "_exp", + "square" = "_sq", "sqrt" = "_sqrt", "center" = "_ct", + "standardize" = "_st", "inverse" = "_inv" +) + +output$ui_tr_ext <- renderUI({ + trfun <- input$tr_transfunction + if (is.empty(trfun)) trfun <- "none" + returnTextInput( + "tr_ext", i18n$t("Variable name extension:"), + value = ext_options[[trfun]] + ) +}) + +output$ui_tr_ext_nz <- renderUI({ + if (is.empty(input$tr_normalizer, "none")) { + return() + } + returnTextInput( + "tr_ext_nz", i18n$t("Variable name extension:"), + value = paste0("_", input$tr_normalizer) + ) +}) + +output$ui_tr_rcname <- renderUI({ + if (is.empty(input$tr_vars)) { + return() + } + returnTextInput( + "tr_rcname", i18n$t("Recoded variable name:"), + value = paste0(input$tr_vars[1], "_rc") + ) +}) + +output$ui_tr_ext_bin <- renderUI({ + if (is.empty(input$tr_vars)) { + return() + } + returnTextInput( + "tr_ext_bin", i18n$t("Variable name extension:"), + value = "_dec" + ) +}) + +output$ui_tr_roname <- renderUI({ + if (is.empty(input$tr_vars)) { + return() + } + returnTextInput( + "tr_roname", i18n$t("Variable name:"), + value = input$tr_vars[1] + ) +}) + +output$ui_tr_typename <- renderUI({ + if (is.empty(input$tr_vars)) { + return() + } + returnTextInput( + "tr_typename", i18n$t("Variable name extension:"), + value = "", + placeholder = i18n$t("Add extension to variable name") + ) +}) + +output$ui_tr_rename <- renderUI({ + validate( + need(available(input$tr_vars), i18n$t("Select one or more variables to rename")) + ) + if (length(input$tr_vars) < 2) { + mess <- i18n$t("Type a new name for the selected variable and press return") + } else { + mess <- i18n$t("Type new names for the selected variables, separated by a , and press return") + } + returnTextAreaInput( + "tr_rename", i18n$t("Rename variable(s):"), + value = "", + rows = 3, + placeholder = mess + ) +}) + +output$ui_tr_dataset <- renderUI({ + tr_dataset <- input$dataset + if (input$tr_change_type == "show_dup") { + tr_dataset <- paste0(tr_dataset, "_dup") + } else if (input$tr_change_type == "holdout") { + tr_dataset <- paste0(tr_dataset, "_holdout") + } else if (input$tr_change_type == "tab2dat") { + tr_dataset <- paste0(tr_dataset, "_dat") + } else if (input$tr_change_type == "gather") { + tr_dataset <- paste0(tr_dataset, "_gathered") + } else if (input$tr_change_type == "spread") { + tr_dataset <- paste0(tr_dataset, "_spread") + } else if (input$tr_change_type == "expand") { + tr_dataset <- paste0(tr_dataset, "_expand") + } + tags$table( + tags$td(textInput("tr_name", i18n$t("Store changes in:"), tr_dataset)), + tags$td(actionButton("tr_store", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE), class = "btn-success"), class = "top") + ) +}) + +trans_options <- setNames( + c("none", "log", "exp", "square", "sqrt", "center", "standardize", "inverse"), + c( + i18n$t("None"), + i18n$t("Ln (natural log)"), + i18n$t("Exp"), + i18n$t("Square"), + i18n$t("Square‑root"), + i18n$t("Center"), + i18n$t("Standardize"), + i18n$t("Inverse") + ) +) + +type_options <- setNames( + c( + "none", "as_factor", "as_numeric", "as_integer", "as_character", "ts", + "as_mdy", "as_dmy", "as_ymd", + "as_mdy_hms", "as_mdy_hm", "as_dmy_hms", "as_dmy_hm", + "as_ymd_hms", "as_ymd_hm" + ), + c( + i18n$t("None"), + i18n$t("As factor"), + i18n$t("As numeric"), + i18n$t("As integer"), + i18n$t("As character"), + i18n$t("As time series"), + i18n$t("As date (mdy)"), + i18n$t("As date (dmy)"), + i18n$t("As date (ymd)"), + i18n$t("As date/time (mdy_hms)"), + i18n$t("As date/time (mdy_hm)"), + i18n$t("As date/time (dmy_hms)"), + i18n$t("As date/time (dmy_hm)"), + i18n$t("As date/time (ymd_hms)"), + i18n$t("As date/time (ymd_hm)") + ) +) + +trans_types <- list( + ` ` = i18n$t("None (summarize)"), + + `Change variable(s)` = setNames( + c("Bin", "Change type", "Normalize", "Recode", "Remove/reorder levels", "Rename", "Replace", "Transform"), + c(i18n$t("Bin"), i18n$t("Change type"), i18n$t("Normalize"), i18n$t("Recode"), + i18n$t("Remove/reorder levels"), i18n$t("Rename"), i18n$t("Replace"), i18n$t("Transform")) + ), + + `Create new variable(s)` = setNames( + c("Clipboard", "Create"), + c(i18n$t("Clipboard"), i18n$t("Create")) + ), + + `Clean data` = setNames( + c("Remove missing values", "Remove/reorder variables", "Remove duplicates", "Show duplicates"), + c(i18n$t("Remove missing values"), i18n$t("Remove/reorder variables"), i18n$t("Remove duplicates"), i18n$t("Show duplicates")) + ), + + `Expand data` = setNames( + c("Expand grid", "Table‑to‑data"), + c(i18n$t("Expand grid"), i18n$t("Table‑to‑data")) + ), + + `Split data` = setNames( + c("Holdout sample", "Training variable"), + c(i18n$t("Holdout sample"), i18n$t("Training variable")) + ), + + `Tidy data` = setNames( + c("Gather columns", "Spread column"), + c(i18n$t("Gather columns"), i18n$t("Spread column")) + ) +) + + + +output$ui_Transform <- renderUI({ + ## Inspired by Ian Fellow's transform ui in JGR/Deducer + tagList( + wellPanel( + checkboxInput("tr_hide", i18n$t("Hide summaries"), state_init("tr_hide", FALSE)), + uiOutput("ui_tr_vars"), + selectizeInput("tr_change_type", i18n$t("Transformation type:"), trans_types, selected = "none"), + conditionalPanel( + condition = "input.tr_change_type == 'type'", + selectInput("tr_typefunction", i18n$t("Change variable type:"), type_options, selected = "none"), + conditionalPanel( + condition = "input.tr_typefunction == 'ts'", + tags$table( + tags$td(numericInput("tr_ts_start_year", label = i18n$t("Start year:"), min = 1, value = NA)), + tags$td(numericInput("tr_ts_start_period", label = i18n$t("Start period:"), min = 1, value = 1)) + ), + tags$table( + tags$td(numericInput("tr_ts_end_year", label = i18n$t("End year:"), value = NA)), + tags$td(numericInput("tr_ts_end_period", label = i18n$t("End period:"), value = NA)) + ), + numericInput("tr_ts_frequency", label = i18n$t("Frequency:"), min = 1, value = 52) + ) + ), + conditionalPanel( + condition = "input.tr_change_type == 'transform'", + selectInput("tr_transfunction", i18n$t("Apply function:"), trans_options) + ), + conditionalPanel( + condition = "input.tr_change_type == 'normalize'", + uiOutput("ui_tr_normalizer") + ), + conditionalPanel( + condition = "input.tr_change_type == 'tab2dat'", + uiOutput("ui_tr_tab2dat") + ), + conditionalPanel( + condition = "input.tr_change_type == 'gather'", + uiOutput("ui_tr_gather") + ), + conditionalPanel( + condition = "input.tr_change_type == 'spread'", + uiOutput("ui_tr_spread") + ), + conditionalPanel( + condition = "input.tr_change_type == 'create'", + returnTextAreaInput( + "tr_create", i18n$t("Create:"), + rows = 3, + placeholder = i18n$t("Type a formula to create a new variable (e.g., x = y - z) and press return") + ) + ), + conditionalPanel( + condition = "input.tr_change_type == 'bin'", + numericInput("tr_bin_n", label = i18n$t("Nr bins:"), min = 2, value = 10), + checkboxInput("tr_bin_rev", i18n$t("Reverse order"), value = FALSE), + uiOutput("ui_tr_ext_bin") + ), + conditionalPanel( + condition = "input.tr_change_type == 'training'", + tags$table( + tags$td(numericInput("tr_training_n", label = i18n$t("Size:"), min = 0, value = .7)), + tags$td(textInput("tr_training", i18n$t("Variable name:"), "training")) + ), + numericInput("tr_training_seed", label = i18n$t("Seed:"), value = 1234) + ), + conditionalPanel( + condition = "input.tr_change_type == 'holdout'", + checkboxInput("tr_holdout_rev", i18n$t("Reverse filter and slice"), value = TRUE) + ), + conditionalPanel( + condition = "input.tr_change_type == 'clip'", + textAreaInput( + "tr_paste", i18n$t("Paste from spreadsheet:"), + rows = 3, + value = "", + resize = "vertical", + placeholder = i18n$t("Copy-and-paste data with a header row from a spreadsheet"), + ) + ), + conditionalPanel( + condition = "input.tr_change_type == 'recode'", + returnTextAreaInput( + "tr_recode", i18n$t("Recode:"), + value = "", + rows = 3, + placeholder = i18n$t("Select a variable, specify how it should be recoded (e.g., lo:20 = 0; else = 1), and press return") + ) + ), + conditionalPanel( + condition = "input.tr_change_type == 'rename'", + uiOutput("ui_tr_rename") + ), + conditionalPanel( + condition = "input.tr_change_type == 'replace'", + uiOutput("ui_tr_replace") + ), + conditionalPanel( + condition = "input.tr_change_type == 'reorg_vars'", + uiOutput("ui_tr_reorg_vars") + ), + conditionalPanel( + condition = "input.tr_change_type == 'reorg_levs'", + uiOutput("ui_tr_reorg_levs") + ), + conditionalPanel( + "input.tr_change_type == 'transform'", + uiOutput("ui_tr_ext") + ), + conditionalPanel( + "input.tr_change_type == 'recode'", + uiOutput("ui_tr_rcname") + ), + conditionalPanel( + "input.tr_change_type == 'normalize'", + uiOutput("ui_tr_ext_nz") + ), + conditionalPanel( + "input.tr_change_type == 'reorg_levs'", + uiOutput("ui_tr_roname") + ), + conditionalPanel( + "input.tr_change_type == 'type'", + uiOutput("ui_tr_typename") + ) + ), + conditionalPanel( + "input.tr_change_type != 'none'", + wellPanel(uiOutput("ui_tr_dataset")) + ), + help_and_report( + modal_title = i18n$t("Transform"), + fun_name = "transform", + help_file = inclMD(file.path(getOption("radiant.path.data"), "app/tools/help/transform.md")), + lic = "by-sa" + ) + ) +}) + +## ensure no variables are selected 'by accident' when creating a new variable +observeEvent(input$tr_change_type, { + if (input$tr_change_type == "create") { + updateSelectInput(session = session, inputId = "tr_vars", label = i18n$t("Group by:"), selected = character(0)) + } else if (input$tr_change_type == "training") { + updateSelectInput(session = session, inputId = "tr_vars", label = i18n$t("Block by:"), selected = character(0)) + } else if (input$tr_change_type == "spread") { + updateSelectInput(session = session, inputId = "tr_vars", selected = character(0)) + } else { + updateSelectInput(session = session, inputId = "tr_vars", label = i18n$t("Select variables:")) + } +}) + +fix_ext <- function(ext) { + gsub("(^\\s+|\\s+$)", "", ext) %>% + gsub("\\s+", "_", .) %>% + gsub("[[:punct:]]", "_", .) %>% + gsub("\\.{2,}", ".", .) %>% + gsub("_{2,}", "_", .) +} + +.change_type <- function(dataset, fun, tr_ts, vars = "", .ext = "", + store_dat = "", store = TRUE) { + .ext <- fix_ext(.ext) + + if (!is.empty(tr_ts)) { + tr_ts <- lapply(tr_ts, function(x) x[!is.na(x)]) %>% + (function(x) x[sapply(x, length) > 0]) + } + + if (!store || !is.character(dataset)) { + fun <- get(fun) + if (is.empty(.ext)) { + do.call(mutate_at, c(list(.tbl = dataset, .vars = vars), .funs = fun, tr_ts)) + } else { + do.call(mutate_at, c(list(.tbl = dataset, .vars = vars), .funs = fun, tr_ts)) %>% + set_colnames(paste0(vars, .ext)) + } + } else { + if (store_dat == "") store_dat <- dataset + if (is.empty(tr_ts)) { + tr_ts <- "" + } else { + tr_ts <- deparse(tr_ts, control = getOption("dctrl"), width.cutoff = 500L) %>% + sub("list\\(", ", ", .) %>% + sub("\\)$", "", .) + } + + if (is.empty(.ext)) { + paste0(i18n$t("## change variable type\n"), store_dat, " <- mutate_at(", dataset, ", .vars = vars(", paste0(vars, collapse = ", "), "), .funs = ", fun, tr_ts, ")\n") + } else { + paste0(i18n$t("## change variable type\n"), store_dat, " <- mutate_ext(", dataset, ", .vars = vars(", paste0(vars, collapse = ", "), "), .funs = ", fun, tr_ts, ", .ext = \"", .ext, "\")\n") + } + } +} + +.transform <- function(dataset, fun, vars = "", .ext = "", + store_dat = "", store = TRUE) { + .ext <- fix_ext(.ext) + + if (!store && !is.character(dataset)) { + fun <- get(fun) + if (is.empty(.ext)) { + result <- try(mutate_at(dataset, .vars = vars, .funs = fun), silent = TRUE) + } else { + result <- try(mutate_at(dataset, .vars = vars, .funs = fun) %>% set_colnames(paste0(vars, .ext)), silent = TRUE) + } + if (inherits(result, "try-error")) { + paste0( + "\n", i18n$t("The transformation type you selected generated an error."), "\n\n", + i18n$t("The error message was:"), "\n\n", + attr(result, "condition")$message, "\n\n", + i18n$t("Please change the selection of variables or the transformation type and try again.") + ) + } else { + result + } + } else { + if (store_dat == "") store_dat <- dataset + if (is.empty(.ext)) { + paste0(i18n$t("## transform variable\n"), store_dat, " <- mutate_at(", dataset, ", .vars = vars(", paste0(vars, collapse = ", "), "), .funs = ", fun, ")\n") + } else { + paste0(i18n$t("## transform variable\n"), store_dat, " <- mutate_ext(", dataset, ", .vars = vars(", paste0(vars, collapse = ", "), "), .funs = ", fun, ", .ext = \"", .ext, "\")\n") + } + } +} + +.create <- function(dataset, cmd, byvar = "", + store_dat = "", store = TRUE) { + ## replacing problem symbols (e.g., em dash, and curly quotes) + cmd <- fix_smart(cmd) + + if (!store || !is.character(dataset)) { + if (is.empty(cmd)) { + return(dataset) + } + + cmd <- gsub("\"", "\'", cmd) %>% + gsub("<-", "=", .) + vars <- strsplit(cmd, ";\\s*")[[1]] %>% + strsplit("=") %>% + sapply("[", 1) %>% + gsub("\\s+", "", .) + + ## in case the create command tries to over-write the group-by variable ... + if (any(byvar %in% vars)) { + byvar <- base::setdiff(byvar, vars) + updateSelectInput(session = session, inputId = "tr_vars", selected = character(0)) + } + + ## useful if functions created in Report > R and Report > Rmd are + ## called in Data > Transform > Create + ## add environment to do.call call instead? + ## https://stackoverflow.com/questions/26028488/do-call-specify-environment-inside-function + attach(r_data) + on.exit(detach(r_data)) + + if (is.empty(byvar)) { + ## using within and do.call because it provides better err messages + nvar <- try(do.call(within, list(dataset, parse(text = cmd))), silent = TRUE) + } else { + dots <- rlang::parse_exprs(cmd) %>% + set_names(vars) + + nvar <- try( + group_by_at(dataset, .vars = byvar) %>% + mutate(!!!dots), + silent = TRUE + ) + vars <- c(byvar, vars) ## to avoid the 'added group_by variable' message + } + if (inherits(nvar, "try-error")) { + paste0( + "\n", i18n$t("The create command was not valid."), "\n", + i18n$t("The command entered was:"), "\n\n", + cmd, "\n\n", + i18n$t("The error message was:"), "\n\n", + attr(nvar, "condition")$message, "\n\n", + i18n$t("Please try again. Examples are shown in the help file") + ) + } else { + select_at(nvar, .vars = vars) %>% + ungroup() + } + } else { + if (store_dat == "") store_dat <- dataset + cmd <- gsub(";", ", ", cmd) %>% + gsub("<-", "=", .) %>% + gsub("\\s{2,}", " ", .) + + if (is.empty(byvar)) { + paste0(i18n$t("## create new variable(s)\n"), store_dat, " <- mutate(", dataset, ", ", cmd, ")\n") + } else { + paste0(i18n$t("## create new variable(s)\n"), store_dat, " <- group_by(", dataset, ", ", paste0(byvar, collapse = ", "), ") %>%\n mutate(", cmd, ") %>%\n ungroup()\n") + } + } +} + +.recode <- function(dataset, var, cmd, rcname = "", + store_dat = "", store = TRUE) { + cmd <- cmd %>% + gsub("\\n", "", .) %>% + gsub("\"", "\'", .) + if (is.empty(rcname)) rcname <- paste0(var, "_rc") + + if (!store || !is.character(dataset)) { + if (cmd == "") { + return(dataset) + } + nvar <- try(car::Recode(dataset[[var]], cmd), silent = TRUE) + if (inherits(nvar, "try-error")) { + paste0( + i18n$t("The recode command was not valid."), "\n", + i18n$t("The error message was:"), "\n", + attr(nvar, "condition")$message, "\n", + i18n$t("Please try again. Examples are shown in the help file (click the ? icon).") + ) + } else { + as.data.frame(nvar, stringsAsFactors = FALSE) %>% setNames(rcname) + } + } else { + if (store_dat == "") store_dat <- dataset + paste0(i18n$t("## recode variable\n"), store_dat, " <- mutate(", dataset, ", ", rcname, " = car::Recode(", var, ", \"", cmd, "\"))\n") + } +} + +.rename <- function(dataset, var, rnm, store_dat = "", store = TRUE) { + rnm <- gsub(";", ",", rnm) + if (gsub("\\s+", "", rnm) != "") { + rnm <- unlist(strsplit(rnm, ",")) %>% + .[1:min(length(.), length(var))] %>% + gsub("^\\s+|\\s+$", "", .) + } + rnm <- fix_names(rnm) + + if (!store || !is.character(dataset)) { + if (all(rnm == "")) { + return(dataset) + } + names(dataset)[seq_len(length(rnm))] <- rnm + dataset + } else { + if (store_dat == "") store_dat <- dataset + name_check <- fix_names(var) != var + if (any(name_check)) var[name_check] <- paste0("`", var[name_check], "`") + paste0(i18n$t("## rename variable(s)\n"), store_dat, " <- dplyr::rename(", dataset, ", ", paste(rnm, var, sep = " = ", collapse = ", "), ")\n") + } +} + +.replace <- function(dataset, var, rpl, store_dat = "", store = TRUE) { + if (!all(fix_names(var) == var) || !all(fix_names(rpl) == rpl)) { + return(i18n$t("\nSome of the variables names used are not valid. Please use 'Rename' to ensure\nvariable names do not have any spaces or symbols and start with a letter")) + } + + if (!store || !is.character(dataset)) { + select_at(dataset, .vars = rpl) %>% set_colnames(var) + } else { + if (store_dat == "") store_dat <- dataset + paste0(i18n$t("## replace variable(s)\n"), store_dat, " <- mutate(", dataset, ", ", paste(var, rpl, sep = " = ", collapse = ", "), ") %>% select(", paste0("-", rpl, collapse = ", "), ")\n") + } +} + +.normalize <- function(dataset, vars, nzvar, .ext = paste0("_", nzvar), + store_dat = "", store = TRUE) { + .ext <- fix_ext(.ext) + + if (!store && !is.character(dataset)) { + nz <- select_at(dataset, .vars = nzvar) + dataset <- select_at(dataset, .vars = vars) + dc <- get_class(dataset) + + isnum <- "numeric" == dc | "integer" == dc + if (sum(isnum) == 0) { + return(i18n$t("Please select only integer or numeric variables to normalize")) + } + vars <- vars[isnum] + select_at(dataset, .vars = vars) %>% + (function(x) x / nz[[1]]) %>% + set_colnames(paste0(vars, .ext)) + } else { + if (store_dat == "") store_dat <- dataset + paste0(i18n$t("## normalize variables\n"), store_dat, " <- mutate_ext(", dataset, ", .vars = vars(", paste0(vars, collapse = ", "), "), .funs = ~ normalize(., ", nzvar, "), .ext = \"", .ext, "\")\n") + } +} + +.tab2dat <- function(dataset, freq, vars = "", + store_dat = "", store = TRUE) { + if (!store && !is.character(dataset)) { + if (is.empty(vars)) vars <- base::setdiff(colnames(dataset), freq) + select_at(dataset, .vars = unique(c(vars, freq))) %>% + table2data(freq) + } else { + if (store_dat == "") store_dat <- dataset + if (is.empty(vars)) vars <- base::setdiff(colnames(r_data[[dataset]]), freq) + vars <- unique(c(vars, freq)) + paste0(i18n$t("## Create data from a table\n"), store_dat, " <- select(", dataset, ", ", paste0(vars, collapse = ", "), ") %>%\n table2data(\"", freq, "\")\n") + } +} + +.gather <- function(dataset, vars, key, value, + store_dat = "", store = TRUE) { + key <- fix_names(key) + value <- fix_names(value) + + if (!store && !is.character(dataset)) { + gather(dataset, !!key, !!value, !!vars, factor_key = TRUE) + } else { + if (store_dat == "") store_dat <- dataset + paste0(i18n$t("## Gather columns\n"), store_dat, " <- gather(", dataset, ", ", key, ", ", value, ", ", paste0(vars, collapse = ", "), ", factor_key = TRUE)\n") + } +} + +.spread <- function(dataset, key, value, fill = NA, + vars = "", store_dat = "", store = TRUE) { + if (!store && !is.character(dataset)) { + if (!vars[1] == "") dataset <- select_at(dataset, .vars = vars) + cn <- colnames(dataset) + if (!all(key %in% cn) || !value %in% cn) { + return(i18n$t("Key or value variable is not in the dataset")) + } + nr <- distinct_at(dataset, .vars = base::setdiff(cn, value), .keep_all = TRUE) %>% + nrow() + if (nr < nrow(dataset)) { + return(i18n$t("Rows are not unique. Select additional variables")) + } + if (length(key) > 1) { + dataset <- unite_(dataset, paste(key, collapse = "_"), key) + key <- paste(key, collapse = "_") + } + spread(dataset, !!key, !!value, fill = fill) + } else { + if (store_dat == "") store_dat <- dataset + cmd <- "" + if (!is.empty(vars)) { + cmd <- paste0(i18n$t("## Select columns\n"), store_dat, " <- select(", dataset, ", ", paste0(vars, collapse = ", "), ")\n") + dataset <- store_dat + } + if (length(key) > 1) { + cmd <- paste0(cmd, i18n$t("## Unite columns\n"), store_dat, " <- unite(", dataset, ", ", paste(key, collapse = "_"), ", ", paste0(key, collapse = ", "), ")\n") + key <- paste(key, collapse = "_") + dataset <- store_dat + } + if (!is.na(fill)) { + paste0(cmd, i18n$t("## Spread columns\n"), store_dat, " <- spread(", dataset, ", ", key, ", ", value, ", fill = ", fill, ")\n") + } else { + paste0(cmd, i18n$t("## Spread columns\n"), store_dat, " <- spread(", dataset, ", ", key, ", ", value, ")\n") + } + } +} + +.expand <- function(dataset, vars = "", store_dat = "", store = TRUE) { + if (!store || !is.character(dataset)) { + if (all(vars == "")) { + paste0(i18n$t("Select variables to expand")) + } else { + expand.grid(level_list(select_at(dataset, .vars = vars))) + } + } else { + paste0(i18n$t("## expanding data\n"), store_dat, " <- expand.grid(level_list(", dataset, ", ", paste0(vars, collapse = ", "), "))\n") + } +} + +.bin <- function(dataset, vars = "", bins = 10, rev = FALSE, + .ext = "_dec", store_dat = "", store = TRUE) { + .ext <- fix_ext(.ext) + + if (!store && !is.character(dataset)) { + if (is.na(bins) || !is.integer(bins)) { + return(i18n$t("Please specify the (integer) number of bins to use")) + } + if (!all(sapply(dataset[, vars, drop = FALSE], is.numeric))) { + return(i18n$t("Binning can only be applied to numeric variables")) + } + select_at(dataset, .vars = vars) %>% + mutate_all(~ xtile(., bins, rev = rev)) %>% + set_colnames(paste0(vars, .ext)) + } else { + if (store_dat == "") store_dat <- dataset + if (rev) { + paste0(i18n$t("## bin variables\n"), store_dat, " <- mutate_ext(", dataset, ", .vars = vars(", paste0(vars, collapse = ", "), "), .funs = ~ xtile(., ", bins, ", rev = TRUE), .ext = \"", .ext, "\")\n") + } else { + paste0(i18n$t("## bin variables\n"), store_dat, " <- mutate_ext(", dataset, ", .vars = vars(", paste0(vars, collapse = ", "), "), .funs = ~ xtile(., ", bins, "), .ext = \"", .ext, "\")\n") + } + } +} + +.training <- function(dataset, vars = "", n = .7, nr = 100, + name = "training", seed = 1234, + store_dat = "", store = TRUE) { + if (is.empty(name)) { + name <- "training" + } else { + name <- fix_names(name) + } + if (!store && !is.character(dataset)) { + n <- n %>% + (function(x) ifelse(x < 0 || is.na(x) || x > nr, 0.7, x)) + if (is.empty(vars)) { + blocks <- NULL + } else { + blocks <- dataset[, vars] + } + + make_train(n, nr, blocks = blocks, seed = seed) %>% + data.frame(stringsAsFactors = FALSE) %>% + setNames(name) + } else { + if (store_dat == "") store_dat <- dataset + if (is.empty(vars)) { + paste0(i18n$t("## created variable to select training sample\n"), store_dat, " <- mutate(", dataset, ", ", name, " = make_train(", n, ", n(), seed = ", seed, "))\n") + } else { + paste0(i18n$t("## created variable to select training sample\n"), store_dat, " <- mutate(", dataset, ", ", name, " = make_train(", n, ", blocks = select(", dataset, ", ", paste0(vars, collapse = ", "), "), seed = ", seed, "))\n") + } + } +} + +## Make a training variable that selects randomly by ID +# http://rpackages.ianhowson.com/cran/dplyr/man/group_indices.html +# http://rpackages.ianhowson.com/cran/dplyr/man/sample.html + +.reorg_levs <- function(dataset, fct, levs, repl = NA, name = fct, + store_dat = "", store = TRUE) { + if (is.empty(name)) name <- fct + if (!store || !is.character(dataset)) { + data.frame(refactor(dataset[[fct]], levs = levs, repl = repl), stringsAsFactors = FALSE) %>% + setNames(name) + } else { + if (store_dat == "") store_dat <- dataset + repl <- if (is.na(repl)) "" else paste0(", repl = \"", repl, "\"") + paste0(i18n$t("## change factor levels\n"), store_dat, " <- mutate(", dataset, ", ", name, " = refactor(", fct, ", levs = c(\"", paste0(levs, collapse = "\",\""), "\")", repl, "))\n") + } +} + +.reorg_vars <- function(dataset, vars = "", store_dat = "", store = TRUE) { + if (!store || !is.character(dataset)) { + get_data(dataset, vars, filt = "", na.rm = FALSE, envir = r_data) + } else { + if (store_dat == "") store_dat <- dataset + paste0(i18n$t("## reorder/remove variables\n"), store_dat, " <- select(", dataset, ", ", paste0(vars, collapse = ", "), ")\n") + } +} + +.remove_na <- function(dataset, vars = "", store_dat = "", + nr_col = 0, store = TRUE) { + if (!store || !is.character(dataset)) { + if (all(vars == "") || length(unique(vars)) == ncol(dataset)) { + dataset %>% filter(complete.cases(.)) + } else { + ind <- select_at(dataset, .vars = vars) %>% complete.cases() + filter(dataset, ind) + } + } else { + if (store_dat == "") store_dat <- dataset + if (all(vars == "") || length(unique(vars)) == nr_col) vars <- "." + paste0(i18n$t("## remove missing values\n"), store_dat, " <- ", dataset, " %>% filter(complete.cases(", paste0(vars, collapse = ", "), "))\n") + } +} + +.remove_dup <- function(dataset, vars = "", store_dat = "", + nr_col = 0, store = TRUE) { + if (!store || !is.character(dataset)) { + if (all(vars == "") || length(unique(vars)) == ncol(dataset)) { + dat <- distinct(dataset) + } else { + dat <- distinct_at(dataset, .vars = vars, .keep_all = TRUE) + } + + if (nrow(dat) == nrow(dataset)) { + paste0(i18n$t("No duplicates found (n_distinct = "), nrow(dat), ")") + } else { + dat + } + } else { + if (all(vars == "") || length(unique(vars)) == nr_col) { + paste0(i18n$t("## remove duplicate rows\n"), store_dat, " <- distinct(", dataset, ")\n") + } else { + paste0(i18n$t("## remove rows with duplicate values\n"), store_dat, " <- distinct(", dataset, ", ", paste0(vars, collapse = ", "), ", .keep_all = TRUE)\n") + } + } +} + +.show_dup <- function(dataset, vars = "", store_dat = "", + nr_col = 0, store = TRUE) { + if (!store || !is.character(dataset)) { + if (all(vars == "") || length(unique(vars)) == ncol(dataset)) { + dat <- filter(dataset, duplicated(dataset)) + } else { + dat <- dataset %>% + group_by_at(.vars = vars) %>% + filter(n() > 1) + + if (nrow(dat) > 0) { + dat <- mutate(dat, nr_dup = 1:n()) %>% + arrange_at(.vars = vars) %>% + ungroup() + } + } + + if (nrow(dat) == 0) { + ## "No duplicates found" + paste0(i18n$t("No duplicates found (n_distinct = "), nrow(dataset), ")") + } else { + dat + } + } else { + if (all(vars == "") || length(unique(vars)) == nr_col) { + paste0(i18n$t("## show duplicate rows\n"), store_dat, " <- ", dataset, " %>% filter(duplicated(.))\n") + } else { + paste0(i18n$t("## show rows with duplicate values\n"), store_dat, " <- show_duplicated(", dataset, ", ", paste0(vars, collapse = ", "), ")\n") + } + } +} + +.holdout <- function(dataset, vars = "", filt = "", arr = "", rows = NULL, rev = FALSE, + store_dat = "", store = TRUE) { + if (is.empty(filt) && is.empty(rows)) { + return(paste0(i18n$t("No filter or slice found (n = "), nrow(dataset), ")")) + } + + if (!store || !is.character(dataset)) { + get_data(dataset, vars = vars, filt = filt, arr = arr, rows = rows, na.rm = FALSE, rev = rev, envir = r_data) + } else { + cmd <- glue("{i18n$t('## create holdout sample')}\n{store_dat} <- get_data(\n {dataset}") # ", vars = {vars}, filt = {filt}, arr = {arr}, rows = {rows}, rev = {rev})\n") + + if (!all(vars == "")) { + cmd <- glue('{cmd},\n vars = c("{paste0(vars, collapse = ", ")}")', .trim = FALSE) + } + if (!is.empty(filt)) { + filt <- gsub("\"", "'", filt) + cmd <- glue('{cmd},\n filt = "{filt}"', .trim = FALSE) + } + if (!is.empty(arr)) { + cmd <- glue('{cmd},\n arr = "{arr}"', .trim = FALSE) + } + if (!is.empty(rows)) { + cmd <- glue('{cmd},\n rows = "{rows}"', .trim = FALSE) + } + glue("{cmd},\n rev = {rev}\n)", .trim = FALSE) + } +} + +inp_vars <- function(inp, rval = "") { + if (is.empty(input[[inp]]) || !available(input[[inp]])) rval else input[[inp]] +} + +transform_main <- reactive({ + req(input$tr_change_type) + if (not_available(input$tr_vars)) { + if (input$tr_change_type == "none" && length(input$tr_vars) == 0) { + return(i18n$t("Select a transformation type or select variables to summarize")) + } else if (input$tr_change_type == "none" && length(input$tr_vars) > 0) { + return(i18n$t("Select a transformation type or select variables to summarize")) + } else if (input$tr_change_type == "type") { + return(i18n$t("Select one or more variables to change their type")) + } else if (input$tr_change_type == "transform") { + return(i18n$t("Select one or more variables to apply a transformation")) + } else if (input$tr_change_type == "rename") { + return(i18n$t("Select one or more variables to rename")) + } else if (input$tr_change_type == "replace") { + return(i18n$t("Select one or more variables to replace")) + } else if (input$tr_change_type == "recode") { + return(i18n$t("Select a variable to recode")) + } else if (input$tr_change_type == "bin") { + return(i18n$t("Select one or more variables to bin")) + } else if (input$tr_change_type == "reorg_levs") { + return(i18n$t("Select a single variable of type factor to change the ordering and/or number of levels")) + } else if (input$tr_change_type == "normalize") { + return(i18n$t("Select one or more variables to normalize")) + } else if (input$tr_change_type == "remove_na") { + return(i18n$t("Select one or more variables to see the effects of removing missing values")) + } else if (input$tr_change_type %in% c("remove_dup", "show_dup")) { + return(i18n$t("Select one or more variables to see the effects of removing duplicates")) + } else if (input$tr_change_type == "gather") { + return(i18n$t("Select one or more variables to gather")) + } else if (input$tr_change_type == "expand") { + return(i18n$t("Select one or more variables to expand")) + } + } + + ## get the active dataset, filter not applied when called from transform tab + dat <- .get_data_transform() + + ## what data to pass on ... + if (input$tr_change_type %in% c("", "none")) { + return(select_at(dat, .vars = input$tr_vars)) + } + + ## reorganize variables + if (input$tr_change_type == "reorg_vars") { + return(.reorg_vars(dat, inp_vars("tr_reorg_vars"), store = FALSE)) + } + + ## create training variable + if (input$tr_change_type == "training") { + return(.training(dat, n = input$tr_training_n, nr = nrow(dat), name = input$tr_training, vars = inp_vars("tr_vars"), seed = input$tr_training_seed, store = FALSE)) + } + + if (input$tr_change_type == "create") { + if (input$tr_create == "") { + return(i18n$t("Specify an equation to create a new variable and press 'return'. **\n** See the help file for examples")) + } else { + return(.create(dat, input$tr_create, byvar = inp_vars("tr_vars"), store = FALSE)) + } + } + + if (input$tr_change_type == "tab2dat") { + if (is.null(input$tr_tab2dat) || input$tr_tab2dat == "none") { + return(i18n$t("Select a frequency variable")) + } else if (!is.empty(input$tr_vars) && all(input$tr_vars == input$tr_tab2dat)) { + return(i18n$t("Select at least one variable that is not the frequency variable")) + } else { + req(available(input$tr_tab2dat)) + return(.tab2dat(dat, input$tr_tab2dat, vars = inp_vars("tr_vars"), store = FALSE)) + } + } + + if (input$tr_change_type == "clip") { + if (input$tr_paste == "") { + return(i18n$t("Copy-and-paste data with a header row from a spreadsheet")) + } else { + cpdat <- try(read.table(header = TRUE, comment.char = "", fill = TRUE, sep = "\t", as.is = TRUE, text = input$tr_paste), silent = TRUE) + if (inherits(cpdat, "try-error")) { + return(i18n$t("The pasted data was not well formatted. Please make sure the number of rows **\n** in the data in Radiant and in the spreadsheet are the same and try again.")) + } else if (nrow(cpdat) != nrow(dat)) { + return(i18n$t("The pasted data does not have the correct number of rows. Please make sure **\n** the number of rows in the data in Radiant and in the spreadsheet are the **\n** same and try again.")) + } else { + return(as.data.frame(cpdat, check.names = FALSE, stringsAsFactors = FALSE) %>% to_fct()) + } + } + } + + ## filter data for holdout + if (input$tr_change_type == "holdout") { + if (!input$show_filter) { + return(i18n$t("\nNo filter, arrange, or slice set. Click the 'Filter' checkbox and enter a\nfilter, arrange, and/or a slice of rows to keep as the main data. The holdout\nwill have have all rows not selected by the filter, arrange, and slice")) + } + return(.holdout(dat, inp_vars("tr_vars"), filt = input$data_filter, arr = input$data_arrange, rows = input$data_rows, rev = input$tr_holdout_rev, store = FALSE)) + } + + ## spread a variable + if (input$tr_change_type == "spread") { + if (is.empty(input$tr_spread_key, "none") || + is.empty(input$tr_spread_value, "none")) { + return(i18n$t("Select a Key and Value pair to spread")) + } + return(.spread(dat, key = input$tr_spread_key, value = input$tr_spread_value, fill = input$tr_spread_fill, vars = inp_vars("tr_vars"), store = FALSE)) + } + + ## only use the functions below if variables have been selected + if (!is.empty(input$tr_vars)) { + if (not_available(input$tr_vars)) { + return() + } + + ## remove missing values + if (input$tr_change_type == "remove_na") { + return(.remove_na(dat, inp_vars("tr_vars"), store = FALSE)) + } + + ## bin variables + if (input$tr_change_type == "bin") { + return(.bin(dat, inp_vars("tr_vars"), bins = input$tr_bin_n, rev = input$tr_bin_rev, .ext = input$tr_ext_bin, store = FALSE)) + } + + ## gather variables + if (input$tr_change_type == "gather") { + if (is.empty(input$tr_gather_key) || is.empty(input$tr_gather_value)) { + return(i18n$t("Provide a name for the Key and Value variables")) + } + return(.gather(dat, inp_vars("tr_vars"), key = input$tr_gather_key, value = input$tr_gather_value, store = FALSE)) + } + + ## remove duplicates + if (input$tr_change_type == "remove_dup") { + return(.remove_dup(dat, inp_vars("tr_vars"), store = FALSE)) + } + + ## expand grid + if (input$tr_change_type == "expand") { + return(.expand(dat, inp_vars("tr_vars"), store = FALSE)) + } + + ## show duplicates + if (input$tr_change_type == "show_dup") { + return(.show_dup(dat, inp_vars("tr_vars"), store = FALSE)) + } + + if (input$tr_change_type == "normalize") { + if (is.empty(input$tr_normalizer, "none")) { + return(i18n$t("Select a normalizing variable")) + } else { + return(.normalize(dat, inp_vars("tr_vars"), input$tr_normalizer, .ext = input$tr_ext_nz, store = FALSE)) + } + } + + if (input$tr_change_type == "replace") { + vars <- input$tr_vars + rpl <- input$tr_replace + if (available(rpl)) { + if (length(vars) != length(rpl)) { + return(i18n$t( + "The number of replacement variables ({rpl_len}) is not equal to the number of variables to replace ({vars_len})", + list(rpl_len = length(rpl), vars_len = length(vars)) + )) + } + return(.replace(dat, vars, rpl, store = FALSE)) + } else { + return(i18n$t("Select one or more variable replacements")) + } + } + + ## selecting the columns to show + dat <- select_at(dat, .vars = input$tr_vars) + vars <- colnames(dat) + + ## change in type is always done in-place + if (input$tr_change_type == "type") { + if (input$tr_typefunction == "none") { + return(i18n$t("Select a transformation type for the selected variables")) + } else { + if (input$tr_typefunction == "ts") { + tr_ts <- list( + start = c(input$tr_ts_start_year, input$tr_ts_start_period), + end = c(input$tr_ts_end_year, input$tr_ts_end_period), + frequency = input$tr_ts_frequency + ) + } else { + tr_ts <- NULL + } + return(.change_type(dat, input$tr_typefunction, tr_ts, inp_vars("tr_vars"), input$tr_typename, store = FALSE)) + } + } + + ## change in type is always done in-place + if (input$tr_change_type == "transform") { + if (input$tr_transfunction == "none") { + return(i18n$t("Select a function to apply to the selected variable(s)")) + } else { + return(.transform(dat, input$tr_transfunction, inp_vars("tr_vars"), input$tr_ext, store = FALSE)) + } + } + + if (input$tr_change_type == "reorg_levs") { + fct <- input$tr_vars[1] + if (length(unique(dat[[fct]])) > 100) { + return(i18n$t("Interactive re-ordering is only supported up to 100 levels. See\n?radiant.data::refactor for information on how to re-order levels in R")) + } else { + return(.reorg_levs(dat, fct, input$tr_reorg_levs, input$tr_rorepl, input$tr_roname, store = FALSE)) + } + } + + if (input$tr_change_type == "recode") { + if (is.empty(input$tr_recode)) { + return(i18n$t("Specify a recode statement, assign a name to the recoded variable, and press 'return'. **\n** See the help file for examples")) + } else { + return(.recode(dat, inp_vars("tr_vars")[1], input$tr_recode, input$tr_rcname, store = FALSE)) + } + } + + if (input$tr_change_type == "rename") { + if (is.empty(input$tr_rename)) { + return(i18n$t("Specify new names for the selected variables (separated by a ',') and press 'return'")) + } else { + if (any(input$tr_rename %in% varnames())) { + return(i18n$t("One or more of the new variables names already exists in the data. **\n** Change the specified names or use the Replace function")) + } else { + return(.rename(dat, inp_vars("tr_vars"), input$tr_rename, store = FALSE)) + } + } + } + } + + return(invisible()) +}) + +output$transform_data <- reactive({ + dataset <- transform_main() + if (is.null(dataset) || is.character(dataset) || nrow(dataset) == 0 || ncol(dataset) == 0) { + tr_snippet() + } else { + show_data_snippet(dataset) + } +}) + +tr_snippet <- reactive({ + show_data_snippet(.get_data_transform()) +}) + +output$transform_summary <- renderPrint({ + req(!isTRUE(input$tr_hide)) + + withProgress(message = i18n$t("Generating summary statistics"), value = 1, { + dataset <- transform_main() + }) + + ## with isolate on the summary wouldn't update when the dataset was changed + if (is.null(dataset)) { + return(invisible()) + } + if (is.character(dataset)) { + cat("**", dataset, "\n**\n\n") + } else { + if (min(dim(dataset)) == 0) { + cat("**", i18n$t("The selected operation resulted in an empty data frame and cannot be executed"), "**\n\n") + } else { + if (input$tr_change_type %in% c("", "none")) { + cat("**", i18n$t("Select a transformation type or select variables to summarize"), "**\n\n") + } else { + cat("**", i18n$t("Press the 'Store' button to add your changes to the data"), "**\n\n") + if (!is.empty(input$tr_vars) && input$tr_change_type == "create") { + cat("**", i18n$t("Results are grouped by"), paste(input$tr_vars, collapse = ", "), "**\n\n") + } else if (!is.empty(input$tr_vars) && input$tr_change_type == "training") { + cat("**", i18n$t("Results are blocked by"), paste(input$tr_vars, collapse = ", "), "**\n\n") + } + } + + if (input$tr_change_type == "reorg_vars") { + cat("**", i18n$t("Drag-and-drop to change ordering. Click the x to remove a variable"), "**") + } else { + cat(paste0(capture.output(get_summary(dataset)), collapse = "\n")) + } + } + } +}) + +observeEvent(input$tr_store, { + withProgress(message = "Storing transformations", value = 1, { + dat <- transform_main() + }) + + if (is.null(dat)) { + return() + } else if (is.character(dat)) { + return() + } else if (min(dim(dat)) == 0) { + return() + } + + ## saving to a new dataset if specified + df_name <- fix_names(input$tr_name) + if (input$tr_name != df_name) { + updateTextInput(session, inputId = "tr_name", value = df_name) + } + ncmd <- "" + if (is.null(r_data[[df_name]])) { + r_data[[df_name]] <- .get_data_transform() + r_info[[paste0(df_name, "_descr")]] <- r_info[[paste0(input$dataset, "_descr")]] + if (!bindingIsActive(as.symbol(df_name), env = r_data)) { + shiny::makeReactiveBinding(df_name, env = r_data) + } + r_info[["datasetlist"]] %<>% c(df_name, .) %>% unique() + + ## adding command to ensure new data is in the datasetlist + if (df_name == input$dataset) { + ncmd <- paste0("\n", i18n$t("## register the new dataset"), "\nregister(\"", df_name, "\")") + } else { + ncmd <- paste0("\n", i18n$t("## register the new dataset"), "\nregister(\"", df_name, "\", \"", input$dataset, "\")") + } + } else if (!df_name %in% r_info[["datasetlist"]]) { + r_info[["datasetlist"]] %<>% c(df_name, .) %>% unique() + + ## adding command to ensure new data is in the datasetlist + if (df_name == input$dataset) { + ncmd <- paste0("\n", i18n$t("## register the new dataset"), "\nregister(\"", df_name, "\")") + } else { + ncmd <- paste0("\n", i18n$t("## register the new dataset"), "\nregister(\"", df_name, "\", \"", input$dataset, "\")") + } + } + + if (input$tr_change_type == "remove_na") { + cmd <- .remove_na(input$dataset, vars = input$tr_vars, df_name, nr_col = ncol(dat)) + r_data[[df_name]] <- dat + } else if (input$tr_change_type == "remove_dup") { + cmd <- .remove_dup(input$dataset, vars = input$tr_vars, df_name, nr_col = ncol(dat)) + r_data[[df_name]] <- dat + } else if (input$tr_change_type == "show_dup") { + cmd <- .show_dup(input$dataset, vars = input$tr_vars, df_name, nr_col = ncol(dat)) + r_data[[df_name]] <- dat + } else if (input$tr_change_type == "holdout") { + cmd <- .holdout(input$dataset, vars = input$tr_vars, filt = input$data_filter, arr = input$data_arrange, rows = input$data_rows, rev = input$tr_holdout_rev, df_name) + r_data[[df_name]] <- dat + } else if (input$tr_change_type == "tab2dat") { + cmd <- .tab2dat(input$dataset, input$tr_tab2dat, vars = input$tr_vars, df_name) + r_data[[df_name]] <- dat + } else if (input$tr_change_type == "gather") { + cmd <- .gather(input$dataset, vars = input$tr_vars, key = input$tr_gather_key, value = input$tr_gather_value, df_name) + r_data[[df_name]] <- dat + } else if (input$tr_change_type == "spread") { + cmd <- .spread(input$dataset, key = input$tr_spread_key, value = input$tr_spread_value, fill = input$tr_spread_fill, vars = input$tr_vars, df_name) + r_data[[df_name]] <- dat + } else if (input$tr_change_type == "expand") { + cmd <- .expand(input$dataset, vars = input$tr_vars, df_name) + r_data[[df_name]] <- dat + } else if (input$tr_change_type == "reorg_vars") { + cmd <- .reorg_vars(input$dataset, vars = input$tr_reorg_vars, df_name) + r_data[[df_name]] <- dat + } else if (input$tr_change_type == "type") { + if (input$tr_typefunction == "ts") { + tr_ts <- list( + start = c(input$tr_ts_start_year, input$tr_ts_start_period), + end = c(input$tr_ts_end_year, input$tr_ts_end_period), + frequency = input$tr_ts_frequency + ) + } else { + tr_ts <- NULL + } + cmd <- .change_type(input$dataset, fun = input$tr_typefunction, tr_ts, vars = input$tr_vars, .ext = input$tr_typename, df_name) + r_data[[df_name]][, colnames(dat)] <- dat + } else if (input$tr_change_type == "transform") { + cmd <- .transform(input$dataset, fun = input$tr_transfunction, vars = input$tr_vars, .ext = input$tr_ext, df_name) + r_data[[df_name]][, colnames(dat)] <- dat + } else if (input$tr_change_type == "training") { + cmd <- .training(input$dataset, n = input$tr_training_n, nr = nrow(dat), name = input$tr_training, vars = input$tr_vars, seed = input$tr_training_seed, df_name) + r_data[[df_name]][, colnames(dat)] <- dat + } else if (input$tr_change_type == "normalize") { + cmd <- .normalize(input$dataset, vars = input$tr_vars, nzvar = input$tr_normalizer, .ext = input$tr_ext_nz, df_name) + r_data[[df_name]][, colnames(dat)] <- dat + } else if (input$tr_change_type == "bin") { + cmd <- .bin(input$dataset, vars = input$tr_vars, bins = input$tr_bin_n, rev = input$tr_bin_rev, .ext = input$tr_ext_bin, df_name) + r_data[[df_name]][, colnames(dat)] <- dat + } else if (input$tr_change_type == "reorg_levs") { + cmd <- .reorg_levs(input$dataset, input$tr_vars[1], input$tr_reorg_levs, input$tr_rorepl, input$tr_roname, df_name) + r_data[[df_name]][, colnames(dat)] <- dat + } else if (input$tr_change_type == "recode") { + cmd <- .recode(input$dataset, input$tr_vars[1], input$tr_recode, input$tr_rcname, df_name) + r_data[[df_name]][, colnames(dat)] <- dat + } else if (input$tr_change_type == "rename") { + cmd <- .rename(input$dataset, input$tr_vars, input$tr_rename, df_name) + r_data[[df_name]] %<>% dplyr::rename(!!!setNames(input$tr_vars, colnames(dat))) + } else if (input$tr_change_type == "create") { + cmd <- .create(input$dataset, cmd = input$tr_create, byvar = input$tr_vars, df_name) + r_data[[df_name]][, colnames(dat)] <- dat + } else if (input$tr_change_type == "replace") { + cmd <- .replace(input$dataset, input$tr_vars, input$tr_replace, df_name) + r_data[[df_name]][, colnames(dat)] <- dat + r_data[[df_name]][, input$tr_replace] <- list(NULL) + } else if (input$tr_change_type == "clip") { + cmd <- paste0( + i18n$t("## using the clipboard for data transformation may seem convenient"), + "\n", + i18n$t("## but it is not 'reproducible' - no command generated"), + "\n" + ) + r_data[[df_name]][, colnames(dat)] <- dat + } + + ## uncomment if you want to revert to resetting the transform UI after Store + # updateTextAreaInput(session, "tr_log", value = paste0(input$tr_log, paste0(cmd, ncmd), "\n")) + + ## update the command log + shinyAce::updateAceEditor(session, "tr_log", value = paste0(input$tr_log, paste0(cmd, ncmd), "\n")) + + ## reset input values once the changes have been applied + # updateSelectInput(session = session, inputId = "tr_change_type", selected = "none") + + ## jumps straight to the new dataset + # updateSelectInput(session = session, inputId = "dataset", selected = df_name) + if (input$dataset != df_name) { + showModal( + modalDialog( + title = i18n$t("Data Stored"), + span( + i18n$t( + paste0( + "Dataset '", df_name, "' was successfully added to ", + "the datasets dropdown. Add code to Report > Rmd or ", + "Report > R to (re)create the results by clicking the ", + "report icon on the bottom left of your screen." + ) + ) + ), + footer = modalButton(i18n$t("OK")), + size = "m", + easyClose = TRUE + ) + ) + } +}) + +observeEvent(input$tr_change_type, { + ## reset all values when tr_change_type is changed + updateTextInput(session = session, inputId = "tr_create", value = "") + updateTextInput(session = session, inputId = "tr_recode", value = "") + updateTextInput(session = session, inputId = "tr_rename", value = "") + updateTextInput(session = session, inputId = "tr_paste", value = "") + updateTextInput(session = session, inputId = "tr_gather_key", value = "") + updateTextInput(session = session, inputId = "tr_gather_value", value = "") + updateTextInput(session = session, inputId = "tr_spread_key", value = "") + updateTextInput(session = session, inputId = "tr_spread_value", value = "") + updateSelectInput(session = session, inputId = "tr_typefunction", selected = "none") + updateSelectInput(session = session, inputId = "tr_transfunction", selected = "none") + updateSelectInput(session = session, inputId = "tr_replace", selected = "None") + updateSelectInput(session = session, inputId = "tr_normalizer", selected = "none") + updateSelectInput(session = session, inputId = "tr_tab2dat", selected = "none") +}) + +transform_report <- function() { + cmd <- NULL + if (!is.empty(input$tr_log)) { + cmd <- gsub("\n{2,}", "\n", input$tr_log) %>% + sub("^\n", "", .) %>% + sub("\n$", "", .) + + shinyAce::updateAceEditor(session, "tr_log", value = "") + } + update_report(cmd = cmd, outputs = NULL, figs = FALSE) +} + +observeEvent(input$transform_report, { + r_info[["latest_screenshot"]] <- NULL + transform_report() +}) + +observeEvent(input$transform_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_transform_screenshot") +}) + +observeEvent(input$modal_transform_screenshot, { + transform_report() + removeModal() +}) diff --git a/radiant.data/inst/app/tools/data/view_ui.R b/radiant.data/inst/app/tools/data/view_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..58105327b436dd7c95a2176073097bdd2cddc033 --- /dev/null +++ b/radiant.data/inst/app/tools/data/view_ui.R @@ -0,0 +1,330 @@ +############################################# +# View table output of the selected dataset +############################################# +output$ui_view_vars <- renderUI({ + vars <- varnames() + req(available(vars)) + isolate({ + if (not_available(r_state$view_vars)) { + r_state$view_vars <<- NULL + r_state$dataviewer_state <<- list() + r_state$dataviewer_search_columns <<- NULL + } + }) + + selectInput( + "view_vars", i18n$t("Select variables to show:"), + choices = vars, + selected = state_multiple("view_vars", vars, vars), + multiple = TRUE, + selectize = FALSE, size = min(15, length(vars)) + ) +}) + +output$ui_View <- renderUI({ + tagList( + wellPanel( + actionLink("view_clear", i18n$t("Clear settings"), icon = icon("sync", verify_fa = FALSE), style = "color:black"), + uiOutput("ui_view_vars"), + returnTextAreaInput("view_tab_slice", + label = i18n$t("Table slice (rows):"), + rows = 1, + value = state_init("view_tab_slice"), + placeholder = i18n$t("e.g., 1:5 and press return") + ), + numericInput( + "view_dec", i18n$t("Decimals:"), + value = state_init("view_dec", 2), + min = 0 + ), + tags$table( + tags$td(textInput("view_name", i18n$t("Store filtered data as:"), "", placeholder = i18n$t("Provide data name"))), + tags$td(actionButton("view_store", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE), class = "btn-success"), class = "top") + ) + ), + help_and_report( + i18n$t("View"), "view", + inclMD(file.path(getOption("radiant.path.data"), "app/tools/help/view.md")) %>% gsub("`", "", .), + lic = "by-sa" + ) + ) +}) + +observeEvent(input$dataviewer_search_columns, { + r_state$dataviewer_search_columns <<- input$dataviewer_search_columns +}) + +observeEvent(input$dataviewer_state, { + r_state$dataviewer_state <<- + if (is.null(input$dataviewer_state)) list() else input$dataviewer_state +}) + +## state_multiple should handle this, but doesn't +## using this observer, however, messes up state settings +# observeEvent(is.null(input$view_vars), { +# if ("view_vars" %in% names(input)) r_state$view_vars <<- NULL +# }) + +observeEvent(input$view_vars, { + if (length(r_state$view_vars) > 0) { + r_state$dataviewer_state <<- list() + r_state$dataviewer_search_columns <<- rep("", length(input$view_vars)) + } + r_state$view_vars <<- input$view_vars +}) + +observeEvent(input$view_clear, { + r_state$dataviewer_state <<- list() + r_state$dataviewer_search_columns <<- rep("", length(input$view_vars)) + r_state$view_vars <<- input$view_vars + updateCheckboxInput(session = session, inputId = "show_filter", value = FALSE) +}) + +output$dataviewer <- DT::renderDataTable( + { + input$view_clear + req(available(input$view_vars)) + dat <- select_at(.get_data(), .vars = input$view_vars) + + style <- if (exists("bslib_current_version") && "4" %in% bslib_current_version()) "bootstrap4" else "bootstrap" + + search <- r_state$dataviewer_state$search$search + if (is.null(search)) search <- "" + fbox <- if (nrow(dat) > 5e6) "none" else list(position = "top") + + isBigFct <- sapply(dat, function(x) is.factor(x) && length(levels(x)) > 1000) + if (sum(isBigFct) > 0) { + dat[, isBigFct] <- select(dat, which(isBigFct)) %>% mutate_all(as.character) + } + + ## for rounding + isInt <- sapply(dat, function(x) is.integer(x)) + isDbl <- sapply(dat, is_double) + dec <- input$view_dec %>% + (function(x) ifelse(is.empty(x) || x < 0, 3, round(x, 0))) + + caption <- if (is.empty(input$view_tab_slice)) NULL else htmltools::tags$caption(glue(i18n$t("Table slice {input$view_tab_slice} will be applied on Download, Store, or Report"))) + + withProgress( + message = i18n$t("Generating view table"), value = 1, + DT::datatable( + dat, + filter = fbox, + selection = "none", + rownames = FALSE, + ## must use fillContainer = FALSE to address + ## see https://github.com/rstudio/DT/issues/367 + ## https://github.com/rstudio/DT/issues/379 + fillContainer = FALSE, + ## only works with client-side processing + # extension = "KeyTable", + escape = FALSE, + # editable = TRUE, + style = style, + options = list( + stateSave = TRUE, ## maintains state + searchCols = lapply(r_state$dataviewer_search_columns, function(x) list(search = x)), + search = list(search = search, regex = TRUE), + order = { + if (is.null(r_state$dataviewer_state$order)) { + list() + } else { + r_state$dataviewer_state$order + } + }, + columnDefs = list( + list(orderSequence = c("desc", "asc"), targets = "_all"), + list(className = "dt-center", targets = "_all") + ), + autoWidth = TRUE, + processing = isTRUE(fbox == "none"), + pageLength = { + if (is.null(r_state$dataviewer_state$length)) 10 else r_state$dataviewer_state$length + }, + lengthMenu = list(c(5, 10, 25, 50, -1), c("5", "10", "25", "50", i18n$t("All"))) + ), + caption = caption, + ## https://github.com/rstudio/DT/issues/146#issuecomment-534319155 + callback = DT::JS('$(window).on("unload", function() { table.state.clear(); }); ') + ) %>% + (function(x) if (sum(isDbl) > 0) DT::formatRound(x, names(isDbl)[isDbl], dec) else x) %>% + (function(x) if (sum(isInt) > 0) DT::formatRound(x, names(isInt)[isInt], 0) else x) + ) + }, + server = TRUE +) + +observeEvent(input$view_store, { + req(input$view_name) + data_filter <- if (input$show_filter) input$data_filter else "" + data_arrange <- if (input$show_filter) input$data_arrange else "" + data_rows <- if (input$show_filter) input$data_rows else "" + + dataset <- fix_names(input$view_name) + if (input$view_name != dataset) { + updateTextInput(session, inputId = "view_name", value = dataset) + } + + r_data[[dataset]] <- get_data( + input$dataset, + vars = input$view_vars, filt = data_filter, arr = data_arrange, + rows = data_rows, data_view_rows = input$dataviewer_rows_all, + na.rm = FALSE, envir = r_data + ) %>% + (function(x) if (is.empty(input$view_tab_slice)) x else slice_data(x, input$view_tab_slice)) + register(dataset) + updateSelectInput(session = session, inputId = "dataset", selected = input$dataset) + + if (input$dataset != dataset) { + ## See https://shiny.posit.co/reference/shiny/latest/modalDialog.html + showModal( + modalDialog( + title = i18n$t("Data Stored"), + span( + paste0(i18n$t("Dataset '"), dataset, i18n$t("' was successfully added to + the datasets dropdown. Add code to Report > Rmd or + Report > R to (re)create the dataset by clicking the report i + con on the bottom left of your screen.")) + ), + footer = modalButton(i18n$t("OK")), + size = "m", + easyClose = TRUE + ) + ) + } +}) + +dl_view_tab <- function(file) { + data_filter <- if (input$show_filter) input$data_filter else "" + data_arrange <- if (input$show_filter) input$data_arrange else "" + data_rows <- if (input$show_filter) input$data_rows else "" + get_data( + input$dataset, + vars = input$view_vars, + filt = data_filter, + arr = data_arrange, + rows = data_rows, + data_view_rows = input$dataviewer_rows_all, + na.rm = FALSE, + envir = r_data + ) %>% + (function(x) if (is.empty(input$view_tab_slice)) x else slice_data(x, input$view_tab_slice)) %>% + write.csv(file, row.names = FALSE) +} + +download_handler( + id = "dl_view_tab", + fun = dl_view_tab, + fn = function() { + ifelse(is.empty(input$view_name), paste0(input$dataset, i18n$t("_view")), input$view_name) + } +) + +.dataviewer <- reactive({ + list(tab = .get_data()[1, ]) +}) + +.viewcmd <- function(mess = "") { + ## get the state of the dt table + ts <- dt_state("dataviewer", vars = input$view_vars) + + if (is.empty(input$view_name)) { + dataset <- NULL + } else { + dataset <- fix_names(input$view_name) + if (input$view_name != dataset) { + updateTextInput(session, inputId = "view_name", value = dataset) + } + } + + cmd <- "" + + ## shorten list of variales if possible + vars <- input$view_vars + cn <- colnames(.dataviewer()$tab) + ind <- which(cn %in% vars) + + if (length(vars) == length(cn)) { + vars <- paste0(head(vars, 1), ":", tail(vars, 1)) + } else if ((max(ind) - min(ind) + 1) == length(vars)) { + vars <- paste0(cn[min(ind)], ":", cn[max(ind)]) + } else if (length(vars) > (length(cn) / 2)) { + vars <- paste0("-", base::setdiff(cn, vars), collapse = ", ") + } else { + vars <- paste0(vars, collapse = ", ") + } + + if (is.empty(dataset)) { + xcmd <- paste0(i18n$t(" dtab(")) + } else { + xcmd <- paste0(i18n$t("dtab("), dataset, ", ") + } + if (!is.empty(input$view_dec, 3)) { + xcmd <- paste0(xcmd, i18n$t("dec = "), input$view_dec, ", ") + } + if (!is.empty(r_state$dataviewer_state$length, 10)) { + xcmd <- paste0(xcmd, i18n$t("pageLength = "), r_state$dataviewer_state$length, ", ") + } + + ## create the command to filter and sort the data + if (is.empty(dataset)) { + cmd <- paste0(cmd, i18n$t("## filter and sort the dataset\n"), input$dataset) + } else { + cmd <- paste0(cmd, i18n$t("## filter and sort the dataset\n"), dataset, " <- ", input$dataset) + } + if (input$show_filter && !is.empty(input$data_filter)) { + cmd <- paste0(cmd, " %>%\n ", i18n$t("filter("), input$data_filter, ")") + } + if (input$show_filter && !is.empty(input$data_arrange)) { + cmd <- paste0(cmd, " %>%\n ", i18n$t("arrange("), make_arrange_cmd(input$data_arrange)) + } + if (input$show_filter && !is.empty(input$data_rows)) { + cmd <- paste0(cmd, " %>%\n ", i18n$t("slice("), input$data_rows, ")") + } + if (!is.empty(ts$search)) { + cmd <- paste0(cmd, " %>%\n filter(search_data(., \"", ts$search, "\"))") + } + if (!is.empty(ts$tabfilt)) { + cmd <- paste0(cmd, " %>%\n ", i18n$t("filter("), ts$tabfilt, ")") + } + if (!is.empty(ts$tabsort)) { + cmd <- paste0(cmd, " %>%\n ", i18n$t("arrange("), ts$tabsort, ")") + } + if (!is.empty(input$view_tab_slice)) { + cmd <- paste0(cmd, " %>%\n slice(", input$view_tab_slice, ")") + xcmd <- paste0(xcmd, i18n$t("caption = \"\") %>%\n render()")) + } else { + xcmd <- paste0(xcmd, i18n$t("caption = \"\", nr = 100) %>%\n render()")) + } + ## moved `select` to the end so filters can use variables + ## not selected for the final dataset + if (is.empty(dataset)) { + paste0(cmd, " %>%\n ", i18n$t("select("), vars, i18n$t(") %>%\n droplevels() %>%")) %>% + paste0("\n", xcmd) + } else { + ret <- paste0(cmd, " %>%\n ", i18n$t("select("), vars, i18n$t(") %>% droplevels()")) + if (dataset != input$dataset) { + ret <- paste0(ret, "\n", i18n$t("register(\""), dataset, "\", \"", input$dataset, "\")\n", xcmd) + } + ret + } +} + +view_report <- function() { + update_report(cmd = .viewcmd(), outputs = NULL, figs = FALSE) +} + +observeEvent(input$view_report, { + r_info[["latest_screenshot"]] <- NULL + view_report() +}) + +observeEvent(input$view_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_view_screenshot") +}) + +observeEvent(input$modal_view_screenshot, { + view_report() + removeModal() +}) diff --git a/radiant.data/inst/app/tools/data/visualize_ui.R b/radiant.data/inst/app/tools/data/visualize_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..522ead842532f03d2d78b8e37c3d99f3e7b08ed8 --- /dev/null +++ b/radiant.data/inst/app/tools/data/visualize_ui.R @@ -0,0 +1,585 @@ +############################################# +# 安全封装：避免 is.empty() 报错 +############################################# +safe_is_empty <- function(x) { + if (is.null(x) || !is.character(x)) return(TRUE) + is.empty(x) +} + +############################################# +# 其余代码保持不变，仅替换 is.empty() 调用 +############################################# + +viz_type <- c( + "分布图（dist）" = "dist", "密度图（density）" = "density", "散点图（scatter）" = "scatter", + "曲面图（surface）" = "surface", "折线图（line）" = "line", "条形图（bar）" = "bar", "箱线图（box）" = "box" +) +viz_check <- c( + "直线（line）" = "line", "局部加权回归（loess）" = "loess", + "抖动（jitter）" = "jitter", + "插值（interpolate）" = "interpolate" +) +viz_axes <- c( + "翻转坐标轴（flip）" = "flip", "X轴对数变换（log_x）" = "log_x", "Y轴对数变换（log_y）" = "log_y", + "Y轴缩放（scale_y）" = "scale_y", "密度（density）" = "density", "排序（sort）" = "sort" +) +viz_theme <- c( + "灰色主题（gray）" = "theme_gray", "黑白主题（bw）" = "theme_bw", + "明亮主题（light）" = "theme_light", "暗黑主题（dark）" = "theme_dark", + "极简主题（minimal）" = "theme_minimal", "经典主题（classic）" = "theme_classic" +) + +os_type <- Sys.info()["sysname"] +if (os_type == "Windows") { + fnt <- names(windowsFonts()) + names(fnt) <- tools::toTitleCase(fnt) + viz_base_family <- c("Theme default" = "", fnt) +} else { + viz_base_family <- c( + "Theme default" = "", "Helvetica" = "Helvetica", "Serif" = "serif", + "Sans" = "sans", "Mono" = "mono", "Courier" = "Courier", "Times" = "Times" + ) +} + +viz_labs <- c(i18n$t("title"), i18n$t("subtitle"), i18n$t("caption"), i18n$t("x"), i18n$t("y")) +viz_add_labs <- function() { + lab_list <- list() + for (l in viz_labs) { + inp <- input[[paste0("viz_labs_", l)]] + if (!safe_is_empty(inp)) lab_list[[l]] <- inp + } + lab_list +} + +viz_args <- as.list(formals(visualize)) + +viz_inputs <- reactive({ + viz_args$data_filter <- if (isTRUE(input$show_filter)) input$data_filter else "" + viz_args$arr <- if (isTRUE(input$show_filter)) input$data_arrange else "" + viz_args$rows <- if (isTRUE(input$show_filter)) input$data_rows else "" + viz_args$dataset <- input$dataset + viz_args$shiny <- input$shiny + viz_args$labs <- viz_add_labs() + for (i in r_drop(names(viz_args), drop = c(i18n$t("dataset"), i18n$t("data_filter"), i18n$t("arr"), i18n$t("rows"), i18n$t("labs")))) { + viz_args[[i]] <- input[[paste0("viz_", i)]] + } + viz_args +}) + +output$ui_viz_type <- renderUI({ + selectInput( + inputId = "viz_type", label = i18n$t("Plot-type:"), choices = viz_type, + selected = state_single("viz_type", viz_type), + multiple = FALSE + ) +}) + +output$ui_viz_nrobs <- renderUI({ + req(input$viz_type == "scatter") + nrobs <- nrow(.get_data()) + choices <- c("1,000" = 1000, "5,000" = 5000, "10,000" = 10000, "All" = -1) %>% + .[. < nrobs] + selectInput( + "viz_nrobs", i18n$t("Number of data points plotted:"), + choices = choices, + selected = state_single("viz_nrobs", choices, 1000) + ) +}) + +output$ui_viz_yvar <- renderUI({ + req(input$viz_type) + vars <- varying_vars() + req(available(vars)) + vars <- vars["date" != .get_class()[vars]] + if (input$viz_type %in% c("line", "bar", "scatter", "surface", "box")) { + vars <- vars["character" != .get_class()[vars]] + } + if (input$viz_type %in% c("box", "scatter")) { + vars <- vars["factor" != .get_class()[vars]] + } + selectInput( + inputId = "viz_yvar", label = i18n$t("Y-variable:"), + choices = vars, + selected = state_multiple("viz_yvar", vars, isolate(input$viz_yvar)), + multiple = TRUE, size = min(3, length(vars)), selectize = FALSE + ) +}) + +output$ui_viz_xvar <- renderUI({ + req(input$viz_type) + vars <- varying_vars() + req(available(vars)) + if (input$viz_type == "dist") vars <- vars["date" != .get_class()[vars]] + if (input$viz_type == "density") vars <- vars["factor" != .get_class()[vars]] + if (input$viz_type %in% c("box", "bar")) vars <- groupable_vars_nonum() + selectInput( + inputId = "viz_xvar", label = i18n$t("X-variable:"), choices = vars, + selected = state_multiple("viz_xvar", vars, isolate(input$viz_xvar)), + multiple = TRUE, size = min(3, length(vars)), selectize = FALSE + ) +}) + +output$ui_viz_comby <- renderUI({ + checkboxInput( + "viz_comby", i18n$t("Combine Y-variables in one plot"), + state_init("viz_comby", FALSE) + ) +}) + +output$ui_viz_combx <- renderUI({ + checkboxInput( + "viz_combx", i18n$t("Combine X-variables in one plot"), + state_init("viz_combx", FALSE) + ) +}) + +observeEvent(length(input$viz_xvar) < 2, { + updateCheckboxInput(session, "viz_combx", value = FALSE) +}) + +observeEvent(length(input$viz_yvar) < 2, { + updateCheckboxInput(session, "viz_comby", value = FALSE) +}) + +observeEvent(input$viz_type, { + if (input$viz_type %in% c("dist", "density")) { + updateCheckboxInput(session, "viz_comby", value = FALSE) + } else { + updateCheckboxInput(session, "viz_combx", value = FALSE) + } +}) + +observeEvent(input$viz_check, { + if (!"loess" %in% input$viz_check && input$viz_smooth != 1) { + updateSliderInput(session, "viz_smooth", value = 1) + } +}) + +output$ui_viz_facet_row <- renderUI({ + vars <- c("None" = ".", groupable_vars_nonum()) + selectizeInput( + "viz_facet_row", i18n$t("Facet row:"), vars, + selected = state_single("viz_facet_row", vars, init = "."), + multiple = FALSE + ) +}) + +output$ui_viz_facet_col <- renderUI({ + vars <- c("None" = ".", groupable_vars_nonum()) + selectizeInput( + "viz_facet_col", i18n$t("Facet column:"), vars, + selected = state_single("viz_facet_col", vars, init = "."), + multiple = FALSE + ) +}) + +output$ui_viz_color <- renderUI({ + req(input$viz_type) + if (input$viz_type == "line") { + vars <- c("None" = "none", groupable_vars()) + } else { + vars <- c("None" = "none", varnames()) + } + if (isTRUE(input$viz_comby) && length(input$viz_yvar) > 1) vars <- c("None" = "none") + selectizeInput( + "viz_color", i18n$t("Color:"), vars, + multiple = FALSE, + selected = state_single("viz_color", vars, init = "none") + ) +}) + +output$ui_viz_fill <- renderUI({ + vars <- c("None" = "none", groupable_vars()) + if (isTRUE(input$viz_combx) && length(input$viz_xvar) > 1) vars <- vars[1] + selectizeInput( + "viz_fill", i18n$t("Fill:"), vars, + multiple = FALSE, + selected = state_single("viz_fill", vars, init = "none") + ) +}) + +output$ui_viz_size <- renderUI({ + req(input$viz_type) + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- c("None" = "none", varnames()[isNum]) + if (isTRUE(input$viz_comby) && length(input$viz_yvar) > 1) vars <- c("None" = "none") + selectizeInput( + "viz_size", i18n$t("Size:"), vars, + multiple = FALSE, + selected = state_single("viz_size", vars, init = "none") + ) +}) + +output$ui_viz_axes <- renderUI({ + req(input$viz_type) + ind <- 1 + if (input$viz_type %in% c("line", "scatter", "surface")) { + ind <- 1:3 + } else if (input$viz_type == "dist") { + ind <- c(1:2, 5) + } else if (input$viz_type == "density") { + ind <- 1:2 + } else if (input$viz_type %in% c("bar", "box")) { + ind <- c(1, 3) + } + if (input$viz_facet_row != "." || input$viz_facet_col != ".") ind <- c(ind, 4) + if (input$viz_type == "bar") ind <- c(ind, 6) + + checkboxGroupInput( + "viz_axes", NULL, viz_axes[ind], + selected = state_group("viz_axes", ""), + inline = TRUE + ) +}) + +output$ui_viz_check <- renderUI({ + req(input$viz_type) + if (input$viz_type == "scatter") { + ind <- 1:3 + } else if (input$viz_type == "box") { + ind <- 3 + } else if (input$viz_type == "surface") { + ind <- 4 + } else { + ind <- c() + } + if (!input$viz_type %in% c("scatter", "box")) { + r_state$viz_check <<- gsub("jitter", "", r_state$viz_check) + } + if (input$viz_type != "scatter") { + r_state$viz_check <<- gsub("line", "", r_state$viz_check) + r_state$viz_check <<- gsub("loess", "", r_state$viz_check) + } + checkboxGroupInput( + "viz_check", NULL, viz_check[ind], + selected = state_group("viz_check", ""), + inline = TRUE + ) +}) + +output$ui_viz_run <- renderUI({ + req(input$dataset) + actionButton("viz_run", i18n$t("Create plot"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") +}) + +output$ui_viz_labs <- renderUI({ + req(input$dataset) + wellPanel( + textAreaInput("viz_labs_title", NULL, "", placeholder = i18n$t("Title"), rows = 1), + textAreaInput("viz_labs_subtitle", NULL, "", placeholder = i18n$t("Subtitle"), rows = 1), + textAreaInput("viz_labs_caption", NULL, "", placeholder = i18n$t("Caption"), rows = 1), + textAreaInput("viz_labs_y", NULL, "", placeholder = i18n$t("Y-label"), rows = 1), + textAreaInput("viz_labs_x", NULL, "", placeholder = i18n$t("X-label"), rows = 1) + ) +}) + +output$ui_viz_colors <- renderUI({ + tagList( + conditionalPanel( + condition = "input.viz_type == 'bar' || input.viz_type == 'dist' || input.viz_type == 'box' || input.viz_type == 'density'", + selectInput( + "viz_fillcol", i18n$t("Fill color:"), + choices = colors(), + selected = state_single("viz_fillcol", colors(), "blue") + ) + ), + conditionalPanel( + condition = "input.viz_type == 'dist' || input.viz_type == 'density' || input.viz_type == 'box' || input.viz_type == 'scatter' || input.viz_type == 'line'", + selectInput( + "viz_linecol", i18n$t("Line color:"), + choices = colors(), + selected = state_single("viz_linecol", colors(), "black") + ) + ), + conditionalPanel( + condition = "input.viz_type == 'scatter' || input.viz_type == 'line' || input.viz_type == 'box'", + selectInput( + "viz_pointcol", i18n$t("Point color:"), + choices = colors(), + selected = state_single("viz_pointcol", colors(), "black") + ) + ) + ) +}) + +run_refresh( + viz_args, "viz", + init = c("xvar", "yvar"), label = i18n$t("Create plot"), relabel = i18n$t("Update plot"), + inputs = c("labs_title", "labs_subtitle", "labs_caption", "labs_y", "labs_x") +) + +output$ui_Visualize <- renderUI({ + tagList( + wellPanel( + uiOutput("ui_viz_run") + ), + checkboxInput("viz_details_main", i18n$t("Main"), state_init("viz_details_main", TRUE)), + conditionalPanel( + "input.viz_details_main == true", + wellPanel( + uiOutput("ui_viz_type"), + conditionalPanel( + "input.viz_type == 'scatter'", + uiOutput("ui_viz_nrobs") + ), + conditionalPanel( + condition = "input.viz_type != 'dist' && input.viz_type != 'density'", + uiOutput("ui_viz_yvar"), + conditionalPanel( + "input.viz_yvar != undefined && input.viz_yvar != null && input.viz_yvar.length > 1", + uiOutput("ui_viz_comby") + ) + ), + uiOutput("ui_viz_xvar"), + conditionalPanel( + "input.viz_type == 'dist' || input.viz_type == 'density'", + conditionalPanel( + "input.viz_xvar != undefined && input.viz_xvar != null && input.viz_xvar.length > 1", + uiOutput("ui_viz_combx") + ) + ), + uiOutput("ui_viz_facet_row"), + uiOutput("ui_viz_facet_col"), + conditionalPanel( + condition = "input.viz_type == 'bar' || input.viz_type == 'dist' || input.viz_type == 'density' || input.viz_type == 'surface'", + uiOutput("ui_viz_fill") + ), + conditionalPanel( + condition = "input.viz_type == 'scatter' || input.viz_type == 'line' || input.viz_type == 'box'", + uiOutput("ui_viz_color") + ), + conditionalPanel( + condition = "input.viz_type == 'scatter'", + uiOutput("ui_viz_size") + ), + conditionalPanel( + condition = "input.viz_type == 'bar' || input.viz_type == 'scatter' || input.viz_type == 'line'", + selectInput( + "viz_fun", i18n$t("Function:"), + choices = getOption("radiant.functions"), + selected = state_single("viz_fun", getOption("radiant.functions"), "mean") + ) + ), + conditionalPanel( + condition = "input.viz_type == 'scatter' || input.viz_type == 'line' || input.viz_type == 'surface' || input.viz_type == 'box'", + uiOutput("ui_viz_check") + ), + uiOutput("ui_viz_axes"), + conditionalPanel( + condition = "input.viz_type == 'dist'", + sliderInput( + "viz_bins", + label = i18n$t("Number of bins:"), + value = state_init("viz_bins", 10), + min = 2, max = 50, step = 1 + ) + ), + conditionalPanel( + "input.viz_type == 'density' || input.viz_type == 'dist' && (input.viz_axes && input.viz_axes.indexOf('density')) >= 0 || (input.viz_type == 'scatter' && (input.viz_check && input.viz_check.indexOf('loess') >= 0))", + sliderInput( + "viz_smooth", + label = i18n$t("Smooth:"), + value = state_init("viz_smooth", 1), + min = 0.1, max = 3, step = .1 + ) + ) + ) + ), + checkboxInput("viz_details_labels", i18n$t("Labels"), state_init("viz_details_labels", FALSE)), + conditionalPanel( + "input.viz_details_labels == true", + uiOutput("ui_viz_labs") + ), + checkboxInput("viz_details_style", i18n$t("Style"), state_init("viz_details_style", FALSE)), + conditionalPanel( + "input.viz_details_style == true", + wellPanel( + selectInput( + "viz_theme", i18n$t("Plot theme:"), + choices = viz_theme, + selected = state_single("viz_theme", viz_theme, "theme_gray") + ), + numericInput( + "viz_base_size", i18n$t("Base font size:"), + value = state_init("viz_base_size", 11) + ), + selectInput( + "viz_base_family", i18n$t("Font family:"), + choices = viz_base_family, + selected = state_single("viz_base_family", viz_base_family, "helvetica") + ), + uiOutput("ui_viz_colors"), + sliderInput( + "viz_alpha", + label = i18n$t("Opacity:"), + value = state_init("viz_alpha", .5), + min = 0, max = 1, step = .01 + ), + tags$table( + tags$td( + numericInput( + "viz_plot_height", + label = i18n$t("Plot height:"), min = 100, + max = 2000, step = 50, + value = state_init("viz_plot_height", r_info[["plot_height"]]), + width = "117px" + ) + ), + tags$td( + numericInput( + "viz_plot_width", + label = i18n$t("Plot width:"), min = 100, + max = 2000, step = 50, + value = state_init("viz_plot_width", r_info[["plot_width"]]), + width = "117px" + ), + width = "100%" + ) + ) + ) + ), + help_and_report( + modal_title = i18n$t("Visualize"), + fun_name = "visualize", + help_file = inclRmd(file.path(getOption("radiant.path.data"), "app/tools/help/visualize.md")), + lic = "by-sa" + ) + ) +}) + +viz_plot_width <- reactive({ + if (safe_is_empty(input$viz_plot_width)) r_info[["plot_width"]] else input$viz_plot_width +}) + +viz_plot_height <- eventReactive( + { + input$viz_run + input$viz_plot_height + input$viz_plot_width + }, + { + if (safe_is_empty(input$viz_plot_height)) { + r_info[["plot_height"]] + } else { + lx <- ifelse(not_available(input$viz_xvar) || isTRUE(input$viz_combx), 1, length(input$viz_xvar)) + ly <- ifelse(not_available(input$viz_yvar) || input$viz_type %in% c("dist", "density") || isTRUE(input$viz_comby), 1, length(input$viz_yvar)) + nr <- lx * ly + if (nr > 1) { + (input$viz_plot_height / 2) * ceiling(nr / 2) + } else { + input$viz_plot_height + } + } + } +) + +output$visualize <- renderPlot({ + req(input$viz_type) + p <- .visualize() + if (is.null(p)) return(NULL) + print(p) +}, width = viz_plot_width, height = viz_plot_height, res = 96) + +.visualize <- eventReactive(input$viz_run, { + req(input$viz_type) + if (input$viz_type == "scatter") req(input$viz_nrobs) + req(input$viz_plot_height && input$viz_plot_width) + + if (not_available(input$viz_xvar) && !input$viz_type %in% c("box", "line")) { + return(NULL) + } + if (input$viz_type %in% c("scatter", "line", "box", "bar", "surface") && not_available(input$viz_yvar)) { + return(NULL) + } + + vizi <- viz_inputs() + vizi$dataset <- input$dataset + vizi$shiny <- TRUE + vizi$envir <- r_data + + withProgress(message = i18n$t("Making plot"), value = 1, { + p <- do.call(visualize, vizi) + if (is.character(p)) return(NULL) + p + }) +}) + +visualize_report <- function() { + vi <- viz_inputs() + if (input$viz_type != "dist") { + vi$bins <- viz_args$bins + } + if (input$viz_type %in% c("dist", "density")) { + vi$yvar <- viz_args$yvar + } + if (!input$viz_type %in% c("density", "scatter", "dist") || + !("loess" %in% input$viz_check || "density" %in% input$viz_axes || input$viz_type == "density")) { + vi$smooth <- viz_args$smooth + } + if (!input$viz_type %in% c("scatter", "box") && "jitter" %in% input$viz_check) { + vi$check <- base::setdiff(vi$check, "jitter") + } + if (input$viz_type != "scatter") { + vi$size <- "none" + vi$nrobs <- NULL + } else { + vi$nrobs <- as_integer(vi$nrobs) + } + if (!input$viz_type %in% c("scatter", "line", "box")) { + vi$color <- NULL + } + if (!input$viz_type %in% c("bar", "dist", "density", "surface")) { + vi$fill <- NULL + } + if (!input$viz_type %in% c("bar", "dist", "box", "density")) { + vi$fillcol <- "blue" + } + if (!input$viz_type %in% c("dist", "density", "box", "scatter", "line")) { + vi$linecol <- "black" + } + if (!input$viz_type %in% c("box", "scatter", "line")) { + vi$pointcol <- "black" + } + if (!input$viz_type %in% c("bar", "line", "scatter")) { + vi$fun <- "mean" + } + if (safe_is_empty(input$data_rows)) { + vi$rows <- NULL + } + inp_main <- c(clean_args(vi, viz_args), custom = FALSE) + update_report( + inp_main = inp_main, + fun_name = "visualize", + outputs = character(0), + pre_cmd = "", + figs = TRUE, + fig.width = viz_plot_width(), + fig.height = viz_plot_height() + ) +} + +download_handler( + id = "dlp_visualize", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_visualize"), + type = "png", + caption = i18n$t("Save visualize plot"), + plot = .visualize, + width = viz_plot_width, + height = viz_plot_height +) + +observeEvent(input$visualize_report, { + r_info[["latest_screenshot"]] <- NULL + visualize_report() +}) + +observeEvent(input$visualize_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_visualize_screenshot") +}) + +observeEvent(input$modal_visualize_screenshot, { + visualize_report() + removeModal() +}) \ No newline at end of file diff --git a/radiant.data/inst/app/tools/help/combine.Rmd b/radiant.data/inst/app/tools/help/combine.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..d42dfc749d7fdc05a12bffabae05f7f503f3e360 --- /dev/null +++ b/radiant.data/inst/app/tools/help/combine.Rmd @@ -0,0 +1,1056 @@ +> 合并两个数据集 + +Radiant 中提供了六种来自 Hadley Wickham 等人开发的dplyr包的 “连接（join）”（或 “合并（merge）”）选项。 + +以下示例改编自 Jenny Bryan 的《dplyr 连接函数速查表》，聚焦三个小型数据集（superheroes、publishers和avengers），以说明 R 和 Radiant 中不同的连接类型及其他数据集合并方式。这些数据也可通过以下链接获取 csv 格式文件： + +* superheroes.csv +* publishers.csv +* avengers.csv + +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    Superheroes
    name alignment gender publisher
    Magneto bad male Marvel
    Storm good female Marvel
    Mystique bad female Marvel
    Batman good male DC
    Joker bad male DC
    Catwoman bad female DC
    Hellboy good male Dark Horse Comics
    + + + + + + + + + + + + + + + + + + + + + + + +
    Publishers
    publisher yr_founded
    DC 1934
    Marvel 1939
    Image 1992
    + +在下方`数据>合并` 标签页的截图中，我们可以看到两个数据集。这两个表格共享 “出版商（publisher）” 变量，该变量会被自动选为连接键。`合并方式` 下拉菜单中提供了不同的连接选项。你也可以在 `合并后的数据集名称` 文本输入框中指定合并后数据集的名称。 + +

    + +
    + +### 内连接（超级英雄 × 出版商） + +若 x = 超级英雄数据集，y = 出版商数据集： + +> 内连接返回 x 中与 y 有匹配值的所有行，以及 x 和 y 的所有列。若 x 和 y 之间存在多个匹配，所有匹配组合都会被返回。 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    name alignment gender publisher yr_founded
    Magneto bad male Marvel 1939
    Storm good female Marvel 1939
    Mystique bad female Marvel 1939
    Batman good male DC 1934
    Joker bad male DC 1934
    Catwoman bad female DC 1934
    + +在上述表格中，我们丢失了 “地狱男爵（Hellboy）”，因为尽管这个英雄出现在`superheroes`数据集中，但其出版商（黑马漫画）未出现在`publishers`数据集中。连接结果包含`superheroes`的所有变量，以及来自`publishers`的 “成立年份（yr_founded）” 变量。我们可以用下方的维恩图可视化内连接： + +

    + +R（Radiant）命令如下： + +```r +# Radiant +combine_data(superheroes, publishers, by = "publisher", type = "inner_join") + +# R +inner_join(superheroes, publishers, by = "publisher") +``` + +
    + +### 左连接（超级英雄 × 出版商） + +> 左连接返回 x 的所有行，以及 x 和 y 的所有列。若 x 和 y 之间存在多个匹配，所有匹配组合都会被返回。 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    name alignment gender publisher yr_founded
    Magneto bad male Marvel 1939
    Storm good female Marvel 1939
    Mystique bad female Marvel 1939
    Batman good male DC 1934
    Joker bad male DC 1934
    Catwoman bad female DC 1934
    Hellboy good male Dark Horse Comics NA
    + +连接结果包含`superheroes`的所有数据，以及来自`publishers`的 “成立年份（yr_founded）” 变量。“地狱男爵” 的出版商未出现在`publishers`中，因此其 “成立年份” 为`NA`。我们可以用下方的维恩图可视化左连接： + +

    + +R（Radiant）命令如下： + +```r +# Radiant +combine_data(superheroes, publishers, by = "publisher", type = "left_join") + +# R +left_join(superheroes, publishers, by = "publisher") +``` + +
    + +### 右连接（超级英雄 × 出版商） + +> 右连接返回 y 的所有行，以及 y 和 x 的所有列。若 y 和 x 之间存在多个匹配，所有匹配组合都会被返回。 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    name alignment gender publisher yr_founded
    Magneto bad male Marvel 1939
    Storm good female Marvel 1939
    Mystique bad female Marvel 1939
    Batman good male DC 1934
    Joker bad male DC 1934
    Catwoman bad female DC 1934
    NA NA NA Image 1992
    + +连接结果包含`publishers`的所有行和列，以及`superheroes`的所有变量。我们丢失了 “地狱男爵”，因为其出版商未出现在`publishers`中。“图像漫画（Image）” 被保留在表格中，但来自`superheroes`的 “姓名（name）”“阵营（alignment）” 和 “性别（gender）” 变量为`NA`。请注意，连接可能会改变行和变量的顺序，因此在分析中不应依赖这些顺序。我们可以用下方的维恩图可视化右连接： + +

    + +R（Radiant）命令如下： + +```r +# Radiant +combine_data(superheroes, publishers, by = "publisher", type = "right_join") + +# R +right_join(superheroes, publishers, by = "publisher") +``` + +
    + +### 全连接（超级英雄 × 出版商） + +> 全连接合并两个数据集，保留出现在任一数据集中的行和列。 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    name alignment gender publisher yr_founded
    Magneto bad male Marvel 1939
    Storm good female Marvel 1939
    Mystique bad female Marvel 1939
    Batman good male DC 1934
    Joker bad male DC 1934
    Catwoman bad female DC 1934
    Hellboy good male Dark Horse Comics NA
    NA NA NA Image 1992
    + +在这个表格中，我们保留了 “地狱男爵”（即使 “黑马漫画” 不在`publishers`中）和 “图像漫画”（即使该出版商未在`superheroes`中列出），并获取了两个数据集的变量。没有匹配项的观测在来自另一个数据集的变量中被赋值为 NA。我们可以用下方的维恩图可视化全连接： + +

    + +R（Radiant）命令如下： + +```r +# Radiant +combine_data(superheroes, publishers, by = "publisher", type = "full_join") + +# R +full_join(superheroes, publishers, by = "publisher") +``` + +### 半连接（超级英雄 × 出版商） + +> 半连接仅保留 x 中的列。内连接会为 x 中每个与 y 匹配的行返回一行，而半连接绝不会复制 x 中的行。 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    name alignment gender publisher
    Magneto bad male Marvel
    Storm good female Marvel
    Mystique bad female Marvel
    Batman good male DC
    Joker bad male DC
    Catwoman bad female DC
    + +我们得到了与`内连接`类似的表格，但仅包含`superheroes`中的变量。R（Radiant）命令如下： + +```r +# Radiant +combine_data(superheroes, publishers, by = "publisher", type = "semi_join") + +# R +semi_join(superheroes, publishers, by = "publisher") +``` + +
    + +### 反连接（超级英雄 × 出版商） + +> 反连接返回 x 中与 y 无匹配值的所有行，仅保留 x 中的列。 + + + + + + + + + + + + + + + + + + +
    name alignment gender publisher
    Hellboy good male Dark Horse Comics
    + +现在我们**只**得到了 `地狱男爵`—— 唯一未在`publishers`中找到对应出版商的超级英雄，且未包含 “成立年份（yr_founded）” 变量。我们可以用下方的维恩图可视化反连接： + +

    + +
    + +### 数据集顺序 + +请注意，所选数据集的顺序可能会影响连接结果。如果我们如下设置 `数据> 合并` 标签页，结果如下： + +

    + +
    + +### 内连接（出版商 × 超级英雄） + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    publisher yr_founded name alignment gender
    DC 1934 Batman good male
    DC 1934 Joker bad male
    DC 1934 Catwoman bad female
    Marvel 1939 Magneto bad male
    Marvel 1939 Storm good female
    Marvel 1939 Mystique bad female
    + +每个在`superheroes`中有匹配项的出版商都会多次出现，每个匹配项对应一行。除变量和行的顺序外，这与上方显示的内连接结果相同。 + +
    + +### 左连接和右连接（出版商 × 超级英雄） + +除行和变量顺序外，`publishers`与`superheroes`的左连接等价于`superheroes`与`publishers`的右连接。同样，`publishers`与`superheroes`的右连接等价于`superheroes`与`publishers`的左连接。 + +
    + +### 全连接（出版商 × 超级英雄） + +如你所料，除行和变量顺序外，`publishers`与`superheroes`的全连接等价于`superheroes`与`publishers`的全连接。 + +
    + +### 半连接（出版商 × 超级英雄） + + + + + + + + + + + + + + + + + + +
    publisher yr_founded
    DC 1934
    Marvel 1939
    + +通过半连接，交换数据集顺序的影响更为明显。尽管每个出版商有多个匹配项，但仅显示一次。与之对比，内连接中 “若 x 和 y 之间存在多个匹配，所有匹配组合都会被返回”。表格中丢失了出版商 “图像漫画（Image）”，因为它不在`superheroes`中。 + +
    + +### 反连接（出版商 × 超级英雄） + + + + + + + + + + + + + + +
    publisher yr_founded
    Image 1992
    + +仅保留了出版商 “图像漫画”，因为 “漫威” 和 “DC” 都在`superheroes`中。我们只保留了`publishers`中的变量。 + +
    + +### 合并数据集的其他工具（复仇者 × 超级英雄） + +当两个数据集具有相同的列（或行）时，还有其他方法可将它们合并为新数据集。我们已使用过`superheroes`数据集，现在尝试将其与`avengers`数据合并。这两个数据集的行数和列数相同，且列名相同。 + +在下方 “数据> 合并” 标签页的截图中，我们可以看到这两个数据集。此处无需选择变量来合并数据集，`选择变量` 中的任何变量在下方命令中都会被忽略。同样，你可以在 `合并后的数据集` 文本输入框中指定合并后数据集的名称。 + +

    + +
    + +### 行绑定 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    name alignment gender publisher
    Thor good male Marvel
    Iron Man good male Marvel
    Hulk good male Marvel
    Hawkeye good male Marvel
    Black Widow good female Marvel
    Captain America good male Marvel
    Magneto bad male Marvel
    Magneto bad male Marvel
    Storm good female Marvel
    Mystique bad female Marvel
    Batman good male DC
    Joker bad male DC
    Catwoman bad female DC
    Hellboy good male Dark Horse Comics
    + +如果`avengers`数据集旨在扩展超级英雄列表，我们可以将两个数据集上下堆叠。新数据集有 14 行和 4 列。由于`avengers`数据集中的编码错误（万磁王并非复仇者），新合并的数据集中出现了重复行，这可能是我们不希望看到的。 + +R（Radiant）命令如下： + +```r +# Radiant +combine_data(avengers, superheroes, type = "bind_rows") + +# R +bind_rows(avengers, superheroes) +``` + +
    + +### 列绑定 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    name...1 alignment...2 gender...3 publisher...4 name...5 alignment...6 gender...7 publisher...8
    Thor good male Marvel Magneto bad male Marvel
    Iron Man good male Marvel Storm good female Marvel
    Hulk good male Marvel Mystique bad female Marvel
    Hawkeye good male Marvel Batman good male DC
    Black Widow good female Marvel Joker bad male DC
    Captain America good male Marvel Catwoman bad female DC
    Magneto bad male Marvel Hellboy good male Dark Horse Comics
    + +如果数据集为相同超级英雄包含不同列，我们可以将两个数据集并排合并。在 Radiant 中，若尝试绑定同名列，会看到错误消息，这是我们应始终避免的情况。若已知两个数据集的行 ID 顺序相同但列完全不同，此方法可能有用。 + +
    + +### 交集 + + + + + + + + + + + + + + + + + + +
    name alignment gender publisher
    Magneto bad male Marvel
    + +检查两个具有相同列的数据集是否有重复行的好方法是从`合并方式` 下拉菜单中选择 `交集`。`avengers`和`superheroes`数据中确实有一行完全相同（即万磁王）。 + +R（Radiant）命令与上方所示相同，只需将`bind_rows`替换为`intersect`。 + +
    + +### 并集 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    name alignment gender publisher
    Thor good male Marvel
    Iron Man good male Marvel
    Hulk good male Marvel
    Hawkeye good male Marvel
    Black Widow good female Marvel
    Captain America good male Marvel
    Magneto bad male Marvel
    Storm good female Marvel
    Mystique bad female Marvel
    Batman good male DC
    Joker bad male DC
    Catwoman bad female DC
    Hellboy good male Dark Horse Comics
    +`avengers`和`superheroes`的 `并集` 会合并数据集，但会省略重复行（即仅保留万磁王的一行）。这可能是我们此处想要的结果。 + +R（Radiant）命令与上方所示相同，只需将`bind_rows`替换为`union`。 + +
    + +### 差集 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    name alignment gender publisher
    Thor good male Marvel
    Iron Man good male Marvel
    Hulk good male Marvel
    Hawkeye good male Marvel
    Black Widow good female Marvel
    Captain America good male Marvel
    +最后，`差集` 会保留`avengers`中不在`superheroes`中的行。若交换输入（即从 `数据集` 下拉菜单中选择`superheroes`，从 `合并对象` 下拉菜单中选择`superheroes`），最终会得到`superheroes`中不在`avengers`中的所有行。两种情况下，万磁王的条目都会被省略。 + +R（Radiant）命令与上方所示相同，只需将`bind_rows`替换为`setdiff`。 + +
    + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建合并后的数据集。 + +更多相关讨论请参见《R for data science》中关于关系数据的章节点击查看和Tidy Explain。 + +### R 函数 + +有关`combine_data`函数的帮助，请参见*数据 > 合并*。 diff --git a/radiant.data/inst/app/tools/help/combine.md b/radiant.data/inst/app/tools/help/combine.md new file mode 100644 index 0000000000000000000000000000000000000000..d42dfc749d7fdc05a12bffabae05f7f503f3e360 --- /dev/null +++ b/radiant.data/inst/app/tools/help/combine.md @@ -0,0 +1,1056 @@ +> 合并两个数据集 + +Radiant 中提供了六种来自 Hadley Wickham 等人开发的dplyr包的 “连接（join）”（或 “合并（merge）”）选项。 + +以下示例改编自 Jenny Bryan 的《dplyr 连接函数速查表》，聚焦三个小型数据集（superheroes、publishers和avengers），以说明 R 和 Radiant 中不同的连接类型及其他数据集合并方式。这些数据也可通过以下链接获取 csv 格式文件： + +* superheroes.csv +* publishers.csv +* avengers.csv + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    Superheroes
    name alignment gender publisher
    Magneto bad male Marvel
    Storm good female Marvel
    Mystique bad female Marvel
    Batman good male DC
    Joker bad male DC
    Catwoman bad female DC
    Hellboy good male Dark Horse Comics
    + + + + + + + + + + + + + + + + + + + + + + + +
    Publishers
    publisher yr_founded
    DC 1934
    Marvel 1939
    Image 1992
    + +在下方`数据>合并` 标签页的截图中，我们可以看到两个数据集。这两个表格共享 “出版商（publisher）” 变量，该变量会被自动选为连接键。`合并方式` 下拉菜单中提供了不同的连接选项。你也可以在 `合并后的数据集名称` 文本输入框中指定合并后数据集的名称。 + +

    + +
    + +### 内连接（超级英雄 × 出版商） + +若 x = 超级英雄数据集，y = 出版商数据集： + +> 内连接返回 x 中与 y 有匹配值的所有行，以及 x 和 y 的所有列。若 x 和 y 之间存在多个匹配，所有匹配组合都会被返回。 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    name alignment gender publisher yr_founded
    Magneto bad male Marvel 1939
    Storm good female Marvel 1939
    Mystique bad female Marvel 1939
    Batman good male DC 1934
    Joker bad male DC 1934
    Catwoman bad female DC 1934
    + +在上述表格中，我们丢失了 “地狱男爵（Hellboy）”，因为尽管这个英雄出现在`superheroes`数据集中，但其出版商（黑马漫画）未出现在`publishers`数据集中。连接结果包含`superheroes`的所有变量，以及来自`publishers`的 “成立年份（yr_founded）” 变量。我们可以用下方的维恩图可视化内连接： + +

    + +R（Radiant）命令如下： + +```r +# Radiant +combine_data(superheroes, publishers, by = "publisher", type = "inner_join") + +# R +inner_join(superheroes, publishers, by = "publisher") +``` + +
    + +### 左连接（超级英雄 × 出版商） + +> 左连接返回 x 的所有行，以及 x 和 y 的所有列。若 x 和 y 之间存在多个匹配，所有匹配组合都会被返回。 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    name alignment gender publisher yr_founded
    Magneto bad male Marvel 1939
    Storm good female Marvel 1939
    Mystique bad female Marvel 1939
    Batman good male DC 1934
    Joker bad male DC 1934
    Catwoman bad female DC 1934
    Hellboy good male Dark Horse Comics NA
    + +连接结果包含`superheroes`的所有数据，以及来自`publishers`的 “成立年份（yr_founded）” 变量。“地狱男爵” 的出版商未出现在`publishers`中，因此其 “成立年份” 为`NA`。我们可以用下方的维恩图可视化左连接： + +

    + +R（Radiant）命令如下： + +```r +# Radiant +combine_data(superheroes, publishers, by = "publisher", type = "left_join") + +# R +left_join(superheroes, publishers, by = "publisher") +``` + +
    + +### 右连接（超级英雄 × 出版商） + +> 右连接返回 y 的所有行，以及 y 和 x 的所有列。若 y 和 x 之间存在多个匹配，所有匹配组合都会被返回。 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    name alignment gender publisher yr_founded
    Magneto bad male Marvel 1939
    Storm good female Marvel 1939
    Mystique bad female Marvel 1939
    Batman good male DC 1934
    Joker bad male DC 1934
    Catwoman bad female DC 1934
    NA NA NA Image 1992
    + +连接结果包含`publishers`的所有行和列，以及`superheroes`的所有变量。我们丢失了 “地狱男爵”，因为其出版商未出现在`publishers`中。“图像漫画（Image）” 被保留在表格中，但来自`superheroes`的 “姓名（name）”“阵营（alignment）” 和 “性别（gender）” 变量为`NA`。请注意，连接可能会改变行和变量的顺序，因此在分析中不应依赖这些顺序。我们可以用下方的维恩图可视化右连接： + +

    + +R（Radiant）命令如下： + +```r +# Radiant +combine_data(superheroes, publishers, by = "publisher", type = "right_join") + +# R +right_join(superheroes, publishers, by = "publisher") +``` + +
    + +### 全连接（超级英雄 × 出版商） + +> 全连接合并两个数据集，保留出现在任一数据集中的行和列。 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    name alignment gender publisher yr_founded
    Magneto bad male Marvel 1939
    Storm good female Marvel 1939
    Mystique bad female Marvel 1939
    Batman good male DC 1934
    Joker bad male DC 1934
    Catwoman bad female DC 1934
    Hellboy good male Dark Horse Comics NA
    NA NA NA Image 1992
    + +在这个表格中，我们保留了 “地狱男爵”（即使 “黑马漫画” 不在`publishers`中）和 “图像漫画”（即使该出版商未在`superheroes`中列出），并获取了两个数据集的变量。没有匹配项的观测在来自另一个数据集的变量中被赋值为 NA。我们可以用下方的维恩图可视化全连接： + +

    + +R（Radiant）命令如下： + +```r +# Radiant +combine_data(superheroes, publishers, by = "publisher", type = "full_join") + +# R +full_join(superheroes, publishers, by = "publisher") +``` + +### 半连接（超级英雄 × 出版商） + +> 半连接仅保留 x 中的列。内连接会为 x 中每个与 y 匹配的行返回一行，而半连接绝不会复制 x 中的行。 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    name alignment gender publisher
    Magneto bad male Marvel
    Storm good female Marvel
    Mystique bad female Marvel
    Batman good male DC
    Joker bad male DC
    Catwoman bad female DC
    + +我们得到了与`内连接`类似的表格，但仅包含`superheroes`中的变量。R（Radiant）命令如下： + +```r +# Radiant +combine_data(superheroes, publishers, by = "publisher", type = "semi_join") + +# R +semi_join(superheroes, publishers, by = "publisher") +``` + +
    + +### 反连接（超级英雄 × 出版商） + +> 反连接返回 x 中与 y 无匹配值的所有行，仅保留 x 中的列。 + + + + + + + + + + + + + + + + + + +
    name alignment gender publisher
    Hellboy good male Dark Horse Comics
    + +现在我们**只**得到了 `地狱男爵`—— 唯一未在`publishers`中找到对应出版商的超级英雄，且未包含 “成立年份（yr_founded）” 变量。我们可以用下方的维恩图可视化反连接： + +

    + +
    + +### 数据集顺序 + +请注意，所选数据集的顺序可能会影响连接结果。如果我们如下设置 `数据> 合并` 标签页，结果如下： + +

    + +
    + +### 内连接（出版商 × 超级英雄） + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    publisher yr_founded name alignment gender
    DC 1934 Batman good male
    DC 1934 Joker bad male
    DC 1934 Catwoman bad female
    Marvel 1939 Magneto bad male
    Marvel 1939 Storm good female
    Marvel 1939 Mystique bad female
    + +每个在`superheroes`中有匹配项的出版商都会多次出现，每个匹配项对应一行。除变量和行的顺序外，这与上方显示的内连接结果相同。 + +
    + +### 左连接和右连接（出版商 × 超级英雄） + +除行和变量顺序外，`publishers`与`superheroes`的左连接等价于`superheroes`与`publishers`的右连接。同样，`publishers`与`superheroes`的右连接等价于`superheroes`与`publishers`的左连接。 + +
    + +### 全连接（出版商 × 超级英雄） + +如你所料，除行和变量顺序外，`publishers`与`superheroes`的全连接等价于`superheroes`与`publishers`的全连接。 + +
    + +### 半连接（出版商 × 超级英雄） + + + + + + + + + + + + + + + + + + +
    publisher yr_founded
    DC 1934
    Marvel 1939
    + +通过半连接，交换数据集顺序的影响更为明显。尽管每个出版商有多个匹配项，但仅显示一次。与之对比，内连接中 “若 x 和 y 之间存在多个匹配，所有匹配组合都会被返回”。表格中丢失了出版商 “图像漫画（Image）”，因为它不在`superheroes`中。 + +
    + +### 反连接（出版商 × 超级英雄） + + + + + + + + + + + + + + +
    publisher yr_founded
    Image 1992
    + +仅保留了出版商 “图像漫画”，因为 “漫威” 和 “DC” 都在`superheroes`中。我们只保留了`publishers`中的变量。 + +
    + +### 合并数据集的其他工具（复仇者 × 超级英雄） + +当两个数据集具有相同的列（或行）时，还有其他方法可将它们合并为新数据集。我们已使用过`superheroes`数据集，现在尝试将其与`avengers`数据合并。这两个数据集的行数和列数相同，且列名相同。 + +在下方 “数据> 合并” 标签页的截图中，我们可以看到这两个数据集。此处无需选择变量来合并数据集，`选择变量` 中的任何变量在下方命令中都会被忽略。同样，你可以在 `合并后的数据集` 文本输入框中指定合并后数据集的名称。 + +

    + +
    + +### 行绑定 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    name alignment gender publisher
    Thor good male Marvel
    Iron Man good male Marvel
    Hulk good male Marvel
    Hawkeye good male Marvel
    Black Widow good female Marvel
    Captain America good male Marvel
    Magneto bad male Marvel
    Magneto bad male Marvel
    Storm good female Marvel
    Mystique bad female Marvel
    Batman good male DC
    Joker bad male DC
    Catwoman bad female DC
    Hellboy good male Dark Horse Comics
    + +如果`avengers`数据集旨在扩展超级英雄列表，我们可以将两个数据集上下堆叠。新数据集有 14 行和 4 列。由于`avengers`数据集中的编码错误（万磁王并非复仇者），新合并的数据集中出现了重复行，这可能是我们不希望看到的。 + +R（Radiant）命令如下： + +```r +# Radiant +combine_data(avengers, superheroes, type = "bind_rows") + +# R +bind_rows(avengers, superheroes) +``` + +
    + +### 列绑定 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    name...1 alignment...2 gender...3 publisher...4 name...5 alignment...6 gender...7 publisher...8
    Thor good male Marvel Magneto bad male Marvel
    Iron Man good male Marvel Storm good female Marvel
    Hulk good male Marvel Mystique bad female Marvel
    Hawkeye good male Marvel Batman good male DC
    Black Widow good female Marvel Joker bad male DC
    Captain America good male Marvel Catwoman bad female DC
    Magneto bad male Marvel Hellboy good male Dark Horse Comics
    + +如果数据集为相同超级英雄包含不同列，我们可以将两个数据集并排合并。在 Radiant 中，若尝试绑定同名列，会看到错误消息，这是我们应始终避免的情况。若已知两个数据集的行 ID 顺序相同但列完全不同，此方法可能有用。 + +
    + +### 交集 + + + + + + + + + + + + + + + + + + +
    name alignment gender publisher
    Magneto bad male Marvel
    + +检查两个具有相同列的数据集是否有重复行的好方法是从`合并方式` 下拉菜单中选择 `交集`。`avengers`和`superheroes`数据中确实有一行完全相同（即万磁王）。 + +R（Radiant）命令与上方所示相同，只需将`bind_rows`替换为`intersect`。 + +
    + +### 并集 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    name alignment gender publisher
    Thor good male Marvel
    Iron Man good male Marvel
    Hulk good male Marvel
    Hawkeye good male Marvel
    Black Widow good female Marvel
    Captain America good male Marvel
    Magneto bad male Marvel
    Storm good female Marvel
    Mystique bad female Marvel
    Batman good male DC
    Joker bad male DC
    Catwoman bad female DC
    Hellboy good male Dark Horse Comics
    +`avengers`和`superheroes`的 `并集` 会合并数据集，但会省略重复行（即仅保留万磁王的一行）。这可能是我们此处想要的结果。 + +R（Radiant）命令与上方所示相同，只需将`bind_rows`替换为`union`。 + +
    + +### 差集 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    name alignment gender publisher
    Thor good male Marvel
    Iron Man good male Marvel
    Hulk good male Marvel
    Hawkeye good male Marvel
    Black Widow good female Marvel
    Captain America good male Marvel
    +最后，`差集` 会保留`avengers`中不在`superheroes`中的行。若交换输入（即从 `数据集` 下拉菜单中选择`superheroes`，从 `合并对象` 下拉菜单中选择`superheroes`），最终会得到`superheroes`中不在`avengers`中的所有行。两种情况下，万磁王的条目都会被省略。 + +R（Radiant）命令与上方所示相同，只需将`bind_rows`替换为`setdiff`。 + +
    + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建合并后的数据集。 + +更多相关讨论请参见《R for data science》中关于关系数据的章节点击查看和Tidy Explain。 + +### R 函数 + +有关`combine_data`函数的帮助，请参见*数据 > 合并*。 diff --git a/radiant.data/inst/app/tools/help/explore.md b/radiant.data/inst/app/tools/help/explore.md new file mode 100644 index 0000000000000000000000000000000000000000..4334aa7777001bdbf6e9a2351b701092a25bf971 --- /dev/null +++ b/radiant.data/inst/app/tools/help/explore.md @@ -0,0 +1,40 @@ +> 汇总和探索你的数据 + +为数据中的一个或多个变量生成汇总统计量。“数据> 探索” 中最强大的功能是，你可以轻松地按一个或多个其他变量来描述数据。 _数据> 透视_ 标签页最适合生成频数表和汇总单个数值变量，而 “数据 > 探索” 标签页允许你使用各种统计量同时汇总多个变量。 + +例如，如果我们从`diamonds`数据集中选择`price`并点击 `生成表格` 按钮，就可以看到观测数（n）、均值、方差等统计量。此外，通过选择`clarity`作为 `分组变量`，也可以轻松获取每种钻石净度水平的平均价格。 + +> 注意，当分类变量（`factor`）从`数值变量` 下拉菜单中被选中时，若所选函数需要，该变量将被转换为数值变量。如果因子水平是数值型的，这些数值将用于所有计算。由于均值、标准差等统计量对非二元分类变量不适用，这类变量将被转换为 0-1（二元）变量，其中第一个水平编码为 1，其他所有水平编码为 0。 + +生成的汇总表格可以通过点击 “存储” 按钮存储到 Radiant 中。如果你想在 “数据 > 可视化” 中基于汇总数据创建图表，这会很有用。要将表格下载为 csv 格式，点击右上角的下载图标。 + +你可以从 `列标题` 下拉菜单中选择选项，切换不同的列标题。可选择 `应用函数`（如均值、中位数等）、`分组变量`（如价格、克拉等），或（首个）`分组依据` 变量的水平（如 Fair-Ideal）。 + +

    + +## 函数 + +以下是 `应用函数`下拉菜单中几个函数的简要说明。不过，大多数函数的含义不言自明。 + +* `n`计算数据中的观测数（或行数）；若选择了 “分组依据（Group by）” 变量，则计算每组中的观测数（`n`使用 R 中的`length`函数） +* `n_distinct`计算不同值的数量 +* `n_missing`计算缺失值的数量 +* `cv`是变异系数（即 mean (x) /sd (x)） +* `sd`和`var`计算数值数据的样本标准差和方差 +* `me`使用 95% 置信水平计算数值变量的误差边际 +* `prop`计算比例。对于仅含 0 或 1 值的变量，其结果等同于`mean`。对于其他数值变量，它计算最大值的出现比例。对于`factor`，它计算第一个水平的出现比例。 +* `sdprop`和`varprop`计算比例的样本标准差和方差 +* `meprop`使用 95% 置信水平计算比例的误差边际 +* `sdpop`和`varpop`计算总体标准差和方差 + +### 过滤数据 + +使用 `过滤数据`框选择（或排除）数据中的特定行集。详见 `数据 > 查看` 的帮助文件。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建汇总表格。 + +### R 函数 + +有关 Radiant 中用于汇总和探索数据的相关 R 函数概述，请参见*数据 > 探索* 。 \ No newline at end of file diff --git a/radiant.data/inst/app/tools/help/figures/anti_join.png b/radiant.data/inst/app/tools/help/figures/anti_join.png new file mode 100644 index 0000000000000000000000000000000000000000..3d232d5e0c202cd77eed50e22406e736e2b35a46 Binary files /dev/null and b/radiant.data/inst/app/tools/help/figures/anti_join.png differ diff --git a/radiant.data/inst/app/tools/help/figures/boxplot.png b/radiant.data/inst/app/tools/help/figures/boxplot.png new file mode 100644 index 0000000000000000000000000000000000000000..72fe58b0bcbb2065c68fe72ae8c1ca2f1bde3232 Binary files /dev/null and b/radiant.data/inst/app/tools/help/figures/boxplot.png differ diff --git a/radiant.data/inst/app/tools/help/figures/combine_avengers_superheroes.png b/radiant.data/inst/app/tools/help/figures/combine_avengers_superheroes.png new file mode 100644 index 0000000000000000000000000000000000000000..bcdba9eed61e3e40cb7ce9a2d4495187210d8c9d Binary files /dev/null and b/radiant.data/inst/app/tools/help/figures/combine_avengers_superheroes.png differ diff --git a/radiant.data/inst/app/tools/help/figures/combine_publishers_superheroes.png b/radiant.data/inst/app/tools/help/figures/combine_publishers_superheroes.png new file mode 100644 index 0000000000000000000000000000000000000000..2c649924b58a704fada01f09ee499ec967104f1d Binary files /dev/null and b/radiant.data/inst/app/tools/help/figures/combine_publishers_superheroes.png differ diff --git a/radiant.data/inst/app/tools/help/figures/combine_superheroes_publishers.png b/radiant.data/inst/app/tools/help/figures/combine_superheroes_publishers.png new file mode 100644 index 0000000000000000000000000000000000000000..c1083c85c2149113a9ae9c30eaa48daaf37ff744 Binary files /dev/null and b/radiant.data/inst/app/tools/help/figures/combine_superheroes_publishers.png differ diff --git a/radiant.data/inst/app/tools/help/figures/expand_grid.png b/radiant.data/inst/app/tools/help/figures/expand_grid.png new file mode 100644 index 0000000000000000000000000000000000000000..4c4246c7a2b2c70d1f2b6d3984ae6fed15c77f2b Binary files /dev/null and b/radiant.data/inst/app/tools/help/figures/expand_grid.png differ diff --git a/radiant.data/inst/app/tools/help/figures/explore.png b/radiant.data/inst/app/tools/help/figures/explore.png new file mode 100644 index 0000000000000000000000000000000000000000..c384f3d3c03897f39b8bafb5d0bcdd16e4458aa4 Binary files /dev/null and b/radiant.data/inst/app/tools/help/figures/explore.png differ diff --git a/radiant.data/inst/app/tools/help/figures/full_join.png b/radiant.data/inst/app/tools/help/figures/full_join.png new file mode 100644 index 0000000000000000000000000000000000000000..775fcf4e5f85ec1e2f3e87a0a7531a79cf348dcc Binary files /dev/null and b/radiant.data/inst/app/tools/help/figures/full_join.png differ diff --git a/radiant.data/inst/app/tools/help/figures/inner_join.png b/radiant.data/inst/app/tools/help/figures/inner_join.png new file mode 100644 index 0000000000000000000000000000000000000000..cb775f49c47a437781cc7505c891d0adfdcf0e33 Binary files /dev/null and b/radiant.data/inst/app/tools/help/figures/inner_join.png differ diff --git a/radiant.data/inst/app/tools/help/figures/left_join.png b/radiant.data/inst/app/tools/help/figures/left_join.png new file mode 100644 index 0000000000000000000000000000000000000000..d20c1b1cbbbf7ed9d280a1683442235b430c0c01 Binary files /dev/null and b/radiant.data/inst/app/tools/help/figures/left_join.png differ diff --git a/radiant.data/inst/app/tools/help/figures/outer_join.png b/radiant.data/inst/app/tools/help/figures/outer_join.png new file mode 100644 index 0000000000000000000000000000000000000000..775fcf4e5f85ec1e2f3e87a0a7531a79cf348dcc Binary files /dev/null and b/radiant.data/inst/app/tools/help/figures/outer_join.png differ diff --git a/radiant.data/inst/app/tools/help/figures/pivotr.png b/radiant.data/inst/app/tools/help/figures/pivotr.png new file mode 100644 index 0000000000000000000000000000000000000000..423fec5631d07476feba0bbb1d32397f0531fd05 Binary files /dev/null and b/radiant.data/inst/app/tools/help/figures/pivotr.png differ diff --git a/radiant.data/inst/app/tools/help/figures/rbbbot.jpg b/radiant.data/inst/app/tools/help/figures/rbbbot.jpg new file mode 100644 index 0000000000000000000000000000000000000000..c1236a92702985871d56ae243bf5e9a3cef4e0d4 Binary files /dev/null and b/radiant.data/inst/app/tools/help/figures/rbbbot.jpg differ diff --git a/radiant.data/inst/app/tools/help/figures/right_join.png b/radiant.data/inst/app/tools/help/figures/right_join.png new file mode 100644 index 0000000000000000000000000000000000000000..e6b29ee183deaf2e374502a7b5b567bababe0f8e Binary files /dev/null and b/radiant.data/inst/app/tools/help/figures/right_join.png differ diff --git a/radiant.data/inst/app/tools/help/manage.html b/radiant.data/inst/app/tools/help/manage.html new file mode 100644 index 0000000000000000000000000000000000000000..3f387737618ce0e20d6ff178fce7741fa4aae5aa --- /dev/null +++ b/radiant.data/inst/app/tools/help/manage.html @@ -0,0 +1,389 @@ + + + + + + + + + + + + + +manage.utf8.md + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    + + + + + + + + + + + + + + +
    +

    Manage data and state: Load data into Radiant, Save data to disk, Remove a dataset from memory, or Save/Load the state of the app

    +
    +
    +

    Datasets

    +

    When you first start Radiant a dataset (diamonds) with information on diamond prices is shown.

    +

    It is good practice to add a description of the data and variables to each file you use. For the files that are bundled with Radiant you will see a brief overview of the variables etc. below a table of the first 10 rows of the data. To add a description for your own data click the Add/edit data description check-box. A text-input box will open below the table where you can add text in markdown format. The description provided for the diamonds data included with Radiant should serve as a good example. After adding or editing a description click the Update description button.

    +

    To rename a dataset loaded in Radiant click the Rename data check box, enter a new name, and click the Rename button

    +
    +
    +

    Load data

    +

    The best way to load and save data for use in Radiant (and R) is to use the R-data format (rds or rda). These are binary files that can be stored compactly and read into R quickly. Select rds (or rda) from the Load data of type dropdown and click Browse to locate the file(s) you want to load on your computer.

    +

    You can get data from a spreadsheet (e.g., Excel or Google sheets) into Radiant in two ways. First, you can save data from the spreadsheet in csv format and then, in Radiant, choose csv from the Load data of type dropdown. Most likely you will have a header row in the csv file with variable names. If the data are not comma separated you can choose semicolon or tab separated. To load a csv file click ‘Browse’ and locate the file on your computer.

    +
    +

    Note: For Windows users with data that contain multibyte characters please make sure your data are in ANSI format so R(adiant) can load the characters correctly.

    +
    +

    Alternatively, you can select and copy the data in the spreadsheet using CTRL-C (or CMD-C on mac), go to Radiant, choose clipboard from the Load data of type dropdown, and click the Paste button. This is a short-cut that can be convenient for smaller datasets that are cleanly formatted.

    +

    If the data is available in R’s global workspace (e.g., you opened a data set in Rstudio and then started Radiant from the addins menu) you can move (or copy) it to Radiant by selecting from global workspace. Select the data.frame(s) you want to use and click the Load button.

    +

    To access all data files bundled with Radiant choose examples from the Load data of type dropdown and then click the Load button. These files are used to illustrate the various data and analysis tools accessible in Radiant. For example, the avengers and publishers data are used to illustrate how to combine data in R(adiant) (i.e., Data > Combine).

    +

    If csv data is available online choose csv (url) from the dropdown, paste the url into the text input shown, and press Load. If an rda file is available online choose rda (url) from the dropdown, paste the url into the text input, and press Load.

    +
    +
    +

    Save data

    +

    As mentioned above, the most convenient way to get data in and out of Radiant is to use the R-data format (rds or rda). Choose rds (or rda) from the Save data to type dropdown and click the Save button to save the selected dataset to file.

    +

    Again, it is good practice to add a description of the data and variables to each file you use. To add a description for your own data click the ‘Add/edit data description’ check-box, add text to the text-input window shown in markdown format, and then click the Update description button. When you save the data as an rds (or rda) file the description you created (or edited) will automatically be added to the file as an attribute.

    +

    Getting data from Radiant into a spreadsheet can be achieved in two ways. First, you can save data in csv format and load the file into the spreadsheet (i.e., choose csv from the Save data to type dropdown and click the Save button). Alternatively, you can copy the data from Radiant into the clipboard by choosing clipboard from the dropdown and clicking the Copy button, open the spreadsheet, and paste the data from Radiant using CTRL-V (or CMD-V on mac).

    +

    To move or copy data from Radiant into R’s global workspace select to global workspace from the Save data to type dropdown and click the Save button.

    +
    +
    +

    Save and load state

    +

    It is convenient to work with state files if you want complete your work at another time, perhaps on another computer, or to review previous work you completed using Radiant. You can save and load the state of the Radiant app just as you would a data file. The state file (extension .rda) will contain (1) the data loaded in Radiant, (2) settings for the analyses you were working on, (3) and any reports or code from the Report menu. To save the current state of the app to your hard-disk click the icon in the navbar and then click Save radiant state file. To load load a previous state click the icon in the navbar and the click Load radiant state file.

    +

    You can also share a state file with others that would like to replicate your analyses. As an example, download and then load the state file radiant-state.rda as described above. You will navigate automatically to the Data > Visualize tab and will see a plot. See also the Data > View tab for some additional settings loaded from the state file. There is also a report in Report > Rmd created using the Radiant interface. The html file radiant-state.html contains the output created by clicking the Knit report button.

    +

    Loading and saving state also works with Rstudio. If you start Radiant from Rstudio and use and then click Stop, the r_data environment and the r_info and r_state lists will be put into Rstudio’s global workspace. If you start radiant again from the Addins menu it will use r_data, r_info, and r_state to restore state. Also, if you load a state file directly into Rstudio it will be used when you start Radiant.

    +

    Use Refresh in the menu in the navbar to return to a clean/new state.

    +
    +
    +

    Remove data from memory

    +

    If data are loaded in memory that you no longer need in the current session check the Remove data from memory box. Then select the data to remove and click the Remove data button. One datafile will always remain open.

    +
    +
    +

    Using commands to load and save data

    +

    R-code can be used in Report > Rmd or Report > R to load data from a file directly into the active Radiant session. Use register("insert-dataset-name") to add a dataset to the Datasets dropdown. R-code can also be used to extract data from Radiant and save it to disk.

    +
    +
    +

    R-functions

    +

    For an overview of related R-functions used by Radiant to load and save data see Data > Manage

    +
    + + + + +
    + + + + + + + + diff --git a/radiant.data/inst/app/tools/help/manage.md b/radiant.data/inst/app/tools/help/manage.md new file mode 100644 index 0000000000000000000000000000000000000000..55a2cc77782eaec16de8e1d9bcf7dfe798480fe2 --- /dev/null +++ b/radiant.data/inst/app/tools/help/manage.md @@ -0,0 +1,55 @@ +> 数据和状态管理：将数据加载到 Radiant、将数据保存到磁盘、从内存中移除数据集，或保存 / 加载应用状态 + +### 数据集 + +首次启动 Radiant 时，会显示一个包含钻石价格信息的数据集（`diamonds`）。 + +为你使用的每个文件添加数据和变量描述是良好的实践。对于 Radiant 自带的文件，在数据前 10 行的表格下方，你会看到变量等的简要概述。要为自己的数据添加描述，点击 `添加 / 编辑数据描述`复选框。表格下方会打开一个文本输入框，你可以在其中以markdown格式添加文本。Radiant 自带的`diamonds`数据的描述应能作为良好示例。添加或编辑描述后，点击 `更新描述` 按钮。 + +要重命名 Radiant 中已加载的数据集，点击 `重命名数据` 复选框，输入新名称，然后点击 `重命名`按钮。 + +### 加载数据 + +在 Radiant（和 R）中加载和保存数据的最佳方式是使用 R 数据格式（rds 或 rda）。这些是二进制文件，可紧凑存储且能快速读入 R。从 `加载数据类型` 下拉菜单中选择`rds`（或`rda`），点击 `浏览` 找到你要在电脑上加载的文件。 + +有两种方法可将电子表格（如 Excel 或 Google 表格）中的数据导入 Radiant。第一种，你可以将电子表格中的数据保存为 csv 格式，然后在 Radiant 中从`加载数据类型` 下拉菜单中选择`csv`。你的 csv 文件很可能有包含变量名的标题行。如果数据不是用逗号分隔的，你可以选择分号或制表符分隔。要加载 csv 文件，点击 `浏览` 并在电脑上找到该文件。 + +另外，你可以在电子表格中使用 CTRL-C（或 Mac 上的 CMD-C）选择并复制数据，转到 Radiant，从 `加载数据类型` 下拉菜单中选择`剪贴板`，然后点击 `粘贴` 按钮。对于格式清晰的小型数据集，这是个便捷的捷径。 + +如果数据在 R 的全局工作区中可用（例如，你在 RStudio 中打开了一个数据集，然后从 “插件（addins）” 菜单启动了 Radiant），你可以通过选择 “from global workspace”（从全局工作区）将其移动（或复制）到 Radiant。选择你要使用的数据框，然后点击 `加载` 按钮。 + +要访问 Radiant 自带的所有数据文件，从 “加载数据类型” 下拉菜单中选择`examples`（示例），然后点击 “加载” 按钮。这些文件用于演示 Radiant 中各种数据和分析工具。例如，`avengers`和`publishers`数据用于演示如何在 R（adiant）中合并数据（即 “数据> 合并”）。 + +如果 csv 数据在线可用，从下拉菜单中选择`csv (url)`，将网址粘贴到显示的文本输入框中，然后按 `加载`。如果 rda 文件在线可用，从下拉菜单中选择`rda (url)`，将网址粘贴到文本输入框中，然后按 `加载`。 + +### 保存数据 + +如前所述，在 Radiant 中导入和导出数据最便捷的方式是使用 R 数据格式（rds 或 rda）。从 `保存数据类型` 下拉菜单中选择`rds`（或`rda`），点击 `保存` 按钮将所选数据集保存到文件。 + +同样，为你使用的每个文件添加数据和变量描述是良好的实践。要为自己的数据添加描述，点击 `添加 / 编辑数据描述` 复选框，在文本输入窗口中以markdown格式添加文本，然后点击 `更新描述` 按钮。当你将数据保存为 `rds`（或` rda`）文件时，你创建（或编辑）的描述会自动作为`attribute`（属性）添加到文件中。 + +将数据从 Radiant 导入电子表格有两种方法。第一种，你可以将数据保存为 csv 格式，然后将文件加载到电子表格中（即从 “保存数据类型” 下拉菜单中选择`csv`，点击 “保存” 按钮）。另外，你可以通过从下拉菜单中选择`剪贴板`，点击 `复制` 按钮，将数据从 Radiant 复制到剪贴板，打开电子表格，使用 CTRL-V（或 Mac 上的 CMD-V）将 Radiant 中的数据粘贴进去。 + +要将数据从 Radiant 移动或复制到 R（studio）的全局工作区，从 “保存数据类型” 下拉菜单中选择`到全局工作空间`，点击 `保存` 按钮。 + +### 保存和加载状态 + +如果你想在其他时间（可能在另一台电脑上）完成工作，或回顾之前使用 Radiant 完成的工作，使用状态文件会很方便。你可以像保存数据文件一样保存和加载 Radiant 应用的状态。状态文件（扩展名为`.state.rda`）将包含：（1）Radiant 中加载的数据；（2）你正在进行的分析设置；（3）“报告（Report）” 菜单中的所有报告或代码。要将应用的当前状态保存到硬盘，点击导航栏中的图标，然后点击 `保存 Radiant 状态文件`。要加载之前的状态，点击导航栏中的图标，然后点击`加载 Radiant 状态文件`。 + +你也可以与想要复现你分析的人共享状态文件。例如，下载然后按上述方法加载状态文件radiant-example.state.rda。你会自动导航到 “数据> 可视化” 标签页并看到一个图表。也可查看 “数据 > 查看” 标签页，获取从状态文件加载的其他设置。“报告 > Rmd” 中还有一个使用 Radiant 界面创建的报告。html 文件radiant-example.nb.html包含点击`编译报告` 按钮生成的输出。 + +状态的加载和保存也适用于 RStudio。如果你从 RStudio 启动 Radiant，使用然后点击 `停止`，`r_data`环境以及`r_info`和`r_state`列表会放入 RStudio 的全局工作区。如果你从 “插件（Addins）” 菜单再次启动 Radiant，它会使用`r_data`、`r_info`和`r_state`恢复状态。此外，如果你直接在 RStudio 中加载状态文件，启动 Radiant 时会使用该文件。 + +使用导航栏中菜单中的 `刷新` 可返回到干净 / 新状态。 + +### 从内存中移除数据 + +如果内存中加载了当前会话不再需要的数据，勾选 `从内存中移除数据`框。然后选择要移除的数据，点击 `移除数据` 按钮。始终会保留一个数据文件。 + +### 使用命令加载和保存数据 + +在 “报告> Rmd” 或 “报告 > R” 中，可使用 R 代码将数据从文件直接加载到活跃的 Radiant 会话中。使用`register("insert-dataset-name")`将数据集添加到 “数据集（Datasets）” 下拉菜单中。也可使用 R 代码从 Radiant 提取数据并保存到磁盘。 + +### R 函数 + +有关 Radiant 中用于加载和保存数据的相关 R 函数概述，请参见*数据 > 管理* 。 diff --git a/radiant.data/inst/app/tools/help/pivotr.md b/radiant.data/inst/app/tools/help/pivotr.md new file mode 100644 index 0000000000000000000000000000000000000000..3d6f91a75d6fb786baf23a8648b34661e27f7708 --- /dev/null +++ b/radiant.data/inst/app/tools/help/pivotr.md @@ -0,0 +1,44 @@ +> 创建透视表以探索你的数据 + +如果你使用过 Excel 中的透视表，那么 “数据> 透视表” 标签页提供的功能对你来说会很熟悉。与“数据> 探索”标签页类似，你可以为数据中的变量生成汇总统计量，也可以生成频数表。“数据> 透视” 中最强大的功能或许是，你可以轻松地**按**一个或多个其他变量来描述数据。 + +例如，加载`diamonds`数据后，从 `分类变量` 下拉菜单中选择`clarity`和`cut`。第一个变量的类别将作为列标题，但你可以通过拖放所选变量来更改它们的顺序。选择这两个变量并点击 `生成透视表`按钮后，会显示不同净度和切工等级钻石的频数表。从 `归一化方式` 下拉菜单中选择 `行`、`列` 或 `总计`，可按行、列或总计数对单元格频数进行归一化，或根据汇总统计量创建指数。如果选择了归一化选项，勾选 `百分比` 框将数值表示为百分比会很方便。从 `条件格式化` 下拉菜单中选择 `色条` 或 `热力图`，可突出显示最高频数。 + +I也可以汇总数值变量。从 `数值变量`下拉菜单中选择`price`，将生成下方所示的表格。就像在“数据> 查看”标签页中一样，你可以通过点击列标题对表格排序。你也可以使用滑块（例如，点击`I1`下方的输入框）将视图限制在指定范围内的值。要仅查看切工为 “Very good”“Premium” 或 “Ideal” 的钻石信息，点击`cut`标题下方的输入框。 + +

    + +以下是 “应用函数（Apply function）” 下拉菜单中几个函数的简要说明。不过，大多数函数的含义不言自明。 + +* `n`计算数据中的观测数（或行数）；若指定了 “分组依据（Group by）” 变量，则计算每组中的观测数（`n`使用 R 中的`length`函数） +* `n_distinct`计算不同值的数量 +* `n_missing`计算缺失值的数量 +* `cv`是变异系数（即 mean (x) /sd (x)） +* `sd`和`var`计算数值数据的样本标准差和方差 +* `me`使用 95% 置信水平计算数值变量的误差边际 +* `prop`计算比例。对于仅含 0 或 1 值的变量，其结果等同于`mean`。对于其他数值变量，它计算最大值的出现比例。对于`factor`，它计算第一个水平的出现比例。 +* `sdprop`和`varprop`计算比例的样本标准差和方差 +* `meprop`使用 95% 置信水平计算比例的误差边际 +* `sdpop`和`varpop`计算总体标准差和方差 + +你也可以基于生成的表格创建条形图（见上图）。要下载 csv 格式的表格或 png 格式的图表，点击右侧相应的下载图标。 + +> 注意，当分类变量（`factor`）从 `数值变量` 下拉菜单中被选中时，若所选函数需要，该变量将被转换为数值变量。如果因子水平是数值型的，这些数值将用于所有计算。由于均值、标准差等统计量对非二元分类变量不适用，这类变量将被转换为 0-1（二元）变量，其中第一个水平编码为 1，其他所有水平编码为 0。 + +### 过滤数据 + +使用 “过滤数据（Filter data）” 框选择（或排除）数据中要制表的特定行集。详见“数据> 查看（Data > View）”的帮助文件。 + +### 存储 + +生成的透视表可以通过点击 `存储` 按钮存储到 Radiant 中。如果你想对表格进行进一步分析，或在“数据> 可视化”中基于汇总数据创建图表，这会很有用。要将表格下载为 csv 格式，点击右上角的下载图标。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向“报告> Rmd”添加代码以（重新）创建透视表。 + +如果已创建图表，可使用`ggplot2`命令进行自定义（例如，`plot(result) + labs(title = "透视图表")`）。详情请参见“数据> 可视化”。 + +### R 函数 + +有关 Radiant 中用于创建透视表的相关 R 函数概述，请参见“数据> 透视” 。 diff --git a/radiant.data/inst/app/tools/help/report_r.Rmd b/radiant.data/inst/app/tools/help/report_r.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..ead51cea047d3ae1a16ee0dac18dbce3c2d40c30 --- /dev/null +++ b/radiant.data/inst/app/tools/help/report_r.Rmd @@ -0,0 +1,71 @@ +> 使用 R 创建（可重复的）报告 + +“报告> R” 标签页允许你运行 R 代码，且可访问 Radiant 中的所有函数和数据。点击`编译报告（R）`按钮后，代码将被执行，输出结果会显示在 “报告> R” 页面的右侧。要仅执行部分代码，用光标选中该部分并按`CTRL-enter`（Mac 上为`CMD-enter`）。 + +你可以通过点击 “加载报告（Load report）” 按钮并选择.r 或.R 文件，将 R 代码文件加载到 Radiant 中。如果你从 RStudio 启动 Radiant，可以通过从下拉菜单中选择所需格式并点击 “保存报告（Save report）” 按钮，将报告保存为 HTML、Word 或 PDF 格式。要仅保存代码，从下拉菜单中选择`R`并按 “保存报告” 按钮。 + +如果你从 RStudio 启动 Radiant，还可以点击 “读取文件（Read files）” 按钮浏览文件并生成将其读入 Radiant 的代码。例如，读取 rda、rds、xls、yaml 和 feather 格式的文件，并将它们添加到 “数据集（Datasets）” 下拉菜单中。如果你想要加载的文件类型当前不支持，将返回文件路径。使用的文件路径将相对于 RStudio 项目根目录。同步到本地 Dropbox 或 Google Drive 文件夹的文件路径将使用`find_dropbox`和`find_gdrive`函数，以增强可重复性。 + +例如，你可以将下方代码复制粘贴到编辑器中，然后按`Knit report (R)`生成结果。 + +```r +## get the active dataset and show the first few observations +.get_data() %>% + head() + +## access a dataset +diamonds %>% + select(price, clarity) %>% + head() + +## add a variable to the diamonds data +diamonds <- mutate(diamonds, log_price = log(price)) + +## show the first observations in the price and log_price columns +diamonds %>% + select(price, log_price) %>% + head() + +## create a histogram of prices +diamonds %>% + ggplot(aes(x = price)) + + geom_histogram() + +## and a histogram of log-prices using radiant.data::visualize +visualize(diamonds, xvar = "log_price", custom = TRUE) + +## open help in the R-studio viewer from Radiant +help(package = "radiant.data") + +## If you are familiar with Shiny you can call reactives when the code +## is evaluated inside a Shiny app. For example, if you transformed +## some variables in Data > Transform you can call the transform_main +## reacive to see the latest result. Very useful for debugging +# transform_main() %>% head() +head() +``` + +## 选项 + +“报告> Rmd” 和 “报告 > R” 中使用的编辑器有多个选项可在`.Rprofile`中设置。 + +```r +options(radiant.ace_vim.keys = FALSE) +options(radiant.ace_theme = "cobalt") +options(radiant.ace_tabSize = 2) +options(radiant.ace_useSoftTabs = TRUE) +options(radiant.ace_showInvisibles = TRUE) +options(radiant.ace_autoComplete = "live") +``` + +说明： + +- `vim.keys`启用一组特殊的键盘快捷键。如果你从未使用过 VIM，可能不需要开启此选项 +- 有关可用的编辑器主题概述，参见：`shinyAce::getAceThemes()` +- 默认情况下，制表符会转换为 2 个空格（即 “软” 制表符）。你可以将使用的空格数从 2 更改为例如 4 +- `showInvisibles`在编辑器中显示制表符和空格 +- 自动完成有 “live”“enabled” 和 “disabled” 三个选项 + +### R 函数 + +有关 Radiant 中用于生成可重复报告的相关 R 函数概述，请参见*报告* 。 diff --git a/radiant.data/inst/app/tools/help/report_r.md b/radiant.data/inst/app/tools/help/report_r.md new file mode 100644 index 0000000000000000000000000000000000000000..ead51cea047d3ae1a16ee0dac18dbce3c2d40c30 --- /dev/null +++ b/radiant.data/inst/app/tools/help/report_r.md @@ -0,0 +1,71 @@ +> 使用 R 创建（可重复的）报告 + +“报告> R” 标签页允许你运行 R 代码，且可访问 Radiant 中的所有函数和数据。点击`编译报告（R）`按钮后，代码将被执行，输出结果会显示在 “报告> R” 页面的右侧。要仅执行部分代码，用光标选中该部分并按`CTRL-enter`（Mac 上为`CMD-enter`）。 + +你可以通过点击 “加载报告（Load report）” 按钮并选择.r 或.R 文件，将 R 代码文件加载到 Radiant 中。如果你从 RStudio 启动 Radiant，可以通过从下拉菜单中选择所需格式并点击 “保存报告（Save report）” 按钮，将报告保存为 HTML、Word 或 PDF 格式。要仅保存代码，从下拉菜单中选择`R`并按 “保存报告” 按钮。 + +如果你从 RStudio 启动 Radiant，还可以点击 “读取文件（Read files）” 按钮浏览文件并生成将其读入 Radiant 的代码。例如，读取 rda、rds、xls、yaml 和 feather 格式的文件，并将它们添加到 “数据集（Datasets）” 下拉菜单中。如果你想要加载的文件类型当前不支持，将返回文件路径。使用的文件路径将相对于 RStudio 项目根目录。同步到本地 Dropbox 或 Google Drive 文件夹的文件路径将使用`find_dropbox`和`find_gdrive`函数，以增强可重复性。 + +例如，你可以将下方代码复制粘贴到编辑器中，然后按`Knit report (R)`生成结果。 + +```r +## get the active dataset and show the first few observations +.get_data() %>% + head() + +## access a dataset +diamonds %>% + select(price, clarity) %>% + head() + +## add a variable to the diamonds data +diamonds <- mutate(diamonds, log_price = log(price)) + +## show the first observations in the price and log_price columns +diamonds %>% + select(price, log_price) %>% + head() + +## create a histogram of prices +diamonds %>% + ggplot(aes(x = price)) + + geom_histogram() + +## and a histogram of log-prices using radiant.data::visualize +visualize(diamonds, xvar = "log_price", custom = TRUE) + +## open help in the R-studio viewer from Radiant +help(package = "radiant.data") + +## If you are familiar with Shiny you can call reactives when the code +## is evaluated inside a Shiny app. For example, if you transformed +## some variables in Data > Transform you can call the transform_main +## reacive to see the latest result. Very useful for debugging +# transform_main() %>% head() +head() +``` + +## 选项 + +“报告> Rmd” 和 “报告 > R” 中使用的编辑器有多个选项可在`.Rprofile`中设置。 + +```r +options(radiant.ace_vim.keys = FALSE) +options(radiant.ace_theme = "cobalt") +options(radiant.ace_tabSize = 2) +options(radiant.ace_useSoftTabs = TRUE) +options(radiant.ace_showInvisibles = TRUE) +options(radiant.ace_autoComplete = "live") +``` + +说明： + +- `vim.keys`启用一组特殊的键盘快捷键。如果你从未使用过 VIM，可能不需要开启此选项 +- 有关可用的编辑器主题概述，参见：`shinyAce::getAceThemes()` +- 默认情况下，制表符会转换为 2 个空格（即 “软” 制表符）。你可以将使用的空格数从 2 更改为例如 4 +- `showInvisibles`在编辑器中显示制表符和空格 +- 自动完成有 “live”“enabled” 和 “disabled” 三个选项 + +### R 函数 + +有关 Radiant 中用于生成可重复报告的相关 R 函数概述，请参见*报告* 。 diff --git a/radiant.data/inst/app/tools/help/report_rmd.Rmd b/radiant.data/inst/app/tools/help/report_rmd.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..84669e0906bbb7cb4dc458e3230fda9e66967d0e --- /dev/null +++ b/radiant.data/inst/app/tools/help/report_rmd.Rmd @@ -0,0 +1,61 @@ +> 使用 Rmarkdown 创建（可重复的）报告 + +在 Radiant 中存储工作的最佳方式是使用 “报告> Rmd” 功能，并保存包含所有结果和设置的状态文件。Radiant 的报告功能应与大多数页面左下角显示的图标结合使用。 + +“报告> Rmd” 左侧的编辑器中，以**R 代码块**形式显示过往命令。这些 “代码块” 可包含你输入的 R 代码，或 Radiant 生成的代码（点击图标后添加到报告中）。所有代码块均以````{r}`开头，以`````结尾。 + +默认情况下，Radiant 会将你刚完成的分析所生成的 R 代码添加到报告底部。点击图标后，Radiant 默认会切换到 “报告> Rmd” 标签页。点击左侧编辑器窗口并向下滚动，即可看到生成的命令。 + +如果你想更精确地控制 Radiant 生成的 R 代码在报告中的位置，可在 “报告> Rmd” 标签页的相应下拉菜单中选择 `手动粘贴`而非 `自动粘贴`。选择 `手动粘贴` 后，点击时，代码会被复制到剪贴板，你可将其粘贴到编辑器窗口的任意位置。 + +如果你从 RStudio 启动 Radiant，还可选择将命令发送到 RStudio 中打开的 Rmarkdown（R 代码）文档，方法是在下拉菜单中选择 “> Rmd”（或 “> R”）而非 “自动粘贴” 或 “手动粘贴”。选择 “> Rmd” 后，“报告 > Rmd” 中的编辑器会隐藏（即 “仅预览”），点击 “编译报告（Rmd）” 会直接从 RStudio 获取文本和代码。 + +默认情况下，点击图标后，应用会切换到 “报告> Rmd” 标签页。但如果你不想在点击该图标后切换标签页，可在 “报告 > Rmd” 标签页的相应下拉菜单中选择 `不切换标签页`。当选择 “> Rmd” 时，“不切换标签页” 为默认选项。 + +你可以添加文本或额外命令来创建 Rmarkdown 文档。Rmarkdown 文件（扩展名为.Rmd）是纯文本文件，可在记事本（Windows）、文本编辑（Mac）、RStudio、Sublime Text 或任何其他文本编辑器中打开。请**不要**使用 Word 编辑 Rmarkdown 文件。 + +使用 Rmarkdown 的强大之处在于，你无需重新生成所有必要的 R 代码，就能快速复现整个分析。点击屏幕左上角的 “编译报告（Rmd）” 按钮后，分析输出会被（重新）生成并显示在 “报告 > Rmd” 页面的右侧。要仅执行报告的一部分，用光标选中该部分并按`CTRL-enter`（Mac 上为`CMD-enter`）生成（部分）输出。 + +你可以在代码块周围添加文本、项目符号、标题等，使用markdown格式描述和解释结果。如需交互式 markdown 教程，请访问[commonmark.org](https://commonmark.org)。 + +如果你从 RStudio 启动 Radiant，可将报告保存为多种格式（即笔记本、HTML、Word、PowerPoint 或 PDF）。有关生成 PowerPoint 演示文稿的更多信息，参见https://bookdown.org/yihui/rmarkdown/powerpoint-presentation.html。要保存编辑器中打开的 Rmarkdown 文件，选择 `Rmd`（或 `Rmd + Data(zip)`）并按 `保存报告` 按钮。之前保存的 Rmarkdown 文件可通过 `加载报告` 按钮加载到 Radiant 中。 + +你也可以点击 `读取文件` 按钮浏览文件，并生成将其读入 Radiant 的代码。例如，读取 rda、rds、xls、yaml 和 feather 格式的文件并将它们添加到 “数据集” 下拉菜单中。你还可以读取图像、R 代码和文本（如 Rmd 或 md）以包含在报告中。如果你想要加载的文件类型当前不支持，会返回文件路径。如果 Radiant 从 RStudio 项目启动，使用的文件路径将相对于项目根目录。同步到本地 Dropbox 或 Google Drive 文件夹的文件路径会使用`find_dropbox`和`find_gdrive`函数，以增强可重复性。 + +## 状态 + +保存分析和设置的最佳方式是，通过点击导航栏中的图标，然后点击 `保存 Radiant 状态文件`，将应用程序的 “状态” 保存到文件中。状态文件（扩展名为 rda）将包含：（1）Radiant 中加载的数据；（2）你正在进行的分析设置；（3）“报告 > Rmd” 和 “报告 > R” 中的所有报告或代码。将状态文件保存到硬盘，当你准备继续工作时，只需通过导航栏中的图标，然后点击 `加载 Radiant 状态文件`加载它即可。 + +如果你在课程中使用 Radiant，建议使用 “报告> Rmd” 功能完成作业和案例分析。完成后，点击 `保存报告` 按钮生成（HTML）笔记本（或 Word、PDF）报告。同时提交报告和状态文件。 + +## 选项 + +“报告> Rmd” 和 “报告 > R” 中使用的编辑器有多个选项可在`.Rprofile`中设置。你可以使用`usethis::edit_r_profile()`修改`.Rprofile`中的设置。 + +```r +options(radiant.ace_vim.keys = FALSE) +options(radiant.ace_theme = "cobalt") +options(radiant.ace_tabSize = 2) +options(radiant.ace_useSoftTabs = TRUE) +options(radiant.ace_showInvisibles = TRUE) +options(radiant.ace_autoComplete = "live") +options(radiant.powerpoint_style = "~/Dropbox/rmd-styles/style.potx") +options(radiant.word_style = "~/Dropbox/rmd-styles/style.docx") +options(radiant.theme = bslib::bs_theme(version = 4, bootswatch = "darkly")) +``` + +说明： + +* `vim.keys`启用一组特殊的键盘快捷键。如果你从未使用过 VIM，可能不需要开启此选项 +* 有关可用的编辑器主题概述，参见：`shinyAce::getAceThemes()` +* 默认情况下，制表符会转换为 2 个空格（即 “软制表符”）。你可以将使用的空格数从 2 更改为例如 4 +* `showInvisibles`在编辑器中显示制表符和空格 +* 自动完成有 “live”“enabled” 和 “disabled” 三个选项 +* Radiant 对 Word 和 PowerPoint 文件有默认样式。不过，这些样式可替换为你创建的样式文件。点击下方链接将 Radiant 中使用的样式文件下载到你的电脑。编辑这些文件，并使用上述`options`函数告知 Radiant 你想要使用的样式文件位置。 + * Word 样式文件 + * PowerPoint 样式文件 +* `theme`选项可用于更改 Radiant 界面的外观。有关可用主题的概述，参见：https://rstudio.github.io/bslib/articles/theming/index.html#bootswatch + +### R 函数 + +有关 Radiant 中用于生成可重复报告的相关 R 函数概述，请参见*报告* 。 diff --git a/radiant.data/inst/app/tools/help/report_rmd.md b/radiant.data/inst/app/tools/help/report_rmd.md new file mode 100644 index 0000000000000000000000000000000000000000..84669e0906bbb7cb4dc458e3230fda9e66967d0e --- /dev/null +++ b/radiant.data/inst/app/tools/help/report_rmd.md @@ -0,0 +1,61 @@ +> 使用 Rmarkdown 创建（可重复的）报告 + +在 Radiant 中存储工作的最佳方式是使用 “报告> Rmd” 功能，并保存包含所有结果和设置的状态文件。Radiant 的报告功能应与大多数页面左下角显示的图标结合使用。 + +“报告> Rmd” 左侧的编辑器中，以**R 代码块**形式显示过往命令。这些 “代码块” 可包含你输入的 R 代码，或 Radiant 生成的代码（点击图标后添加到报告中）。所有代码块均以````{r}`开头，以`````结尾。 + +默认情况下，Radiant 会将你刚完成的分析所生成的 R 代码添加到报告底部。点击图标后，Radiant 默认会切换到 “报告> Rmd” 标签页。点击左侧编辑器窗口并向下滚动，即可看到生成的命令。 + +如果你想更精确地控制 Radiant 生成的 R 代码在报告中的位置，可在 “报告> Rmd” 标签页的相应下拉菜单中选择 `手动粘贴`而非 `自动粘贴`。选择 `手动粘贴` 后，点击时，代码会被复制到剪贴板，你可将其粘贴到编辑器窗口的任意位置。 + +如果你从 RStudio 启动 Radiant，还可选择将命令发送到 RStudio 中打开的 Rmarkdown（R 代码）文档，方法是在下拉菜单中选择 “> Rmd”（或 “> R”）而非 “自动粘贴” 或 “手动粘贴”。选择 “> Rmd” 后，“报告 > Rmd” 中的编辑器会隐藏（即 “仅预览”），点击 “编译报告（Rmd）” 会直接从 RStudio 获取文本和代码。 + +默认情况下，点击图标后，应用会切换到 “报告> Rmd” 标签页。但如果你不想在点击该图标后切换标签页，可在 “报告 > Rmd” 标签页的相应下拉菜单中选择 `不切换标签页`。当选择 “> Rmd” 时，“不切换标签页” 为默认选项。 + +你可以添加文本或额外命令来创建 Rmarkdown 文档。Rmarkdown 文件（扩展名为.Rmd）是纯文本文件，可在记事本（Windows）、文本编辑（Mac）、RStudio、Sublime Text 或任何其他文本编辑器中打开。请**不要**使用 Word 编辑 Rmarkdown 文件。 + +使用 Rmarkdown 的强大之处在于，你无需重新生成所有必要的 R 代码，就能快速复现整个分析。点击屏幕左上角的 “编译报告（Rmd）” 按钮后，分析输出会被（重新）生成并显示在 “报告 > Rmd” 页面的右侧。要仅执行报告的一部分，用光标选中该部分并按`CTRL-enter`（Mac 上为`CMD-enter`）生成（部分）输出。 + +你可以在代码块周围添加文本、项目符号、标题等，使用markdown格式描述和解释结果。如需交互式 markdown 教程，请访问[commonmark.org](https://commonmark.org)。 + +如果你从 RStudio 启动 Radiant，可将报告保存为多种格式（即笔记本、HTML、Word、PowerPoint 或 PDF）。有关生成 PowerPoint 演示文稿的更多信息，参见https://bookdown.org/yihui/rmarkdown/powerpoint-presentation.html。要保存编辑器中打开的 Rmarkdown 文件，选择 `Rmd`（或 `Rmd + Data(zip)`）并按 `保存报告` 按钮。之前保存的 Rmarkdown 文件可通过 `加载报告` 按钮加载到 Radiant 中。 + +你也可以点击 `读取文件` 按钮浏览文件，并生成将其读入 Radiant 的代码。例如，读取 rda、rds、xls、yaml 和 feather 格式的文件并将它们添加到 “数据集” 下拉菜单中。你还可以读取图像、R 代码和文本（如 Rmd 或 md）以包含在报告中。如果你想要加载的文件类型当前不支持，会返回文件路径。如果 Radiant 从 RStudio 项目启动，使用的文件路径将相对于项目根目录。同步到本地 Dropbox 或 Google Drive 文件夹的文件路径会使用`find_dropbox`和`find_gdrive`函数，以增强可重复性。 + +## 状态 + +保存分析和设置的最佳方式是，通过点击导航栏中的图标，然后点击 `保存 Radiant 状态文件`，将应用程序的 “状态” 保存到文件中。状态文件（扩展名为 rda）将包含：（1）Radiant 中加载的数据；（2）你正在进行的分析设置；（3）“报告 > Rmd” 和 “报告 > R” 中的所有报告或代码。将状态文件保存到硬盘，当你准备继续工作时，只需通过导航栏中的图标，然后点击 `加载 Radiant 状态文件`加载它即可。 + +如果你在课程中使用 Radiant，建议使用 “报告> Rmd” 功能完成作业和案例分析。完成后，点击 `保存报告` 按钮生成（HTML）笔记本（或 Word、PDF）报告。同时提交报告和状态文件。 + +## 选项 + +“报告> Rmd” 和 “报告 > R” 中使用的编辑器有多个选项可在`.Rprofile`中设置。你可以使用`usethis::edit_r_profile()`修改`.Rprofile`中的设置。 + +```r +options(radiant.ace_vim.keys = FALSE) +options(radiant.ace_theme = "cobalt") +options(radiant.ace_tabSize = 2) +options(radiant.ace_useSoftTabs = TRUE) +options(radiant.ace_showInvisibles = TRUE) +options(radiant.ace_autoComplete = "live") +options(radiant.powerpoint_style = "~/Dropbox/rmd-styles/style.potx") +options(radiant.word_style = "~/Dropbox/rmd-styles/style.docx") +options(radiant.theme = bslib::bs_theme(version = 4, bootswatch = "darkly")) +``` + +说明： + +* `vim.keys`启用一组特殊的键盘快捷键。如果你从未使用过 VIM，可能不需要开启此选项 +* 有关可用的编辑器主题概述，参见：`shinyAce::getAceThemes()` +* 默认情况下，制表符会转换为 2 个空格（即 “软制表符”）。你可以将使用的空格数从 2 更改为例如 4 +* `showInvisibles`在编辑器中显示制表符和空格 +* 自动完成有 “live”“enabled” 和 “disabled” 三个选项 +* Radiant 对 Word 和 PowerPoint 文件有默认样式。不过，这些样式可替换为你创建的样式文件。点击下方链接将 Radiant 中使用的样式文件下载到你的电脑。编辑这些文件，并使用上述`options`函数告知 Radiant 你想要使用的样式文件位置。 + * Word 样式文件 + * PowerPoint 样式文件 +* `theme`选项可用于更改 Radiant 界面的外观。有关可用主题的概述，参见：https://rstudio.github.io/bslib/articles/theming/index.html#bootswatch + +### R 函数 + +有关 Radiant 中用于生成可重复报告的相关 R 函数概述，请参见*报告* 。 diff --git a/radiant.data/inst/app/tools/help/state.md b/radiant.data/inst/app/tools/help/state.md new file mode 100644 index 0000000000000000000000000000000000000000..5c0e206abd14ee8f9c0011ca25eea3904259b961 --- /dev/null +++ b/radiant.data/inst/app/tools/help/state.md @@ -0,0 +1,9 @@ +> 保存、加载、共享或查看状态 + +如果你想在其他时间（可能在另一台电脑上）完成工作，或回顾之前使用 Radiant 完成的工作，使用状态文件会很方便。你可以像保存数据文件一样保存和加载 Radiant 应用的状态。状态文件（扩展名为`.rda`）将包含：（1）Radiant 中加载的数据；（2）你正在进行的分析设置；（3）“报告（Report）” 菜单中的所有报告或代码。要将应用的当前状态保存到硬盘，点击导航栏中的图标，然后点击`保存Radiant状态文件`。要加载之前的状态，点击导航栏中的图标，然后点击`加载Radiant状态文件`。 + +你也可以与想要复现你分析的人共享状态文件。例如，按上述方法下载然后加载状态文件radiant-example.state.rda。你会自动导航到 “数据> 可视化” 标签页并看到一个图表。也可查看 “数据 > 查看” 标签页，获取从状态文件加载的其他设置。“报告 > Rmd” 中还有一个使用 Radiant 界面创建的报告。html 文件radiant-example.nb.html包含点击`编译报告`按钮生成的输出。 + +状态的加载和保存也适用于 RStudio。如果你从 RStudio 启动 Radiant，使用然后点击`停止`，`r_data`环境以及`r_info`和`r_state`列表会放入 RStudio 的全局工作区。如果你从 “插件（Addins）” 菜单再次启动 Radiant，它会使用`r_data`、`r_info`和`r_state`恢复状态。此外，如果你直接在 RStudio 中加载状态文件，启动 Radiant 时会使用该文件。 + +使用导航栏中菜单中的`刷新`可返回到干净 / 新状态。 \ No newline at end of file diff --git a/radiant.data/inst/app/tools/help/transform.Rmd b/radiant.data/inst/app/tools/help/transform.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..a2c07be53ea24762d00a6478f97e31d065f3eece --- /dev/null +++ b/radiant.data/inst/app/tools/help/transform.Rmd @@ -0,0 +1,312 @@ +> 转换变量 + +### 转换命令日志 + +在 “数据> 转换” 标签页中应用的所有转换都可被记录。例如，如果你对数值变量应用 “自然对数（Ln (natural log)）” 转换，点击 `存储` 按钮后，以下代码会生成并显示在屏幕底部的 “转换命令日志” 窗口中。 + +```r +## transform variable +diamonds <- mutate_ext( + diamonds, + .vars = vars(price, carat), + .funs = log, + .ext = "_ln" +) +``` + +如果你想用新的类似数据重新运行报告，这一功能至关重要。更重要的是，它记录了数据转换和结果生成的步骤，即你的工作现在具有可重复性。 + +要将命令日志窗口中的命令添加到“报告> Rmd”中的报告，点击图标。 + +### 过滤数据 + +即使已指定过滤器，它对 “数据> 转换” 中的（大多数）函数也无效。要基于过滤器创建新数据集，请导航至“数据> 查看”标签页并点击 `存储` 按钮。或者，要基于过滤器创建新数据集，从 `转换类型`下拉菜单中选择 `拆分数据 > 留存样本`。 + +### 隐藏汇总 + +对于较大的数据集，或不需要汇总信息时，在选择转换类型并指定数据修改方式前，点击 `隐藏汇总` 会很有用。如果你想查看汇总，请确保未勾选 `隐藏汇总`。 + +### 修改变量 + +#### 分箱 + +当你想创建多个五分位数 / 十分位数 /... 变量时，“分箱（Bin）” 命令是下文讨论的`xtile`命令的便捷功能。要计算五分位数，在 “分箱数量（Nr bins）” 中输入`5`。“反转（reverse）” 选项会将 1 替换为 5、2 替换为 4……5 替换为 1。为新变量选择合适的扩展名。 + +#### 更改类型 + +从 “转换类型” 下拉菜单中选择 `类型` 后，会显示另一个下拉菜单，可用于更改一个或多个变量的类型（或类别）。例如，你可以将整数类型的变量转换为因子类型的变量。点击 “存储” 按钮将更改应用到数据集。以下是转换选项的说明： + +1. 转换为因子（As factor）：将变量转换为因子类型（即分类变量） +2. 转换为数值（As number）：将变量转换为数值类型 +3. 转换为整数（As integer）：将变量转换为整数类型 +4. 转换为字符（As character）：将变量转换为字符类型（即字符串） +5. 转换为时间序列（As times series）：将变量转换为 ts 类型 +6. 转换为日期（月 - 日 - 年）（As date (mdy)）：如果日期格式为月 - 日 - 年，将变量转换为日期类型 +7. 转换为日期（日 - 月 - 年）（As date (dmy)）：如果日期格式为日 - 月 - 年，将变量转换为日期类型 +8. 转换为日期（年 - 月 - 日）（As date (ymd)）：如果日期格式为年 - 月 - 日，将变量转换为日期类型 +9. 转换为日期 / 时间（月 - 日 - 年 - 时 - 分 - 秒）（As date/time (mdy_hms)）：如果日期时间格式为月 - 日 - 年 - 时 - 分 - 秒，将变量转换为日期时间类型 +10. 转换为日期 / 时间（月 - 日 - 年 - 时 - 分）（As date/time (mdy_hm)）：如果日期时间格式为月 - 日 - 年 - 时 - 分，将变量转换为日期时间类型 +11. 转换为日期 / 时间（日 - 月 - 年 - 时 - 分 - 秒）（As date/time (dmy_hms)）：如果日期时间格式为日 - 月 - 年 - 时 - 分 - 秒，将变量转换为日期时间类型 +12. 转换为日期 / 时间（日 - 月 - 年 - 时 - 分）（As date/time (dmy_hm)）：如果日期时间格式为日 - 月 - 年 - 时 - 分，将变量转换为日期时间类型 +13. 转换为日期 / 时间（年 - 月 - 日 - 时 - 分 - 秒）（As date/time (ymd_hms)）：如果日期时间格式为年 - 月 - 日 - 时 - 分 - 秒，将变量转换为日期时间类型 +14. 转换为日期 / 时间（年 - 月 - 日 - 时 - 分）（As date/time (ymd_hm)）：如果日期时间格式为年 - 月 - 日 - 时 - 分，将变量转换为日期时间类型 + +**注意：** 将变量转换为`ts`类型（即时间序列）时，至少应指定起始周期和数据频率。例如，对于从一年第 4 周开始的周数据，在 “起始周期（Start period）” 中输入`4`，并将 “频率（Frequency）” 设为`52`。 + +#### 标准化 + +从 “转换类型” 下拉菜单中选择 `标准化` 以标准化一个或多个变量。例如，在钻石数据中，我们可能希望按克拉数表示钻石价格。在 `选择变量` 框中选择`price`，并选择`carat`作为 `标准化变量`。主面板中会显示新变量（如`price_carat`）的汇总统计量。点击 “存储” 按钮将更改应用到数据。 + +#### 重编码 + +要使用重编码功能，选择你想要更改的变量，然后从 “转换类型” 下拉菜单中选择 “重编码（Recode）”。提供一个或多个重编码命令（用`;`分隔），按回车查看变量更改信息。注意，你可以在 “重编码变量名称（Recoded variable name）” 输入框中指定重编码后变量的名称（按回车提交更改）。最后，点击 “存储” 将重编码后的变量添加到数据中。以下是一些示例： + +1. 将 20 以下的值设为`低（Low）`，其他设为`高（High）` + + ```r + lo:20 = 'Low'; else = 'High' + ``` + +2. 将 20 以上的值设为`高（High）`，其他设为`低（Low）` + + ```r + 20:hi = 'High'; else = 'Low' + ``` + +3. 将 1-12 的值设为`A`，13-24 的值设为`B`，其余设为`C` + + ```r + 1:12 = 'A'; 13:24 = 'B'; else = 'C' + ``` + +4. 为“基础> 表格 > 交叉表”分析合并年龄类别。在下方示例中，`<25`和`25-34`重编码为`<35`，`35-44`和`45-54`重编码为`35-54`，`55-64`和`>64`重编码为`>54` + + + ```r + '<25' = '<35'; '25-34' = '<35'; '35-44' = '35-54'; '45-54' = '35-54'; '55-64' = '>54'; '>64' = '>54' + ``` + +5. 要在后续分析中排除特定值（如数据中的异常值），可将其重编码为缺失值。例如，如果我们想从名为`sales`的变量中移除等于 400 的最大值，（1）在 `选择变量` 框中选择变量`sales`，在 `重编码` 框中输入以下命令。按回车并点击 “存储” 将重编码后的变量添加到数据中 + + + ```r + 400 = NA + ``` + +5. 要将特定数值（如克拉数）重编码为新值，（1）在 `选择变量` 框中选择变量`carat`，在 `重编码` 框中输入以下命令，将克拉数大于或等于 2 的值设为 2。按回车并点击 `存储` 将重编码后的变量添加到数据中 + + ```r + 2:hi = 2 + ``` + +**注意：** 使用重编码功能时，变量标签中不要使用`=`（例如`50:hi = '>= 50'`），这会导致错误。 + +#### 重新排序或移除水平 + +如果 `选择变量` 中选中了单个因子类型变量，从`转换类型` 下拉菜单中选择 `移除/重新排序级别` 可重新排序和 / 或移除水平。拖放水平可重新排序，点击×可移除水平。注意，默认情况下，移除一个或多个水平会在数据中引入缺失值。如果你希望将移除的水平重编码为新水平（例如 “其他”），只需在`替换水平名称`输入框中输入 “其他” 并按回车。如果生成的因子水平符合预期，点击`存储` 应用更改。要暂时从数据中排除水平，使用 `过滤数据`框（参见“数据> 查看”标签页中的帮助文件）。 + +#### 重命名 + +从`转换类型` 下拉菜单中选择`重命名`，选择一个或多个变量，在 `重命名` 框中输入它们的新名称（用`,`分隔）。按回车在屏幕上查看重命名后变量的汇总，点击 `存储` 更改数据中的变量名称。 + +#### 替换 + +如果想用新变量（例如通过`创建、转换、剪贴板` 等创建的变量）替换数据中的现有变量，从 `转换类型` 下拉菜单中选择 `替换`。选择一个或多个要覆盖的变量和相同数量的替换变量。点击 `存储` 修改数据。 + +#### 转换 + +从`转换类型` 下拉菜单中选择 `转换` 后，会显示另一个下拉菜单，可用于对数据中的一个或多个变量应用常见转换。例如，要对变量取自然对数，选择要转换的变量，从 `应用函数` 下拉菜单中选择 `自然对数`。转换后的变量会带有 `变量名称扩展名` 输入框中指定的扩展名（例如`_ln`）。更改扩展名后请务必按回车。点击 `存储` 按钮将（更改后的）变量添加到数据集。以下是 Radiant 中包含的转换函数说明： + +1. 自然对数（Ln）：创建所选变量的自然对数转换版本（即 log (x) 或 ln (x)） +2. 平方（Square）：变量自乘（即 x² 或 square (x)） +3. 平方根（Square-root）：取变量的平方根（即 x^0.5） +4. 绝对值（Absolute）：变量的绝对值（即 abs (x)） +5. 中心化（Center）：创建均值为 0 的新变量（即 x - mean (x)） +6. 标准化（Standardize）：创建均值为 0、标准差为 1 的新变量（即 (x - mean (x))/sd (x)） +7. 倒数（Inverse）：1/x + +### 创建新变量 + +#### 剪贴板 + +尽管不推荐，但你可以在电子表格（如 Excel 或 Google 表格）中处理数据，再将数据复制粘贴回 Radiant。如果原始数据不在电子表格中，使用“数据> 管理”中的剪贴板功能将其粘贴到电子表格，或点击“数据> 查看”标签页右上角的下载图标。在电子表格程序中应用转换，然后将新变量（带标题标签）复制到剪贴板（Windows 用 CTRL-C，Mac 用 CMD-C）。从 “转换类型” 下拉菜单中选择 “剪贴板（Clipboard）”，将新数据粘贴到 “从电子表格粘贴（Paste from spreadsheet）” 框中。关键是新变量的观测数必须与 Radiant 中的数据一致。点击 “存储” 将新变量添加到数据中。 + +> **注意：** 不推荐使用剪贴板功能进行数据转换，因为它不可重复。 + +#### 创建 + +从`转换类型` 下拉菜单中选择 `创建`。这是创建新变量或转换现有变量最灵活的命令，但需要一些基本的 R 语法知识。新变量可以是（活跃）数据集中其他变量的任意函数。以下是一些示例。每个示例中，`=`左侧是新变量的名称，`=`右侧可包含其他变量名称和基本 R 函数。输入命令后按回车查看新变量的汇总统计量。如果结果符合预期，点击`存储` 将其添加到数据集。 + +> **注意：** 如果从 “选择变量” 列表中选中了一个或多个变量，创建新变量前会先按这些变量对数据分组（见下方示例 1）。如果不希望分组，请确保创建新变量时未选中任何变量 + +1. 创建等于价格均值的新变量`z`。要按组（如按净度水平）计算价格均值，在创建`z`前从 “选择变量” 列表中选择`clarity` + + ```r + z = mean(price) + ``` + +2. 创建变量`z`，其值为变量 x 和 y 的差值 + + ```r + z = x - y + ``` + +3. 创建变量`z`，其为变量`x`的转换版本，均值为 0（另见 “转换> 中心化”）： + + ```r + z = x - mean(x) + ``` + +4. 创建逻辑变量`z`，当`x > y`时取值为 TRUE，否则为 FALSE + + ```r + z = x > y + ``` + +5. 创建逻辑变量`z`，当`x`等于`y`时取值为 TRUE，否则为 FALSE + + ```r + z = x == y + ``` + +6. 创建变量`z`，其值为变量`x`滞后 3 期的值 + + ```r + z = lag(x,3) + ``` + +7. 创建具有两个水平（即`smaller`和`bigger`）的分类变量 + + ```r + z = ifelse(x < y, 'smaller', 'bigger') + ``` + +8. 创建具有三个水平的分类变量。另一种方法是使用下文描述的 “重编码” 函数 + + ```r + z = ifelse(x < 60, '< 60', ifelse(x > 65, '> 65', '60-65')) + ``` + +9. 将异常值转换为缺失值。例如，如果我们想从名为`sales`的变量中移除等于 400 的最大值，可使用`ifelse`语句，在 “创建” 框中输入以下命令。按回车并点击 “存储” 将`sales_rc`添加到数据中。注意，如果我们在`=`左侧输入`sales`，原始变量将被覆盖 + + ```r + sales_rc = ifelse(sales > 400, NA, sales) + ``` + +10. If a respondent with ID 3 provided information on the wrong scale in a survey (e.g., income in \$1s rather than in \$1000s) we could use an `ifelse` statement and enter the command below in the `Create` box. As before, press `return` and `Store` to add `sales_rc` to the data + + ```r + income_rc = ifelse(ID == 3, income/1000, income) + ``` + +11. 如果 ID 为 3 的受访者在调查中使用了错误的量表（如收入单位为 1 美元而非 1000 美元），可使用`ifelse`语句，在 “创建” 框中输入以下命令。同样，按回车并点击 “存储” 将`income_rc`添加到数据中 + + ```r + income_rc = ifelse(ID %in% c(1, 3, 15), income/1000, income) + ``` + +12. 如果多名受访者出现相同的量表错误（如 ID 为 1、3 和 15 的受访者），再次使用 “创建” 并输入： + + ```r + date = parse_date_time(x, '%m%d%y') + ``` + +13. 计算两个日期 / 时间之间的秒数差 + + ```r + tdiff = as_duration(time2 - time1) + ``` + +14. 从日期变量中提取月份 + + ```r + m = month(date) + ``` + +15. 可从日期或日期时间变量中提取的其他属性包括`minute`（分钟）、`hour`（小时）、`day`（日）、`week`（周）、`quarter`（季度）、`year`（年）、`wday`（星期）。对于`wday`和`month`，在调用中添加`label = TRUE`会很方便。例如，从日期变量中提取星期并使用标签而非数字 + + ```r + wd = wday(date, label = TRUE) + ``` + +16. 使用经纬度信息计算两个地点之间的距离 + + ```r + dist = as_distance(lat1, long1, lat2, long2) + ``` + +17. 使用`xtile`命令计算变量`recency`的五分位数。要创建十分位数，将`5`替换为`10`。 + + ```r + rec_iq = xtile(recency, 5) + ``` + +18. 要反转上述 17 中创建的五分位数顺序，使用`rev = TRUE` + + ```r + rec_iq = xtile(recency, 5, rev = TRUE) + ``` + +19. 要从字符或因子变量的条目中移除文本，使用`sub`移除首个实例，或`gsub`移除所有实例。例如，假设变量`bk_score`的每行在数字前都有字母 “clv”（如 “clv150”）。我们可按如下方式将每个 “clv” 替换为 “”： + + ```r + bk_score = sub("clv", "", bk_score) + ``` + +注意：对于上述示例 7、8 和 15，在进一步分析前，可能需要将新变量更改为因子类型（另见上文 “更改类型”） + +### 清洗数据 + +#### 移除缺失值 + +从 `转换类型` 下拉菜单中选择 `移除缺失值` 以删除含一个或多个缺失值的行。`选择变量` 中存在缺失值的行将被移除。点击 `存储` 修改数据。如果存在缺失值，你会看到数据汇总中的观测数发生变化（即`n`的值变化）。 + +#### 重新排序或移除变量 + +从 `转换类型` 下拉菜单中选择 `移除/重新排序变量`。拖放变量可重新排序数据中的变量。要移除变量，点击标签旁的×符号。点击 `存储` 应用更改。 + +#### 移除重复值 + +数据集中通常有一个或多个变量的值唯一（即无重复）。例如，客户 ID 应唯一，除非数据集包含同一客户的多个订单。要移除重复项，选择一个或多个变量来确定 “唯一性”。从`转换类型` 下拉菜单中选择 `移除重复项`，查看显示的汇总统计量变化。点击 `存储` 修改数据。如果存在重复行，你会看到数据汇总中的观测数发生变化（即`n`和`n_distinct`的值变化）。 + +#### 显示重复值 + +如果数据中存在重复项，使用 `显示重复项`可更好地了解在多行中具有相同值的数据点。如果你想在“数据> 查看”标签页中查看重复项，确保将它们存储在不同的数据集中（即**不要**覆盖你正在处理的数据）。如果基于数据中的所有列显示重复项，只会显示重复行中的一行。这些行完全相同，显示 2 行或 3 行没有意义。但如果基于部分变量查看重复项，Radiant 会生成包含**所有**相关行的数据集。 + +### 扩展数据 + +#### 扩展网格 + +创建包含所选变量所有值组合的数据集。这在生成预测数据集时很有用，例如在“模型> 估计 > 线性回归（OLS）”或“模型> 估计 > 逻辑回归（GLM）”中。假设你想创建包含钻石`cut`和`color`所有可能组合的数据集。从`转换类型` 下拉菜单中选择 `扩展网格`，在 `选择变量` 框中选择`cut`和`color`，从下方截图中可看到有 35 种可能的组合（即`cut`有 5 个唯一值，`color`有 7 个唯一值，因此有 5×7 种组合）。为新数据集命名（如 diamonds_expand），点击 `存储` 按钮将其添加到 `数据集（Datasets）` 下拉菜单中。 + +

    + +#### 表格转数据 + +将频数表转换为数据集。行数将等于所有频数之和。 + +### 拆分数据 + +#### 留存样本 + +要基于过滤器创建留存样本，从 `转换类型` 下拉菜单中选择 `留存样本`。默认使用活跃过滤器的 `相反` 条件。例如，如果分析的是`date < '2014-12-13'`的观测，且勾选了`反转过滤器` 框，留存样本将包含`date >= '2014-12-13'`的行。 + +#### 训练变量 + +要创建可用于（随机）过滤数据集以进行模型训练和测试的变量，从 `转换类型` 下拉菜单中选择 `训练变量`。指定用于训练的观测数（如将 `大小` 设为 2000）或选择的观测比例（如将 `大小` 设为 0.7）。新变量在训练数据中取值为`1`，在测试数据中取值为`0`。 + +也可选择一个或多个变量用于训练和测试样本的随机分配 `区组化`。这有助于确保例如感兴趣变量的正负案例比例（如 “购买” vs “未购买”）在训练和测试样本中（几乎）相同。 + +### 整洁数据 + +#### 汇集列 + +将多个变量合并为一列。如果加载了`diamonds`数据集，从`转换类型` 下拉菜单中选择 `汇集列` 后，在 `选择变量` 框中选择`cut`和`color`。这将创建新变量`key`和`value`。`key`有两个水平（即`cut`和`color`），`value`包含`cut`和`color`的所有值。 + +#### 扩展列 + +将一列 `扩展` 为多列。与 `汇集`相反。有关`整洁数据` 的详细讨论，参见整洁数据说明文档。 + +### R 函数 + +有关 Radiant 中用于数据转换的相关 R 函数概述，请参见“数据> 转换” 。 diff --git a/radiant.data/inst/app/tools/help/transform.md b/radiant.data/inst/app/tools/help/transform.md new file mode 100644 index 0000000000000000000000000000000000000000..a2c07be53ea24762d00a6478f97e31d065f3eece --- /dev/null +++ b/radiant.data/inst/app/tools/help/transform.md @@ -0,0 +1,312 @@ +> 转换变量 + +### 转换命令日志 + +在 “数据> 转换” 标签页中应用的所有转换都可被记录。例如，如果你对数值变量应用 “自然对数（Ln (natural log)）” 转换，点击 `存储` 按钮后，以下代码会生成并显示在屏幕底部的 “转换命令日志” 窗口中。 + +```r +## transform variable +diamonds <- mutate_ext( + diamonds, + .vars = vars(price, carat), + .funs = log, + .ext = "_ln" +) +``` + +如果你想用新的类似数据重新运行报告，这一功能至关重要。更重要的是，它记录了数据转换和结果生成的步骤，即你的工作现在具有可重复性。 + +要将命令日志窗口中的命令添加到“报告> Rmd”中的报告，点击图标。 + +### 过滤数据 + +即使已指定过滤器，它对 “数据> 转换” 中的（大多数）函数也无效。要基于过滤器创建新数据集，请导航至“数据> 查看”标签页并点击 `存储` 按钮。或者，要基于过滤器创建新数据集，从 `转换类型`下拉菜单中选择 `拆分数据 > 留存样本`。 + +### 隐藏汇总 + +对于较大的数据集，或不需要汇总信息时，在选择转换类型并指定数据修改方式前，点击 `隐藏汇总` 会很有用。如果你想查看汇总，请确保未勾选 `隐藏汇总`。 + +### 修改变量 + +#### 分箱 + +当你想创建多个五分位数 / 十分位数 /... 变量时，“分箱（Bin）” 命令是下文讨论的`xtile`命令的便捷功能。要计算五分位数，在 “分箱数量（Nr bins）” 中输入`5`。“反转（reverse）” 选项会将 1 替换为 5、2 替换为 4……5 替换为 1。为新变量选择合适的扩展名。 + +#### 更改类型 + +从 “转换类型” 下拉菜单中选择 `类型` 后，会显示另一个下拉菜单，可用于更改一个或多个变量的类型（或类别）。例如，你可以将整数类型的变量转换为因子类型的变量。点击 “存储” 按钮将更改应用到数据集。以下是转换选项的说明： + +1. 转换为因子（As factor）：将变量转换为因子类型（即分类变量） +2. 转换为数值（As number）：将变量转换为数值类型 +3. 转换为整数（As integer）：将变量转换为整数类型 +4. 转换为字符（As character）：将变量转换为字符类型（即字符串） +5. 转换为时间序列（As times series）：将变量转换为 ts 类型 +6. 转换为日期（月 - 日 - 年）（As date (mdy)）：如果日期格式为月 - 日 - 年，将变量转换为日期类型 +7. 转换为日期（日 - 月 - 年）（As date (dmy)）：如果日期格式为日 - 月 - 年，将变量转换为日期类型 +8. 转换为日期（年 - 月 - 日）（As date (ymd)）：如果日期格式为年 - 月 - 日，将变量转换为日期类型 +9. 转换为日期 / 时间（月 - 日 - 年 - 时 - 分 - 秒）（As date/time (mdy_hms)）：如果日期时间格式为月 - 日 - 年 - 时 - 分 - 秒，将变量转换为日期时间类型 +10. 转换为日期 / 时间（月 - 日 - 年 - 时 - 分）（As date/time (mdy_hm)）：如果日期时间格式为月 - 日 - 年 - 时 - 分，将变量转换为日期时间类型 +11. 转换为日期 / 时间（日 - 月 - 年 - 时 - 分 - 秒）（As date/time (dmy_hms)）：如果日期时间格式为日 - 月 - 年 - 时 - 分 - 秒，将变量转换为日期时间类型 +12. 转换为日期 / 时间（日 - 月 - 年 - 时 - 分）（As date/time (dmy_hm)）：如果日期时间格式为日 - 月 - 年 - 时 - 分，将变量转换为日期时间类型 +13. 转换为日期 / 时间（年 - 月 - 日 - 时 - 分 - 秒）（As date/time (ymd_hms)）：如果日期时间格式为年 - 月 - 日 - 时 - 分 - 秒，将变量转换为日期时间类型 +14. 转换为日期 / 时间（年 - 月 - 日 - 时 - 分）（As date/time (ymd_hm)）：如果日期时间格式为年 - 月 - 日 - 时 - 分，将变量转换为日期时间类型 + +**注意：** 将变量转换为`ts`类型（即时间序列）时，至少应指定起始周期和数据频率。例如，对于从一年第 4 周开始的周数据，在 “起始周期（Start period）” 中输入`4`，并将 “频率（Frequency）” 设为`52`。 + +#### 标准化 + +从 “转换类型” 下拉菜单中选择 `标准化` 以标准化一个或多个变量。例如，在钻石数据中，我们可能希望按克拉数表示钻石价格。在 `选择变量` 框中选择`price`，并选择`carat`作为 `标准化变量`。主面板中会显示新变量（如`price_carat`）的汇总统计量。点击 “存储” 按钮将更改应用到数据。 + +#### 重编码 + +要使用重编码功能，选择你想要更改的变量，然后从 “转换类型” 下拉菜单中选择 “重编码（Recode）”。提供一个或多个重编码命令（用`;`分隔），按回车查看变量更改信息。注意，你可以在 “重编码变量名称（Recoded variable name）” 输入框中指定重编码后变量的名称（按回车提交更改）。最后，点击 “存储” 将重编码后的变量添加到数据中。以下是一些示例： + +1. 将 20 以下的值设为`低（Low）`，其他设为`高（High）` + + ```r + lo:20 = 'Low'; else = 'High' + ``` + +2. 将 20 以上的值设为`高（High）`，其他设为`低（Low）` + + ```r + 20:hi = 'High'; else = 'Low' + ``` + +3. 将 1-12 的值设为`A`，13-24 的值设为`B`，其余设为`C` + + ```r + 1:12 = 'A'; 13:24 = 'B'; else = 'C' + ``` + +4. 为“基础> 表格 > 交叉表”分析合并年龄类别。在下方示例中，`<25`和`25-34`重编码为`<35`，`35-44`和`45-54`重编码为`35-54`，`55-64`和`>64`重编码为`>54` + + + ```r + '<25' = '<35'; '25-34' = '<35'; '35-44' = '35-54'; '45-54' = '35-54'; '55-64' = '>54'; '>64' = '>54' + ``` + +5. 要在后续分析中排除特定值（如数据中的异常值），可将其重编码为缺失值。例如，如果我们想从名为`sales`的变量中移除等于 400 的最大值，（1）在 `选择变量` 框中选择变量`sales`，在 `重编码` 框中输入以下命令。按回车并点击 “存储” 将重编码后的变量添加到数据中 + + + ```r + 400 = NA + ``` + +5. 要将特定数值（如克拉数）重编码为新值，（1）在 `选择变量` 框中选择变量`carat`，在 `重编码` 框中输入以下命令，将克拉数大于或等于 2 的值设为 2。按回车并点击 `存储` 将重编码后的变量添加到数据中 + + ```r + 2:hi = 2 + ``` + +**注意：** 使用重编码功能时，变量标签中不要使用`=`（例如`50:hi = '>= 50'`），这会导致错误。 + +#### 重新排序或移除水平 + +如果 `选择变量` 中选中了单个因子类型变量，从`转换类型` 下拉菜单中选择 `移除/重新排序级别` 可重新排序和 / 或移除水平。拖放水平可重新排序，点击×可移除水平。注意，默认情况下，移除一个或多个水平会在数据中引入缺失值。如果你希望将移除的水平重编码为新水平（例如 “其他”），只需在`替换水平名称`输入框中输入 “其他” 并按回车。如果生成的因子水平符合预期，点击`存储` 应用更改。要暂时从数据中排除水平，使用 `过滤数据`框（参见“数据> 查看”标签页中的帮助文件）。 + +#### 重命名 + +从`转换类型` 下拉菜单中选择`重命名`，选择一个或多个变量，在 `重命名` 框中输入它们的新名称（用`,`分隔）。按回车在屏幕上查看重命名后变量的汇总，点击 `存储` 更改数据中的变量名称。 + +#### 替换 + +如果想用新变量（例如通过`创建、转换、剪贴板` 等创建的变量）替换数据中的现有变量，从 `转换类型` 下拉菜单中选择 `替换`。选择一个或多个要覆盖的变量和相同数量的替换变量。点击 `存储` 修改数据。 + +#### 转换 + +从`转换类型` 下拉菜单中选择 `转换` 后，会显示另一个下拉菜单，可用于对数据中的一个或多个变量应用常见转换。例如，要对变量取自然对数，选择要转换的变量，从 `应用函数` 下拉菜单中选择 `自然对数`。转换后的变量会带有 `变量名称扩展名` 输入框中指定的扩展名（例如`_ln`）。更改扩展名后请务必按回车。点击 `存储` 按钮将（更改后的）变量添加到数据集。以下是 Radiant 中包含的转换函数说明： + +1. 自然对数（Ln）：创建所选变量的自然对数转换版本（即 log (x) 或 ln (x)） +2. 平方（Square）：变量自乘（即 x² 或 square (x)） +3. 平方根（Square-root）：取变量的平方根（即 x^0.5） +4. 绝对值（Absolute）：变量的绝对值（即 abs (x)） +5. 中心化（Center）：创建均值为 0 的新变量（即 x - mean (x)） +6. 标准化（Standardize）：创建均值为 0、标准差为 1 的新变量（即 (x - mean (x))/sd (x)） +7. 倒数（Inverse）：1/x + +### 创建新变量 + +#### 剪贴板 + +尽管不推荐，但你可以在电子表格（如 Excel 或 Google 表格）中处理数据，再将数据复制粘贴回 Radiant。如果原始数据不在电子表格中，使用“数据> 管理”中的剪贴板功能将其粘贴到电子表格，或点击“数据> 查看”标签页右上角的下载图标。在电子表格程序中应用转换，然后将新变量（带标题标签）复制到剪贴板（Windows 用 CTRL-C，Mac 用 CMD-C）。从 “转换类型” 下拉菜单中选择 “剪贴板（Clipboard）”，将新数据粘贴到 “从电子表格粘贴（Paste from spreadsheet）” 框中。关键是新变量的观测数必须与 Radiant 中的数据一致。点击 “存储” 将新变量添加到数据中。 + +> **注意：** 不推荐使用剪贴板功能进行数据转换，因为它不可重复。 + +#### 创建 + +从`转换类型` 下拉菜单中选择 `创建`。这是创建新变量或转换现有变量最灵活的命令，但需要一些基本的 R 语法知识。新变量可以是（活跃）数据集中其他变量的任意函数。以下是一些示例。每个示例中，`=`左侧是新变量的名称，`=`右侧可包含其他变量名称和基本 R 函数。输入命令后按回车查看新变量的汇总统计量。如果结果符合预期，点击`存储` 将其添加到数据集。 + +> **注意：** 如果从 “选择变量” 列表中选中了一个或多个变量，创建新变量前会先按这些变量对数据分组（见下方示例 1）。如果不希望分组，请确保创建新变量时未选中任何变量 + +1. 创建等于价格均值的新变量`z`。要按组（如按净度水平）计算价格均值，在创建`z`前从 “选择变量” 列表中选择`clarity` + + ```r + z = mean(price) + ``` + +2. 创建变量`z`，其值为变量 x 和 y 的差值 + + ```r + z = x - y + ``` + +3. 创建变量`z`，其为变量`x`的转换版本，均值为 0（另见 “转换> 中心化”）： + + ```r + z = x - mean(x) + ``` + +4. 创建逻辑变量`z`，当`x > y`时取值为 TRUE，否则为 FALSE + + ```r + z = x > y + ``` + +5. 创建逻辑变量`z`，当`x`等于`y`时取值为 TRUE，否则为 FALSE + + ```r + z = x == y + ``` + +6. 创建变量`z`，其值为变量`x`滞后 3 期的值 + + ```r + z = lag(x,3) + ``` + +7. 创建具有两个水平（即`smaller`和`bigger`）的分类变量 + + ```r + z = ifelse(x < y, 'smaller', 'bigger') + ``` + +8. 创建具有三个水平的分类变量。另一种方法是使用下文描述的 “重编码” 函数 + + ```r + z = ifelse(x < 60, '< 60', ifelse(x > 65, '> 65', '60-65')) + ``` + +9. 将异常值转换为缺失值。例如，如果我们想从名为`sales`的变量中移除等于 400 的最大值，可使用`ifelse`语句，在 “创建” 框中输入以下命令。按回车并点击 “存储” 将`sales_rc`添加到数据中。注意，如果我们在`=`左侧输入`sales`，原始变量将被覆盖 + + ```r + sales_rc = ifelse(sales > 400, NA, sales) + ``` + +10. If a respondent with ID 3 provided information on the wrong scale in a survey (e.g., income in \$1s rather than in \$1000s) we could use an `ifelse` statement and enter the command below in the `Create` box. As before, press `return` and `Store` to add `sales_rc` to the data + + ```r + income_rc = ifelse(ID == 3, income/1000, income) + ``` + +11. 如果 ID 为 3 的受访者在调查中使用了错误的量表（如收入单位为 1 美元而非 1000 美元），可使用`ifelse`语句，在 “创建” 框中输入以下命令。同样，按回车并点击 “存储” 将`income_rc`添加到数据中 + + ```r + income_rc = ifelse(ID %in% c(1, 3, 15), income/1000, income) + ``` + +12. 如果多名受访者出现相同的量表错误（如 ID 为 1、3 和 15 的受访者），再次使用 “创建” 并输入： + + ```r + date = parse_date_time(x, '%m%d%y') + ``` + +13. 计算两个日期 / 时间之间的秒数差 + + ```r + tdiff = as_duration(time2 - time1) + ``` + +14. 从日期变量中提取月份 + + ```r + m = month(date) + ``` + +15. 可从日期或日期时间变量中提取的其他属性包括`minute`（分钟）、`hour`（小时）、`day`（日）、`week`（周）、`quarter`（季度）、`year`（年）、`wday`（星期）。对于`wday`和`month`，在调用中添加`label = TRUE`会很方便。例如，从日期变量中提取星期并使用标签而非数字 + + ```r + wd = wday(date, label = TRUE) + ``` + +16. 使用经纬度信息计算两个地点之间的距离 + + ```r + dist = as_distance(lat1, long1, lat2, long2) + ``` + +17. 使用`xtile`命令计算变量`recency`的五分位数。要创建十分位数，将`5`替换为`10`。 + + ```r + rec_iq = xtile(recency, 5) + ``` + +18. 要反转上述 17 中创建的五分位数顺序，使用`rev = TRUE` + + ```r + rec_iq = xtile(recency, 5, rev = TRUE) + ``` + +19. 要从字符或因子变量的条目中移除文本，使用`sub`移除首个实例，或`gsub`移除所有实例。例如，假设变量`bk_score`的每行在数字前都有字母 “clv”（如 “clv150”）。我们可按如下方式将每个 “clv” 替换为 “”： + + ```r + bk_score = sub("clv", "", bk_score) + ``` + +注意：对于上述示例 7、8 和 15，在进一步分析前，可能需要将新变量更改为因子类型（另见上文 “更改类型”） + +### 清洗数据 + +#### 移除缺失值 + +从 `转换类型` 下拉菜单中选择 `移除缺失值` 以删除含一个或多个缺失值的行。`选择变量` 中存在缺失值的行将被移除。点击 `存储` 修改数据。如果存在缺失值，你会看到数据汇总中的观测数发生变化（即`n`的值变化）。 + +#### 重新排序或移除变量 + +从 `转换类型` 下拉菜单中选择 `移除/重新排序变量`。拖放变量可重新排序数据中的变量。要移除变量，点击标签旁的×符号。点击 `存储` 应用更改。 + +#### 移除重复值 + +数据集中通常有一个或多个变量的值唯一（即无重复）。例如，客户 ID 应唯一，除非数据集包含同一客户的多个订单。要移除重复项，选择一个或多个变量来确定 “唯一性”。从`转换类型` 下拉菜单中选择 `移除重复项`，查看显示的汇总统计量变化。点击 `存储` 修改数据。如果存在重复行，你会看到数据汇总中的观测数发生变化（即`n`和`n_distinct`的值变化）。 + +#### 显示重复值 + +如果数据中存在重复项，使用 `显示重复项`可更好地了解在多行中具有相同值的数据点。如果你想在“数据> 查看”标签页中查看重复项，确保将它们存储在不同的数据集中（即**不要**覆盖你正在处理的数据）。如果基于数据中的所有列显示重复项，只会显示重复行中的一行。这些行完全相同，显示 2 行或 3 行没有意义。但如果基于部分变量查看重复项，Radiant 会生成包含**所有**相关行的数据集。 + +### 扩展数据 + +#### 扩展网格 + +创建包含所选变量所有值组合的数据集。这在生成预测数据集时很有用，例如在“模型> 估计 > 线性回归（OLS）”或“模型> 估计 > 逻辑回归（GLM）”中。假设你想创建包含钻石`cut`和`color`所有可能组合的数据集。从`转换类型` 下拉菜单中选择 `扩展网格`，在 `选择变量` 框中选择`cut`和`color`，从下方截图中可看到有 35 种可能的组合（即`cut`有 5 个唯一值，`color`有 7 个唯一值，因此有 5×7 种组合）。为新数据集命名（如 diamonds_expand），点击 `存储` 按钮将其添加到 `数据集（Datasets）` 下拉菜单中。 + +

    + +#### 表格转数据 + +将频数表转换为数据集。行数将等于所有频数之和。 + +### 拆分数据 + +#### 留存样本 + +要基于过滤器创建留存样本，从 `转换类型` 下拉菜单中选择 `留存样本`。默认使用活跃过滤器的 `相反` 条件。例如，如果分析的是`date < '2014-12-13'`的观测，且勾选了`反转过滤器` 框，留存样本将包含`date >= '2014-12-13'`的行。 + +#### 训练变量 + +要创建可用于（随机）过滤数据集以进行模型训练和测试的变量，从 `转换类型` 下拉菜单中选择 `训练变量`。指定用于训练的观测数（如将 `大小` 设为 2000）或选择的观测比例（如将 `大小` 设为 0.7）。新变量在训练数据中取值为`1`，在测试数据中取值为`0`。 + +也可选择一个或多个变量用于训练和测试样本的随机分配 `区组化`。这有助于确保例如感兴趣变量的正负案例比例（如 “购买” vs “未购买”）在训练和测试样本中（几乎）相同。 + +### 整洁数据 + +#### 汇集列 + +将多个变量合并为一列。如果加载了`diamonds`数据集，从`转换类型` 下拉菜单中选择 `汇集列` 后，在 `选择变量` 框中选择`cut`和`color`。这将创建新变量`key`和`value`。`key`有两个水平（即`cut`和`color`），`value`包含`cut`和`color`的所有值。 + +#### 扩展列 + +将一列 `扩展` 为多列。与 `汇集`相反。有关`整洁数据` 的详细讨论，参见整洁数据说明文档。 + +### R 函数 + +有关 Radiant 中用于数据转换的相关 R 函数概述，请参见“数据> 转换” 。 diff --git a/radiant.data/inst/app/tools/help/view.Rmd b/radiant.data/inst/app/tools/help/view.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..10738474c84f216159f1a1cdfc06bb5fb71aabcd --- /dev/null +++ b/radiant.data/inst/app/tools/help/view.Rmd @@ -0,0 +1,112 @@ +> 以交互式表格显示数据 + +### 数据集 + +从 `数据集` 下拉菜单中选择一个数据集。文件通过`数据 > 管理` 标签加载到 Radiant 中。 + +### 过滤数据 + +有多种方法可选择数据子集进行查看。左侧的 `过滤数据` 框（点击复选框）可与`>`和`<`等符号配合使用。你也可以组合子集命令，例如，`x > 3 & y == 2`将只显示变量`x`的值大于 3**且**变量`y`等于 2 的行。注意，在 R 和大多数其他编程语言中，`=`用于**赋值**，`==`用于判断值是否**相等**。相反，`!=`用于判断两个值是否**不相等**。你还可以使用包含**或（OR）** 条件的表达式。例如，要选择 “Salary” 小于 100,000 美元**或**大于 20,000 美元的行，使用`Salary > 20000 | Salary < 100000`。`|`是**或（OR）** 的符号，`&`是**且（AND）** 的符号。 + +也可以使用日期进行过滤。例如，要选择 2014 年 6 月 1 日之前的行，在过滤框中输入`date < "2014-6-1"`并按回车。 + +你还可以使用字符串匹配选择行。例如，输入`grepl('ood', cut)`可选择`cut`为 “Good” 或 “Very good” 的行。默认情况下，此搜索区分大小写。如需不区分大小写的搜索，使用`grepl("GOOD", cut, ignore.case = TRUE)`。在 `过滤` 框中输入语句并按回车，屏幕上会显示结果；如果表达式无效，框下方会显示错误信息。 + +重要的是，这些过滤器是**持久的**，将应用于 Radiant 中的所有分析。要停用过滤器，取消勾选 `过滤数据` 复选框。要移除过滤器，直接删除即可。 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    Operator Description Example
    `<` less than `price < 5000`
    `<=` less than or equal to `carat <= 2`
    `>` greater than `price > 1000`
    `>=` greater than or equal to `carat >= 2`
    `==` exactly equal to `cut == 'Fair'`
    `!=` not equal to `cut != 'Fair'`
    `|` x OR y `price > 10000 | cut == 'Premium'`
    `&` x AND y `carat < 2 & cut == 'Fair'`
    `%in%` x is one of y `cut %in% c('Fair', 'Good')`
    is.na is missing `is.na(price)`
    + +过滤器也可与 R 代码结合使用，快速查看所选数据集的样本。例如，`runif(n()) > .9`可用于抽样数据中约 10% 的行，`1:n() < 101`将只选择数据的前 100 行。 + +### 选择要显示的变量 + +默认情况下，会显示数据中的所有列。点击任意变量可单独聚焦该变量。要选择多个变量，使用键盘上的 SHIFT 键和箭头键。在 Mac 上，可使用 CMD 键选择多个变量；在 Windows 上，使用 CTRL 键可达到相同效果。要选择所有变量，使用 CTRL-A（Mac 上为 CMD-A）。 + +### 浏览数据 + +默认情况下，一次仅显示 10 行数据。你可以通过 “显示…… 条目（Show ... entries）” 下拉菜单更改此设置。点击屏幕右下角的 “下一页（Next）” 和 “上一页（Previous）” 按钮翻阅数据。 + +### 排序 + +点击表格中的列标题可对数据排序。再次点击将在升序和降序排序之间切换。要同时按多列排序，按住 Shift 键，然后点击第 2 列、第 3 列等进行排序。 + +### 列过滤和搜索 + +对于具有有限个不同值的变量（即因子），你可以从变量名下的列过滤器中选择要保留的水平。例如，要过滤出切工为理想（Ideal）的行，点击`cut`列标题下方的框，从显示的下拉菜单中选择`Ideal`。你也可以在这些列过滤器中输入字符串，然后按回车。注意，匹配不区分大小写。实际上，输入`eal`也会得到相同结果，因为搜索会匹配字符串的任意部分。同样，你可以输入字符串来基于字符变量（如街道名称）选择行。 + +对于数值变量，列过滤器框有一些特殊功能，使其几乎与 `过滤数据` 框一样强大。对于数值和整数变量，你可以使用`...`表示范围。例如，要选择价格在 500 美元到 2000 美元之间的`price`值，输入`500 ... 2000`并按回车。该范围包含输入的值。此外，如果我们想过滤`carat`，`0.32 ...`将只显示克拉值大于或等于 0.32 的钻石。数值变量还有一个滑块，可用于定义要保留的值的范围。 + +如果你想更高级地操作，可以使用右上角的搜索框，通过**正则表达式**搜索所有列。例如，要查找**任何**列中条目以数字 72 结尾的所有行，输入`72$`（即`$`符号用于表示条目的结尾）。要查找所有条目以 60 开头的行，使用`^60`（即`^`用于表示条目的第一个字符）。正则表达式的搜索功能非常强大，但这是一个较广的主题。要了解更多关于正则表达式的内容，参见此教程。 + +### 存储过滤器 + +重要的是，列排序、列过滤器和搜索**不具有持久性**。要将这些设置存储用于 Radiant 的其他部分，按 “存储（Store）” 按钮。你可以通过更改 `存储` 按钮左侧文本输入框中的值，将数据和设置存储在不同的数据集名称下。此功能也可用于选择要保留的变量子集：只需选择你想保留的变量，然后按 `存储` 按钮。要更精确地控制要保留或移除的变量，并指定它们在数据集中的顺序，请使用 “数据 > 转换” 标签。 + +要以 csv 格式下载数据，点击屏幕右上角的图标。 + +点击屏幕左下角的报告（）图标，或按键盘上的`ALT-enter`，将 Radiant 使用的过滤和排序命令添加到“报告> Rmd”中的（可重复的）报告中。 + +### R 函数 + +有关 Radiant 中用于查看、搜索和过滤数据的相关 R 函数概述，请参见“数据> 查看” 。 diff --git a/radiant.data/inst/app/tools/help/view.md b/radiant.data/inst/app/tools/help/view.md new file mode 100644 index 0000000000000000000000000000000000000000..10738474c84f216159f1a1cdfc06bb5fb71aabcd --- /dev/null +++ b/radiant.data/inst/app/tools/help/view.md @@ -0,0 +1,112 @@ +> 以交互式表格显示数据 + +### 数据集 + +从 `数据集` 下拉菜单中选择一个数据集。文件通过`数据 > 管理` 标签加载到 Radiant 中。 + +### 过滤数据 + +有多种方法可选择数据子集进行查看。左侧的 `过滤数据` 框（点击复选框）可与`>`和`<`等符号配合使用。你也可以组合子集命令，例如，`x > 3 & y == 2`将只显示变量`x`的值大于 3**且**变量`y`等于 2 的行。注意，在 R 和大多数其他编程语言中，`=`用于**赋值**，`==`用于判断值是否**相等**。相反，`!=`用于判断两个值是否**不相等**。你还可以使用包含**或（OR）** 条件的表达式。例如，要选择 “Salary” 小于 100,000 美元**或**大于 20,000 美元的行，使用`Salary > 20000 | Salary < 100000`。`|`是**或（OR）** 的符号，`&`是**且（AND）** 的符号。 + +也可以使用日期进行过滤。例如，要选择 2014 年 6 月 1 日之前的行，在过滤框中输入`date < "2014-6-1"`并按回车。 + +你还可以使用字符串匹配选择行。例如，输入`grepl('ood', cut)`可选择`cut`为 “Good” 或 “Very good” 的行。默认情况下，此搜索区分大小写。如需不区分大小写的搜索，使用`grepl("GOOD", cut, ignore.case = TRUE)`。在 `过滤` 框中输入语句并按回车，屏幕上会显示结果；如果表达式无效，框下方会显示错误信息。 + +重要的是，这些过滤器是**持久的**，将应用于 Radiant 中的所有分析。要停用过滤器，取消勾选 `过滤数据` 复选框。要移除过滤器，直接删除即可。 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    Operator Description Example
    `<` less than `price < 5000`
    `<=` less than or equal to `carat <= 2`
    `>` greater than `price > 1000`
    `>=` greater than or equal to `carat >= 2`
    `==` exactly equal to `cut == 'Fair'`
    `!=` not equal to `cut != 'Fair'`
    `|` x OR y `price > 10000 | cut == 'Premium'`
    `&` x AND y `carat < 2 & cut == 'Fair'`
    `%in%` x is one of y `cut %in% c('Fair', 'Good')`
    is.na is missing `is.na(price)`
    + +过滤器也可与 R 代码结合使用，快速查看所选数据集的样本。例如，`runif(n()) > .9`可用于抽样数据中约 10% 的行，`1:n() < 101`将只选择数据的前 100 行。 + +### 选择要显示的变量 + +默认情况下，会显示数据中的所有列。点击任意变量可单独聚焦该变量。要选择多个变量，使用键盘上的 SHIFT 键和箭头键。在 Mac 上，可使用 CMD 键选择多个变量；在 Windows 上，使用 CTRL 键可达到相同效果。要选择所有变量，使用 CTRL-A（Mac 上为 CMD-A）。 + +### 浏览数据 + +默认情况下，一次仅显示 10 行数据。你可以通过 “显示…… 条目（Show ... entries）” 下拉菜单更改此设置。点击屏幕右下角的 “下一页（Next）” 和 “上一页（Previous）” 按钮翻阅数据。 + +### 排序 + +点击表格中的列标题可对数据排序。再次点击将在升序和降序排序之间切换。要同时按多列排序，按住 Shift 键，然后点击第 2 列、第 3 列等进行排序。 + +### 列过滤和搜索 + +对于具有有限个不同值的变量（即因子），你可以从变量名下的列过滤器中选择要保留的水平。例如，要过滤出切工为理想（Ideal）的行，点击`cut`列标题下方的框，从显示的下拉菜单中选择`Ideal`。你也可以在这些列过滤器中输入字符串，然后按回车。注意，匹配不区分大小写。实际上，输入`eal`也会得到相同结果，因为搜索会匹配字符串的任意部分。同样，你可以输入字符串来基于字符变量（如街道名称）选择行。 + +对于数值变量，列过滤器框有一些特殊功能，使其几乎与 `过滤数据` 框一样强大。对于数值和整数变量，你可以使用`...`表示范围。例如，要选择价格在 500 美元到 2000 美元之间的`price`值，输入`500 ... 2000`并按回车。该范围包含输入的值。此外，如果我们想过滤`carat`，`0.32 ...`将只显示克拉值大于或等于 0.32 的钻石。数值变量还有一个滑块，可用于定义要保留的值的范围。 + +如果你想更高级地操作，可以使用右上角的搜索框，通过**正则表达式**搜索所有列。例如，要查找**任何**列中条目以数字 72 结尾的所有行，输入`72$`（即`$`符号用于表示条目的结尾）。要查找所有条目以 60 开头的行，使用`^60`（即`^`用于表示条目的第一个字符）。正则表达式的搜索功能非常强大，但这是一个较广的主题。要了解更多关于正则表达式的内容，参见此教程。 + +### 存储过滤器 + +重要的是，列排序、列过滤器和搜索**不具有持久性**。要将这些设置存储用于 Radiant 的其他部分，按 “存储（Store）” 按钮。你可以通过更改 `存储` 按钮左侧文本输入框中的值，将数据和设置存储在不同的数据集名称下。此功能也可用于选择要保留的变量子集：只需选择你想保留的变量，然后按 `存储` 按钮。要更精确地控制要保留或移除的变量，并指定它们在数据集中的顺序，请使用 “数据 > 转换” 标签。 + +要以 csv 格式下载数据，点击屏幕右上角的图标。 + +点击屏幕左下角的报告（）图标，或按键盘上的`ALT-enter`，将 Radiant 使用的过滤和排序命令添加到“报告> Rmd”中的（可重复的）报告中。 + +### R 函数 + +有关 Radiant 中用于查看、搜索和过滤数据的相关 R 函数概述，请参见“数据> 查看” 。 diff --git a/radiant.data/inst/app/tools/help/visualize.md b/radiant.data/inst/app/tools/help/visualize.md new file mode 100644 index 0000000000000000000000000000000000000000..a425ee2ef95f8d7c8e573402581d51c55f86c6c3 --- /dev/null +++ b/radiant.data/inst/app/tools/help/visualize.md @@ -0,0 +1,142 @@ +> 可视化数据 + +### 过滤数据 + +使用 `过滤数据` 框选择（或排除）数据中的特定行集。详见“数据> 查看”的帮助文件。 + +### 图表类型 + +选择你想要的图表类型。例如，加载`diamonds`数据后，选择`分布` 和所有（X）变量（使用 CTRL-a 或 CMD-a）。这将为数据集中的所有数值变量创建直方图，为所有分类变量创建条形图。密度图仅可用于数值变量。散点图用于可视化两个变量之间的关系：选择一个或多个变量作为 Y 轴变量，一个或多个变量作为 X 轴变量。如果其中一个变量是分类变量（即因子 {factor}），应将其指定为 X 轴变量。可通过 “颜色（Color）” 或 “大小（Size）” 下拉菜单添加其他变量的信息。折线图与散点图类似，但会将数据点连接起来，特别适用于时间序列数据。曲面图与 “热力图（Heat maps）” 类似，需要 3 个输入变量：X、Y 和填充色（Fill）。条形图用于展示分类（或整数）变量（X）与数值变量（Y）的（均值）值之间的关系。箱线图也用于 Y 为数值变量、X 为分类变量的情况，它比条形图包含更多信息，但解读起来也稍复杂一些。 + +> 注意，在条形图中，当分类变量（`factor`）被选为 Y 轴变量时，若所选函数需要，该变量将被转换为数值变量。如果因子水平是数值型的，这些数值将用于所有计算。由于均值、标准差等统计量对非二元分类变量不适用，这类变量将被转换为 0-1（二元）变量，其中第一个水平编码为 1，其他所有水平编码为 0。例如，如果我们从`diamonds`数据中选择`color`作为 Y 轴变量，并选择`mean`作为应用函数，那么每个条形将表示取值为`D`的观测比例。 + +### 箱线图 + +箱线的上下 “边缘（hinges）” 对应数据的第一和第三四分位数（第 25 和第 75 百分位数）。中间的边缘是数据的中位数。上须线从上边缘（即箱体顶部）延伸至数据中在上边缘 1.5 倍四分位距范围内的最大值。四分位距（IQR）是第 25 和第 75 百分位数之间的距离。下须线从下边缘延伸至数据中下边缘 1.5 倍四分位距范围内的最小值。须线以外的数据可能是异常值，将以点的形式绘制（如 Tukey 所建议）。 + +总之： + +1. 下须线从 Q1 延伸至数据最小值与（Q1 - 1.5×IQR）中的较大值 +2. 上须线从 Q3 延伸至数据最大值与（Q3 + 1.5×IQR）中的较小值 + +其中 Q1 是第 25 百分位数，Q3 是第 75 百分位数。你可能需要多读几遍上述两点才能理解。下方图表有助于解释箱线图的结构。 + +

    +来源 + +### 子图和热力图 + +`行分面` 和 `列分面` 可用于将数据拆分为不同组，并为每组创建单独的图表。 + +如果选择散点图或折线图，会显示 “颜色（Color）” 下拉菜单。选择 “颜色” 变量将创建一种热力图，其中颜色与 “颜色” 变量的值相关联。在折线图中从 “颜色” 下拉菜单选择分类变量，会将数据拆分为组，并为每组显示不同颜色的线。 + +### 回归线、局部加权回归线和抖动 + +要在散点图中添加线性或非线性回归线，勾选 `线`和 / 或`局部加权回归`框。如果数据取值有限，`抖动` 功能有助于更好地了解大多数数据点的分布位置。`抖动` 会为每个数据点添加一个小的随机值，使它们在图表中不完全重叠。 + +### 坐标轴缩放 + +散点图中变量之间的关系可能是非线性的。我们可以对数据应用多种转换，使这种关系变为（近似）线性（见“数据> 转换”），以便更容易通过例如“模型> 估计 > 线性回归（OLS）”进行估计。对业务数据最常用的数据转换可能是（自然）对数转换。要查看对数转换是否适合你的数据，勾选 “X 轴对数（Log X）” 和 / 或 “Y 轴对数（Log Y）” 框（例如，对于散点图或条形图）。 + +默认情况下，使用 `行分面` 时，所有子图的 Y 轴刻度相同。要使每个子图的 Y 轴刻度独立，点击 `Y 轴缩放` 复选框。 + +### 翻转坐标轴 + +要交换 X 轴和 Y 轴上的变量，勾选 `翻转` 框。 + +### 图表高度和宽度 + +要调整图表大小，修改屏幕左下角的高度和宽度输入框中的值。 + +### 保存图表 + +保存图表的最佳方式是通过点击屏幕左下角的报告（）图标或按键盘上的`ALT-enter`生成`visualize`命令。或者，点击屏幕右上角的图标将 png 文件保存到磁盘。 + +### 在 “报告> Rmd” 中定制图表 + +要定制图表，首先通过点击屏幕左下角的报告（）图标或按键盘上的`ALT-enter`生成`visualize`命令。下方示例说明了如何在“报告> Rmd”标签中定制命令。注意`custom`被设为`TRUE`。 + +```r +visualize(diamonds, yvar = "price", xvar = "carat", type = "scatter", custom = TRUE) + + labs( + title = "A scatterplot", + y = "Price in $", + x = "Carats" + ) +``` + +图表的默认分辨率为 144 dots per inch（dpi）。你可以在 “报告> Rmd” 中调高或调低此设置。例如，下方代码块标题确保图表宽 7 英寸、高 3.5 英寸，分辨率为 600 dpi。 + +```` ```{r fig.width = 7, fig.height = 3.5, dpi = 600} ```` + +如果你安装了`svglite`包，下方代码块标题将生成高质量的`svg`格式图表。 + +```` ```{r fig.width = 7, fig.height = 3.5, dev = "svglite"} ```` + +**一些常见的定制命令：** + +* 添加标题：`+ labs(title = "我的标题")` +* 添加副标题：`+ labs(subtitle = "我的副标题")` +* 在图表下方添加说明：`+ labs(caption = "基于……的数据")` +* 更改标签：`+ labs(x = "我的X轴标签")`或`+ labs(y = "我的Y轴标签")` +* 移除所有图例：`+ theme(legend.position = "none")` +* 更改图例标题：`+ labs(color = "新图例标题")`或`+ labs(fill = "新图例标题")` +* 旋转刻度标签：`+ theme(axis.text.x = element_text(angle = 90, hjust = 1))` +* 设置图表范围：`+ ylim(5000, 8000)`或`+ xlim("VS1","VS2")` +* 移除大小图例：`+ scale_size(guide = "none")` +* 更改大小范围：`+ scale_size(range=c(1,6))` +* 绘制水平线：`+ geom_hline(yintercept = 0.1)` +* 绘制垂直线：`+ geom_vline(xintercept = 8)` +* 将 Y 轴缩放为百分比：`+ scale_y_continuous(labels = scales::percent)` +* 将 Y 轴以百万为单位：`+ scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6))` +* 以美元显示 Y 轴：`+ scale_y_continuous(labels = scales::dollar_format())` +* 使用逗号作为 Y 轴千位分隔符：`+ scale_y_continuous(labels = scales::comma)` + +有关如何定制图表用于展示的更多内容，参见http://r4ds.had.co.nz/graphics-for-communication.html。 + +另见 ggplot2 文档网站https://ggplot2.tidyverse.org。 + +假设我们在 “数据> 可视化” 中使用钻石数据创建了三组条形图。要在图表组上方添加标题并设置单列布局，可使用`patchwork`如下： + +```r +library(patchwork) +plot_list <- visualize( + diamonds, + xvar = c("clarity", "cut", "color"), + yvar = "price", + type = "bar", + custom = TRUE +) +wrap_plots(plot_list, ncol = 1) + plot_annotation(title = "Three bar plots") +``` + +有关如何定制图表组的更多信息，参见patchwork 文档网站。 + +### 在 “报告> Rmd” 中制作交互式图表 + +使用`plotly`库可将 Radiant 中生成的（大多数）图表转换为交互式图形。设置`custom = TRUE`后，可使用`ggplotly`函数转换单个图表。见下方示例： + +```r +visualize(diamonds, xvar = "price", custom = TRUE) %>% + ggplotly() %>% + render() +``` + +如果创建了多个图表，可使用`plotly`包的`subplot`函数。为`nrows`参数提供值以设置图表布局网格。在下方示例中创建了四个图表，由于`nrow = 2`，图表将以 2×2 网格显示。 + +```r +visualize(diamonds, xvar = c("carat", "clarity", "cut", "color"), custom = TRUE) %>% + subplot(nrows = 2) %>% + render() +``` + +有关`plotly`库的更多信息，参见下方链接： + +* 入门指南：https://plot.ly/r/getting-started/ +* 参考手册：https://plot.ly/r/reference/ +* 书籍：https://cpsievert.github.io/plotly_book +* 代码：https://github.com/ropensci/plotly + +### R 函数 + +有关 Radiant 中用于数据可视化的相关 R 函数概述，请参见“数据> 可视化” 。 diff --git a/radiant.data/inst/app/ui.R b/radiant.data/inst/app/ui.R new file mode 100644 index 0000000000000000000000000000000000000000..07973f50ed4ab5694aeea96920f57e65f6a9a85a --- /dev/null +++ b/radiant.data/inst/app/ui.R @@ -0,0 +1,12 @@ +## ui for data menu in radiant +navbar_proj( + do.call( + navbarPage, + c( + "Radiant for R", + getOption("radiant.nav_ui"), + getOption("radiant.shared_ui"), + help_menu("help_data_ui") + ) + ) +) diff --git a/radiant.data/inst/app/www/imgs/by-nc-sa.png b/radiant.data/inst/app/www/imgs/by-nc-sa.png new file mode 100644 index 0000000000000000000000000000000000000000..76eb5da461b41405c500a557253eec5f65169519 Binary files /dev/null and b/radiant.data/inst/app/www/imgs/by-nc-sa.png differ diff --git a/radiant.data/inst/app/www/imgs/by-sa.png b/radiant.data/inst/app/www/imgs/by-sa.png new file mode 100644 index 0000000000000000000000000000000000000000..2332cc49dd634c62e4013e13e5e4f06747c7e250 Binary files /dev/null and b/radiant.data/inst/app/www/imgs/by-sa.png differ diff --git a/radiant.data/inst/app/www/imgs/icon.png b/radiant.data/inst/app/www/imgs/icon.png new file mode 100644 index 0000000000000000000000000000000000000000..e27a5d7ce9c4d0db2495b75f7fd8b4bd091921a7 Binary files /dev/null and b/radiant.data/inst/app/www/imgs/icon.png differ diff --git a/radiant.data/inst/app/www/js/draggable_modal.js b/radiant.data/inst/app/www/js/draggable_modal.js new file mode 100644 index 0000000000000000000000000000000000000000..f740e6f2c26b5ab49edade601ffaab2f10e7cf17 --- /dev/null +++ b/radiant.data/inst/app/www/js/draggable_modal.js @@ -0,0 +1,30 @@ +// From http://stackoverflow.com/a/27122472/1974918 +// $(function(){ +// $('.modal').modal({ keyboard: false, +// show: true +// }); +// // Jquery draggable +// $('.modal-dialog').draggable({ +// handle: ".modal-header" +// }); +// }); + +// https://stackoverflow.com/questions/45062397/make-bootstrap-modal-draggable-and-keep-background-usable/45062993 +// perhaps try again when jquery-ui.js is upgraded in the next shiny release? +// $('#manage_help').click(function() { +// // reset modal if it isn't visible +// if (!($('.modal.in').length)) { +// $('.modal-dialog').css({ +// top: 0, +// left: 0 +// }); +// } +// $('#manage_help').modal({ +// backdrop: false, +// show: true +// }); + +// $('.modal-dialog').draggable({ +// handle: ".modal-header" +// }); +// }); \ No newline at end of file diff --git a/radiant.data/inst/app/www/js/math_reset.js b/radiant.data/inst/app/www/js/math_reset.js new file mode 100644 index 0000000000000000000000000000000000000000..90262b880899fb7fd9be64cac279e2f3272f257c --- /dev/null +++ b/radiant.data/inst/app/www/js/math_reset.js @@ -0,0 +1,33 @@ +// Line below was in ui.R. No longer needed +// tags$head(HTML("")), +// Use $\setCounter{-10}$ at the top of a file to reset the equation counter for +// each markdown file +// If you do not use this feature, equation number will start with (1) on the +// case that is opened first - probably not what you want + +// from https://groups.google.com/d/msg/mathjax-users/uA-l1L9yVTA/-adeXpevMIkJ +window.MathJax = { + jax: ["input/TeX", "output/HTML-CSS"], //just some defaults + extensions: ["tex2jax.js", "MathMenu.js", "MathZoom.js"], + TeX: { + extensions: ["AMSmath.js", "AMSsymbols.js"], + equationNumbers: { + autoNumber: "all" + } + }, + AuthorInit: function() { + MathJax.Hub.Register.StartupHook("TeX AMSmath Ready", function() { + MathJax.InputJax.TeX.Definitions.Add({ + macros: { + setCounter: "setCounter" + } + }, null, true); + MathJax.InputJax.TeX.Parse.Augment({ + setCounter: function(name) { + var num = parseInt(this.GetArgument(name)); + MathJax.Extension["TeX/AMSmath"].number = num; + } + }); + }); + } +}; diff --git a/radiant.data/inst/app/www/js/message-handler.js b/radiant.data/inst/app/www/js/message-handler.js new file mode 100644 index 0000000000000000000000000000000000000000..a2808c0cd10633785cc5b7ea916688795eff6caf --- /dev/null +++ b/radiant.data/inst/app/www/js/message-handler.js @@ -0,0 +1,9 @@ +// This receives messages of type "testmessage" from the server. +// See https://shiny.posit.co/gallery/server-to-client-custom-messages.html +// for details +// Code copied from https://github.com/rstudio/shiny-examples/tree/master/088-action-pattern1 +Shiny.addCustomMessageHandler("message", + function(message) { + alert(JSON.stringify(message)); + } +); diff --git a/radiant.data/inst/app/www/js/returnTextAreaBinding.js b/radiant.data/inst/app/www/js/returnTextAreaBinding.js new file mode 100644 index 0000000000000000000000000000000000000000..ccb84ffa7ee59db8e26b793dbc540c06807f1b83 --- /dev/null +++ b/radiant.data/inst/app/www/js/returnTextAreaBinding.js @@ -0,0 +1,62 @@ +// based on https://gist.github.com/xiaodaigh/7150112 +var returnTextAreaBinding = new Shiny.InputBinding(); +$.extend(returnTextAreaBinding, { + + find: function (scope) { + return $(scope).find('.returnTextArea'); + }, + getId: function (el) { + return $(el).attr('id') + }, + getValue: function (el) { + return el.value; + }, + setValue: function (el, value) { + el.value = value; + }, + subscribe: function (el, callback) { + // callback when if enter key is pressed: http://stackoverflow.com/a/30149302/1974918 + $(el).on('keydown.textInputBinding input.textInputBinding', function (event) { + if (event.keyCode == 13) { + event.preventDefault(); + callback(); + } + // print value using console.log(event.target.value); + if (event.target.value == "") { + callback(); + } + }); + + // callback when updateTextInput is used to reset value to "" + $(el).on('change.textInputBinding', function (event) { + if (event.target.value == "") { + callback(); + } else { + callback(false); + } + }); + }, + unsubscribe: function (el) { + $(el).off('.textInputBinding'); + }, + receiveMessage: function (el, data) { + if (data.hasOwnProperty('value')) + this.setValue(el, data.value); + if (data.hasOwnProperty('label')) + $(el).parent().find('label[for=' + el.id + ']').text(data.label); + $(el).trigger('change'); + }, + getState: function (el) { + return { + label: $(el).parent().find('label[for=' + el.id + ']').text(), + value: el.value + }; + }, + getRatePolicy: function () { + return { + policy: 'debounce', + delay: 250 + }; + } +}); +Shiny.inputBindings.register(returnTextAreaBinding, 'shiny.returnTextArea'); diff --git a/radiant.data/inst/app/www/js/returnTextInputBinding.js b/radiant.data/inst/app/www/js/returnTextInputBinding.js new file mode 100644 index 0000000000000000000000000000000000000000..f6e2fc924c982f670c359181d554cd35dda96998 --- /dev/null +++ b/radiant.data/inst/app/www/js/returnTextInputBinding.js @@ -0,0 +1,64 @@ +// based on https://gist.github.com/xiaodaigh/7150112 +var returnTextInputBinding = new Shiny.InputBinding(); +$.extend(returnTextInputBinding, { + find: function(scope) { + return $(scope).find('input[type="text"]'); + }, + getId: function(el) { + return Shiny.InputBinding.prototype.getId.call(this, el) || el.name; + }, + getValue: function(el) { + return el.value; + }, + setValue: function(el, value) { + el.value = value; + }, + subscribe: function(el, callback) { + // same setup as returnTextAreaBinding.js + // callback when if enter key is pressed: http://stackoverflow.com/a/30149302/1974918 + $(el).on('keydown.textInputBinding input.textInputBinding', function(event) { + if(event.keyCode == 13) { + event.preventDefault(); + callback(); + } + // print value using console.log(event.target.value); + if(event.target.value == "") { + callback(); + } + }); + + // callback when updateTextInput is used to reset value to "" + $(el).on('change.textInputBinding', function(event) { + if(event.target.value == "") { + callback(); + } else { + callback(false); + } + }); + }, + unsubscribe: function(el) { + $(el).off('.textInputBinding'); + }, + receiveMessage: function(el, data) { + if (data.hasOwnProperty('value')) + this.setValue(el, data.value); + + if (data.hasOwnProperty('label')) + $(el).parent().find('label[for=' + el.id + ']').text(data.label); + + $(el).trigger('change'); + }, + getState: function(el) { + return { + label: $(el).parent().find('label[for=' + el.id + ']').text(), + value: el.value + }; + }, + getRatePolicy: function() { + return { + policy: 'debounce', + delay: 250 + }; + } +}); +Shiny.inputBindings.register(returnTextInputBinding, 'returnTextInput'); diff --git a/radiant.data/inst/app/www/js/run_return.js b/radiant.data/inst/app/www/js/run_return.js new file mode 100644 index 0000000000000000000000000000000000000000..a09435675d7337016101f351e5c93c420abcb4b3 --- /dev/null +++ b/radiant.data/inst/app/www/js/run_return.js @@ -0,0 +1,200 @@ +// based on http://stackoverflow.com/a/32340906/1974918 +// and http://stackoverflow.com/a/8774101/1974918 +// check out https://www.youtube.com/watch?v=tM0q3u220mI for debugging +// https://stackoverflow.com/questions/35831811/register-repeated-keyboard-presses-in-shiny +// https://github.com/rstudio/shiny/issues/928 +// https://stackoverflow.com/questions/32002170/r-shiny-enabling-keyboard-shortcuts +// https://stackoverflow.com/questions/47569992/home-button-in-header-in-r-shiny-dashboard +$(document).keydown(function (event) { + + // console.log(document.activeElement) + if ($(".btn-success:visible" || ".shiny-bound-input:visible").is(":visible") && + (event.metaKey || event.ctrlKey || event.shiftKey) && event.keyCode == 13) { + $(".btn-success:visible" || ".shiny-bound-input:visible").click(); + } else if ($(".fa-edit:visible" || ".shiny-bound-input:visible").is(":visible") && + event.altKey && event.keyCode == 13) { + $(".fa-edit:visible" || ".shiny-bound-input:visible").click(); + } else if ($(".fa-question:visible" || ".shiny-bound-input:visible").is(":visible") && + event.keyCode == 112) { + $(".fa-question:visible" || ".shiny-bound-input:visible").click(); + } else if ($(".fa-camera:visible" || ".shiny-bound-input:visible").is(":visible") && + (event.metaKey || event.ctrlKey) && event.keyCode == 80) { + $(".fa-camera:visible" || ".shiny-bound-input:visible").click(); + event.preventDefault(); + } else if ($(".fa-download:visible" || ".shiny-bound-input:visible").is(":visible") && + (event.metaKey || event.ctrlKey) && event.shiftKey === false && event.keyCode == 83) { + $(".fa-download:visible" || ".shiny-bound-input:visible").click(); + event.preventDefault(); + } else if ($("#updateDescr").is(":visible") && (event.metaKey || event.ctrlKey) && event.keyCode == 13) { + $("#updateDescr").click(); + event.preventDefault(); + } else if ($("#rmd_read_files").is(":visible") && (event.metaKey || event.ctrlKey) && event.shiftKey === false && event.keyCode == 79) { + $("#rmd_read_files").click(); + event.preventDefault(); + } else if ($("#r_read_files").is(":visible") && (event.metaKey || event.ctrlKey) && event.shiftKey === false && event.keyCode == 79) { + $("#r_read_files").click(); + event.preventDefault(); + } else if ($("#rmd_save").is(":visible") && (event.metaKey || event.ctrlKey) && event.shiftKey === false && event.keyCode == 83) { + // different because rmd_save is a link see https://stackoverflow.com/a/3738603/1974918 + document.getElementById("rmd_save").click(); + event.preventDefault(); + } else if ($("#r_save").is(":visible") && (event.metaKey || event.ctrlKey) && event.shiftKey === false && event.keyCode == 83) { + // different because r_save is a link see https://stackoverflow.com/a/3738603/1974918 + document.getElementById("r_save").click(); + event.preventDefault(); + } else if ((event.metaKey || event.ctrlKey) && event.shiftKey && event.keyCode == 83) { + document.getElementById("state_save").click(); + event.preventDefault(); + } else if ((event.metaKey || event.ctrlKey) && event.shiftKey && event.keyCode == 79) { + document.getElementById("state_load").click(); + event.preventDefault(); + } else if ($("#uploadfile").is(":visible") && (event.metaKey || event.ctrlKey) && + event.shiftKey === false && event.keyCode == 79) { + $("#uploadfile").click(); + event.preventDefault(); + } else if ($("#man_save_data").is(":visible") && (event.metaKey || event.ctrlKey) && + event.shiftKey === false && event.keyCode == 83) { + $("#man_save_data").click(); + event.preventDefault(); + } + + // focusing in text (area) inputs + if ($("#data_rename").is(":focus") && event.keyCode == 13) { + $("#renameButton").click(); + } else if ($("#url_csv").is(":focus") && event.keyCode == 13) { + $("#url_csv_load").click(); + } else if ($("#url_rds").is(":focus") && event.keyCode == 13) { + $("#url_rds_load").click(); + } else if ($("#view_name").is(":focus") && event.keyCode == 13) { + $("#view_store").click(); + } else if ($("#pvt_name").is(":focus") && event.keyCode == 13) { + $("#pvt_store").click(); + } else if ($("#expl_name").is(":focus") && event.keyCode == 13) { + $("#expl_store").click(); + } else if ($("#tr_name").is(":focus") && event.keyCode == 13) { + $("#tr_store").click(); + } else if ($("#cmb_name").is(":focus") && event.keyCode == 13) { + $("#cmb_store").click(); + } else if ($("#man_rename_data").is(":focus") && + document.getElementById('man_rename_data').checked === true) { + $("#data_rename").focus(); + } else if ($("#man_add_descr").is(":focus") && + document.getElementById('man_add_descr').checked === true) { + $("#man_data_descr").focus(); + } else if ($("#show_filter").is(":focus") && $("#show_filter")[0].checked) { + $("#data_filter").focus(); + } else if ($("#tr_change_type").next(".selectize-control").find(".focus").length > 0) { + // can set focus for selectize input + // https://stackoverflow.com/questions/48104027/determine-if-selectize-input-has-focus + if ($('#tr_change_type').selectize()[0].selectize.getValue() === "recode") { + $("#tr_recode").focus(); + } else if ($('#tr_change_type').selectize()[0].selectize.getValue() === "clip") { + $("#tr_paste").focus(); + } else if ($('#tr_change_type').selectize()[0].selectize.getValue() === "create") { + $("#tr_create").focus(); + } + } else if ($("#rmd_knit").is(":visible") && document.activeElement === document.body) { + $(".ace_text-input").focus(); + } else if ($("#r_knit").is(":visible") && document.activeElement === document.body) { + $(".ace_text-input").focus(); + } + + // needed to address https://github.com/rstudio/shiny/issues/1916 + $("input:text").attr("spellcheck", "false"); +}); + +$(function () { + $("#state_save_link").on('click', function (e) { + e.preventDefault(); + $("#state_save").trigger('click'); + }); + $("#state_load_link").on('click', function (e) { + e.preventDefault(); + $("#state_load").trigger('click'); + }); + $("#state_upload_link").on('click', function (e) { + e.preventDefault(); + $("#state_upload").trigger('click'); + }); +}); + +// from https://stackoverflow.com/a/33251536/1974918 by Dean Attali +$(document).on("shiny:connected", function () { + Shiny.onInputChange("get_screen_width", $(window).width()); +}); + +// from https://github.com/rstudio/shiny/issues/2033#issuecomment-386438821 +$(document).on('shiny:disconnected', function () { + window.parent.postMessage('disconnected', '*'); +}); + +// based on https://stackoverflow.com/questions/61690502/shiny-setinputvalue-only-works-on-the-2nd-try +function get_img_src() { + var img_src = $("#screenshot_preview img").attr("src"); + Shiny.setInputValue("img_src", img_src); +} + +function generate_screenshot() { + var clonedHeight = document.querySelector('body').scrollHeight; + html2canvas($("body")[0], { + y: 42, // Set the starting point to 100 pixels from the top + // width: document.body.scrollWidth, + height: document.body.scrollHeight, // set this on the cloned document + onclone: (clonedDocument) => { + Array.from(clonedDocument.querySelectorAll("textarea")).forEach((textArea) => { + if (textArea && textArea.value.length > 30) { + const labelFor = textArea.getAttribute("id") + const label = clonedDocument.querySelector(`label[for="${labelFor}"]`) + const div = clonedDocument.createElement("div") + div.innerText = textArea.value + div.style.border = "1px solid #d3d3d3" + div.style.padding = "10px 10px 10px 10px" + div.style.width = "100%" + div.style.borderRadius = "5px" + div.style.boxSizing = "border-box"; + div.style.margin = "0"; + div.style.backgroundColor = "white" + textArea.style.display = "none" + textArea.parentElement.append(label, div); + } + }) + + Array.from(clonedDocument.querySelectorAll('select[multiple]')).forEach((msel) => { + const multiSelect = document.querySelector("#" + msel.getAttribute("id")); + if (multiSelect && multiSelect.selectedOptions.length > 1) { + const clonedMultiSelect = clonedDocument.querySelector("#" + msel.getAttribute("id")); + const list = clonedDocument.createElement('ul') + Array.from(multiSelect.selectedOptions).forEach((option) => { + const item = clonedDocument.createElement('li') + item.innerHTML = option.value + item.style = "list-style: none; padding-left: 0.5em" + item.style.width = "100%" + list.appendChild(item) + }) + list.style.border = "1px solid #d3d3d3" + list.style.padding = "5px 5px 5px 5px" + list.style.width = "100%" + list.style.backgroundColor = "white" + list.style.borderRadius = "5px" + clonedMultiSelect.style.display = "none" + clonedMultiSelect.parentElement.appendChild(list) + } + }); + console.log(clonedDocument.querySelector("body").scrollHeight); + clonedHeight = clonedDocument.querySelector("body").scrollHeight + "px"; + console.log("clonedHeight: " + clonedHeight); + }, + ignoreElements: function (el) { + return el.classList.contains("navbar-inverse") || el.classList.contains("dropdown-menu"); + } + }).then(canvas => { + var img = document.createElement("img"); + img.src = canvas.toDataURL("png"); + img.width = parseInt(canvas.style.width); + img.height = parseInt(canvas.style.height); // changing value has no impact + // has no impact even when "height:" above is not set + // img.height = parseInt(clonedHeight); + $("#screenshot_preview").empty(); + $("#screenshot_preview").append(img); + }); +} diff --git a/radiant.data/inst/app/www/js/session.js b/radiant.data/inst/app/www/js/session.js new file mode 100644 index 0000000000000000000000000000000000000000..4a463b26dccf9ac85836ce0a74bfe35814e4386d --- /dev/null +++ b/radiant.data/inst/app/www/js/session.js @@ -0,0 +1,18 @@ +Shiny.addCustomMessageHandler("session_start", function(data) { + var search = location.search; + var reSSUID = /([?&])SSUID=[^&]*&?/g; + + if (search.length > 0) { + if (reSSUID.test(search)) + search = search.replace(reSSUID, "$1"); + if (!/[?&]$/.test(search)) + search += "&"; + search += "SSUID=" + encodeURIComponent(data); + } else { + search = "?SSUID=" + encodeURIComponent(data); + } + + // Joe Cheng: "Work around ShinyApps.io/SSP/RSC base href silliness" + var path = location.pathname.replace(/\/_w_(\w+)/, ""); + history.replaceState(null, null, path + search); +}) diff --git a/radiant.data/inst/app/www/js/video_reset.js b/radiant.data/inst/app/www/js/video_reset.js new file mode 100644 index 0000000000000000000000000000000000000000..84bb66515273c0f87d5562422ae4c3d6e8701472 --- /dev/null +++ b/radiant.data/inst/app/www/js/video_reset.js @@ -0,0 +1,21 @@ +// from http://stackoverflow.com/a/31078774/1974918 +$(function(){ + $("body").on('hidden.bs.modal', function (e) { + var $iframes = $(e.target).find("iframe"); + $iframes.each(function(index, iframe){ + $(iframe).attr("src", $(iframe).attr("src")); + }); + }); +}); + +// from http://stackoverflow.com/a/28114558/1974918 +// needed to wrap in function(){} and updated using ideas +// from http://stackoverflow.com/a/31078774/1974918 +$(function(){ + $('a[data-toggle="tab"]').on('shown.bs.tab', function (e) { + var $iframes = $(e.relatedTarget.hash).find('iframe'); + $iframes.each(function(index, iframe){ + $(iframe).attr("src", $(iframe).attr("src")); + }); + }); +}); diff --git a/radiant.data/inst/app/www/scpt/choose.dir.scpt b/radiant.data/inst/app/www/scpt/choose.dir.scpt new file mode 100644 index 0000000000000000000000000000000000000000..2ed0a509b1ac235056b34e6053733063381e3bef Binary files /dev/null and b/radiant.data/inst/app/www/scpt/choose.dir.scpt differ diff --git a/radiant.data/inst/app/www/scpt/choose.files.scpt b/radiant.data/inst/app/www/scpt/choose.files.scpt new file mode 100644 index 0000000000000000000000000000000000000000..045e1ddcb63e5d861bddbb4057fa509f0f5d6f3c Binary files /dev/null and b/radiant.data/inst/app/www/scpt/choose.files.scpt differ diff --git a/radiant.data/inst/app/www/style.css b/radiant.data/inst/app/www/style.css new file mode 100644 index 0000000000000000000000000000000000000000..1c56c22d47da9e5eed5692c931e4bc2e92342778 --- /dev/null +++ b/radiant.data/inst/app/www/style.css @@ -0,0 +1,257 @@ +ul, +ol { + padding-left: 18px; +} + +#viz_details_main+span, +#viz_details_labels+span, +#viz_details_style+span { + font-weight: bold; +} + +.table { + width: auto; +} + +.btn { + overflow: hidden; + white-space: nowrap; + text-overflow: ellipsis; +} + +.snippet th, +.snippet td { + text-align: center; +} + +table.dataTable tfoot td, +table.dataTable thead td { + padding: 0 0 0 0; +} + +td.top { + padding-top: 33px; +} + +td.top_small { + padding-top: 5px; +} + +td.top_mini { + padding-top: 1px; +} + +.well { + padding: 7px; + margin-bottom: 5px; +} + +.col-sm-4 { + max-width: 315px; +} + +.checkbox { + margin-top: 0; + margin-bottom: 0; +} + +.form-group { + margin-top: 0; + margin-bottom: 0; +} + +.radio-inline+.radio-inline, +.checkbox-inline+.checkbox-inline { + margin-left: 0; + margin-right: 5px; +} + +.radio-inline, +.checkbox-inline { + margin-right: 5px; +} + +.help-modal-dialog { + padding-top: 80px; +} + +.modal-sm { + padding-top: 80px; + width: 600px; +} + +.help-modal-body { + max-height: 600px; + overflow-y: auto; +} + +.modal-title { + display: inline-block; + line-height: 1; + margin-top: 0; + margin-bottom: 0; +} + +img { + max-width: 85% !important; + height: auto; +} + +/* based on https://stackoverflow.com/a/30338814/1974918*/ +pre { + overflow: auto; + white-space: pre; + word-wrap: normal; + /*background-color: #ffffff;*/ +} + +code, +pre code { + overflow: auto; + white-space: pre; + word-wrap: normal; +} + +#state_download { + font-family: "Helvetica Neue", Helvetica, Arial, sans-serif; + font-size: 16px; + color: black; +} + +/* allow all textareas and multiple-select inputs to resize vertically */ +/* have to set overflow to make resize work on Safari */ +/* based on https://css-tricks.com/almanac/properties/r/resize/ */ +textarea, +select { + resize: vertical; + overflow: auto; + max-width: 100%; +} + +.alignleft { + float: left; +} + +.alignright { + float: right; +} + +.aligncenter { + margin-left: 42%; +} + +.color_bar { + background-color: blue; +} + +/* from: https://github.com/swarm-lab/editR/blob/master/inst/app/www/editR.css */ +#rmd_edit, +#r_edit { + position: absolute; + top: 100px; + bottom: 0; + left: 0; + right: 50%; + padding-right: 10px; + margin-top: 1rem; +} + +/* from: https://github.com/swarm-lab/editR/blob/master/inst/app/www/editR.css */ +#rmd_knitted, +#r_knitted { + position: absolute; + top: 100px; + bottom: 0; + left: 50%; + right: 0; + padding-left: 10px; + overflow-y: scroll; + margin-top: 1rem; +} + +/* Needed in combination with navbarPage with fixed-top */ +/* based on https://stackoverflow.com/a/19231861/1974918 */ +body { + padding-top: 42px; +} + +.navbar { + margin-bottom: 5px; + background-color: black; +} + +.navbar .nav>li>a { + padding-left: 7px; + padding-right: 8px; +} + +.nav-tabs { + margin-bottom: 10px; +} + +.dropdown-menu { + max-height: 90vh; + overflow-y: auto; +} + +@media (max-width: 1000px) { + .navbar-header { + float: none; + } + + .navbar-left, + .navbar-right { + float: none !important; + } + + .navbar-toggle { + display: block; + } + + .navbar-collapse { + border-top: 1px solid transparent; + box-shadow: inset 0 1px 0 rgba(255, 255, 255, 0.1); + } + + .navbar-fixed-top { + top: 0; + border-width: 0 0 1px; + } + + .navbar-collapse.collapse { + display: none !important; + } + + .navbar-nav { + float: none !important; + margin-top: 7.5px; + } + + .navbar-nav>li { + float: none; + } + + .navbar-nav>li>a { + padding-top: 10px; + padding-bottom: 10px; + } + + .collapse.in { + display: block !important; + } +} + +/* border radius same as other buttons in shiny */ +.btn-file-solitary { + border-radius: 4px !important; +} + +/* likely due to bootstrap css, font set to white */ +/* with dark themes against a white background */ +/* see https://github.com/ajaxorg/ace/issues/3071 */ +.ace_replace_form, +.ace_search_field, +.ace_replacebtn, +.ace_searchbtn { + color: black; +} diff --git a/radiant.data/inst/app/www/style.docx b/radiant.data/inst/app/www/style.docx new file mode 100644 index 0000000000000000000000000000000000000000..7a0b58254d67bc022a05124989d26e3622d87c9a Binary files /dev/null and b/radiant.data/inst/app/www/style.docx differ diff --git a/radiant.data/inst/app/www/style.potx b/radiant.data/inst/app/www/style.potx new file mode 100644 index 0000000000000000000000000000000000000000..a2ca5068810ae07a87e957706af897f467a6c6a6 Binary files /dev/null and b/radiant.data/inst/app/www/style.potx differ diff --git a/radiant.data/inst/assets/html2canvas/html2canvas.min.js b/radiant.data/inst/assets/html2canvas/html2canvas.min.js new file mode 100644 index 0000000000000000000000000000000000000000..aed6bfd70defa322824e5cba11b3ad5d6061ee28 --- /dev/null +++ b/radiant.data/inst/assets/html2canvas/html2canvas.min.js @@ -0,0 +1,20 @@ +/*! + * html2canvas 1.4.1 + * Copyright (c) 2022 Niklas von Hertzen + * Released under MIT License + */ +!function(A,e){"object"==typeof exports&&"undefined"!=typeof module?module.exports=e():"function"==typeof define&&define.amd?define(e):(A="undefined"!=typeof globalThis?globalThis:A||self).html2canvas=e()}(this,function(){"use strict"; +/*! ***************************************************************************** + Copyright (c) Microsoft Corporation. + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH + REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY + AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, + INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM + LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR + OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR + PERFORMANCE OF THIS SOFTWARE. + ***************************************************************************** */var r=function(A,e){return(r=Object.setPrototypeOf||{__proto__:[]}instanceof Array&&function(A,e){A.__proto__=e}||function(A,e){for(var t in e)Object.prototype.hasOwnProperty.call(e,t)&&(A[t]=e[t])})(A,e)};function A(A,e){if("function"!=typeof e&&null!==e)throw new TypeError("Class extends value "+String(e)+" is not a constructor or null");function t(){this.constructor=A}r(A,e),A.prototype=null===e?Object.create(e):(t.prototype=e.prototype,new t)}var h=function(){return(h=Object.assign||function(A){for(var e,t=1,r=arguments.length;ts[0]&&e[1]>10),s%1024+56320)),(B+1===t||16384>5],this.data[e=(e<<2)+(31&A)];if(A<=65535)return e=this.index[2048+(A-55296>>5)],this.data[e=(e<<2)+(31&A)];if(A>11)],e=this.index[e+=A>>5&63],this.data[e=(e<<2)+(31&A)];if(A<=1114111)return this.data[this.highValueIndex]}return this.errorValue},l);function l(A,e,t,r,B,n){this.initialValue=A,this.errorValue=e,this.highStart=t,this.highValueIndex=r,this.index=B,this.data=n}for(var C="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/",u="undefined"==typeof Uint8Array?[]:new Uint8Array(256),F=0;F>4,i[o++]=(15&t)<<4|r>>2,i[o++]=(3&r)<<6|63&B;return n}(y="KwAAAAAAAAAACA4AUD0AADAgAAACAAAAAAAIABAAGABAAEgAUABYAGAAaABgAGgAYgBqAF8AZwBgAGgAcQB5AHUAfQCFAI0AlQCdAKIAqgCyALoAYABoAGAAaABgAGgAwgDKAGAAaADGAM4A0wDbAOEA6QDxAPkAAQEJAQ8BFwF1AH0AHAEkASwBNAE6AUIBQQFJAVEBWQFhAWgBcAF4ATAAgAGGAY4BlQGXAZ8BpwGvAbUBvQHFAc0B0wHbAeMB6wHxAfkBAQIJAvEBEQIZAiECKQIxAjgCQAJGAk4CVgJeAmQCbAJ0AnwCgQKJApECmQKgAqgCsAK4ArwCxAIwAMwC0wLbAjAA4wLrAvMC+AIAAwcDDwMwABcDHQMlAy0DNQN1AD0DQQNJA0kDSQNRA1EDVwNZA1kDdQB1AGEDdQBpA20DdQN1AHsDdQCBA4kDkQN1AHUAmQOhA3UAdQB1AHUAdQB1AHUAdQB1AHUAdQB1AHUAdQB1AHUAdQB1AKYDrgN1AHUAtgO+A8YDzgPWAxcD3gPjA+sD8wN1AHUA+wMDBAkEdQANBBUEHQQlBCoEFwMyBDgEYABABBcDSARQBFgEYARoBDAAcAQzAXgEgASIBJAEdQCXBHUAnwSnBK4EtgS6BMIEyAR1AHUAdQB1AHUAdQCVANAEYABgAGAAYABgAGAAYABgANgEYADcBOQEYADsBPQE/AQEBQwFFAUcBSQFLAU0BWQEPAVEBUsFUwVbBWAAYgVgAGoFcgV6BYIFigWRBWAAmQWfBaYFYABgAGAAYABgAKoFYACxBbAFuQW6BcEFwQXHBcEFwQXPBdMF2wXjBeoF8gX6BQIGCgYSBhoGIgYqBjIGOgZgAD4GRgZMBmAAUwZaBmAAYABgAGAAYABgAGAAYABgAGAAYABgAGIGYABpBnAGYABgAGAAYABgAGAAYABgAGAAYAB4Bn8GhQZgAGAAYAB1AHcDFQSLBmAAYABgAJMGdQA9A3UAmwajBqsGqwaVALMGuwbDBjAAywbSBtIG1QbSBtIG0gbSBtIG0gbdBuMG6wbzBvsGAwcLBxMHAwcbByMHJwcsBywHMQcsB9IGOAdAB0gHTgfSBkgHVgfSBtIG0gbSBtIG0gbSBtIG0gbSBiwHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAdgAGAALAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAdbB2MHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsB2kH0gZwB64EdQB1AHUAdQB1AHUAdQB1AHUHfQdgAIUHjQd1AHUAlQedB2AAYAClB6sHYACzB7YHvgfGB3UAzgfWBzMB3gfmB1EB7gf1B/0HlQENAQUIDQh1ABUIHQglCBcDLQg1CD0IRQhNCEEDUwh1AHUAdQBbCGMIZAhlCGYIZwhoCGkIYwhkCGUIZghnCGgIaQhjCGQIZQhmCGcIaAhpCGMIZAhlCGYIZwhoCGkIYwhkCGUIZghnCGgIaQhjCGQIZQhmCGcIaAhpCGMIZAhlCGYIZwhoCGkIYwhkCGUIZghnCGgIaQhjCGQIZQhmCGcIaAhpCGMIZAhlCGYIZwhoCGkIYwhkCGUIZghnCGgIaQhjCGQIZQhmCGcIaAhpCGMIZAhlCGYIZwhoCGkIYwhkCGUIZghnCGgIaQhjCGQIZQhmCGcIaAhpCGMIZAhlCGYIZwhoCGkIYwhkCGUIZghnCGgIaQhjCGQIZQhmCGcIaAhpCGMIZAhlCGYIZwhoCGkIYwhkCGUIZghnCGgIaQhjCGQIZQhmCGcIaAhpCGMIZAhlCGYIZwhoCGkIYwhkCGUIZghnCGgIaQhjCGQIZQhmCGcIaAhpCGMIZAhlCGYIZwhoCGkIYwhkCGUIZghnCGgIaQhjCGQIZQhmCGcIaAhpCGMIZAhlCGYIZwhoCGkIYwhkCGUIZghnCGgIaQhjCGQIZQhmCGcIaAhpCGMIZAhlCGYIZwhoCGkIYwhkCGUIZghnCGgIaQhjCGQIZQhmCGcIaAhpCGMIZAhlCGYIZwhoCGkIYwhkCGUIZghnCGgIaQhjCGQIZQhmCGcIaAhpCGMIZAhlCGYIZwhoCGkIYwhkCGUIZghnCGgIaQhjCGQIZQhmCGcIaAhpCGMIZAhlCGYIZwhoCGkIYwhkCGUIZghnCGgIaQhjCGQIZQhmCGcIaAhpCGMIZAhlCGYIZwhoCGkIYwhkCGUIZghnCGgIaQhjCGQIZQhmCGcIaAhpCGMIZAhlCGYIZwhoCGkIYwhkCGUIZghnCGgIaQhjCGQIZQhmCGcIaAhpCGMIZAhlCGYIZwhoCGkIYwhkCGUIZghnCGgIcAh3CHoIMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwAIIIggiCCIIIggiCCIIIggiCCIIIggiCCIIIggiCCIIIggiCCIIIggiCCIIIggiCCIIIggiCCIIIggiCCIIIgggwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAALAcsBywHLAcsBywHLAcsBywHLAcsB4oILAcsB44I0gaWCJ4Ipgh1AHUAqgiyCHUAdQB1AHUAdQB1AHUAdQB1AHUAtwh8AXUAvwh1AMUIyQjRCNkI4AjoCHUAdQB1AO4I9gj+CAYJDgkTCS0HGwkjCYIIggiCCIIIggiCCIIIggiCCIIIggiCCIIIggiCCIIIggiCCIIIggiCCIIIggiCCIIIggiCCIIIggiCCIIIggiAAIAAAAFAAYABgAGIAXwBgAHEAdQBFAJUAogCyAKAAYABgAEIA4ABGANMA4QDxAMEBDwE1AFwBLAE6AQEBUQF4QkhCmEKoQrhCgAHIQsAB0MLAAcABwAHAAeDC6ABoAHDCwMMAAcABwAHAAdDDGMMAAcAB6MM4wwjDWMNow3jDaABoAGgAaABoAGgAaABoAGgAaABoAGgAaABoAGgAaABoAGgAaABoAEjDqABWw6bDqABpg6gAaABoAHcDvwOPA+gAaABfA/8DvwO/A78DvwO/A78DvwO/A78DvwO/A78DvwO/A78DvwO/A78DvwO/A78DvwO/A78DvwO/A78DpcPAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcAB9cPKwkyCToJMAB1AHUAdQBCCUoJTQl1AFUJXAljCWcJawkwADAAMAAwAHMJdQB2CX4JdQCECYoJjgmWCXUAngkwAGAAYABxAHUApgn3A64JtAl1ALkJdQDACTAAMAAwADAAdQB1AHUAdQB1AHUAdQB1AHUAowYNBMUIMAAwADAAMADICcsJ0wnZCRUE4QkwAOkJ8An4CTAAMAB1AAAKvwh1AAgKDwoXCh8KdQAwACcKLgp1ADYKqAmICT4KRgowADAAdQB1AE4KMAB1AFYKdQBeCnUAZQowADAAMAAwADAAMAAwADAAMAAVBHUAbQowADAAdQC5CXUKMAAwAHwBxAijBogEMgF9CoQKiASMCpQKmgqIBKIKqgquCogEDQG2Cr4KxgrLCjAAMADTCtsKCgHjCusK8Qr5CgELMAAwADAAMAB1AIsECQsRC3UANAEZCzAAMAAwADAAMAB1ACELKQswAHUANAExCzkLdQBBC0kLMABRC1kLMAAwADAAMAAwADAAdQBhCzAAMAAwAGAAYABpC3ELdwt/CzAAMACHC4sLkwubC58Lpwt1AK4Ltgt1APsDMAAwADAAMAAwADAAMAAwAL4LwwvLC9IL1wvdCzAAMADlC+kL8Qv5C/8LSQswADAAMAAwADAAMAAwADAAMAAHDDAAMAAwADAAMAAODBYMHgx1AHUAdQB1AHUAdQB1AHUAdQB1AHUAdQB1AHUAdQB1AHUAdQB1AHUAdQB1AHUAdQB1AHUAdQB1ACYMMAAwADAAdQB1AHUALgx1AHUAdQB1AHUAdQA2DDAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwAHUAdQB1AHUAdQB1AHUAdQB1AHUAdQB1AHUAdQB1AHUAdQB1AD4MdQBGDHUAdQB1AHUAdQB1AEkMdQB1AHUAdQB1AFAMMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwAHUAdQB1AHUAdQB1AHUAdQB1AHUAdQB1AHUAdQBYDHUAdQB1AF8MMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAB1AHUAdQB1AHUAdQB1AHUAdQB1AHUAdQB1AHUAdQB1AHUA+wMVBGcMMAAwAHwBbwx1AHcMfwyHDI8MMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAYABgAJcMMAAwADAAdQB1AJ8MlQClDDAAMACtDCwHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsB7UMLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHdQB1AHUAdQB1AHUAdQB1AHUAdQB1AHUAdQB1AA0EMAC9DDAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAsBywHLAcsBywHLAcsBywHLQcwAMEMyAwsBywHLAcsBywHLAcsBywHLAcsBywHzAwwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwAHUAdQB1ANQM2QzhDDAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMABgAGAAYABgAGAAYABgAOkMYADxDGAA+AwADQYNYABhCWAAYAAODTAAMAAwADAAFg1gAGAAHg37AzAAMAAwADAAYABgACYNYAAsDTQNPA1gAEMNPg1LDWAAYABgAGAAYABgAGAAYABgAGAAUg1aDYsGVglhDV0NcQBnDW0NdQ15DWAAYABgAGAAYABgAGAAYABgAGAAYABgAGAAYABgAGAAlQCBDZUAiA2PDZcNMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAnw2nDTAAMAAwADAAMAAwAHUArw23DTAAMAAwADAAMAAwADAAMAAwADAAMAB1AL8NMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAB1AHUAdQB1AHUAdQDHDTAAYABgAM8NMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAA1w11ANwNMAAwAD0B5A0wADAAMAAwADAAMADsDfQN/A0EDgwOFA4wABsOMAAwADAAMAAwADAAMAAwANIG0gbSBtIG0gbSBtIG0gYjDigOwQUuDsEFMw7SBjoO0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIGQg5KDlIOVg7SBtIGXg5lDm0OdQ7SBtIGfQ6EDooOjQ6UDtIGmg6hDtIG0gaoDqwO0ga0DrwO0gZgAGAAYADEDmAAYAAkBtIGzA5gANIOYADaDokO0gbSBt8O5w7SBu8O0gb1DvwO0gZgAGAAxA7SBtIG0gbSBtIGYABgAGAAYAAED2AAsAUMD9IG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIGFA8sBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAccD9IGLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHJA8sBywHLAcsBywHLAccDywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywPLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAc0D9IG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIGLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAccD9IG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIGFA8sBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHLAcsBywHPA/SBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gbSBtIG0gYUD0QPlQCVAJUAMAAwADAAMACVAJUAlQCVAJUAlQCVAEwPMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAA//8EAAQABAAEAAQABAAEAAQABAANAAMAAQABAAIABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQACgATABcAHgAbABoAHgAXABYAEgAeABsAGAAPABgAHABLAEsASwBLAEsASwBLAEsASwBLABgAGAAeAB4AHgATAB4AUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQABYAGwASAB4AHgAeAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAWAA0AEQAeAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArAAQABAAEAAQABAAFAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAJABYAGgAbABsAGwAeAB0AHQAeAE8AFwAeAA0AHgAeABoAGwBPAE8ADgBQAB0AHQAdAE8ATwAXAE8ATwBPABYAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAB0AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAdAFAAUABQAFAAUABQAFAAUAAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAFAAHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAeAB4AHgAeAFAATwBAAE8ATwBPAEAATwBQAFAATwBQAB4AHgAeAB4AHgAeAB0AHQAdAB0AHgAdAB4ADgBQAFAAUABQAFAAHgAeAB4AHgAeAB4AHgBQAB4AUAAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4ABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAJAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAkACQAJAAkACQAJAAkABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAeAB4AHgAeAFAAHgAeAB4AKwArAFAAUABQAFAAGABQACsAKwArACsAHgAeAFAAHgBQAFAAUAArAFAAKwAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AKwAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4ABAAEAAQABAAEAAQABAAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArACsAUAAeAB4AHgAeAB4AHgBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAYAA0AKwArAB4AHgAbACsABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQADQAEAB4ABAAEAB4ABAAEABMABAArACsAKwArACsAKwArACsAVgBWAFYAVgBWAFYAVgBWAFYAVgBWAFYAVgBWAFYAVgBWAFYAVgBWAFYAVgBWAFYAVgBWAFYAKwArACsAKwBWAFYAVgBWAB4AHgArACsAKwArACsAKwArACsAKwArACsAHgAeAB4AHgAeAB4AHgAeAB4AGgAaABoAGAAYAB4AHgAEAAQABAAEAAQABAAEAAQABAAEAAQAEwAEACsAEwATAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABABLAEsASwBLAEsASwBLAEsASwBLABoAGQAZAB4AUABQAAQAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQABMAUAAEAAQABAAEAAQABAAEAB4AHgAEAAQABAAEAAQABABQAFAABAAEAB4ABAAEAAQABABQAFAASwBLAEsASwBLAEsASwBLAEsASwBQAFAAUAAeAB4AUAAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AKwAeAFAABABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAABAAEAAQABAAEAAQABAAEAAQABAAEAFAAKwArACsAKwArACsAKwArACsAKwArACsAKwArAEsASwBLAEsASwBLAEsASwBLAEsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAABAAEAAQABAAEAAQABAAEAAQAUABQAB4AHgAYABMAUAArACsABAAbABsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAEAAQABAAEAFAABAAEAAQABAAEAFAABAAEAAQAUAAEAAQABAAEAAQAKwArAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAEAAQABAArACsAHgArAFAAUABQAFAAUABQAFAAUABQAFAAUAArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArAFAAUABQAFAAUABQAFAAUABQAFAAKwArACsAKwArACsAKwArACsAKwArAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAB4ABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAAQABAAEAFAABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQAUAAEAAQABAAEAAQABAAEAFAAUABQAFAAUABQAFAAUABQAFAABAAEAA0ADQBLAEsASwBLAEsASwBLAEsASwBLAB4AUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAEAAQABAArAFAAUABQAFAAUABQAFAAUAArACsAUABQACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwBQAFAAUABQAFAAUABQACsAUAArACsAKwBQAFAAUABQACsAKwAEAFAABAAEAAQABAAEAAQABAArACsABAAEACsAKwAEAAQABABQACsAKwArACsAKwArACsAKwAEACsAKwArACsAUABQACsAUABQAFAABAAEACsAKwBLAEsASwBLAEsASwBLAEsASwBLAFAAUAAaABoAUABQAFAAUABQAEwAHgAbAFAAHgAEACsAKwAEAAQABAArAFAAUABQAFAAUABQACsAKwArACsAUABQACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwBQAFAAUABQAFAAUABQACsAUABQACsAUABQACsAUABQACsAKwAEACsABAAEAAQABAAEACsAKwArACsABAAEACsAKwAEAAQABAArACsAKwAEACsAKwArACsAKwArACsAUABQAFAAUAArAFAAKwArACsAKwArACsAKwBLAEsASwBLAEsASwBLAEsASwBLAAQABABQAFAAUAAEAB4AKwArACsAKwArACsAKwArACsAKwAEAAQABAArAFAAUABQAFAAUABQAFAAUABQACsAUABQAFAAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwBQAFAAUABQAFAAUABQACsAUABQACsAUABQAFAAUABQACsAKwAEAFAABAAEAAQABAAEAAQABAAEACsABAAEAAQAKwAEAAQABAArACsAUAArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwBQAFAABAAEACsAKwBLAEsASwBLAEsASwBLAEsASwBLAB4AGwArACsAKwArACsAKwArAFAABAAEAAQABAAEAAQAKwAEAAQABAArAFAAUABQAFAAUABQAFAAUAArACsAUABQACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAAQABAAEAAQABAArACsABAAEACsAKwAEAAQABAArACsAKwArACsAKwArAAQABAAEACsAKwArACsAUABQACsAUABQAFAABAAEACsAKwBLAEsASwBLAEsASwBLAEsASwBLAB4AUABQAFAAUABQAFAAUAArACsAKwArACsAKwArACsAKwArAAQAUAArAFAAUABQAFAAUABQACsAKwArAFAAUABQACsAUABQAFAAUAArACsAKwBQAFAAKwBQACsAUABQACsAKwArAFAAUAArACsAKwBQAFAAUAArACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUAArACsAKwArAAQABAAEAAQABAArACsAKwAEAAQABAArAAQABAAEAAQAKwArAFAAKwArACsAKwArACsABAArACsAKwArACsAKwArACsAKwArAEsASwBLAEsASwBLAEsASwBLAEsAUABQAFAAHgAeAB4AHgAeAB4AGwAeACsAKwArACsAKwAEAAQABAAEAAQAUABQAFAAUABQAFAAUABQACsAUABQAFAAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwArACsAUAAEAAQABAAEAAQABAAEACsABAAEAAQAKwAEAAQABAAEACsAKwArACsAKwArACsABAAEACsAUABQAFAAKwArACsAKwArAFAAUAAEAAQAKwArAEsASwBLAEsASwBLAEsASwBLAEsAKwArACsAKwArACsAKwAOAFAAUABQAFAAUABQAFAAHgBQAAQABAAEAA4AUABQAFAAUABQAFAAUABQACsAUABQAFAAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArAFAAUABQAFAAUABQAFAAUABQAFAAKwBQAFAAUABQAFAAKwArAAQAUAAEAAQABAAEAAQABAAEACsABAAEAAQAKwAEAAQABAAEACsAKwArACsAKwArACsABAAEACsAKwArACsAKwArACsAUAArAFAAUAAEAAQAKwArAEsASwBLAEsASwBLAEsASwBLAEsAKwBQAFAAKwArACsAKwArACsAKwArACsAKwArACsAKwAEAAQABAAEAFAAUABQAFAAUABQAFAAUABQACsAUABQAFAAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAABAAEAFAABAAEAAQABAAEAAQABAArAAQABAAEACsABAAEAAQABABQAB4AKwArACsAKwBQAFAAUAAEAFAAUABQAFAAUABQAFAAUABQAFAABAAEACsAKwBLAEsASwBLAEsASwBLAEsASwBLAFAAUABQAFAAUABQAFAAUABQABoAUABQAFAAUABQAFAAKwAEAAQABAArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArAFAAUABQAFAAUABQAFAAUABQACsAUAArACsAUABQAFAAUABQAFAAUAArACsAKwAEACsAKwArACsABAAEAAQABAAEAAQAKwAEACsABAAEAAQABAAEAAQABAAEACsAKwArACsAKwArAEsASwBLAEsASwBLAEsASwBLAEsAKwArAAQABAAeACsAKwArACsAKwArACsAKwArACsAKwArAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXAAqAFwAXAAqACoAKgAqACoAKgAqACsAKwArACsAGwBcAFwAXABcAFwAXABcACoAKgAqACoAKgAqACoAKgAeAEsASwBLAEsASwBLAEsASwBLAEsADQANACsAKwArACsAKwBcAFwAKwBcACsAXABcAFwAXABcACsAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcACsAXAArAFwAXABcAFwAXABcAFwAXABcAFwAKgBcAFwAKgAqACoAKgAqACoAKgAqACoAXAArACsAXABcAFwAXABcACsAXAArACoAKgAqACoAKgAqACsAKwBLAEsASwBLAEsASwBLAEsASwBLACsAKwBcAFwAXABcAFAADgAOAA4ADgAeAA4ADgAJAA4ADgANAAkAEwATABMAEwATAAkAHgATAB4AHgAeAAQABAAeAB4AHgAeAB4AHgBLAEsASwBLAEsASwBLAEsASwBLAFAAUABQAFAAUABQAFAAUABQAFAADQAEAB4ABAAeAAQAFgARABYAEQAEAAQAUABQAFAAUABQAFAAUABQACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwArACsAKwAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQADQAEAAQABAAEAAQADQAEAAQAUABQAFAAUABQAAQABAAEAAQABAAEAAQABAAEAAQABAArAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAArAA0ADQAeAB4AHgAeAB4AHgAEAB4AHgAeAB4AHgAeACsAHgAeAA4ADgANAA4AHgAeAB4AHgAeAAkACQArACsAKwArACsAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcACoAKgAqACoAKgAqACoAKgAqACoAKgAqACoAKgAqACoAKgAqACoAKgBcAEsASwBLAEsASwBLAEsASwBLAEsADQANAB4AHgAeAB4AXABcAFwAXABcAFwAKgAqACoAKgBcAFwAXABcACoAKgAqAFwAKgAqACoAXABcACoAKgAqACoAKgAqACoAXABcAFwAKgAqACoAKgBcAFwAXABcAFwAXABcAFwAXABcAFwAXABcACoAKgAqACoAKgAqACoAKgAqACoAKgAqAFwAKgBLAEsASwBLAEsASwBLAEsASwBLACoAKgAqACoAKgAqAFAAUABQAFAAUABQACsAUAArACsAKwArACsAUAArACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAHgBQAFAAUABQAFgAWABYAFgAWABYAFgAWABYAFgAWABYAFgAWABYAFgAWABYAFgAWABYAFgAWABYAFgAWABYAFgAWABYAFgAWABZAFkAWQBZAFkAWQBZAFkAWQBZAFkAWQBZAFkAWQBZAFkAWQBZAFkAWQBZAFkAWQBZAFkAWQBZAFkAWQBZAFkAWgBaAFoAWgBaAFoAWgBaAFoAWgBaAFoAWgBaAFoAWgBaAFoAWgBaAFoAWgBaAFoAWgBaAFoAWgBaAFoAWgBaAFAAUABQAFAAUABQAFAAUABQACsAUABQAFAAUAArACsAUABQAFAAUABQAFAAUAArAFAAKwBQAFAAUABQACsAKwBQAFAAUABQAFAAUABQAFAAUAArAFAAUABQAFAAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArAFAAUABQAFAAKwArAFAAUABQAFAAUABQAFAAKwBQACsAUABQAFAAUAArACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwBQAFAAUABQACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArACsABAAEAAQAHgANAB4AHgAeAB4AHgAeAB4AUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAHgAeAB4AHgAeAB4AHgAeAB4AHgArACsAKwArACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAKwBQAFAAUABQAFAAUAArACsADQBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAHgAeAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAANAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAWABEAKwArACsAUABQAFAAUABQAFAAUABQAFAAUABQAA0ADQANAFAAUABQAFAAUABQAFAAUABQAFAAUAArACsAKwArACsAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwBQAFAAUABQAAQABAAEACsAKwArACsAKwArACsAKwArACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAEAAQABAANAA0AKwArACsAKwArACsAKwArACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAABAAEACsAKwArACsAKwArACsAKwArACsAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwBQAFAAUAArAAQABAArACsAKwArACsAKwArACsAKwArACsAKwBcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAKgAqACoAKgAqACoAKgAqACoAKgAqACoAKgAqACoAKgAqACoAKgAqAA0ADQAVAFwADQAeAA0AGwBcACoAKwArAEsASwBLAEsASwBLAEsASwBLAEsAKwArACsAKwArACsAUABQAFAAUABQAFAAUABQAFAAUAArACsAKwArACsAKwAeAB4AEwATAA0ADQAOAB4AEwATAB4ABAAEAAQACQArAEsASwBLAEsASwBLAEsASwBLAEsAKwArACsAKwArACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArACsAKwArACsAKwArAFAAUABQAFAAUAAEAAQAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAAQAUAArACsAKwArACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArACsAKwArACsAKwArACsAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwAEAAQABAAEAAQABAAEAAQABAAEAAQABAArACsAKwArAAQABAAEAAQABAAEAAQABAAEAAQABAAEACsAKwArACsAHgArACsAKwATABMASwBLAEsASwBLAEsASwBLAEsASwBcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXAArACsAXABcAFwAXABcACsAKwArACsAKwArACsAKwArACsAKwBcAFwAXABcAFwAXABcAFwAXABcAFwAXAArACsAKwArAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcACsAKwArACsAKwArAEsASwBLAEsASwBLAEsASwBLAEsAXAArACsAKwAqACoAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAAQABAAEAAQABAArACsAHgAeAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcACoAKgAqACoAKgAqACoAKgAqACoAKwAqACoAKgAqACoAKgAqACoAKgAqACoAKgAqACoAKgAqACoAKgAqACoAKgAqACoAKgAqACoAKgAqACoAKwArAAQASwBLAEsASwBLAEsASwBLAEsASwArACsAKwArACsAKwBLAEsASwBLAEsASwBLAEsASwBLACsAKwArACsAKwArACoAKgAqACoAKgAqACoAXAAqACoAKgAqACoAKgArACsABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsABAAEAAQABAAEAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAAQABAAEAAQABABQAFAAUABQAFAAUABQACsAKwArACsASwBLAEsASwBLAEsASwBLAEsASwANAA0AHgANAA0ADQANAB4AHgAeAB4AHgAeAB4AHgAeAB4ABAAEAAQABAAEAAQABAAEAAQAHgAeAB4AHgAeAB4AHgAeAB4AKwArACsABAAEAAQAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAABAAEAAQABAAEAAQABAAEAAQABAAEAAQABABQAFAASwBLAEsASwBLAEsASwBLAEsASwBQAFAAUABQAFAAUABQAFAABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEACsAKwArACsAKwArACsAKwAeAB4AHgAeAFAAUABQAFAABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEACsAKwArAA0ADQANAA0ADQBLAEsASwBLAEsASwBLAEsASwBLACsAKwArAFAAUABQAEsASwBLAEsASwBLAEsASwBLAEsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAA0ADQBQAFAAUABQAFAAUABQAFAAUAArACsAKwArACsAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAKwBQAFAAUAAeAB4AHgAeAB4AHgAeAB4AKwArACsAKwArACsAKwArAAQABAAEAB4ABAAEAAQABAAEAAQABAAEAAQABAAEAAQABABQAFAAUABQAAQAUABQAFAAUABQAFAABABQAFAABAAEAAQAUAArACsAKwArACsABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEACsABAAEAAQABAAEAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AKwArAFAAUABQAFAAUABQACsAKwBQAFAAUABQAFAAUABQAFAAKwBQACsAUAArAFAAKwAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeACsAKwAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgArAB4AHgAeAB4AHgAeAB4AHgBQAB4AHgAeAFAAUABQACsAHgAeAB4AHgAeAB4AHgAeAB4AHgBQAFAAUABQACsAKwAeAB4AHgAeAB4AHgArAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AKwArAFAAUABQACsAHgAeAB4AHgAeAB4AHgAOAB4AKwANAA0ADQANAA0ADQANAAkADQANAA0ACAAEAAsABAAEAA0ACQANAA0ADAAdAB0AHgAXABcAFgAXABcAFwAWABcAHQAdAB4AHgAUABQAFAANAAEAAQAEAAQABAAEAAQACQAaABoAGgAaABoAGgAaABoAHgAXABcAHQAVABUAHgAeAB4AHgAeAB4AGAAWABEAFQAVABUAHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4ADQAeAA0ADQANAA0AHgANAA0ADQAHAB4AHgAeAB4AKwAEAAQABAAEAAQABAAEAAQABAAEAFAAUAArACsATwBQAFAAUABQAFAAHgAeAB4AFgARAE8AUABPAE8ATwBPAFAAUABQAFAAUAAeAB4AHgAWABEAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAKwArABsAGwAbABsAGwAbABsAGgAbABsAGwAbABsAGwAbABsAGwAbABsAGwAbABsAGgAbABsAGwAbABoAGwAbABoAGwAbABsAGwAbABsAGwAbABsAGwAbABsAGwAbABsAGwAbAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQAHgAeAFAAGgAeAB0AHgBQAB4AGgAeAB4AHgAeAB4AHgAeAB4AHgBPAB4AUAAbAB4AHgBQAFAAUABQAFAAHgAeAB4AHQAdAB4AUAAeAFAAHgBQAB4AUABPAFAAUAAeAB4AHgAeAB4AHgAeAFAAUABQAFAAUAAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAFAAHgBQAFAAUABQAE8ATwBQAFAAUABQAFAATwBQAFAATwBQAE8ATwBPAE8ATwBPAE8ATwBPAE8ATwBPAFAAUABQAFAATwBPAE8ATwBPAE8ATwBPAE8ATwBQAFAAUABQAFAAUABQAFAAUAAeAB4AUABQAFAAUABPAB4AHgArACsAKwArAB0AHQAdAB0AHQAdAB0AHQAdAB0AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB0AHgAdAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAdAB4AHQAdAB4AHgAeAB0AHQAeAB4AHQAeAB4AHgAdAB4AHQAbABsAHgAdAB4AHgAeAB4AHQAeAB4AHQAdAB0AHQAeAB4AHQAeAB0AHgAdAB0AHQAdAB0AHQAeAB0AHgAeAB4AHgAeAB0AHQAdAB0AHgAeAB4AHgAdAB0AHgAeAB4AHgAeAB4AHgAeAB4AHgAdAB4AHgAeAB0AHgAeAB4AHgAeAB0AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAdAB0AHgAeAB0AHQAdAB0AHgAeAB0AHQAeAB4AHQAdAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB0AHQAeAB4AHQAdAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHQAeAB4AHgAdAB4AHgAeAB4AHgAeAB4AHQAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB0AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AFAAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeABYAEQAWABEAHgAeAB4AHgAeAB4AHQAeAB4AHgAeAB4AHgAeACUAJQAeAB4AHgAeAB4AHgAeAB4AHgAWABEAHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AJQAlACUAJQAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArAE8ATwBPAE8ATwBPAE8ATwBPAE8ATwBPAE8ATwBPAE8ATwBPAE8ATwBPAE8ATwBPAE8ATwBPAE8ATwBPAE8ATwAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAdAE8ATwBPAE8ATwBPAE8ATwBPAE8ATwBPAE8ATwBPAE8ATwBPAE8ATwBPAFAAHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHgAeAB4AHgAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAeAB4AHQAdAB0AHQAeAB4AHgAeAB4AHgAeAB4AHgAeAB0AHQAeAB0AHQAdAB0AHQAdAB0AHgAeAB4AHgAeAB4AHgAeAB0AHQAeAB4AHQAdAB4AHgAeAB4AHQAdAB4AHgAeAB4AHQAdAB0AHgAeAB0AHgAeAB0AHQAdAB0AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAdAB0AHQAdAB4AHgAeAB4AHgAeAB4AHgAeAB0AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAlACUAJQAlAB4AHQAdAB4AHgAdAB4AHgAeAB4AHQAdAB4AHgAeAB4AJQAlAB0AHQAlAB4AJQAlACUAIAAlACUAHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAlACUAJQAeAB4AHgAeAB0AHgAdAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAdAB0AHgAdAB0AHQAeAB0AJQAdAB0AHgAdAB0AHgAdAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeACUAHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHQAdAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAlACUAJQAlACUAJQAlACUAJQAlACUAJQAdAB0AHQAdACUAHgAlACUAJQAdACUAJQAdAB0AHQAlACUAHQAdACUAHQAdACUAJQAlAB4AHQAeAB4AHgAeAB0AHQAlAB0AHQAdAB0AHQAdACUAJQAlACUAJQAdACUAJQAgACUAHQAdACUAJQAlACUAJQAlACUAJQAeAB4AHgAlACUAIAAgACAAIAAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB0AHgAeAB4AFwAXABcAFwAXABcAHgATABMAJQAeAB4AHgAWABEAFgARABYAEQAWABEAFgARABYAEQAWABEATwBPAE8ATwBPAE8ATwBPAE8ATwBPAE8ATwBPAE8ATwBPAE8ATwBPAE8ATwAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeABYAEQAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAWABEAFgARABYAEQAWABEAFgARAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AFgARABYAEQAWABEAFgARABYAEQAWABEAFgARABYAEQAWABEAFgARABYAEQAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAWABEAFgARAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AFgARAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAdAB0AHQAdAB0AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgArACsAHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AKwAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AUABQAFAAUAAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAEAAQABAAeAB4AKwArACsAKwArABMADQANAA0AUAATAA0AUABQAFAAUABQAFAAUABQACsAKwArACsAKwArACsAUAANACsAKwArACsAKwArACsAKwArACsAKwArACsAKwAEAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArACsAKwArACsAKwArACsAKwBQAFAAUABQAFAAUABQACsAUABQAFAAUABQAFAAUAArAFAAUABQAFAAUABQAFAAKwBQAFAAUABQAFAAUABQACsAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXAA0ADQANAA0ADQANAA0ADQAeAA0AFgANAB4AHgAXABcAHgAeABcAFwAWABEAFgARABYAEQAWABEADQANAA0ADQATAFAADQANAB4ADQANAB4AHgAeAB4AHgAMAAwADQANAA0AHgANAA0AFgANAA0ADQANAA0ADQANAA0AHgANAB4ADQANAB4AHgAeACsAKwArACsAKwArACsAKwArACsAKwArACsAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACsAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAKwArACsAKwArACsAKwArACsAKwArACsAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwAlACUAJQAlACUAJQAlACUAJQAlACUAJQArACsAKwArAA0AEQARACUAJQBHAFcAVwAWABEAFgARABYAEQAWABEAFgARACUAJQAWABEAFgARABYAEQAWABEAFQAWABEAEQAlAFcAVwBXAFcAVwBXAFcAVwBXAAQABAAEAAQABAAEACUAVwBXAFcAVwA2ACUAJQBXAFcAVwBHAEcAJQAlACUAKwBRAFcAUQBXAFEAVwBRAFcAUQBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFEAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBRAFcAUQBXAFEAVwBXAFcAVwBXAFcAUQBXAFcAVwBXAFcAVwBRAFEAKwArAAQABAAVABUARwBHAFcAFQBRAFcAUQBXAFEAVwBRAFcAUQBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFEAVwBRAFcAUQBXAFcAVwBXAFcAVwBRAFcAVwBXAFcAVwBXAFEAUQBXAFcAVwBXABUAUQBHAEcAVwArACsAKwArACsAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAKwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAKwAlACUAVwBXAFcAVwAlACUAJQAlACUAJQAlACUAJQAlACsAKwArACsAKwArACsAKwArACsAKwArAFEAUQBRAFEAUQBRAFEAUQBRAFEAUQBRAFEAUQBRAFEAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQArAFcAVwBXAFcAVwBXAFcAVwBXAFcAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQBPAE8ATwBPAE8ATwBPAE8AJQBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXACUAJQAlAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAEcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAKwArACsAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQArACsAKwArACsAKwArACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAADQATAA0AUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABLAEsASwBLAEsASwBLAEsASwBLAFAAUAArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAFAABAAEAAQABAAeAAQABAAEAAQABAAEAAQABAAEAAQAHgBQAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AUABQAAQABABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAAQABAAeAA0ADQANAA0ADQArACsAKwArACsAKwArACsAHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAFAAUABQAFAAUABQAFAAUABQAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AUAAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgBQAB4AHgAeAB4AHgAeAFAAHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgArACsAHgAeAB4AHgAeAB4AHgAeAB4AKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwAeAB4AUABQAFAAUABQAFAAUABQAFAAUABQAAQAUABQAFAABABQAFAAUABQAAQAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAAQABAAEAAQABAAeAB4AHgAeAAQAKwArACsAUABQAFAAUABQAFAAHgAeABoAHgArACsAKwArACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAADgAOABMAEwArACsAKwArACsAKwArACsABAAEAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAAQABAAEAAQABAAEACsAKwArACsAKwArACsAKwANAA0ASwBLAEsASwBLAEsASwBLAEsASwArACsAKwArACsAKwAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABABQAFAAUABQAFAAUAAeAB4AHgBQAA4AUABQAAQAUABQAFAAUABQAFAABAAEAAQABAAEAAQABAAEAA0ADQBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQAKwArACsAKwArACsAKwArACsAKwArAB4AWABYAFgAWABYAFgAWABYAFgAWABYAFgAWABYAFgAWABYAFgAWABYAFgAWABYAFgAWABYAFgAWABYACsAKwArAAQAHgAeAB4AHgAeAB4ADQANAA0AHgAeAB4AHgArAFAASwBLAEsASwBLAEsASwBLAEsASwArACsAKwArAB4AHgBcAFwAXABcAFwAKgBcAFwAXABcAFwAXABcAFwAXABcAEsASwBLAEsASwBLAEsASwBLAEsAXABcAFwAXABcACsAUABQAFAAUABQAFAAUABQAFAABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEACsAKwArACsAKwArACsAKwArAFAAUABQAAQAUABQAFAAUABQAFAAUABQAAQABAArACsASwBLAEsASwBLAEsASwBLAEsASwArACsAHgANAA0ADQBcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAKgAqACoAXAAqACoAKgBcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXAAqAFwAKgAqACoAXABcACoAKgBcAFwAXABcAFwAKgAqAFwAKgBcACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArAFwAXABcACoAKgBQAFAAUABQAFAAUABQAFAAUABQAFAABAAEAAQABAAEAA0ADQBQAFAAUAAEAAQAKwArACsAKwArACsAKwArACsAKwBQAFAAUABQAFAAUAArACsAUABQAFAAUABQAFAAKwArAFAAUABQAFAAUABQACsAKwArACsAKwArACsAKwArAFAAUABQAFAAUABQAFAAKwBQAFAAUABQAFAAUABQACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAHgAeACsAKwArACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAEAAQABAAEAAQABAAEAAQADQAEAAQAKwArAEsASwBLAEsASwBLAEsASwBLAEsAKwArACsAKwArACsAVABVAFUAVQBVAFUAVQBVAFUAVQBVAFUAVQBVAFUAVQBVAFUAVQBVAFUAVQBVAFUAVQBVAFUAVQBUAFUAVQBVAFUAVQBVAFUAVQBVAFUAVQBVAFUAVQBVAFUAVQBVAFUAVQBVAFUAVQBVAFUAVQBVACsAKwArACsAKwArACsAKwArACsAKwArAFkAWQBZAFkAWQBZAFkAWQBZAFkAWQBZAFkAWQBZAFkAWQBZAFkAKwArACsAKwBaAFoAWgBaAFoAWgBaAFoAWgBaAFoAWgBaAFoAWgBaAFoAWgBaAFoAWgBaAFoAWgBaAFoAWgBaAFoAKwArACsAKwAGAAYABgAGAAYABgAGAAYABgAGAAYABgAGAAYABgAGAAYABgAGAAYABgAGAAYABgAGAAYABgAGAAYABgAGAAYAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXACUAJQBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAJQAlACUAJQAlACUAUABQAFAAUABQAFAAUAArACsAKwArACsAKwArACsAKwArACsAKwBQAFAAUABQAFAAKwArACsAKwArAFYABABWAFYAVgBWAFYAVgBWAFYAVgBWAB4AVgBWAFYAVgBWAFYAVgBWAFYAVgBWAFYAVgArAFYAVgBWAFYAVgArAFYAKwBWAFYAKwBWAFYAKwBWAFYAVgBWAFYAVgBWAFYAVgBWAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAEQAWAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUAAaAB4AKwArAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQAGAARABEAGAAYABMAEwAWABEAFAArACsAKwArACsAKwAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEACUAJQAlACUAJQAWABEAFgARABYAEQAWABEAFgARABYAEQAlACUAFgARACUAJQAlACUAJQAlACUAEQAlABEAKwAVABUAEwATACUAFgARABYAEQAWABEAJQAlACUAJQAlACUAJQAlACsAJQAbABoAJQArACsAKwArAFAAUABQAFAAUAArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwArAAcAKwATACUAJQAbABoAJQAlABYAEQAlACUAEQAlABEAJQBXAFcAVwBXAFcAVwBXAFcAVwBXABUAFQAlACUAJQATACUAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXABYAJQARACUAJQAlAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwAWACUAEQAlABYAEQARABYAEQARABUAVwBRAFEAUQBRAFEAUQBRAFEAUQBRAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAEcARwArACsAVwBXAFcAVwBXAFcAKwArAFcAVwBXAFcAVwBXACsAKwBXAFcAVwBXAFcAVwArACsAVwBXAFcAKwArACsAGgAbACUAJQAlABsAGwArAB4AHgAeAB4AHgAeAB4AKwArACsAKwArACsAKwArACsAKwAEAAQABAAQAB0AKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwBQAFAAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArACsAKwArACsADQANAA0AKwArACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAKwArAB4AHgAeAB4AHgAeAB4AHgAeAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgBQAFAAHgAeAB4AKwAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAAQAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwAEAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAKwArACsAKwArACsAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwArACsAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAABAAEAAQABAAEACsAKwArACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArAA0AUABQAFAAUAArACsAKwArAFAAUABQAFAAUABQAFAAUAANAFAAUABQAFAAUAArACsAKwArACsAKwArACsAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwArACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAKwArACsAKwArACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAKwArACsAKwArACsAKwArACsAKwAeACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAUABQAFAAUABQAFAAKwArAFAAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArAFAAUAArACsAKwBQACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwANAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAeAB4AUABQAFAAUABQAFAAUAArACsAKwArACsAKwArAFAAUABQAFAAUABQAFAAUABQACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArAFAAUAArACsAKwArACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAKwArAA0AUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAKwArACsAKwAeAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAKwArACsAUABQAFAAUABQAAQABAAEACsABAAEACsAKwArACsAKwAEAAQABAAEAFAAUABQAFAAKwBQAFAAUAArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwArAAQABAAEACsAKwArACsABABQAFAAUABQAFAAUABQAFAAUAArACsAKwArACsAKwArAA0ADQANAA0ADQANAA0ADQAeACsAKwArACsAKwArACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAeAFAAUABQAFAAUABQAFAAUAAeAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAAQABAArACsAKwArAFAAUABQAFAAUAANAA0ADQANAA0ADQAUACsAKwArACsAKwArACsAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwArACsADQANAA0ADQANAA0ADQBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArACsAKwArACsAKwArAB4AHgAeAB4AKwArACsAKwArACsAKwArACsAKwArACsAUABQAFAAUABQAFAAUAArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArAFAAUABQAFAAUABQAFAAUABQACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAKwArACsAKwArACsAKwArACsAKwArACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArACsAKwArACsAKwArAFAAUABQAFAAUABQAAQABAAEAAQAKwArACsAKwArACsAKwArAEsASwBLAEsASwBLAEsASwBLAEsAKwArACsAKwArACsAUABQAFAAUABQAFAAUABQAFAAUAArAAQABAANACsAKwBQAFAAKwArACsAKwArACsAKwArACsAKwArACsAKwArAFAAUABQAFAAUABQAAQABAAEAAQABAAEAAQABAAEAAQABABQAFAAUABQAB4AHgAeAB4AHgArACsAKwArACsAKwAEAAQABAAEAAQABAAEAA0ADQAeAB4AHgAeAB4AKwArACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAEsASwBLAEsASwBLAEsASwBLAEsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsABABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAAQABAAEAAQABAAEAAQABAAEAAQABAAeAB4AHgANAA0ADQANACsAKwArACsAKwArACsAKwArACsAKwAeACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwArACsAKwArACsAKwBLAEsASwBLAEsASwBLAEsASwBLACsAKwArACsAKwArAFAAUABQAFAAUABQAFAABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEACsASwBLAEsASwBLAEsASwBLAEsASwANAA0ADQANAFAABAAEAFAAKwArACsAKwArACsAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAABAAeAA4AUAArACsAKwArACsAKwArACsAKwAEAFAAUABQAFAADQANAB4ADQAEAAQABAAEAB4ABAAEAEsASwBLAEsASwBLAEsASwBLAEsAUAAOAFAADQANAA0AKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwArACsAKwArACsAKwArACsAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAEAAQABAAEAAQABAAEAAQABAAEAAQABAANAA0AHgANAA0AHgAEACsAUABQAFAAUABQAFAAUAArAFAAKwBQAFAAUABQACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwBQAFAAUABQAFAAUABQAFAAUABQAA0AKwArACsAKwArACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAEAAQABAAEAAQABAAEAAQABAAEAAQAKwArACsAKwArAEsASwBLAEsASwBLAEsASwBLAEsAKwArACsAKwArACsABAAEAAQABAArAFAAUABQAFAAUABQAFAAUAArACsAUABQACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwBQAFAAUABQAFAAUABQACsAUABQACsAUABQAFAAUABQACsABAAEAFAABAAEAAQABAAEAAQABAArACsABAAEACsAKwAEAAQABAArACsAUAArACsAKwArACsAKwAEACsAKwArACsAKwBQAFAAUABQAFAABAAEACsAKwAEAAQABAAEAAQABAAEACsAKwArAAQABAAEAAQABAArACsAKwArACsAKwArACsAKwArACsABAAEAAQABAAEAAQABABQAFAAUABQAA0ADQANAA0AHgBLAEsASwBLAEsASwBLAEsASwBLAA0ADQArAB4ABABQAFAAUAArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwAEAAQABAAEAFAAUAAeAFAAKwArACsAKwArACsAKwArAEsASwBLAEsASwBLAEsASwBLAEsAKwArACsAKwArACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAABAAEAAQABAAEAAQABAArACsABAAEAAQABAAEAAQABAAEAAQADgANAA0AEwATAB4AHgAeAA0ADQANAA0ADQANAA0ADQANAA0ADQANAA0ADQANAFAAUABQAFAABAAEACsAKwAEAA0ADQAeAFAAKwArACsAKwArACsAKwArACsAKwArAEsASwBLAEsASwBLAEsASwBLAEsAKwArACsAKwArACsADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAFAAKwArACsAKwArACsAKwBLAEsASwBLAEsASwBLAEsASwBLACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAXABcAFwAKwArACoAKgAqACoAKgAqACoAKgAqACoAKgAqACoAKgAqACsAKwArACsASwBLAEsASwBLAEsASwBLAEsASwBcAFwADQANAA0AKgBQAFAAUABQAFAAUABQAFAAUABQAFAAUAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAeACsAKwArACsASwBLAEsASwBLAEsASwBLAEsASwBQAFAAUABQAFAAUABQAFAAUAArACsAKwArACsAKwArACsAKwArACsAKwBQAFAAUABQAFAAUABQAFAAKwArAFAAKwArAFAAUABQAFAAUABQAFAAUAArAFAAUAArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAABAAEAAQABAAEAAQAKwAEAAQAKwArAAQABAAEAAQAUAAEAFAABAAEAA0ADQANACsAKwArACsAKwArACsAKwArAEsASwBLAEsASwBLAEsASwBLAEsAKwArACsAKwArACsAUABQAFAAUABQAFAAUABQACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAABAAEAAQABAAEAAQABAArACsABAAEAAQABAAEAAQABABQAA4AUAAEACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArAFAABAAEAAQABAAEAAQABAAEAAQABABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAEAAQABAAEAAQABAAEAFAABAAEAAQABAAOAB4ADQANAA0ADQAOAB4ABAArACsAKwArACsAKwArACsAUAAEAAQABAAEAAQABAAEAAQABAAEAAQAUABQAFAAUABQAFAAUABQAFAAUAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAA0ADQANAFAADgAOAA4ADQANACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwBQAFAAUABQAFAAUABQAFAAUAArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAABAAEAAQABAAEAAQABAAEACsABAAEAAQABAAEAAQABAAEAFAADQANAA0ADQANACsAKwArACsAKwArACsAKwArACsASwBLAEsASwBLAEsASwBLAEsASwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArACsAKwAOABMAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwArAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAArAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAArACsAKwArACsAKwArACsAKwBQAFAAUABQAFAAUABQACsAUABQACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAEAAQABAAEAAQABAArACsAKwAEACsABAAEACsABAAEAAQABAAEAAQABABQAAQAKwArACsAKwArACsAKwArAEsASwBLAEsASwBLAEsASwBLAEsAKwArACsAKwArACsAUABQAFAAUABQAFAAKwBQAFAAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAEAAQABAAEAAQAKwAEAAQAKwAEAAQABAAEAAQAUAArACsAKwArACsAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAABAAEAAQABAAeAB4AKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwBQACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAB4AHgAeAB4AHgAeAB4AHgAaABoAGgAaAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgArACsAKwArACsAKwArACsAKwArACsAKwArAA0AUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAKwArACsAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsADQANAA0ADQANACsAKwArACsAKwArACsAKwArACsAKwBQAFAAUABQACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAASABIAEgAQwBDAEMAUABQAFAAUABDAFAAUABQAEgAQwBIAEMAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAASABDAEMAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwAJAAkACQAJAAkACQAJABYAEQArACsAKwArACsAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABIAEMAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArAEsASwBLAEsASwBLAEsASwBLAEsAKwArACsAKwANAA0AKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwArAAQABAAEAAQABAANACsAKwArACsAKwArACsAKwArACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAEAAQABAAEAAQABAAEAA0ADQANAB4AHgAeAB4AHgAeAFAAUABQAFAADQAeACsAKwArACsAKwArACsAKwArACsASwBLAEsASwBLAEsASwBLAEsASwArAFAAUABQAFAAUABQAFAAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArACsAKwArACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAANAA0AHgAeACsAKwArACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAKwArACsAKwAEAFAABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQAKwArACsAKwArACsAKwAEAAQABAAEAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAARwBHABUARwAJACsAKwArACsAKwArACsAKwArACsAKwAEAAQAKwArACsAKwArACsAKwArACsAKwArACsAKwArAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXACsAKwArACsAKwArACsAKwBXAFcAVwBXAFcAVwBXAFcAVwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAUQBRAFEAKwArACsAKwArACsAKwArACsAKwArACsAKwBRAFEAUQBRACsAKwArACsAKwArACsAKwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXACsAKwArACsAUABQAFAAUABQAFAAUABQAFAAUABQACsAKwArACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAKwArACsAKwArACsAUABQAFAAUABQAFAAUABQAFAAUAArACsAHgAEAAQADQAEAAQABAAEACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgArACsAKwArACsAKwArACsAKwArAB4AHgAeAB4AHgAeAB4AKwArAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAAQABAAEAAQABAAeAB4AHgAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAB4AHgAEAAQABAAEAAQABAAEAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4ABAAEAAQABAAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4ABAAEAAQAHgArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAKwArACsAKwArACsAKwArACsAKwArAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgArACsAKwArACsAKwArACsAKwAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgArAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AKwBQAFAAKwArAFAAKwArAFAAUAArACsAUABQAFAAUAArAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeACsAUAArAFAAUABQAFAAUABQAFAAKwAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AKwBQAFAAUABQACsAKwBQAFAAUABQAFAAUABQAFAAKwBQAFAAUABQAFAAUABQACsAHgAeAFAAUABQAFAAUAArAFAAKwArACsAUABQAFAAUABQAFAAUAArAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAHgBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgBQAFAAUABQAFAAUABQAFAAUABQAFAAHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAB4AHgAeAB4AHgAeAB4AHgAeACsAKwBLAEsASwBLAEsASwBLAEsASwBLAEsASwBLAEsASwBLAEsASwBLAEsASwBLAEsASwBLAEsASwBLAEsASwBLAEsASwBLAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAeAB4AHgAeAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAeAB4AHgAeAB4AHgAeAB4ABAAeAB4AHgAeAB4AHgAeAB4AHgAeAAQAHgAeAA0ADQANAA0AHgArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwAEAAQABAAEAAQAKwAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArAAQABAAEAAQABAAEAAQAKwAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQAKwArAAQABAAEAAQABAAEAAQAKwAEAAQAKwAEAAQABAAEAAQAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArACsAKwAEAAQABAAEAAQABAAEAFAAUABQAFAAUABQAFAAKwArAEsASwBLAEsASwBLAEsASwBLAEsAKwArACsAKwBQAB4AKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUAAEAAQABAAEAEsASwBLAEsASwBLAEsASwBLAEsAKwArACsAKwArABsAUABQAFAAUABQACsAKwBQAFAAUABQAFAAUABQAFAAUAAEAAQABAAEAAQABAAEACsAKwArACsAKwArACsAKwArAB4AHgAeAB4ABAAEAAQABAAEAAQABABQACsAKwArACsASwBLAEsASwBLAEsASwBLAEsASwArACsAKwArABYAFgArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAGgBQAFAAUAAaAFAAUABQAFAAKwArACsAKwArACsAKwArACsAKwArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAeAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQACsAKwBQAFAAUABQACsAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwBQAFAAKwBQACsAKwBQACsAUABQAFAAUABQAFAAUABQAFAAUAArAFAAUABQAFAAKwBQACsAUAArACsAKwArACsAKwBQACsAKwArACsAUAArAFAAKwBQACsAUABQAFAAKwBQAFAAKwBQACsAKwBQACsAUAArAFAAKwBQACsAUAArAFAAUAArAFAAKwArAFAAUABQAFAAKwBQAFAAUABQAFAAUABQACsAUABQAFAAUAArAFAAUABQAFAAKwBQACsAUABQAFAAUABQAFAAUABQAFAAUAArAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAArACsAKwArACsAUABQAFAAKwBQAFAAUABQAFAAKwBQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwAeAB4AKwArACsAKwArACsAKwArACsAKwArACsAKwArAE8ATwBPAE8ATwBPAE8ATwBPAE8ATwBPAE8AJQAlACUAHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHgAeAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB4AHgAeACUAJQAlAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAdAB0AHQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQApACkAKQApACkAKQApACkAKQApACkAKQApACkAKQApACkAKQApACkAKQApACkAKQApACkAJQAlACUAJQAlACAAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAeAB4AJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlAB4AHgAlACUAJQAlACUAHgAlACUAJQAlACUAIAAgACAAJQAlACAAJQAlACAAIAAgACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACEAIQAhACEAIQAlACUAIAAgACUAJQAgACAAIAAgACAAIAAgACAAIAAgACAAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAJQAlACUAIAAlACUAJQAlACAAIAAgACUAIAAgACAAJQAlACUAJQAlACUAJQAgACUAIAAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAHgAlAB4AJQAeACUAJQAlACUAJQAgACUAJQAlACUAHgAlAB4AHgAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlAB4AHgAeAB4AHgAeAB4AJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAeAB4AHgAeAB4AHgAeAB4AHgAeACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACAAIAAlACUAJQAlACAAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACAAJQAlACUAJQAgACAAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAHgAeAB4AHgAeAB4AHgAeACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAeAB4AHgAeAB4AHgAlACUAJQAlACUAJQAlACAAIAAgACUAJQAlACAAIAAgACAAIAAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeABcAFwAXABUAFQAVAB4AHgAeAB4AJQAlACUAIAAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACAAIAAgACUAJQAlACUAJQAlACUAJQAlACAAJQAlACUAJQAlACUAJQAlACUAJQAlACAAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AJQAlACUAJQAlACUAJQAlACUAJQAlACUAHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AJQAlACUAJQAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeACUAJQAlACUAJQAlACUAJQAeAB4AHgAeAB4AHgAeAB4AHgAeACUAJQAlACUAJQAlAB4AHgAeAB4AHgAeAB4AHgAlACUAJQAlACUAJQAlACUAHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAgACUAJQAgACUAJQAlACUAJQAlACUAJQAgACAAIAAgACAAIAAgACAAJQAlACUAJQAlACUAIAAlACUAJQAlACUAJQAlACUAJQAgACAAIAAgACAAIAAgACAAIAAgACUAJQAgACAAIAAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAgACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACAAIAAlACAAIAAlACAAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAgACAAIAAlACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAJQAlAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AKwAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArAEsASwBLAEsASwBLAEsASwBLAEsAKwArACsAKwArACsAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAKwArAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXACUAJQBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwAlACUAJQAlACUAJQAlACUAJQAlACUAVwBXACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQBXAFcAVwBXAFcAVwBXAFcAVwBXAFcAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAJQAlACUAKwAEACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArACsAKwArAA=="),L=Array.isArray(m)?function(A){for(var e=A.length,t=[],r=0;r=this._value.length?-1:this._value[A]},XA.prototype.consumeUnicodeRangeToken=function(){for(var A=[],e=this.consumeCodePoint();lA(e)&&A.length<6;)A.push(e),e=this.consumeCodePoint();for(var t=!1;63===e&&A.length<6;)A.push(e),e=this.consumeCodePoint(),t=!0;if(t)return{type:30,start:parseInt(g.apply(void 0,A.map(function(A){return 63===A?48:A})),16),end:parseInt(g.apply(void 0,A.map(function(A){return 63===A?70:A})),16)};var r=parseInt(g.apply(void 0,A),16);if(45===this.peekCodePoint(0)&&lA(this.peekCodePoint(1))){this.consumeCodePoint();for(var e=this.consumeCodePoint(),B=[];lA(e)&&B.length<6;)B.push(e),e=this.consumeCodePoint();return{type:30,start:r,end:parseInt(g.apply(void 0,B),16)}}return{type:30,start:r,end:r}},XA.prototype.consumeIdentLikeToken=function(){var A=this.consumeName();return"url"===A.toLowerCase()&&40===this.peekCodePoint(0)?(this.consumeCodePoint(),this.consumeUrlToken()):40===this.peekCodePoint(0)?(this.consumeCodePoint(),{type:19,value:A}):{type:20,value:A}},XA.prototype.consumeUrlToken=function(){var A=[];if(this.consumeWhiteSpace(),-1===this.peekCodePoint(0))return{type:22,value:""};var e,t=this.peekCodePoint(0);if(39===t||34===t){t=this.consumeStringToken(this.consumeCodePoint());return 0===t.type&&(this.consumeWhiteSpace(),-1===this.peekCodePoint(0)||41===this.peekCodePoint(0))?(this.consumeCodePoint(),{type:22,value:t.value}):(this.consumeBadUrlRemnants(),xA)}for(;;){var r=this.consumeCodePoint();if(-1===r||41===r)return{type:22,value:g.apply(void 0,A)};if(CA(r))return this.consumeWhiteSpace(),-1===this.peekCodePoint(0)||41===this.peekCodePoint(0)?(this.consumeCodePoint(),{type:22,value:g.apply(void 0,A)}):(this.consumeBadUrlRemnants(),xA);if(34===r||39===r||40===r||(0<=(e=r)&&e<=8||11===e||14<=e&&e<=31||127===e))return this.consumeBadUrlRemnants(),xA;if(92===r){if(!hA(r,this.peekCodePoint(0)))return this.consumeBadUrlRemnants(),xA;A.push(this.consumeEscapedCodePoint())}else A.push(r)}},XA.prototype.consumeWhiteSpace=function(){for(;CA(this.peekCodePoint(0));)this.consumeCodePoint()},XA.prototype.consumeBadUrlRemnants=function(){for(;;){var A=this.consumeCodePoint();if(41===A||-1===A)return;hA(A,this.peekCodePoint(0))&&this.consumeEscapedCodePoint()}},XA.prototype.consumeStringSlice=function(A){for(var e="";0>8,r=255&A>>16,A=255&A>>24;return e<255?"rgba("+A+","+r+","+t+","+e/255+")":"rgb("+A+","+r+","+t+")"}function Qe(A,e){if(17===A.type)return A.number;if(16!==A.type)return 0;var t=3===e?1:255;return 3===e?A.number/100*t:Math.round(A.number/100*t)}var ce=function(A,e){return 11===e&&12===A.type||(28===e&&29===A.type||2===e&&3===A.type)},ae={type:17,number:0,flags:4},ge={type:16,number:50,flags:4},we={type:16,number:100,flags:4},Ue=function(A,e){if(16===A.type)return A.number/100*e;if(WA(A))switch(A.unit){case"rem":case"em":return 16*A.number;default:return A.number}return A.number},le=function(A,e){if(15===e.type)switch(e.unit){case"deg":return Math.PI*e.number/180;case"grad":return Math.PI/200*e.number;case"rad":return e.number;case"turn":return 2*Math.PI*e.number}throw new Error("Unsupported angle type")},Ce=function(A){return Math.PI*A/180},ue=function(A,e){if(18===e.type){var t=me[e.name];if(void 0===t)throw new Error('Attempting to parse an unsupported color function "'+e.name+'"');return t(A,e.values)}if(5===e.type){if(3===e.value.length){var r=e.value.substring(0,1),B=e.value.substring(1,2),n=e.value.substring(2,3);return Fe(parseInt(r+r,16),parseInt(B+B,16),parseInt(n+n,16),1)}if(4===e.value.length){var r=e.value.substring(0,1),B=e.value.substring(1,2),n=e.value.substring(2,3),s=e.value.substring(3,4);return Fe(parseInt(r+r,16),parseInt(B+B,16),parseInt(n+n,16),parseInt(s+s,16)/255)}if(6===e.value.length){r=e.value.substring(0,2),B=e.value.substring(2,4),n=e.value.substring(4,6);return Fe(parseInt(r,16),parseInt(B,16),parseInt(n,16),1)}if(8===e.value.length){r=e.value.substring(0,2),B=e.value.substring(2,4),n=e.value.substring(4,6),s=e.value.substring(6,8);return Fe(parseInt(r,16),parseInt(B,16),parseInt(n,16),parseInt(s,16)/255)}}if(20===e.type){e=Le[e.value.toUpperCase()];if(void 0!==e)return e}return Le.TRANSPARENT},Fe=function(A,e,t,r){return(A<<24|e<<16|t<<8|Math.round(255*r)<<0)>>>0},he=function(A,e){e=e.filter($A);if(3===e.length){var t=e.map(Qe),r=t[0],B=t[1],t=t[2];return Fe(r,B,t,1)}if(4!==e.length)return 0;e=e.map(Qe),r=e[0],B=e[1],t=e[2],e=e[3];return Fe(r,B,t,e)};function de(A,e,t){return t<0&&(t+=1),1<=t&&--t,t<1/6?(e-A)*t*6+A:t<.5?e:t<2/3?6*(e-A)*(2/3-t)+A:A}function fe(A,e){return ue(A,JA.create(e).parseComponentValue())}function He(A,e){return A=ue(A,e[0]),(e=e[1])&&te(e)?{color:A,stop:e}:{color:A,stop:null}}function pe(A,t){var e=A[0],r=A[A.length-1];null===e.stop&&(e.stop=ae),null===r.stop&&(r.stop=we);for(var B=[],n=0,s=0;sA.optimumDistance)?{optimumCorner:e,optimumDistance:r}:A},{optimumDistance:s?1/0:-1/0,optimumCorner:null}).optimumCorner}var Ke=function(A,e){var t=e.filter($A),r=t[0],B=t[1],n=t[2],e=t[3],t=(17===r.type?Ce(r.number):le(A,r))/(2*Math.PI),A=te(B)?B.number/100:0,r=te(n)?n.number/100:0,B=void 0!==e&&te(e)?Ue(e,1):1;if(0==A)return Fe(255*r,255*r,255*r,1);n=r<=.5?r*(1+A):r+A-r*A,e=2*r-n,A=de(e,n,t+1/3),r=de(e,n,t),t=de(e,n,t-1/3);return Fe(255*A,255*r,255*t,B)},me={hsl:Ke,hsla:Ke,rgb:he,rgba:he},Le={ALICEBLUE:4042850303,ANTIQUEWHITE:4209760255,AQUA:16777215,AQUAMARINE:2147472639,AZURE:4043309055,BEIGE:4126530815,BISQUE:4293182719,BLACK:255,BLANCHEDALMOND:4293643775,BLUE:65535,BLUEVIOLET:2318131967,BROWN:2771004159,BURLYWOOD:3736635391,CADETBLUE:1604231423,CHARTREUSE:2147418367,CHOCOLATE:3530104575,CORAL:4286533887,CORNFLOWERBLUE:1687547391,CORNSILK:4294499583,CRIMSON:3692313855,CYAN:16777215,DARKBLUE:35839,DARKCYAN:9145343,DARKGOLDENROD:3095837695,DARKGRAY:2846468607,DARKGREEN:6553855,DARKGREY:2846468607,DARKKHAKI:3182914559,DARKMAGENTA:2332068863,DARKOLIVEGREEN:1433087999,DARKORANGE:4287365375,DARKORCHID:2570243327,DARKRED:2332033279,DARKSALMON:3918953215,DARKSEAGREEN:2411499519,DARKSLATEBLUE:1211993087,DARKSLATEGRAY:793726975,DARKSLATEGREY:793726975,DARKTURQUOISE:13554175,DARKVIOLET:2483082239,DEEPPINK:4279538687,DEEPSKYBLUE:12582911,DIMGRAY:1768516095,DIMGREY:1768516095,DODGERBLUE:512819199,FIREBRICK:2988581631,FLORALWHITE:4294635775,FORESTGREEN:579543807,FUCHSIA:4278255615,GAINSBORO:3705462015,GHOSTWHITE:4177068031,GOLD:4292280575,GOLDENROD:3668254975,GRAY:2155905279,GREEN:8388863,GREENYELLOW:2919182335,GREY:2155905279,HONEYDEW:4043305215,HOTPINK:4285117695,INDIANRED:3445382399,INDIGO:1258324735,IVORY:4294963455,KHAKI:4041641215,LAVENDER:3873897215,LAVENDERBLUSH:4293981695,LAWNGREEN:2096890111,LEMONCHIFFON:4294626815,LIGHTBLUE:2916673279,LIGHTCORAL:4034953471,LIGHTCYAN:3774873599,LIGHTGOLDENRODYELLOW:4210742015,LIGHTGRAY:3553874943,LIGHTGREEN:2431553791,LIGHTGREY:3553874943,LIGHTPINK:4290167295,LIGHTSALMON:4288707327,LIGHTSEAGREEN:548580095,LIGHTSKYBLUE:2278488831,LIGHTSLATEGRAY:2005441023,LIGHTSLATEGREY:2005441023,LIGHTSTEELBLUE:2965692159,LIGHTYELLOW:4294959359,LIME:16711935,LIMEGREEN:852308735,LINEN:4210091775,MAGENTA:4278255615,MAROON:2147483903,MEDIUMAQUAMARINE:1724754687,MEDIUMBLUE:52735,MEDIUMORCHID:3126187007,MEDIUMPURPLE:2473647103,MEDIUMSEAGREEN:1018393087,MEDIUMSLATEBLUE:2070474495,MEDIUMSPRINGGREEN:16423679,MEDIUMTURQUOISE:1221709055,MEDIUMVIOLETRED:3340076543,MIDNIGHTBLUE:421097727,MINTCREAM:4127193855,MISTYROSE:4293190143,MOCCASIN:4293178879,NAVAJOWHITE:4292783615,NAVY:33023,OLDLACE:4260751103,OLIVE:2155872511,OLIVEDRAB:1804477439,ORANGE:4289003775,ORANGERED:4282712319,ORCHID:3664828159,PALEGOLDENROD:4008225535,PALEGREEN:2566625535,PALETURQUOISE:2951671551,PALEVIOLETRED:3681588223,PAPAYAWHIP:4293907967,PEACHPUFF:4292524543,PERU:3448061951,PINK:4290825215,PLUM:3718307327,POWDERBLUE:2967529215,PURPLE:2147516671,REBECCAPURPLE:1714657791,RED:4278190335,ROSYBROWN:3163525119,ROYALBLUE:1097458175,SADDLEBROWN:2336560127,SALMON:4202722047,SANDYBROWN:4104413439,SEAGREEN:780883967,SEASHELL:4294307583,SIENNA:2689740287,SILVER:3233857791,SKYBLUE:2278484991,SLATEBLUE:1784335871,SLATEGRAY:1887473919,SLATEGREY:1887473919,SNOW:4294638335,SPRINGGREEN:16744447,STEELBLUE:1182971135,TAN:3535047935,TEAL:8421631,THISTLE:3636451583,TOMATO:4284696575,TRANSPARENT:0,TURQUOISE:1088475391,VIOLET:4001558271,WHEAT:4125012991,WHITE:4294967295,WHITESMOKE:4126537215,YELLOW:4294902015,YELLOWGREEN:2597139199},be={name:"background-clip",initialValue:"border-box",prefix:!1,type:1,parse:function(A,e){return e.map(function(A){if(_A(A))switch(A.value){case"padding-box":return 1;case"content-box":return 2}return 0})}},De={name:"background-color",initialValue:"transparent",prefix:!1,type:3,format:"color"},Ke=function(t,A){var r=Ce(180),B=[];return Ae(A).forEach(function(A,e){if(0===e){e=A[0];if(20===e.type&&-1!==["top","left","right","bottom"].indexOf(e.value))return void(r=se(A));if(ne(e))return void(r=(le(t,e)+Ce(270))%Ce(360))}A=He(t,A);B.push(A)}),{angle:r,stops:B,type:1}},ve="closest-side",xe="farthest-side",Me="closest-corner",Se="farthest-corner",Te="ellipse",Ge="contain",he=function(r,A){var B=0,n=3,s=[],o=[];return Ae(A).forEach(function(A,e){var t=!0;0===e?t=A.reduce(function(A,e){if(_A(e))switch(e.value){case"center":return o.push(ge),!1;case"top":case"left":return o.push(ae),!1;case"right":case"bottom":return o.push(we),!1}else if(te(e)||ee(e))return o.push(e),!1;return A},t):1===e&&(t=A.reduce(function(A,e){if(_A(e))switch(e.value){case"circle":return B=0,!1;case Te:return!(B=1);case Ge:case ve:return n=0,!1;case xe:return!(n=1);case Me:return!(n=2);case"cover":case Se:return!(n=3)}else if(ee(e)||te(e))return(n=!Array.isArray(n)?[]:n).push(e),!1;return A},t)),t&&(A=He(r,A),s.push(A))}),{size:n,shape:B,stops:s,position:o,type:2}},Oe=function(A,e){if(22===e.type){var t={url:e.value,type:0};return A.cache.addImage(e.value),t}if(18!==e.type)throw new Error("Unsupported image type "+e.type);t=ke[e.name];if(void 0===t)throw new Error('Attempting to parse an unsupported image function "'+e.name+'"');return t(A,e.values)};var Ve,ke={"linear-gradient":function(t,A){var r=Ce(180),B=[];return Ae(A).forEach(function(A,e){if(0===e){e=A[0];if(20===e.type&&"to"===e.value)return void(r=se(A));if(ne(e))return void(r=le(t,e))}A=He(t,A);B.push(A)}),{angle:r,stops:B,type:1}},"-moz-linear-gradient":Ke,"-ms-linear-gradient":Ke,"-o-linear-gradient":Ke,"-webkit-linear-gradient":Ke,"radial-gradient":function(B,A){var n=0,s=3,o=[],i=[];return Ae(A).forEach(function(A,e){var t,r=!0;0===e&&(t=!1,r=A.reduce(function(A,e){if(t)if(_A(e))switch(e.value){case"center":return i.push(ge),A;case"top":case"left":return i.push(ae),A;case"right":case"bottom":return i.push(we),A}else(te(e)||ee(e))&&i.push(e);else if(_A(e))switch(e.value){case"circle":return n=0,!1;case Te:return!(n=1);case"at":return!(t=!0);case ve:return s=0,!1;case"cover":case xe:return!(s=1);case Ge:case Me:return!(s=2);case Se:return!(s=3)}else if(ee(e)||te(e))return(s=!Array.isArray(s)?[]:s).push(e),!1;return A},r)),r&&(A=He(B,A),o.push(A))}),{size:s,shape:n,stops:o,position:i,type:2}},"-moz-radial-gradient":he,"-ms-radial-gradient":he,"-o-radial-gradient":he,"-webkit-radial-gradient":he,"-webkit-gradient":function(r,A){var e=Ce(180),B=[],n=1;return Ae(A).forEach(function(A,e){var t,A=A[0];if(0===e){if(_A(A)&&"linear"===A.value)return void(n=1);if(_A(A)&&"radial"===A.value)return void(n=2)}18===A.type&&("from"===A.name?(t=ue(r,A.values[0]),B.push({stop:ae,color:t})):"to"===A.name?(t=ue(r,A.values[0]),B.push({stop:we,color:t})):"color-stop"!==A.name||2===(A=A.values.filter($A)).length&&(t=ue(r,A[1]),A=A[0],ZA(A)&&B.push({stop:{type:16,number:100*A.number,flags:A.flags},color:t})))}),1===n?{angle:(e+Ce(180))%Ce(360),stops:B,type:n}:{size:3,shape:0,stops:B,position:[],type:n}}},Re={name:"background-image",initialValue:"none",type:1,prefix:!1,parse:function(e,A){if(0===A.length)return[];var t=A[0];return 20===t.type&&"none"===t.value?[]:A.filter(function(A){return $A(A)&&!(20===(A=A).type&&"none"===A.value||18===A.type&&!ke[A.name])}).map(function(A){return Oe(e,A)})}},Ne={name:"background-origin",initialValue:"border-box",prefix:!1,type:1,parse:function(A,e){return e.map(function(A){if(_A(A))switch(A.value){case"padding-box":return 1;case"content-box":return 2}return 0})}},Pe={name:"background-position",initialValue:"0% 0%",type:1,prefix:!1,parse:function(A,e){return Ae(e).map(function(A){return A.filter(te)}).map(re)}},Xe={name:"background-repeat",initialValue:"repeat",prefix:!1,type:1,parse:function(A,e){return Ae(e).map(function(A){return A.filter(_A).map(function(A){return A.value}).join(" ")}).map(Je)}},Je=function(A){switch(A){case"no-repeat":return 1;case"repeat-x":case"repeat no-repeat":return 2;case"repeat-y":case"no-repeat repeat":return 3;default:return 0}};(he=Ve=Ve||{}).AUTO="auto",he.CONTAIN="contain";function Ye(A,e){return _A(A)&&"normal"===A.value?1.2*e:17===A.type?e*A.number:te(A)?Ue(A,e):e}var We,Ze,_e={name:"background-size",initialValue:"0",prefix:!(he.COVER="cover"),type:1,parse:function(A,e){return Ae(e).map(function(A){return A.filter(qe)})}},qe=function(A){return _A(A)||te(A)},he=function(A){return{name:"border-"+A+"-color",initialValue:"transparent",prefix:!1,type:3,format:"color"}},je=he("top"),ze=he("right"),$e=he("bottom"),At=he("left"),he=function(A){return{name:"border-radius-"+A,initialValue:"0 0",prefix:!1,type:1,parse:function(A,e){return re(e.filter(te))}}},et=he("top-left"),tt=he("top-right"),rt=he("bottom-right"),Bt=he("bottom-left"),he=function(A){return{name:"border-"+A+"-style",initialValue:"solid",prefix:!1,type:2,parse:function(A,e){switch(e){case"none":return 0;case"dashed":return 2;case"dotted":return 3;case"double":return 4}return 1}}},nt=he("top"),st=he("right"),ot=he("bottom"),it=he("left"),he=function(A){return{name:"border-"+A+"-width",initialValue:"0",type:0,prefix:!1,parse:function(A,e){return WA(e)?e.number:0}}},Qt=he("top"),ct=he("right"),at=he("bottom"),gt=he("left"),wt={name:"color",initialValue:"transparent",prefix:!1,type:3,format:"color"},Ut={name:"direction",initialValue:"ltr",prefix:!1,type:2,parse:function(A,e){return"rtl"!==e?0:1}},lt={name:"display",initialValue:"inline-block",prefix:!1,type:1,parse:function(A,e){return e.filter(_A).reduce(function(A,e){return A|Ct(e.value)},0)}},Ct=function(A){switch(A){case"block":case"-webkit-box":return 2;case"inline":return 4;case"run-in":return 8;case"flow":return 16;case"flow-root":return 32;case"table":return 64;case"flex":case"-webkit-flex":return 128;case"grid":case"-ms-grid":return 256;case"ruby":return 512;case"subgrid":return 1024;case"list-item":return 2048;case"table-row-group":return 4096;case"table-header-group":return 8192;case"table-footer-group":return 16384;case"table-row":return 32768;case"table-cell":return 65536;case"table-column-group":return 131072;case"table-column":return 262144;case"table-caption":return 524288;case"ruby-base":return 1048576;case"ruby-text":return 2097152;case"ruby-base-container":return 4194304;case"ruby-text-container":return 8388608;case"contents":return 16777216;case"inline-block":return 33554432;case"inline-list-item":return 67108864;case"inline-table":return 134217728;case"inline-flex":return 268435456;case"inline-grid":return 536870912}return 0},ut={name:"float",initialValue:"none",prefix:!1,type:2,parse:function(A,e){switch(e){case"left":return 1;case"right":return 2;case"inline-start":return 3;case"inline-end":return 4}return 0}},Ft={name:"letter-spacing",initialValue:"0",prefix:!1,type:0,parse:function(A,e){return!(20===e.type&&"normal"===e.value||17!==e.type&&15!==e.type)?e.number:0}},ht={name:"line-break",initialValue:(he=We=We||{}).NORMAL="normal",prefix:!(he.STRICT="strict"),type:2,parse:function(A,e){return"strict"!==e?We.NORMAL:We.STRICT}},dt={name:"line-height",initialValue:"normal",prefix:!1,type:4},ft={name:"list-style-image",initialValue:"none",type:0,prefix:!1,parse:function(A,e){return 20===e.type&&"none"===e.value?null:Oe(A,e)}},Ht={name:"list-style-position",initialValue:"outside",prefix:!1,type:2,parse:function(A,e){return"inside"!==e?1:0}},pt={name:"list-style-type",initialValue:"none",prefix:!1,type:2,parse:function(A,e){switch(e){case"disc":return 0;case"circle":return 1;case"square":return 2;case"decimal":return 3;case"cjk-decimal":return 4;case"decimal-leading-zero":return 5;case"lower-roman":return 6;case"upper-roman":return 7;case"lower-greek":return 8;case"lower-alpha":return 9;case"upper-alpha":return 10;case"arabic-indic":return 11;case"armenian":return 12;case"bengali":return 13;case"cambodian":return 14;case"cjk-earthly-branch":return 15;case"cjk-heavenly-stem":return 16;case"cjk-ideographic":return 17;case"devanagari":return 18;case"ethiopic-numeric":return 19;case"georgian":return 20;case"gujarati":return 21;case"gurmukhi":case"hebrew":return 22;case"hiragana":return 23;case"hiragana-iroha":return 24;case"japanese-formal":return 25;case"japanese-informal":return 26;case"kannada":return 27;case"katakana":return 28;case"katakana-iroha":return 29;case"khmer":return 30;case"korean-hangul-formal":return 31;case"korean-hanja-formal":return 32;case"korean-hanja-informal":return 33;case"lao":return 34;case"lower-armenian":return 35;case"malayalam":return 36;case"mongolian":return 37;case"myanmar":return 38;case"oriya":return 39;case"persian":return 40;case"simp-chinese-formal":return 41;case"simp-chinese-informal":return 42;case"tamil":return 43;case"telugu":return 44;case"thai":return 45;case"tibetan":return 46;case"trad-chinese-formal":return 47;case"trad-chinese-informal":return 48;case"upper-armenian":return 49;case"disclosure-open":return 50;case"disclosure-closed":return 51;default:return-1}}},he=function(A){return{name:"margin-"+A,initialValue:"0",prefix:!1,type:4}},Et=he("top"),It=he("right"),yt=he("bottom"),Kt=he("left"),mt={name:"overflow",initialValue:"visible",prefix:!1,type:1,parse:function(A,e){return e.filter(_A).map(function(A){switch(A.value){case"hidden":return 1;case"scroll":return 2;case"clip":return 3;case"auto":return 4;default:return 0}})}},Lt={name:"overflow-wrap",initialValue:"normal",prefix:!1,type:2,parse:function(A,e){return"break-word"!==e?"normal":"break-word"}},he=function(A){return{name:"padding-"+A,initialValue:"0",prefix:!1,type:3,format:"length-percentage"}},bt=he("top"),Dt=he("right"),vt=he("bottom"),xt=he("left"),Mt={name:"text-align",initialValue:"left",prefix:!1,type:2,parse:function(A,e){switch(e){case"right":return 2;case"center":case"justify":return 1;default:return 0}}},St={name:"position",initialValue:"static",prefix:!1,type:2,parse:function(A,e){switch(e){case"relative":return 1;case"absolute":return 2;case"fixed":return 3;case"sticky":return 4}return 0}},Tt={name:"text-shadow",initialValue:"none",type:1,prefix:!1,parse:function(n,A){return 1===A.length&&jA(A[0],"none")?[]:Ae(A).map(function(A){for(var e={color:Le.TRANSPARENT,offsetX:ae,offsetY:ae,blur:ae},t=0,r=0;r>5],this.data[e=(e<<2)+(31&A)];if(A<=65535)return e=this.index[2048+(A-55296>>5)],this.data[e=(e<<2)+(31&A)];if(A>11)],e=this.index[e+=A>>5&63],this.data[e=(e<<2)+(31&A)];if(A<=1114111)return this.data[this.highValueIndex]}return this.errorValue},pr);function pr(A,e,t,r,B,n){this.initialValue=A,this.errorValue=e,this.highStart=t,this.highValueIndex=r,this.index=B,this.data=n}for(var Er="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/",Ir="undefined"==typeof Uint8Array?[]:new Uint8Array(256),yr=0;yr>10),s%1024+56320)),(B+1===t||16384>4,i[o++]=(15&t)<<4|r>>2,i[o++]=(3&r)<<6|63&B;return n}(br="AAAAAAAAAAAAEA4AGBkAAFAaAAACAAAAAAAIABAAGAAwADgACAAQAAgAEAAIABAACAAQAAgAEAAIABAACAAQAAgAEAAIABAAQABIAEQATAAIABAACAAQAAgAEAAIABAAVABcAAgAEAAIABAACAAQAGAAaABwAHgAgACIAI4AlgAIABAAmwCjAKgAsAC2AL4AvQDFAMoA0gBPAVYBWgEIAAgACACMANoAYgFkAWwBdAF8AX0BhQGNAZUBlgGeAaMBlQGWAasBswF8AbsBwwF0AcsBYwHTAQgA2wG/AOMBdAF8AekB8QF0AfkB+wHiAHQBfAEIAAMC5gQIAAsCEgIIAAgAFgIeAggAIgIpAggAMQI5AkACygEIAAgASAJQAlgCYAIIAAgACAAKBQoFCgUTBRMFGQUrBSsFCAAIAAgACAAIAAgACAAIAAgACABdAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACABoAmgCrwGvAQgAbgJ2AggAHgEIAAgACADnAXsCCAAIAAgAgwIIAAgACAAIAAgACACKAggAkQKZAggAPADJAAgAoQKkAqwCsgK6AsICCADJAggA0AIIAAgACAAIANYC3gIIAAgACAAIAAgACABAAOYCCAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAkASoB+QIEAAgACAA8AEMCCABCBQgACABJBVAFCAAIAAgACAAIAAgACAAIAAgACABTBVoFCAAIAFoFCABfBWUFCAAIAAgACAAIAAgAbQUIAAgACAAIAAgACABzBXsFfQWFBYoFigWKBZEFigWKBYoFmAWfBaYFrgWxBbkFCAAIAAgACAAIAAgACAAIAAgACAAIAMEFCAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAMgFCADQBQgACAAIAAgACAAIAAgACAAIAAgACAAIAO4CCAAIAAgAiQAIAAgACABAAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAD0AggACAD8AggACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIANYFCAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAMDvwAIAAgAJAIIAAgACAAIAAgACAAIAAgACwMTAwgACAB9BOsEGwMjAwgAKwMyAwsFYgE3A/MEPwMIAEUDTQNRAwgAWQOsAGEDCAAIAAgACAAIAAgACABpAzQFNQU2BTcFOAU5BToFNAU1BTYFNwU4BTkFOgU0BTUFNgU3BTgFOQU6BTQFNQU2BTcFOAU5BToFNAU1BTYFNwU4BTkFOgU0BTUFNgU3BTgFOQU6BTQFNQU2BTcFOAU5BToFNAU1BTYFNwU4BTkFOgU0BTUFNgU3BTgFOQU6BTQFNQU2BTcFOAU5BToFNAU1BTYFNwU4BTkFOgU0BTUFNgU3BTgFOQU6BTQFNQU2BTcFOAU5BToFNAU1BTYFNwU4BTkFOgU0BTUFNgU3BTgFOQU6BTQFNQU2BTcFOAU5BToFNAU1BTYFNwU4BTkFOgU0BTUFNgU3BTgFOQU6BTQFNQU2BTcFOAU5BToFNAU1BTYFNwU4BTkFOgU0BTUFNgU3BTgFOQU6BTQFNQU2BTcFOAU5BToFNAU1BTYFNwU4BTkFOgU0BTUFNgU3BTgFOQU6BTQFNQU2BTcFOAU5BToFNAU1BTYFNwU4BTkFOgU0BTUFNgU3BTgFOQU6BTQFNQU2BTcFOAU5BToFNAU1BTYFNwU4BTkFOgU0BTUFNgU3BTgFOQU6BTQFNQU2BTcFOAU5BToFNAU1BTYFNwU4BTkFOgU0BTUFNgU3BTgFOQU6BTQFNQU2BTcFOAU5BToFNAU1BTYFNwU4BTkFOgU0BTUFNgU3BTgFOQU6BTQFNQU2BTcFOAU5BToFNAU1BTYFNwU4BTkFOgU0BTUFNgU3BTgFOQU6BTQFNQU2BTcFOAU5BToFNAU1BTYFNwU4BTkFOgU0BTUFNgU3BTgFOQU6BTQFNQU2BTcFOAU5BToFNAU1BTYFNwU4BTkFOgU0BTUFNgU3BTgFOQU6BTQFNQU2BTcFOAU5BToFNAU1BTYFNwU4BTkFOgU0BTUFNgU3BTgFOQU6BTQFNQU2BTcFOAU5BToFNAU1BTYFNwU4BTkFIQUoBSwFCAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACABtAwgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACABMAEwACAAIAAgACAAIABgACAAIAAgACAC/AAgACAAyAQgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACACAAIAAwAAgACAAIAAgACAAIAAgACAAIAAAARABIAAgACAAIABQASAAIAAgAIABwAEAAjgCIABsAqAC2AL0AigDQAtwC+IJIQqVAZUBWQqVAZUBlQGVAZUBlQGrC5UBlQGVAZUBlQGVAZUBlQGVAXsKlQGVAbAK6wsrDGUMpQzlDJUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAZUBlQGVAfAKAAuZA64AtwCJALoC6ADwAAgAuACgA/oEpgO6AqsD+AAIAAgAswMIAAgACAAIAIkAuwP5AfsBwwPLAwgACAAIAAgACADRA9kDCAAIAOED6QMIAAgACAAIAAgACADuA/YDCAAIAP4DyQAIAAgABgQIAAgAXQAOBAgACAAIAAgACAAIABMECAAIAAgACAAIAAgACAD8AAQBCAAIAAgAGgQiBCoECAExBAgAEAEIAAgACAAIAAgACAAIAAgACAAIAAgACAA4BAgACABABEYECAAIAAgATAQYAQgAVAQIAAgACAAIAAgACAAIAAgACAAIAFoECAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgAOQEIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAB+BAcACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAEABhgSMBAgACAAIAAgAlAQIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAwAEAAQABAADAAMAAwADAAQABAAEAAQABAAEAAQABHATAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgAdQMIAAgACAAIAAgACAAIAMkACAAIAAgAfQMIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACACFA4kDCAAIAAgACAAIAOcBCAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAIcDCAAIAAgACAAIAAgACAAIAAgACAAIAJEDCAAIAAgACADFAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACABgBAgAZgQIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgAbAQCBXIECAAIAHkECAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACABAAJwEQACjBKoEsgQIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAC6BMIECAAIAAgACAAIAAgACABmBAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgAxwQIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAGYECAAIAAgAzgQIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgAigWKBYoFigWKBYoFigWKBd0FXwUIAOIF6gXxBYoF3gT5BQAGCAaKBYoFigWKBYoFigWKBYoFigWKBYoFigXWBIoFigWKBYoFigWKBYoFigWKBYsFEAaKBYoFigWKBYoFigWKBRQGCACKBYoFigWKBQgACAAIANEECAAIABgGigUgBggAJgYIAC4GMwaKBYoF0wQ3Bj4GigWKBYoFigWKBYoFigWKBYoFigWKBYoFigUIAAgACAAIAAgACAAIAAgAigWKBYoFigWKBYoFigWKBYoFigWKBYoFigWKBYoFigWKBYoFigWKBYoFigWKBYoFigWKBYoFigWKBYoFigWLBf///////wQABAAEAAQABAAEAAQABAAEAAQAAwAEAAQAAgAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAAAAAAAAAAAAAAAAAAAAAAAAAOAAAAAAAAAAQADgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAFAAUABQAFAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAAAAUAAAAFAAUAAAAFAAUAAAAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAAEAAQABAAEAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAFAAUABQAFAAUABQAFAAUABQAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAFAAUABQAFAAUAAQAAAAUABQAFAAUABQAFAAAAAAAFAAUAAAAFAAUABQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAUABQAFAAUABQAFAAUABQAFAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAUABQAFAAUABQAFAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAFAAAAAAAFAAUAAQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABwAFAAUABQAFAAAABwAHAAcAAAAHAAcABwAFAAEAAAAAAAAAAAAAAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAHAAcABwAFAAUABQAFAAcABwAFAAUAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAHAAAAAQABAAAAAAAAAAAAAAAFAAUABQAFAAAABwAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAHAAcABwAHAAcAAAAHAAcAAAAAAAUABQAHAAUAAQAHAAEABwAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAFAAUABQAFAAUABwABAAUABQAFAAUAAAAAAAAAAAAAAAEAAQABAAEAAQABAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABwAFAAUAAAAAAAAAAAAAAAAABQAFAAUABQAFAAUAAQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAFAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQABQANAAQABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQABAAEAAQABAAEAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAAEAAQABAAEAAQABAAEAAQABAAEAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAQABAAEAAQABAAEAAQABAAAAAAAAAAAAAAAAAAAAAAABQAHAAUABQAFAAAAAAAAAAcABQAFAAUABQAFAAQABAAEAAQABAAEAAQABAAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAEAAQABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAFAAUAAAAFAAUABQAFAAUAAAAFAAUABQAAAAUABQAFAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAUABQAAAAAAAAAAAAUABQAFAAcAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAHAAUAAAAHAAcABwAFAAUABQAFAAUABQAFAAUABwAHAAcABwAFAAcABwAAAAUABQAFAAUABQAFAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABwAHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAAAAUABwAHAAUABQAFAAUAAAAAAAcABwAAAAAABwAHAAUAAAAAAAAAAAAAAAAAAAAAAAAABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAAAAAABQAFAAcAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAAABwAHAAcABQAFAAAAAAAAAAAABQAFAAAAAAAFAAUABQAAAAAAAAAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAAAAAAAAAFAAAAAAAAAAAAAAAAAAAAAAAAAAAABwAFAAUABQAFAAUAAAAFAAUABwAAAAcABwAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAUABQAFAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUAAAAFAAUABwAFAAUABQAFAAAAAAAHAAcAAAAAAAcABwAFAAAAAAAAAAAAAAAAAAAABQAFAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAcABwAAAAAAAAAHAAcABwAAAAcABwAHAAUAAAAAAAAAAAAAAAAAAAAAAAAABQAAAAAAAAAAAAAAAAAAAAAABQAHAAcABwAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABwAHAAcABwAAAAUABQAFAAAABQAFAAUABQAAAAAAAAAAAAAAAAAAAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAAAAcABQAHAAcABQAHAAcAAAAFAAcABwAAAAcABwAFAAUAAAAAAAAAAAAAAAAAAAAFAAUAAAAAAAAAAAAAAAAAAAAAAAAABQAFAAcABwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAAAAUABwAAAAAAAAAAAAAAAAAAAAAAAAAAAAUAAAAAAAAAAAAFAAcABwAFAAUABQAAAAUAAAAHAAcABwAHAAcABwAHAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUAAAAHAAUABQAFAAUABQAFAAUAAAAAAAAAAAAAAAAAAAAAAAUABQAFAAUABQAFAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAAABwAFAAUABQAFAAUABQAFAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAFAAUABQAFAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAAAAUAAAAFAAAAAAAAAAAABwAHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABwAFAAUABQAFAAUAAAAFAAUAAAAAAAAAAAAAAAUABQAFAAUABQAFAAUABQAFAAUABQAAAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAFAAUABwAFAAUABQAFAAUABQAAAAUABQAHAAcABQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAHAAcABQAFAAAAAAAAAAAABQAFAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAUABQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAAAAcABQAFAAAAAAAAAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAFAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAHAAUABQAFAAUABQAFAAUABwAHAAcABwAHAAcABwAHAAUABwAHAAUABQAFAAUABQAFAAUABQAFAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAFAAUABwAHAAcABwAFAAUABwAHAAcAAAAAAAAAAAAHAAcABQAHAAcABwAHAAcABwAFAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAFAAcABwAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcABQAHAAUABQAFAAUABQAFAAUAAAAFAAAABQAAAAAABQAFAAUABQAFAAUABQAFAAcABwAHAAcABwAHAAUABQAFAAUABQAFAAUABQAFAAUAAAAAAAUABQAFAAUABQAHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAFAAUABQAFAAUABwAFAAcABwAHAAcABwAFAAcABwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAUABQAFAAUABQAFAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAUABwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAHAAUABQAFAAUABwAHAAUABQAHAAUABQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAcABQAFAAcABwAHAAUABwAFAAUABQAHAAcAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABwAHAAcABwAHAAcABwAHAAUABQAFAAUABQAFAAUABQAHAAcABQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAFAAUAAAAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAcABQAFAAUABQAFAAUABQAAAAAAAAAAAAUAAAAAAAAAAAAAAAAABQAAAAAABwAFAAUAAAAAAAAAAAAAAAAABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAAABQAFAAUABQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAFAAUABQAFAAUADgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAFAAUAAAAFAAUABQAFAAUABQAFAAUABQAFAAAAAAAAAAAABQAAAAAAAAAFAAAAAAAAAAAABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABwAHAAUABQAHAAAAAAAAAAAABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcABwAHAAcABQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUAAAAAAAAAAAAAAAAABQAFAAUABQAFAAUABQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAFAAUABQAFAAUABQAFAAUABQAHAAcAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAcABwAFAAUABQAFAAcABwAFAAUABwAHAAAAAAAAAAAAAAAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAFAAUABQAFAAcABwAFAAUABwAHAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAAAAAAAAAAAAAAAAAAAAAAFAAcAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUAAAAFAAUABQAAAAAABQAFAAAAAAAAAAAAAAAFAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcABQAFAAcABwAAAAAAAAAAAAAABwAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcABwAFAAcABwAFAAcABwAAAAcABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAFAAUABQAAAAAAAAAAAAAAAAAFAAUABQAAAAUABQAAAAAAAAAAAAAABQAFAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAUABQAAAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcABQAHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAUABQAFAAUABwAFAAUABQAFAAUABQAFAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABwAHAAcABQAFAAUABQAFAAUABQAFAAUABwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAHAAcABwAFAAUABQAHAAcABQAHAAUABQAAAAAAAAAAAAAAAAAFAAAABwAHAAcABQAFAAUABQAFAAUABQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABwAHAAcABwAAAAAABwAHAAAAAAAHAAcABwAAAAAAAAAAAAAAAAAAAAAAAAAFAAAAAAAAAAAAAAAAAAAAAAAAAAAABwAHAAAAAAAFAAUABQAFAAUABQAFAAAAAAAAAAUABQAFAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAHAAcABwAFAAUABQAFAAUABQAFAAUABwAHAAUABQAFAAcABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAHAAcABQAFAAUABQAFAAUABwAFAAcABwAFAAcABQAFAAcABQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAHAAcABQAFAAUABQAAAAAABwAHAAcABwAFAAUABwAFAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcABwAHAAUABQAFAAUABQAFAAUABQAHAAcABQAHAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABwAFAAcABwAFAAUABQAFAAUABQAHAAUAAAAAAAAAAAAAAAAAAAAAAAcABwAFAAUABQAFAAcABQAFAAUABQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAHAAcABwAFAAUABQAFAAUABQAFAAUABQAHAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAHAAcABwAFAAUABQAFAAAAAAAFAAUABwAHAAcABwAFAAAAAAAAAAcAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAUABQAFAAUABQAFAAUABQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAAAAAAABQAFAAUABQAFAAUABwAHAAUABQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcABQAFAAUABQAFAAUABQAAAAUABQAFAAUABQAFAAcABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUAAAAHAAUABQAFAAUABQAFAAUABwAFAAUABwAFAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAFAAUABQAFAAUAAAAAAAAABQAAAAUABQAAAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAHAAcABwAHAAcAAAAFAAUAAAAHAAcABQAHAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAUABwAHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAUABQAFAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAUABQAFAAUABQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAAAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAAAAAAAAAAAAAAAAAAABQAFAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcABwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAAAAUABQAFAAAAAAAFAAUABQAFAAUABQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAFAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAFAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAAAAAAAAAAABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAAAAAAAAAAAAAAAAAAAAAAFAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUABQAFAAUABQAAAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAFAAUABQAFAAUABQAAAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAFAAUABQAAAAAABQAFAAUABQAFAAUABQAAAAUABQAAAAUABQAFAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFAAUABQAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQAFAAUABQAFAAUABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAFAAUABQAFAAUADgAOAA4ADgAOAA4ADwAPAA8ADwAPAA8ADwAPAA8ADwAPAA8ADwAPAA8ADwAPAA8ADwAPAA8ADwAPAA8ADwAPAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcABwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABwAHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAcABwAHAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAgACAAIAAAAAAAAAAkACQAJAAkACQAJAAkACQAJAAkACQAJAAkACQAJAAkACQAJAAkACQAJAAkACQAJAAkACQAJAAkACQAJAAkACQAKAAoACgAKAAoACgAKAAoACgAKAAoACgAKAAoACgAKAAoACgAKAAoACgAKAAoACgAMAAwADAAMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAkACQAJAAkACQAJAAkACQAJAAkACQAJAAkACQAJAAkACQAJAAkAAAAAAAAAAAAKAAoACgAKAAoACgAKAAoACgAKAAoACgAKAAoACgAKAAoACgAKAAoACgAKAAoACgAKAAoACgAKAAoACgAKAAoACgAAAAAAAAAAAAsADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwACwAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAMAAwADAAAAAAADgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOAA4ADgAOAA4ADgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADgAOAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA4ADgAAAAAAAAAAAAAAAAAAAAAADgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADgAOAA4ADgAOAA4ADgAOAA4ADgAOAAAAAAAAAAAADgAOAA4AAAAAAAAAAAAAAAAAAAAOAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADgAOAAAAAAAAAAAAAAAAAAAAAAAAAAAADgAAAAAAAAAAAAAAAAAAAAAAAAAOAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADgAOAA4ADgAAAA4ADgAOAA4ADgAOAAAADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4AAAAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAAAAAAAAAAAAAAAAAAAAAAAAAAAADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4AAAAAAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAAAA4AAAAOAAAAAAAAAAAAAAAAAA4AAAAAAAAAAAAAAAAADgAAAAAAAAAAAAAAAAAAAAAAAAAAAA4ADgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADgAAAAAADgAAAAAAAAAAAA4AAAAOAAAAAAAAAAAADgAOAA4AAAAOAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOAA4ADgAOAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOAA4ADgAAAAAAAAAAAAAAAAAAAAAAAAAOAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA4ADgAOAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADgAOAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADgAAAAAAAAAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOAAAADgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOAA4ADgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA4ADgAOAA4ADgAOAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA4ADgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADgAAAAAADgAOAA4ADgAOAA4ADgAOAA4ADgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAAAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAAAAAAAAAAAAAAAAAAAAAAAAAAAADgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA4AAAAAAA4ADgAOAA4ADgAOAA4ADgAOAAAADgAOAA4ADgAAAAAAAAAAAAAAAAAAAAAAAAAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4AAAAAAAAAAAAAAAAADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOAA4ADgAOAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADgAOAA4ADgAOAA4ADgAOAAAAAAAAAAAAAAAAAAAAAAAAAAAADgAOAA4ADgAOAA4AAAAAAAAAAAAAAAAAAAAAAA4ADgAOAA4ADgAOAA4ADgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4AAAAOAA4ADgAOAA4ADgAAAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4ADgAOAA4AAAAAAAAAAAA="),xr=Array.isArray(vr)?function(A){for(var e=A.length,t=[],r=0;rs.x||t.y>s.y;return s=t,0===e||A});return A.body.removeChild(e),t}(document);return Object.defineProperty(Xr,"SUPPORT_WORD_BREAKING",{value:A}),A},get SUPPORT_SVG_DRAWING(){var A=function(A){var e=new Image,t=A.createElement("canvas"),A=t.getContext("2d");if(!A)return!1;e.src="data:image/svg+xml,";try{A.drawImage(e,0,0),t.toDataURL()}catch(A){return!1}return!0}(document);return Object.defineProperty(Xr,"SUPPORT_SVG_DRAWING",{value:A}),A},get SUPPORT_FOREIGNOBJECT_DRAWING(){var A="function"==typeof Array.from&&"function"==typeof window.fetch?function(t){var A=t.createElement("canvas"),r=100;A.width=r,A.height=r;var B=A.getContext("2d");if(!B)return Promise.reject(!1);B.fillStyle="rgb(0, 255, 0)",B.fillRect(0,0,r,r);var e=new Image,n=A.toDataURL();e.src=n;e=Nr(r,r,0,0,e);return B.fillStyle="red",B.fillRect(0,0,r,r),Pr(e).then(function(A){B.drawImage(A,0,0);var e=B.getImageData(0,0,r,r).data;B.fillStyle="red",B.fillRect(0,0,r,r);A=t.createElement("div");return A.style.backgroundImage="url("+n+")",A.style.height="100px",Lr(e)?Pr(Nr(r,r,0,0,A)):Promise.reject(!1)}).then(function(A){return B.drawImage(A,0,0),Lr(B.getImageData(0,0,r,r).data)}).catch(function(){return!1})}(document):Promise.resolve(!1);return Object.defineProperty(Xr,"SUPPORT_FOREIGNOBJECT_DRAWING",{value:A}),A},get SUPPORT_CORS_IMAGES(){var A=void 0!==(new Image).crossOrigin;return Object.defineProperty(Xr,"SUPPORT_CORS_IMAGES",{value:A}),A},get SUPPORT_RESPONSE_TYPE(){var A="string"==typeof(new XMLHttpRequest).responseType;return Object.defineProperty(Xr,"SUPPORT_RESPONSE_TYPE",{value:A}),A},get SUPPORT_CORS_XHR(){var A="withCredentials"in new XMLHttpRequest;return Object.defineProperty(Xr,"SUPPORT_CORS_XHR",{value:A}),A},get SUPPORT_NATIVE_TEXT_SEGMENTATION(){var A=!("undefined"==typeof Intl||!Intl.Segmenter);return Object.defineProperty(Xr,"SUPPORT_NATIVE_TEXT_SEGMENTATION",{value:A}),A}},Jr=function(A,e){this.text=A,this.bounds=e},Yr=function(A,e){var t=e.ownerDocument;if(t){var r=t.createElement("html2canvaswrapper");r.appendChild(e.cloneNode(!0));t=e.parentNode;if(t){t.replaceChild(r,e);A=f(A,r);return r.firstChild&&t.replaceChild(r.firstChild,r),A}}return d.EMPTY},Wr=function(A,e,t){var r=A.ownerDocument;if(!r)throw new Error("Node has no owner document");r=r.createRange();return r.setStart(A,e),r.setEnd(A,e+t),r},Zr=function(A){if(Xr.SUPPORT_NATIVE_TEXT_SEGMENTATION){var e=new Intl.Segmenter(void 0,{granularity:"grapheme"});return Array.from(e.segment(A)).map(function(A){return A.segment})}return function(A){for(var e,t=mr(A),r=[];!(e=t.next()).done;)e.value&&r.push(e.value.slice());return r}(A)},_r=function(A,e){return 0!==e.letterSpacing?Zr(A):function(A,e){if(Xr.SUPPORT_NATIVE_TEXT_SEGMENTATION){var t=new Intl.Segmenter(void 0,{granularity:"word"});return Array.from(t.segment(A)).map(function(A){return A.segment})}return jr(A,e)}(A,e)},qr=[32,160,4961,65792,65793,4153,4241],jr=function(A,e){for(var t,r=wA(A,{lineBreak:e.lineBreak,wordBreak:"break-word"===e.overflowWrap?"break-word":e.wordBreak}),B=[];!(t=r.next()).done;)!function(){var A,e;t.value&&(A=t.value.slice(),A=Q(A),e="",A.forEach(function(A){-1===qr.indexOf(A)?e+=g(A):(e.length&&B.push(e),B.push(g(A)),e="")}),e.length&&B.push(e))}();return B},zr=function(A,e,t){var B,n,s,o,i;this.text=$r(e.data,t.textTransform),this.textBounds=(B=A,A=this.text,s=e,A=_r(A,n=t),o=[],i=0,A.forEach(function(A){var e,t,r;n.textDecorationLine.length||0e.height?new d(e.left+(e.width-e.height)/2,e.top,e.height,e.height):e.width"),Ln(this.referenceElement.ownerDocument,t,n),o.replaceChild(o.adoptNode(this.documentElement),o.documentElement),o.close(),A},fn.prototype.createElementClone=function(A){if(Cr(A,2),zB(A))return this.createCanvasClone(A);if(MB(A))return this.createVideoClone(A);if(SB(A))return this.createStyleClone(A);var e=A.cloneNode(!1);return $B(e)&&($B(A)&&A.currentSrc&&A.currentSrc!==A.src&&(e.src=A.currentSrc,e.srcset=""),"lazy"===e.loading&&(e.loading="eager")),TB(e)?this.createCustomElementClone(e):e},fn.prototype.createCustomElementClone=function(A){var e=document.createElement("html2canvascustomelement");return Kn(A.style,e),e},fn.prototype.createStyleClone=function(A){try{var e=A.sheet;if(e&&e.cssRules){var t=[].slice.call(e.cssRules,0).reduce(function(A,e){return e&&"string"==typeof e.cssText?A+e.cssText:A},""),r=A.cloneNode(!1);return r.textContent=t,r}}catch(A){if(this.context.logger.error("Unable to access cssRules property",A),"SecurityError"!==A.name)throw A}return A.cloneNode(!1)},fn.prototype.createCanvasClone=function(e){var A;if(this.options.inlineImages&&e.ownerDocument){var t=e.ownerDocument.createElement("img");try{return t.src=e.toDataURL(),t}catch(A){this.context.logger.info("Unable to inline canvas contents, canvas is tainted",e)}}t=e.cloneNode(!1);try{t.width=e.width,t.height=e.height;var r,B,n=e.getContext("2d"),s=t.getContext("2d");return s&&(!this.options.allowTaint&&n?s.putImageData(n.getImageData(0,0,e.width,e.height),0,0):(!(r=null!==(A=e.getContext("webgl2"))&&void 0!==A?A:e.getContext("webgl"))||!1===(null==(B=r.getContextAttributes())?void 0:B.preserveDrawingBuffer)&&this.context.logger.warn("Unable to clone WebGL context as it has preserveDrawingBuffer=false",e),s.drawImage(e,0,0))),t}catch(A){this.context.logger.info("Unable to clone canvas as it is tainted",e)}return t},fn.prototype.createVideoClone=function(e){var A=e.ownerDocument.createElement("canvas");A.width=e.offsetWidth,A.height=e.offsetHeight;var t=A.getContext("2d");try{return t&&(t.drawImage(e,0,0,A.width,A.height),this.options.allowTaint||t.getImageData(0,0,A.width,A.height)),A}catch(A){this.context.logger.info("Unable to clone video as it is tainted",e)}A=e.ownerDocument.createElement("canvas");return A.width=e.offsetWidth,A.height=e.offsetHeight,A},fn.prototype.appendChildNode=function(A,e,t){XB(e)&&("SCRIPT"===e.tagName||e.hasAttribute(hn)||"function"==typeof this.options.ignoreElements&&this.options.ignoreElements(e))||this.options.copyStyles&&XB(e)&&SB(e)||A.appendChild(this.cloneNode(e,t))},fn.prototype.cloneChildNodes=function(A,e,t){for(var r,B=this,n=(A.shadowRoot||A).firstChild;n;n=n.nextSibling)XB(n)&&rn(n)&&"function"==typeof n.assignedNodes?(r=n.assignedNodes()).length&&r.forEach(function(A){return B.appendChildNode(e,A,t)}):this.appendChildNode(e,n,t)},fn.prototype.cloneNode=function(A,e){if(PB(A))return document.createTextNode(A.data);if(!A.ownerDocument)return A.cloneNode(!1);var t=A.ownerDocument.defaultView;if(t&&XB(A)&&(JB(A)||YB(A))){var r=this.createElementClone(A);r.style.transitionProperty="none";var B=t.getComputedStyle(A),n=t.getComputedStyle(A,":before"),s=t.getComputedStyle(A,":after");this.referenceElement===A&&JB(r)&&(this.clonedReferenceElement=r),jB(r)&&Mn(r);t=this.counters.parse(new Ur(this.context,B)),n=this.resolvePseudoContent(A,r,n,gn.BEFORE);TB(A)&&(e=!0),MB(A)||this.cloneChildNodes(A,r,e),n&&r.insertBefore(n,r.firstChild);s=this.resolvePseudoContent(A,r,s,gn.AFTER);return s&&r.appendChild(s),this.counters.pop(t),(B&&(this.options.copyStyles||YB(A))&&!An(A)||e)&&Kn(B,r),0===A.scrollTop&&0===A.scrollLeft||this.scrolledElements.push([r,A.scrollLeft,A.scrollTop]),(en(A)||tn(A))&&(en(r)||tn(r))&&(r.value=A.value),r}return A.cloneNode(!1)},fn.prototype.resolvePseudoContent=function(o,A,e,t){var i=this;if(e){var r=e.content,Q=A.ownerDocument;if(Q&&r&&"none"!==r&&"-moz-alt-content"!==r&&"none"!==e.display){this.counters.parse(new Ur(this.context,e));var c=new wr(this.context,e),a=Q.createElement("html2canvaspseudoelement");Kn(e,a),c.content.forEach(function(A){if(0===A.type)a.appendChild(Q.createTextNode(A.value));else if(22===A.type){var e=Q.createElement("img");e.src=A.value,e.style.opacity="1",a.appendChild(e)}else if(18===A.type){var t,r,B,n,s;"attr"===A.name?(e=A.values.filter(_A)).length&&a.appendChild(Q.createTextNode(o.getAttribute(e[0].value)||"")):"counter"===A.name?(B=(r=A.values.filter($A))[0],r=r[1],B&&_A(B)&&(t=i.counters.getCounterValue(B.value),s=r&&_A(r)?pt.parse(i.context,r.value):3,a.appendChild(Q.createTextNode(Fn(t,s,!1))))):"counters"===A.name&&(B=(t=A.values.filter($A))[0],s=t[1],r=t[2],B&&_A(B)&&(B=i.counters.getCounterValues(B.value),n=r&&_A(r)?pt.parse(i.context,r.value):3,s=s&&0===s.type?s.value:"",s=B.map(function(A){return Fn(A,n,!1)}).join(s),a.appendChild(Q.createTextNode(s))))}else if(20===A.type)switch(A.value){case"open-quote":a.appendChild(Q.createTextNode(Xt(c.quotes,i.quoteDepth++,!0)));break;case"close-quote":a.appendChild(Q.createTextNode(Xt(c.quotes,--i.quoteDepth,!1)));break;default:a.appendChild(Q.createTextNode(A.value))}}),a.className=Dn+" "+vn;t=t===gn.BEFORE?" "+Dn:" "+vn;return YB(A)?A.className.baseValue+=t:A.className+=t,a}}},fn.destroy=function(A){return!!A.parentNode&&(A.parentNode.removeChild(A),!0)},fn);function fn(A,e,t){if(this.context=A,this.options=t,this.scrolledElements=[],this.referenceElement=e,this.counters=new Bn,this.quoteDepth=0,!e.ownerDocument)throw new Error("Cloned element does not have an owner document");this.documentElement=this.cloneNode(e.ownerDocument.documentElement,!1)}(he=gn=gn||{})[he.BEFORE=0]="BEFORE",he[he.AFTER=1]="AFTER";function Hn(e){return new Promise(function(A){!e.complete&&e.src?(e.onload=A,e.onerror=A):A()})}var pn=function(A,e){var t=A.createElement("iframe");return t.className="html2canvas-container",t.style.visibility="hidden",t.style.position="fixed",t.style.left="-10000px",t.style.top="0px",t.style.border="0",t.width=e.width.toString(),t.height=e.height.toString(),t.scrolling="no",t.setAttribute(hn,"true"),A.body.appendChild(t),t},En=function(A){return Promise.all([].slice.call(A.images,0).map(Hn))},In=function(B){return new Promise(function(e,A){var t=B.contentWindow;if(!t)return A("No window assigned for iframe");var r=t.document;t.onload=B.onload=function(){t.onload=B.onload=null;var A=setInterval(function(){0"),e},Ln=function(A,e,t){A&&A.defaultView&&(e!==A.defaultView.pageXOffset||t!==A.defaultView.pageYOffset)&&A.defaultView.scrollTo(e,t)},bn=function(A){var e=A[0],t=A[1],A=A[2];e.scrollLeft=t,e.scrollTop=A},Dn="___html2canvas___pseudoelement_before",vn="___html2canvas___pseudoelement_after",xn='{\n content: "" !important;\n display: none !important;\n}',Mn=function(A){Sn(A,"."+Dn+":before"+xn+"\n ."+vn+":after"+xn)},Sn=function(A,e){var t=A.ownerDocument;t&&((t=t.createElement("style")).textContent=e,A.appendChild(t))},Tn=(Gn.getOrigin=function(A){var e=Gn._link;return e?(e.href=A,e.href=e.href,e.protocol+e.hostname+e.port):"about:blank"},Gn.isSameOrigin=function(A){return Gn.getOrigin(A)===Gn._origin},Gn.setContext=function(A){Gn._link=A.document.createElement("a"),Gn._origin=Gn.getOrigin(A.location.href)},Gn._origin="about:blank",Gn);function Gn(){}var On=(Vn.prototype.addImage=function(A){var e=Promise.resolve();return this.has(A)||(Yn(A)||Pn(A))&&(this._cache[A]=this.loadImage(A)).catch(function(){}),e},Vn.prototype.match=function(A){return this._cache[A]},Vn.prototype.loadImage=function(s){return a(this,void 0,void 0,function(){var e,r,t,B,n=this;return H(this,function(A){switch(A.label){case 0:return(e=Tn.isSameOrigin(s),r=!Xn(s)&&!0===this._options.useCORS&&Xr.SUPPORT_CORS_IMAGES&&!e,t=!Xn(s)&&!e&&!Yn(s)&&"string"==typeof this._options.proxy&&Xr.SUPPORT_CORS_XHR&&!r,e||!1!==this._options.allowTaint||Xn(s)||Yn(s)||t||r)?(B=s,t?[4,this.proxy(B)]:[3,2]):[2];case 1:B=A.sent(),A.label=2;case 2:return this.context.logger.debug("Added image "+s.substring(0,256)),[4,new Promise(function(A,e){var t=new Image;t.onload=function(){return A(t)},t.onerror=e,(Jn(B)||r)&&(t.crossOrigin="anonymous"),t.src=B,!0===t.complete&&setTimeout(function(){return A(t)},500),0t.width+C?0:Math.max(0,n-C),Math.max(0,s-l),As.TOP_RIGHT):new Zn(t.left+t.width-C,t.top+l),this.bottomRightPaddingBox=0t.width+F+A?0:n-F+A,s-(l+h),As.TOP_RIGHT):new Zn(t.left+t.width-(C+d),t.top+l+h),this.bottomRightContentBox=0A.element.container.styles.zIndex.order?(s=e,!1):0=A.element.container.styles.zIndex.order?(o=e+1,!1):0Only one dataset available.,,combine_ui.R +

    Dataset 1:,

    数据集 1：,combine_ui.R +

    Dataset 2:,

    数据集 2：,combine_ui.R +

    No matching variables selected

    ,

    未选择可匹配字段

    ,combine_ui.R +"

    Combining data failed. The error message was:

    \"",

    合并数据失败，错误信息如下：

    \""""",combine_ui.R, +

    Combined dataset: ,

    合并后数据集：,combine_ui.R +Filter data,筛选数据,data_ui +Data filter:,数据筛选：,data_ui +"Provide a filter (e.g., price > 5000) and press return",输入筛选条件（例如 price > 5000）并按回车,data_ui +Data arrange (sort):,数据排序：,data_ui +"Arrange (e.g., color, desc(price)) and press return","输入排序方式（例如 color, desc(price)）并按回车",data_ui +Data slice (rows):,数据行截取：,data_ui +Manage,管理,data_ui +Data preview,数据预览,data_ui +Data structure,数据结构,data_ui +Data summary,数据摘要,data_ui +Data load and save commands,数据加载与保存命令,data_ui +View,查看,"data_ui, view_ui.R" +Visualize,可视化,"data_ui, visualize_ui.R" +Pivot,透视表,data_ui +Explore,探索,"data_ui, explore_ui.R" +Transform,转换,data_ui +Numeric variable(s):,数值型变量：,explore_ui.R +Group by:,分组变量：,"explore_ui.R, pivotr_ui.R" +Select group-by variable,选择分组变量,explore_ui.R +Apply function(s):,应用函数：,explore_ui.R +Select functions,选择函数,explore_ui.R +Function,函数,explore_ui.R +Variables,变量,explore_ui.R +Group by,分组,explore_ui.R +Column header:,列标题：,explore_ui.R +Store as:,命名为：,"explore_ui.R, pivotr_ui.R" +Provide a table name,请输入表格名称,"explore_ui.R, pivotr_ui.R" +Create table,生成表格,explore_ui.R +Update table,更新表格,explore_ui.R +Table slice (rows):,表格行选择：,"explore_ui.R, pivotr_ui.R, view_ui.R" +"e.g., 1:50 and press return",例如 1:5 并按回车,"explore_ui.R, data_ui" +Decimals:,小数位数：,"explore_ui.R, pivotr_ui.R, view_ui.R" +Store,保存,"explore_ui.R, pivotr_ui.R, view_ui.R" +Generating explore table,正在生成探索表格,explore_ui.R +Data Stored,数据已保存,"explore_ui.R, pivotr_ui.R, view_ui.R" +Dataset '{dataset}' was successfully added to the datasets dropdown. Add code to Report > Rmd or Report > R to (re)create the results by clicking the report icon on the bottom left of your screen.,数据集“{dataset}”已成功添加到下拉菜单中。点击左下角的报告图标，在 Report > Rmd 或 Report > R 中添加代码以（重新）生成结果。,explore_ui.R +OK,确定,"explore_ui.R, manage_ui.R, pivotr_ui.R" +Load radiant state file,加载 Radiant 状态文件,"manage_ui.R,global.R" +Load,加载,manage_ui.R +Load data,加载数据,manage_ui.R +Description,描述,manage_ui.R +Paste,粘贴,manage_ui.R +Copy data,复制数据,manage_ui.R +Save,保存,manage_ui.R +Save data,保存数据,manage_ui.R +Save radiant state file,保存 Radiant 状态文件,"manage_ui.R,global.R" +Add/edit data description,添加/编辑数据描述,manage_ui.R +Rename data,重命名数据,manage_ui.R +Display:,显示：,manage_ui.R +Show R-code,显示 R 代码,manage_ui.R +Remove data from memory,从内存中移除数据,manage_ui.R +Remove data,移除数据,manage_ui.R +Copy-and-paste data below:,复制并粘贴数据到下方：,manage_ui.R +Data.frames in Global Env:,全局环境中的数据框：,manage_ui.R +to global workspace,到全局工作空间,manage_ui.R +rds | rda | rdata,rds | rda | rdata,manage_ui.R +parquet,列式存储,manage_ui.R +csv,csv,manage_ui.R +clipboard,剪贴板,manage_ui.R +examples,示例,manage_ui.R +rds (url),rds（url）,manage_ui.R +csv (url),csv（url）,manage_ui.R +from global workspace,从全局工作空间,manage_ui.R +radiant state file,Radiant 状态文件,manage_ui.R +rds,rds,manage_ui.R +rda,rda,manage_ui.R +
    , "
    ", "manage_ui.R" +Upload radiant state file:, "上传 Radiant 状态文件：", "manage_ui.R" +, "", "manage_ui.R" +Datasets:, "数据集：", "manage_ui.R" +Update description, "更新描述", "manage_ui.R" +Load data of type:, "加载数据类型：", "data_ui" +Header, "表头", "data_ui" +Str. as Factor, "作为因子处理字符串", "data_ui" +Separator:, "分隔符：", "data_ui" +Decimal:, "小数点：", "data_ui" +Maximum rows to read:, "最大读取行数：", "data_ui" +Save data to type:, "保存数据类型：", "manage_ui.R" +
    , "
    ", "manage_ui.R" +## Load commands, "## 加载命令", "manage_ui.R" +diamonds, "钻石数据集", "manage_ui.R" +
    , "
    ", "manage_ui.R" +Type text to describe the data using markdown to format it.\nSee http://commonmark.org/help/ for more information, "使用 Markdown 格式化文本来描述数据。更多信息请参见 http://commonmark.org/help/", "manage_ui.R" +preview,预览,manage_ui.R +str,结构,manage_ui.R +summary,总结,manage_ui.R +#### There was an error loading the data. Please make sure the data are in csv format,#### 加载数据时发生错误。请确保数据为 CSV 格式。,manage.R +Read issues (max 10 rows shown):,读取问题（最多显示 10 行）：,manage.R +#### Radiant does not load xls files directly. Please save the data as a csv file and try again.,#### Radiant 不支持直接加载 XLS 文件。请将数据另存为 CSV 文件后再试。,manage.R +#### The filename extension \{fext}\" does not match the specified file-type \"{ext}\". Please specify the file type you are trying to upload",#### 文件扩展名“{fext}”与所选的文件类型“{ext}”不匹配。请确认要上传的文件类型。,manage.R +#### There was an error loading the data. Please make sure the data are in rda format.,#### 加载数据时发生错误。请确保数据为 RDA 格式。,manage.R +#### To restore state select 'radiant state file' from the 'Load data of type' drowdown before loading the file,#### 如需恢复状态，请先在“数据类型”下拉菜单中选择“Radiant 状态文件”后再加载。,manage.R +#### More than one R object contained in the data.,#### 数据中包含多个 R 对象。,manage.R +#### There was an error loading the data. Please make sure the data are in rds format.,#### 加载数据时发生错误。请确保数据为 RDS 格式。,manage.R +The 'arrow' package is not installed. Please install it and try again.,未安装 'arrow' 包。请先安装后再试。,manage.R +#### The arrow package required to work with data in parquet format is not installed. Please use install.packages('arrow'),#### 加载 Parquet 格式数据需要安装 arrow 包。请运行 install.packages('arrow') 进行安装。,manage.R +#### There was an error loading the data. Please make sure the data are in parquet format.,#### 加载数据时发生错误。请确保数据为 Parquet 格式。,manage.R +#### There was an error loading the data,#### 加载数据时发生错误,manage.R +#### The selected filetype is not currently supported ({fext}),#### 当前不支持所选文件类型（{fext}）,manage.R +None,无,pivotr_ui.R +Row,行,pivotr_ui.R +Column,列,pivotr_ui.R +Total,总计,pivotr_ui.R +Color bar,色条,pivotr_ui.R +Heat map,热力图,pivotr_ui.R +Categorical variables:,分类变量：,pivotr_ui.R +Select categorical variables,选择分类变量,pivotr_ui.R +Numeric variable:,数值变量：,pivotr_ui.R +Select numeric variable,选择数值变量,pivotr_ui.R +Apply function:,应用函数：,pivotr_ui.R +Normalize by:,按以下方式标准化：,pivotr_ui.R +Conditional formatting:,条件格式化：,pivotr_ui.R +Create pivot table,生成透视表,pivotr_ui.R +Update pivot table,更新透视表,pivotr_ui.R +"e.g., 1:5 and press return",例如：1:5 并按回车,pivotr_ui.R +Show table ,显示表格,pivotr_ui.R +Show plot ,显示图形,pivotr_ui.R +Percentage,百分比,pivotr_ui.R +Chi-square,卡方检验,pivotr_ui.R +Fill,填充,pivotr_ui.R +Flip,翻转,"pivotr_ui.R,visualize_ui.R" +Pivotr,透视表模块,pivotr_ui.R +Generating pivot table,正在生成透视表,pivotr_ui.R +Plots created for at most 3 categorical variables,最多只能为三个分类变量生成图表,pivotr_ui.R +Dataset '%s' was successfully added to the datasets dropdown. Add code to Report > Rmd or Report > R to (re)create the results by clicking the report icon on the bottom left of your screen.,数据集「%s」已成功添加至下拉菜单。点击左下角的报告图标可将代码添加到 Report > Rmd 或 Report > R，以用于（重新）生成结果。,pivotr_ui.R +Making plot,正在生成图表,pivotr_ui.R +Save pivot plot,保存透视图,pivotr_ui.R +Plot type:,图类型：,pivotr_ui.R +Acquiring variable information,获取变量信息,pivotr_ui.R +Select variable(s):,选择变量：,transform_ui.R +Normalizing variable:,标准化变量：,transform_ui.R +Frequency variable:,频率变量：,transform_ui.R +Key name:,键名：,transform_ui.R +Value name:,值名：,transform_ui.R +Key(s):,键(s)：,transform_ui.R +Value:,值：,transform_ui.R +Fill:,填充:,"transform_ui.R, visualize_ui.R" +Reorder/remove variables:,重新排序/移除变量：,transform_ui.R +Select a single variable of type factor or character,选择一个类型为因子或字符的单个变量,transform_ui.R +Reorder/remove levels:,重新排序/移除级别：,transform_ui.R +Replacement level name:,替换级别名称：,transform_ui.R +Variable name extension:,变量名扩展：,transform_ui.R +Recoded variable name:,重新编码变量名：,transform_ui.R +Variable name:,变量名：,transform_ui.R +Add extension to variable name,为变量名添加扩展,transform_ui.R +Rename variable(s):,重命名变量：,transform_ui.R +Create:,创建：,transform_ui.R +Nr bins:,箱数：,transform_ui.R +Reverse order,反转顺序,transform_ui.R +Size:,大小：,"transform_ui.R, visualize_ui.R" +Seed:,种子：,transform_ui.R +Reverse filter and slice,反向过滤并切片,transform_ui.R +Paste from spreadsheet:,从电子表格粘贴：,transform_ui.R +"Specify a recode statement, assign a name to the recoded variable, and press 'return'",指定重新编码语句，为重新编码的变量分配名称，并按回车,transform_ui.R +Select one or more variables to rename,选择一个或多个变量进行重命名,transform_ui.R +Select one or more variables to replace,选择一个或多个变量进行替换,transform_ui.R +Select a variable to recode,选择一个变量进行重新编码,transform_ui.R +Select one or more variables to bin,选择一个或多个变量进行分箱,transform_ui.R +Select a single variable of type factor to change the ordering and/or number of levels,选择一个因子类型的单个变量来更改排序和/或级别数量,transform_ui.R +Select one or more variables to normalize,选择一个或多个变量进行标准化,transform_ui.R +Select one or more variables to see the effects of removing missing values,选择一个或多个变量，查看移除缺失值的效果,transform_ui.R +Select one or more variables to see the effects of removing duplicates,选择一个或多个变量，查看移除重复值的效果,transform_ui.R +Select one or more variables to gather,选择一个或多个变量进行汇集,transform_ui.R +Select one or more variables to expand,选择一个或多个变量进行扩展,transform_ui.R +Select a transformation type or select variables to summarize,选择一个转换类型或选择变量进行汇总,transform_ui.R +The transformation type you selected generated an error.,您选择的转换类型生成了一个错误。,transform_ui.R +The error message was:,错误消息是：,transform_ui.R +Please change the selection of variables or the transformation type and try again.,请更改变量选择或转换类型并重试。,transform_ui.R +The create command was not valid.,创建命令无效。,transform_ui.R +The command entered was:,输入的命令是：,transform_ui.R +Please try again. Examples are shown in the help file (click the ? icon).,请再试一次。示例已显示在帮助文件中（点击？图标）,transform_ui.R +Some of the variables names used are not valid. Please use 'Rename' to ensure variable names do not have any spaces or symbols and start with a letter,使用的变量名中有些无效。请使用“重命名”确保变量名没有空格或符号，并以字母开头,transform_ui.R +No duplicates found (n_distinct = ,未找到重复项（n_distinct = ,transform_ui.R +## remove missing values,## 移除缺失值,transform_ui.R +## remove duplicate rows,## 移除重复行,transform_ui.R +## show duplicate rows,## 显示重复行,transform_ui.R +## change variable type,## 更改变量类型,transform_ui.R +## transform variable,## 转换变量,transform_ui.R +## created variable to select training sample,## 创建变量来选择训练样本,transform_ui.R +## create new variable,## 创建新变量,transform_ui.R +## rename variable,## 重命名变量,transform_ui.R +## reorder/remove variables,## 重新排序/移除变量,transform_ui.R +## change factor levels,## 更改因子级别,transform_ui.R +## bin variables,## 分箱变量,transform_ui.R +## gather columns,## 汇集列,transform_ui.R +## spread columns,## 展开列,transform_ui.R +## create holdout sample,## 创建保留样本,transform_ui.R +## register the new dataset,## 注册新数据集,transform_ui.R +Ln (natural log),自然对数,transform_ui.R +Square,平方,transform_ui.R +Square‑root,平方根,transform_ui.R +Center,中心,transform_ui.R +Standardize,标准化,transform_ui.R +Inverse,逆,transform_ui.R +As factor,作为因子,transform_ui.R +As numeric,作为数值,transform_ui.R +As integer,作为整数,transform_ui.R +As character,作为字符,transform_ui.R +As time series,作为时间序列,transform_ui.R +As date (mdy),作为日期（mdy）,transform_ui.R +As date (dmy),作为日期（dmy）,transform_ui.R +As date (ymd),作为日期（ymd）,transform_ui.R +As date/time (mdy_hms),作为日期时间（mdy_hms）,transform_ui.R +As date/time (mdy_hm),作为日期时间（mdy_hm）,transform_ui.R +As date/time (dmy_hms),作为日期时间（dmy_hms）,transform_ui.R +As date/time (dmy_hm),作为日期时间（dmy_hm）,transform_ui.R +As date/time (ymd_hms),作为日期时间（ymd_hms）,transform_ui.R +As date/time (ymd_hm),作为日期时间（ymd_hm）,transform_ui.R +None (summarize),无（汇总）,transform_ui.R +Bin,分箱,transform_ui.R +Change type,更改类型,transform_ui.R +Remove/reorder levels,移除/重新排序级别,transform_ui.R +Rename,重命名,transform_ui.R +Clipboard,剪贴板,transform_ui.R +Create,创建,transform_ui.R +Remove missing values,移除缺失值,transform_ui.R +Remove/reorder variables,移除/重新排序变量,transform_ui.R +Remove duplicates,移除重复值,transform_ui.R +Show duplicates,显示重复值,transform_ui.R +Expand grid,展开网格,transform_ui.R +Table‑to‑data,表格转数据,transform_ui.R +Holdout sample,保留样本,transform_ui.R +Training variable,训练变量,transform_ui.R +Gather columns,汇集列,transform_ui.R +Spread column,展开列,transform_ui.R +Transform command log:,转换命令日志：,transform_ui.R +Generating summary statistics,生成摘要统计,transform_ui.R +Hide summaries,隐藏摘要,transform_ui.R +Transformation type:,转换类型：,transform_ui.R +Change variable type:,更改变量类型：,transform_ui.R +Start year:,起始年份：,transform_ui.R +Start period:,起始周期：,transform_ui.R +End year:,结束年份：,transform_ui.R +End period:,结束周期：,transform_ui.R +Frequency:,频率：,transform_ui.R +"Type a formula to create a new variable (e.g., x = y - z) and press return",输入公式以创建新变量（例如 x = y - z）并按回车,transform_ui.R +Copy-and-paste data with a header row from a spreadsheet,从电子表格复制并粘贴带有标题行的数据,transform_ui.R +Recode:,重新编码：,transform_ui.R +"Select a variable, specify how it should be recoded (e.g., lo:20 = 0; else = 1), and press return",选择一个变量，指定如何重新编码（例如 lo:20 = 0；else = 1），并按回车,transform_ui.R +Select variables:,选择变量：,transform_ui.R +Store changes in:,将更改存储在：,transform_ui.R +Select variables to show:,选择要显示的变量：,view_ui.R +Clear settings,清除设置,view_ui.R +Store filtered data as:,将筛选后的数据存储为：,view_ui.R +Dataset '{dataset}' was successfully added to the datasets dropdown. Add code to Report > Rmd or Report > R to (re)create the dataset by clicking the report icon on the bottom left of your screen.,数据集'{dataset}'已成功添加到数据集下拉菜单中。点击左下角的报告图标，在Report > Rmd或Report > R中添加代码以（重新）创建该数据集。,view_ui.R +Generating view table,正在生成查看表格,view_ui.R +_view,_视图,view_ui.R +Provide data name,提供数据名称,view_ui.R +All,全部,view_ui.R +"Table slice {input$view_tab_slice} will be applied on Download, Store, or Report",表格切片 {input$view_tab_slice} 将应用于下载、存储或报告,view_ui.R +Dataset ',数据集 ',view_ui.R +' was successfully added to the datasets dropdown. Add code to Report > Rmd or Report > R to (re)create the dataset by clicking the report icon on the bottom left of your screen.,' 已成功添加到数据集下拉菜单中。通过点击左下角的报告图标，在 Report > Rmd 或 Report > R 中添加代码以（重新）创建数据集。,view_ui.R +Distribution,分布,visualize_ui.R +Density,密度,visualize_ui.R +Scatter,散点图,visualize_ui.R +Surface,表面图,visualize_ui.R +Line,折线图,visualize_ui.R +Bar,条形图,visualize_ui.R +Box-plot,箱型图,visualize_ui.R +Loess,局部加权回归,visualize_ui.R +Jitter,抖动,visualize_ui.R +Interpolate,插值,visualize_ui.R +Log X,对数X,visualize_ui.R +Log Y,对数Y,visualize_ui.R +Scale-y,缩放Y,visualize_ui.R +Sort,排序,visualize_ui.R +Gray,灰色,visualize_ui.R +Black and White,黑白,visualize_ui.R +Light,浅色,visualize_ui.R +Dark,深色,visualize_ui.R +Minimal,简约,visualize_ui.R +Classic,经典,visualize_ui.R +title,标题,visualize_ui.R +subtitle,副标题,visualize_ui.R +caption,说明,visualize_ui.R +x,X轴,visualize_ui.R +y,Y轴,visualize_ui.R +Theme default,默认主题,visualize_ui.R +Helvetica,Helvetica字体,visualize_ui.R +Serif,衬线字体,visualize_ui.R +Sans,无衬线字体,visualize_ui.R +Mono,等宽字体,visualize_ui.R +Courier,Courier字体,visualize_ui.R +Times,Times字体,visualize_ui.R +dataset, "数据集", "visualize_ui.R" +data_filter, "数据筛选", "visualize_ui.R" +arr, "排序", "visualize_ui.R" +rows, "行", "visualize_ui.R" +labs, "标签", "visualize_ui.R" +Plot-type:, "绘图类型:", "visualize_ui.R" +Number of data points plotted:, "绘制的数据点数量:", "visualize_ui.R" +Y-variable:, "Y变量:", "visualize_ui.R" +X-variable:, "X变量:", "visualize_ui.R" +Combine Y-variables in one plot, "将Y变量合并到一个图表中", "visualize_ui.R" +Combine X-variables in one plot, "将X变量合并到一个图表中", "visualize_ui.R" +Facet row:, "分面行:", "visualize_ui.R" +Facet column:, "分面列:", "visualize_ui.R" +Color:, "颜色", "visualize_ui.R" +Main, "主要", "visualize_ui.R" +Function:, "函数:", "visualize_ui.R" +Labels, "标签", "visualize_ui.R" +Style, "样式", "visualize_ui.R" +Plot theme:, "图表主题:", "visualize_ui.R" +Base font size:, "基本字体大小:", "visualize_ui.R" +Font family:, "字体系列:", "visualize_ui.R" +Opacity:, "透明度:", "visualize_ui.R" +Plot height:, "图表高度:", "visualize_ui.R" +Plot width:, "图表宽度:", "visualize_ui.R" +Number of bins:, "分箱数:", "visualize_ui.R" +Smooth:, "平滑:", "visualize_ui.R" +Create plot, "创建图表", "visualize_ui.R" +Update plot, "更新图表", "visualize_ui.R" +Save visualize plot, "保存可视化图表", "visualize_ui.R" +Please select variables from the dropdown menus to create a plot, "请选择下拉菜单中的变量以创建图表", "visualize_ui.R" +No Y-variable provided for a plot that requires one, "没有提供Y变量，无法绘制需要Y变量的图表", "visualize_ui.R" +Title, "标题", "visualize_ui.R" +Subtitle, "副标题", "visualize_ui.R" +Caption, "说明", "visualize_ui.R" +Y-label, "Y轴标签", "visualize_ui.R" +X-label, "X轴标签", "visualize_ui.R" +Fill color:, "填充颜色:", "visualize_ui.R" +Line color:, "线条颜色:", "visualize_ui.R" +Point color:, "点的颜色:", "visualize_ui.R" +Data,数据,global.R +Share radiant state,分享Radiant状态,global.R +View radiant state,查看Radiant状态,global.R +Download radiant state file,下载Radiant状态文件,global.R +Upload radiant state file,上传Radiant状态文件,global.R +Stop,停止,global.R +Refresh,刷新,global.R +New session,新建会话,global.R +Videos,视频,global.R +About,关于,global.R +Radiant docs,Radiant文档,global.R +Report issue,报告问题,global.R +Report,报告,global.R diff --git a/radiant.data/man/add_class.Rd b/radiant.data/man/add_class.Rd new file mode 100644 index 0000000000000000000000000000000000000000..cbe082e06393874b9d848260ab3808de202d8865 --- /dev/null +++ b/radiant.data/man/add_class.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{add_class} +\alias{add_class} +\title{Convenience function to add a class} +\usage{ +add_class(x, cl) +} +\arguments{ +\item{x}{Object} + +\item{cl}{Vector of class labels to add} +} +\description{ +Convenience function to add a class +} +\examples{ +foo <- "some text" \%>\% add_class("text") +foo <- "some text" \%>\% add_class(c("text", "another class")) +} diff --git a/radiant.data/man/add_description.Rd b/radiant.data/man/add_description.Rd new file mode 100644 index 0000000000000000000000000000000000000000..15215cfd3585ac9356056214db056bbcd2e5e99a --- /dev/null +++ b/radiant.data/man/add_description.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{add_description} +\alias{add_description} +\title{Convenience function to add a markdown description to a data.frame} +\usage{ +add_description(df, md = "", path = "") +} +\arguments{ +\item{df}{A data.frame or tibble} + +\item{md}{Data description in markdown format} + +\item{path}{Path to a text file with the data description in markdown format} +} +\description{ +Convenience function to add a markdown description to a data.frame +} +\examples{ +if (interactive()) { + mt <- mtcars |> add_description(md = "# MTCARS\n\nThis data.frame contains information on ...") + describe(mt) +} + +} +\seealso{ +See also \code{\link{register}} +} diff --git a/radiant.data/man/arrange_data.Rd b/radiant.data/man/arrange_data.Rd new file mode 100644 index 0000000000000000000000000000000000000000..ccc05ec3fa8305c45137dcb59201e7e9a281f1f6 --- /dev/null +++ b/radiant.data/man/arrange_data.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/view.R +\name{arrange_data} +\alias{arrange_data} +\title{Arrange data with user-specified expression} +\usage{ +arrange_data(dataset, expr = NULL) +} +\arguments{ +\item{dataset}{Data frame to arrange} + +\item{expr}{Expression to use arrange rows from the specified dataset} +} +\value{ +Arranged data frame +} +\description{ +Arrange data with user-specified expression +} +\details{ +Arrange data, likely in combination with slicing +} diff --git a/radiant.data/man/as_character.Rd b/radiant.data/man/as_character.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a85e6189088961cd85b83e9958de3dad0333c393 --- /dev/null +++ b/radiant.data/man/as_character.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{as_character} +\alias{as_character} +\title{Wrapper for as.character} +\usage{ +as_character(x) +} +\arguments{ +\item{x}{Input vector} +} +\description{ +Wrapper for as.character +} diff --git a/radiant.data/man/as_distance.Rd b/radiant.data/man/as_distance.Rd new file mode 100644 index 0000000000000000000000000000000000000000..fd2d3a9770cd6e1bc44776573cd3aa2a4303a6b3 --- /dev/null +++ b/radiant.data/man/as_distance.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{as_distance} +\alias{as_distance} +\title{Distance in kilometers or miles between two locations based on lat-long +Function based on \url{http://www.movable-type.co.uk/scripts/latlong.html}. Uses the haversine formula} +\usage{ +as_distance( + lat1, + long1, + lat2, + long2, + unit = "km", + R = c(km = 6371, miles = 3959)[[unit]] +) +} +\arguments{ +\item{lat1}{Latitude of location 1} + +\item{long1}{Longitude of location 1} + +\item{lat2}{Latitude of location 2} + +\item{long2}{Longitude of location 2} + +\item{unit}{Measure kilometers ("km", default) or miles ("miles")} + +\item{R}{Radius of the earth} +} +\value{ +Distance between two points +} +\description{ +Distance in kilometers or miles between two locations based on lat-long +Function based on \url{http://www.movable-type.co.uk/scripts/latlong.html}. Uses the haversine formula +} +\examples{ +as_distance(32.8245525, -117.0951632, 40.7033127, -73.979681, unit = "km") +as_distance(32.8245525, -117.0951632, 40.7033127, -73.979681, unit = "miles") + +} diff --git a/radiant.data/man/as_dmy.Rd b/radiant.data/man/as_dmy.Rd new file mode 100644 index 0000000000000000000000000000000000000000..545f6519f07ac1eb282134e1e552c9e98d9bdb98 --- /dev/null +++ b/radiant.data/man/as_dmy.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{as_dmy} +\alias{as_dmy} +\title{Convert input in day-month-year format to date} +\usage{ +as_dmy(x) +} +\arguments{ +\item{x}{Input variable} +} +\value{ +Date variable of class Date +} +\description{ +Convert input in day-month-year format to date +} +\examples{ +as_dmy("1-2-2014") + +} diff --git a/radiant.data/man/as_dmy_hm.Rd b/radiant.data/man/as_dmy_hm.Rd new file mode 100644 index 0000000000000000000000000000000000000000..646115fad0dac0dee5e0586e5f4a1e94274d7e5a --- /dev/null +++ b/radiant.data/man/as_dmy_hm.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{as_dmy_hm} +\alias{as_dmy_hm} +\title{Convert input in day-month-year-hour-minute format to date-time} +\usage{ +as_dmy_hm(x) +} +\arguments{ +\item{x}{Input variable} +} +\value{ +Date-time variable of class Date +} +\description{ +Convert input in day-month-year-hour-minute format to date-time +} +\examples{ +as_mdy_hm("1-1-2014 12:15") +} diff --git a/radiant.data/man/as_dmy_hms.Rd b/radiant.data/man/as_dmy_hms.Rd new file mode 100644 index 0000000000000000000000000000000000000000..6bc8e932079011f7bd2f09b6ff419eb5f812f1c6 --- /dev/null +++ b/radiant.data/man/as_dmy_hms.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{as_dmy_hms} +\alias{as_dmy_hms} +\title{Convert input in day-month-year-hour-minute-second format to date-time} +\usage{ +as_dmy_hms(x) +} +\arguments{ +\item{x}{Input variable} +} +\value{ +Date-time variable of class Date +} +\description{ +Convert input in day-month-year-hour-minute-second format to date-time +} +\examples{ +as_mdy_hms("1-1-2014 12:15:01") +} diff --git a/radiant.data/man/as_duration.Rd b/radiant.data/man/as_duration.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a9499a45d6ffc378816efaac43824f1190647f09 --- /dev/null +++ b/radiant.data/man/as_duration.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{as_duration} +\alias{as_duration} +\title{Wrapper for lubridate's as.duration function. Result converted to numeric} +\usage{ +as_duration(x) +} +\arguments{ +\item{x}{Time difference} +} +\description{ +Wrapper for lubridate's as.duration function. Result converted to numeric +} diff --git a/radiant.data/man/as_factor.Rd b/radiant.data/man/as_factor.Rd new file mode 100644 index 0000000000000000000000000000000000000000..636fd640581cce06f4f22e9f0e5e25c6ea242abd --- /dev/null +++ b/radiant.data/man/as_factor.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{as_factor} +\alias{as_factor} +\title{Wrapper for factor with ordered = FALSE} +\usage{ +as_factor(x, ordered = FALSE) +} +\arguments{ +\item{x}{Input vector} + +\item{ordered}{Order factor levels (TRUE, FALSE)} +} +\description{ +Wrapper for factor with ordered = FALSE +} diff --git a/radiant.data/man/as_hm.Rd b/radiant.data/man/as_hm.Rd new file mode 100644 index 0000000000000000000000000000000000000000..fb5e172b2f1c3de04d9f89e2d68394f6ae54725a --- /dev/null +++ b/radiant.data/man/as_hm.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{as_hm} +\alias{as_hm} +\title{Convert input in hour-minute format to time} +\usage{ +as_hm(x) +} +\arguments{ +\item{x}{Input variable} +} +\value{ +Time variable of class Period +} +\description{ +Convert input in hour-minute format to time +} +\examples{ +as_hm("12:45") +\dontrun{ +as_hm("12:45") \%>\% minute() +} +} diff --git a/radiant.data/man/as_hms.Rd b/radiant.data/man/as_hms.Rd new file mode 100644 index 0000000000000000000000000000000000000000..b89337213d6d94384176b73337346b9f0b58ef84 --- /dev/null +++ b/radiant.data/man/as_hms.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{as_hms} +\alias{as_hms} +\title{Convert input in hour-minute-second format to time} +\usage{ +as_hms(x) +} +\arguments{ +\item{x}{Input variable} +} +\value{ +Time variable of class Period +} +\description{ +Convert input in hour-minute-second format to time +} +\examples{ +as_hms("12:45:00") +\dontrun{ +as_hms("12:45:00") \%>\% hour() +as_hms("12:45:00") \%>\% second() +} +} diff --git a/radiant.data/man/as_integer.Rd b/radiant.data/man/as_integer.Rd new file mode 100644 index 0000000000000000000000000000000000000000..06947a61aa6beea5b6cf729e468eb502bcd8f93e --- /dev/null +++ b/radiant.data/man/as_integer.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{as_integer} +\alias{as_integer} +\title{Convert variable to integer avoiding potential issues with factors} +\usage{ +as_integer(x) +} +\arguments{ +\item{x}{Input variable} +} +\value{ +Integer +} +\description{ +Convert variable to integer avoiding potential issues with factors +} +\examples{ +as_integer(rnorm(10)) +as_integer(letters) +as_integer(as.factor(5:10)) +as.integer(as.factor(5:10)) +as_integer(c("a", "b")) +as_integer(c("0", "1")) +as_integer(as.factor(c("0", "1"))) + +} diff --git a/radiant.data/man/as_mdy.Rd b/radiant.data/man/as_mdy.Rd new file mode 100644 index 0000000000000000000000000000000000000000..acec54d798701e91481148ce147c63d18874cdd0 --- /dev/null +++ b/radiant.data/man/as_mdy.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{as_mdy} +\alias{as_mdy} +\title{Convert input in month-day-year format to date} +\usage{ +as_mdy(x) +} +\arguments{ +\item{x}{Input variable} +} +\value{ +Date variable of class Date +} +\description{ +Convert input in month-day-year format to date +} +\details{ +Use as.character if x is a factor +} +\examples{ +as_mdy("2-1-2014") +\dontrun{ +as_mdy("2-1-2014") \%>\% month(label = TRUE) +as_mdy("2-1-2014") \%>\% week() +as_mdy("2-1-2014") \%>\% wday(label = TRUE) +} +} diff --git a/radiant.data/man/as_mdy_hm.Rd b/radiant.data/man/as_mdy_hm.Rd new file mode 100644 index 0000000000000000000000000000000000000000..bdb26712f4ac318c63a40e87a848e66131df30ae --- /dev/null +++ b/radiant.data/man/as_mdy_hm.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{as_mdy_hm} +\alias{as_mdy_hm} +\title{Convert input in month-day-year-hour-minute format to date-time} +\usage{ +as_mdy_hm(x) +} +\arguments{ +\item{x}{Input variable} +} +\value{ +Date-time variable of class Date +} +\description{ +Convert input in month-day-year-hour-minute format to date-time +} +\examples{ +as_mdy_hm("1-1-2014 12:15") +} diff --git a/radiant.data/man/as_mdy_hms.Rd b/radiant.data/man/as_mdy_hms.Rd new file mode 100644 index 0000000000000000000000000000000000000000..0e8996d7627487e26311f7df198026a5120fad2b --- /dev/null +++ b/radiant.data/man/as_mdy_hms.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{as_mdy_hms} +\alias{as_mdy_hms} +\title{Convert input in month-day-year-hour-minute-second format to date-time} +\usage{ +as_mdy_hms(x) +} +\arguments{ +\item{x}{Input variable} +} +\value{ +Date-time variable of class Date +} +\description{ +Convert input in month-day-year-hour-minute-second format to date-time +} +\examples{ +as_mdy_hms("1-1-2014 12:15:01") +} diff --git a/radiant.data/man/as_numeric.Rd b/radiant.data/man/as_numeric.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f68da15793efef92a6e7e4d7e98234c7c76afc10 --- /dev/null +++ b/radiant.data/man/as_numeric.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{as_numeric} +\alias{as_numeric} +\title{Convert variable to numeric avoiding potential issues with factors} +\usage{ +as_numeric(x) +} +\arguments{ +\item{x}{Input variable} +} +\value{ +Numeric +} +\description{ +Convert variable to numeric avoiding potential issues with factors +} +\examples{ +as_numeric(rnorm(10)) +as_numeric(letters) +as_numeric(as.factor(5:10)) +as.numeric(as.factor(5:10)) +as_numeric(c("a", "b")) +as_numeric(c("3", "4")) +as_numeric(as.factor(c("3", "4"))) + +} diff --git a/radiant.data/man/as_ymd.Rd b/radiant.data/man/as_ymd.Rd new file mode 100644 index 0000000000000000000000000000000000000000..c1d9133f8a04a921d9639ea2a574837ad36c83bc --- /dev/null +++ b/radiant.data/man/as_ymd.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{as_ymd} +\alias{as_ymd} +\title{Convert input in year-month-day format to date} +\usage{ +as_ymd(x) +} +\arguments{ +\item{x}{Input variable} +} +\value{ +Date variable of class Date +} +\description{ +Convert input in year-month-day format to date +} +\examples{ +as_ymd("2013-1-1") + +} diff --git a/radiant.data/man/as_ymd_hm.Rd b/radiant.data/man/as_ymd_hm.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a8340663ad368b80cb214160e021f375e4d8fe2a --- /dev/null +++ b/radiant.data/man/as_ymd_hm.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{as_ymd_hm} +\alias{as_ymd_hm} +\title{Convert input in year-month-day-hour-minute format to date-time} +\usage{ +as_ymd_hm(x) +} +\arguments{ +\item{x}{Input variable} +} +\value{ +Date-time variable of class Date +} +\description{ +Convert input in year-month-day-hour-minute format to date-time +} +\examples{ +as_ymd_hm("2014-1-1 12:15") +} diff --git a/radiant.data/man/as_ymd_hms.Rd b/radiant.data/man/as_ymd_hms.Rd new file mode 100644 index 0000000000000000000000000000000000000000..7057f00c74c87d93dcd1375e62bca208944d2884 --- /dev/null +++ b/radiant.data/man/as_ymd_hms.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{as_ymd_hms} +\alias{as_ymd_hms} +\title{Convert input in year-month-day-hour-minute-second format to date-time} +\usage{ +as_ymd_hms(x) +} +\arguments{ +\item{x}{Input variable} +} +\value{ +Date-time variable of class Date +} +\description{ +Convert input in year-month-day-hour-minute-second format to date-time +} +\examples{ +as_ymd_hms("2014-1-1 12:15:01") +\dontrun{ +as_ymd_hms("2014-1-1 12:15:01") \%>\% as.Date() +as_ymd_hms("2014-1-1 12:15:01") \%>\% month() +as_ymd_hms("2014-1-1 12:15:01") \%>\% hour() +} +} diff --git a/radiant.data/man/avengers.Rd b/radiant.data/man/avengers.Rd new file mode 100644 index 0000000000000000000000000000000000000000..1ddb5c8a82aa38c422d317a025ec59e054cdb845 --- /dev/null +++ b/radiant.data/man/avengers.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{avengers} +\alias{avengers} +\title{Avengers} +\format{ +A data frame with 7 rows and 4 variables +} +\usage{ +data(avengers) +} +\description{ +Avengers +} +\details{ +List of avengers. The dataset is used to illustrate data merging / joining. Description provided in attr(avengers,"description") +} +\keyword{datasets} diff --git a/radiant.data/man/center.Rd b/radiant.data/man/center.Rd new file mode 100644 index 0000000000000000000000000000000000000000..7ee18592ed2126216e733d4cc4b3abfa16c23cce --- /dev/null +++ b/radiant.data/man/center.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{center} +\alias{center} +\title{Center} +\usage{ +center(x, na.rm = TRUE) +} +\arguments{ +\item{x}{Input variable} + +\item{na.rm}{If TRUE missing values are removed before calculation} +} +\value{ +If x is a numeric variable return x - mean(x) +} +\description{ +Center +} diff --git a/radiant.data/man/choose_dir.Rd b/radiant.data/man/choose_dir.Rd new file mode 100644 index 0000000000000000000000000000000000000000..daa40a46addbe0286231a06af3fd7490f4c6db28 --- /dev/null +++ b/radiant.data/man/choose_dir.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{choose_dir} +\alias{choose_dir} +\title{Choose a directory interactively} +\usage{ +choose_dir(...) +} +\arguments{ +\item{...}{Arguments passed to utils::choose.dir on Windows} +} +\value{ +Path to the directory selected by the user +} +\description{ +Choose a directory interactively +} +\details{ +Open a file dialog to select a directory. Uses JavaScript on Mac, utils::choose.dir on Windows, and dirname(file.choose()) on Linux +} +\examples{ +\dontrun{ +choose_dir() +} + +} diff --git a/radiant.data/man/choose_files.Rd b/radiant.data/man/choose_files.Rd new file mode 100644 index 0000000000000000000000000000000000000000..c132683f349682f2526f2a4c5182e993ebb22a2b --- /dev/null +++ b/radiant.data/man/choose_files.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{choose_files} +\alias{choose_files} +\title{Choose files interactively} +\usage{ +choose_files(...) +} +\arguments{ +\item{...}{Strings used to indicate which file types should be available for selection (e.g., "csv" or "pdf")} +} +\value{ +Vector of paths to files selected by the user +} +\description{ +Choose files interactively +} +\details{ +Open a file dialog. Uses JavaScript on Mac, utils::choose.files on Windows, and file.choose() on Linux +} +\examples{ +\dontrun{ +choose_files("pdf", "csv") +} + +} diff --git a/radiant.data/man/ci_label.Rd b/radiant.data/man/ci_label.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a889cdaa0c35e57bc17c72f1c730888c30d6aebe --- /dev/null +++ b/radiant.data/man/ci_label.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{ci_label} +\alias{ci_label} +\title{Labels for confidence intervals} +\usage{ +ci_label(alt = "two.sided", cl = 0.95, dec = 3) +} +\arguments{ +\item{alt}{Type of hypothesis ("two.sided","less","greater")} + +\item{cl}{Confidence level} + +\item{dec}{Number of decimals to show} +} +\value{ +A character vector with labels for a confidence interval +} +\description{ +Labels for confidence intervals +} +\examples{ +ci_label("less", .95) +ci_label("two.sided", .95) +ci_label("greater", .9) +} diff --git a/radiant.data/man/ci_perc.Rd b/radiant.data/man/ci_perc.Rd new file mode 100644 index 0000000000000000000000000000000000000000..bc37a642f13427a992e5e3ae2c98db99e00237c7 --- /dev/null +++ b/radiant.data/man/ci_perc.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{ci_perc} +\alias{ci_perc} +\title{Values at confidence levels} +\usage{ +ci_perc(dat, alt = "two.sided", cl = 0.95) +} +\arguments{ +\item{dat}{Data} + +\item{alt}{Type of hypothesis ("two.sided","less","greater")} + +\item{cl}{Confidence level} +} +\value{ +A vector with values at a confidence level +} +\description{ +Values at confidence levels +} +\examples{ +ci_perc(0:100, "less", .95) +ci_perc(0:100, "greater", .95) +ci_perc(0:100, "two.sided", .80) +} diff --git a/radiant.data/man/combine_data.Rd b/radiant.data/man/combine_data.Rd new file mode 100644 index 0000000000000000000000000000000000000000..20206f42d57bb83e553a10111e006b7f61f4c595 --- /dev/null +++ b/radiant.data/man/combine_data.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/combine.R +\name{combine_data} +\alias{combine_data} +\title{Combine datasets using dplyr's bind and join functions} +\usage{ +combine_data( + x, + y, + by = "", + add = "", + type = "inner_join", + data_filter = "", + arr = "", + rows = NULL, + envir = parent.frame(), + ... +) +} +\arguments{ +\item{x}{Dataset} + +\item{y}{Dataset to combine with x} + +\item{by}{Variables used to combine `x` and `y`} + +\item{add}{Variables to add from `y`} + +\item{type}{The main bind and join types from the dplyr package are provided. \bold{inner_join} returns all rows from x with matching values in y, and all columns from x and y. If there are multiple matches between x and y, all match combinations are returned. \bold{left_join} returns all rows from x, and all columns from x and y. If there are multiple matches between x and y, all match combinations are returned. \bold{right_join} is equivalent to a left join for datasets y and x. \bold{full_join} combines two datasets, keeping rows and columns that appear in either. \bold{semi_join} returns all rows from x with matching values in y, keeping just columns from x. A semi join differs from an inner join because an inner join will return one row of x for each matching row of y, whereas a semi join will never duplicate rows of x. \bold{anti_join} returns all rows from x without matching values in y, keeping only columns from x. \bold{bind_rows} and \bold{bind_cols} are also included, as are \bold{intersect}, \bold{union}, and \bold{setdiff}. See \url{https://radiant-rstats.github.io/docs/data/combine.html} for further details} + +\item{data_filter}{Expression used to filter the dataset. This should be a string (e.g., "price > 10000")} + +\item{arr}{Expression to arrange (sort) the data on (e.g., "color, desc(price)")} + +\item{rows}{Rows to select from the specified dataset} + +\item{envir}{Environment to extract data from} + +\item{...}{further arguments passed to or from other methods} +} +\value{ +Combined dataset +} +\description{ +Combine datasets using dplyr's bind and join functions +} +\details{ +See \url{https://radiant-rstats.github.io/docs/data/combine.html} for an example in Radiant +} +\examples{ +avengers \%>\% combine_data(superheroes, type = "bind_cols") +combine_data(avengers, superheroes, type = "bind_cols") +avengers \%>\% combine_data(superheroes, type = "bind_rows") +avengers \%>\% combine_data(superheroes, add = "publisher", type = "bind_rows") + +} diff --git a/radiant.data/man/copy_all.Rd b/radiant.data/man/copy_all.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a146e5940dd4deea7626d401f7ec6b8f3cccc603 --- /dev/null +++ b/radiant.data/man/copy_all.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{copy_all} +\alias{copy_all} +\title{Source all package functions} +\usage{ +copy_all(.from) +} +\arguments{ +\item{.from}{The package to pull the function from} +} +\description{ +Source all package functions +} +\details{ +Equivalent of source with local=TRUE for all package functions. Adapted from functions by smbache, author of the import package. See \url{https://github.com/rticulate/import/issues/4/} for a discussion. This function will be deprecated when (if) it is included in \url{https://github.com/rticulate/import/} +} +\examples{ +copy_all(radiant.data) +} diff --git a/radiant.data/man/copy_attr.Rd b/radiant.data/man/copy_attr.Rd new file mode 100644 index 0000000000000000000000000000000000000000..47ba6f0a30ce5b9da6eb0084a0385bb3d3fd558d --- /dev/null +++ b/radiant.data/man/copy_attr.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{copy_attr} +\alias{copy_attr} +\title{Copy attributes from one object to another} +\usage{ +copy_attr(to, from, attr) +} +\arguments{ +\item{to}{Object to copy attributes to} + +\item{from}{Object to copy attributes from} + +\item{attr}{Vector of attributes. If missing all attributes will be copied} +} +\description{ +Copy attributes from one object to another +} diff --git a/radiant.data/man/copy_from.Rd b/radiant.data/man/copy_from.Rd new file mode 100644 index 0000000000000000000000000000000000000000..516d8dada4f5f1ca8b6966c3edf5a5109a37005e --- /dev/null +++ b/radiant.data/man/copy_from.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{copy_from} +\alias{copy_from} +\title{Source for package functions} +\usage{ +copy_from(.from, ...) +} +\arguments{ +\item{.from}{The package to pull the function from} + +\item{...}{Functions to pull} +} +\description{ +Source for package functions +} +\details{ +Equivalent of source with local=TRUE for package functions. Written by smbache, author of the import package. See \url{https://github.com/rticulate/import/issues/4/} for a discussion. This function will be deprecated when (if) it is included in \url{https://github.com/rticulate/import/} +} +\examples{ +copy_from(radiant.data, get_data) +} diff --git a/radiant.data/man/cv.Rd b/radiant.data/man/cv.Rd new file mode 100644 index 0000000000000000000000000000000000000000..fcbf70c3718f7264f967c65377c58a3fd69dfbeb --- /dev/null +++ b/radiant.data/man/cv.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{cv} +\alias{cv} +\title{Coefficient of variation} +\usage{ +cv(x, na.rm = TRUE) +} +\arguments{ +\item{x}{Input variable} + +\item{na.rm}{If TRUE missing values are removed before calculation} +} +\value{ +Coefficient of variation +} +\description{ +Coefficient of variation +} +\examples{ +cv(runif(100)) + +} diff --git a/radiant.data/man/deregister.Rd b/radiant.data/man/deregister.Rd new file mode 100644 index 0000000000000000000000000000000000000000..3e8bb98185f66052ae6ef8fc8ca482d13b3110b1 --- /dev/null +++ b/radiant.data/man/deregister.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{deregister} +\alias{deregister} +\title{Deregister a data.frame or list in Radiant} +\usage{ +deregister( + dataset, + shiny = shiny::getDefaultReactiveDomain(), + envir = r_data, + info = r_info +) +} +\arguments{ +\item{dataset}{String containing the name of the data.frame to deregister} + +\item{shiny}{Check if function is called from a shiny application} + +\item{envir}{Environment to remove data from} + +\item{info}{Reactive list with information about available data in radiant} +} +\description{ +Deregister a data.frame or list in Radiant +} diff --git a/radiant.data/man/describe.Rd b/radiant.data/man/describe.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f49129af29b7433fa679dc7982ad356c513d0915 --- /dev/null +++ b/radiant.data/man/describe.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{describe} +\alias{describe} +\title{Show dataset description} +\usage{ +describe(dataset, envir = parent.frame()) +} +\arguments{ +\item{dataset}{Dataset with "description" attribute} + +\item{envir}{Environment to extract data from} +} +\description{ +Show dataset description +} +\details{ +Show dataset description, if available, in html form in Rstudio viewer or the default browser. The description should be in markdown format, attached to a data.frame as an attribute with the name "description" +} diff --git a/radiant.data/man/diamonds.Rd b/radiant.data/man/diamonds.Rd new file mode 100644 index 0000000000000000000000000000000000000000..fefefa182989907a4e1535f090fe117d96d76210 --- /dev/null +++ b/radiant.data/man/diamonds.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{diamonds} +\alias{diamonds} +\title{Diamond prices} +\format{ +A data frame with 3000 rows and 10 variables +} +\usage{ +data(diamonds) +} +\description{ +Diamond prices +} +\details{ +A sample of 3,000 from the diamonds dataset bundled with ggplot2. Description provided in attr(diamonds,"description") +} +\keyword{datasets} diff --git a/radiant.data/man/does_vary.Rd b/radiant.data/man/does_vary.Rd new file mode 100644 index 0000000000000000000000000000000000000000..3c893b7bfa079302b44ded82e93585e1559385a4 --- /dev/null +++ b/radiant.data/man/does_vary.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{does_vary} +\alias{does_vary} +\title{Does a vector have non-zero variability?} +\usage{ +does_vary(x, na.rm = TRUE) +} +\arguments{ +\item{x}{Input variable} + +\item{na.rm}{If TRUE missing values are removed before calculation} +} +\value{ +Logical. TRUE is there is variability +} +\description{ +Does a vector have non-zero variability? +} +\examples{ +summarise_all(diamonds, does_vary) \%>\% as.logical() + +} diff --git a/radiant.data/man/dtab.Rd b/radiant.data/man/dtab.Rd new file mode 100644 index 0000000000000000000000000000000000000000..87908f333e303ba1cfc6a063fe55003929e341b9 --- /dev/null +++ b/radiant.data/man/dtab.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/view.R +\name{dtab} +\alias{dtab} +\title{Method to create datatables} +\usage{ +dtab(object, ...) +} +\arguments{ +\item{object}{Object of relevant class to render} + +\item{...}{Additional arguments} +} +\description{ +Method to create datatables +} +\seealso{ +See \code{\link{dtab.data.frame}} to create an interactive table from a data.frame + +See \code{\link{dtab.explore}} to create an interactive table from an \code{\link{explore}} object + +See \code{\link{dtab.pivotr}} to create an interactive table from a \code{\link{pivotr}} object +} diff --git a/radiant.data/man/dtab.data.frame.Rd b/radiant.data/man/dtab.data.frame.Rd new file mode 100644 index 0000000000000000000000000000000000000000..64afce50947d85e9254cc93d71a62f0d05fe0f82 --- /dev/null +++ b/radiant.data/man/dtab.data.frame.Rd @@ -0,0 +1,73 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/view.R +\name{dtab.data.frame} +\alias{dtab.data.frame} +\title{Create an interactive table to view, search, sort, and filter data} +\usage{ +\method{dtab}{data.frame}( + object, + vars = "", + filt = "", + arr = "", + rows = NULL, + nr = NULL, + na.rm = FALSE, + dec = 3, + perc = "", + filter = "top", + pageLength = 10, + dom = "", + style = "bootstrap4", + rownames = FALSE, + caption = NULL, + envir = parent.frame(), + ... +) +} +\arguments{ +\item{object}{Data.frame to display} + +\item{vars}{Variables to show (default is all)} + +\item{filt}{Filter to apply to the specified dataset. For example "price > 10000" if dataset is "diamonds" (default is "")} + +\item{arr}{Expression to arrange (sort) the data on (e.g., "color, desc(price)")} + +\item{rows}{Select rows in the specified dataset. For example "1:10" for the first 10 rows or "n()-10:n()" for the last 10 rows (default is NULL)} + +\item{nr}{Number of rows of data to include in the table. This function will be mainly used in reports so it is best to keep this number small} + +\item{na.rm}{Remove rows with missing values (default is FALSE)} + +\item{dec}{Number of decimal places to show. Default is no rounding (NULL)} + +\item{perc}{Vector of column names to be displayed as a percentage} + +\item{filter}{Show column filters in DT table. Options are "none", "top", "bottom"} + +\item{pageLength}{Number of rows to show in table} + +\item{dom}{Table control elements to show on the page. See \url{https://datatables.net/reference/option/dom}} + +\item{style}{Table formatting style ("bootstrap" or "default")} + +\item{rownames}{Show data.frame rownames. Default is FALSE} + +\item{caption}{Table caption} + +\item{envir}{Environment to extract data from} + +\item{...}{Additional arguments} +} +\description{ +Create an interactive table to view, search, sort, and filter data +} +\details{ +View, search, sort, and filter a data.frame. For styling options see \url{https://rstudio.github.io/DT/functions.html} +} +\examples{ +\dontrun{ +dtab(mtcars) +} + +} diff --git a/radiant.data/man/dtab.explore.Rd b/radiant.data/man/dtab.explore.Rd new file mode 100644 index 0000000000000000000000000000000000000000..89ed5057d71ed69a84f60027120c4d32bdd7a4ad --- /dev/null +++ b/radiant.data/man/dtab.explore.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{dtab.explore} +\alias{dtab.explore} +\title{Make an interactive table of summary statistics} +\usage{ +\method{dtab}{explore}( + object, + dec = 3, + searchCols = NULL, + order = NULL, + pageLength = NULL, + caption = NULL, + ... +) +} +\arguments{ +\item{object}{Return value from \code{\link{explore}}} + +\item{dec}{Number of decimals to show} + +\item{searchCols}{Column search and filter} + +\item{order}{Column sorting} + +\item{pageLength}{Page length} + +\item{caption}{Table caption} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Make an interactive table of summary statistics +} +\details{ +See \url{https://radiant-rstats.github.io/docs/data/explore.html} for an example in Radiant +} +\examples{ +\dontrun{ +tab <- explore(diamonds, "price:x") \%>\% dtab() +tab <- explore(diamonds, "price", byvar = "cut", fun = c("n_obs", "skew"), top = "byvar") \%>\% + dtab() +} + +} +\seealso{ +\code{\link{pivotr}} to create a pivot table + +\code{\link{summary.pivotr}} to show summaries +} diff --git a/radiant.data/man/dtab.pivotr.Rd b/radiant.data/man/dtab.pivotr.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f364f0e3393e7357b4a2f5d505b65d4c892c34ac --- /dev/null +++ b/radiant.data/man/dtab.pivotr.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pivotr.R +\name{dtab.pivotr} +\alias{dtab.pivotr} +\title{Make an interactive pivot table} +\usage{ +\method{dtab}{pivotr}( + object, + format = "none", + perc = FALSE, + dec = 3, + searchCols = NULL, + order = NULL, + pageLength = NULL, + caption = NULL, + ... +) +} +\arguments{ +\item{object}{Return value from \code{\link{pivotr}}} + +\item{format}{Show Color bar ("color_bar"), Heat map ("heat"), or None ("none")} + +\item{perc}{Display numbers as percentages (TRUE or FALSE)} + +\item{dec}{Number of decimals to show} + +\item{searchCols}{Column search and filter} + +\item{order}{Column sorting} + +\item{pageLength}{Page length} + +\item{caption}{Table caption} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Make an interactive pivot table +} +\details{ +See \url{https://radiant-rstats.github.io/docs/data/pivotr.html} for an example in Radiant +} +\examples{ +\dontrun{ +pivotr(diamonds, cvars = "cut") \%>\% dtab() +pivotr(diamonds, cvars = c("cut", "clarity")) \%>\% dtab(format = "color_bar") +pivotr(diamonds, cvars = c("cut", "clarity"), normalize = "total") \%>\% + dtab(format = "color_bar", perc = TRUE) +} + +} +\seealso{ +\code{\link{pivotr}} to create the pivot table + +\code{\link{summary.pivotr}} to print the table +} diff --git a/radiant.data/man/empty_level.Rd b/radiant.data/man/empty_level.Rd new file mode 100644 index 0000000000000000000000000000000000000000..ebbc1e60967d7af5b77dc71a6c514c550909017a --- /dev/null +++ b/radiant.data/man/empty_level.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{empty_level} +\alias{empty_level} +\title{Convert categorical variables to factors and deal with empty/missing values} +\usage{ +empty_level(x) +} +\arguments{ +\item{x}{Categorical variable used in table} +} +\value{ +Variable with updated levels +} +\description{ +Convert categorical variables to factors and deal with empty/missing values +} diff --git a/radiant.data/man/explore.Rd b/radiant.data/man/explore.Rd new file mode 100644 index 0000000000000000000000000000000000000000..0677fb209f23685890b980d7f49b59511b036054 --- /dev/null +++ b/radiant.data/man/explore.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{explore} +\alias{explore} +\title{Explore and summarize data} +\usage{ +explore( + dataset, + vars = "", + byvar = "", + fun = c("mean", "sd"), + top = "fun", + tabfilt = "", + tabsort = "", + tabslice = "", + nr = Inf, + data_filter = "", + arr = "", + rows = NULL, + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset to explore} + +\item{vars}{(Numeric) variables to summarize} + +\item{byvar}{Variable(s) to group data by} + +\item{fun}{Functions to use for summarizing} + +\item{top}{Use functions ("fun"), variables ("vars"), or group-by variables as column headers} + +\item{tabfilt}{Expression used to filter the table (e.g., "Total > 10000")} + +\item{tabsort}{Expression used to sort the table (e.g., "desc(Total)")} + +\item{tabslice}{Expression used to filter table (e.g., "1:5")} + +\item{nr}{Number of rows to display} + +\item{data_filter}{Expression used to filter the dataset before creating the table (e.g., "price > 10000")} + +\item{arr}{Expression to arrange (sort) the data on (e.g., "color, desc(price)")} + +\item{rows}{Rows to select from the specified dataset} + +\item{envir}{Environment to extract data from} +} +\value{ +A list of all variables defined in the function as an object of class explore +} +\description{ +Explore and summarize data +} +\details{ +See \url{https://radiant-rstats.github.io/docs/data/explore.html} for an example in Radiant +} +\examples{ +explore(diamonds, c("price", "carat")) \%>\% str() +explore(diamonds, "price:x")$tab +explore(diamonds, c("price", "carat"), byvar = "cut", fun = c("n_missing", "skew"))$tab + +} +\seealso{ +See \code{\link{summary.explore}} to show summaries +} diff --git a/radiant.data/man/filter_data.Rd b/radiant.data/man/filter_data.Rd new file mode 100644 index 0000000000000000000000000000000000000000..c259b12e8fc8c928b407840dfc2e850c0e748cc7 --- /dev/null +++ b/radiant.data/man/filter_data.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/view.R +\name{filter_data} +\alias{filter_data} +\title{Filter data with user-specified expression} +\usage{ +filter_data(dataset, filt = "", drop = TRUE) +} +\arguments{ +\item{dataset}{Data frame to filter} + +\item{filt}{Filter expression to apply to the specified dataset} + +\item{drop}{Drop unused factor levels after filtering (default is TRUE)} +} +\value{ +Filtered data frame +} +\description{ +Filter data with user-specified expression +} +\details{ +Filters can be used to view a sample from a selected dataset. For example, runif(nrow(.)) > .9 could be used to sample approximately 10% of the rows in the data and 1:nrow(.) < 101 would select only the first 100 rows in the data. Note: "." references the currently selected dataset. +} +\examples{ +select(diamonds, 1:3) \%>\% filter_data(filt = "price > max(.$price) - 100") +select(diamonds, 1:3) \%>\% filter_data(filt = "runif(nrow(.)) > .995") +} diff --git a/radiant.data/man/find_dropbox.Rd b/radiant.data/man/find_dropbox.Rd new file mode 100644 index 0000000000000000000000000000000000000000..b4f89cce3795d51ff9cd8f9a9d3786d678f59a6d --- /dev/null +++ b/radiant.data/man/find_dropbox.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{find_dropbox} +\alias{find_dropbox} +\title{Find Dropbox folder} +\usage{ +find_dropbox(account = 1) +} +\arguments{ +\item{account}{Integer. If multiple accounts exist, specify which one to use. By default, the first account listed is used} +} +\value{ +Path to Dropbox account +} +\description{ +Find Dropbox folder +} +\details{ +Find the path for Dropbox if available +} diff --git a/radiant.data/man/find_gdrive.Rd b/radiant.data/man/find_gdrive.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f5bce0042b9e1f72d5d12e462ce872a7671046c3 --- /dev/null +++ b/radiant.data/man/find_gdrive.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{find_gdrive} +\alias{find_gdrive} +\title{Find Google Drive folder} +\usage{ +find_gdrive() +} +\value{ +Path to Google Drive folder +} +\description{ +Find Google Drive folder +} +\details{ +Find the path for Google Drive if available +} diff --git a/radiant.data/man/find_home.Rd b/radiant.data/man/find_home.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a7692e91a7e82a71566da24cf8894ab0ccba31fe --- /dev/null +++ b/radiant.data/man/find_home.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{find_home} +\alias{find_home} +\title{Find user directory} +\usage{ +find_home() +} +\description{ +Find user directory +} +\details{ +Returns /Users/x and not /Users/x/Documents +} diff --git a/radiant.data/man/find_project.Rd b/radiant.data/man/find_project.Rd new file mode 100644 index 0000000000000000000000000000000000000000..3ce586cfefb2e95b313073054406ef0cb3e39e6a --- /dev/null +++ b/radiant.data/man/find_project.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{find_project} +\alias{find_project} +\title{Find the Rstudio project folder} +\usage{ +find_project(mess = TRUE) +} +\arguments{ +\item{mess}{Show or hide messages (default mess = TRUE)} +} +\value{ +Path to Rstudio project folder if available or else and empty string. The returned path is normalized +} +\description{ +Find the Rstudio project folder +} +\details{ +Find the path for the Rstudio project folder if available. The returned path is normalized (see \code{\link{normalizePath}}) +} diff --git a/radiant.data/man/fix_names.Rd b/radiant.data/man/fix_names.Rd new file mode 100644 index 0000000000000000000000000000000000000000..8f6bea02875e21e6aa825f33f2f0543fd1fa8694 --- /dev/null +++ b/radiant.data/man/fix_names.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/manage.R +\name{fix_names} +\alias{fix_names} +\title{Ensure column names are valid} +\usage{ +fix_names(x, lower = FALSE) +} +\arguments{ +\item{x}{Data.frame or vector of (column) names} + +\item{lower}{Set letters to lower case (TRUE or FALSE)} +} +\description{ +Ensure column names are valid +} +\details{ +Remove symbols, trailing and leading spaces, and convert to valid R column names. Opinionated version of \code{\link{make.names}} +} +\examples{ +fix_names(c(" var-name ", "$amount spent", "100")) +} diff --git a/radiant.data/man/fix_smart.Rd b/radiant.data/man/fix_smart.Rd new file mode 100644 index 0000000000000000000000000000000000000000..14d150d56ac13c535ad0170f3c98492715b0db85 --- /dev/null +++ b/radiant.data/man/fix_smart.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{fix_smart} +\alias{fix_smart} +\title{Replace smart quotes etc.} +\usage{ +fix_smart(text, all = FALSE) +} +\arguments{ +\item{text}{Text to be parsed} + +\item{all}{Should all non-ascii characters be removed? Default is FALSE} +} +\description{ +Replace smart quotes etc. +} diff --git a/radiant.data/man/flip.Rd b/radiant.data/man/flip.Rd new file mode 100644 index 0000000000000000000000000000000000000000..de6281d21e25b4ea069e7550e9901ba32d4178c7 --- /dev/null +++ b/radiant.data/man/flip.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{flip} +\alias{flip} +\title{Flip the DT table to put Function, Variable, or Group by on top} +\usage{ +flip(expl, top = "fun") +} +\arguments{ +\item{expl}{Return value from \code{\link{explore}}} + +\item{top}{The variable (type) to display at the top of the table ("fun" for Function, "var" for Variable, and "byvar" for Group by. "fun" is the default} +} +\description{ +Flip the DT table to put Function, Variable, or Group by on top +} +\details{ +See \url{https://radiant-rstats.github.io/docs/data/explore.html} for an example in Radiant +} +\examples{ +explore(diamonds, "price:x", top = "var") \%>\% summary() +explore(diamonds, "price", byvar = "cut", fun = c("n_obs", "skew"), top = "byvar") \%>\% summary() + +} +\seealso{ +\code{\link{explore}} to calculate summaries + +\code{\link{summary.explore}} to show summaries + +\code{\link{dtab.explore}} to create the DT table +} diff --git a/radiant.data/man/format_df.Rd b/radiant.data/man/format_df.Rd new file mode 100644 index 0000000000000000000000000000000000000000..e697160e5ea954e3d96173e96ff71ff608c64db9 --- /dev/null +++ b/radiant.data/man/format_df.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{format_df} +\alias{format_df} +\title{Format a data.frame with a specified number of decimal places} +\usage{ +format_df(tbl, dec = NULL, perc = FALSE, mark = "", na.rm = FALSE, ...) +} +\arguments{ +\item{tbl}{Data.frame} + +\item{dec}{Number of decimals to show} + +\item{perc}{Display numbers as percentages (TRUE or FALSE)} + +\item{mark}{Thousand separator} + +\item{na.rm}{Remove missing values} + +\item{...}{Additional arguments for format_nr} +} +\value{ +Data.frame for printing +} +\description{ +Format a data.frame with a specified number of decimal places +} +\examples{ +data.frame(x = c("a", "b"), y = c(1L, 2L), z = c(-0.0005, 3)) \%>\% + format_df(dec = 4) +data.frame(x = c(1L, 2L), y = c(0.06, 0.8)) \%>\% + format_df(dec = 2, perc = TRUE) +data.frame(x = c(1L, 2L, NA), y = c(NA, 1.008, 2.8)) \%>\% + format_df(dec = 2) +} diff --git a/radiant.data/man/format_nr.Rd b/radiant.data/man/format_nr.Rd new file mode 100644 index 0000000000000000000000000000000000000000..2638a328dd5f303da727e6978ac1b534edce6260 --- /dev/null +++ b/radiant.data/man/format_nr.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{format_nr} +\alias{format_nr} +\title{Format a number with a specified number of decimal places, thousand sep, and a symbol} +\usage{ +format_nr(x, sym = "", dec = 2, perc = FALSE, mark = ",", na.rm = TRUE, ...) +} +\arguments{ +\item{x}{Number or vector} + +\item{sym}{Symbol to use} + +\item{dec}{Number of decimals to show} + +\item{perc}{Display number as a percentage} + +\item{mark}{Thousand separator} + +\item{na.rm}{Remove missing values} + +\item{...}{Additional arguments passed to \code{\link{formatC}}} +} +\value{ +Character (vector) in the desired format +} +\description{ +Format a number with a specified number of decimal places, thousand sep, and a symbol +} +\examples{ +format_nr(2000, "$") +format_nr(2000, dec = 4) +format_nr(.05, perc = TRUE) +format_nr(c(.1, .99), perc = TRUE) +format_nr(data.frame(a = c(.1, .99)), perc = TRUE) +format_nr(data.frame(a = 1:10), sym = "$", dec = 0) +format_nr(c(1, 1.9, 1.008, 1.00)) +format_nr(c(1, 1.9, 1.008, 1.00), drop0trailing = TRUE) +format_nr(NA) +format_nr(NULL) +} diff --git a/radiant.data/man/get_class.Rd b/radiant.data/man/get_class.Rd new file mode 100644 index 0000000000000000000000000000000000000000..6ed7c7f388eeb935ef62f07babdd5436a3b82ea2 --- /dev/null +++ b/radiant.data/man/get_class.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{get_class} +\alias{get_class} +\title{Get variable class} +\usage{ +get_class(dat) +} +\arguments{ +\item{dat}{Dataset to evaluate} +} +\value{ +Vector with class information for each variable +} +\description{ +Get variable class +} +\details{ +Get variable class information for each column in a data.frame +} +\examples{ +get_class(mtcars) +} diff --git a/radiant.data/man/get_data.Rd b/radiant.data/man/get_data.Rd new file mode 100644 index 0000000000000000000000000000000000000000..c34cccf2d583f617c2e21530a6051ad3745a8881 --- /dev/null +++ b/radiant.data/man/get_data.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{get_data} +\alias{get_data} +\title{Select variables and filter data} +\usage{ +get_data( + dataset, + vars = "", + filt = "", + arr = "", + rows = NULL, + data_view_rows = NULL, + na.rm = TRUE, + rev = FALSE, + envir = c() +) +} +\arguments{ +\item{dataset}{Dataset or name of the data.frame} + +\item{vars}{Variables to extract from the data.frame} + +\item{filt}{Filter to apply to the specified dataset} + +\item{arr}{Expression to use to arrange (sort) the specified dataset} + +\item{rows}{Select rows in the specified dataset} + +\item{data_view_rows}{Vector of rows to select. Only used by Data > View in Radiant. Users should use "rows" instead} + +\item{na.rm}{Remove rows with missing values (default is TRUE)} + +\item{rev}{Reverse filter and row selection (i.e., get the remainder)} + +\item{envir}{Environment to extract data from} +} +\value{ +Data.frame with specified columns and rows +} +\description{ +Select variables and filter data +} +\details{ +Function is used in radiant to select variables and filter data based on user input in string form +} +\examples{ +get_data(mtcars, vars = "cyl:vs", filt = "mpg > 25") +get_data(mtcars, vars = c("mpg", "cyl"), rows = 1:10) +get_data(mtcars, vars = c("mpg", "cyl"), arr = "desc(mpg)", rows = "1:5") +} diff --git a/radiant.data/man/get_summary.Rd b/radiant.data/man/get_summary.Rd new file mode 100644 index 0000000000000000000000000000000000000000..683149e6cac98e6a19eb144c5d8738000bc69a78 --- /dev/null +++ b/radiant.data/man/get_summary.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{get_summary} +\alias{get_summary} +\title{Create data.frame summary} +\usage{ +get_summary(dataset, dc = get_class(dataset), dec = 3) +} +\arguments{ +\item{dataset}{Data.frame} + +\item{dc}{Class for each variable} + +\item{dec}{Number of decimals to show} +} +\description{ +Create data.frame summary +} +\details{ +Used in Radiant's Data > Transform tab +} diff --git a/radiant.data/man/ggplotly.Rd b/radiant.data/man/ggplotly.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f65f34ffb971f9e4bfa6f7dcdc01648da2867819 --- /dev/null +++ b/radiant.data/man/ggplotly.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{ggplotly} +\alias{ggplotly} +\title{Work around to avoid (harmless) messages from ggplotly} +\usage{ +ggplotly(...) +} +\arguments{ +\item{...}{Arguments to pass to the \code{\link[plotly]{ggplotly}} function in the plotly package} +} +\description{ +Work around to avoid (harmless) messages from ggplotly +} +\seealso{ +See the \code{\link[plotly]{ggplotly}} function in the plotly package for details (?plotly::ggplotly) +} diff --git a/radiant.data/man/indexr.Rd b/radiant.data/man/indexr.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d1b7e59086c43759c2aec1f90cf870e66671767d --- /dev/null +++ b/radiant.data/man/indexr.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{indexr} +\alias{indexr} +\title{Find index corrected for missing values and filters} +\usage{ +indexr(dataset, vars = "", filt = "", arr = "", rows = NULL, cmd = "") +} +\arguments{ +\item{dataset}{Dataset} + +\item{vars}{Variables to select} + +\item{filt}{Data filter} + +\item{arr}{Expression to arrange (sort) the data on (e.g., "color, desc(price)")} + +\item{rows}{Selected rows} + +\item{cmd}{A command used to customize the data} +} +\description{ +Find index corrected for missing values and filters +} diff --git a/radiant.data/man/install_webshot.Rd b/radiant.data/man/install_webshot.Rd new file mode 100644 index 0000000000000000000000000000000000000000..fe4a2b36eba4022c56e2d283e55a014ace4723b1 --- /dev/null +++ b/radiant.data/man/install_webshot.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{install_webshot} +\alias{install_webshot} +\title{Install webshot and phantomjs} +\usage{ +install_webshot() +} +\description{ +Install webshot and phantomjs +} diff --git a/radiant.data/man/inverse.Rd b/radiant.data/man/inverse.Rd new file mode 100644 index 0000000000000000000000000000000000000000..61eb892aee463fd24b222a7f4a763785efb81b17 --- /dev/null +++ b/radiant.data/man/inverse.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{inverse} +\alias{inverse} +\title{Calculate inverse of a variable} +\usage{ +inverse(x) +} +\arguments{ +\item{x}{Input variable} +} +\value{ +1/x +} +\description{ +Calculate inverse of a variable +} diff --git a/radiant.data/man/is.empty.Rd b/radiant.data/man/is.empty.Rd new file mode 100644 index 0000000000000000000000000000000000000000..cbc4972407891a407c618ca7634b441255b8823a --- /dev/null +++ b/radiant.data/man/is.empty.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{is.empty} +\alias{is.empty} +\title{Is a variable empty} +\usage{ +is.empty(x, empty = "\\\\s*") +} +\arguments{ +\item{x}{Character value to evaluate} + +\item{empty}{Indicate what 'empty' means. Default is empty string (i.e., "")} +} +\value{ +TRUE if empty, else FALSE +} +\description{ +Is a variable empty +} +\details{ +Is a variable empty +} +\examples{ +is.empty("") +is.empty(NULL) +is.empty(NA) +is.empty(c()) +is.empty("none", empty = "none") +is.empty("") +is.empty(" ") +is.empty(" something ") +is.empty(c("", "something")) +is.empty(c(NA, 1:100)) +is.empty(mtcars) +} diff --git a/radiant.data/man/is_double.Rd b/radiant.data/man/is_double.Rd new file mode 100644 index 0000000000000000000000000000000000000000..af32d17a11b23cba8416c3c9983912b2151829d9 --- /dev/null +++ b/radiant.data/man/is_double.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{is_double} +\alias{is_double} +\title{Is input a double (and not a date type)?} +\usage{ +is_double(x) +} +\arguments{ +\item{x}{Input} +} +\value{ +TRUE if double and not a type of date, else FALSE +} +\description{ +Is input a double (and not a date type)? +} diff --git a/radiant.data/man/is_not.Rd b/radiant.data/man/is_not.Rd new file mode 100644 index 0000000000000000000000000000000000000000..1ac1528cfb91abb33d907de85356c8d73a18162d --- /dev/null +++ b/radiant.data/man/is_not.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{is_not} +\alias{is_not} +\title{Convenience function for is.null or is.na} +\usage{ +is_not(x) +} +\arguments{ +\item{x}{Input} +} +\description{ +Convenience function for is.null or is.na +} +\examples{ +is_not(NA) +is_not(NULL) +is_not(c()) +is_not(list()) +is_not(data.frame()) +} diff --git a/radiant.data/man/is_string.Rd b/radiant.data/man/is_string.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d5e4868e1a2df5450f000b56b99f7fe29cc9a30f --- /dev/null +++ b/radiant.data/man/is_string.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{is_string} +\alias{is_string} +\title{Is input a string?} +\usage{ +is_string(x) +} +\arguments{ +\item{x}{Input} +} +\value{ +TRUE if string, else FALSE +} +\description{ +Is input a string? +} +\examples{ +is_string(" ") +is_string("data") +is_string(c("data", "")) +is_string(NULL) +is_string(NA) +} diff --git a/radiant.data/man/iterms.Rd b/radiant.data/man/iterms.Rd new file mode 100644 index 0000000000000000000000000000000000000000..4d2687e3e3179b1e13c8eb858fa7d9a07daa0d1a --- /dev/null +++ b/radiant.data/man/iterms.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{iterms} +\alias{iterms} +\title{Create a vector of interaction terms for linear and logistic regression} +\usage{ +iterms(vars, nway = 2, sep = ":") +} +\arguments{ +\item{vars}{Labels to use} + +\item{nway}{2-way (2) or 3-way (3) interaction labels to create} + +\item{sep}{Separator to use between variable names (e.g., :)} +} +\value{ +Character vector of interaction term labels +} +\description{ +Create a vector of interaction terms for linear and logistic regression +} +\examples{ +paste0("var", 1:3) \%>\% iterms(2) +paste0("var", 1:3) \%>\% iterms(3) +paste0("var", 1:3) \%>\% iterms(2, sep = ".") +} diff --git a/radiant.data/man/launch.Rd b/radiant.data/man/launch.Rd new file mode 100644 index 0000000000000000000000000000000000000000..2fa1d28b23fdb93fc2c4b59097dfe6d0b9cc2628 --- /dev/null +++ b/radiant.data/man/launch.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{launch} +\alias{launch} +\title{Launch radiant apps} +\usage{ +launch(package = "radiant.data", run = "viewer", state, ...) +} +\arguments{ +\item{package}{Radiant package to start. One of "radiant.data", "radiant.design", "radiant.basics", "radiant.model", "radiant.multivariate", or "radiant"} + +\item{run}{Run a radiant app in an external browser ("browser"), an Rstudio window ("window"), or in the Rstudio viewer ("viewer")} + +\item{state}{Path to statefile to load} + +\item{...}{additional arguments to pass to shiny::runApp (e.g, port = 8080)} +} +\description{ +Launch radiant apps +} +\details{ +See \url{https://radiant-rstats.github.io/docs/} for radiant documentation and tutorials +} +\examples{ +\dontrun{ +launch() +launch(run = "viewer") +launch(run = "window") +launch(run = "browser") +} + +} diff --git a/radiant.data/man/level_list.Rd b/radiant.data/man/level_list.Rd new file mode 100644 index 0000000000000000000000000000000000000000..5b55e187aff87b1cfc868ee18231f7b8b96002c5 --- /dev/null +++ b/radiant.data/man/level_list.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{level_list} +\alias{level_list} +\title{Generate list of levels and unique values} +\usage{ +level_list(dataset, ...) +} +\arguments{ +\item{dataset}{A data.frame} + +\item{...}{Unquoted variable names to evaluate} +} +\description{ +Generate list of levels and unique values +} +\examples{ +data.frame(a = c(rep("a", 5), rep("b", 5)), b = c(rep(1, 5), 6:10)) \%>\% level_list() +level_list(mtcars, mpg, cyl) + +} diff --git a/radiant.data/man/ln.Rd b/radiant.data/man/ln.Rd new file mode 100644 index 0000000000000000000000000000000000000000..1e305ee8b6111613dd798f7a31886a59686f6627 --- /dev/null +++ b/radiant.data/man/ln.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{ln} +\alias{ln} +\title{Natural log} +\usage{ +ln(x, na.rm = TRUE) +} +\arguments{ +\item{x}{Input variable} + +\item{na.rm}{Remove missing values (default is TRUE)} +} +\value{ +Natural log of vector +} +\description{ +Natural log +} +\examples{ +ln(runif(10, 1, 2)) + +} diff --git a/radiant.data/man/load_clip.Rd b/radiant.data/man/load_clip.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f29ff00353e4494114e9772000ce340b4e57bec3 --- /dev/null +++ b/radiant.data/man/load_clip.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/manage.R +\name{load_clip} +\alias{load_clip} +\title{Load data through clipboard on Windows or macOS} +\usage{ +load_clip(delim = "\\t", text, suppress = TRUE) +} +\arguments{ +\item{delim}{Delimiter to use (tab is the default)} + +\item{text}{Text input to convert to table} + +\item{suppress}{Suppress warnings} +} +\description{ +Load data through clipboard on Windows or macOS +} +\details{ +Extract data from the clipboard into a data.frame on Windows or macOS +} +\seealso{ +See the \code{\link{save_clip}} +} diff --git a/radiant.data/man/make_arrange_cmd.Rd b/radiant.data/man/make_arrange_cmd.Rd new file mode 100644 index 0000000000000000000000000000000000000000..0f65636d6d20d4d87ca5cc920ae8f7b0cc396ec0 --- /dev/null +++ b/radiant.data/man/make_arrange_cmd.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/view.R +\name{make_arrange_cmd} +\alias{make_arrange_cmd} +\title{Generate arrange commands from user input} +\usage{ +make_arrange_cmd(expr, dataset = "") +} +\arguments{ +\item{expr}{Expression to use arrange rows from the specified dataset} + +\item{dataset}{String with dataset name} +} +\value{ +Arrange command +} +\description{ +Generate arrange commands from user input +} +\details{ +Form arrange command from user input +} diff --git a/radiant.data/man/make_train.Rd b/radiant.data/man/make_train.Rd new file mode 100644 index 0000000000000000000000000000000000000000..890b9f97dae51d7206581e1a90be1f4ecedf3450 --- /dev/null +++ b/radiant.data/man/make_train.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{make_train} +\alias{make_train} +\title{Generate a variable used to selected a training sample} +\usage{ +make_train(n = 0.7, nr = NULL, blocks = NULL, seed = 1234) +} +\arguments{ +\item{n}{Number (or fraction) of observations to label as training} + +\item{nr}{Number of rows in the dataset} + +\item{blocks}{A vector to use for blocking or a data.frame from which to construct a blocking vector} + +\item{seed}{Random seed} +} +\value{ +0/1 variables for filtering +} +\description{ +Generate a variable used to selected a training sample +} +\examples{ +make_train(.5, 10) +make_train(.5, 10) \%>\% table() +make_train(100, 1000) \%>\% table() +make_train(.15, blocks = mtcars$vs) \%>\% table() / nrow(mtcars) +make_train(.10, blocks = iris$Species) \%>\% table() / nrow(iris) +make_train(.5, blocks = iris[, c("Petal.Width", "Species")]) \%>\% table() + +} diff --git a/radiant.data/man/make_vec.Rd b/radiant.data/man/make_vec.Rd new file mode 100644 index 0000000000000000000000000000000000000000..2f5d05ef97d68cc3cd1f351bc9796f5a7a9e03e6 --- /dev/null +++ b/radiant.data/man/make_vec.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{make_vec} +\alias{make_vec} +\title{Convert a string of numbers into a vector} +\usage{ +make_vec(x) +} +\arguments{ +\item{x}{A string of numbers that may include fractions} +} +\description{ +Convert a string of numbers into a vector +} +\examples{ +make_vec("1 2 4") +make_vec("1/2 2/3 4/5") +make_vec(0.1) +} diff --git a/radiant.data/man/me.Rd b/radiant.data/man/me.Rd new file mode 100644 index 0000000000000000000000000000000000000000..1af5df40621e7066ffb086ba20b7965ad52a753e --- /dev/null +++ b/radiant.data/man/me.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{me} +\alias{me} +\title{Margin of error} +\usage{ +me(x, conf_lev = 0.95, na.rm = TRUE) +} +\arguments{ +\item{x}{Input variable} + +\item{conf_lev}{Confidence level. The default is 0.95} + +\item{na.rm}{If TRUE missing values are removed before calculation} +} +\value{ +Margin of error +} +\description{ +Margin of error +} +\examples{ +me(rnorm(100)) + +} diff --git a/radiant.data/man/meprop.Rd b/radiant.data/man/meprop.Rd new file mode 100644 index 0000000000000000000000000000000000000000..8622689a2e0ed6c46ba37a0f831f30ad064dd83c --- /dev/null +++ b/radiant.data/man/meprop.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{meprop} +\alias{meprop} +\title{Margin of error for proportion} +\usage{ +meprop(x, conf_lev = 0.95, na.rm = TRUE) +} +\arguments{ +\item{x}{Input variable} + +\item{conf_lev}{Confidence level. The default is 0.95} + +\item{na.rm}{If TRUE missing values are removed before calculation} +} +\value{ +Margin of error +} +\description{ +Margin of error for proportion +} +\examples{ +meprop(c(rep(1L, 10), rep(0L, 10))) + +} diff --git a/radiant.data/man/modal.Rd b/radiant.data/man/modal.Rd new file mode 100644 index 0000000000000000000000000000000000000000..e771c255facef65bfff1842e6f5c466747335017 --- /dev/null +++ b/radiant.data/man/modal.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{modal} +\alias{modal} +\title{Calculate the mode (modal value) and return a label} +\usage{ +modal(x, na.rm = TRUE) +} +\arguments{ +\item{x}{A vector} + +\item{na.rm}{If TRUE missing values are removed before calculation} +} +\description{ +Calculate the mode (modal value) and return a label +} +\details{ +From https://www.tutorialspoint.com/r/r_mean_median_mode.htm +} +\examples{ +modal(c("a", "b", "b")) +modal(c(1:10, 5)) +modal(as.factor(c(letters, "b"))) +modal(runif(100) > 0.5) + +} diff --git a/radiant.data/man/month.Rd b/radiant.data/man/month.Rd new file mode 100644 index 0000000000000000000000000000000000000000..8fc972653214b96b347be33fe45a369c8450a405 --- /dev/null +++ b/radiant.data/man/month.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{month} +\alias{month} +\title{Add ordered argument to lubridate::month} +\usage{ +month(x, label = FALSE, abbr = TRUE, ordered = FALSE) +} +\arguments{ +\item{x}{Input date vector} + +\item{label}{Month as label (TRUE, FALSE)} + +\item{abbr}{Abbreviate label (TRUE, FALSE)} + +\item{ordered}{Order factor (TRUE, FALSE)} +} +\description{ +Add ordered argument to lubridate::month +} +\seealso{ +See the \code{\link[lubridate]{month}} function in the lubridate package for additional details +} diff --git a/radiant.data/man/mutate_ext.Rd b/radiant.data/man/mutate_ext.Rd new file mode 100644 index 0000000000000000000000000000000000000000..503128b7cb82a0f62a01c862476f8046d5305b2b --- /dev/null +++ b/radiant.data/man/mutate_ext.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{mutate_ext} +\alias{mutate_ext} +\title{Add transformed variables to a data frame with the option to include a custom variable name extension} +\usage{ +mutate_ext(.tbl, .funs, ..., .ext = "", .vars = c()) +} +\arguments{ +\item{.tbl}{Data frame to add transformed variables to} + +\item{.funs}{Function(s) to apply (e.g., log)} + +\item{...}{Variables to transform} + +\item{.ext}{Extension to add for each variable} + +\item{.vars}{A list of columns generated by dplyr::vars(), or a character vector of column names, or a numeric vector of column positions.} +} +\description{ +Add transformed variables to a data frame with the option to include a custom variable name extension +} +\details{ +Wrapper for dplyr::mutate_at that allows custom variable name extensions +} +\examples{ +mutate_ext(mtcars, .funs = log, mpg, cyl, .ext = "_ln") +mutate_ext(mtcars, .funs = log, .ext = "_ln") +mutate_ext(mtcars, .funs = log) +mutate_ext(mtcars, .funs = log, .ext = "_ln", .vars = vars(mpg, cyl)) + +} diff --git a/radiant.data/man/n_missing.Rd b/radiant.data/man/n_missing.Rd new file mode 100644 index 0000000000000000000000000000000000000000..6c1ade385edd2b4adca4ac1c696d48eab04f2828 --- /dev/null +++ b/radiant.data/man/n_missing.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{n_missing} +\alias{n_missing} +\title{Number of missing values} +\usage{ +n_missing(x, ...) +} +\arguments{ +\item{x}{Input variable} + +\item{...}{Additional arguments} +} +\value{ +number of missing values +} +\description{ +Number of missing values +} +\examples{ +n_missing(c("a", "b", NA)) + +} diff --git a/radiant.data/man/n_obs.Rd b/radiant.data/man/n_obs.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f7eb2118eae6c6b12606f2a0a5a435eca9cd85b5 --- /dev/null +++ b/radiant.data/man/n_obs.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{n_obs} +\alias{n_obs} +\title{Number of observations} +\usage{ +n_obs(x, ...) +} +\arguments{ +\item{x}{Input variable} + +\item{...}{Additional arguments} +} +\value{ +number of observations +} +\description{ +Number of observations +} +\examples{ +n_obs(c("a", "b", NA)) + +} diff --git a/radiant.data/man/normalize.Rd b/radiant.data/man/normalize.Rd new file mode 100644 index 0000000000000000000000000000000000000000..2c0d6e9186afb6c6dd144ab361aa62e4b751b38f --- /dev/null +++ b/radiant.data/man/normalize.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{normalize} +\alias{normalize} +\title{Normalize a variable x by a variable y} +\usage{ +normalize(x, y) +} +\arguments{ +\item{x}{Input variable} + +\item{y}{Normalizing variable} +} +\value{ +x/y +} +\description{ +Normalize a variable x by a variable y +} diff --git a/radiant.data/man/parse_path.Rd b/radiant.data/man/parse_path.Rd new file mode 100644 index 0000000000000000000000000000000000000000..5eb452a2db4d08431bedd36b2133787a505fd4d9 --- /dev/null +++ b/radiant.data/man/parse_path.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{parse_path} +\alias{parse_path} +\title{Parse file path into useful components} +\usage{ +parse_path(path, chr = "", pdir = getwd(), mess = TRUE) +} +\arguments{ +\item{path}{Path to be parsed} + +\item{chr}{Character to wrap around path for display} + +\item{pdir}{Project directory if available} + +\item{mess}{Print messages if Dropbox or Google Drive not found} +} +\description{ +Parse file path into useful components +} +\details{ +Parse file path into useful components (i.e., file name, file extension, relative path, etc.) +} +\examples{ +list.files(".", full.names = TRUE)[1] \%>\% parse_path() +} diff --git a/radiant.data/man/percentiles.Rd b/radiant.data/man/percentiles.Rd new file mode 100644 index 0000000000000000000000000000000000000000..e56322465c39da7b77d291af65abddb6852aadde --- /dev/null +++ b/radiant.data/man/percentiles.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{p01} +\alias{p01} +\alias{p025} +\alias{p05} +\alias{p10} +\alias{p25} +\alias{p75} +\alias{p90} +\alias{p95} +\alias{p975} +\alias{p99} +\title{Calculate percentiles} +\usage{ +p01(x, na.rm = TRUE) + +p025(x, na.rm = TRUE) + +p05(x, na.rm = TRUE) + +p10(x, na.rm = TRUE) + +p25(x, na.rm = TRUE) + +p75(x, na.rm = TRUE) + +p90(x, na.rm = TRUE) + +p95(x, na.rm = TRUE) + +p975(x, na.rm = TRUE) + +p99(x, na.rm = TRUE) +} +\arguments{ +\item{x}{Numeric vector} + +\item{na.rm}{If TRUE missing values are removed before calculation} +} +\description{ +Calculate percentiles +} +\examples{ +p01(0:100) + +} diff --git a/radiant.data/man/pfun.Rd b/radiant.data/man/pfun.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f77da7f109b41e3935a8207c82e3308946d79635 --- /dev/null +++ b/radiant.data/man/pfun.Rd @@ -0,0 +1,76 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{pfun} +\alias{pfun} +\alias{psum} +\alias{pmean} +\alias{pmedian} +\alias{psd} +\alias{pvar} +\alias{pcv} +\alias{pp01} +\alias{pp025} +\alias{pp05} +\alias{pp10} +\alias{pp25} +\alias{pp75} +\alias{pp95} +\alias{pp975} +\alias{pp99} +\title{Summarize a set of numeric vectors per row} +\usage{ +pfun(..., fun, na.rm = TRUE) + +psum(..., na.rm = TRUE) + +pmean(..., na.rm = TRUE) + +pmedian(..., na.rm = TRUE) + +psd(..., na.rm = TRUE) + +pvar(..., na.rm = TRUE) + +pcv(..., na.rm = TRUE) + +pp01(..., na.rm = TRUE) + +pp025(..., na.rm = TRUE) + +pp05(..., na.rm = TRUE) + +pp10(..., na.rm = TRUE) + +pp25(..., na.rm = TRUE) + +pp75(..., na.rm = TRUE) + +pp95(..., na.rm = TRUE) + +pp975(..., na.rm = TRUE) + +pp99(..., na.rm = TRUE) +} +\arguments{ +\item{...}{Numeric vectors of the same length} + +\item{fun}{Function to apply} + +\item{na.rm}{a logical indicating whether missing values should be removed.} +} +\value{ +A vector of 'parallel' summaries of the argument vectors. +} +\description{ +Summarize a set of numeric vectors per row +} +\details{ +Calculate summary statistics of the input vectors per row (or 'parallel') +} +\examples{ +pfun(1:10, fun = mean) +psum(1:10, 10:1) +} +\seealso{ +See also \code{\link{pmin}} and \code{\link{pmax}} +} diff --git a/radiant.data/man/pivotr.Rd b/radiant.data/man/pivotr.Rd new file mode 100644 index 0000000000000000000000000000000000000000..48396deac0917f6c53311b2908eb8a408545d988 --- /dev/null +++ b/radiant.data/man/pivotr.Rd @@ -0,0 +1,64 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pivotr.R +\name{pivotr} +\alias{pivotr} +\title{Create a pivot table} +\usage{ +pivotr( + dataset, + cvars = "", + nvar = "None", + fun = "mean", + normalize = "None", + tabfilt = "", + tabsort = "", + tabslice = "", + nr = Inf, + data_filter = "", + arr = "", + rows = NULL, + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset to tabulate} + +\item{cvars}{Categorical variables} + +\item{nvar}{Numerical variable} + +\item{fun}{Function to apply to numerical variable} + +\item{normalize}{Normalize the table by row total, column totals, or overall total} + +\item{tabfilt}{Expression used to filter the table (e.g., "Total > 10000")} + +\item{tabsort}{Expression used to sort the table (e.g., "desc(Total)")} + +\item{tabslice}{Expression used to filter table (e.g., "1:5")} + +\item{nr}{Number of rows to display} + +\item{data_filter}{Expression used to filter the dataset before creating the table (e.g., "price > 10000")} + +\item{arr}{Expression to arrange (sort) the data on (e.g., "color, desc(price)")} + +\item{rows}{Rows to select from the specified dataset} + +\item{envir}{Environment to extract data from} +} +\description{ +Create a pivot table +} +\details{ +Create a pivot-table. See \url{https://radiant-rstats.github.io/docs/data/pivotr.html} for an example in Radiant +} +\examples{ +pivotr(diamonds, cvars = "cut") \%>\% str() +pivotr(diamonds, cvars = "cut")$tab +pivotr(diamonds, cvars = c("cut", "clarity", "color"))$tab +pivotr(diamonds, cvars = "cut:clarity", nvar = "price")$tab +pivotr(diamonds, cvars = "cut", nvar = "price")$tab +pivotr(diamonds, cvars = "cut", normalize = "total")$tab + +} diff --git a/radiant.data/man/plot.pivotr.Rd b/radiant.data/man/plot.pivotr.Rd new file mode 100644 index 0000000000000000000000000000000000000000..5f34b97c78e9a5324e32752c21196990e0c80e0f --- /dev/null +++ b/radiant.data/man/plot.pivotr.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pivotr.R +\name{plot.pivotr} +\alias{plot.pivotr} +\title{Plot method for the pivotr function} +\usage{ +\method{plot}{pivotr}( + x, + type = "dodge", + perc = FALSE, + flip = FALSE, + fillcol = "blue", + opacity = 0.5, + ... +) +} +\arguments{ +\item{x}{Return value from \code{\link{pivotr}}} + +\item{type}{Plot type to use ("fill" or "dodge" (default))} + +\item{perc}{Use percentage on the y-axis} + +\item{flip}{Flip the axes in a plot (FALSE or TRUE)} + +\item{fillcol}{Fill color for bar-plot when only one categorical variable has been selected (default is "blue")} + +\item{opacity}{Opacity for plot elements (0 to 1)} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the pivotr function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/data/pivotr} for an example in Radiant +} +\examples{ +pivotr(diamonds, cvars = "cut") \%>\% plot() +pivotr(diamonds, cvars = c("cut", "clarity")) \%>\% plot() +pivotr(diamonds, cvars = c("cut", "clarity", "color")) \%>\% plot() + +} +\seealso{ +\code{\link{pivotr}} to generate summaries + +\code{\link{summary.pivotr}} to show summaries +} diff --git a/radiant.data/man/prop.Rd b/radiant.data/man/prop.Rd new file mode 100644 index 0000000000000000000000000000000000000000..e2d19f6ad552120878432931c9674dc07c2a597c --- /dev/null +++ b/radiant.data/man/prop.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{prop} +\alias{prop} +\title{Calculate proportion} +\usage{ +prop(x, na.rm = TRUE) +} +\arguments{ +\item{x}{Input variable} + +\item{na.rm}{If TRUE missing values are removed before calculation} +} +\value{ +Proportion of first level for a factor and of the maximum value for numeric +} +\description{ +Calculate proportion +} +\examples{ +prop(c(rep(1L, 10), rep(0L, 10))) +prop(c(rep(4, 10), rep(2, 10))) +prop(rep(0, 10)) +prop(factor(c(rep("a", 20), rep("b", 10)))) + +} diff --git a/radiant.data/man/publishers.Rd b/radiant.data/man/publishers.Rd new file mode 100644 index 0000000000000000000000000000000000000000..eff9c306511ba79e5ad02c955fa9481b2d2f98ec --- /dev/null +++ b/radiant.data/man/publishers.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{publishers} +\alias{publishers} +\title{Comic publishers} +\format{ +A data frame with 3 rows and 2 variables +} +\usage{ +data(publishers) +} +\description{ +Comic publishers +} +\details{ +List of comic publishers from \url{https://stat545.com/join-cheatsheet.html}. The dataset is used to illustrate data merging / joining. Description provided in attr(publishers,"description") +} +\keyword{datasets} diff --git a/radiant.data/man/qscatter.Rd b/radiant.data/man/qscatter.Rd new file mode 100644 index 0000000000000000000000000000000000000000..10a58cb088856612d5b1ec6f09a9fba096a28bc6 --- /dev/null +++ b/radiant.data/man/qscatter.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/visualize.R +\name{qscatter} +\alias{qscatter} +\title{Create a qscatter plot similar to Stata} +\usage{ +qscatter(dataset, xvar, yvar, lev = "", fun = "mean", bins = 20) +} +\arguments{ +\item{dataset}{Data to plot (data.frame or tibble)} + +\item{xvar}{Character indicating the variable to display along the X-axis of the plot} + +\item{yvar}{Character indicating the variable to display along the Y-axis of the plot} + +\item{lev}{Level in yvar to use if yvar is of type character of factor. If lev is empty then the first level is used} + +\item{fun}{Summary measure to apply to both the x and y variable} + +\item{bins}{Number of bins to use} +} +\description{ +Create a qscatter plot similar to Stata +} +\examples{ +qscatter(diamonds, "price", "carat") +qscatter(titanic, "age", "survived") + +} diff --git a/radiant.data/man/qterms.Rd b/radiant.data/man/qterms.Rd new file mode 100644 index 0000000000000000000000000000000000000000..7fe31d0a7d202fa1af1a07688f19c8f83e5320ba --- /dev/null +++ b/radiant.data/man/qterms.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{qterms} +\alias{qterms} +\title{Create a vector of quadratic and cubed terms for use in linear and logistic regression} +\usage{ +qterms(vars, nway = 2) +} +\arguments{ +\item{vars}{Variables labels to use} + +\item{nway}{quadratic (2) or cubic (3) term labels to create} +} +\value{ +Character vector of (regression) term labels +} +\description{ +Create a vector of quadratic and cubed terms for use in linear and logistic regression +} +\examples{ +qterms(c("a", "b"), 3) +qterms(c("a", "b"), 2) +} diff --git a/radiant.data/man/radiant.data-deprecated.Rd b/radiant.data/man/radiant.data-deprecated.Rd new file mode 100644 index 0000000000000000000000000000000000000000..99438c593611e32b3f8cdc982143971af34c41dd --- /dev/null +++ b/radiant.data/man/radiant.data-deprecated.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/deprecated.R +\name{radiant.data-deprecated} +\alias{radiant.data-deprecated} +\alias{mean_rm} +\alias{median_rm} +\alias{min_rm} +\alias{max_rm} +\alias{sd_rm} +\alias{var_rm} +\alias{sum_rm} +\alias{getdata} +\alias{filterdata} +\alias{combinedata} +\alias{viewdata} +\alias{toFct} +\alias{fixMS} +\alias{getsummary} +\alias{Search} +\alias{formatnr} +\alias{formatdf} +\alias{rounddf} +\alias{getclass} +\alias{is_numeric} +\title{Deprecated function(s) in the radiant.data package} +\usage{ +mean_rm(...) +} +\arguments{ +\item{...}{Parameters to be passed to the updated functions} +} +\description{ +These functions are provided for compatibility with previous versions of +radiant but will be removed +} +\section{Details}{ + +\itemize{ + \item Replace \code{mean_rm} by \code{\link{mean}} + \item Replace \code{median_rm} by \code{\link{median}} + \item Replace \code{min_rm} by \code{\link{min}} + \item Replace \code{max_rm} by \code{\link{max}} + \item Replace \code{sd_rm} by \code{\link{sd}} + \item Replace \code{var_rm} by \code{\link{var}} + \item Replace \code{sum_rm} by \code{\link{sum}} + \item Replace \code{getdata} by \code{\link{get_data}} + \item Replace \code{filterdata} by \code{\link{filter_data}} + \item Replace \code{combinedata} by \code{\link{combine_data}} + \item Replace \code{viewdata} by \code{\link{view_data}} + \item Replace \code{toFct} by \code{\link{to_fct}} + \item Replace \code{fixMS} by \code{\link{fix_smart}} + \item Replace \code{rounddf} by \code{\link{round_df}} + \item Replace \code{formatdf} by \code{\link{format_df}} + \item Replace \code{formatnr} by \code{\link{format_nr}} + \item Replace \code{getclass} by \code{\link{get_class}} + \item Replace \code{is_numeric} by \code{\link{is_double}} + \item Replace \code{is_empty} by \code{\link{is.empty}} +} +} + diff --git a/radiant.data/man/radiant.data.Rd b/radiant.data/man/radiant.data.Rd new file mode 100644 index 0000000000000000000000000000000000000000..b43d2ba723742f47a1f0c08203c61cc84552bd72 --- /dev/null +++ b/radiant.data/man/radiant.data.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R, R/radiant.R +\name{radiant.data} +\alias{radiant.data} +\title{radiant.data} +\usage{ +radiant.data(state, ...) +} +\arguments{ +\item{state}{Path to statefile to load} + +\item{...}{additional arguments to pass to shiny::runApp (e.g, port = 8080)} +} +\description{ +Launch the radiant.data app in the default web browser +} +\examples{ +\dontrun{ +radiant.data() +radiant.data("https://github.com/radiant-rstats/docs/raw/gh-pages/examples/demo-dvd-rnd.state.rda") +radiant.data("viewer") +} +} diff --git a/radiant.data/man/radiant.data_url.Rd b/radiant.data/man/radiant.data_url.Rd new file mode 100644 index 0000000000000000000000000000000000000000..4f6eec446098645b4fb24d0073ccf78b31c6001d --- /dev/null +++ b/radiant.data/man/radiant.data_url.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{radiant.data_url} +\alias{radiant.data_url} +\title{Start radiant.data app but do not open a browser} +\usage{ +radiant.data_url(state, ...) +} +\arguments{ +\item{state}{Path to statefile to load} + +\item{...}{additional arguments to pass to shiny::runApp (e.g, port = 8080)} +} +\description{ +Start radiant.data app but do not open a browser +} +\examples{ +\dontrun{ +radiant.data_url() +} +} diff --git a/radiant.data/man/radiant.data_viewer.Rd b/radiant.data/man/radiant.data_viewer.Rd new file mode 100644 index 0000000000000000000000000000000000000000..1441a41bc603bd28b2dfd5305ee7a661766c3dbf --- /dev/null +++ b/radiant.data/man/radiant.data_viewer.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{radiant.data_viewer} +\alias{radiant.data_viewer} +\title{Launch the radiant.data app in the Rstudio viewer} +\usage{ +radiant.data_viewer(state, ...) +} +\arguments{ +\item{state}{Path to statefile to load} + +\item{...}{additional arguments to pass to shiny::runApp (e.g, port = 8080)} +} +\description{ +Launch the radiant.data app in the Rstudio viewer +} +\examples{ +\dontrun{ +radiant.data_viewer() +} +} diff --git a/radiant.data/man/radiant.data_window.Rd b/radiant.data/man/radiant.data_window.Rd new file mode 100644 index 0000000000000000000000000000000000000000..7b3aab2cbddd410229e57c674298d866f82666f4 --- /dev/null +++ b/radiant.data/man/radiant.data_window.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{radiant.data_window} +\alias{radiant.data_window} +\title{Launch the radiant.data app in an Rstudio window} +\usage{ +radiant.data_window(state, ...) +} +\arguments{ +\item{state}{Path to statefile to load} + +\item{...}{additional arguments to pass to shiny::runApp (e.g, port = 8080)} +} +\description{ +Launch the radiant.data app in an Rstudio window +} +\examples{ +\dontrun{ +radiant.data_window() +} +} diff --git a/radiant.data/man/read_files.Rd b/radiant.data/man/read_files.Rd new file mode 100644 index 0000000000000000000000000000000000000000..033527bbd81f13602f6abb53a138fe00239a1f80 --- /dev/null +++ b/radiant.data/man/read_files.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{read_files} +\alias{read_files} +\title{Generate code to read a file} +\usage{ +read_files( + path, + pdir = "", + type = "rmd", + to = "", + clipboard = TRUE, + radiant = FALSE +) +} +\arguments{ +\item{path}{Path to file. If empty, a file browser will be opened} + +\item{pdir}{Project dir} + +\item{type}{Generate code for _Report > Rmd_ ("rmd") or _Report > R_ ("r")} + +\item{to}{Name to use for object. If empty, will use file name to derive an object name} + +\item{clipboard}{Return code to clipboard (not available on Linux)} + +\item{radiant}{Should returned code be formatted for use with other code generated by Radiant?} +} +\description{ +Generate code to read a file +} +\details{ +Return code to read a file at the specified path. Will open a file browser if no path is provided +} +\examples{ +if (interactive()) { + read_files(clipboard = FALSE) +} +} diff --git a/radiant.data/man/reexports.Rd b/radiant.data/man/reexports.Rd new file mode 100644 index 0000000000000000000000000000000000000000..c87ef7d15c0b351a2fc5d927e461a22da178238f --- /dev/null +++ b/radiant.data/man/reexports.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{import} +\name{reexports} +\alias{reexports} +\alias{theme_version} +\alias{bs_theme} +\alias{wrap_plots} +\alias{plot_annotation} +\alias{writePNG} +\alias{glue} +\alias{glue_data} +\alias{glue_collapse} +\alias{knit_print} +\alias{rownames_to_column} +\alias{tibble} +\alias{as_tibble} +\alias{tidy} +\alias{glance} +\alias{kurtosi} +\alias{skew} +\alias{date} +\title{Objects exported from other packages} +\keyword{internal} +\description{ +These objects are imported from other packages. Follow the links +below to see their documentation. + +\describe{ + \item{broom}{\code{\link[broom:reexports]{glance}}, \code{\link[broom:reexports]{tidy}}} + + \item{bslib}{\code{\link[bslib]{bs_theme}}, \code{\link[bslib]{theme_version}}} + + \item{glue}{\code{\link[glue]{glue}}, \code{\link[glue]{glue_collapse}}, \code{\link[glue:glue]{glue_data}}} + + \item{knitr}{\code{\link[knitr]{knit_print}}} + + \item{lubridate}{\code{\link[lubridate]{date}}} + + \item{patchwork}{\code{\link[patchwork]{plot_annotation}}, \code{\link[patchwork]{wrap_plots}}} + + \item{png}{\code{\link[png]{writePNG}}} + + \item{psych}{\code{\link[psych:skew]{kurtosi}}, \code{\link[psych]{skew}}} + + \item{tibble}{\code{\link[tibble]{as_tibble}}, \code{\link[tibble:rownames]{rownames_to_column}}, \code{\link[tibble]{tibble}}} +}} + diff --git a/radiant.data/man/refactor.Rd b/radiant.data/man/refactor.Rd new file mode 100644 index 0000000000000000000000000000000000000000..c574e58d6813309bce54b4cf0a82e396ea31366f --- /dev/null +++ b/radiant.data/man/refactor.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{refactor} +\alias{refactor} +\title{Remove/reorder levels} +\usage{ +refactor(x, levs = levels(x), repl = NA) +} +\arguments{ +\item{x}{Character or Factor} + +\item{levs}{Set of levels to use} + +\item{repl}{String (or NA) used to replace missing levels} +} +\description{ +Remove/reorder levels +} +\details{ +Keep only a specific set of levels in a factor. By removing levels the base for comparison in, e.g., regression analysis, becomes the first level. To relabel the base use, for example, repl = 'other' +} +\examples{ +refactor(diamonds$cut, c("Premium", "Ideal")) \%>\% head() +refactor(diamonds$cut, c("Premium", "Ideal"), "Other") \%>\% head() + +} diff --git a/radiant.data/man/register.Rd b/radiant.data/man/register.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a5ac7dfe12169e114d08137e5bab6447e2183347 --- /dev/null +++ b/radiant.data/man/register.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{register} +\alias{register} +\title{Register a data.frame or list in Radiant} +\usage{ +register( + new, + org = "", + descr = "", + shiny = shiny::getDefaultReactiveDomain(), + envir = r_data +) +} +\arguments{ +\item{new}{String containing the name of the data.frame to register} + +\item{org}{Name of the original data.frame if a (working) copy is being made} + +\item{descr}{Data description in markdown format} + +\item{shiny}{Check if function is called from a shiny application} + +\item{envir}{Environment to assign data to} +} +\description{ +Register a data.frame or list in Radiant +} +\seealso{ +See also \code{\link{add_description}} to add a description in markdown format + to a data.frame +} diff --git a/radiant.data/man/render.Rd b/radiant.data/man/render.Rd new file mode 100644 index 0000000000000000000000000000000000000000..744b8ec602da27fac422abbf095073bf5bf83b18 --- /dev/null +++ b/radiant.data/man/render.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{render} +\alias{render} +\title{Base method used to render htmlwidgets} +\usage{ +render(object, ...) +} +\arguments{ +\item{object}{Object of relevant class to render} + +\item{...}{Additional arguments} +} +\description{ +Base method used to render htmlwidgets +} diff --git a/radiant.data/man/render.datatables.Rd b/radiant.data/man/render.datatables.Rd new file mode 100644 index 0000000000000000000000000000000000000000..21979b0983a451bb1c4c1c9b57974b8d641041e2 --- /dev/null +++ b/radiant.data/man/render.datatables.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{render.datatables} +\alias{render.datatables} +\title{Method to render DT tables} +\usage{ +\method{render}{datatables}(object, shiny = shiny::getDefaultReactiveDomain(), ...) +} +\arguments{ +\item{object}{DT table} + +\item{shiny}{Check if function is called from a shiny application} + +\item{...}{Additional arguments} +} +\description{ +Method to render DT tables +} diff --git a/radiant.data/man/render.plotly.Rd b/radiant.data/man/render.plotly.Rd new file mode 100644 index 0000000000000000000000000000000000000000..cfbb302afcda4e3f4319daec7f922ade586d738d --- /dev/null +++ b/radiant.data/man/render.plotly.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{render.plotly} +\alias{render.plotly} +\title{Method to render plotly plots} +\usage{ +\method{render}{plotly}(object, shiny = shiny::getDefaultReactiveDomain(), ...) +} +\arguments{ +\item{object}{plotly object} + +\item{shiny}{Check if function is called from a shiny application} + +\item{...}{Additional arguments} +} +\description{ +Method to render plotly plots +} diff --git a/radiant.data/man/round_df.Rd b/radiant.data/man/round_df.Rd new file mode 100644 index 0000000000000000000000000000000000000000..61764a12eb6dd50ebff91bb357611a3a98799d1c --- /dev/null +++ b/radiant.data/man/round_df.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{round_df} +\alias{round_df} +\title{Round doubles in a data.frame to a specified number of decimal places} +\usage{ +round_df(tbl, dec = 3) +} +\arguments{ +\item{tbl}{Data frame} + +\item{dec}{Number of decimals to show} +} +\value{ +Data frame with rounded doubles +} +\description{ +Round doubles in a data.frame to a specified number of decimal places +} +\examples{ +data.frame(x = as.factor(c("a", "b")), y = c(1L, 2L), z = c(-0.0005, 3.1)) \%>\% + round_df(dec = 2) +} diff --git a/radiant.data/man/save_clip.Rd b/radiant.data/man/save_clip.Rd new file mode 100644 index 0000000000000000000000000000000000000000..1043487adca38d8f8c95388d26b569ffefefe80f --- /dev/null +++ b/radiant.data/man/save_clip.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/manage.R +\name{save_clip} +\alias{save_clip} +\title{Save data to clipboard on Windows or macOS} +\usage{ +save_clip(dataset) +} +\arguments{ +\item{dataset}{Dataset to save to clipboard} +} +\description{ +Save data to clipboard on Windows or macOS +} +\details{ +Save a data.frame or tibble to the clipboard on Windows or macOS +} +\seealso{ +See the \code{\link{load_clip}} +} diff --git a/radiant.data/man/sdpop.Rd b/radiant.data/man/sdpop.Rd new file mode 100644 index 0000000000000000000000000000000000000000..0293762eb637b05e48e1026696e4d1f840f98927 --- /dev/null +++ b/radiant.data/man/sdpop.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{sdpop} +\alias{sdpop} +\title{Standard deviation for the population} +\usage{ +sdpop(x, na.rm = TRUE) +} +\arguments{ +\item{x}{Input variable} + +\item{na.rm}{If TRUE missing values are removed before calculation} +} +\value{ +Standard deviation for the population +} +\description{ +Standard deviation for the population +} +\examples{ +sdpop(rnorm(100)) + +} diff --git a/radiant.data/man/sdprop.Rd b/radiant.data/man/sdprop.Rd new file mode 100644 index 0000000000000000000000000000000000000000..c16c75141336b6715a7fe928471253063ff36583 --- /dev/null +++ b/radiant.data/man/sdprop.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{sdprop} +\alias{sdprop} +\title{Standard deviation for proportion} +\usage{ +sdprop(x, na.rm = TRUE) +} +\arguments{ +\item{x}{Input variable} + +\item{na.rm}{If TRUE missing values are removed before calculation} +} +\value{ +Standard deviation for proportion +} +\description{ +Standard deviation for proportion +} +\examples{ +sdprop(c(rep(1L, 10), rep(0L, 10))) + +} diff --git a/radiant.data/man/se.Rd b/radiant.data/man/se.Rd new file mode 100644 index 0000000000000000000000000000000000000000..fecb7bb3e7479b7f08809d91b18085c0304df83d --- /dev/null +++ b/radiant.data/man/se.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{se} +\alias{se} +\title{Standard error} +\usage{ +se(x, na.rm = TRUE) +} +\arguments{ +\item{x}{Input variable} + +\item{na.rm}{If TRUE missing values are removed before calculation} +} +\value{ +Standard error +} +\description{ +Standard error +} +\examples{ +se(rnorm(100)) + +} diff --git a/radiant.data/man/search_data.Rd b/radiant.data/man/search_data.Rd new file mode 100644 index 0000000000000000000000000000000000000000..c7f433c07e7204adabc9b08d7f3faa266a606e84 --- /dev/null +++ b/radiant.data/man/search_data.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/view.R +\name{search_data} +\alias{search_data} +\title{Search for a pattern in all columns of a data.frame} +\usage{ +search_data(dataset, pattern, ignore.case = TRUE, fixed = FALSE) +} +\arguments{ +\item{dataset}{Data.frame to search} + +\item{pattern}{String to match} + +\item{ignore.case}{Should search be case sensitive or not (default is FALSE)} + +\item{fixed}{Allow regular expressions or not (default is FALSE)} +} +\description{ +Search for a pattern in all columns of a data.frame +} +\examples{ +publishers \%>\% filter(search_data(., "^m")) +} +\seealso{ +See \code{\link{grepl}} for a detailed description of the function arguments +} diff --git a/radiant.data/man/seprop.Rd b/radiant.data/man/seprop.Rd new file mode 100644 index 0000000000000000000000000000000000000000..33c5d222229d869f152d2e510832f42b3325997b --- /dev/null +++ b/radiant.data/man/seprop.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{seprop} +\alias{seprop} +\title{Standard error for proportion} +\usage{ +seprop(x, na.rm = TRUE) +} +\arguments{ +\item{x}{Input variable} + +\item{na.rm}{If TRUE missing values are removed before calculation} +} +\value{ +Standard error for proportion +} +\description{ +Standard error for proportion +} +\examples{ +seprop(c(rep(1L, 10), rep(0L, 10))) + +} diff --git a/radiant.data/man/set_attr.Rd b/radiant.data/man/set_attr.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d330a48f65a0d06101ec16507337875a044c940e --- /dev/null +++ b/radiant.data/man/set_attr.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{set_attr} +\alias{set_attr} +\title{Alias used to add an attribute} +\usage{ +set_attr(x, which, value) +} +\arguments{ +\item{x}{Object} + +\item{which}{Attribute name} + +\item{value}{Value to set} +} +\description{ +Alias used to add an attribute +} +\examples{ +foo <- data.frame(price = 1:5) \%>\% set_attr("description", "price set in experiment ...") +} diff --git a/radiant.data/man/show_duplicated.Rd b/radiant.data/man/show_duplicated.Rd new file mode 100644 index 0000000000000000000000000000000000000000..2e9f204f25ba6ab2ec271ce1803c99229013ee01 --- /dev/null +++ b/radiant.data/man/show_duplicated.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{show_duplicated} +\alias{show_duplicated} +\title{Show all rows with duplicated values (not just the first or last)} +\usage{ +show_duplicated(.tbl, ...) +} +\arguments{ +\item{.tbl}{Data frame to add transformed variables to} + +\item{...}{Variables used to evaluate row uniqueness} +} +\description{ +Show all rows with duplicated values (not just the first or last) +} +\details{ +If an entire row is duplicated use "duplicated" to show only one of the duplicated rows. When using a subset of variables to establish uniqueness it may be of interest to show all rows that have (some) duplicate elements +} +\examples{ +bind_rows(mtcars, mtcars[c(1, 5, 7), ]) \%>\% + show_duplicated(mpg, cyl) +bind_rows(mtcars, mtcars[c(1, 5, 7), ]) \%>\% + show_duplicated() + +} diff --git a/radiant.data/man/sig_stars.Rd b/radiant.data/man/sig_stars.Rd new file mode 100644 index 0000000000000000000000000000000000000000..8b1cc39f02dc9d73674765d36dbee4fbcb7670e4 --- /dev/null +++ b/radiant.data/man/sig_stars.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{sig_stars} +\alias{sig_stars} +\title{Add stars based on p.values} +\usage{ +sig_stars(pval) +} +\arguments{ +\item{pval}{Vector of p-values} +} +\value{ +A vector of stars +} +\description{ +Add stars based on p.values +} +\examples{ +sig_stars(c(.0009, .049, .009, .4, .09)) +} diff --git a/radiant.data/man/slice_data.Rd b/radiant.data/man/slice_data.Rd new file mode 100644 index 0000000000000000000000000000000000000000..954134dbfd9222fba741d7b32d05838c1eb20b8a --- /dev/null +++ b/radiant.data/man/slice_data.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/view.R +\name{slice_data} +\alias{slice_data} +\title{Slice data with user-specified expression} +\usage{ +slice_data(dataset, expr = NULL, drop = TRUE) +} +\arguments{ +\item{dataset}{Data frame to slice} + +\item{expr}{Expression to use select rows from the specified dataset} + +\item{drop}{Drop unused factor levels after filtering (default is TRUE)} +} +\value{ +Sliced data frame +} +\description{ +Slice data with user-specified expression +} +\details{ +Select only a slice of the data to work with +} diff --git a/radiant.data/man/square.Rd b/radiant.data/man/square.Rd new file mode 100644 index 0000000000000000000000000000000000000000..5cc254a44685e3557bc47bba53603b1b0a208466 --- /dev/null +++ b/radiant.data/man/square.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{square} +\alias{square} +\title{Calculate square of a variable} +\usage{ +square(x) +} +\arguments{ +\item{x}{Input variable} +} +\value{ +x^2 +} +\description{ +Calculate square of a variable +} diff --git a/radiant.data/man/sshh.Rd b/radiant.data/man/sshh.Rd new file mode 100644 index 0000000000000000000000000000000000000000..86e842e2ae2d5a4468cb3c5f6e562a7a61074a24 --- /dev/null +++ b/radiant.data/man/sshh.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{sshh} +\alias{sshh} +\title{Hide warnings and messages and return invisible} +\usage{ +sshh(...) +} +\arguments{ +\item{...}{Inputs to keep quite} +} +\description{ +Hide warnings and messages and return invisible +} +\details{ +Hide warnings and messages and return invisible +} +\examples{ +sshh(library(dplyr)) +} diff --git a/radiant.data/man/sshhr.Rd b/radiant.data/man/sshhr.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f7c0c88421c8708f139ab5cc3373aeb233a5ff0f --- /dev/null +++ b/radiant.data/man/sshhr.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{sshhr} +\alias{sshhr} +\title{Hide warnings and messages and return result} +\usage{ +sshhr(...) +} +\arguments{ +\item{...}{Inputs to keep quite} +} +\description{ +Hide warnings and messages and return result +} +\details{ +Hide warnings and messages and return result +} +\examples{ +sshhr(library(dplyr)) +} diff --git a/radiant.data/man/standardize.Rd b/radiant.data/man/standardize.Rd new file mode 100644 index 0000000000000000000000000000000000000000..7b0bca3e16764c1552706da4c2b7b13cd8b28358 --- /dev/null +++ b/radiant.data/man/standardize.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{standardize} +\alias{standardize} +\title{Standardize} +\usage{ +standardize(x, na.rm = TRUE) +} +\arguments{ +\item{x}{Input variable} + +\item{na.rm}{If TRUE missing values are removed before calculation} +} +\value{ +If x is a numeric variable return (x - mean(x)) / sd(x) +} +\description{ +Standardize +} diff --git a/radiant.data/man/store.Rd b/radiant.data/man/store.Rd new file mode 100644 index 0000000000000000000000000000000000000000..0e24d83fa7cdd345a70a01a515fd867f21ddce4d --- /dev/null +++ b/radiant.data/man/store.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{store} +\alias{store} +\title{Method to store variables in a dataset in Radiant} +\usage{ +store(dataset, object = "deprecated", ...) +} +\arguments{ +\item{dataset}{Dataset} + +\item{object}{Object of relevant class that has information to be stored} + +\item{...}{Additional arguments} +} +\description{ +Method to store variables in a dataset in Radiant +} diff --git a/radiant.data/man/store.explore.Rd b/radiant.data/man/store.explore.Rd new file mode 100644 index 0000000000000000000000000000000000000000..3c2a4877b3d21ad7c90d00df50f62e87a7b643b2 --- /dev/null +++ b/radiant.data/man/store.explore.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{store.explore} +\alias{store.explore} +\title{Deprecated: Store method for the explore function} +\usage{ +\method{store}{explore}(dataset, object, name, ...) +} +\arguments{ +\item{dataset}{Dataset} + +\item{object}{Return value from \code{\link{explore}}} + +\item{name}{Name to assign to the dataset} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Deprecated: Store method for the explore function +} +\details{ +Return the summarized data. See \url{https://radiant-rstats.github.io/docs/data/explore.html} for an example in Radiant +} +\seealso{ +\code{\link{explore}} to generate summaries +} diff --git a/radiant.data/man/store.pivotr.Rd b/radiant.data/man/store.pivotr.Rd new file mode 100644 index 0000000000000000000000000000000000000000..87a28e4c1bbbe6d7ec0b8cb73904ff386080d7c1 --- /dev/null +++ b/radiant.data/man/store.pivotr.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pivotr.R +\name{store.pivotr} +\alias{store.pivotr} +\title{Deprecated: Store method for the pivotr function} +\usage{ +\method{store}{pivotr}(dataset, object, name, ...) +} +\arguments{ +\item{dataset}{Dataset} + +\item{object}{Return value from \code{\link{pivotr}}} + +\item{name}{Name to assign to the dataset} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Deprecated: Store method for the pivotr function +} +\details{ +Return the summarized data. See \url{https://radiant-rstats.github.io/docs/data/pivotr.html} for an example in Radiant +} +\seealso{ +\code{\link{pivotr}} to generate summaries +} diff --git a/radiant.data/man/subplot.Rd b/radiant.data/man/subplot.Rd new file mode 100644 index 0000000000000000000000000000000000000000..c6be00de2c15d3e6178079c81939510a5c4efe1d --- /dev/null +++ b/radiant.data/man/subplot.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{subplot} +\alias{subplot} +\title{Work around to avoid (harmless) messages from subplot} +\usage{ +subplot(..., margin = 0.04) +} +\arguments{ +\item{...}{Arguments to pass to the \code{\link[plotly]{subplot}} function in the plotly packages} + +\item{margin}{Default margin to use between plots} +} +\description{ +Work around to avoid (harmless) messages from subplot +} +\seealso{ +See the \code{\link[plotly]{subplot}} in the plotly package for details (?plotly::subplot) +} diff --git a/radiant.data/man/summary.explore.Rd b/radiant.data/man/summary.explore.Rd new file mode 100644 index 0000000000000000000000000000000000000000..5ea744439c87e21593f2f25f36185c90954fac4c --- /dev/null +++ b/radiant.data/man/summary.explore.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{summary.explore} +\alias{summary.explore} +\title{Summary method for the explore function} +\usage{ +\method{summary}{explore}(object, dec = 3, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{explore}}} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the explore function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/data/explore.html} for an example in Radiant +} +\examples{ +result <- explore(diamonds, "price:x") +summary(result) +result <- explore(diamonds, "price", byvar = "cut", fun = c("n_obs", "skew")) +summary(result) +explore(diamonds, "price:x", byvar = "color") \%>\% summary() + +} +\seealso{ +\code{\link{explore}} to generate summaries +} diff --git a/radiant.data/man/summary.pivotr.Rd b/radiant.data/man/summary.pivotr.Rd new file mode 100644 index 0000000000000000000000000000000000000000..61da655185a2d0ce036f5ef1ae62daf7dd8b0a96 --- /dev/null +++ b/radiant.data/man/summary.pivotr.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pivotr.R +\name{summary.pivotr} +\alias{summary.pivotr} +\title{Summary method for pivotr} +\usage{ +\method{summary}{pivotr}(object, perc = FALSE, dec = 3, chi2 = FALSE, shiny = FALSE, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{pivotr}}} + +\item{perc}{Display numbers as percentages (TRUE or FALSE)} + +\item{dec}{Number of decimals to show} + +\item{chi2}{If TRUE calculate the chi-square statistic for the (pivot) table} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for pivotr +} +\details{ +See \url{https://radiant-rstats.github.io/docs/data/pivotr.html} for an example in Radiant +} +\examples{ +pivotr(diamonds, cvars = "cut") \%>\% summary(chi2 = TRUE) +pivotr(diamonds, cvars = "cut", tabsort = "desc(n_obs)") \%>\% summary() +pivotr(diamonds, cvars = "cut", tabfilt = "n_obs > 700") \%>\% summary() +pivotr(diamonds, cvars = "cut:clarity", nvar = "price") \%>\% summary() + +} +\seealso{ +\code{\link{pivotr}} to create the pivot-table using dplyr +} diff --git a/radiant.data/man/superheroes.Rd b/radiant.data/man/superheroes.Rd new file mode 100644 index 0000000000000000000000000000000000000000..ec85f8f9d9041de59e9725f71edcde07b580a4cc --- /dev/null +++ b/radiant.data/man/superheroes.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{superheroes} +\alias{superheroes} +\title{Super heroes} +\format{ +A data frame with 7 rows and 4 variables +} +\usage{ +data(superheroes) +} +\description{ +Super heroes +} +\details{ +List of super heroes from \url{https://stat545.com/join-cheatsheet.html}. The dataset is used to illustrate data merging / joining. Description provided in attr(superheroes,"description") +} +\keyword{datasets} diff --git a/radiant.data/man/table2data.Rd b/radiant.data/man/table2data.Rd new file mode 100644 index 0000000000000000000000000000000000000000..6170cc2676492037fdd884bb1ffe701b584406f2 --- /dev/null +++ b/radiant.data/man/table2data.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{table2data} +\alias{table2data} +\title{Create data.frame from a table} +\usage{ +table2data(dataset, freq = tail(colnames(dataset), 1)) +} +\arguments{ +\item{dataset}{Data.frame} + +\item{freq}{Column name with frequency information} +} +\description{ +Create data.frame from a table +} +\examples{ +data.frame(price = c("$200", "$300"), sale = c(10, 2)) \%>\% table2data() + +} diff --git a/radiant.data/man/titanic.Rd b/radiant.data/man/titanic.Rd new file mode 100644 index 0000000000000000000000000000000000000000..507d87f5338458e0c16d42370ce00a68d21dc127 --- /dev/null +++ b/radiant.data/man/titanic.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{titanic} +\alias{titanic} +\title{Survival data for the Titanic} +\format{ +A data frame with 1043 rows and 10 variables +} +\usage{ +data(titanic) +} +\description{ +Survival data for the Titanic +} +\details{ +Survival data for the Titanic. Description provided in attr(titanic,"description") +} +\keyword{datasets} diff --git a/radiant.data/man/to_fct.Rd b/radiant.data/man/to_fct.Rd new file mode 100644 index 0000000000000000000000000000000000000000..4a74ac59d59bf9248e028147ae68721cb35456e8 --- /dev/null +++ b/radiant.data/man/to_fct.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{to_fct} +\alias{to_fct} +\title{Convert characters to factors} +\usage{ +to_fct(dataset, safx = 30, nuniq = 100, n = 100) +} +\arguments{ +\item{dataset}{Data frame} + +\item{safx}{Ratio of number of rows to number of unique values} + +\item{nuniq}{Cutoff for number of unique values} + +\item{n}{Cutoff for small dataset} +} +\description{ +Convert characters to factors +} +\details{ +Convert columns of type character to factors based on a set of rules. By default columns will be converted for small datasets (<= 100 rows) with more rows than unique values. For larger datasets, columns are converted only when the number of unique values is <= 100 and there are 30 or more rows in the data for every unique value +} +\examples{ +tibble(a = c("a", "b"), b = c("a", "a"), c = 1:2) \%>\% to_fct() +} diff --git a/radiant.data/man/varpop.Rd b/radiant.data/man/varpop.Rd new file mode 100644 index 0000000000000000000000000000000000000000..1c42b9b423ee316dbc006d2fa46325bd0ced9faf --- /dev/null +++ b/radiant.data/man/varpop.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{varpop} +\alias{varpop} +\title{Variance for the population} +\usage{ +varpop(x, na.rm = TRUE) +} +\arguments{ +\item{x}{Input variable} + +\item{na.rm}{If TRUE missing values are removed before calculation} +} +\value{ +Variance for the population +} +\description{ +Variance for the population +} +\examples{ +varpop(rnorm(100)) + +} diff --git a/radiant.data/man/varprop.Rd b/radiant.data/man/varprop.Rd new file mode 100644 index 0000000000000000000000000000000000000000..979ac3e9c7cf3b66c00619f70701bf2dab991f07 --- /dev/null +++ b/radiant.data/man/varprop.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explore.R +\name{varprop} +\alias{varprop} +\title{Variance for proportion} +\usage{ +varprop(x, na.rm = TRUE) +} +\arguments{ +\item{x}{Input variable} + +\item{na.rm}{If TRUE missing values are removed before calculation} +} +\value{ +Variance for proportion +} +\description{ +Variance for proportion +} +\examples{ +varprop(c(rep(1L, 10), rep(0L, 10))) + +} diff --git a/radiant.data/man/view_data.Rd b/radiant.data/man/view_data.Rd new file mode 100644 index 0000000000000000000000000000000000000000..b96eb088a610fb1c52a6e0e13a9c521292ca3302 --- /dev/null +++ b/radiant.data/man/view_data.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/view.R +\name{view_data} +\alias{view_data} +\title{View data in a shiny-app} +\usage{ +view_data( + dataset, + vars = "", + filt = "", + arr = "", + rows = NULL, + na.rm = FALSE, + dec = 3, + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Data.frame or name of the dataframe to view} + +\item{vars}{Variables to show (default is all)} + +\item{filt}{Filter to apply to the specified dataset} + +\item{arr}{Expression to arrange (sort) data} + +\item{rows}{Select rows in the specified dataset} + +\item{na.rm}{Remove rows with missing values (default is FALSE)} + +\item{dec}{Number of decimals to show} + +\item{envir}{Environment to extract data from} +} +\description{ +View data in a shiny-app +} +\details{ +View, search, sort, etc. your data +} +\examples{ +\dontrun{ +view_data(mtcars) +} + +} +\seealso{ +See \code{\link{get_data}} and \code{\link{filter_data}} +} diff --git a/radiant.data/man/visualize.Rd b/radiant.data/man/visualize.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a2e37a078b3d4c99b5c63c5b5e930a6d30baf87c --- /dev/null +++ b/radiant.data/man/visualize.Rd @@ -0,0 +1,146 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/visualize.R +\name{visualize} +\alias{visualize} +\title{Visualize data using ggplot2 \url{https://ggplot2.tidyverse.org/}} +\usage{ +visualize( + dataset, + xvar, + yvar = "", + comby = FALSE, + combx = FALSE, + type = ifelse(is.empty(yvar), "dist", "scatter"), + nrobs = -1, + facet_row = ".", + facet_col = ".", + color = "none", + fill = "none", + size = "none", + fillcol = "blue", + linecol = "black", + pointcol = "black", + bins = 10, + smooth = 1, + fun = "mean", + check = "", + axes = "", + alpha = 0.5, + theme = "theme_gray", + base_size = 11, + base_family = "", + labs = list(), + xlim = NULL, + ylim = NULL, + data_filter = "", + arr = "", + rows = NULL, + shiny = FALSE, + custom = FALSE, + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Data to plot (data.frame or tibble)} + +\item{xvar}{One or more variables to display along the X-axis of the plot} + +\item{yvar}{Variable to display along the Y-axis of the plot (default = "none")} + +\item{comby}{Combine yvars in plot (TRUE or FALSE, FALSE is the default)} + +\item{combx}{Combine xvars in plot (TRUE or FALSE, FALSE is the default)} + +\item{type}{Type of plot to create. One of Distribution ('dist'), Density ('density'), Scatter ('scatter'), Surface ('surface'), Line ('line'), Bar ('bar'), or Box-plot ('box')} + +\item{nrobs}{Number of data points to show in scatter plots (-1 for all)} + +\item{facet_row}{Create vertically arranged subplots for each level of the selected factor variable} + +\item{facet_col}{Create horizontally arranged subplots for each level of the selected factor variable} + +\item{color}{Adds color to a scatter plot to generate a 'heat map'. For a line plot one line is created for each group and each is assigned a different color} + +\item{fill}{Display bar, distribution, and density plots by group, each with a different color. Also applied to surface plots to generate a 'heat map'} + +\item{size}{Numeric variable used to scale the size of scatter-plot points} + +\item{fillcol}{Color used for bars, boxes, etc. when no color or fill variable is specified} + +\item{linecol}{Color for lines when no color variable is specified} + +\item{pointcol}{Color for points when no color variable is specified} + +\item{bins}{Number of bins used for a histogram (1 - 50)} + +\item{smooth}{Adjust the flexibility of the loess line for scatter plots} + +\item{fun}{Set the summary measure for line and bar plots when the X-variable is a factor (default is "mean"). Also used to plot an error bar in a scatter plot when the X-variable is a factor. Options are "mean" and/or "median"} + +\item{check}{Add a regression line ("line"), a loess line ("loess"), or jitter ("jitter") to a scatter plot} + +\item{axes}{Flip the axes in a plot ("flip") or apply a log transformation (base e) to the y-axis ("log_y") or the x-axis ("log_x")} + +\item{alpha}{Opacity for plot elements (0 to 1)} + +\item{theme}{ggplot theme to use (e.g., "theme_gray" or "theme_classic")} + +\item{base_size}{Base font size to use (default = 11)} + +\item{base_family}{Base font family to use (e.g., "Times" or "Helvetica")} + +\item{labs}{Labels to use for plots} + +\item{xlim}{Set limit for x-axis (e.g., c(0, 1))} + +\item{ylim}{Set limit for y-axis (e.g., c(0, 1))} + +\item{data_filter}{Expression used to filter the dataset. This should be a string (e.g., "price > 10000")} + +\item{arr}{Expression used to sort the data. Likely used in combination for `rows`} + +\item{rows}{Rows to select from the specified dataset} + +\item{shiny}{Logical (TRUE, FALSE) to indicate if the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options.} + +\item{envir}{Environment to extract data from} +} +\value{ +Generated plots +} +\description{ +Visualize data using ggplot2 \url{https://ggplot2.tidyverse.org/} +} +\details{ +See \url{https://radiant-rstats.github.io/docs/data/visualize.html} for an example in Radiant +} +\examples{ +visualize(diamonds, "price:cut", type = "dist", fillcol = "red") +visualize(diamonds, "carat:cut", + yvar = "price", type = "scatter", + pointcol = "blue", fun = c("mean", "median"), linecol = c("red", "green") +) +visualize(diamonds, + yvar = "price", xvar = c("cut", "clarity"), + type = "bar", fun = "median" +) +visualize(diamonds, + yvar = "price", xvar = c("cut", "clarity"), + type = "line", fun = "max" +) +visualize(diamonds, + yvar = "price", xvar = "carat", type = "scatter", + size = "table", custom = TRUE +) + scale_size(range = c(1, 10), guide = "none") +visualize(diamonds, yvar = "price", xvar = "carat", type = "scatter", custom = TRUE) + + labs(title = "A scatterplot", x = "price in $") +visualize(diamonds, xvar = "price:carat", custom = TRUE) \%>\% + wrap_plots(ncol = 2) + plot_annotation(title = "Histograms") +visualize(diamonds, + xvar = "cut", yvar = "price", type = "bar", + facet_row = "cut", fill = "cut" +) + +} diff --git a/radiant.data/man/wday.Rd b/radiant.data/man/wday.Rd new file mode 100644 index 0000000000000000000000000000000000000000..828397e0db7689299fe76976cca606796f6afe52 --- /dev/null +++ b/radiant.data/man/wday.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{wday} +\alias{wday} +\title{Add ordered argument to lubridate::wday} +\usage{ +wday(x, label = FALSE, abbr = TRUE, ordered = FALSE) +} +\arguments{ +\item{x}{Input date vector} + +\item{label}{Weekday as label (TRUE, FALSE)} + +\item{abbr}{Abbreviate label (TRUE, FALSE)} + +\item{ordered}{Order factor (TRUE, FALSE)} +} +\description{ +Add ordered argument to lubridate::wday +} +\seealso{ +See the \code{\link[lubridate:day]{lubridate::wday()}} function in the lubridate package for additional details +} diff --git a/radiant.data/man/weighted.sd.Rd b/radiant.data/man/weighted.sd.Rd new file mode 100644 index 0000000000000000000000000000000000000000..2322ff7e9bb24cc5ab5be1c0d143b283ca750d82 --- /dev/null +++ b/radiant.data/man/weighted.sd.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{weighted.sd} +\alias{weighted.sd} +\title{Weighted standard deviation} +\usage{ +weighted.sd(x, wt, na.rm = TRUE) +} +\arguments{ +\item{x}{Numeric vector} + +\item{wt}{Numeric vector of weights} + +\item{na.rm}{Remove missing values (default is TRUE)} +} +\description{ +Weighted standard deviation +} +\details{ +Calculate weighted standard deviation +} diff --git a/radiant.data/man/which.pmax.Rd b/radiant.data/man/which.pmax.Rd new file mode 100644 index 0000000000000000000000000000000000000000..146259df2c561505499dc8e4313e52885aa89ff8 --- /dev/null +++ b/radiant.data/man/which.pmax.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{which.pmax} +\alias{which.pmax} +\title{Index of the maximum per row} +\usage{ +which.pmax(...) +} +\arguments{ +\item{...}{Numeric or character vectors of the same length} +} +\value{ +Vector of rankings +} +\description{ +Index of the maximum per row +} +\details{ +Determine the index of the maximum of the input vectors per row. Extension of \code{which.max} +} +\examples{ +which.pmax(1:10, 10:1) +which.pmax(2, 10:1) +which.pmax(mtcars) +} +\seealso{ +See also \code{\link{which.max}} and \code{\link{which.pmin}} +} diff --git a/radiant.data/man/which.pmin.Rd b/radiant.data/man/which.pmin.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f400406d37e9383abb3dc88a8d62bfca6235875e --- /dev/null +++ b/radiant.data/man/which.pmin.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{which.pmin} +\alias{which.pmin} +\title{Index of the minimum per row} +\usage{ +which.pmin(...) +} +\arguments{ +\item{...}{Numeric or character vectors of the same length} +} +\value{ +Vector of rankings +} +\description{ +Index of the minimum per row +} +\details{ +Determine the index of the minimum of the input vectors per row. Extension of \code{which.min} +} +\examples{ +which.pmin(1:10, 10:1) +which.pmin(2, 10:1) +which.pmin(mtcars) +} +\seealso{ +See also \code{\link{which.min}} and \code{\link{which.pmax}} +} diff --git a/radiant.data/man/write_parquet.Rd b/radiant.data/man/write_parquet.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d654d560ed9af877b16ec6a81e77b4cbd743e42e --- /dev/null +++ b/radiant.data/man/write_parquet.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{write_parquet} +\alias{write_parquet} +\title{Workaround to store description file together with a parquet data file} +\usage{ +write_parquet(x, file, description = attr(x, "description")) +} +\arguments{ +\item{x}{A data frame to write to disk} + +\item{file}{Path to store parquet file} + +\item{description}{Data description} +} +\description{ +Workaround to store description file together with a parquet data file +} diff --git a/radiant.data/man/xtile.Rd b/radiant.data/man/xtile.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f5d62ccf6d531c70544da813eb8af69d99477067 --- /dev/null +++ b/radiant.data/man/xtile.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform.R +\name{xtile} +\alias{xtile} +\title{Split a numeric variable into a number of bins and return a vector of bin numbers} +\usage{ +xtile(x, n = 5, rev = FALSE, type = 7) +} +\arguments{ +\item{x}{Numeric variable} + +\item{n}{number of bins to create} + +\item{rev}{Reverse the order of the bin numbers} + +\item{type}{An integer between 1 and 9 to select one of the quantile algorithms described in the help for the stats::quantile function} +} +\description{ +Split a numeric variable into a number of bins and return a vector of bin numbers +} +\examples{ +xtile(1:10, 5) +xtile(1:10, 5, rev = TRUE) +xtile(c(rep(1, 6), 7:10), 5) + +} +\seealso{ +See \link[stats]{quantile} for a description of the different algorithm types +} diff --git a/radiant.data/tests/testthat.R b/radiant.data/tests/testthat.R new file mode 100644 index 0000000000000000000000000000000000000000..189810b02be6b0a8634fd279d06df167c561f5b3 --- /dev/null +++ b/radiant.data/tests/testthat.R @@ -0,0 +1,3 @@ +## use shift-cmd-t in Rstudio to run all tests +library(testthat) +test_check("radiant.data") diff --git a/radiant.data/tests/testthat/data/css_example.css b/radiant.data/tests/testthat/data/css_example.css new file mode 100644 index 0000000000000000000000000000000000000000..8cc9722af3e3860d5b1effcae05464cdf69f1fb4 --- /dev/null +++ b/radiant.data/tests/testthat/data/css_example.css @@ -0,0 +1,15 @@ +.table { + width: auto; +} + +img { + max-width: 85% !important; + height: auto; +} + +pre, code, pre code { + overflow: auto; + white-space: pre; + word-wrap: normal; + background-color: #ffffff; +} diff --git a/radiant.data/tests/testthat/data/csv_example.csv b/radiant.data/tests/testthat/data/csv_example.csv new file mode 100644 index 0000000000000000000000000000000000000000..53528242cfbeb88796c679342e07dad3dee4620e --- /dev/null +++ b/radiant.data/tests/testthat/data/csv_example.csv @@ -0,0 +1,8 @@ +name,alignment,gender,publisher +Magneto,bad,male,Marvel +Storm,good,female,Marvel +Mystique,bad,female,Marvel +Batman,good,male,DC +Joker,bad,male,DC +Catwoman,bad,female,DC +Hellboy,good,male,Dark Horse Comics diff --git a/radiant.data/tests/testthat/data/flights.csv b/radiant.data/tests/testthat/data/flights.csv new file mode 100644 index 0000000000000000000000000000000000000000..57713e586b9c926ec37595c2c2ffaa1339f19de4 --- /dev/null +++ b/radiant.data/tests/testthat/data/flights.csv @@ -0,0 +1,3306 @@ +"year","month","day","dep_time","sched_dep_time","dep_delay","arr_time","sched_arr_time","arr_delay","carrier","flight","tailnum","origin","dest","air_time","distance","hour","minute","time_hour" +2013,1,1,820,820,0,1254,1310,-16,"B6",717,"N527JB","JFK","SJU",190,1598,8,20,2013-01-01 08:00:00 +2013,1,1,920,905,15,1039,1025,14,"B6",1305,"N346JB","JFK","IAD",52,228,9,5,2013-01-01 09:00:00 +2013,1,1,1230,1235,-5,1440,1438,2,"EV",5311,"N741EV","EWR","DTW",108,488,12,35,2013-01-01 12:00:00 +2013,1,1,1339,1335,4,1654,1631,23,"B6",431,"N510JB","LGA","SRQ",170,1047,13,35,2013-01-01 13:00:00 +2013,1,1,1342,1320,22,1617,1504,73,"EV",3832,"N13969","EWR","STL",194,872,13,20,2013-01-01 13:00:00 +2013,1,1,1552,1600,-8,1749,1757,-8,"9E",3459,"N910XJ","JFK","BNA",150,765,16,0,2013-01-01 16:00:00 +2013,1,1,1730,1730,0,2126,2110,16,"B6",179,"N618JB","JFK","PHX",323,2153,17,30,2013-01-01 17:00:00 +2013,1,1,1807,1738,29,2251,2103,NA,"UA",1228,"N31412","EWR","SAN",NA,2425,17,38,2013-01-01 17:00:00 +2013,1,1,2229,2159,30,149,100,49,"B6",11,"N531JB","JFK","FLL",153,1069,21,59,2013-01-01 21:00:00 +2013,1,2,807,810,-3,1133,1129,4,"DL",1271,"N322US","JFK","FLL",170,1069,8,10,2013-01-02 08:00:00 +2013,1,2,857,900,-3,1130,1227,-57,"DL",120,"N710TW","JFK","LAX",310,2475,9,0,2013-01-02 09:00:00 +2013,1,2,928,905,23,1331,1229,62,"B6",1061,"N184JB","JFK","AUS",251,1521,9,5,2013-01-02 09:00:00 +2013,1,2,944,929,15,1054,1042,12,"EV",4636,"N13969","EWR","DCA",45,199,9,29,2013-01-02 09:00:00 +2013,1,2,1101,1100,1,1201,1215,-14,"WN",3094,"N701GS","LGA","BWI",35,185,11,0,2013-01-02 11:00:00 +2013,1,2,1124,1130,-6,1340,1332,8,"US",1085,"N162UW","LGA","CLT",104,544,11,30,2013-01-02 11:00:00 +2013,1,2,1137,1140,-3,1442,1451,-9,"DL",2175,"N997DL","LGA","PBI",148,1035,11,40,2013-01-02 11:00:00 +2013,1,2,1156,1200,-4,1254,1320,-26,"UA",1248,"N76523","EWR","BOS",36,200,12,0,2013-01-02 12:00:00 +2013,1,2,1159,1200,-1,1408,1356,12,"US",1443,"N764US","JFK","CLT",110,541,12,0,2013-01-02 12:00:00 +2013,1,2,1343,1345,-2,1702,1646,16,"DL",1685,"N362NW","LGA","MCO",150,950,13,45,2013-01-02 13:00:00 +2013,1,2,1646,1650,-4,1810,1820,-10,"AA",1790,"N3HPAA","JFK","BOS",45,187,16,50,2013-01-02 16:00:00 +2013,1,2,1753,1700,53,2052,2014,38,"B6",15,"N339JB","JFK","FLL",159,1069,17,0,2013-01-02 17:00:00 +2013,1,2,1810,1730,40,2145,2110,35,"B6",179,"N809JB","JFK","PHX",299,2153,17,30,2013-01-02 17:00:00 +2013,1,2,1934,1745,109,2302,2106,116,"DL",1433,"N369NW","LGA","RSW",178,1080,17,45,2013-01-02 17:00:00 +2013,1,3,859,820,39,1011,939,32,"9E",4051,"N8611A","JFK","BWI",41,184,8,20,2013-01-03 08:00:00 +2013,1,3,1021,1025,-4,1207,1231,-24,"EV",5026,"N719EV","EWR","DTW",86,488,10,25,2013-01-03 10:00:00 +2013,1,3,1125,1130,-5,1422,1430,-8,"DL",695,"N938DL","JFK","MCO",153,944,11,30,2013-01-03 11:00:00 +2013,1,3,1249,1251,-2,1554,1602,-8,"UA",428,"N433UA","LGA","IAH",221,1416,12,51,2013-01-03 12:00:00 +2013,1,3,1306,1259,7,1502,1502,0,"US",1459,"N539UW","LGA","CLT",93,544,12,59,2013-01-03 12:00:00 +2013,1,3,1454,1455,-1,1836,1805,31,"UA",473,"N445UA","EWR","FLL",179,1065,14,55,2013-01-03 14:00:00 +2013,1,3,1605,1600,5,1904,1820,44,"FL",620,"N893AT","LGA","ATL",145,762,16,0,2013-01-03 16:00:00 +2013,1,3,1728,1729,-1,1900,1902,-2,"EV",4480,"N12126","EWR","PIT",62,319,17,29,2013-01-03 17:00:00 +2013,1,3,1904,1659,125,2327,2046,NA,"9E",3375,"N916XJ","JFK","SAT",NA,1587,16,59,2013-01-03 16:00:00 +2013,1,3,1950,1845,65,2228,2227,1,"B6",91,"N636JB","JFK","OAK",319,2576,18,45,2013-01-03 18:00:00 +2013,1,3,2114,2100,14,49,31,18,"DL",2363,"N718TW","JFK","LAX",347,2475,21,0,2013-01-03 21:00:00 +2013,1,4,559,600,-1,902,925,-23,"UA",303,"N557UA","JFK","SFO",334,2586,6,0,2013-01-04 06:00:00 +2013,1,4,917,920,-3,1228,1240,-12,"AA",1589,"N544AA","EWR","DFW",208,1372,9,20,2013-01-04 09:00:00 +2013,1,4,1047,1050,-3,1216,1227,-11,"EV",4662,"N12540","EWR","RDU",74,416,10,50,2013-01-04 10:00:00 +2013,1,4,1243,1240,3,1443,1445,-2,"DL",1131,"N334NB","LGA","DTW",83,502,12,40,2013-01-04 12:00:00 +2013,1,4,1324,1300,24,1621,1610,11,"WN",2596,"N286WN","EWR","HOU",222,1411,13,0,2013-01-04 13:00:00 +2013,1,4,1643,1605,38,1926,1925,1,"9E",3325,"N905XJ","JFK","DFW",208,1391,16,5,2013-01-04 16:00:00 +2013,1,4,1822,1722,60,1954,1844,70,"EV",4300,"N11565","EWR","RIC",52,277,17,22,2013-01-04 17:00:00 +2013,1,4,2019,2030,-11,2254,2334,-40,"UA",771,"N557UA","JFK","LAX",312,2475,20,30,2013-01-04 20:00:00 +2013,1,4,2117,2118,-1,2221,2217,4,"EV",4404,"N15983","EWR","PVD",32,160,21,18,2013-01-04 21:00:00 +2013,1,5,37,2230,127,341,131,130,"B6",11,"N527JB","JFK","FLL",163,1069,22,30,2013-01-05 22:00:00 +2013,1,5,611,600,11,909,912,-3,"UA",549,"N425UA","EWR","RSW",164,1068,6,0,2013-01-05 06:00:00 +2013,1,5,914,903,11,1032,1051,-19,"UA",317,"N408UA","EWR","ORD",119,719,9,3,2013-01-05 09:00:00 +2013,1,5,1105,1059,6,1411,1413,-2,"UA",1606,"N37427","EWR","RSW",161,1068,10,59,2013-01-05 10:00:00 +2013,1,5,1315,1255,20,1606,1549,17,"B6",991,"N249JB","JFK","PBI",155,1028,12,55,2013-01-05 12:00:00 +2013,1,5,1325,1330,-5,1640,1645,-5,"AA",753,"N466AA","LGA","DFW",233,1389,13,30,2013-01-05 13:00:00 +2013,1,5,1450,1450,0,1630,1640,-10,"MQ",4403,"N853MQ","JFK","RDU",72,427,14,50,2013-01-05 14:00:00 +2013,1,5,1758,1759,-1,1908,1912,-4,"EV",4509,"N13133","EWR","PWM",48,284,17,59,2013-01-05 17:00:00 +2013,1,5,1759,1810,-11,1942,1945,-3,"MQ",4484,"N723MQ","LGA","BNA",145,764,18,10,2013-01-05 18:00:00 +2013,1,5,1953,2000,-7,2158,2222,-24,"9E",3439,"N604LR","JFK","CVG",105,589,20,0,2013-01-05 20:00:00 +2013,1,5,1956,2000,-4,2227,2235,-8,"MQ",4662,"N507MQ","LGA","ATL",121,762,20,0,2013-01-05 20:00:00 +2013,1,5,2016,1940,36,2308,2241,27,"B6",381,"N624JB","LGA","FLL",158,1076,19,40,2013-01-05 19:00:00 +2013,1,6,721,721,0,1023,1012,11,"B6",987,"N657JB","JFK","MCO",148,944,7,21,2013-01-06 07:00:00 +2013,1,6,749,737,12,1113,1113,0,"B6",643,"N705JB","JFK","SFO",358,2586,7,37,2013-01-06 07:00:00 +2013,1,6,825,825,0,1058,1024,34,"US",487,"N650AW","JFK","CLT",99,541,8,25,2013-01-06 08:00:00 +2013,1,6,958,1000,-2,1244,1255,-11,"DL",1529,"N618DL","JFK","LAS",310,2248,10,0,2013-01-06 10:00:00 +2013,1,6,1029,1020,9,1330,1330,0,"AA",731,"N3JRAA","LGA","DFW",211,1389,10,20,2013-01-06 10:00:00 +2013,1,6,1139,1140,-1,1510,1445,25,"AA",1623,"N3GBAA","EWR","MIA",172,1085,11,40,2013-01-06 11:00:00 +2013,1,6,1454,1500,-6,1637,1655,-18,"MQ",4429,"N719MQ","LGA","CMH",87,479,15,0,2013-01-06 15:00:00 +2013,1,6,1457,1355,62,1829,1709,80,"B6",83,"N519JB","JFK","SEA",351,2422,13,55,2013-01-06 13:00:00 +2013,1,6,1750,1745,5,2115,2117,-2,"DL",1394,"N3744F","JFK","PDX",351,2454,17,45,2013-01-06 17:00:00 +2013,1,6,2110,2100,10,2212,2220,-8,"MQ",3744,"N512MQ","EWR","ORD",106,719,21,0,2013-01-06 21:00:00 +2013,1,6,2300,2245,15,14,2356,18,"B6",608,"N281JB","JFK","PWM",45,273,22,45,2013-01-06 22:00:00 +2013,1,7,625,634,-9,928,935,-7,"UA",772,"N571UA","EWR","MIA",158,1085,6,34,2013-01-07 06:00:00 +2013,1,7,1050,1042,8,1213,1206,7,"EV",4694,"N13955","EWR","MKE",117,725,10,42,2013-01-07 10:00:00 +2013,1,7,1051,1055,-4,1345,1405,-20,"AA",739,"N3JSAA","LGA","DFW",199,1389,10,55,2013-01-07 10:00:00 +2013,1,7,1545,1545,0,1830,1910,-40,"AA",133,"N338AA","JFK","LAX",322,2475,15,45,2013-01-07 15:00:00 +2013,1,7,1556,1600,-4,1854,1840,14,"DL",847,"N6712B","LGA","ATL",114,762,16,0,2013-01-07 16:00:00 +2013,1,7,1634,1635,-1,1753,1810,-17,"MQ",3695,"N510MQ","EWR","ORD",112,719,16,35,2013-01-07 16:00:00 +2013,1,7,1821,1830,-9,2024,2044,-20,"EV",5203,"N391CA","EWR","DTW",88,488,18,30,2013-01-07 18:00:00 +2013,1,8,711,705,6,1007,1035,-28,"VX",399,"N837VA","JFK","LAX",334,2475,7,5,2013-01-08 07:00:00 +2013,1,8,740,745,-5,905,923,-18,"UA",1162,"N37293","EWR","ORD",118,719,7,45,2013-01-08 07:00:00 +2013,1,8,912,845,27,1049,1006,43,"EV",4112,"N12921","EWR","RIC",57,277,8,45,2013-01-08 08:00:00 +2013,1,8,1019,1025,-6,1153,1231,-38,"EV",5026,"N724EV","EWR","DTW",81,488,10,25,2013-01-08 10:00:00 +2013,1,8,1154,1155,-1,1301,1304,-3,"9E",3483,"N906XJ","JFK","BOS",39,187,11,55,2013-01-08 11:00:00 +2013,1,8,1503,1510,-7,1703,1710,-7,"MQ",4579,"N523MQ","LGA","CLT",87,544,15,10,2013-01-08 15:00:00 +2013,1,8,1603,1610,-7,1753,1756,-3,"EV",5486,"N600QX","LGA","PIT",62,335,16,10,2013-01-08 16:00:00 +2013,1,8,1635,1645,-10,1842,1906,-24,"9E",4027,"N8944B","EWR","CVG",101,569,16,45,2013-01-08 16:00:00 +2013,1,8,1722,1710,12,2043,2036,7,"UA",1418,"N48127","EWR","SFO",354,2565,17,10,2013-01-08 17:00:00 +2013,1,8,1756,1759,-3,2033,2014,19,"EV",4397,"N14204","EWR","MCI",186,1092,17,59,2013-01-08 17:00:00 +2013,1,9,2,2359,3,432,444,-12,"B6",739,"N603JB","JFK","PSE",193,1617,23,59,2013-01-09 23:00:00 +2013,1,9,655,700,-5,938,957,-19,"B6",203,"N618JB","JFK","LAS",318,2248,7,0,2013-01-09 07:00:00 +2013,1,9,805,810,-5,1013,1007,6,"EV",4537,"N14902","EWR","MEM",169,946,8,10,2013-01-09 08:00:00 +2013,1,9,831,830,1,1206,1154,12,"UA",112,"N14107","JFK","LAX",351,2475,8,30,2013-01-09 08:00:00 +2013,1,9,836,845,-9,1019,1006,13,"EV",4112,"N13553","EWR","RIC",64,277,8,45,2013-01-09 08:00:00 +2013,1,9,1153,1200,-7,1414,1432,-18,"EV",4090,"N12922","EWR","JAX",125,820,12,0,2013-01-09 12:00:00 +2013,1,9,1427,1430,-3,1634,1637,-3,"EV",4687,"N15574","EWR","CVG",110,569,14,30,2013-01-09 14:00:00 +2013,1,9,1510,1509,1,1739,1741,-2,"EV",3817,"N16559","EWR","JAX",129,820,15,9,2013-01-09 15:00:00 +2013,1,9,1732,1710,22,1928,1912,16,"US",894,"N188US","LGA","CLT",86,544,17,10,2013-01-09 17:00:00 +2013,1,9,1802,1645,77,2005,1853,72,"EV",4997,"N614QX","EWR","DTW",85,488,16,45,2013-01-09 16:00:00 +2013,1,9,1812,1815,-3,2035,2026,9,"DL",2019,"N374NW","LGA","MSP",176,1020,18,15,2013-01-09 18:00:00 +2013,1,10,855,900,-5,1213,1216,-3,"UA",1405,"N27724","LGA","IAH",212,1416,9,0,2013-01-10 09:00:00 +2013,1,10,1309,1300,9,1602,1606,-4,"B6",85,"N659JB","JFK","FLL",149,1069,13,0,2013-01-10 13:00:00 +2013,1,10,1710,1715,-5,2010,2019,-9,"DL",1585,"N949DL","LGA","MCO",136,950,17,15,2013-01-10 17:00:00 +2013,1,10,1738,1745,-7,1939,1953,-14,"DL",2331,"N909DE","LGA","DTW",84,502,17,45,2013-01-10 17:00:00 +2013,1,10,1853,1900,-7,2002,2015,-13,"US",2187,"N749US","LGA","DCA",46,214,19,0,2013-01-10 19:00:00 +2013,1,10,1941,1940,1,2231,2249,-18,"B6",381,"N653JB","LGA","FLL",146,1076,19,40,2013-01-10 19:00:00 +2013,1,10,2006,1935,31,2147,2145,2,"9E",3899,"N8907A","JFK","CLE",73,425,19,35,2013-01-10 19:00:00 +2013,1,10,2109,2029,40,2219,2140,39,"9E",3609,"N800AY","JFK","PHL",25,94,20,29,2013-01-10 20:00:00 +2013,1,11,625,633,-8,758,813,-15,"EV",4424,"N14543","EWR","RDU",72,416,6,33,2013-01-11 06:00:00 +2013,1,11,713,720,-7,854,845,9,"FL",850,"N956AT","LGA","MKE",132,738,7,20,2013-01-11 07:00:00 +2013,1,11,717,720,-3,1010,1023,-13,"UA",1724,"N76254","EWR","PBI",145,1023,7,20,2013-01-11 07:00:00 +2013,1,11,1156,1200,-4,1414,1432,-18,"EV",4090,"N14148","EWR","JAX",116,820,12,0,2013-01-11 12:00:00 +2013,1,11,1157,1205,-8,1449,1520,-31,"AA",743,"N494AA","LGA","DFW",205,1389,12,5,2013-01-11 12:00:00 +2013,1,11,1411,1420,-9,1602,1620,-18,"MQ",4588,"N3AEMQ","LGA","MSP",150,1020,14,20,2013-01-11 14:00:00 +2013,1,11,1657,1700,-3,1928,1943,-15,"DL",1499,"N638DL","LGA","ATL",107,762,17,0,2013-01-11 17:00:00 +2013,1,11,1736,1700,36,1916,1849,27,"EV",4202,"N16546","EWR","STL",133,872,17,0,2013-01-11 17:00:00 +2013,1,11,1952,1947,5,2105,2112,-7,"EV",4412,"N26549","EWR","BUF",52,282,19,47,2013-01-11 19:00:00 +2013,1,11,2057,2100,-3,2218,2225,-7,"WN",530,"N707SA","LGA","MDW",115,725,21,0,2013-01-11 21:00:00 +2013,1,11,2108,2005,63,2309,2204,65,"EV",4133,"N11565","EWR","GSP",95,594,20,5,2013-01-11 20:00:00 +2013,1,12,556,600,-4,708,709,-1,"B6",380,"N266JB","EWR","BOS",43,200,6,0,2013-01-12 06:00:00 +2013,1,12,610,600,10,749,759,-10,"EV",4911,"N738EV","EWR","DTW",78,488,6,0,2013-01-12 06:00:00 +2013,1,12,623,630,-7,756,810,-14,"B6",905,"N296JB","JFK","ORD",120,740,6,30,2013-01-12 06:00:00 +2013,1,12,837,840,-3,1149,1152,-3,"UA",1506,"N77431","EWR","SAN",343,2425,8,40,2013-01-12 08:00:00 +2013,1,12,1559,1550,9,1811,1825,-14,"9E",3427,"N605LR","JFK","IND",99,665,15,50,2013-01-12 15:00:00 +2013,1,12,1613,1548,25,1917,1925,-8,"DL",1773,"N3750D","JFK","SLC",279,1990,15,48,2013-01-12 15:00:00 +2013,1,12,1856,1900,-4,2050,2056,-6,"9E",3368,"N913XJ","JFK","PIT",63,340,19,0,2013-01-12 19:00:00 +2013,1,12,1931,1930,1,2119,2149,-30,"9E",3798,"N8495B","JFK","CLT",82,541,19,30,2013-01-12 19:00:00 +2013,1,12,1939,1940,-1,2113,2125,-12,"MQ",3783,"N532MQ","JFK","CMH",74,483,19,40,2013-01-12 19:00:00 +2013,1,13,550,600,-10,826,859,-33,"B6",507,"N594JB","EWR","FLL",139,1065,6,0,2013-01-13 06:00:00 +2013,1,13,839,840,-1,1142,1151,-9,"UA",1626,"N73291","EWR","SAN",345,2425,8,40,2013-01-13 08:00:00 +2013,1,13,855,855,0,1041,1101,-20,"EV",4383,"N11181","EWR","DTW",85,488,8,55,2013-01-13 08:00:00 +2013,1,13,1018,1020,-2,1333,1330,3,"AA",731,"N598AA","LGA","DFW",220,1389,10,20,2013-01-13 10:00:00 +2013,1,13,1721,1600,81,2035,1912,83,"UA",1200,"N14219","EWR","SAN",352,2425,16,0,2013-01-13 16:00:00 +2013,1,13,1813,1815,-2,2036,1958,38,"9E",4019,"N8432A","JFK","RIC",55,288,18,15,2013-01-13 18:00:00 +2013,1,13,1916,1920,-4,2300,2246,14,"DL",83,"N399DA","JFK","FLL",144,1069,19,20,2013-01-13 19:00:00 +2013,1,13,1940,1729,131,2150,1935,135,"EV",4382,"N14179","EWR","DTW",86,488,17,29,2013-01-13 17:00:00 +2013,1,13,2202,2110,52,58,2355,63,"B6",529,"N561JB","EWR","MCO",131,937,21,10,2013-01-13 21:00:00 +2013,1,14,555,600,-5,908,912,-4,"B6",135,"N565JB","JFK","RSW",170,1074,6,0,2013-01-14 06:00:00 +2013,1,14,825,820,5,957,958,-1,"9E",3317,"N920XJ","JFK","BUF",58,301,8,20,2013-01-14 08:00:00 +2013,1,14,858,900,-2,1046,1048,-2,"UA",225,"N574UA","EWR","ORD",133,719,9,0,2013-01-14 09:00:00 +2013,1,14,1151,1155,-4,1248,1304,-16,"9E",3483,"N602LR","JFK","BOS",40,187,11,55,2013-01-14 11:00:00 +2013,1,14,1232,1240,-8,1551,1540,11,"AA",1853,"N4WPAA","EWR","DFW",237,1372,12,40,2013-01-14 12:00:00 +2013,1,14,1358,1359,-1,1523,1534,-11,"UA",1734,"N24224","EWR","ORD",128,719,13,59,2013-01-14 13:00:00 +2013,1,14,1443,1452,-9,1654,1655,-1,"DL",1231,"N950DL","LGA","DTW",94,502,14,52,2013-01-14 14:00:00 +2013,1,14,1538,1545,-7,1739,1744,-5,"UA",1710,"N15712","LGA","CLE",75,419,15,45,2013-01-14 15:00:00 +2013,1,14,1751,1800,-9,1857,1910,-13,"WN",808,"N281WN","EWR","BWI",37,169,18,0,2013-01-14 18:00:00 +2013,1,14,1907,1915,-8,2202,2230,-28,"DL",1729,"N3766","JFK","LAS",327,2248,19,15,2013-01-14 19:00:00 +2013,1,14,1953,2000,-7,2248,2312,-24,"B6",801,"N653JB","JFK","FLL",147,1069,20,0,2013-01-14 20:00:00 +2013,1,15,603,610,-7,852,902,-10,"B6",145,"N705JB","JFK","PBI",145,1028,6,10,2013-01-15 06:00:00 +2013,1,15,834,840,-6,958,1012,-14,"EV",4413,"N23139","EWR","PIT",62,319,8,40,2013-01-15 08:00:00 +2013,1,15,855,900,-5,1055,1048,7,"UA",385,"N819UA","EWR","ORD",151,719,9,0,2013-01-15 09:00:00 +2013,1,15,1445,1445,0,1558,1606,-8,"9E",3452,"N905XJ","JFK","BOS",33,187,14,45,2013-01-15 14:00:00 +2013,1,15,1550,1550,0,1820,1826,-6,"9E",3427,"N919XJ","JFK","IND",118,665,15,50,2013-01-15 15:00:00 +2013,1,15,1736,1735,1,1927,1922,5,"B6",1111,"N192JB","JFK","RDU",86,427,17,35,2013-01-15 17:00:00 +2013,1,15,1842,1846,-4,2009,2019,-10,"B6",130,"N206JB","JFK","BUF",66,301,18,46,2013-01-15 18:00:00 +2013,1,15,1857,1904,-7,2029,2026,3,"EV",4131,"N11189","EWR","RIC",56,277,19,4,2013-01-15 19:00:00 +2013,1,15,NA,1330,NA,NA,1640,NA,"AA",753,"N3BWAA","LGA","DFW",NA,1389,13,30,2013-01-15 13:00:00 +2013,1,16,623,630,-7,849,831,18,"US",1125,"N108UW","EWR","CLT",100,529,6,30,2013-01-16 06:00:00 +2013,1,16,754,800,-6,938,917,21,"US",2165,"N715UW","LGA","DCA",70,214,8,0,2013-01-16 08:00:00 +2013,1,16,853,900,-7,1015,1022,-7,"US",2167,"N765US","LGA","DCA",48,214,9,0,2013-01-16 09:00:00 +2013,1,16,857,850,7,1216,1113,63,"EV",4125,"N17169","EWR","XNA",214,1131,8,50,2013-01-16 08:00:00 +2013,1,16,1127,1130,-3,1352,1334,18,"US",1625,"N543UW","LGA","CLT",110,544,11,30,2013-01-16 11:00:00 +2013,1,16,1223,1056,87,1324,1208,76,"UA",1047,"N12218","EWR","BOS",34,200,10,56,2013-01-16 10:00:00 +2013,1,16,1428,1425,3,1635,1630,5,"EV",5164,"N614QX","EWR","MSP",171,1008,14,25,2013-01-16 14:00:00 +2013,1,16,1439,1420,19,1656,1620,36,"MQ",4588,"N504MQ","LGA","MSP",169,1020,14,20,2013-01-16 14:00:00 +2013,1,16,1500,1500,0,1743,1742,1,"DL",2347,"N616DL","LGA","ATL",123,762,15,0,2013-01-16 15:00:00 +2013,1,16,1556,1600,-4,1835,1834,1,"FL",620,"N959AT","LGA","ATL",136,762,16,0,2013-01-16 16:00:00 +2013,1,16,1715,1600,75,2024,1915,69,"AA",565,"N3FAAA","JFK","DFW",226,1391,16,0,2013-01-16 16:00:00 +2013,1,16,1717,1640,37,1928,1835,53,"WN",372,"N402WN","LGA","STL",167,888,16,40,2013-01-16 16:00:00 +2013,1,16,1931,1830,61,2103,2015,48,"MQ",4674,"N530MQ","LGA","CLE",77,419,18,30,2013-01-16 18:00:00 +2013,1,17,756,633,83,949,813,96,"EV",4424,"N11547","EWR","RDU",85,416,6,33,2013-01-17 06:00:00 +2013,1,17,951,958,-7,1144,1137,7,"UA",258,"N455UA","LGA","ORD",139,733,9,58,2013-01-17 09:00:00 +2013,1,17,1432,1440,-8,1545,1557,-12,"EV",4113,"N14568","EWR","IAD",58,212,14,40,2013-01-17 14:00:00 +2013,1,17,1835,1840,-5,2037,2049,-12,"DL",2131,"N353NW","LGA","DTW",92,502,18,40,2013-01-17 18:00:00 +2013,1,17,1926,1930,-4,2115,2115,0,"EV",3274,"N13968","LGA","CLE",75,419,19,30,2013-01-17 19:00:00 +2013,1,18,601,610,-9,821,818,3,"EV",4941,"N753EV","EWR","MSP",171,1008,6,10,2013-01-18 06:00:00 +2013,1,18,1233,1235,-2,1527,1535,-8,"UA",1000,"N78506","EWR","MIA",152,1085,12,35,2013-01-18 12:00:00 +2013,1,18,1253,1300,-7,1357,1407,-10,"US",2175,"N746UW","LGA","DCA",40,214,13,0,2013-01-18 13:00:00 +2013,1,18,1258,1259,-1,1527,1456,31,"US",1459,"N561UW","LGA","CLT",106,544,12,59,2013-01-18 12:00:00 +2013,1,18,1413,1420,-7,1621,1620,1,"MQ",4588,"N525MQ","LGA","MSP",159,1020,14,20,2013-01-18 14:00:00 +2013,1,18,2006,2015,-9,2223,2210,13,"MQ",4555,"N711MQ","LGA","CMH",80,479,20,15,2013-01-18 20:00:00 +2013,1,19,805,810,-5,910,925,-15,"AA",1838,"N3EDAA","JFK","BOS",40,187,8,10,2013-01-19 08:00:00 +2013,1,19,812,815,-3,941,957,-16,"9E",3521,"N936XJ","JFK","ORD",128,740,8,15,2013-01-19 08:00:00 +2013,1,19,856,905,-9,1207,1235,-28,"VX",407,"N630VA","JFK","LAX",338,2475,9,5,2013-01-19 09:00:00 +2013,1,19,913,920,-7,1415,1448,-33,"DL",675,"N707TW","JFK","STT",198,1623,9,20,2013-01-19 09:00:00 +2013,1,19,1052,1059,-7,1158,1207,-9,"EV",4456,"N13124","EWR","BOS",46,200,10,59,2013-01-19 10:00:00 +2013,1,19,1242,1250,-8,1527,1550,-23,"DL",1685,"N335NW","LGA","MCO",142,950,12,50,2013-01-19 12:00:00 +2013,1,19,1441,1443,-2,1736,1755,-19,"UA",1587,"N33284","EWR","RSW",164,1068,14,43,2013-01-19 14:00:00 +2013,1,19,1739,1718,21,1852,1840,12,"EV",4300,"N15980","EWR","RIC",49,277,17,18,2013-01-19 17:00:00 +2013,1,19,1856,1859,-3,2049,2104,-15,"EV",4700,"N29917","EWR","CLT",88,529,18,59,2013-01-19 18:00:00 +2013,1,20,649,649,0,931,912,19,"UA",311,"N495UA","EWR","DEN",249,1605,6,49,2013-01-20 06:00:00 +2013,1,20,705,709,-4,1017,1021,-4,"UA",1525,"N38459","EWR","RSW",172,1068,7,9,2013-01-20 07:00:00 +2013,1,20,854,857,-3,1148,1207,-19,"UA",1110,"N24715","EWR","IAH",210,1400,8,57,2013-01-20 08:00:00 +2013,1,20,1250,1230,20,1406,1405,1,"WN",283,"N286WN","LGA","MKE",123,738,12,30,2013-01-20 12:00:00 +2013,1,20,2129,2130,-1,9,2,7,"B6",97,"N663JB","JFK","DEN",253,1626,21,30,2013-01-20 21:00:00 +2013,1,20,2323,2159,84,26,2315,71,"EV",4162,"N14977","EWR","BTV",45,266,21,59,2013-01-20 21:00:00 +2013,1,21,631,635,-4,927,939,-12,"UA",1627,"N27724","EWR","PBI",158,1023,6,35,2013-01-21 06:00:00 +2013,1,21,653,700,-7,1008,1014,-6,"DL",1879,"N373NW","LGA","FLL",171,1076,7,0,2013-01-21 07:00:00 +2013,1,21,840,840,0,932,959,-27,"UA",1289,"N76528","EWR","BOS",35,200,8,40,2013-01-21 08:00:00 +2013,1,21,2023,2000,23,2349,2312,37,"B6",801,"N516JB","JFK","FLL",167,1069,20,0,2013-01-21 20:00:00 +2013,1,21,2038,2042,-4,2230,2231,-1,"EV",3833,"N11539","EWR","STL",155,872,20,42,2013-01-21 20:00:00 +2013,1,21,2102,2029,33,2305,2233,32,"EV",4348,"N17185","EWR","MSP",154,1008,20,29,2013-01-21 20:00:00 +2013,1,22,559,600,-1,917,859,18,"B6",507,"N519JB","EWR","FLL",168,1065,6,0,2013-01-22 06:00:00 +2013,1,22,708,715,-7,1031,1035,-4,"AA",825,"N3EPAA","JFK","FLL",178,1069,7,15,2013-01-22 07:00:00 +2013,1,22,1344,1345,-1,1620,1649,-29,"UA",164,"N37298","EWR","IAH",203,1400,13,45,2013-01-22 13:00:00 +2013,1,22,1520,1510,10,1741,1710,31,"MQ",4579,"N505MQ","LGA","CLT",97,544,15,10,2013-01-22 15:00:00 +2013,1,22,1846,1629,137,2057,1832,145,"EV",4411,"N21144","EWR","MEM",153,946,16,29,2013-01-22 16:00:00 +2013,1,22,1916,1810,66,2101,1945,76,"MQ",4484,"N713MQ","LGA","BNA",132,764,18,10,2013-01-22 18:00:00 +2013,1,22,2021,2025,-4,2300,2331,-31,"UA",226,"N457UA","EWR","DFW",200,1372,20,25,2013-01-22 20:00:00 +2013,1,23,829,830,-1,1140,1143,-3,"UA",561,"N570UA","EWR","FLL",167,1065,8,30,2013-01-23 08:00:00 +2013,1,23,1029,1030,-1,1359,1415,-16,"VX",23,"N837VA","JFK","SFO",374,2586,10,30,2013-01-23 10:00:00 +2013,1,23,1203,1200,3,1358,1400,-2,"US",1443,"N733UW","JFK","CLT",91,541,12,0,2013-01-23 12:00:00 +2013,1,23,1352,1335,17,1651,1633,18,"B6",1161,"N613JB","LGA","PBI",152,1035,13,35,2013-01-23 13:00:00 +2013,1,23,1446,1447,-1,1640,1654,-14,"EV",4572,"N16918","EWR","GSP",97,594,14,47,2013-01-23 14:00:00 +2013,1,23,1504,1510,-6,1710,1710,0,"MQ",4579,"N500MQ","LGA","CLT",87,544,15,10,2013-01-23 15:00:00 +2013,1,23,1546,1550,-4,1832,1820,12,"9E",3355,"N932XJ","JFK","MSP",171,1029,15,50,2013-01-23 15:00:00 +2013,1,23,1855,1900,-5,2125,2134,-9,"FL",645,"N928AT","LGA","ATL",117,762,19,0,2013-01-23 19:00:00 +2013,1,24,37,2107,210,236,2322,194,"EV",3819,"N16561","EWR","SDF",104,642,21,7,2013-01-24 21:00:00 +2013,1,24,1355,1345,10,1647,1705,-18,"AA",1073,"N3AUAA","LGA","MIA",145,1096,13,45,2013-01-24 13:00:00 +2013,1,24,1704,1710,-6,2013,2015,-2,"AA",695,"N3FMAA","JFK","AUS",213,1521,17,10,2013-01-24 17:00:00 +2013,1,24,1725,1725,0,2046,2040,6,"AA",145,"N3FYAA","JFK","SAN",340,2446,17,25,2013-01-24 17:00:00 +2013,1,24,NA,600,NA,NA,801,NA,"EV",4911,"N709EV","EWR","DTW",NA,488,6,0,2013-01-24 06:00:00 +2013,1,25,1836,1710,86,2102,1912,110,"US",894,"N196UW","LGA","CLT",88,544,17,10,2013-01-25 17:00:00 +2013,1,25,1842,1830,12,2225,2202,23,"UA",272,"N525UA","JFK","SFO",355,2586,18,30,2013-01-25 18:00:00 +2013,1,25,2105,2100,5,2357,2349,8,"B6",399,"N594JB","LGA","MCO",132,950,21,0,2013-01-25 21:00:00 +2013,1,25,2203,1946,137,36,2154,162,"EV",4536,"N14993","EWR","CVG",102,569,19,46,2013-01-25 19:00:00 +2013,1,26,810,759,11,1034,1011,23,"US",1733,"N561UW","LGA","CLT",104,544,7,59,2013-01-26 07:00:00 +2013,1,26,821,810,11,1339,1315,24,"AA",655,"N5EYAA","JFK","STT",201,1623,8,10,2013-01-26 08:00:00 +2013,1,26,851,845,6,1343,1350,-7,"AA",1357,"N5FMAA","JFK","SJU",199,1598,8,45,2013-01-26 08:00:00 +2013,1,26,919,920,-1,1114,1125,-11,"MQ",4582,"N521MQ","LGA","CLT",92,544,9,20,2013-01-26 09:00:00 +2013,1,26,1411,1415,-4,1506,1526,-20,"B6",1010,"N184JB","JFK","BOS",36,187,14,15,2013-01-26 14:00:00 +2013,1,26,1738,1720,18,1905,1905,0,"MQ",4479,"N739MQ","LGA","RDU",70,431,17,20,2013-01-26 17:00:00 +2013,1,27,729,731,-2,1047,1045,2,"B6",1601,"N585JB","LGA","RSW",164,1080,7,31,2013-01-27 07:00:00 +2013,1,27,837,830,7,1019,1013,6,"EV",3815,"N12552","EWR","GSO",71,445,8,30,2013-01-27 08:00:00 +2013,1,27,1152,1200,-8,1253,1315,-22,"MQ",4425,"N855MQ","JFK","DCA",51,213,12,0,2013-01-27 12:00:00 +2013,1,27,1253,1300,-7,1516,1529,-13,"EV",4950,"N709EV","EWR","ATL",111,746,13,0,2013-01-27 13:00:00 +2013,1,27,1306,1300,6,1554,1610,-16,"WN",2239,"N466WN","EWR","HOU",211,1411,13,0,2013-01-27 13:00:00 +2013,1,27,1449,1455,-6,1821,1825,-4,"AA",1769,"N5EXAA","JFK","MIA",147,1089,14,55,2013-01-27 14:00:00 +2013,1,27,1635,1610,25,1837,1800,37,"AA",341,"N492AA","LGA","ORD",138,733,16,10,2013-01-27 16:00:00 +2013,1,27,1648,1655,-7,2004,2015,-11,"B6",359,"N566JB","JFK","BUR",362,2465,16,55,2013-01-27 16:00:00 +2013,1,27,1855,1900,-5,2036,2057,-21,"9E",3368,"N908XJ","JFK","PIT",73,340,19,0,2013-01-27 19:00:00 +2013,1,28,629,630,-1,812,810,2,"B6",905,"N324JB","JFK","ORD",134,740,6,30,2013-01-28 06:00:00 +2013,1,28,657,705,-8,952,1021,-29,"B6",981,"N649JB","JFK","FLL",149,1069,7,5,2013-01-28 07:00:00 +2013,1,28,1617,1625,-8,1852,1855,-3,"MQ",4661,"N3AEMQ","LGA","ATL",119,762,16,25,2013-01-28 16:00:00 +2013,1,28,1656,1700,-4,2014,2049,-35,"DL",31,"N727TW","JFK","SFO",359,2586,17,0,2013-01-28 17:00:00 +2013,1,28,1823,1830,-7,2157,2205,-8,"AA",269,"N3HDAA","JFK","SEA",356,2422,18,30,2013-01-28 18:00:00 +2013,1,28,2149,2159,-10,2245,2316,-31,"DL",2155,"N369NW","LGA","PWM",42,269,21,59,2013-01-28 21:00:00 +2013,1,29,1055,1100,-5,1321,1338,-17,"DL",1647,"N669DN","LGA","ATL",120,762,11,0,2013-01-29 11:00:00 +2013,1,29,1139,1140,-1,1421,1445,-24,"AA",1623,"N3HPAA","EWR","MIA",136,1085,11,40,2013-01-29 11:00:00 +2013,1,29,1211,1212,-1,1550,1551,-1,"UA",1227,"N34460","EWR","PHX",320,2133,12,12,2013-01-29 12:00:00 +2013,1,29,1257,1300,-3,1538,1606,-28,"B6",85,"N768JB","JFK","FLL",141,1069,13,0,2013-01-29 13:00:00 +2013,1,29,1348,1350,-2,1703,1715,-12,"US",688,"N648AW","EWR","PHX",298,2133,13,50,2013-01-29 13:00:00 +2013,1,29,1452,1500,-8,1812,1837,-25,"DL",963,"N705TW","JFK","LAX",334,2475,15,0,2013-01-29 15:00:00 +2013,1,29,1454,1500,-6,1611,1608,3,"US",2132,"N958UW","LGA","BOS",44,184,15,0,2013-01-29 15:00:00 +2013,1,29,1503,1510,-7,1712,1650,22,"WN",323,"N292WN","LGA","MKE",143,738,15,10,2013-01-29 15:00:00 +2013,1,30,841,835,6,1239,1215,24,"UA",1739,"N54241","EWR","SFO",352,2565,8,35,2013-01-30 08:00:00 +2013,1,30,854,834,20,1110,1039,31,"EV",4250,"N16571","EWR","GRR",101,605,8,34,2013-01-30 08:00:00 +2013,1,30,949,630,199,1231,847,224,"EV",4393,"N12567","EWR","IND",112,645,6,30,2013-01-30 06:00:00 +2013,1,30,1222,1115,67,1402,1215,107,"OO",8500,"N978SW","LGA","ORD",132,733,11,15,2013-01-30 11:00:00 +2013,1,30,1255,1300,-5,1523,1506,17,"9E",3762,"N8980A","EWR","CVG",104,569,13,0,2013-01-30 13:00:00 +2013,1,30,1329,1259,30,1532,1456,36,"US",1459,"N183UW","LGA","CLT",96,544,12,59,2013-01-30 12:00:00 +2013,1,30,1757,1753,4,2103,2105,-2,"UA",535,"N532UA","JFK","LAX",341,2475,17,53,2013-01-30 17:00:00 +2013,1,31,703,645,18,933,920,13,"UA",338,"N448UA","LGA","DEN",224,1620,6,45,2013-01-31 06:00:00 +2013,1,31,715,720,-5,928,928,0,"DL",831,"N913DE","LGA","DTW",83,502,7,20,2013-01-31 07:00:00 +2013,1,31,900,900,0,1117,1133,-16,"UA",1643,"N17128","EWR","DEN",225,1605,9,0,2013-01-31 09:00:00 +2013,1,31,1200,1205,-5,1319,1325,-6,"WN",644,"N924WN","EWR","MDW",113,711,12,5,2013-01-31 12:00:00 +2013,1,31,1204,1200,4,1315,1309,6,"US",2173,"N757UW","LGA","DCA",54,214,12,0,2013-01-31 12:00:00 +2013,1,31,1216,1220,-4,1526,1533,-7,"B6",209,"N558JB","JFK","LGB",344,2465,12,20,2013-01-31 12:00:00 +2013,1,31,1918,1930,-12,2157,2151,6,"9E",3798,"N8924B","JFK","CLT",93,541,19,30,2013-01-31 19:00:00 +2013,1,31,1924,1925,-1,2244,2229,15,"DL",1485,"N992DL","LGA","MCO",160,950,19,25,2013-01-31 19:00:00 +2013,10,1,618,630,-12,851,919,-28,"UA",1454,"N23708","LGA","IAH",194,1416,6,30,2013-10-01 06:00:00 +2013,10,1,626,630,-4,756,805,-9,"AA",303,"N475AA","LGA","ORD",112,733,6,30,2013-10-01 06:00:00 +2013,10,1,1221,1230,-9,1350,1405,-15,"AA",329,"N489AA","LGA","ORD",117,733,12,30,2013-10-01 12:00:00 +2013,10,1,1618,1600,18,1751,1755,-4,"9E",3523,"N602LR","JFK","ORD",120,740,16,0,2013-10-01 16:00:00 +2013,10,1,1639,1640,-1,1912,1947,-35,"B6",423,"N657JB","JFK","LAX",313,2475,16,40,2013-10-01 16:00:00 +2013,10,1,1655,1700,-5,1841,1910,-29,"9E",3932,"N8696C","EWR","CVG",86,569,17,0,2013-10-01 17:00:00 +2013,10,2,819,826,-7,950,1014,-24,"EV",4537,"N11536","EWR","MEM",130,946,8,26,2013-10-02 08:00:00 +2013,10,2,858,900,-2,1207,1206,1,"UA",1581,"N39450","EWR","SEA",332,2402,9,0,2013-10-02 09:00:00 +2013,10,2,1359,1359,0,1503,1511,-8,"B6",118,"N274JB","JFK","BOS",43,187,13,59,2013-10-02 13:00:00 +2013,10,2,1425,1430,-5,1732,1742,-10,"UA",1296,"N33103","EWR","SFO",344,2565,14,30,2013-10-02 14:00:00 +2013,10,2,1729,1730,-1,2001,2017,-16,"B6",327,"N584JB","EWR","MCO",128,937,17,30,2013-10-02 17:00:00 +2013,10,2,1948,2000,-12,2125,2120,5,"US",2195,"N745VJ","LGA","DCA",39,214,20,0,2013-10-02 20:00:00 +2013,10,2,1952,2000,-8,2137,2132,5,"UA",695,"N846UA","LGA","ORD",111,733,20,0,2013-10-02 20:00:00 +2013,10,3,731,737,-6,859,915,-16,"EV",3821,"N16541","EWR","GSO",69,445,7,37,2013-10-03 07:00:00 +2013,10,3,924,933,-9,1216,1225,-9,"B6",199,"N589JB","LGA","MCO",133,950,9,33,2013-10-03 09:00:00 +2013,10,3,925,935,-10,1220,1230,-10,"B6",223,"N639JB","JFK","LAX",331,2475,9,35,2013-10-03 09:00:00 +2013,10,3,1249,1259,-10,1354,1405,-11,"B6",316,"N323JB","JFK","SYR",43,209,12,59,2013-10-03 12:00:00 +2013,10,3,1446,1444,2,1543,1624,-41,"9E",3393,"N904XJ","JFK","DCA",41,213,14,44,2013-10-03 14:00:00 +2013,10,3,1547,1550,-3,1748,1730,18,"MQ",3416,"N9EAMQ","LGA","RDU",65,431,15,50,2013-10-03 15:00:00 +2013,10,3,1621,1625,-4,1838,1831,7,"DL",2231,"N363NW","LGA","DTW",87,502,16,25,2013-10-03 16:00:00 +2013,10,3,1813,1815,-2,2138,2138,0,"DL",17,"N191DN","JFK","LAX",348,2475,18,15,2013-10-03 18:00:00 +2013,10,3,2129,2130,-1,2353,2359,-6,"B6",97,"N521JB","JFK","DEN",236,1626,21,30,2013-10-03 21:00:00 +2013,10,4,651,517,94,917,757,80,"UA",252,"N553UA","EWR","IAH",176,1400,5,17,2013-10-04 05:00:00 +2013,10,4,826,829,-3,1133,1122,11,"B6",189,"N623JB","JFK","SAN",325,2446,8,29,2013-10-04 08:00:00 +2013,10,4,1358,1400,-2,1615,1632,-17,"DL",2247,"N6707A","LGA","ATL",102,762,14,0,2013-10-04 14:00:00 +2013,10,4,1724,1735,-11,1921,1946,-25,"YV",2751,"N922FJ","LGA","CLT",81,544,17,35,2013-10-04 17:00:00 +2013,10,4,1730,1734,-4,2107,2046,21,"UA",418,"N580UA","EWR","SFO",348,2565,17,34,2013-10-04 17:00:00 +2013,10,4,1834,1820,14,2204,2124,40,"B6",1013,"N608JB","JFK","LGB",344,2465,18,20,2013-10-04 18:00:00 +2013,10,4,1837,1841,-4,1951,2010,-19,"B6",2202,"N316JB","JFK","BUF",58,301,18,41,2013-10-04 18:00:00 +2013,10,4,2242,2255,-13,2351,9,-18,"B6",486,"N206JB","JFK","ROC",50,264,22,55,2013-10-04 22:00:00 +2013,10,5,736,740,-4,1021,1035,-14,"B6",163,"N354JB","JFK","SRQ",142,1041,7,40,2013-10-05 07:00:00 +2013,10,5,1057,1105,-8,1202,1215,-13,"MQ",3230,"N508MQ","JFK","DCA",40,213,11,5,2013-10-05 11:00:00 +2013,10,5,1354,1400,-6,1636,1655,-19,"AA",1151,"N3JCAA","LGA","DFW",201,1389,14,0,2013-10-05 14:00:00 +2013,10,5,1430,1342,48,1633,1551,42,"EV",4395,"N27962","EWR","IND",97,645,13,42,2013-10-05 13:00:00 +2013,10,5,1448,1429,19,1558,1548,10,"B6",286,"N318JB","JFK","ROC",48,264,14,29,2013-10-05 14:00:00 +2013,10,5,1719,1630,49,2023,2000,23,"VX",27,"N849VA","JFK","SFO",349,2586,16,30,2013-10-05 16:00:00 +2013,10,6,700,710,-10,1004,1000,4,"AA",2493,"N5EAAA","JFK","MCO",131,944,7,10,2013-10-06 07:00:00 +2013,10,6,913,915,-2,1131,1143,-12,"EV",5109,"N709EV","LGA","CHS",92,641,9,15,2013-10-06 09:00:00 +2013,10,6,1155,1200,-5,1331,1334,-3,"EV",4188,"N15985","EWR","CLE",62,404,12,0,2013-10-06 12:00:00 +2013,10,6,1204,1205,-1,1336,1350,-14,"MQ",3404,"N832MQ","LGA","RDU",67,431,12,5,2013-10-06 12:00:00 +2013,10,6,1517,1430,47,1627,1553,34,"EV",5713,"N829AS","LGA","IAD",44,229,14,30,2013-10-06 14:00:00 +2013,10,6,1553,1555,-2,1714,1730,-16,"WN",134,"N728SW","LGA","BNA",118,764,15,55,2013-10-06 15:00:00 +2013,10,6,1805,1714,51,1947,1839,68,"B6",918,"N339JB","JFK","BOS",33,187,17,14,2013-10-06 17:00:00 +2013,10,6,1833,1830,3,2111,2112,-1,"B6",711,"N598JB","JFK","LAS",287,2248,18,30,2013-10-06 18:00:00 +2013,10,6,1900,1905,-5,2148,2205,-17,"AA",1691,"N594AA","EWR","DFW",191,1372,19,5,2013-10-06 19:00:00 +2013,10,6,2152,2159,-7,2259,2308,-9,"9E",3525,"N605LR","LGA","SYR",37,198,21,59,2013-10-06 21:00:00 +2013,10,7,800,805,-5,1057,1123,-26,"DL",1271,"N907DL","JFK","FLL",149,1069,8,5,2013-10-07 08:00:00 +2013,10,7,912,915,-3,1138,1154,-16,"EV",5211,"N398CA","LGA","SAV",106,722,9,15,2013-10-07 09:00:00 +2013,10,7,950,1000,-10,1140,1130,10,"EV",5736,"N828AS","LGA","IAD",50,229,10,0,2013-10-07 10:00:00 +2013,10,7,1053,1031,22,1257,1240,17,"EV",4632,"N11119","EWR","OMA",161,1134,10,31,2013-10-07 10:00:00 +2013,10,7,1403,1355,8,1652,1639,13,"UA",431,"N834UA","EWR","DFW",200,1372,13,55,2013-10-07 13:00:00 +2013,10,7,1443,1456,-13,1629,1641,-12,"9E",3846,"N8390A","JFK","ORF",69,290,14,56,2013-10-07 14:00:00 +2013,10,7,1520,1521,-1,1900,1819,41,"UA",1554,"N19136","EWR","LAX",327,2454,15,21,2013-10-07 15:00:00 +2013,10,7,1701,1529,92,2010,1847,83,"UA",1246,"N76269","EWR","SFO",346,2565,15,29,2013-10-07 15:00:00 +2013,10,7,1848,1800,48,2007,1920,47,"WN",318,"N475WN","EWR","MDW",111,711,18,0,2013-10-07 18:00:00 +2013,10,7,2108,1755,193,2340,2055,165,"AA",1185,"N3FRAA","LGA","DFW",188,1389,17,55,2013-10-07 17:00:00 +2013,10,7,NA,1700,NA,NA,1817,NA,"US",2189,NA,"LGA","DCA",NA,214,17,0,2013-10-07 17:00:00 +2013,10,8,822,825,-3,1120,1148,-28,"UA",397,"N597UA","JFK","SFO",339,2586,8,25,2013-10-08 08:00:00 +2013,10,8,1022,1031,-9,1214,1240,-26,"EV",4632,"N17115","EWR","OMA",151,1134,10,31,2013-10-08 10:00:00 +2013,10,8,1044,959,45,1227,1144,43,"AA",1030,"N566AA","LGA","STL",122,888,9,59,2013-10-08 09:00:00 +2013,10,8,1129,1135,-6,1336,1343,-7,"DL",2219,"N949DL","LGA","MSP",147,1020,11,35,2013-10-08 11:00:00 +2013,10,8,1245,1245,0,1545,1600,-15,"AA",1697,"N631AA","JFK","MIA",159,1089,12,45,2013-10-08 12:00:00 +2013,10,8,1437,1429,8,1543,1548,-5,"B6",286,"N318JB","JFK","ROC",48,264,14,29,2013-10-08 14:00:00 +2013,10,8,1445,1445,0,1743,1758,-15,"UA",841,"N512UA","JFK","LAX",330,2475,14,45,2013-10-08 14:00:00 +2013,10,8,1725,1730,-5,1934,1953,-19,"EV",5298,"N608QX","LGA","OMA",151,1148,17,30,2013-10-08 17:00:00 +2013,10,9,625,630,-5,721,742,-21,"UA",1686,"N29717","EWR","BOS",34,200,6,30,2013-10-09 06:00:00 +2013,10,9,737,740,-3,1032,1035,-3,"B6",163,"N281JB","JFK","SRQ",151,1041,7,40,2013-10-09 07:00:00 +2013,10,9,812,815,-3,1029,1055,-26,"DL",1429,"N6714Q","JFK","LAS",286,2248,8,15,2013-10-09 08:00:00 +2013,10,9,1024,1000,24,1203,1130,33,"EV",5736,"N834AS","LGA","IAD",49,229,10,0,2013-10-09 10:00:00 +2013,10,9,1254,1300,-6,1414,1439,-25,"EV",5378,"N713EV","LGA","PIT",54,335,13,0,2013-10-09 13:00:00 +2013,10,9,1303,1300,3,1548,1550,-2,"AA",1145,"N3KJAA","LGA","DFW",187,1389,13,0,2013-10-09 13:00:00 +2013,10,9,1304,1310,-6,1459,1526,-27,"EV",5283,"N741EV","LGA","CVG",85,585,13,10,2013-10-09 13:00:00 +2013,10,9,1501,1506,-5,1737,1737,0,"EV",4377,"N11547","EWR","JAX",121,820,15,6,2013-10-09 15:00:00 +2013,10,9,1516,1517,-1,1844,1834,10,"B6",1729,"N503JB","JFK","RSW",158,1074,15,17,2013-10-09 15:00:00 +2013,10,9,1810,1815,-5,1956,2021,-25,"DL",2019,"N364NW","LGA","MSP",139,1020,18,15,2013-10-09 18:00:00 +2013,10,9,1812,1759,13,2045,2032,13,"DL",61,"N6715C","LGA","ATL",105,762,17,59,2013-10-09 17:00:00 +2013,10,9,1934,1900,34,2051,2039,12,"UA",693,"N453UA","LGA","ORD",103,733,19,0,2013-10-09 19:00:00 +2013,10,9,NA,600,NA,NA,730,NA,"UA",279,NA,"EWR","ORD",NA,719,6,0,2013-10-09 06:00:00 +2013,10,10,1048,1050,-2,1256,1250,6,"MQ",3689,"N6EAMQ","LGA","DTW",75,502,10,50,2013-10-10 10:00:00 +2013,10,10,1253,1300,-7,1413,1409,4,"US",2148,"N954UW","LGA","BOS",34,184,13,0,2013-10-10 13:00:00 +2013,10,10,1356,1400,-4,1504,1507,-3,"US",2150,"N947UW","LGA","BOS",33,184,14,0,2013-10-10 14:00:00 +2013,10,10,1642,1645,-3,1911,1944,-33,"B6",283,"N657JB","JFK","MCO",130,944,16,45,2013-10-10 16:00:00 +2013,10,10,1944,1830,74,2152,2110,42,"WN",2698,"N942WN","EWR","MSY",154,1167,18,30,2013-10-10 18:00:00 +2013,10,10,2110,2022,48,2252,2155,57,"B6",105,"N351JB","JFK","ORD",113,740,20,22,2013-10-10 20:00:00 +2013,10,10,2247,2110,97,103,2341,82,"EV",5811,"N11150","EWR","JAX",112,820,21,10,2013-10-10 21:00:00 +2013,10,10,2249,2255,-6,4,9,-5,"B6",486,"N307JB","JFK","ROC",45,264,22,55,2013-10-10 22:00:00 +2013,10,11,558,600,-2,735,758,-23,"EV",5068,"N582CA","EWR","DTW",78,488,6,0,2013-10-11 06:00:00 +2013,10,11,600,600,0,853,858,-5,"B6",371,"N568JB","LGA","FLL",138,1076,6,0,2013-10-11 06:00:00 +2013,10,11,627,635,-8,906,919,-13,"UA",223,"N515UA","EWR","MCO",129,937,6,35,2013-10-11 06:00:00 +2013,10,11,735,735,0,1031,1035,-4,"AA",2279,"N3ABAA","LGA","MIA",151,1096,7,35,2013-10-11 07:00:00 +2013,10,11,902,900,2,1145,1157,-12,"B6",63,"N729JB","JFK","SEA",309,2422,9,0,2013-10-11 09:00:00 +2013,10,11,1454,1455,-1,1655,1723,-28,"9E",3326,"N916XJ","JFK","IND",91,665,14,55,2013-10-11 14:00:00 +2013,10,11,1502,1455,7,1741,1759,-18,"DL",1935,"N370NB","LGA","TPA",134,1010,14,55,2013-10-11 14:00:00 +2013,10,11,1614,1615,-1,1859,1915,-16,"AA",65,"N3FMAA","JFK","DFW",181,1391,16,15,2013-10-11 16:00:00 +2013,10,11,1820,1815,5,2107,2138,-31,"DL",17,"N195DN","JFK","LAX",321,2475,18,15,2013-10-11 18:00:00 +2013,10,11,1908,1830,38,2013,1950,23,"MQ",3486,"N517MQ","LGA","BNA",99,764,18,30,2013-10-11 18:00:00 +2013,10,11,2002,1900,62,2141,2101,40,"9E",3433,"N602LR","JFK","PIT",55,340,19,0,2013-10-11 19:00:00 +2013,10,12,601,610,-9,842,855,-13,"AA",1103,"N3DHAA","LGA","DFW",197,1389,6,10,2013-10-12 06:00:00 +2013,10,12,728,601,87,838,722,76,"UA",1198,"N33284","LGA","ORD",102,733,6,1,2013-10-12 06:00:00 +2013,10,12,733,659,34,935,912,23,"EV",4122,"N11155","EWR","SDF",106,642,6,59,2013-10-12 06:00:00 +2013,10,12,733,735,-2,1000,932,28,"EV",4246,"N12167","EWR","DTW",99,488,7,35,2013-10-12 07:00:00 +2013,10,12,1158,1150,8,1334,1340,-6,"MQ",3616,"N0EGMQ","LGA","MSP",132,1020,11,50,2013-10-12 11:00:00 +2013,10,12,1400,1400,0,1636,1655,-19,"AA",1151,"N3EWAA","LGA","DFW",194,1389,14,0,2013-10-12 14:00:00 +2013,10,12,1532,1505,27,1737,1709,28,"EV",4181,"N10156","EWR","MCI",154,1092,15,5,2013-10-12 15:00:00 +2013,10,12,1738,1732,6,1940,1959,-19,"FL",623,"N934AT","LGA","ATL",100,762,17,32,2013-10-12 17:00:00 +2013,10,12,1816,1815,1,2104,2135,-31,"AA",1611,"N3DGAA","LGA","MIA",141,1096,18,15,2013-10-12 18:00:00 +2013,10,13,1023,1029,-6,1224,1239,-15,"US",604,"N654AW","EWR","PHX",280,2133,10,29,2013-10-13 10:00:00 +2013,10,13,1203,1206,-3,1508,1513,-5,"UA",1496,"N24729","EWR","SNA",345,2434,12,6,2013-10-13 12:00:00 +2013,10,13,1550,1548,2,1909,1911,-2,"DL",31,"N384DA","JFK","SLC",265,1990,15,48,2013-10-13 15:00:00 +2013,10,13,1628,1615,13,1840,1845,-5,"MQ",3357,"N526MQ","LGA","ATL",101,762,16,15,2013-10-13 16:00:00 +2013,10,13,1637,1629,8,1944,1919,25,"UA",1695,"N12116","EWR","IAH",193,1400,16,29,2013-10-13 16:00:00 +2013,10,13,1850,1830,20,2104,2110,-6,"WN",2698,"N401WN","EWR","MSY",152,1167,18,30,2013-10-13 18:00:00 +2013,10,14,638,641,-3,745,805,-20,"EV",4522,"N14573","EWR","BNA",107,748,6,41,2013-10-14 06:00:00 +2013,10,14,744,745,-1,1021,1009,12,"DL",807,"N359NB","EWR","ATL",110,746,7,45,2013-10-14 07:00:00 +2013,10,14,758,800,-2,1048,1117,-29,"DL",2431,"N960DL","JFK","MIA",142,1089,8,0,2013-10-14 08:00:00 +2013,10,14,850,855,-5,1142,1156,-14,"UA",207,"N475UA","LGA","IAH",189,1416,8,55,2013-10-14 08:00:00 +2013,10,14,949,1000,-11,1118,1134,-16,"UA",673,"N806UA","LGA","ORD",106,733,10,0,2013-10-14 10:00:00 +2013,10,14,1112,1100,12,1340,1341,-1,"DL",1647,"N523US","LGA","ATL",103,762,11,0,2013-10-14 11:00:00 +2013,10,14,1500,1500,0,1732,1758,-26,"B6",573,"N662JB","EWR","TPA",129,997,15,0,2013-10-14 15:00:00 +2013,10,14,1700,1659,1,2014,1959,15,"UA",1665,"N14250","EWR","LAX",349,2454,16,59,2013-10-14 16:00:00 +2013,10,14,1817,1820,-3,2013,2034,-21,"9E",3542,"N931XJ","JFK","MSP",148,1029,18,20,2013-10-14 18:00:00 +2013,10,14,1859,1825,34,2132,2133,-1,"DL",1854,"N360NB","LGA","FLL",136,1076,18,25,2013-10-14 18:00:00 +2013,10,14,1931,1835,56,2154,2146,8,"DL",2391,"N939DL","JFK","TPA",126,1005,18,35,2013-10-14 18:00:00 +2013,10,14,1934,1930,4,2157,2159,-2,"DL",2142,"N324NB","EWR","ATL",102,746,19,30,2013-10-14 19:00:00 +2013,10,15,618,620,-2,713,728,-15,"EV",4241,"N14562","EWR","DCA",38,199,6,20,2013-10-15 06:00:00 +2013,10,15,836,840,-4,1001,1005,-4,"EV",5813,"N13913","EWR","RIC",54,277,8,40,2013-10-15 08:00:00 +2013,10,15,1305,1304,1,1544,1554,-10,"UA",1641,"N34131","EWR","MCO",129,937,13,4,2013-10-15 13:00:00 +2013,10,15,1451,1455,-4,1715,1723,-8,"9E",3326,"N930XJ","JFK","IND",97,665,14,55,2013-10-15 14:00:00 +2013,10,15,1620,1625,-5,1822,1838,-16,"EV",4684,"N15985","EWR","SDF",102,642,16,25,2013-10-15 16:00:00 +2013,10,15,1724,1729,-5,1846,1900,-14,"EV",4195,"N34111","EWR","BNA",106,748,17,29,2013-10-15 17:00:00 +2013,10,15,1832,1805,27,2018,1950,28,"AA",353,"N4WVAA","LGA","ORD",116,733,18,5,2013-10-15 18:00:00 +2013,10,15,1923,1830,53,2113,2010,63,"MQ",3134,"N518MQ","EWR","ORD",116,719,18,30,2013-10-15 18:00:00 +2013,10,15,2029,2040,-11,2239,2258,-19,"9E",4033,"N8847A","LGA","TYS",90,647,20,40,2013-10-15 20:00:00 +2013,10,16,553,600,-7,739,730,9,"AA",301,"N502AA","LGA","ORD",127,733,6,0,2013-10-16 06:00:00 +2013,10,16,751,755,-4,859,910,-11,"WN",909,"N606SW","EWR","MDW",112,711,7,55,2013-10-16 07:00:00 +2013,10,16,1151,1200,-9,1324,1334,-10,"UA",667,"N839UA","LGA","ORD",123,733,12,0,2013-10-16 12:00:00 +2013,10,16,1255,1300,-5,1515,1526,-11,"DL",1798,"N341NB","EWR","ATL",106,746,13,0,2013-10-16 13:00:00 +2013,10,16,1311,1300,11,1518,1450,28,"MQ",3388,"N847MQ","LGA","CMH",78,479,13,0,2013-10-16 13:00:00 +2013,10,16,1502,1445,17,1656,1628,28,"EV",4596,"N26545","EWR","STL",150,872,14,45,2013-10-16 14:00:00 +2013,10,16,1629,1630,-1,1948,1940,8,"AA",181,"N335AA","JFK","LAX",347,2475,16,30,2013-10-16 16:00:00 +2013,10,16,1651,1700,-9,1929,1940,-11,"DL",1499,"N979DL","LGA","ATL",114,762,17,0,2013-10-16 17:00:00 +2013,10,16,1825,1830,-5,2227,2140,47,"B6",305,"N768JB","EWR","FLL",147,1065,18,30,2013-10-16 18:00:00 +2013,10,16,2029,2025,4,2346,2350,-4,"B6",915,"N590JB","JFK","SFO",345,2586,20,25,2013-10-16 20:00:00 +2013,10,17,653,655,-2,818,810,8,"WN",404,"N258WN","LGA","MKE",115,738,6,55,2013-10-17 06:00:00 +2013,10,17,755,800,-5,1044,1117,-33,"DL",2431,"N923DL","JFK","MIA",148,1089,8,0,2013-10-17 08:00:00 +2013,10,17,1018,1020,-2,1259,1309,-10,"B6",53,"N636JB","JFK","PBI",141,1028,10,20,2013-10-17 10:00:00 +2013,10,17,1105,1105,0,1220,1245,-25,"EV",5309,"N720EV","LGA","BGR",51,378,11,5,2013-10-17 11:00:00 +2013,10,17,1121,1129,-8,1351,1400,-9,"B6",1211,"N705JB","JFK","LAS",307,2248,11,29,2013-10-17 11:00:00 +2013,10,17,1253,1259,-6,1555,1555,0,"UA",1280,"N15712","LGA","IAH",220,1416,12,59,2013-10-17 12:00:00 +2013,10,17,1311,1226,45,1519,1418,61,"EV",4640,"N17984","EWR","DAY",95,533,12,26,2013-10-17 12:00:00 +2013,10,17,1445,1450,-5,1713,1745,-32,"UA",294,"N425UA","EWR","MCO",131,937,14,50,2013-10-17 14:00:00 +2013,10,17,1457,1500,-3,1612,1631,-19,"UA",399,"N435UA","EWR","ORD",111,719,15,0,2013-10-17 15:00:00 +2013,10,17,1652,1700,-8,1932,1940,-8,"DL",1499,"N970DL","LGA","ATL",122,762,17,0,2013-10-17 17:00:00 +2013,10,17,1654,1548,66,1919,1757,82,"EV",3825,"N13538","EWR","IND",109,645,15,48,2013-10-17 15:00:00 +2013,10,17,1820,1820,0,2117,2124,-7,"B6",1013,"N834JB","JFK","LGB",331,2465,18,20,2013-10-17 18:00:00 +2013,10,17,1850,1850,0,2317,2212,65,"B6",669,"N507JB","JFK","SJC",377,2569,18,50,2013-10-17 18:00:00 +2013,10,17,2104,2106,-2,6,2354,12,"UA",475,"N429UA","EWR","IAH",201,1400,21,6,2013-10-17 21:00:00 +2013,10,18,803,805,-2,955,1000,-5,"EV",5242,"N748EV","LGA","GSO",77,461,8,5,2013-10-18 08:00:00 +2013,10,18,924,930,-6,1033,1038,-5,"B6",116,"N296JB","JFK","SYR",47,209,9,30,2013-10-18 09:00:00 +2013,10,18,943,905,38,1130,1115,15,"DL",181,"N327NW","LGA","DTW",84,502,9,5,2013-10-18 09:00:00 +2013,10,18,1443,1445,-2,1749,1758,-9,"UA",841,"N595UA","JFK","LAX",341,2475,14,45,2013-10-18 14:00:00 +2013,10,18,1555,1559,-4,1709,1730,-21,"UA",287,"N436UA","EWR","ORD",118,719,15,59,2013-10-18 15:00:00 +2013,10,18,1557,1525,32,1804,1726,38,"EV",4576,"N13949","EWR","GRR",106,605,15,25,2013-10-18 15:00:00 +2013,10,18,1617,1620,-3,1717,1740,-23,"UA",1064,"N14731","EWR","BOS",42,200,16,20,2013-10-18 16:00:00 +2013,10,18,1656,1700,-4,1814,1817,-3,"US",2189,"N752US","LGA","DCA",48,214,17,0,2013-10-18 17:00:00 +2013,10,18,1857,1850,7,2207,2212,-5,"B6",669,"N768JB","JFK","SJC",353,2569,18,50,2013-10-18 18:00:00 +2013,10,18,2021,2030,-9,2149,2205,-16,"WN",2520,"N213WN","EWR","MDW",111,711,20,30,2013-10-18 20:00:00 +2013,10,19,852,900,-8,1004,1025,-21,"US",2173,"N945UW","LGA","DCA",48,214,9,0,2013-10-19 09:00:00 +2013,10,19,1230,1231,-1,1320,1329,-9,"EV",4133,"N12967","EWR","PVD",32,160,12,31,2013-10-19 12:00:00 +2013,10,19,1706,1715,-9,1816,1830,-14,"B6",2580,"N190JB","EWR","BOS",40,200,17,15,2013-10-19 17:00:00 +2013,10,19,2012,2022,-10,2234,2246,-12,"B6",135,"N556JB","JFK","PHX",298,2153,20,22,2013-10-19 20:00:00 +2013,10,20,543,545,-2,843,855,-12,"AA",2243,"N5BYAA","JFK","MIA",158,1089,5,45,2013-10-20 05:00:00 +2013,10,20,652,650,2,816,819,-3,"UA",1177,"N23707","EWR","ORD",118,719,6,50,2013-10-20 06:00:00 +2013,10,20,724,729,-5,1033,1021,12,"UA",443,"N555UA","JFK","LAX",347,2475,7,29,2013-10-20 07:00:00 +2013,10,20,758,805,-7,1111,1106,5,"DL",1109,"N335NB","LGA","TPA",159,1010,8,5,2013-10-20 08:00:00 +2013,10,20,823,829,-6,1142,1139,3,"AA",2267,"N3EYAA","LGA","MIA",164,1096,8,29,2013-10-20 08:00:00 +2013,10,20,1228,1226,2,1326,1338,-12,"UA",252,"N465UA","EWR","BOS",44,200,12,26,2013-10-20 12:00:00 +2013,10,20,1451,1455,-4,1759,1759,0,"DL",1935,"N334NB","LGA","TPA",153,1010,14,55,2013-10-20 14:00:00 +2013,10,20,1456,1455,1,1732,1723,9,"9E",3326,"N923XJ","JFK","IND",106,665,14,55,2013-10-20 14:00:00 +2013,10,20,1544,1550,-6,1717,1730,-13,"MQ",3416,"N542MQ","LGA","RDU",73,431,15,50,2013-10-20 15:00:00 +2013,10,20,1623,1445,98,1944,1750,114,"B6",1171,"N571JB","LGA","FLL",175,1076,14,45,2013-10-20 14:00:00 +2013,10,20,1722,1730,-8,1829,1847,-18,"B6",1516,"N307JB","JFK","SYR",46,209,17,30,2013-10-20 17:00:00 +2013,10,20,1808,1815,-7,1950,1954,-4,"EV",5287,"N730EV","LGA","MSN",122,812,18,15,2013-10-20 18:00:00 +2013,10,20,1813,1815,-2,2123,2138,-15,"DL",17,"N194DN","JFK","LAX",332,2475,18,15,2013-10-20 18:00:00 +2013,10,20,1931,1920,11,2203,2211,-8,"UA",1429,"N76529","EWR","LAS",302,2227,19,20,2013-10-20 19:00:00 +2013,10,20,1934,1940,-6,2135,2120,15,"AA",363,"N481AA","LGA","ORD",116,733,19,40,2013-10-20 19:00:00 +2013,10,20,1957,2005,-8,2115,2130,-15,"MQ",3604,"N508MQ","EWR","ORD",113,719,20,5,2013-10-20 20:00:00 +2013,10,20,2027,2030,-3,2233,2251,-18,"EV",5209,"N740EV","LGA","CHS",104,641,20,30,2013-10-20 20:00:00 +2013,10,20,2058,2100,-2,2336,2344,-8,"B6",499,"N561JB","LGA","MCO",140,950,21,0,2013-10-20 21:00:00 +2013,10,21,631,600,31,740,717,23,"EV",5747,"N834AS","LGA","IAD",42,229,6,0,2013-10-21 06:00:00 +2013,10,21,755,800,-5,1100,1110,-10,"B6",1511,"N566JB","EWR","RSW",163,1068,8,0,2013-10-21 08:00:00 +2013,10,21,802,800,2,1025,1026,-1,"9E",3507,"N901XJ","JFK","MSY",186,1182,8,0,2013-10-21 08:00:00 +2013,10,21,921,930,-9,1228,1245,-17,"WN",746,"N930WN","EWR","AUS",232,1504,9,30,2013-10-21 09:00:00 +2013,10,21,1044,1050,-6,1235,1250,-15,"MQ",3689,"N527MQ","LGA","DTW",84,502,10,50,2013-10-21 10:00:00 +2013,10,21,1134,1140,-6,1436,1430,6,"UA",1618,"N39728","EWR","TPA",157,997,11,40,2013-10-21 11:00:00 +2013,10,21,1242,1240,2,1421,1425,-4,"WN",137,"N7734H","LGA","STL",143,888,12,40,2013-10-21 12:00:00 +2013,10,21,1248,1259,-11,1442,1512,-30,"EV",5207,"N753EV","LGA","CLT",90,544,12,59,2013-10-21 12:00:00 +2013,10,21,1301,1305,-4,1420,1427,-7,"EV",5816,"N12922","EWR","RIC",55,277,13,5,2013-10-21 13:00:00 +2013,10,21,1507,1510,-3,1821,1812,9,"UA",1483,"N76505","EWR","AUS",230,1504,15,10,2013-10-21 15:00:00 +2013,10,21,1736,1715,21,2104,2015,49,"AA",2488,"N4YNAA","EWR","DFW",218,1372,17,15,2013-10-21 17:00:00 +2013,10,21,1822,1825,-3,2140,2133,7,"DL",1854,"N315NB","LGA","FLL",167,1076,18,25,2013-10-21 18:00:00 +2013,10,22,739,745,-6,1008,1009,-1,"DL",807,"N346NB","EWR","ATL",117,746,7,45,2013-10-22 07:00:00 +2013,10,22,950,1000,-10,1059,1120,-21,"US",2175,"N763US","LGA","DCA",54,214,10,0,2013-10-22 10:00:00 +2013,10,22,1153,1155,-2,1409,1425,-16,"WN",264,"N715SW","LGA","DEN",226,1620,11,55,2013-10-22 11:00:00 +2013,10,22,1319,1312,7,1630,1624,6,"B6",1639,"N568JB","LGA","RSW",171,1080,13,12,2013-10-22 13:00:00 +2013,10,22,1452,1500,-8,1558,1618,-20,"US",2185,"N753US","LGA","DCA",53,214,15,0,2013-10-22 15:00:00 +2013,10,22,1517,1520,-3,1644,1705,-21,"AA",341,"N549AA","LGA","ORD",122,733,15,20,2013-10-22 15:00:00 +2013,10,22,1519,1528,-9,1654,1659,-5,"EV",4502,"N26545","EWR","BNA",133,748,15,28,2013-10-22 15:00:00 +2013,10,22,1524,1440,44,1642,1600,42,"EV",6049,"N14974","EWR","IAD",49,212,14,40,2013-10-22 14:00:00 +2013,10,22,1910,1910,0,2213,2215,-2,"AA",21,"N339AA","JFK","LAX",326,2475,19,10,2013-10-22 19:00:00 +2013,10,22,1912,1900,12,2123,2133,-10,"DL",245,"N375DA","JFK","PHX",293,2153,19,0,2013-10-22 19:00:00 +2013,10,22,2100,2106,-6,2344,2354,-10,"UA",475,"N494UA","EWR","IAH",205,1400,21,6,2013-10-22 21:00:00 +2013,10,23,625,630,-5,910,922,-12,"UA",797,"N512UA","JFK","LAX",318,2475,6,30,2013-10-23 06:00:00 +2013,10,23,628,630,-2,836,839,-3,"EV",4393,"N12569","EWR","IND",112,645,6,30,2013-10-23 06:00:00 +2013,10,23,905,830,35,1107,1019,48,"EV",5195,"N748EV","LGA","RIC",70,292,8,30,2013-10-23 08:00:00 +2013,10,23,1039,1043,-4,1257,1311,-14,"UA",1110,"N37409","EWR","LAS",294,2227,10,43,2013-10-23 10:00:00 +2013,10,23,1151,1200,-9,1414,1425,-11,"UA",998,"N833UA","EWR","PHX",300,2133,12,0,2013-10-23 12:00:00 +2013,10,23,1604,1608,-4,1724,1752,-28,"B6",1105,"N374JB","JFK","ORD",119,740,16,8,2013-10-23 16:00:00 +2013,10,23,1722,1625,57,2042,1932,70,"B6",423,"N632JB","JFK","LAX",350,2475,16,25,2013-10-23 16:00:00 +2013,10,24,720,725,-5,1004,1008,-4,"UA",212,"N668UA","EWR","IAH",200,1400,7,25,2013-10-24 07:00:00 +2013,10,24,820,825,-5,1139,1120,19,"UA",478,"N429UA","EWR","MCO",149,937,8,25,2013-10-24 08:00:00 +2013,10,24,831,835,-4,952,1000,-8,"MQ",3355,"N543MQ","LGA","BNA",122,764,8,35,2013-10-24 08:00:00 +2013,10,24,1107,1110,-3,1440,1430,10,"AA",1599,"N3ANAA","LGA","MIA",182,1096,11,10,2013-10-24 11:00:00 +2013,10,24,1156,1200,-4,1301,1312,-11,"DL",2451,"N359NB","JFK","BOS",38,187,12,0,2013-10-24 12:00:00 +2013,10,24,1212,1221,-9,1316,1328,-12,"B6",34,"N192JB","JFK","BTV",47,266,12,21,2013-10-24 12:00:00 +2013,10,24,1759,1717,42,1955,1908,47,"EV",4411,"N14568","EWR","MEM",159,946,17,17,2013-10-24 17:00:00 +2013,10,24,1824,1829,-5,2016,2031,-15,"US",1751,"N194UW","EWR","CLT",87,529,18,29,2013-10-24 18:00:00 +2013,10,24,1928,1900,28,2034,2025,9,"WN",490,"N759GS","LGA","MKE",106,738,19,0,2013-10-24 19:00:00 +2013,10,25,633,635,-2,830,833,-3,"EV",4535,"N31131","EWR","MSP",148,1008,6,35,2013-10-25 06:00:00 +2013,10,25,722,705,17,858,845,13,"WN",1265,"N275WN","EWR","STL",127,872,7,5,2013-10-25 07:00:00 +2013,10,25,804,757,7,1008,1024,-16,"UA",245,"N830UA","EWR","DEN",220,1605,7,57,2013-10-25 07:00:00 +2013,10,25,825,830,-5,1117,1152,-35,"UA",1480,"N87512","EWR","SFO",336,2565,8,30,2013-10-25 08:00:00 +2013,10,25,1014,1020,-6,1314,1309,5,"B6",53,"N807JB","JFK","PBI",157,1028,10,20,2013-10-25 10:00:00 +2013,10,25,1042,1025,17,1153,1140,13,"MQ",3611,"N539MQ","EWR","ORD",105,719,10,25,2013-10-25 10:00:00 +2013,10,25,1051,1055,-4,1355,1353,2,"B6",1,"N586JB","JFK","FLL",155,1069,10,55,2013-10-25 10:00:00 +2013,10,25,1252,1256,-4,1552,1602,-10,"DL",1375,"N3772H","JFK","SLC",270,1990,12,56,2013-10-25 12:00:00 +2013,10,25,1618,1555,23,1855,1828,27,"DL",1705,"N373NW","LGA","MSY",164,1183,15,55,2013-10-25 15:00:00 +2013,10,25,1853,1840,13,2112,2116,-4,"DL",87,"N854NW","JFK","ATL",104,760,18,40,2013-10-25 18:00:00 +2013,10,25,1915,1930,-15,2123,2049,34,"EV",5769,"N828AS","LGA","IAD",53,229,19,30,2013-10-25 19:00:00 +2013,10,25,1936,1925,11,2230,2247,-17,"DL",2307,"N355NW","JFK","SAT",216,1587,19,25,2013-10-25 19:00:00 +2013,10,25,2000,1945,15,2048,2059,-11,"9E",3843,"N8506C","JFK","PHL",25,94,19,45,2013-10-25 19:00:00 +2013,10,25,2013,1930,43,2218,2159,19,"DL",2142,"N318NB","EWR","ATL",100,746,19,30,2013-10-25 19:00:00 +2013,10,25,NA,2045,NA,NA,2359,NA,"DL",443,"N722TW","JFK","SEA",NA,2422,20,45,2013-10-25 20:00:00 +2013,10,26,555,600,-5,819,829,-10,"EV",5661,"N17560","EWR","ATL",112,746,6,0,2013-10-26 06:00:00 +2013,10,26,651,659,-8,903,921,-18,"UA",265,"N412UA","EWR","MSY",163,1167,6,59,2013-10-26 06:00:00 +2013,10,26,912,915,-3,1108,1110,-2,"EV",5222,"N232PQ","EWR","DTW",89,488,9,15,2013-10-26 09:00:00 +2013,10,26,1728,1730,-2,1851,1852,-1,"B6",86,"N183JB","JFK","ROC",54,264,17,30,2013-10-26 17:00:00 +2013,10,26,1737,1735,2,2041,2107,-26,"UA",1284,"N13248","EWR","SFO",339,2565,17,35,2013-10-26 17:00:00 +2013,10,26,1836,1840,-4,2002,2002,0,"EV",4131,"N17560","EWR","RIC",55,277,18,40,2013-10-26 18:00:00 +2013,10,27,651,653,-2,950,1001,-11,"UA",1299,"N27421","EWR","RSW",160,1068,6,53,2013-10-27 06:00:00 +2013,10,27,729,736,-7,903,920,-17,"B6",885,"N351JB","JFK","RDU",68,427,7,36,2013-10-27 07:00:00 +2013,10,27,808,811,-3,1051,1106,-15,"B6",1783,"N590JB","JFK","MCO",134,944,8,11,2013-10-27 08:00:00 +2013,10,27,915,919,-4,1125,1128,-3,"EV",4087,"N11548","EWR","IND",101,645,9,19,2013-10-27 09:00:00 +2013,10,27,1158,1200,-2,1349,1358,-9,"US",1973,"N193UW","JFK","CLT",77,541,12,0,2013-10-27 12:00:00 +2013,10,27,1234,1239,-5,1409,1420,-11,"EV",4335,"N11544","EWR","CMH",76,463,12,39,2013-10-27 12:00:00 +2013,10,27,1835,1815,20,2011,2015,-4,"WN",1113,"N782SA","LGA","STL",129,888,18,15,2013-10-27 18:00:00 +2013,10,27,1951,1956,-5,2138,2155,-17,"DL",2131,"N333NB","LGA","DTW",80,502,19,56,2013-10-27 19:00:00 +2013,10,28,725,725,0,948,1008,-20,"UA",598,"N676UA","EWR","IAH",183,1400,7,25,2013-10-28 07:00:00 +2013,10,28,750,755,-5,1115,1110,5,"AA",59,"N349AA","JFK","SFO",360,2586,7,55,2013-10-28 07:00:00 +2013,10,28,759,759,0,908,912,-4,"EV",4866,"N16147","EWR","BTV",44,266,7,59,2013-10-28 07:00:00 +2013,10,28,1156,1200,-4,1507,1506,1,"DL",423,"N713TW","JFK","LAX",348,2475,12,0,2013-10-28 12:00:00 +2013,10,28,1311,1310,1,1527,1530,-3,"FL",348,"N983AT","LGA","ATL",108,762,13,10,2013-10-28 13:00:00 +2013,10,28,1544,1529,15,1912,1847,25,"UA",1246,"N78511","EWR","SFO",368,2565,15,29,2013-10-28 15:00:00 +2013,10,28,1701,1704,-3,1943,1958,-15,"UA",525,"N434UA","LGA","IAH",199,1416,17,4,2013-10-28 17:00:00 +2013,10,28,1708,1710,-2,1817,1830,-13,"UA",1064,"N16709","EWR","BOS",46,200,17,10,2013-10-28 17:00:00 +2013,10,28,1718,1717,1,1903,1908,-5,"EV",4411,"N12996","EWR","MEM",144,946,17,17,2013-10-28 17:00:00 +2013,10,28,1959,2001,-2,2236,2252,-16,"B6",883,"N508JB","JFK","MCO",128,944,20,1,2013-10-28 20:00:00 +2013,10,28,2015,2025,-10,2238,2242,-4,"EV",4085,"N13133","EWR","OMA",174,1134,20,25,2013-10-28 20:00:00 +2013,10,29,559,600,-1,718,715,3,"WN",464,"N281WN","EWR","MDW",115,711,6,0,2013-10-29 06:00:00 +2013,10,29,727,735,-8,1021,1035,-14,"AA",2279,"N3JDAA","LGA","MIA",141,1096,7,35,2013-10-29 07:00:00 +2013,10,29,803,810,-7,1031,1111,-40,"DL",1167,"N310DE","JFK","TPA",135,1005,8,10,2013-10-29 08:00:00 +2013,10,29,821,830,-9,956,1007,-11,"9E",3579,"N8837B","LGA","IAD",48,229,8,30,2013-10-29 08:00:00 +2013,10,29,825,830,-5,1040,1033,7,"DL",2119,"N341NW","LGA","MSP",167,1020,8,30,2013-10-29 08:00:00 +2013,10,29,934,940,-6,1058,1120,-22,"AA",317,"N504AA","LGA","ORD",120,733,9,40,2013-10-29 09:00:00 +2013,10,29,1023,951,32,1244,1207,37,"UA",256,"N454UA","EWR","DEN",243,1605,9,51,2013-10-29 09:00:00 +2013,10,29,1444,1450,-6,1654,1645,9,"MQ",3588,"N511MQ","LGA","MSP",170,1020,14,50,2013-10-29 14:00:00 +2013,10,29,1524,1528,-4,1645,1659,-14,"EV",4502,"N16561","EWR","BNA",121,748,15,28,2013-10-29 15:00:00 +2013,10,30,704,710,-6,1002,1000,2,"AA",2493,"N619AA","JFK","MCO",143,944,7,10,2013-10-30 07:00:00 +2013,10,30,756,800,-4,1013,1005,8,"9E",3353,"N933XJ","JFK","DTW",106,509,8,0,2013-10-30 08:00:00 +2013,10,30,835,840,-5,1036,1100,-24,"EV",5475,"N758EV","LGA","CLT",87,544,8,40,2013-10-30 08:00:00 +2013,10,30,858,857,1,1204,1151,13,"UA",997,"N571UA","EWR","LAX",338,2454,8,57,2013-10-30 08:00:00 +2013,10,30,1023,1030,-7,1341,1355,-14,"VX",187,"N631VA","EWR","SFO",362,2565,10,30,2013-10-30 10:00:00 +2013,10,30,1257,1249,8,1454,1512,-18,"UA",1444,"N23708","EWR","MSY",163,1167,12,49,2013-10-30 12:00:00 +2013,10,30,1429,1436,-7,1544,1557,-13,"B6",286,"N334JB","JFK","ROC",54,264,14,36,2013-10-30 14:00:00 +2013,10,30,1455,1455,0,1846,1849,-3,"B6",703,"N524JB","JFK","SJU",194,1598,14,55,2013-10-30 14:00:00 +2013,10,30,2007,2015,-8,2203,2155,8,"MQ",3535,"N523MQ","JFK","CMH",70,483,20,15,2013-10-30 20:00:00 +2013,10,31,555,600,-5,752,749,3,"DL",731,"N364NW","LGA","DTW",89,502,6,0,2013-10-31 06:00:00 +2013,10,31,909,915,-6,1159,1221,-22,"DL",1885,"N917DL","LGA","MCO",126,950,9,15,2013-10-31 09:00:00 +2013,10,31,914,910,4,1209,1220,-11,"AA",1,"N327AA","JFK","LAX",328,2475,9,10,2013-10-31 09:00:00 +2013,10,31,1151,1200,-9,1309,1315,-6,"US",2179,"N748UW","LGA","DCA",47,214,12,0,2013-10-31 12:00:00 +2013,10,31,1456,1500,-4,1633,1634,-1,"UA",685,"N805UA","LGA","ORD",123,733,15,0,2013-10-31 15:00:00 +2013,10,31,1543,1548,-5,1911,1909,2,"DL",31,"N3737C","JFK","SLC",278,1990,15,48,2013-10-31 15:00:00 +2013,10,31,1759,1803,-4,2027,2111,-44,"UA",237,"N540UA","EWR","LAX",308,2454,18,3,2013-10-31 18:00:00 +2013,10,31,1811,1740,31,2017,1931,46,"EV",3843,"N16911","EWR","CMH",94,463,17,40,2013-10-31 17:00:00 +2013,10,31,1826,1830,-4,2043,2046,-3,"DL",2002,"N917DE","JFK","DTW",86,509,18,30,2013-10-31 18:00:00 +2013,11,1,957,1005,-8,1209,1217,-8,"DL",2319,"N355NW","LGA","MSP",142,1020,10,5,2013-11-01 10:00:00 +2013,11,1,1341,1345,-4,1534,1520,14,"MQ",3305,"N507MQ","LGA","RDU",79,431,13,45,2013-11-01 13:00:00 +2013,11,1,1536,1444,52,1710,1641,29,"EV",4949,"N730EV","LGA","GSO",76,461,14,44,2013-11-01 14:00:00 +2013,11,1,1545,1521,24,1827,1807,20,"UA",598,"N579UA","EWR","IAH",204,1400,15,21,2013-11-01 15:00:00 +2013,11,1,1813,1815,-2,1956,2021,-25,"DL",2019,"N369NW","LGA","MSP",145,1020,18,15,2013-11-01 18:00:00 +2013,11,1,1933,1935,-2,2243,2250,-7,"AA",2437,"N3ADAA","LGA","MIA",157,1096,19,35,2013-11-01 19:00:00 +2013,11,1,1946,1956,-10,2140,2155,-15,"DL",2131,"N318NB","LGA","DTW",79,502,19,56,2013-11-01 19:00:00 +2013,11,2,759,754,5,908,911,-3,"B6",1307,"N298JB","JFK","IAD",52,228,7,54,2013-11-02 07:00:00 +2013,11,2,1350,1359,-9,1449,1511,-22,"UA",1703,"N57111","EWR","BOS",39,200,13,59,2013-11-02 13:00:00 +2013,11,2,1532,1530,2,1700,1701,-1,"EV",3812,"N11547","EWR","BNA",120,748,15,30,2013-11-02 15:00:00 +2013,11,2,1542,1545,-3,1929,1942,-13,"DL",689,"N37700","JFK","SJU",199,1598,15,45,2013-11-02 15:00:00 +2013,11,2,1614,1611,3,1914,1915,-1,"B6",753,"N621JB","JFK","PBI",154,1028,16,11,2013-11-02 16:00:00 +2013,11,2,1921,1925,-4,2216,2244,-28,"DL",2307,"N332NW","JFK","SAT",222,1587,19,25,2013-11-02 19:00:00 +2013,11,3,1018,1023,-5,1208,1218,-10,"US",1745,"N569UW","EWR","CLT",86,529,10,23,2013-11-03 10:00:00 +2013,11,3,1054,1100,-6,1322,1352,-30,"DL",695,"N915DE","JFK","MCO",130,944,11,0,2013-11-03 11:00:00 +2013,11,3,1205,1205,0,1323,1330,-7,"WN",483,"N220WN","EWR","MDW",114,711,12,5,2013-11-03 12:00:00 +2013,11,3,1255,1300,-5,1507,1522,-15,"DL",2043,"N341NB","JFK","ATL",108,760,13,0,2013-11-03 13:00:00 +2013,11,3,1300,1310,-10,1409,1429,-20,"EV",3805,"N14543","EWR","RIC",53,277,13,10,2013-11-03 13:00:00 +2013,11,3,1429,1429,0,1741,1737,4,"B6",301,"N569JB","JFK","FLL",149,1069,14,29,2013-11-03 14:00:00 +2013,11,3,1929,1930,-1,2325,2324,1,"DL",435,"N624AG","JFK","SFO",364,2586,19,30,2013-11-03 19:00:00 +2013,11,3,1936,1940,-4,2103,2125,-22,"MQ",3374,"N854MQ","JFK","RDU",64,427,19,40,2013-11-03 19:00:00 +2013,11,3,1943,1937,6,2209,2139,30,"EV",4370,"N12564","EWR","CHS",91,628,19,37,2013-11-03 19:00:00 +2013,11,3,2011,2016,-5,2202,2154,8,"EV",4106,"N11547","EWR","GSO",73,445,20,16,2013-11-03 20:00:00 +2013,11,3,2040,2040,0,13,2359,14,"B6",523,"N796JB","JFK","LAX",350,2475,20,40,2013-11-03 20:00:00 +2013,11,3,2232,2154,38,2338,2306,32,"UA",523,"N405UA","EWR","BOS",39,200,21,54,2013-11-03 21:00:00 +2013,11,3,2241,2245,-4,2348,3,-15,"B6",486,"N375JB","JFK","ROC",51,264,22,45,2013-11-03 22:00:00 +2013,11,4,621,630,-9,912,919,-7,"B6",1099,"N746JB","LGA","MCO",131,950,6,30,2013-11-04 06:00:00 +2013,11,4,633,635,-2,841,833,8,"EV",4535,"N10156","EWR","MSP",165,1008,6,35,2013-11-04 06:00:00 +2013,11,4,830,837,-7,932,939,-7,"EV",4249,"N11565","EWR","BWI",36,169,8,37,2013-11-04 08:00:00 +2013,11,4,1006,1010,-4,1240,1243,-3,"9E",3512,"N921XJ","LGA","IND",103,660,10,10,2013-11-04 10:00:00 +2013,11,4,1256,1300,-4,1423,1413,10,"US",2181,"N730US","LGA","DCA",44,214,13,0,2013-11-04 13:00:00 +2013,11,4,1257,1300,-3,1610,1550,20,"AA",1145,"N3HAAA","LGA","DFW",208,1389,13,0,2013-11-04 13:00:00 +2013,11,4,1312,1300,12,1557,1605,-8,"UA",1158,"N39418","EWR","MIA",145,1085,13,0,2013-11-04 13:00:00 +2013,11,4,1332,1325,7,1443,1436,7,"B6",308,"N353JB","JFK","PWM",49,273,13,25,2013-11-04 13:00:00 +2013,11,4,1413,1417,-4,1658,1646,12,"UA",587,"N822UA","EWR","LAS",327,2227,14,17,2013-11-04 14:00:00 +2013,11,4,1719,1729,-10,1946,1937,9,"EV",3849,"N16954","EWR","CVG",116,569,17,29,2013-11-04 17:00:00 +2013,11,5,555,600,-5,745,754,-9,"DL",731,"N334NB","LGA","DTW",83,502,6,0,2013-11-05 06:00:00 +2013,11,5,631,639,-8,834,853,-19,"EV",4412,"N14168","EWR","MSP",157,1008,6,39,2013-11-05 06:00:00 +2013,11,5,947,953,-6,1234,1256,-22,"B6",5,"N633JB","EWR","FLL",141,1065,9,53,2013-11-05 09:00:00 +2013,11,5,1335,1345,-10,1622,1700,-38,"AA",1073,"N3FDAA","LGA","MIA",147,1096,13,45,2013-11-05 13:00:00 +2013,11,5,1541,1550,-9,1711,1730,-19,"MQ",3416,"N542MQ","LGA","RDU",72,431,15,50,2013-11-05 15:00:00 +2013,11,6,616,620,-4,812,810,2,"MQ",3351,"N508MQ","LGA","DTW",94,502,6,20,2013-11-06 06:00:00 +2013,11,6,634,635,-1,901,849,12,"EV",4412,"N12201","EWR","MSP",167,1008,6,35,2013-11-06 06:00:00 +2013,11,6,747,759,-12,1025,1032,-7,"DL",2047,"N967DL","LGA","ATL",123,762,7,59,2013-11-06 07:00:00 +2013,11,6,749,800,-11,900,915,-15,"US",2171,"N764US","LGA","DCA",45,214,8,0,2013-11-06 08:00:00 +2013,11,6,805,800,5,1017,1016,1,"9E",2921,"N930XJ","JFK","MSP",169,1029,8,0,2013-11-06 08:00:00 +2013,11,6,832,840,-8,1022,1020,2,"MQ",3531,"N834MQ","LGA","RDU",77,431,8,40,2013-11-06 08:00:00 +2013,11,6,1123,1132,-9,1235,1253,-18,"EV",5797,"N13975","EWR","RIC",53,277,11,32,2013-11-06 11:00:00 +2013,11,6,1135,1145,-10,1240,1310,-30,"EV",3827,"N11547","EWR","ORF",49,284,11,45,2013-11-06 11:00:00 +2013,11,6,1146,1150,-4,1310,1325,-15,"WN",3566,"N236WN","LGA","BNA",121,764,11,50,2013-11-06 11:00:00 +2013,11,6,1402,1405,-3,1701,1712,-11,"UA",235,"N835UA","EWR","SAN",344,2425,14,5,2013-11-06 14:00:00 +2013,11,6,1539,1545,-6,1818,1815,3,"WN",3778,"N771SA","EWR","DEN",241,1605,15,45,2013-11-06 15:00:00 +2013,11,6,1824,1830,-6,2145,2149,-4,"DL",413,"N970DL","JFK","MIA",148,1089,18,30,2013-11-06 18:00:00 +2013,11,6,1931,1935,-4,2228,2250,-22,"AA",2437,"N3DEAA","LGA","MIA",150,1096,19,35,2013-11-06 19:00:00 +2013,11,7,555,600,-5,909,854,15,"B6",605,"N508JB","EWR","FLL",149,1065,6,0,2013-11-07 06:00:00 +2013,11,7,1249,1259,-10,1419,1428,-9,"EV",4622,"N34110","EWR","BNA",131,748,12,59,2013-11-07 12:00:00 +2013,11,7,1624,1627,-3,1835,1846,-11,"EV",4294,"N10575","EWR","SAV",115,708,16,27,2013-11-07 16:00:00 +2013,11,7,1809,1804,5,2143,2135,8,"UA",1481,"N24706","EWR","PHX",304,2133,18,4,2013-11-07 18:00:00 +2013,11,7,1843,1845,-2,2210,2210,0,"AA",177,"N336AA","JFK","SFO",355,2586,18,45,2013-11-07 18:00:00 +2013,11,7,1924,1720,124,2241,2030,131,"AA",291,"N3HVAA","JFK","AUS",234,1521,17,20,2013-11-07 17:00:00 +2013,11,7,1959,2001,-2,2307,2252,15,"B6",883,"N591JB","JFK","MCO",143,944,20,1,2013-11-07 20:00:00 +2013,11,7,2058,2100,-2,2209,2206,3,"US",2164,"N945UW","LGA","BOS",37,184,21,0,2013-11-07 21:00:00 +2013,11,8,713,719,-6,920,941,-21,"UA",573,"N830UA","EWR","MSY",173,1167,7,19,2013-11-08 07:00:00 +2013,11,8,852,900,-8,1006,1023,-17,"US",2173,"N770UW","LGA","DCA",42,214,9,0,2013-11-08 09:00:00 +2013,11,8,902,906,-4,1020,1019,1,"EV",5858,"N18557","EWR","DCA",41,199,9,6,2013-11-08 09:00:00 +2013,11,8,1055,1056,-1,1216,1230,-14,"EV",5309,"N738EV","LGA","BGR",55,378,10,56,2013-11-08 10:00:00 +2013,11,8,1309,1315,-6,1644,1657,-13,"US",456,"N669AW","JFK","PHX",317,2153,13,15,2013-11-08 13:00:00 +2013,11,8,1311,1315,-4,1506,1506,0,"US",802,"N174US","EWR","CLT",87,529,13,15,2013-11-08 13:00:00 +2013,11,8,1323,1325,-2,1501,1527,-26,"EV",5299,"N724EV","LGA","MEM",141,963,13,25,2013-11-08 13:00:00 +2013,11,8,1448,1450,-2,1647,1712,-25,"9E",2903,"N922XJ","JFK","CLT",86,541,14,50,2013-11-08 14:00:00 +2013,11,8,1627,1630,-3,2003,2010,-7,"VX",27,"N854VA","JFK","SFO",363,2586,16,30,2013-11-08 16:00:00 +2013,11,8,1816,1745,31,1938,1920,18,"EV",4191,"N15983","EWR","BNA",119,748,17,45,2013-11-08 17:00:00 +2013,11,8,1900,1900,0,2036,2043,-7,"UA",654,"N404UA","EWR","ORD",119,719,19,0,2013-11-08 19:00:00 +2013,11,8,1903,1910,-7,2228,2215,13,"AA",21,"N335AA","JFK","LAX",317,2475,19,10,2013-11-08 19:00:00 +2013,11,8,2143,2139,4,2308,2302,6,"B6",702,"N238JB","JFK","BUF",63,301,21,39,2013-11-08 21:00:00 +2013,11,9,624,615,9,859,915,-16,"UA",482,"N495UA","EWR","FLL",140,1065,6,15,2013-11-09 06:00:00 +2013,11,9,638,625,13,752,755,-3,"WN",3848,"N8606C","LGA","MDW",121,725,6,25,2013-11-09 06:00:00 +2013,11,9,1307,1310,-3,1546,1610,-24,"UA",624,"N411UA","EWR","MIA",144,1085,13,10,2013-11-09 13:00:00 +2013,11,9,1402,1415,-13,1530,1550,-20,"AA",1170,"N4XGAA","LGA","STL",133,888,14,15,2013-11-09 14:00:00 +2013,11,9,1529,1530,-1,1816,1829,-13,"B6",83,"N715JB","JFK","MCO",135,944,15,30,2013-11-09 15:00:00 +2013,11,9,1641,1642,-1,1918,1915,3,"EV",4705,"N11551","EWR","ATL",119,746,16,42,2013-11-09 16:00:00 +2013,11,9,1731,1730,1,2014,2022,-8,"B6",983,"N554JB","JFK","MCO",137,944,17,30,2013-11-09 17:00:00 +2013,11,9,1826,1830,-4,2155,2155,0,"DL",442,"N704X","JFK","SEA",353,2422,18,30,2013-11-09 18:00:00 +2013,11,9,2015,2001,14,2247,2252,-5,"B6",883,"N510JB","JFK","MCO",130,944,20,1,2013-11-09 20:00:00 +2013,11,9,2046,2050,-4,108,135,-27,"UA",1071,"N37253","EWR","BQN",184,1585,20,50,2013-11-09 20:00:00 +2013,11,10,551,600,-9,846,905,-19,"AA",1175,"N3AUAA","LGA","MIA",150,1096,6,0,2013-11-10 06:00:00 +2013,11,10,814,810,4,1100,1108,-8,"DL",1109,"N340NB","LGA","TPA",150,1010,8,10,2013-11-10 08:00:00 +2013,11,10,921,930,-9,1157,1221,-24,"B6",199,"N638JB","LGA","MCO",136,950,9,30,2013-11-10 09:00:00 +2013,11,10,1152,1150,2,1508,1526,-18,"UA",1723,"N73259","EWR","SFO",357,2565,11,50,2013-11-10 11:00:00 +2013,11,10,1414,1328,46,1553,1530,23,"EV",5299,"N722EV","LGA","MEM",138,963,13,28,2013-11-10 13:00:00 +2013,11,10,1551,1549,2,1841,1859,-18,"UA",1023,"N38446","EWR","RSW",154,1068,15,49,2013-11-10 15:00:00 +2013,11,10,1555,1600,-5,1737,1741,-4,"UA",1051,"N23708","LGA","ORD",129,733,16,0,2013-11-10 16:00:00 +2013,11,10,1557,1600,-3,1850,1903,-13,"B6",305,"N566JB","EWR","FLL",156,1065,16,0,2013-11-10 16:00:00 +2013,11,10,1725,1729,-4,2027,1951,36,"F9",837,"N206FR","LGA","DEN",242,1620,17,29,2013-11-10 17:00:00 +2013,11,10,1825,1829,-4,2035,2033,2,"US",1751,"N156UW","EWR","CLT",84,529,18,29,2013-11-10 18:00:00 +2013,11,10,1833,1834,-1,2125,2100,25,"9E",2923,"N294PQ","JFK","MSP",175,1029,18,34,2013-11-10 18:00:00 +2013,11,10,2021,2025,-4,2304,2335,-31,"UA",256,"N825UA","EWR","MIA",145,1085,20,25,2013-11-10 20:00:00 +2013,11,11,743,750,-7,851,912,-21,"EV",3815,"N29917","EWR","ROC",48,246,7,50,2013-11-11 07:00:00 +2013,11,11,811,815,-4,1021,1052,-31,"DL",1429,"N651DL","JFK","LAS",291,2248,8,15,2013-11-11 08:00:00 +2013,11,11,932,936,-4,1035,1052,-17,"B6",116,"N267JB","JFK","SYR",46,209,9,36,2013-11-11 09:00:00 +2013,11,11,957,1000,-3,1341,1333,8,"DL",469,"N705TW","JFK","SFO",351,2586,10,0,2013-11-11 10:00:00 +2013,11,11,1052,1100,-8,1142,1210,-28,"US",2144,"N953UW","LGA","BOS",32,184,11,0,2013-11-11 11:00:00 +2013,11,11,1258,1259,-1,1527,1546,-19,"UA",866,"N460UA","EWR","LAS",309,2227,12,59,2013-11-11 12:00:00 +2013,11,11,1334,1330,4,1618,1634,-16,"B6",431,"N579JB","LGA","SRQ",145,1047,13,30,2013-11-11 13:00:00 +2013,11,11,1444,1449,-5,1728,1803,-35,"UA",501,"N479UA","LGA","IAH",205,1416,14,49,2013-11-11 14:00:00 +2013,11,11,1500,1505,-5,1717,1655,22,"MQ",3391,"N803MQ","LGA","CMH",80,479,15,5,2013-11-11 15:00:00 +2013,11,11,1543,1545,-2,1756,1756,0,"EV",4576,"N13989","EWR","GRR",113,605,15,45,2013-11-11 15:00:00 +2013,11,11,1600,1545,15,1836,1815,21,"WN",3778,"N727SW","EWR","DEN",253,1605,15,45,2013-11-11 15:00:00 +2013,11,11,1756,1800,-4,1930,1944,-14,"EV",5451,"N723EV","LGA","PIT",58,335,18,0,2013-11-11 18:00:00 +2013,11,11,1926,1855,31,2122,2035,47,"AA",359,"N547AA","LGA","ORD",132,733,18,55,2013-11-11 18:00:00 +2013,11,12,619,623,-4,750,738,12,"EV",4533,"N14570","EWR","BUF",56,282,6,23,2013-11-12 06:00:00 +2013,11,12,726,730,-4,823,844,-21,"UA",424,"N413UA","EWR","BOS",35,200,7,30,2013-11-12 07:00:00 +2013,11,12,1244,1245,-1,1558,1555,3,"WN",1428,"N905WN","EWR","HOU",239,1411,12,45,2013-11-12 12:00:00 +2013,11,12,1346,1259,47,1617,1511,66,"EV",5207,"N716EV","LGA","CLT",93,544,12,59,2013-11-12 12:00:00 +2013,11,12,1713,1630,43,1959,1940,19,"AA",181,"N328AA","JFK","LAX",317,2475,16,30,2013-11-12 16:00:00 +2013,11,12,1713,1710,3,1956,2017,-21,"DL",1519,"N385DN","EWR","SLC",267,1969,17,10,2013-11-12 17:00:00 +2013,11,12,1812,1804,8,2126,2135,-9,"UA",1481,"N37468","EWR","PHX",285,2133,18,4,2013-11-12 18:00:00 +2013,11,12,1928,1929,-1,2158,2222,-24,"DL",1729,"N380DA","JFK","LAS",295,2248,19,29,2013-11-12 19:00:00 +2013,11,12,2304,2250,14,24,8,16,"B6",2002,"N329JB","JFK","BUF",55,301,22,50,2013-11-12 22:00:00 +2013,11,13,753,800,-7,1048,1053,-5,"DL",1959,"N624AG","JFK","MCO",137,944,8,0,2013-11-13 08:00:00 +2013,11,13,908,915,-7,1232,1235,-3,"DL",874,"N963DL","LGA","MIA",150,1096,9,15,2013-11-13 09:00:00 +2013,11,13,916,900,16,1145,1139,6,"DL",1747,"N3757D","LGA","ATL",101,762,9,0,2013-11-13 09:00:00 +2013,11,13,954,959,-5,1110,1116,-6,"EV",5711,"N827AS","JFK","IAD",50,228,9,59,2013-11-13 09:00:00 +2013,11,13,1007,1015,-8,1159,1218,-19,"US",893,"N172US","JFK","CLT",83,541,10,15,2013-11-13 10:00:00 +2013,11,13,1024,853,91,1259,1207,52,"UA",378,"N455UA","EWR","IAH",186,1400,8,53,2013-11-13 08:00:00 +2013,11,13,1042,1045,-3,1250,1320,-30,"EV",4679,"N14203","EWR","JAX",113,820,10,45,2013-11-13 10:00:00 +2013,11,13,1126,1125,1,1253,1310,-17,"AA",327,"N3CCAA","LGA","ORD",107,733,11,25,2013-11-13 11:00:00 +2013,11,13,1255,1300,-5,1521,1550,-29,"AA",1145,"N3KWAA","LGA","DFW",181,1389,13,0,2013-11-13 13:00:00 +2013,11,13,1629,1621,8,1905,1839,26,"EV",5601,"N717EV","LGA","CLT",79,544,16,21,2013-11-13 16:00:00 +2013,11,13,1750,1650,60,2023,1920,63,"WN",356,"N281WN","LGA","DEN",212,1620,16,50,2013-11-13 16:00:00 +2013,11,13,1807,1808,-1,2047,2134,-47,"UA",1165,"N14214","EWR","LAX",310,2454,18,8,2013-11-13 18:00:00 +2013,11,13,1825,1830,-5,2127,2149,-22,"DL",413,"N999DN","JFK","MIA",141,1089,18,30,2013-11-13 18:00:00 +2013,11,13,1856,1858,-2,2201,2210,-9,"UA",541,"N459UA","EWR","SEA",326,2402,18,58,2013-11-13 18:00:00 +2013,11,13,1937,1920,17,2103,2055,8,"WN",152,"N284WN","LGA","MKE",106,738,19,20,2013-11-13 19:00:00 +2013,11,14,556,600,-4,716,719,-3,"EV",6177,"N16963","EWR","IAD",42,212,6,0,2013-11-14 06:00:00 +2013,11,14,604,600,4,926,933,-7,"UA",1668,"N24224","EWR","SFO",355,2565,6,0,2013-11-14 06:00:00 +2013,11,14,1012,1018,-6,1128,1137,-9,"EV",6054,"N16546","EWR","IAD",43,212,10,18,2013-11-14 10:00:00 +2013,11,14,1022,1025,-3,1343,1400,-17,"UA",642,"N595UA","JFK","SFO",353,2586,10,25,2013-11-14 10:00:00 +2013,11,14,1023,1025,-2,1121,1127,-6,"B6",518,"N318JB","JFK","BOS",41,187,10,25,2013-11-14 10:00:00 +2013,11,14,1024,1030,-6,1311,1324,-13,"B6",925,"N587JB","JFK","TPA",142,1005,10,30,2013-11-14 10:00:00 +2013,11,14,1146,1145,1,1258,1315,-17,"WN",172,"N7738A","LGA","MDW",110,725,11,45,2013-11-14 11:00:00 +2013,11,14,1219,1200,19,1447,1437,10,"DL",1947,"N980DL","LGA","ATL",111,762,12,0,2013-11-14 12:00:00 +2013,11,14,1452,1455,-3,1942,1951,-9,"DL",1,"N3745B","JFK","SJU",197,1598,14,55,2013-11-14 14:00:00 +2013,11,14,1953,2000,-7,2104,2117,-13,"9E",2950,"N8847A","JFK","BWI",36,184,20,0,2013-11-14 20:00:00 +2013,11,15,610,615,-5,806,818,-12,"US",1989,"N171US","EWR","CLT",86,529,6,15,2013-11-15 06:00:00 +2013,11,15,656,700,-4,1008,1015,-7,"B6",23,"N827JB","JFK","LAX",348,2475,7,0,2013-11-15 07:00:00 +2013,11,15,1056,1100,-4,1237,1304,-27,"DL",1869,"N314NB","LGA","DTW",80,502,11,0,2013-11-15 11:00:00 +2013,11,15,1448,1450,-2,1600,1624,-24,"9E",2936,"N8894A","JFK","IAD",47,228,14,50,2013-11-15 14:00:00 +2013,11,15,1527,1530,-3,1844,1845,-1,"AA",85,"N347AA","JFK","SFO",351,2586,15,30,2013-11-15 15:00:00 +2013,11,15,1626,1635,-9,1753,1815,-22,"MQ",2949,"N691MQ","JFK","BNA",126,765,16,35,2013-11-15 16:00:00 +2013,11,15,1937,1935,2,2134,2120,14,"9E",2909,"N922XJ","JFK","RIC",61,288,19,35,2013-11-15 19:00:00 +2013,11,16,722,725,-3,839,900,-21,"WN",2020,"N621SW","EWR","BNA",119,748,7,25,2013-11-16 07:00:00 +2013,11,16,829,800,29,1128,1100,28,"AA",33,"N336AA","JFK","LAX",339,2475,8,0,2013-11-16 08:00:00 +2013,11,16,922,930,-8,1209,1237,-28,"B6",271,"N598JB","LGA","FLL",151,1076,9,30,2013-11-16 09:00:00 +2013,11,16,929,935,-6,1229,1244,-15,"DL",1174,"N317NB","LGA","PBI",150,1035,9,35,2013-11-16 09:00:00 +2013,11,16,1307,1315,-8,1609,1630,-21,"B6",1639,"N635JB","LGA","RSW",158,1080,13,15,2013-11-16 13:00:00 +2013,11,16,1425,1429,-4,1727,1737,-10,"B6",301,"N746JB","JFK","FLL",141,1069,14,29,2013-11-16 14:00:00 +2013,11,16,1627,1530,57,1948,1905,43,"UA",257,"N510UA","JFK","SFO",361,2586,15,30,2013-11-16 15:00:00 +2013,11,16,1647,1642,5,1915,1915,0,"EV",4705,"N13553","EWR","ATL",122,746,16,42,2013-11-16 16:00:00 +2013,11,16,1747,1559,108,1934,1746,108,"B6",1105,"N192JB","JFK","ORD",129,740,15,59,2013-11-16 15:00:00 +2013,11,16,1927,1629,178,2200,1932,148,"B6",1161,"N640JB","LGA","PBI",139,1035,16,29,2013-11-16 16:00:00 +2013,11,16,1955,2005,-10,2231,2310,-39,"B6",1201,"N329JB","JFK","FLL",140,1069,20,5,2013-11-16 20:00:00 +2013,11,17,3,2250,73,111,2356,75,"B6",1816,"N265JB","JFK","SYR",44,209,22,50,2013-11-17 22:00:00 +2013,11,17,622,630,-8,831,835,-4,"US",1946,"N172US","EWR","CLT",102,529,6,30,2013-11-17 06:00:00 +2013,11,17,1136,1130,6,1342,1344,-2,"DL",2219,"N922DL","LGA","MSP",149,1020,11,30,2013-11-17 11:00:00 +2013,11,17,1352,1400,-8,1453,1515,-22,"US",2183,"N732US","LGA","DCA",40,214,14,0,2013-11-17 14:00:00 +2013,11,17,1532,1515,17,1705,1656,9,"9E",2933,"N919XJ","JFK","ROC",47,264,15,15,2013-11-17 15:00:00 +2013,11,17,1726,1715,11,2030,1905,85,"AA",345,"N4YSAA","LGA","ORD",149,733,17,15,2013-11-17 17:00:00 +2013,11,17,2026,2020,6,7,2359,8,"UA",1651,"N27205","EWR","SFO",384,2565,20,20,2013-11-17 20:00:00 +2013,11,17,2052,2050,2,107,135,-28,"UA",1071,"N14250","EWR","BQN",179,1585,20,50,2013-11-17 20:00:00 +2013,11,18,624,630,-6,928,938,-10,"B6",929,"N760JB","JFK","RSW",159,1074,6,30,2013-11-18 06:00:00 +2013,11,18,654,700,-6,930,951,-21,"DL",2285,"N371NW","LGA","MCO",132,950,7,0,2013-11-18 07:00:00 +2013,11,18,845,820,25,1218,1155,23,"UA",1043,"N27421","EWR","PHX",307,2133,8,20,2013-11-18 08:00:00 +2013,11,18,1404,1406,-2,1709,1722,-13,"B6",895,"N649JB","JFK","AUS",228,1521,14,6,2013-11-18 14:00:00 +2013,11,18,1455,1505,-10,1645,1655,-10,"MQ",3391,"N832MQ","LGA","CMH",85,479,15,5,2013-11-18 15:00:00 +2013,11,18,1645,1645,0,1908,1909,-1,"DL",2042,"N338NB","EWR","ATL",111,746,16,45,2013-11-18 16:00:00 +2013,11,18,1708,1659,9,1852,1859,-7,"DL",1518,"N355NW","EWR","DTW",86,488,16,59,2013-11-18 16:00:00 +2013,11,18,1714,1720,-6,2021,2030,-9,"AA",291,"N3AGAA","JFK","AUS",227,1521,17,20,2013-11-18 17:00:00 +2013,11,18,2213,2015,118,38,2312,86,"UA",479,"N422UA","EWR","IAH",190,1400,20,15,2013-11-18 20:00:00 +2013,11,19,627,630,-3,855,901,-6,"DL",479,"N3771K","JFK","ATL",113,760,6,30,2013-11-19 06:00:00 +2013,11,19,637,640,-3,758,805,-7,"WN",1121,"N927WN","LGA","MKE",119,738,6,40,2013-11-19 06:00:00 +2013,11,19,755,805,-10,1045,1104,-19,"DL",346,"N305DQ","JFK","TPA",144,1005,8,5,2013-11-19 08:00:00 +2013,11,19,832,840,-8,1109,1115,-6,"EV",4388,"N13970","EWR","JAX",123,820,8,40,2013-11-19 08:00:00 +2013,11,19,832,835,-3,958,1000,-2,"MQ",3355,"N1EAMQ","LGA","BNA",113,764,8,35,2013-11-19 08:00:00 +2013,11,19,1146,1145,1,1321,1315,6,"WN",172,"N954WN","LGA","MDW",117,725,11,45,2013-11-19 11:00:00 +2013,11,19,1224,1230,-6,1454,1516,-22,"B6",127,"N599JB","EWR","MCO",134,937,12,30,2013-11-19 12:00:00 +2013,11,19,1225,1229,-4,1326,1335,-9,"UA",551,"N818UA","EWR","BOS",41,200,12,29,2013-11-19 12:00:00 +2013,11,19,1255,1259,-4,1439,1438,1,"UA",1198,"N76505","LGA","ORD",121,733,12,59,2013-11-19 12:00:00 +2013,11,19,1552,1600,-8,1857,1905,-8,"AA",1156,"N3ESAA","LGA","DFW",202,1389,16,0,2013-11-19 16:00:00 +2013,11,19,1633,1632,1,2007,2014,-7,"UA",1284,"N37422","EWR","SFO",364,2565,16,32,2013-11-19 16:00:00 +2013,11,19,1721,1725,-4,2027,2040,-13,"VX",169,"N637VA","EWR","LAX",340,2454,17,25,2013-11-19 17:00:00 +2013,11,20,625,629,-4,730,744,-14,"EV",4533,"N14573","EWR","BUF",47,282,6,29,2013-11-20 06:00:00 +2013,11,20,715,730,-15,1017,1055,-38,"VX",183,"N837VA","EWR","SFO",349,2565,7,30,2013-11-20 07:00:00 +2013,11,20,947,959,-12,1101,1116,-15,"EV",5711,"N829AS","JFK","IAD",53,228,9,59,2013-11-20 09:00:00 +2013,11,20,1023,1025,-2,1231,1247,-16,"EV",4495,"N11548","EWR","SAV",113,708,10,25,2013-11-20 10:00:00 +2013,11,20,1454,1500,-6,1803,1803,0,"DL",1935,"N365NB","LGA","TPA",146,1010,15,0,2013-11-20 15:00:00 +2013,11,20,1659,1710,-11,1837,1900,-23,"EV",4202,"N14923","EWR","STL",137,872,17,10,2013-11-20 17:00:00 +2013,11,20,2055,2100,-5,2202,2206,-4,"US",2164,"N961UW","LGA","BOS",38,184,21,0,2013-11-20 21:00:00 +2013,11,21,836,843,-7,1037,1051,-14,"US",2071,"N770UW","LGA","CLT",90,544,8,43,2013-11-21 08:00:00 +2013,11,21,1300,1300,0,1541,1538,3,"DL",781,"N929DL","LGA","ATL",120,762,13,0,2013-11-21 13:00:00 +2013,11,21,1545,1545,0,1744,1810,-26,"MQ",2963,"N652MQ","JFK","CVG",97,589,15,45,2013-11-21 15:00:00 +2013,11,21,1608,1610,-2,1911,1918,-7,"UA",1064,"N36469","EWR","FLL",160,1065,16,10,2013-11-21 16:00:00 +2013,11,21,1725,1705,20,2043,2015,28,"AA",67,"N3FYAA","JFK","SAN",353,2446,17,5,2013-11-21 17:00:00 +2013,11,21,1808,1810,-2,2118,2129,-11,"B6",1013,"N729JB","JFK","LGB",352,2465,18,10,2013-11-21 18:00:00 +2013,11,21,1916,1900,16,2149,2136,13,"DL",947,"N984DL","LGA","ATL",116,762,19,0,2013-11-21 19:00:00 +2013,11,21,2141,2150,-9,2247,2311,-24,"EV",3846,"N14562","EWR","ROC",46,246,21,50,2013-11-21 21:00:00 +2013,11,22,650,655,-5,831,815,16,"WN",3792,"N907WN","LGA","MKE",136,738,6,55,2013-11-22 06:00:00 +2013,11,22,654,655,-1,1031,940,51,"AA",1263,"N3HMAA","JFK","LAS",356,2248,6,55,2013-11-22 06:00:00 +2013,11,22,718,725,-7,924,927,-3,"DL",831,"N347NB","LGA","DTW",93,502,7,25,2013-11-22 07:00:00 +2013,11,22,802,810,-8,1053,1108,-15,"DL",1109,"N314NB","LGA","TPA",140,1010,8,10,2013-11-22 08:00:00 +2013,11,22,827,830,-3,1125,1100,25,"F9",509,"N213FR","LGA","DEN",259,1620,8,30,2013-11-22 08:00:00 +2013,11,22,1206,1200,6,1533,1526,7,"UA",766,"N512UA","JFK","SFO",363,2586,12,0,2013-11-22 12:00:00 +2013,11,22,1938,1900,38,2037,2018,19,"US",2193,"N748UW","LGA","DCA",42,214,19,0,2013-11-22 19:00:00 +2013,11,22,2249,2159,50,4,2322,42,"EV",5311,"N615QX","LGA","BGR",53,378,21,59,2013-11-22 21:00:00 +2013,11,22,2308,1914,234,235,2158,277,"UA",324,"N523UA","EWR","LAS",364,2227,19,14,2013-11-22 19:00:00 +2013,11,23,747,730,17,1039,1026,13,"UA",1148,"N37470","EWR","TPA",151,997,7,30,2013-11-23 07:00:00 +2013,11,23,940,813,87,1043,924,79,"EV",4625,"N14177","EWR","BWI",37,169,8,13,2013-11-23 08:00:00 +2013,11,23,1037,1045,-8,1340,1352,-12,"DL",2506,"N340NB","LGA","FLL",151,1076,10,45,2013-11-23 10:00:00 +2013,11,23,1111,1119,-8,1437,1432,5,"UA",703,"N588UA","JFK","LAX",359,2475,11,19,2013-11-23 11:00:00 +2013,11,23,2022,2015,7,2306,2314,-8,"UA",1466,"N17229","EWR","IAH",209,1400,20,15,2013-11-23 20:00:00 +2013,11,24,741,730,11,1222,1220,2,"B6",1289,"N715JB","EWR","SJU",192,1608,7,30,2013-11-24 07:00:00 +2013,11,24,827,825,2,1029,1029,0,"US",2053,"N105UW","JFK","CLT",99,541,8,25,2013-11-24 08:00:00 +2013,11,24,1107,945,82,1318,1203,75,"EV",5443,"N751EV","LGA","CLT",89,544,9,45,2013-11-24 09:00:00 +2013,11,24,1351,1350,1,1650,1705,-15,"AA",1073,"N3GRAA","LGA","MIA",150,1096,13,50,2013-11-24 13:00:00 +2013,11,24,1428,1435,-7,1602,1625,-23,"EV",5391,"N741EV","LGA","MSN",124,812,14,35,2013-11-24 14:00:00 +2013,11,24,1510,1520,-10,1704,1701,3,"9E",2958,"N8416B","JFK","ROC",58,264,15,20,2013-11-24 15:00:00 +2013,11,24,1754,1720,34,2029,2030,-1,"AA",2488,"N437AA","EWR","DFW",199,1372,17,20,2013-11-24 17:00:00 +2013,11,24,2014,2019,-5,2320,2345,-25,"UA",1224,"N73276","EWR","LAX",332,2454,20,19,2013-11-24 20:00:00 +2013,11,24,2037,2015,22,2335,2354,-19,"DL",427,"N199DN","JFK","LAX",312,2475,20,15,2013-11-24 20:00:00 +2013,11,24,2058,2050,8,133,135,-2,"UA",1071,"N77258","EWR","BQN",190,1585,20,50,2013-11-24 20:00:00 +2013,11,25,752,800,-8,906,936,-30,"UA",711,"N468UA","LGA","ORD",119,733,8,0,2013-11-25 08:00:00 +2013,11,25,754,800,-6,1055,1115,-20,"AA",2267,"N3GLAA","LGA","MIA",154,1096,8,0,2013-11-25 08:00:00 +2013,11,25,852,855,-3,1315,1345,-30,"DL",301,"N709TW","JFK","SJU",188,1598,8,55,2013-11-25 08:00:00 +2013,11,25,1011,1020,-9,1157,1205,-8,"MQ",3466,"N817MQ","LGA","RDU",72,431,10,20,2013-11-25 10:00:00 +2013,11,25,1037,1047,-10,1328,1353,-25,"B6",971,"N613JB","LGA","FLL",151,1076,10,47,2013-11-25 10:00:00 +2013,11,25,1624,1630,-6,1942,1952,-10,"DL",1373,"N329NW","JFK","MIA",159,1089,16,30,2013-11-25 16:00:00 +2013,11,25,1933,1930,3,2137,2138,-1,"EV",4361,"N16954","EWR","TYS",103,631,19,30,2013-11-25 19:00:00 +2013,11,25,2100,2033,27,2224,2206,18,"FL",1159,"N961AT","LGA","CAK",68,397,20,33,2013-11-25 20:00:00 +2013,11,26,626,630,-4,826,830,-4,"MQ",3599,"N527MQ","LGA","MSP",161,1020,6,30,2013-11-26 06:00:00 +2013,11,26,837,842,-5,1006,953,13,"EV",3809,"N13955","EWR","SYR",41,195,8,42,2013-11-26 08:00:00 +2013,11,26,1203,1200,3,1455,1500,-5,"DL",1685,"N998DL","LGA","MCO",143,950,12,0,2013-11-26 12:00:00 +2013,11,26,1257,1300,-3,1534,1538,-4,"DL",781,"N980DL","LGA","ATL",129,762,13,0,2013-11-26 13:00:00 +2013,11,26,1359,1405,-6,1655,1712,-17,"UA",223,"N818UA","EWR","SAN",333,2425,14,5,2013-11-26 14:00:00 +2013,11,26,1524,1510,14,1848,1835,13,"AA",1327,"N3BXAA","LGA","PBI",161,1035,15,10,2013-11-26 15:00:00 +2013,11,26,1538,1543,-5,1801,1752,9,"EV",4667,"N17185","EWR","MSP",150,1008,15,43,2013-11-26 15:00:00 +2013,11,26,1550,1555,-5,1734,1740,-6,"EV",5091,"N744EV","LGA","PIT",63,335,15,55,2013-11-26 15:00:00 +2013,11,26,1642,1645,-3,1750,1805,-15,"EV",4662,"N14907","EWR","ROC",45,246,16,45,2013-11-26 16:00:00 +2013,11,26,1644,1645,-1,1950,2010,-20,"AA",181,"N335AA","JFK","LAX",330,2475,16,45,2013-11-26 16:00:00 +2013,11,26,1844,1830,14,2152,2205,-13,"B6",669,"N519JB","JFK","SJC",341,2569,18,30,2013-11-26 18:00:00 +2013,11,26,1957,2000,-3,2110,2110,0,"AA",2314,"N3KKAA","JFK","BOS",40,187,20,0,2013-11-26 20:00:00 +2013,11,27,629,630,-1,951,922,29,"UA",1627,"N87531","EWR","PBI",179,1023,6,30,2013-11-27 06:00:00 +2013,11,27,748,743,5,1228,1230,-2,"UA",1216,"N37427","EWR","SJU",200,1608,7,43,2013-11-27 07:00:00 +2013,11,27,809,810,-1,1046,1034,12,"DL",2457,"N360NB","LGA","MSY",184,1183,8,10,2013-11-27 08:00:00 +2013,11,27,857,857,0,1156,1210,-14,"UA",997,"N578UA","EWR","LAX",322,2454,8,57,2013-11-27 08:00:00 +2013,11,27,907,915,-8,1231,1235,-4,"DL",874,"N359NB","LGA","MIA",180,1096,9,15,2013-11-27 09:00:00 +2013,11,27,1613,1505,68,1916,1735,101,"EV",5199,"N744EV","LGA","CHS",122,641,15,5,2013-11-27 15:00:00 +2013,11,27,1730,1630,60,2050,2010,40,"VX",27,"N853VA","JFK","SFO",349,2586,16,30,2013-11-27 16:00:00 +2013,11,27,1842,1830,12,2103,2035,28,"US",425,"N553UW","JFK","CLT",91,541,18,30,2013-11-27 18:00:00 +2013,11,27,2036,2030,6,2141,2150,-9,"MQ",3604,"N516MQ","EWR","ORD",103,719,20,30,2013-11-27 20:00:00 +2013,11,27,2059,2000,59,46,2325,81,"VX",415,"N623VA","JFK","LAX",342,2475,20,0,2013-11-27 20:00:00 +2013,11,28,604,610,-6,754,810,-16,"DL",1919,"N908DE","LGA","MSP",150,1020,6,10,2013-11-28 06:00:00 +2013,11,28,842,822,20,1034,1023,11,"EV",4691,"N14570","EWR","DAY",91,533,8,22,2013-11-28 08:00:00 +2013,11,28,928,915,13,1037,1050,-13,"EV",5220,"N759EV","LGA","ROC",44,254,9,15,2013-11-28 09:00:00 +2013,11,28,949,959,-10,1101,1116,-15,"EV",5711,"N827AS","JFK","IAD",50,228,9,59,2013-11-28 09:00:00 +2013,11,28,2129,2135,-6,38,55,-17,"AA",185,"N338AA","JFK","LAX",347,2475,21,35,2013-11-28 21:00:00 +2013,11,29,654,700,-6,812,836,-24,"UA",331,"N405UA","LGA","ORD",121,733,7,0,2013-11-29 07:00:00 +2013,11,29,925,930,-5,1219,1237,-18,"B6",271,"N663JB","LGA","FLL",157,1076,9,30,2013-11-29 09:00:00 +2013,11,29,1037,1040,-3,1201,1159,2,"B6",2602,"N329JB","JFK","BUF",67,301,10,40,2013-11-29 10:00:00 +2013,11,29,1213,1215,-2,1536,1531,5,"UA",1075,"N17719","EWR","SNA",361,2434,12,15,2013-11-29 12:00:00 +2013,11,29,1240,1247,-7,1357,1415,-18,"EV",4682,"N11539","EWR","PIT",60,319,12,47,2013-11-29 12:00:00 +2013,11,29,1409,1425,-16,1619,1653,-34,"FL",1070,"N955AT","LGA","ATL",112,762,14,25,2013-11-29 14:00:00 +2013,11,29,1442,1443,-1,1650,1703,-13,"EV",4181,"N16963","EWR","MCI",170,1092,14,43,2013-11-29 14:00:00 +2013,11,29,1500,1500,0,1717,1730,-13,"MQ",3669,"N1EAMQ","LGA","ATL",110,762,15,0,2013-11-29 15:00:00 +2013,11,29,1814,1820,-6,2130,2145,-15,"AA",119,"N3KAAA","EWR","LAX",353,2454,18,20,2013-11-29 18:00:00 +2013,11,30,655,700,-5,1019,1015,4,"B6",23,"N789JB","JFK","LAX",351,2475,7,0,2013-11-30 07:00:00 +2013,11,30,658,645,13,831,840,-9,"EV",4106,"N11121","EWR","STL",132,872,6,45,2013-11-30 06:00:00 +2013,11,30,802,807,-5,1048,1112,-24,"DL",1271,"N995DL","JFK","FLL",140,1069,8,7,2013-11-30 08:00:00 +2013,11,30,950,955,-5,1104,1125,-21,"MQ",3675,"N509MQ","LGA","BNA",115,764,9,55,2013-11-30 09:00:00 +2013,11,30,1357,1359,-2,1457,1508,-11,"B6",118,"N348JB","JFK","BOS",34,187,13,59,2013-11-30 13:00:00 +2013,11,30,1526,1352,94,1640,1458,102,"EV",4641,"N13975","EWR","BOS",37,200,13,52,2013-11-30 13:00:00 +2013,11,30,1629,1629,0,1905,1932,-27,"B6",1161,"N599JB","LGA","PBI",140,1035,16,29,2013-11-30 16:00:00 +2013,11,30,1752,1745,7,1905,1920,-15,"EV",4191,"N13202","EWR","BNA",110,748,17,45,2013-11-30 17:00:00 +2013,11,30,1854,1900,-6,2010,2035,-25,"EV",4522,"N16954","EWR","BNA",110,748,19,0,2013-11-30 19:00:00 +2013,11,30,1955,2000,-5,2246,2303,-17,"B6",65,"N656JB","JFK","ABQ",266,1826,20,0,2013-11-30 20:00:00 +2013,12,1,810,815,-5,1033,1042,-9,"DL",914,"N302NB","LGA","DEN",231,1620,8,15,2013-12-01 08:00:00 +2013,12,1,811,815,-4,1052,1123,-31,"B6",281,"N337JB","JFK","HOU",206,1428,8,15,2013-12-01 08:00:00 +2013,12,1,848,845,3,1202,1211,-9,"UA",1162,"N38473","EWR","SEA",345,2402,8,45,2013-12-01 08:00:00 +2013,12,1,924,924,0,1158,1205,-7,"9E",4065,"N8942A","LGA","SDF",108,659,9,24,2013-12-01 09:00:00 +2013,12,1,1208,1215,-7,1504,1531,-27,"UA",1686,"N16732","EWR","SNA",332,2434,12,15,2013-12-01 12:00:00 +2013,12,1,1305,1310,-5,1614,1607,7,"B6",553,"N292JB","JFK","PBI",156,1028,13,10,2013-12-01 13:00:00 +2013,12,1,1439,1440,-1,1629,1639,-10,"DL",1231,"N357NB","LGA","DTW",88,502,14,40,2013-12-01 14:00:00 +2013,12,1,1716,1659,17,1922,1900,22,"DL",1518,"N905DL","EWR","DTW",98,488,16,59,2013-12-01 16:00:00 +2013,12,1,2015,2025,-10,2127,2205,-38,"AA",371,"N4WLAA","LGA","ORD",107,733,20,25,2013-12-01 20:00:00 +2013,12,2,627,630,-3,951,1018,-27,"US",495,"N542UW","JFK","PHX",298,2153,6,30,2013-12-02 06:00:00 +2013,12,2,826,830,-4,935,955,-20,"9E",2912,"N904XJ","JFK","DCA",50,213,8,30,2013-12-02 08:00:00 +2013,12,2,900,900,0,1212,1215,-3,"DL",422,"N718TW","JFK","LAX",342,2475,9,0,2013-12-02 09:00:00 +2013,12,2,948,959,-11,1050,1116,-26,"EV",5711,"N825AS","JFK","IAD",42,228,9,59,2013-12-02 09:00:00 +2013,12,2,1359,1345,14,1509,1510,-1,"WN",593,"N727SW","LGA","MDW",113,725,13,45,2013-12-02 13:00:00 +2013,12,2,1803,1656,67,1921,1815,66,"EV",4240,"N17146","EWR","IAD",42,212,16,56,2013-12-02 16:00:00 +2013,12,2,2010,1956,14,2228,2234,-6,"DL",2454,"N3740C","JFK","DEN",237,1626,19,56,2013-12-02 19:00:00 +2013,12,2,2104,2115,-11,2306,2315,-9,"MQ",3384,"N539MQ","LGA","CLT",88,544,21,15,2013-12-02 21:00:00 +2013,12,3,702,700,2,1041,1030,11,"DL",2002,"N624AG","JFK","SLC",304,1990,7,0,2013-12-03 07:00:00 +2013,12,3,719,725,-6,946,1002,-16,"B6",677,"N187JB","JFK","JAX",122,828,7,25,2013-12-03 07:00:00 +2013,12,3,821,820,1,1020,1021,-1,"US",409,"N642AW","EWR","CLT",83,529,8,20,2013-12-03 08:00:00 +2013,12,3,850,900,-10,1009,1030,-21,"EV",5220,"N371CA","LGA","ROC",43,254,9,0,2013-12-03 09:00:00 +2013,12,3,1258,1305,-7,1451,1517,-26,"EV",5207,"N371CA","LGA","CLT",81,544,13,5,2013-12-03 13:00:00 +2013,12,3,1344,1315,29,1455,1445,10,"WN",2868,"N969WN","EWR","BNA",115,748,13,15,2013-12-03 13:00:00 +2013,12,3,1453,1454,-1,1937,1951,-14,"DL",2003,"N3745B","JFK","SJU",201,1598,14,54,2013-12-03 14:00:00 +2013,12,3,1500,1451,9,1621,1606,15,"EV",5801,"N13958","EWR","BUF",70,282,14,51,2013-12-03 14:00:00 +2013,12,3,1723,1730,-7,1919,1925,-6,"MQ",3526,"N5PBMQ","LGA","CMH",79,479,17,30,2013-12-03 17:00:00 +2013,12,3,1921,1930,-9,2215,2235,-20,"AA",1691,"N526AA","EWR","DFW",205,1372,19,30,2013-12-03 19:00:00 +2013,12,3,NA,1845,NA,NA,2040,NA,"MQ",3349,"N546MQ","LGA","MSP",NA,1020,18,45,2013-12-03 18:00:00 +2013,12,4,804,758,6,1153,1139,14,"UA",1246,"N38458","EWR","SFO",382,2565,7,58,2013-12-04 07:00:00 +2013,12,4,938,910,28,1224,1235,-11,"AA",1085,"N5ENAA","JFK","MIA",141,1089,9,10,2013-12-04 09:00:00 +2013,12,4,957,1000,-3,1258,1247,11,"UA",1110,"N28457","EWR","LAS",334,2227,10,0,2013-12-04 10:00:00 +2013,12,4,1122,1130,-8,1253,1327,-34,"EV",5373,"N707EV","LGA","GSO",71,461,11,30,2013-12-04 11:00:00 +2013,12,4,1253,1300,-7,1348,1410,-22,"US",2148,"N965UW","LGA","BOS",38,184,13,0,2013-12-04 13:00:00 +2013,12,4,1256,1300,-4,1539,1540,-1,"DL",781,"N977DL","LGA","ATL",116,762,13,0,2013-12-04 13:00:00 +2013,12,4,1308,1310,-2,1536,1558,-22,"UA",1641,"N67134","EWR","MCO",128,937,13,10,2013-12-04 13:00:00 +2013,12,4,1411,1420,-9,1623,1555,28,"EV",4171,"N31131","EWR","MSN",163,799,14,20,2013-12-04 14:00:00 +2013,12,4,1430,1440,-10,1623,1644,-21,"DL",1231,"N911DE","LGA","DTW",87,502,14,40,2013-12-04 14:00:00 +2013,12,4,1537,1522,15,1849,1843,6,"UA",342,"N569UA","EWR","SFO",353,2565,15,22,2013-12-04 15:00:00 +2013,12,4,1606,1606,0,1748,1745,3,"UA",635,"N515UA","LGA","ORD",125,733,16,6,2013-12-04 16:00:00 +2013,12,4,1646,1659,-13,1831,1857,-26,"EV",4640,"N13994","EWR","DAY",85,533,16,59,2013-12-04 16:00:00 +2013,12,4,1846,1850,-4,2136,2220,-44,"AA",235,"N3HBAA","JFK","SEA",329,2422,18,50,2013-12-04 18:00:00 +2013,12,5,512,515,-3,753,814,-21,"UA",1545,"N14230","EWR","IAH",204,1400,5,15,2013-12-05 05:00:00 +2013,12,5,738,745,-7,1024,1043,-19,"B6",1717,"N784JB","LGA","TPA",142,1010,7,45,2013-12-05 07:00:00 +2013,12,5,819,823,-4,1229,1201,28,"UA",1043,"N39423","EWR","PHX",314,2133,8,23,2013-12-05 08:00:00 +2013,12,5,946,947,-1,1429,1430,-1,"B6",403,"N579JB","JFK","SJU",186,1598,9,47,2013-12-05 09:00:00 +2013,12,5,1847,1630,137,2120,1905,135,"MQ",3357,"N502MQ","LGA","ATL",120,762,16,30,2013-12-05 16:00:00 +2013,12,5,1909,1900,9,2100,2035,25,"UA",693,"N469UA","LGA","ORD",131,733,19,0,2013-12-05 19:00:00 +2013,12,5,2027,1930,57,2132,2052,40,"9E",2959,"N8970D","JFK","SYR",39,209,19,30,2013-12-05 19:00:00 +2013,12,5,NA,1800,NA,NA,1944,NA,"9E",4218,NA,"LGA","PIT",NA,335,18,0,2013-12-05 18:00:00 +2013,12,5,NA,2159,NA,NA,2359,NA,"EV",3845,"N14570","EWR","GSP",NA,594,21,59,2013-12-05 21:00:00 +2013,12,5,NA,2104,NA,NA,2221,NA,"EV",4119,"N11551","EWR","RIC",NA,277,21,4,2013-12-05 21:00:00 +2013,12,5,NA,1000,NA,NA,1113,NA,"US",2142,NA,"LGA","BOS",NA,184,10,0,2013-12-05 10:00:00 +2013,12,6,625,630,-5,928,938,-10,"B6",929,"N594JB","JFK","RSW",162,1074,6,30,2013-12-06 06:00:00 +2013,12,6,921,917,4,1226,1226,0,"UA",1170,"N37267","EWR","FLL",151,1065,9,17,2013-12-06 09:00:00 +2013,12,6,1129,1134,-5,1435,1428,7,"UA",249,"N472UA","EWR","TPA",148,997,11,34,2013-12-06 11:00:00 +2013,12,6,1240,1215,25,1522,1445,37,"MQ",3670,"N502MQ","LGA","ATL",122,762,12,15,2013-12-06 12:00:00 +2013,12,6,1351,1400,-9,1440,1509,-29,"B6",118,"N375JB","JFK","BOS",37,187,14,0,2013-12-06 14:00:00 +2013,12,6,1658,1700,-2,1913,1840,33,"WN",2960,"N291WN","LGA","BNA",141,764,17,0,2013-12-06 17:00:00 +2013,12,6,1849,1805,44,2024,1930,54,"WN",1710,"N273WN","EWR","MDW",121,711,18,5,2013-12-06 18:00:00 +2013,12,6,1958,2002,-4,2104,2121,-17,"UA",1703,"N36444","EWR","BOS",39,200,20,2,2013-12-06 20:00:00 +2013,12,6,2357,2359,-2,454,445,9,"B6",745,"N584JB","JFK","PSE",204,1617,23,59,2013-12-06 23:00:00 +2013,12,6,NA,1115,NA,NA,1425,NA,"AA",1139,"N3ERAA","LGA","DFW",NA,1389,11,15,2013-12-06 11:00:00 +2013,12,6,NA,1706,NA,NA,1911,NA,"EV",4411,"N14953","EWR","MEM",NA,946,17,6,2013-12-06 17:00:00 +2013,12,7,604,605,-1,716,724,-8,"EV",5747,"N909EV","LGA","IAD",55,229,6,5,2013-12-07 06:00:00 +2013,12,7,727,730,-3,1023,1042,-19,"DL",874,"N376NW","LGA","MIA",159,1096,7,30,2013-12-07 07:00:00 +2013,12,7,919,920,-1,1321,1245,36,"VX",407,"N641VA","JFK","LAX",395,2475,9,20,2013-12-07 09:00:00 +2013,12,7,1044,930,74,1330,1237,53,"B6",271,"N516JB","LGA","FLL",152,1076,9,30,2013-12-07 09:00:00 +2013,12,7,1139,1147,-8,1531,1457,34,"B6",323,"N784JB","JFK","LAX",395,2475,11,47,2013-12-07 11:00:00 +2013,12,7,1209,1216,-7,1519,1526,-7,"B6",1129,"N595JB","JFK","RSW",169,1074,12,16,2013-12-07 12:00:00 +2013,12,7,1818,1830,-12,2021,2050,-29,"DL",2331,"N954DL","JFK","DTW",95,509,18,30,2013-12-07 18:00:00 +2013,12,7,1910,1915,-5,2157,2213,-16,"DL",2159,"N913DL","JFK","MCO",137,944,19,15,2013-12-07 19:00:00 +2013,12,7,2024,2025,-1,2328,2255,33,"DL",436,"N3762Y","JFK","DEN",266,1626,20,25,2013-12-07 20:00:00 +2013,12,8,1211,1220,-9,1354,1350,4,"MQ",3461,"N832MQ","LGA","BNA",138,764,12,20,2013-12-08 12:00:00 +2013,12,8,1313,1314,-1,1645,1629,16,"B6",1639,"N506JB","LGA","RSW",174,1080,13,14,2013-12-08 13:00:00 +2013,12,8,1348,1259,49,1546,1454,52,"MQ",3388,"N827MQ","LGA","CMH",99,479,12,59,2013-12-08 12:00:00 +2013,12,8,1528,1530,-2,1809,1758,11,"DL",1942,"N787NC","EWR","ATL",130,746,15,30,2013-12-08 15:00:00 +2013,12,8,1830,1800,30,2130,2036,54,"DL",926,"N979AT","EWR","ATL",124,746,18,0,2013-12-08 18:00:00 +2013,12,8,2306,2229,37,14,2343,31,"B6",234,"N183JB","JFK","BTV",45,266,22,29,2013-12-08 22:00:00 +2013,12,8,NA,1900,NA,NA,2359,NA,"AA",1029,"N617AA","JFK","SJU",NA,1598,19,0,2013-12-08 19:00:00 +2013,12,9,1127,905,142,1227,1024,123,"B6",208,"N304JB","JFK","PWM",42,273,9,5,2013-12-09 09:00:00 +2013,12,9,1159,1200,-1,1439,1400,39,"US",2069,"N105UW","JFK","CLT",102,541,12,0,2013-12-09 12:00:00 +2013,12,9,1224,1230,-6,1533,1544,-11,"DL",406,"N392DA","JFK","MIA",157,1089,12,30,2013-12-09 12:00:00 +2013,12,9,1258,1300,-2,1425,1413,12,"US",2181,"N741UW","LGA","DCA",48,214,13,0,2013-12-09 13:00:00 +2013,12,9,1405,1354,11,1655,1647,8,"UA",1149,"N18223","EWR","PBI",149,1023,13,54,2013-12-09 13:00:00 +2013,12,9,1601,1455,66,1716,1625,51,"MQ",3425,"N523MQ","JFK","DCA",48,213,14,55,2013-12-09 14:00:00 +2013,12,9,1858,1800,58,2044,1940,64,"MQ",3501,"N834MQ","LGA","RDU",78,431,18,0,2013-12-09 18:00:00 +2013,12,9,1947,1912,35,2123,2048,35,"9E",2958,"N836AY","JFK","ORF",53,290,19,12,2013-12-09 19:00:00 +2013,12,9,2227,2229,-2,2400,2351,9,"B6",486,"N183JB","JFK","ROC",61,264,22,29,2013-12-09 22:00:00 +2013,12,10,634,632,2,920,925,-5,"UA",478,"N475UA","EWR","MCO",147,937,6,32,2013-12-10 06:00:00 +2013,12,10,656,650,6,1031,1022,9,"UA",1668,"N75428","EWR","SFO",366,2565,6,50,2013-12-10 06:00:00 +2013,12,10,944,905,39,1221,1115,66,"DL",181,"N359NW","LGA","DTW",92,502,9,5,2013-12-10 09:00:00 +2013,12,10,1003,917,46,1404,1226,98,"UA",1170,"N35260","EWR","FLL",166,1065,9,17,2013-12-10 09:00:00 +2013,12,10,1014,930,44,1732,1527,125,"UA",15,"N78060","EWR","HNL",653,4963,9,30,2013-12-10 09:00:00 +2013,12,10,1030,1030,0,1325,1254,31,"DL",838,"N978AT","EWR","ATL",128,746,10,30,2013-12-10 10:00:00 +2013,12,10,1300,1300,0,1455,1428,27,"UA",1734,"N19117","EWR","ORD",131,719,13,0,2013-12-10 13:00:00 +2013,12,10,1520,1450,30,1911,1755,76,"AA",320,"N476AA","EWR","DFW",256,1372,14,50,2013-12-10 14:00:00 +2013,12,10,1823,1800,23,2003,1940,23,"MQ",3501,"N814MQ","LGA","RDU",81,431,18,0,2013-12-10 18:00:00 +2013,12,10,1942,1944,-2,2235,2236,-1,"UA",234,"N411UA","EWR","MCO",145,937,19,44,2013-12-10 19:00:00 +2013,12,10,2101,2059,2,2340,2314,26,"MQ",3473,"N506MQ","LGA","ATL",133,762,20,59,2013-12-10 20:00:00 +2013,12,10,NA,2038,NA,NA,2259,NA,"9E",3681,NA,"LGA","GSP",NA,610,20,38,2013-12-10 20:00:00 +2013,12,10,NA,1250,NA,NA,1350,NA,"AA",178,"N3JRAA","JFK","BOS",NA,187,12,50,2013-12-10 12:00:00 +2013,12,10,NA,1130,NA,NA,1332,NA,"US",707,NA,"LGA","CLT",NA,544,11,30,2013-12-10 11:00:00 +2013,12,11,823,825,-2,1027,1005,22,"MQ",3272,"N844MQ","LGA","CLE",88,419,8,25,2013-12-11 08:00:00 +2013,12,11,855,859,-4,1104,1104,0,"MQ",3565,"N512MQ","LGA","CLT",105,544,8,59,2013-12-11 08:00:00 +2013,12,11,916,811,65,1141,1012,89,"EV",4691,"N14558","EWR","DAY",107,533,8,11,2013-12-11 08:00:00 +2013,12,11,1139,1140,-1,1505,1455,10,"AA",388,"N3FTAA","LGA","MIA",168,1096,11,40,2013-12-11 11:00:00 +2013,12,11,1453,1259,114,1805,1614,111,"AA",1256,"N3ATAA","LGA","MIA",165,1096,12,59,2013-12-11 12:00:00 +2013,12,11,1700,1659,1,2012,2018,-6,"UA",1721,"N37290","EWR","LAX",340,2454,16,59,2013-12-11 16:00:00 +2013,12,11,1736,1725,11,2056,2045,11,"VX",169,"N640VA","EWR","LAX",355,2454,17,25,2013-12-11 17:00:00 +2013,12,11,1819,1815,4,2151,2127,24,"9E",2915,"N916XJ","JFK","DFW",256,1391,18,15,2013-12-11 18:00:00 +2013,12,11,1829,1810,19,2009,1951,18,"9E",3513,"N906XJ","LGA","MKE",121,738,18,10,2013-12-11 18:00:00 +2013,12,12,653,655,-2,752,804,-12,"B6",318,"N354JB","JFK","BOS",36,187,6,55,2013-12-12 06:00:00 +2013,12,12,1109,1115,-6,1357,1425,-28,"AA",1139,"N3AYAA","LGA","DFW",198,1389,11,15,2013-12-12 11:00:00 +2013,12,12,1413,1400,13,1511,1509,2,"B6",118,"N183JB","JFK","BOS",38,187,14,0,2013-12-12 14:00:00 +2013,12,12,1438,1420,18,1706,1644,22,"UA",586,"N534UA","EWR","DEN",242,1605,14,20,2013-12-12 14:00:00 +2013,12,12,1736,1728,8,1900,1849,11,"EV",4300,"N16981","EWR","RIC",54,277,17,28,2013-12-12 17:00:00 +2013,12,12,1752,1730,22,2050,2046,4,"B6",359,"N766JB","JFK","BUR",342,2465,17,30,2013-12-12 17:00:00 +2013,12,12,1815,1815,0,2047,2042,5,"DL",2013,"N323NB","JFK","MSP",174,1029,18,15,2013-12-12 18:00:00 +2013,12,13,738,740,-2,914,925,-11,"AA",307,"N3KXAA","LGA","ORD",134,733,7,40,2013-12-13 07:00:00 +2013,12,13,757,759,-2,1021,1037,-16,"DL",2047,"N6701","LGA","ATL",110,762,7,59,2013-12-13 07:00:00 +2013,12,13,834,835,-1,1102,1051,11,"EV",4945,"N611QX","LGA","CLT",81,544,8,35,2013-12-13 08:00:00 +2013,12,13,1053,1030,23,1330,1333,-3,"UA",1711,"N33262","EWR","IAH",200,1400,10,30,2013-12-13 10:00:00 +2013,12,13,1155,1200,-5,1348,1400,-12,"US",2069,"N114UW","JFK","CLT",87,541,12,0,2013-12-13 12:00:00 +2013,12,13,1242,1250,-8,1349,1350,-1,"AA",178,"N3GKAA","JFK","BOS",42,187,12,50,2013-12-13 12:00:00 +2013,12,13,1527,1530,-3,1839,1903,-24,"DL",417,"N189DN","JFK","LAX",335,2475,15,30,2013-12-13 15:00:00 +2013,12,13,1650,1650,0,1837,1823,14,"UA",1177,"N12221","EWR","ORD",134,719,16,50,2013-12-13 16:00:00 +2013,12,13,2025,1930,55,2243,2141,62,"EV",4543,"N11192","EWR","DSM",163,1017,19,30,2013-12-13 19:00:00 +2013,12,13,2110,2115,-5,2303,2315,-12,"MQ",3384,"N523MQ","LGA","CLT",85,544,21,15,2013-12-13 21:00:00 +2013,12,14,741,745,-4,1034,1043,-9,"B6",1717,"N519JB","LGA","TPA",157,1010,7,45,2013-12-14 07:00:00 +2013,12,14,912,842,30,1125,1025,60,"9E",2926,"N293PQ","JFK","ORD",133,740,8,42,2013-12-14 08:00:00 +2013,12,14,1301,1303,-2,1643,1605,38,"UA",228,"N453UA","EWR","MIA",170,1085,13,3,2013-12-14 13:00:00 +2013,12,14,1926,1922,4,107,13,54,"DL",448,"N702TW","JFK","SJU",191,1598,19,22,2013-12-14 19:00:00 +2013,12,14,NA,2111,NA,NA,2303,NA,"EV",4700,"N12921","EWR","CLT",NA,529,21,11,2013-12-14 21:00:00 +2013,12,14,NA,1856,NA,NA,2209,NA,"UA",1416,NA,"EWR","FLL",NA,1065,18,56,2013-12-14 18:00:00 +2013,12,15,558,559,-1,704,718,-14,"EV",3820,"N14542","EWR","IAD",42,212,5,59,2013-12-15 05:00:00 +2013,12,15,931,930,1,1318,1243,35,"UA",248,"N421UA","EWR","MIA",190,1085,9,30,2013-12-15 09:00:00 +2013,12,15,956,959,-3,1237,1244,-7,"B6",411,"N663JB","JFK","LAS",309,2248,9,59,2013-12-15 09:00:00 +2013,12,15,1557,1550,7,1713,1710,3,"WN",421,"N279WN","EWR","MDW",115,711,15,50,2013-12-15 15:00:00 +2013,12,15,1633,1615,18,1903,1834,29,"EV",5601,"N741EV","LGA","CLT",98,544,16,15,2013-12-15 16:00:00 +2013,12,15,1707,1705,2,1903,1909,-6,"US",894,"N184US","LGA","CLT",93,544,17,5,2013-12-15 17:00:00 +2013,12,15,2022,2030,-8,2146,2150,-4,"MQ",3604,"N524MQ","EWR","ORD",113,719,20,30,2013-12-15 20:00:00 +2013,12,15,NA,1230,NA,NA,1420,NA,"WN",2639,NA,"LGA","STL",NA,888,12,30,2013-12-15 12:00:00 +2013,12,16,559,604,-5,827,838,-11,"EV",4137,"N13123","EWR","ATL",120,746,6,4,2013-12-16 06:00:00 +2013,12,16,708,705,3,1201,1156,5,"B6",3,"N768JB","JFK","SJU",206,1598,7,5,2013-12-16 07:00:00 +2013,12,16,745,748,-3,1107,1108,-1,"UA",327,"N416UA","EWR","PDX",361,2434,7,48,2013-12-16 07:00:00 +2013,12,16,827,829,-2,1044,1055,-11,"EV",4419,"N21197","EWR","XNA",173,1131,8,29,2013-12-16 08:00:00 +2013,12,16,831,800,31,1033,954,39,"9E",2932,"N904XJ","JFK","RDU",75,427,8,0,2013-12-16 08:00:00 +2013,12,16,953,959,-6,1104,1116,-12,"EV",5711,"N830AS","JFK","IAD",55,228,9,59,2013-12-16 09:00:00 +2013,12,16,959,1005,-6,1135,1155,-20,"UA",1298,"N73276","EWR","CLE",72,404,10,5,2013-12-16 10:00:00 +2013,12,16,1723,1730,-7,2054,2046,8,"B6",359,"N520JB","JFK","BUR",360,2465,17,30,2013-12-16 17:00:00 +2013,12,17,825,830,-5,1034,1037,-3,"DL",517,"N315NB","EWR","MSP",139,1008,8,30,2013-12-17 08:00:00 +2013,12,17,944,942,2,1205,1154,11,"EV",4186,"N11535","EWR","CLT",96,529,9,42,2013-12-17 09:00:00 +2013,12,17,1414,1421,-7,1545,1538,7,"EV",5712,"N836AS","JFK","IAD",51,228,14,21,2013-12-17 14:00:00 +2013,12,17,1421,1345,36,1809,1656,73,"DL",1779,"N932DL","LGA","FLL",161,1076,13,45,2013-12-17 13:00:00 +2013,12,17,1828,1615,133,2036,1834,122,"EV",5601,"N750EV","LGA","CLT",87,544,16,15,2013-12-17 16:00:00 +2013,12,17,2120,1915,125,19,2208,131,"UA",866,"N833UA","EWR","LAS",313,2227,19,15,2013-12-17 19:00:00 +2013,12,17,NA,1400,NA,NA,1558,NA,"EV",4175,"N25134","EWR","AVL",NA,583,14,0,2013-12-17 14:00:00 +2013,12,17,NA,1800,NA,NA,1942,NA,"UA",691,NA,"LGA","ORD",NA,733,18,0,2013-12-17 18:00:00 +2013,12,18,1106,1059,7,1325,1258,27,"DL",1869,"N302NB","LGA","DTW",84,502,10,59,2013-12-18 10:00:00 +2013,12,18,1236,1229,7,1345,1345,0,"B6",1386,"N203JB","JFK","ROC",54,264,12,29,2013-12-18 12:00:00 +2013,12,18,1523,1522,1,1858,1843,15,"UA",342,"N564UA","EWR","SFO",366,2565,15,22,2013-12-18 15:00:00 +2013,12,18,1553,1530,23,1724,1717,7,"9E",2941,"N8903A","JFK","RIC",54,288,15,30,2013-12-18 15:00:00 +2013,12,18,1742,1659,43,2119,2034,45,"B6",167,"N536JB","JFK","OAK",375,2576,16,59,2013-12-18 16:00:00 +2013,12,18,1855,1850,5,2228,2220,8,"AA",235,"N3DEAA","JFK","SEA",373,2422,18,50,2013-12-18 18:00:00 +2013,12,18,1929,1850,39,2211,2205,6,"DL",1854,"N358NB","LGA","FLL",143,1076,18,50,2013-12-18 18:00:00 +2013,12,18,1938,1915,23,2232,2208,24,"UA",866,"N835UA","EWR","LAS",321,2227,19,15,2013-12-18 19:00:00 +2013,12,18,1955,1932,23,2318,2305,13,"B6",161,"N594JB","JFK","SMF",360,2521,19,32,2013-12-18 19:00:00 +2013,12,18,2058,2106,-8,2204,2213,-9,"B6",2680,"N228JB","EWR","BOS",43,200,21,6,2013-12-18 21:00:00 +2013,12,18,NA,600,NA,NA,717,NA,"EV",5716,"N830AS","JFK","IAD",NA,228,6,0,2013-12-18 06:00:00 +2013,12,19,742,729,13,1039,1029,10,"UA",1122,"N37263","EWR","PBI",145,1023,7,29,2013-12-19 07:00:00 +2013,12,19,1441,1410,31,1718,1701,17,"UA",1111,"N76515","EWR","LAS",318,2227,14,10,2013-12-19 14:00:00 +2013,12,19,1451,1454,-3,1557,1626,-29,"9E",2903,"N927XJ","JFK","BOS",41,187,14,54,2013-12-19 14:00:00 +2013,12,19,1807,1800,7,2035,2036,-1,"DL",967,"N978AT","EWR","ATL",112,746,18,0,2013-12-19 18:00:00 +2013,12,19,2148,2030,78,2323,2150,93,"MQ",3604,"N500MQ","EWR","ORD",134,719,20,30,2013-12-19 20:00:00 +2013,12,19,2239,2137,62,2339,2237,62,"EV",4625,"N14923","EWR","BWI",35,169,21,37,2013-12-19 21:00:00 +2013,12,20,755,800,-5,925,915,10,"US",2171,"N946UW","LGA","DCA",58,214,8,0,2013-12-20 08:00:00 +2013,12,20,909,855,14,1126,1100,26,"MQ",3478,"N839MQ","LGA","DTW",98,502,8,55,2013-12-20 08:00:00 +2013,12,20,1121,1105,16,1214,1203,11,"EV",4133,"N14573","EWR","PVD",31,160,11,5,2013-12-20 11:00:00 +2013,12,20,1450,1500,-10,1608,1611,-3,"US",2152,"N945UW","LGA","BOS",42,184,15,0,2013-12-20 15:00:00 +2013,12,20,1517,1320,117,1635,1449,106,"EV",4104,"N14573","EWR","BNA",118,748,13,20,2013-12-20 13:00:00 +2013,12,20,1726,1730,-4,2039,2035,4,"B6",305,"N566JB","EWR","FLL",156,1065,17,30,2013-12-20 17:00:00 +2013,12,20,1736,1707,29,2107,2018,49,"UA",237,"N809UA","EWR","DFW",227,1372,17,7,2013-12-20 17:00:00 +2013,12,20,1844,1845,-1,2046,2040,6,"MQ",3349,"N513MQ","LGA","MSP",163,1020,18,45,2013-12-20 18:00:00 +2013,12,20,1916,1735,101,2040,1856,104,"EV",5846,"N14991","EWR","RIC",51,277,17,35,2013-12-20 17:00:00 +2013,12,20,1929,1930,-1,2309,2301,8,"DL",2537,"N6705Y","JFK","SLC",297,1990,19,30,2013-12-20 19:00:00 +2013,12,20,2104,1940,84,2316,2153,83,"EV",4361,"N27962","EWR","TYS",105,631,19,40,2013-12-20 19:00:00 +2013,12,21,625,630,-5,820,842,-22,"US",2085,"N161UW","LGA","CLT",91,544,6,30,2013-12-21 06:00:00 +2013,12,21,651,630,21,923,926,-3,"UA",1144,"N57439","EWR","MCO",137,937,6,30,2013-12-21 06:00:00 +2013,12,21,815,800,15,1113,1115,-2,"AA",2267,"N3AMAA","LGA","MIA",155,1096,8,0,2013-12-21 08:00:00 +2013,12,21,1029,1030,-1,1306,1315,-9,"DL",420,"N3731T","JFK","LAS",309,2248,10,30,2013-12-21 10:00:00 +2013,12,21,1515,1520,-5,1857,1852,5,"DL",1982,"N946DL","LGA","MIA",156,1096,15,20,2013-12-21 15:00:00 +2013,12,21,1621,1550,31,1853,1831,22,"DL",2488,"N912DL","JFK","ATL",120,760,15,50,2013-12-21 15:00:00 +2013,12,21,1704,1705,-1,2007,2015,-8,"AA",67,"N3HWAA","JFK","SAN",336,2446,17,5,2013-12-21 17:00:00 +2013,12,21,1741,1659,42,2020,1933,47,"EV",4705,"N19554","EWR","ATL",130,746,16,59,2013-12-21 16:00:00 +2013,12,21,2001,1903,58,2256,2230,26,"UA",1152,"N75426","EWR","PDX",332,2434,19,3,2013-12-21 19:00:00 +2013,12,22,617,551,26,918,907,11,"UA",1455,"N77258","EWR","LAX",329,2454,5,51,2013-12-22 05:00:00 +2013,12,22,626,600,26,907,849,18,"B6",353,"N506JB","JFK","PBI",147,1028,6,0,2013-12-22 06:00:00 +2013,12,22,1100,1048,12,1420,1354,26,"B6",971,"N507JB","LGA","FLL",164,1076,10,48,2013-12-22 10:00:00 +2013,12,22,1343,1355,-12,1551,1535,16,"MQ",3305,"N821MQ","LGA","RDU",92,431,13,55,2013-12-22 13:00:00 +2013,12,22,1456,1500,-4,1757,1740,17,"MQ",3202,"N635MQ","JFK","IND",114,665,15,0,2013-12-22 15:00:00 +2013,12,22,1846,1847,-1,2158,2207,-9,"B6",263,"N630JB","JFK","SEA",331,2422,18,47,2013-12-22 18:00:00 +2013,12,23,135,2250,165,251,8,163,"B6",2002,"N324JB","JFK","BUF",59,301,22,50,2013-12-23 22:00:00 +2013,12,23,644,645,-1,917,920,-3,"EV",4388,"N13908","EWR","JAX",130,820,6,45,2013-12-23 06:00:00 +2013,12,23,836,845,-9,1043,1053,-10,"US",2071,"N702UW","LGA","CLT",101,544,8,45,2013-12-23 08:00:00 +2013,12,23,932,905,27,1255,1221,34,"DL",1109,"N978DL","LGA","TPA",164,1010,9,5,2013-12-23 09:00:00 +2013,12,23,1438,1340,58,1756,1715,41,"WN",516,"N234WN","EWR","PHX",302,2133,13,40,2013-12-23 13:00:00 +2013,12,23,1518,1510,8,1831,1845,-14,"AA",145,"N5FEAA","JFK","MIA",160,1089,15,10,2013-12-23 15:00:00 +2013,12,23,1530,1515,15,1823,1811,12,"UA",1592,"N17122","EWR","MCO",148,937,15,15,2013-12-23 15:00:00 +2013,12,23,1858,1847,11,2138,2121,17,"UA",1139,"N18243","EWR","DEN",233,1605,18,47,2013-12-23 18:00:00 +2013,12,23,1927,1829,58,2229,2124,65,"B6",543,"N521JB","EWR","PBI",152,1023,18,29,2013-12-23 18:00:00 +2013,12,24,859,900,-1,1220,1229,-9,"DL",422,"N197DN","JFK","LAX",344,2475,9,0,2013-12-24 09:00:00 +2013,12,24,1133,1046,47,1233,1222,11,"UA",1044,"N39726","EWR","ORD",105,719,10,46,2013-12-24 10:00:00 +2013,12,24,1144,1145,-1,1259,1315,-16,"WN",172,"N217JC","LGA","MDW",110,725,11,45,2013-12-24 11:00:00 +2013,12,24,1345,1339,6,1653,1645,8,"UA",1164,"N37281","EWR","FLL",166,1065,13,39,2013-12-24 13:00:00 +2013,12,24,1413,1310,63,1708,1606,62,"B6",505,"N563JB","EWR","FLL",163,1065,13,10,2013-12-24 13:00:00 +2013,12,24,1600,1459,61,2050,1953,57,"B6",703,"N913JB","JFK","SJU",208,1598,14,59,2013-12-24 14:00:00 +2013,12,24,1728,1730,-2,2042,2107,-25,"DL",434,"N702TW","JFK","SFO",352,2586,17,30,2013-12-24 17:00:00 +2013,12,25,819,820,-1,1059,1116,-17,"B6",1783,"N607JB","JFK","MCO",137,944,8,20,2013-12-25 08:00:00 +2013,12,25,1411,1359,12,1656,1714,-18,"B6",213,"N712JB","JFK","LGB",326,2465,13,59,2013-12-25 13:00:00 +2013,12,25,1448,1450,-2,1634,1650,-16,"MQ",3199,"N534MQ","LGA","CLT",89,544,14,50,2013-12-25 14:00:00 +2013,12,25,1532,1530,2,1847,1859,-12,"DL",417,"N154DL","JFK","LAX",334,2475,15,30,2013-12-25 15:00:00 +2013,12,25,1721,1725,-4,1833,1845,-12,"AA",256,"N3ELAA","JFK","BOS",35,187,17,25,2013-12-25 17:00:00 +2013,12,25,1828,1830,-2,2025,2035,-10,"US",425,"N523UW","JFK","CLT",88,541,18,30,2013-12-25 18:00:00 +2013,12,25,2140,2141,-1,44,37,7,"B6",425,"N579JB","JFK","TPA",160,1005,21,41,2013-12-25 21:00:00 +2013,12,25,2149,2155,-6,2328,2334,-6,"B6",985,"N339JB","JFK","RDU",80,427,21,55,2013-12-25 21:00:00 +2013,12,26,606,611,-5,905,912,-7,"B6",601,"N658JB","JFK","FLL",158,1069,6,11,2013-12-26 06:00:00 +2013,12,26,812,751,21,1120,1137,-17,"UA",497,"N808UA","EWR","SFO",339,2565,7,51,2013-12-26 07:00:00 +2013,12,26,819,820,-1,1320,1345,-25,"DL",454,"N624AG","JFK","STT",197,1623,8,20,2013-12-26 08:00:00 +2013,12,26,843,850,-7,1011,1035,-24,"AA",313,"N434AA","LGA","ORD",123,733,8,50,2013-12-26 08:00:00 +2013,12,26,1217,1130,47,1412,1319,53,"EV",4628,"N13970","EWR","STL",149,872,11,30,2013-12-26 11:00:00 +2013,12,26,1315,1315,0,1632,1620,12,"DL",2487,"N3730B","JFK","FLL",172,1069,13,15,2013-12-26 13:00:00 +2013,12,26,1316,1318,-2,1713,1629,44,"DL",2361,"N348NW","JFK","MIA",170,1089,13,18,2013-12-26 13:00:00 +2013,12,26,1443,1450,-7,1658,1650,8,"MQ",3199,"N520MQ","LGA","CLT",95,544,14,50,2013-12-26 14:00:00 +2013,12,26,2030,2045,-15,2230,2302,-32,"9E",4105,"N8696C","LGA","GSP",95,610,20,45,2013-12-26 20:00:00 +2013,12,27,709,710,-1,1032,1007,25,"B6",683,"N506JB","JFK","MCO",147,944,7,10,2013-12-27 07:00:00 +2013,12,27,803,600,123,1012,803,129,"EV",4166,"N12172","EWR","GSP",104,594,6,0,2013-12-27 06:00:00 +2013,12,27,944,817,87,1047,931,76,"EV",4234,"N12175","EWR","BWI",45,169,8,17,2013-12-27 08:00:00 +2013,12,27,1410,1413,-3,1637,1733,-56,"UA",1493,"N69806","EWR","LAX",308,2454,14,13,2013-12-27 14:00:00 +2013,12,27,1457,1455,2,1654,1650,4,"MQ",3391,"N856MQ","LGA","CMH",87,479,14,55,2013-12-27 14:00:00 +2013,12,27,1757,1800,-3,1928,1940,-12,"MQ",3501,"N844MQ","LGA","RDU",70,431,18,0,2013-12-27 18:00:00 +2013,12,28,852,900,-8,1131,1157,-26,"B6",27,"N806JB","EWR","MCO",136,937,9,0,2013-12-28 09:00:00 +2013,12,28,957,1012,-15,1202,1223,-21,"US",1780,"N965UW","LGA","CLT",88,544,10,12,2013-12-28 10:00:00 +2013,12,28,1028,947,41,1440,1430,10,"B6",403,"N784JB","JFK","SJU",179,1598,9,47,2013-12-28 09:00:00 +2013,12,28,1056,1100,-4,1210,1222,-12,"EV",5349,"N707EV","LGA","BTV",43,258,11,0,2013-12-28 11:00:00 +2013,12,28,1121,1048,33,1438,1354,44,"B6",971,"N552JB","LGA","FLL",158,1076,10,48,2013-12-28 10:00:00 +2013,12,28,1144,1155,-11,1332,1355,-23,"MQ",3616,"N516MQ","LGA","MSP",155,1020,11,55,2013-12-28 11:00:00 +2013,12,28,1321,1210,71,1620,1520,60,"AA",1143,"N3BTAA","LGA","DFW",207,1389,12,10,2013-12-28 12:00:00 +2013,12,28,1421,1425,-4,1629,1700,-31,"DL",884,"N329NB","LGA","DEN",228,1620,14,25,2013-12-28 14:00:00 +2013,12,28,1427,1429,-2,1651,1655,-4,"B6",575,"N238JB","JFK","MSY",184,1182,14,29,2013-12-28 14:00:00 +2013,12,28,1656,1700,-4,1953,1955,-2,"AA",45,"N3AAAA","JFK","LAS",335,2248,17,0,2013-12-28 17:00:00 +2013,12,28,1712,1714,-2,1946,1945,1,"UA",509,"N562UA","LGA","DEN",245,1620,17,14,2013-12-28 17:00:00 +2013,12,28,1903,1847,16,2126,2121,5,"UA",1481,"N14228","EWR","DEN",229,1605,18,47,2013-12-28 18:00:00 +2013,12,28,1949,1945,4,2049,2118,-29,"9E",2950,"N8432A","JFK","BWI",37,184,19,45,2013-12-28 19:00:00 +2013,12,28,2026,2040,-14,2318,2311,7,"EV",4333,"N16149","EWR","TUL",205,1215,20,40,2013-12-28 20:00:00 +2013,12,29,835,819,16,1117,1119,-2,"UA",318,"N830UA","EWR","BZN",264,1882,8,19,2013-12-29 08:00:00 +2013,12,29,907,910,-3,1233,1235,-2,"AA",1085,"N635AA","JFK","MIA",166,1089,9,10,2013-12-29 09:00:00 +2013,12,29,1256,1300,-4,1531,1540,-9,"DL",781,"N939DL","LGA","ATL",126,762,13,0,2013-12-29 13:00:00 +2013,12,29,1343,1345,-2,1547,1553,-6,"US",1802,"N742PS","JFK","CLT",100,541,13,45,2013-12-29 13:00:00 +2013,12,29,2049,2055,-6,2218,2213,5,"DL",2599,"N982DL","JFK","BOS",30,187,20,55,2013-12-29 20:00:00 +2013,12,29,2131,2029,62,35,2339,56,"UA",340,"N802UA","EWR","MIA",162,1085,20,29,2013-12-29 20:00:00 +2013,12,29,2156,2046,70,108,2358,70,"B6",329,"N706JB","JFK","RSW",165,1074,20,46,2013-12-29 20:00:00 +2013,12,29,2304,2245,19,210,127,43,"B6",2583,"N618JB","JFK","MCO",147,944,22,45,2013-12-29 22:00:00 +2013,12,30,945,950,-5,1202,1219,-17,"9E",3304,"N8884E","LGA","GSP",110,610,9,50,2013-12-30 09:00:00 +2013,12,30,958,1001,-3,1143,1210,-27,"EV",4297,"N11194","EWR","DTW",89,488,10,1,2013-12-30 10:00:00 +2013,12,30,1317,1315,2,1626,1620,6,"DL",2487,"N3743H","JFK","FLL",172,1069,13,15,2013-12-30 13:00:00 +2013,12,30,1510,1500,10,1808,1730,38,"MQ",3669,"N5PBMQ","LGA","ATL",139,762,15,0,2013-12-30 15:00:00 +2013,12,30,1939,1930,9,2256,2301,-5,"DL",2537,"N6709","JFK","SLC",281,1990,19,30,2013-12-30 19:00:00 +2013,12,30,2145,2129,16,48,32,16,"UA",236,"N821UA","EWR","TPA",162,997,21,29,2013-12-30 21:00:00 +2013,12,31,749,756,-7,944,959,-15,"US",1733,"N173US","LGA","CLT",93,544,7,56,2013-12-31 07:00:00 +2013,12,31,829,835,-6,1130,1148,-18,"UA",429,"N462UA","LGA","IAH",219,1416,8,35,2013-12-31 08:00:00 +2013,12,31,1159,1115,44,1507,1428,39,"DL",2098,"N310NW","LGA","MIA",161,1096,11,15,2013-12-31 11:00:00 +2013,12,31,1325,1330,-5,1610,1622,-12,"DL",381,"N373NW","LGA","MCO",147,950,13,30,2013-12-31 13:00:00 +2013,12,31,1540,1550,-10,1733,1744,-11,"9E",2900,"N295PQ","JFK","BNA",133,765,15,50,2013-12-31 15:00:00 +2013,12,31,1654,1700,-6,1947,2014,-27,"UA",1128,"N33289","LGA","IAH",217,1416,17,0,2013-12-31 17:00:00 +2013,2,1,1002,1010,-8,1118,1140,-22,"MQ",3795,"N543MQ","EWR","ORD",114,719,10,10,2013-02-01 10:00:00 +2013,2,1,1026,1030,-4,1257,1252,5,"DL",2343,"N640DL","EWR","ATL",117,746,10,30,2013-02-01 10:00:00 +2013,2,1,1245,1240,5,1553,1555,-2,"AA",2041,"N5EFAA","JFK","MIA",167,1089,12,40,2013-02-01 12:00:00 +2013,2,1,1451,1500,-9,1947,1837,NA,"DL",963,"N721TW","JFK","LAX",NA,2475,15,0,2013-02-01 15:00:00 +2013,2,1,1631,1635,-4,1833,1841,-8,"B6",1085,"N178JB","JFK","CLT",89,541,16,35,2013-02-01 16:00:00 +2013,2,1,1706,1710,-4,1922,1913,9,"US",894,"N426US","LGA","CLT",88,544,17,10,2013-02-01 17:00:00 +2013,2,1,1712,1710,2,2028,2036,-8,"UA",1178,"N29129","EWR","SFO",355,2565,17,10,2013-02-01 17:00:00 +2013,2,1,1858,1905,-7,2044,2040,4,"WN",981,"N486WN","LGA","MKE",114,738,19,5,2013-02-01 19:00:00 +2013,2,1,2106,1905,121,2,2225,97,"AA",21,"N336AA","JFK","LAX",331,2475,19,5,2013-02-01 19:00:00 +2013,2,2,634,600,34,942,906,36,"B6",125,"N763JB","JFK","FLL",159,1069,6,0,2013-02-02 06:00:00 +2013,2,2,752,759,-7,949,1007,-18,"EV",4498,"N17146","EWR","MSP",155,1008,7,59,2013-02-02 07:00:00 +2013,2,2,942,945,-3,1227,1247,-20,"DL",1885,"N327NW","LGA","MCO",141,950,9,45,2013-02-02 09:00:00 +2013,2,2,956,1000,-4,1104,1125,-21,"EV",5698,"N834AS","LGA","IAD",47,229,10,0,2013-02-02 10:00:00 +2013,2,2,1351,1350,1,1619,1624,-5,"B6",615,"N216JB","JFK","JAX",128,828,13,50,2013-02-02 13:00:00 +2013,2,2,1615,1621,-6,1722,1741,-19,"EV",3814,"N26545","EWR","ROC",46,246,16,21,2013-02-02 16:00:00 +2013,2,2,1745,1735,10,1915,1922,-7,"B6",1111,"N316JB","JFK","RDU",72,427,17,35,2013-02-02 17:00:00 +2013,2,2,1835,1810,25,2140,2130,10,"AA",1611,"N3FYAA","LGA","MIA",165,1096,18,10,2013-02-02 18:00:00 +2013,2,3,536,540,-4,927,850,37,"AA",1141,"N5EBAA","JFK","MIA",164,1089,5,40,2013-02-03 05:00:00 +2013,2,3,1024,1015,9,1320,1331,-11,"UA",1728,"N26226","LGA","IAH",209,1416,10,15,2013-02-03 10:00:00 +2013,2,3,1125,1135,-10,1315,1330,-15,"MQ",4553,"N723MQ","LGA","CLE",68,419,11,35,2013-02-03 11:00:00 +2013,2,3,1357,1359,-2,1644,1659,-15,"UA",1122,"N37252","EWR","PBI",149,1023,13,59,2013-02-03 13:00:00 +2013,2,3,1610,1600,10,1832,1840,-8,"DL",847,"N610DL","LGA","ATL",107,762,16,0,2013-02-03 16:00:00 +2013,2,3,1614,1600,14,1855,1850,5,"DL",1331,"N3739P","JFK","DEN",247,1626,16,0,2013-02-03 16:00:00 +2013,2,3,1754,1805,-11,1929,1955,-26,"MQ",4626,"N546MQ","LGA","CMH",76,479,18,5,2013-02-03 18:00:00 +2013,2,3,1802,1725,37,2044,2023,21,"UA",1178,"N76503","EWR","IAH",196,1400,17,25,2013-02-03 17:00:00 +2013,2,3,1957,2000,-3,2238,2305,-27,"B6",21,"N657JB","JFK","TPA",142,1005,20,0,2013-02-03 20:00:00 +2013,2,4,639,645,-6,905,846,19,"US",1251,"N764US","EWR","CLT",81,529,6,45,2013-02-04 06:00:00 +2013,2,4,801,800,1,1108,1124,-16,"DL",2143,"N362NW","JFK","MIA",164,1089,8,0,2013-02-04 08:00:00 +2013,2,4,824,827,-3,1006,1031,-25,"EV",4652,"N13958","EWR","MYR",84,550,8,27,2013-02-04 08:00:00 +2013,2,4,1151,1200,-9,1257,1315,-18,"EV",4349,"N13913","EWR","ORF",49,284,12,0,2013-02-04 12:00:00 +2013,2,4,1316,1320,-4,1424,1436,-12,"EV",4231,"N13995","EWR","IAD",46,212,13,20,2013-02-04 13:00:00 +2013,2,4,1520,1520,0,1836,1842,-6,"DL",2115,"N334NW","LGA","MIA",170,1096,15,20,2013-02-04 15:00:00 +2013,2,4,1854,1830,24,2100,2044,16,"EV",5203,"N608QX","EWR","DTW",99,488,18,30,2013-02-04 18:00:00 +2013,2,4,1928,1935,-7,2213,2233,-20,"UA",1416,"N38727","EWR","IAH",208,1400,19,35,2013-02-04 19:00:00 +2013,2,5,1145,1155,-10,1244,1304,-20,"9E",3483,"N937XJ","JFK","BOS",32,187,11,55,2013-02-05 11:00:00 +2013,2,5,1531,1447,44,1737,1654,43,"EV",4572,"N16541","EWR","GSP",99,594,14,47,2013-02-05 14:00:00 +2013,2,5,1629,1629,0,1934,2005,-31,"UA",1078,"N76254","EWR","SAT",226,1569,16,29,2013-02-05 16:00:00 +2013,2,5,1655,1659,-4,1943,2015,-32,"UA",250,"N840UA","EWR","LAX",331,2454,16,59,2013-02-05 16:00:00 +2013,2,5,1854,1900,-6,2206,2235,-29,"DL",87,"N705TW","JFK","LAX",323,2475,19,0,2013-02-05 19:00:00 +2013,2,5,1856,1850,6,2159,2142,17,"B6",527,"N729JB","EWR","MCO",139,937,18,50,2013-02-05 18:00:00 +2013,2,5,NA,1520,NA,NA,1654,NA,"9E",4105,NA,"JFK","IAD",NA,228,15,20,2013-02-05 15:00:00 +2013,2,6,619,600,19,855,815,40,"FL",345,"N972AT","LGA","ATL",121,762,6,0,2013-02-06 06:00:00 +2013,2,6,625,630,-5,754,810,-16,"AA",303,"N3DFAA","LGA","ORD",120,733,6,30,2013-02-06 06:00:00 +2013,2,6,653,659,-6,957,959,-2,"AA",1815,"N5FPAA","JFK","MCO",140,944,6,59,2013-02-06 06:00:00 +2013,2,6,827,825,2,1111,1136,-25,"B6",181,"N571JB","JFK","SAN",327,2446,8,25,2013-02-06 08:00:00 +2013,2,6,848,850,-2,1125,1148,-23,"B6",59,"N580JB","JFK","TPA",139,1005,8,50,2013-02-06 08:00:00 +2013,2,6,1340,1345,-5,1700,1705,-5,"AA",117,"N338AA","JFK","LAX",348,2475,13,45,2013-02-06 13:00:00 +2013,2,6,1508,1509,-1,1732,1741,-9,"EV",3817,"N36915","EWR","JAX",120,820,15,9,2013-02-06 15:00:00 +2013,2,6,1511,1510,1,1720,1710,10,"MQ",4579,"N546MQ","LGA","CLT",83,544,15,10,2013-02-06 15:00:00 +2013,2,6,1738,1745,-7,2101,2055,6,"AA",785,"N3JAAA","LGA","DFW",215,1389,17,45,2013-02-06 17:00:00 +2013,2,7,458,500,-2,642,648,-6,"US",1117,"N165US","EWR","CLT",87,529,5,0,2013-02-07 05:00:00 +2013,2,7,826,835,-9,1111,1105,6,"MQ",4610,"N508MQ","LGA","ATL",132,762,8,35,2013-02-07 08:00:00 +2013,2,7,1055,1100,-5,1410,1424,-14,"DL",2044,"N925DL","LGA","MIA",156,1096,11,0,2013-02-07 11:00:00 +2013,2,7,1131,1129,2,1438,1437,1,"B6",133,"N605JB","JFK","RSW",165,1074,11,29,2013-02-07 11:00:00 +2013,2,7,1211,1200,11,1516,1510,6,"AA",3,"N323AA","JFK","LAX",340,2475,12,0,2013-02-07 12:00:00 +2013,2,7,1539,1540,-1,1913,1900,13,"UA",161,"N19117","JFK","LAX",358,2475,15,40,2013-02-07 15:00:00 +2013,2,7,1649,1645,4,1922,2005,-43,"AA",181,"N324AA","JFK","LAX",321,2475,16,45,2013-02-07 16:00:00 +2013,2,7,1711,1710,1,1857,1859,-2,"EV",4202,"N14542","EWR","STL",143,872,17,10,2013-02-07 17:00:00 +2013,2,7,1718,1722,-4,1836,1844,-8,"EV",4300,"N13968","EWR","RIC",52,277,17,22,2013-02-07 17:00:00 +2013,2,7,1954,2000,-6,2117,2139,-22,"UA",1094,"N13718","EWR","CLE",62,404,20,0,2013-02-07 20:00:00 +2013,2,8,822,825,-3,959,945,14,"MQ",4418,"N850MQ","JFK","DCA",48,213,8,25,2013-02-08 08:00:00 +2013,2,8,NA,2159,NA,NA,2306,NA,"EV",4322,"N15980","EWR","PWM",NA,284,21,59,2013-02-08 21:00:00 +2013,2,8,NA,1945,NA,NA,2241,NA,"9E",3314,NA,"JFK","JAX",NA,828,19,45,2013-02-08 19:00:00 +2013,2,8,NA,1345,NA,NA,1457,NA,"B6",602,"N351JB","JFK","PWM",NA,273,13,45,2013-02-08 13:00:00 +2013,2,8,NA,1730,NA,NA,1855,NA,"WN",216,"N258WN","EWR","MDW",NA,711,17,30,2013-02-08 17:00:00 +2013,2,8,NA,1355,NA,NA,1530,NA,"WN",348,"N728SW","LGA","MDW",NA,725,13,55,2013-02-08 13:00:00 +2013,2,9,NA,1610,NA,NA,1731,NA,"9E",3689,NA,"JFK","PHL",NA,94,16,10,2013-02-09 16:00:00 +2013,2,9,NA,1110,NA,NA,1335,NA,"B6",1925,"N187JB","JFK","MSY",NA,1182,11,10,2013-02-09 11:00:00 +2013,2,9,NA,600,NA,NA,903,NA,"B6",371,"N708JB","LGA","FLL",NA,1076,6,0,2013-02-09 06:00:00 +2013,2,9,NA,1200,NA,NA,1400,NA,"US",1443,NA,"JFK","CLT",NA,541,12,0,2013-02-09 12:00:00 +2013,2,10,625,625,0,910,937,-27,"UA",304,"N490UA","LGA","IAH",207,1416,6,25,2013-02-10 06:00:00 +2013,2,10,1214,1220,-6,1417,1350,27,"MQ",3697,"N517MQ","EWR","ORD",147,719,12,20,2013-02-10 12:00:00 +2013,2,10,1346,1300,46,1507,1440,27,"AA",329,"N4WMAA","LGA","ORD",120,733,13,0,2013-02-10 13:00:00 +2013,2,10,1513,1440,33,1620,1549,31,"UA",1687,"N24729","EWR","BOS",43,200,14,40,2013-02-10 14:00:00 +2013,2,10,1709,1710,-1,2050,2015,35,"AA",695,"N3GBAA","JFK","AUS",248,1521,17,10,2013-02-10 17:00:00 +2013,2,10,1743,1730,13,1931,1923,8,"US",449,"N654AW","EWR","CLT",84,529,17,30,2013-02-10 17:00:00 +2013,2,10,1806,1726,40,1930,1859,31,"EV",3843,"N14542","EWR","PIT",56,319,17,26,2013-02-10 17:00:00 +2013,2,11,601,600,1,743,730,13,"WN",3223,"N8602F","LGA","MDW",128,725,6,0,2013-02-11 06:00:00 +2013,2,11,610,610,0,919,915,4,"AA",1837,"N3GFAA","LGA","MIA",158,1096,6,10,2013-02-11 06:00:00 +2013,2,11,631,634,-3,926,935,-9,"UA",772,"N541UA","EWR","MIA",158,1085,6,34,2013-02-11 06:00:00 +2013,2,11,837,830,7,1021,1015,6,"AA",313,"N4YDAA","LGA","ORD",126,733,8,30,2013-02-11 08:00:00 +2013,2,11,858,845,13,1022,1006,16,"EV",4409,"N10575","EWR","RIC",57,277,8,45,2013-02-11 08:00:00 +2013,2,11,1451,1345,66,1553,1457,56,"B6",602,"N183JB","JFK","PWM",44,273,13,45,2013-02-11 13:00:00 +2013,2,11,1557,1600,-3,1712,1712,0,"US",2134,"N945UW","LGA","BOS",44,184,16,0,2013-02-11 16:00:00 +2013,2,11,1607,1529,38,1904,1837,27,"UA",1624,"N27205","EWR","FLL",157,1065,15,29,2013-02-11 15:00:00 +2013,2,11,1657,1700,-3,2023,2036,-13,"DL",127,"N709TW","JFK","LAX",336,2475,17,0,2013-02-11 17:00:00 +2013,2,11,1720,1705,15,2006,2007,-1,"B6",143,"N638JB","JFK","PBI",144,1028,17,5,2013-02-11 17:00:00 +2013,2,11,2010,1635,215,2324,1951,213,"B6",139,"N279JB","JFK","RSW",162,1074,16,35,2013-02-11 16:00:00 +2013,2,11,2049,1915,94,2215,2111,64,"9E",3525,"N913XJ","JFK","ORD",121,740,19,15,2013-02-11 19:00:00 +2013,2,11,NA,1846,NA,NA,2018,NA,"B6",130,"N187JB","JFK","BUF",NA,301,18,46,2013-02-11 18:00:00 +2013,2,12,821,817,4,1118,1127,-9,"DL",1109,"N333NW","LGA","TPA",156,1010,8,17,2013-02-12 08:00:00 +2013,2,12,843,840,3,1028,1030,-2,"EV",4548,"N23139","EWR","RDU",74,416,8,40,2013-02-12 08:00:00 +2013,2,12,943,945,-2,1119,1135,-16,"WN",469,"N221WN","LGA","BNA",129,764,9,45,2013-02-12 09:00:00 +2013,2,12,1656,1700,-4,1953,2036,-43,"DL",127,"N624AG","JFK","LAX",327,2475,17,0,2013-02-12 17:00:00 +2013,2,12,1721,1725,-4,2013,2017,-4,"UA",1109,"N12116","EWR","MCO",146,937,17,25,2013-02-12 17:00:00 +2013,2,12,1912,1915,-3,2130,2137,-7,"EV",4085,"N16170","EWR","OMA",177,1134,19,15,2013-02-12 19:00:00 +2013,2,12,2053,2100,-7,2237,2250,-13,"MQ",4584,"N500MQ","LGA","CLT",88,544,21,0,2013-02-12 21:00:00 +2013,2,13,955,958,-3,1112,1137,-25,"UA",258,"N842UA","LGA","ORD",118,733,9,58,2013-02-13 09:00:00 +2013,2,13,1010,1015,-5,1304,1340,-36,"US",75,"N677AW","EWR","PHX",277,2133,10,15,2013-02-13 10:00:00 +2013,2,13,1131,1129,2,1441,1437,4,"B6",133,"N593JB","JFK","RSW",169,1074,11,29,2013-02-13 11:00:00 +2013,2,13,1218,1200,18,1504,1432,32,"EV",4090,"N18556","EWR","JAX",150,820,12,0,2013-02-13 12:00:00 +2013,2,13,1442,1446,-4,1750,1757,-7,"UA",997,"N482UA","LGA","IAH",231,1416,14,46,2013-02-13 14:00:00 +2013,2,13,1744,1745,-1,2100,2042,18,"B6",391,"N506JB","LGA","MCO",165,950,17,45,2013-02-13 17:00:00 +2013,2,13,1811,1800,11,2037,2006,31,"US",373,"N535UW","JFK","CLT",96,541,18,0,2013-02-13 18:00:00 +2013,2,13,1835,1845,-10,2014,2030,-16,"MQ",4517,"N723MQ","LGA","CRW",80,444,18,45,2013-02-13 18:00:00 +2013,2,13,1853,1855,-2,2126,2142,-16,"DL",951,"N193DN","JFK","ATL",127,760,18,55,2013-02-13 18:00:00 +2013,2,14,732,730,2,1056,1115,-19,"VX",11,"N839VA","JFK","SFO",344,2586,7,30,2013-02-14 07:00:00 +2013,2,14,1520,1450,30,1658,1640,18,"MQ",4403,"N806MQ","JFK","RDU",74,427,14,50,2013-02-14 14:00:00 +2013,2,14,1542,1450,52,1904,1755,69,"AA",1813,"N5FAAA","JFK","MCO",161,944,14,50,2013-02-14 14:00:00 +2013,2,14,1715,1700,15,1829,1813,16,"US",2136,"N945UW","LGA","BOS",39,184,17,0,2013-02-14 17:00:00 +2013,2,14,1744,1745,-1,2106,2117,-11,"UA",1462,"N19130","EWR","SFO",348,2565,17,45,2013-02-14 17:00:00 +2013,2,14,1750,1720,30,2140,2033,67,"DL",1779,"N361NW","LGA","FLL",204,1076,17,20,2013-02-14 17:00:00 +2013,2,15,530,530,0,822,831,-9,"UA",1714,"N76503","LGA","IAH",217,1416,5,30,2013-02-15 05:00:00 +2013,2,15,728,729,-1,1041,1026,15,"B6",361,"N607JB","LGA","PBI",170,1035,7,29,2013-02-15 07:00:00 +2013,2,15,757,801,-4,1023,1024,-1,"EV",4315,"N11192","EWR","XNA",176,1131,8,1,2013-02-15 08:00:00 +2013,2,15,1112,1049,23,1420,1400,20,"B6",373,"N594JB","LGA","FLL",166,1076,10,49,2013-02-15 10:00:00 +2013,2,15,1628,1636,-8,1805,1812,-7,"EV",4399,"N23139","EWR","RDU",71,416,16,36,2013-02-15 16:00:00 +2013,2,15,1814,1750,24,2128,2041,47,"B6",527,"N552JB","EWR","MCO",152,937,17,50,2013-02-15 17:00:00 +2013,2,15,2206,2200,6,122,57,25,"B6",11,"N547JB","JFK","FLL",169,1069,22,0,2013-02-15 22:00:00 +2013,2,16,651,653,-2,928,930,-2,"EV",3838,"N18556","EWR","ATL",129,746,6,53,2013-02-16 06:00:00 +2013,2,16,751,750,1,948,1006,-18,"DL",2119,"N901DE","LGA","MSP",144,1020,7,50,2013-02-16 07:00:00 +2013,2,16,826,800,26,1017,1032,-15,"UA",1583,"N37281","LGA","DEN",213,1620,8,0,2013-02-16 08:00:00 +2013,2,16,1128,1112,16,1324,1345,-21,"UA",405,"N475UA","LGA","DEN",210,1620,11,12,2013-02-16 11:00:00 +2013,2,16,1255,1300,-5,1521,1537,-16,"DL",781,"N357NW","LGA","ATL",121,762,13,0,2013-02-16 13:00:00 +2013,2,16,1351,1300,51,1459,1408,51,"US",2175,"N955UW","LGA","DCA",50,214,13,0,2013-02-16 13:00:00 +2013,2,16,1722,1725,-3,2004,2040,-36,"AA",145,"N371AA","JFK","SAN",323,2446,17,25,2013-02-16 17:00:00 +2013,2,16,1921,1930,-9,2030,2122,-52,"9E",3916,"N8501F","JFK","ROC",47,264,19,30,2013-02-16 19:00:00 +2013,2,16,1930,1934,-4,2054,2118,-24,"UA",1023,"N15712","EWR","CLE",63,404,19,34,2013-02-16 19:00:00 +2013,2,16,2208,2155,13,116,48,28,"B6",515,"N238JB","EWR","FLL",165,1065,21,55,2013-02-16 21:00:00 +2013,2,17,1102,1106,-4,1305,1335,-30,"UA",405,"N588UA","LGA","DEN",223,1620,11,6,2013-02-17 11:00:00 +2013,2,17,1120,1115,5,1414,1425,-11,"AA",2099,"N3GNAA","LGA","MIA",153,1096,11,15,2013-02-17 11:00:00 +2013,2,17,1252,1300,-8,1435,1450,-15,"MQ",4426,"N725MQ","LGA","CMH",78,479,13,0,2013-02-17 13:00:00 +2013,2,17,1431,1438,-7,1714,1748,-34,"DL",1902,"N321US","LGA","PBI",145,1035,14,38,2013-02-17 14:00:00 +2013,2,17,1448,1455,-7,1559,1645,-46,"AA",337,"N565AA","LGA","ORD",109,733,14,55,2013-02-17 14:00:00 +2013,2,17,1716,1600,76,1844,1751,53,"B6",917,"N304JB","JFK","ORD",118,740,16,0,2013-02-17 16:00:00 +2013,2,17,2028,2000,28,2147,2147,0,"9E",3320,"N916XJ","JFK","BUF",55,301,20,0,2013-02-17 20:00:00 +2013,2,18,600,601,-1,845,859,-14,"UA",1627,"N26215","EWR","PBI",137,1023,6,1,2013-02-18 06:00:00 +2013,2,18,658,700,-2,949,1014,-25,"DL",1879,"N357NW","LGA","FLL",151,1076,7,0,2013-02-18 07:00:00 +2013,2,18,756,710,46,1255,1204,51,"B6",715,"N645JB","JFK","SJU",197,1598,7,10,2013-02-18 07:00:00 +2013,2,18,810,815,-5,1032,1056,-24,"DL",914,"N368NW","LGA","DEN",230,1620,8,15,2013-02-18 08:00:00 +2013,2,18,951,929,22,1223,1225,-2,"UA",1110,"N37252","EWR","LAS",314,2227,9,29,2013-02-18 09:00:00 +2013,2,18,1052,1020,32,1333,1330,3,"AA",731,"N505AA","LGA","DFW",203,1389,10,20,2013-02-18 10:00:00 +2013,2,18,1109,1110,-1,1232,1252,-20,"EV",5273,"N608QX","LGA","PIT",58,335,11,10,2013-02-18 11:00:00 +2013,2,18,1152,1200,-8,1304,1331,-27,"UA",329,"N843UA","EWR","ORD",117,719,12,0,2013-02-18 12:00:00 +2013,2,18,1336,1259,37,1452,1436,16,"UA",1233,"N14118","EWR","ORD",117,719,12,59,2013-02-18 12:00:00 +2013,2,18,1428,1435,-7,1730,1744,-14,"B6",347,"N284JB","JFK","SRQ",151,1041,14,35,2013-02-18 14:00:00 +2013,2,18,1509,1459,10,1628,1634,-6,"UA",1599,"N14704","EWR","ORD",119,719,14,59,2013-02-18 14:00:00 +2013,2,18,1754,1750,4,1918,1920,-2,"WN",732,"N223WN","EWR","MDW",118,711,17,50,2013-02-18 17:00:00 +2013,2,18,1803,1725,38,2020,1954,26,"UA",509,"N575UA","LGA","DEN",225,1620,17,25,2013-02-18 17:00:00 +2013,2,18,1829,1835,-6,1927,1950,-23,"MQ",3944,"N690MQ","JFK","BWI",38,184,18,35,2013-02-18 18:00:00 +2013,2,18,1955,2000,-5,2105,2117,-12,"US",2189,"N758US","LGA","DCA",42,214,20,0,2013-02-18 20:00:00 +2013,2,18,2038,2044,-6,2139,2150,-11,"EV",4583,"N14173","EWR","MHT",39,209,20,44,2013-02-18 20:00:00 +2013,2,18,2046,1955,51,2153,2125,28,"WN",2327,"N747SA","EWR","MDW",109,711,19,55,2013-02-18 19:00:00 +2013,2,19,556,600,-4,837,849,-12,"B6",145,"N504JB","JFK","PBI",145,1028,6,0,2013-02-19 06:00:00 +2013,2,19,603,608,-5,813,820,-7,"EV",5679,"N17560","EWR","CVG",108,569,6,8,2013-02-19 06:00:00 +2013,2,19,621,630,-9,809,831,-22,"US",1436,"N556UW","EWR","CLT",88,529,6,30,2013-02-19 06:00:00 +2013,2,19,758,748,10,1002,1010,-8,"EV",5682,"N17138","EWR","OMA",165,1134,7,48,2013-02-19 07:00:00 +2013,2,19,1357,1320,37,1737,1625,72,"B6",377,"N662JB","LGA","FLL",191,1076,13,20,2013-02-19 13:00:00 +2013,2,19,1555,1540,15,1737,1743,-6,"9E",3523,"N602LR","JFK","ORD",119,740,15,40,2013-02-19 15:00:00 +2013,2,19,1745,1745,0,2130,2120,10,"AA",177,"N336AA","JFK","SFO",362,2586,17,45,2013-02-19 17:00:00 +2013,2,19,2103,1945,78,2349,2241,68,"9E",3287,"N918XJ","JFK","JAX",129,828,19,45,2013-02-19 19:00:00 +2013,2,19,2117,2115,2,10,2358,12,"B6",927,"N649JB","EWR","MCO",139,937,21,15,2013-02-19 21:00:00 +2013,2,19,2151,2015,96,2326,2210,76,"MQ",4555,"N722MQ","LGA","CMH",80,479,20,15,2013-02-19 20:00:00 +2013,2,20,557,600,-3,734,801,-27,"EV",4911,"N750EV","EWR","DTW",79,488,6,0,2013-02-20 06:00:00 +2013,2,20,732,600,92,855,715,100,"EV",5716,"N827AS","JFK","IAD",50,228,6,0,2013-02-20 06:00:00 +2013,2,20,914,920,-6,1056,1042,14,"B6",108,"N317JB","JFK","BUF",66,301,9,20,2013-02-20 09:00:00 +2013,2,20,942,945,-3,1056,1115,-19,"WN",3587,"N426WN","LGA","MKE",113,738,9,45,2013-02-20 09:00:00 +2013,2,20,951,955,-4,1221,1220,1,"MQ",4654,"N509MQ","LGA","ATL",124,762,9,55,2013-02-20 09:00:00 +2013,2,20,1056,1059,-3,1405,1441,-36,"UA",1120,"N14242","EWR","SFO",355,2565,10,59,2013-02-20 10:00:00 +2013,2,20,1457,1455,2,1644,1637,7,"9E",3318,"N600LR","JFK","BUF",66,301,14,55,2013-02-20 14:00:00 +2013,2,20,1535,1526,9,1824,1807,17,"UA",1222,"N39423","EWR","LAS",315,2227,15,26,2013-02-20 15:00:00 +2013,2,20,1721,1715,6,2026,2019,7,"DL",1585,"N912DL","LGA","MCO",135,950,17,15,2013-02-20 17:00:00 +2013,2,20,1953,1955,-2,2118,2125,-7,"WN",2327,"N460WN","EWR","MDW",110,711,19,55,2013-02-20 19:00:00 +2013,2,21,631,635,-4,849,843,6,"EV",4626,"N14143","EWR","MSP",170,1008,6,35,2013-02-21 06:00:00 +2013,2,21,959,1002,-3,1246,1300,-14,"UA",1428,"N14228","EWR","TPA",152,997,10,2,2013-02-21 10:00:00 +2013,2,21,1140,1120,20,1434,1422,12,"B6",1,"N637JB","JFK","FLL",156,1069,11,20,2013-02-21 11:00:00 +2013,2,21,1257,1259,-2,1430,1436,-6,"UA",1233,"N41140","EWR","ORD",135,719,12,59,2013-02-21 12:00:00 +2013,2,21,1520,1528,-8,1653,1701,-8,"EV",3815,"N15973","EWR","BNA",127,748,15,28,2013-02-21 15:00:00 +2013,2,21,1521,1505,16,1948,2000,-12,"B6",703,"N729JB","JFK","SJU",182,1598,15,5,2013-02-21 15:00:00 +2013,2,21,2054,2100,-6,2205,2207,-2,"US",2144,"N952UW","LGA","BOS",40,184,21,0,2013-02-21 21:00:00 +2013,2,22,512,515,-3,759,814,-15,"UA",697,"N811UA","EWR","IAH",206,1400,5,15,2013-02-22 05:00:00 +2013,2,22,706,635,31,939,852,47,"EV",4423,"N33182","EWR","IND",117,645,6,35,2013-02-22 06:00:00 +2013,2,22,729,730,-1,1043,1115,-32,"VX",11,"N842VA","JFK","SFO",341,2586,7,30,2013-02-22 07:00:00 +2013,2,22,859,840,19,1205,1147,18,"UA",443,"N505UA","JFK","LAX",333,2475,8,40,2013-02-22 08:00:00 +2013,2,22,1416,1325,51,1841,1809,32,"B6",705,"N526JB","JFK","SJU",180,1598,13,25,2013-02-22 13:00:00 +2013,2,22,1528,1535,-7,1854,1850,4,"AA",763,"N3GUAA","LGA","DFW",236,1389,15,35,2013-02-22 15:00:00 +2013,2,22,1608,1605,3,1816,1750,26,"MQ",4415,"N734MQ","LGA","RDU",80,431,16,5,2013-02-22 16:00:00 +2013,2,22,1718,1721,-3,2016,2049,-33,"UA",1460,"N16732","EWR","SNA",337,2434,17,21,2013-02-22 17:00:00 +2013,2,22,1823,1835,-12,2207,2157,10,"UA",1284,"N23708","EWR","AUS",258,1504,18,35,2013-02-22 18:00:00 +2013,2,22,1905,1910,-5,2200,2232,-32,"DL",2159,"N389DA","JFK","MCO",139,944,19,10,2013-02-22 19:00:00 +2013,2,23,954,905,49,1231,1121,70,"EV",4686,"N11165","EWR","MCI",181,1092,9,5,2013-02-23 09:00:00 +2013,2,23,1452,1456,-4,1727,1622,65,"9E",4357,"N830AY","JFK","ORF",53,290,14,56,2013-02-23 14:00:00 +2013,2,23,1724,1659,25,2149,2044,65,"9E",3375,"N917XJ","JFK","SAT",272,1587,16,59,2013-02-23 16:00:00 +2013,2,23,2014,2000,14,2330,2332,-2,"UA",1482,"N77530","EWR","SFO",352,2565,20,0,2013-02-23 20:00:00 +2013,2,24,604,600,4,908,927,-19,"UA",1205,"N76504","EWR","LAX",337,2454,6,0,2013-02-24 06:00:00 +2013,2,24,906,910,-4,1033,1053,-20,"B6",885,"N266JB","JFK","RDU",69,427,9,10,2013-02-24 09:00:00 +2013,2,24,1837,1636,121,2022,1812,130,"EV",4399,"N17984","EWR","RDU",67,416,16,36,2013-02-24 16:00:00 +2013,2,24,1854,1858,-4,2208,2214,-6,"UA",1152,"N54241","EWR","PDX",334,2434,18,58,2013-02-24 18:00:00 +2013,2,24,1914,1920,-6,2237,2246,-9,"DL",869,"N3747D","JFK","FLL",155,1069,19,20,2013-02-24 19:00:00 +2013,2,24,1921,1925,-4,2119,2126,-7,"9E",3331,"N604LR","JFK","RDU",72,427,19,25,2013-02-24 19:00:00 +2013,2,24,2032,2000,32,2322,2300,22,"B6",21,"N775JB","JFK","TPA",148,1005,20,0,2013-02-24 20:00:00 +2013,2,25,625,600,25,756,745,11,"AA",301,"N3BRAA","LGA","ORD",118,733,6,0,2013-02-25 06:00:00 +2013,2,25,917,920,-3,1207,1240,-33,"AA",1589,"N4UCAA","EWR","DFW",213,1372,9,20,2013-02-25 09:00:00 +2013,2,25,1030,1030,0,1256,1254,2,"DL",2343,"N3763D","EWR","ATL",121,746,10,30,2013-02-25 10:00:00 +2013,2,25,1539,1540,-1,1706,1714,-8,"9E",4178,"N8604C","JFK","ROC",54,264,15,40,2013-02-25 15:00:00 +2013,2,25,1740,1729,11,2032,2046,-14,"DL",1185,"N382DA","EWR","SLC",273,1969,17,29,2013-02-25 17:00:00 +2013,2,25,1854,1855,-1,2050,2100,-10,"US",1491,"N184US","LGA","CLT",87,544,18,55,2013-02-25 18:00:00 +2013,2,25,NA,1007,NA,NA,1122,NA,"EV",5711,"N830AS","JFK","IAD",NA,228,10,7,2013-02-25 10:00:00 +2013,2,26,559,600,-1,749,731,18,"UA",816,"N435UA","LGA","ORD",120,733,6,0,2013-02-26 06:00:00 +2013,2,26,735,740,-5,1037,1105,-28,"DL",1915,"N710TW","JFK","SEA",332,2422,7,40,2013-02-26 07:00:00 +2013,2,26,821,815,6,1125,1125,0,"UA",1218,"N39728","EWR","DFW",221,1372,8,15,2013-02-26 08:00:00 +2013,2,26,925,930,-5,1256,1242,14,"B6",375,"N554JB","LGA","FLL",173,1076,9,30,2013-02-26 09:00:00 +2013,2,26,1000,1000,0,1228,1221,7,"EV",3810,"N14158","EWR","SAV",118,708,10,0,2013-02-26 10:00:00 +2013,2,26,1236,1245,-9,1620,1545,35,"B6",85,"N558JB","JFK","FLL",204,1069,12,45,2013-02-26 12:00:00 +2013,2,26,1340,1254,46,1502,1418,44,"EV",4275,"N13958","EWR","BNA",120,748,12,54,2013-02-26 12:00:00 +2013,2,26,1410,1357,13,1512,1513,-1,"EV",4670,"N12567","EWR","IAD",42,212,13,57,2013-02-26 13:00:00 +2013,2,26,1657,1615,42,1832,1831,1,"DL",1619,"N315US","LGA","MSP",131,1020,16,15,2013-02-26 16:00:00 +2013,2,26,1753,1753,0,2043,2113,-30,"UA",535,"N505UA","JFK","LAX",323,2475,17,53,2013-02-26 17:00:00 +2013,2,26,1843,1850,-7,2002,2050,-48,"AA",2019,"N548AA","LGA","STL",123,888,18,50,2013-02-26 18:00:00 +2013,2,26,1846,1850,-4,2007,2041,-34,"DL",1235,"N365NB","LGA","PIT",64,335,18,50,2013-02-26 18:00:00 +2013,2,26,2140,2145,-5,2235,2239,-4,"EV",4099,"N14158","EWR","BWI",40,169,21,45,2013-02-26 21:00:00 +2013,2,27,715,705,10,1022,1034,-12,"UA",580,"N428UA","EWR","SNA",311,2434,7,5,2013-02-27 07:00:00 +2013,2,27,720,730,-10,1014,1040,-26,"AA",2083,"N599AA","EWR","DFW",211,1372,7,30,2013-02-27 07:00:00 +2013,2,27,731,730,1,924,843,41,"B6",44,"N562JB","JFK","SYR",42,209,7,30,2013-02-27 07:00:00 +2013,2,27,842,844,-2,1014,958,16,"EV",4682,"N13908","EWR","SYR",35,195,8,44,2013-02-27 08:00:00 +2013,2,27,1101,1030,31,1219,1210,9,"AA",321,"N4YCAA","LGA","ORD",108,733,10,30,2013-02-27 10:00:00 +2013,2,27,1407,1154,133,1723,1447,156,"B6",27,"N334JB","JFK","TPA",166,1005,11,54,2013-02-27 11:00:00 +2013,2,27,1624,1625,-1,1844,1855,-11,"MQ",4661,"N531MQ","LGA","ATL",122,762,16,25,2013-02-27 16:00:00 +2013,2,27,1628,1600,28,1753,1712,41,"US",2134,"N950UW","LGA","BOS",34,184,16,0,2013-02-27 16:00:00 +2013,2,27,1631,1600,31,1832,1820,12,"MQ",3985,"N660MQ","JFK","CVG",107,589,16,0,2013-02-27 16:00:00 +2013,2,27,1653,1548,65,1907,1830,37,"DL",95,"N393DA","JFK","ATL",117,760,15,48,2013-02-27 15:00:00 +2013,2,27,1703,1600,63,1809,1717,52,"US",2181,"N742PS","LGA","DCA",49,214,16,0,2013-02-27 16:00:00 +2013,2,27,1806,1815,-9,1936,1958,-22,"9E",4019,"N8709A","JFK","RIC",60,288,18,15,2013-02-27 18:00:00 +2013,2,27,1811,1720,51,2118,2040,38,"AA",1999,"N5CRAA","EWR","MIA",162,1085,17,20,2013-02-27 17:00:00 +2013,2,27,1830,1825,5,2034,2049,-15,"UA",247,"N436UA","EWR","DEN",207,1605,18,25,2013-02-27 18:00:00 +2013,2,27,1856,1900,-4,2210,2217,-7,"DL",2391,"N967DL","JFK","TPA",164,1005,19,0,2013-02-27 19:00:00 +2013,2,27,1921,1925,-4,2212,2303,-51,"DL",6,"N376DA","JFK","SLC",254,1990,19,25,2013-02-27 19:00:00 +2013,2,27,2118,2125,-7,2244,2250,-6,"MQ",4660,"N6EAMQ","LGA","BNA",113,764,21,25,2013-02-27 21:00:00 +2013,2,27,2126,2044,42,2222,2150,32,"EV",4583,"N21130","EWR","MHT",35,209,20,44,2013-02-27 20:00:00 +2013,2,28,814,824,-10,1011,1034,-23,"EV",4357,"N29917","EWR","CVG",94,569,8,24,2013-02-28 08:00:00 +2013,2,28,841,845,-4,940,1015,-35,"9E",3405,"N901XJ","JFK","DCA",39,213,8,45,2013-02-28 08:00:00 +2013,2,28,1018,1021,-3,1329,1342,-13,"DL",1903,"N908DE","LGA","SRQ",162,1047,10,21,2013-02-28 10:00:00 +2013,2,28,1225,1225,0,1338,1349,-11,"EV",4271,"N11551","EWR","BNA",115,748,12,25,2013-02-28 12:00:00 +2013,2,28,1634,1640,-6,1852,1913,-21,"UA",1669,"N24715","EWR","ATL",110,746,16,40,2013-02-28 16:00:00 +2013,2,28,1855,1900,-5,2152,2301,-69,"DL",1967,"N705TW","JFK","SFO",331,2586,19,0,2013-02-28 19:00:00 +2013,2,28,2004,2015,-11,2214,2210,4,"MQ",4555,"N719MQ","LGA","CMH",73,479,20,15,2013-02-28 20:00:00 +2013,2,28,2008,2005,3,2157,2227,-30,"EV",4555,"N14179","EWR","OMA",150,1134,20,5,2013-02-28 20:00:00 +2013,3,1,555,600,-5,715,715,0,"EV",5716,"N828AS","JFK","IAD",52,228,6,0,2013-03-01 06:00:00 +2013,3,1,558,600,-2,903,856,7,"B6",507,"N589JB","EWR","FLL",159,1065,6,0,2013-03-01 06:00:00 +2013,3,1,617,615,2,859,855,4,"9E",3623,"N153PQ","JFK","ATL",110,760,6,15,2013-03-01 06:00:00 +2013,3,1,716,710,6,958,1035,-37,"VX",399,"N636VA","JFK","LAX",315,2475,7,10,2013-03-01 07:00:00 +2013,3,1,946,935,11,1158,1230,-32,"VX",251,"N837VA","JFK","LAS",290,2248,9,35,2013-03-01 09:00:00 +2013,3,1,1449,1452,-3,1704,1655,9,"DL",1231,"N999DN","LGA","DTW",87,502,14,52,2013-03-01 14:00:00 +2013,3,1,1456,1459,-3,1715,1711,4,"B6",1275,"N284JB","JFK","CHS",106,636,14,59,2013-03-01 14:00:00 +2013,3,1,1549,1600,-11,1933,1925,8,"AA",1467,"N3HJAA","LGA","MIA",173,1096,16,0,2013-03-01 16:00:00 +2013,3,1,1555,1600,-5,1725,1724,1,"YV",3788,"N516LR","LGA","IAD",51,229,16,0,2013-03-01 16:00:00 +2013,3,1,1749,1759,-10,2118,2054,24,"B6",391,"N571JB","LGA","MCO",161,950,17,59,2013-03-01 17:00:00 +2013,3,1,1952,1930,22,2313,2238,35,"UA",1292,"N76503","EWR","FLL",169,1065,19,30,2013-03-01 19:00:00 +2013,3,2,555,600,-5,704,715,-11,"EV",5716,"N832AS","JFK","IAD",44,228,6,0,2013-03-02 06:00:00 +2013,3,2,724,730,-6,832,843,-11,"B6",44,"N805JB","JFK","SYR",47,209,7,30,2013-03-02 07:00:00 +2013,3,2,841,830,11,1234,1139,55,"UA",752,"N486UA","EWR","FLL",182,1065,8,30,2013-03-02 08:00:00 +2013,3,2,926,935,-9,1307,1247,20,"B6",375,"N589JB","LGA","FLL",173,1076,9,35,2013-03-02 09:00:00 +2013,3,2,957,1001,-4,1207,1232,-25,"DL",2006,"N347NW","LGA","MSY",156,1183,10,1,2013-03-02 10:00:00 +2013,3,2,1236,1237,-1,1506,1548,-42,"UA",525,"N476UA","LGA","IAH",192,1416,12,37,2013-03-02 12:00:00 +2013,3,2,1541,1545,-4,1815,1857,-42,"UA",841,"N525UA","JFK","LAX",313,2475,15,45,2013-03-02 15:00:00 +2013,3,2,1729,1730,-1,1929,1923,6,"US",449,"N648AW","EWR","CLT",85,529,17,30,2013-03-02 17:00:00 +2013,3,2,2000,1810,110,2315,2130,105,"AA",1611,"N3CKAA","LGA","MIA",169,1096,18,10,2013-03-02 18:00:00 +2013,3,3,858,900,-2,1213,1220,-7,"AA",647,"N359AA","JFK","MIA",161,1089,9,0,2013-03-03 09:00:00 +2013,3,3,946,929,17,1100,1123,-23,"EV",4711,"N11547","EWR","STL",122,872,9,29,2013-03-03 09:00:00 +2013,3,3,1027,1030,-3,1352,1410,-18,"VX",23,"N847VA","JFK","SFO",367,2586,10,30,2013-03-03 10:00:00 +2013,3,3,1042,1050,-8,1334,1402,-28,"DL",1903,"N922DL","LGA","SRQ",148,1047,10,50,2013-03-03 10:00:00 +2013,3,3,1339,1314,25,1503,1451,12,"EV",4306,"N14993","EWR","GSO",67,445,13,14,2013-03-03 13:00:00 +2013,3,3,1357,1400,-3,1508,1513,-5,"B6",602,"N238JB","JFK","PWM",54,273,14,0,2013-03-03 14:00:00 +2013,3,3,1426,1435,-9,1638,1707,-29,"EV",3810,"N13995","EWR","JAX",116,820,14,35,2013-03-03 14:00:00 +2013,3,3,1529,1530,-1,1900,1855,5,"AA",1039,"N3GKAA","JFK","FLL",168,1069,15,30,2013-03-03 15:00:00 +2013,3,3,1602,1556,6,1934,1925,9,"UA",1602,"N71411","EWR","SFO",373,2565,15,56,2013-03-03 15:00:00 +2013,3,3,1632,1640,-8,1814,1857,-43,"9E",3442,"N902XJ","JFK","CVG",84,589,16,40,2013-03-03 16:00:00 +2013,3,3,1638,1635,3,1959,2001,-2,"US",656,"N648AW","EWR","PHX",301,2133,16,35,2013-03-03 16:00:00 +2013,3,3,1707,1700,7,1940,2025,-45,"WN",430,"N750SA","EWR","HOU",190,1411,17,0,2013-03-03 17:00:00 +2013,3,3,1903,1855,8,2241,2240,1,"VX",29,"N624VA","JFK","SFO",376,2586,18,55,2013-03-03 18:00:00 +2013,3,4,714,720,-6,837,848,-11,"FL",850,"N988AT","LGA","MKE",112,738,7,20,2013-03-04 07:00:00 +2013,3,4,1038,1029,9,1324,1308,16,"DL",1529,"N395DN","JFK","LAS",321,2248,10,29,2013-03-04 10:00:00 +2013,3,4,1500,1505,-5,1624,1640,-16,"9E",4105,"N8747B","JFK","IAD",51,228,15,5,2013-03-04 15:00:00 +2013,3,4,1550,1515,35,1722,1700,22,"MQ",4333,"N628MQ","JFK","PIT",63,340,15,15,2013-03-04 15:00:00 +2013,3,4,1611,1558,13,1725,1728,-3,"B6",12,"N258JB","JFK","SYR",48,209,15,58,2013-03-04 15:00:00 +2013,3,4,1640,1640,0,1902,1850,12,"MQ",4540,"N734MQ","LGA","DTW",81,502,16,40,2013-03-04 16:00:00 +2013,3,4,1838,1715,83,2148,2024,84,"DL",1779,"N327NW","LGA","FLL",147,1076,17,15,2013-03-04 17:00:00 +2013,3,4,1859,1900,-1,2134,2131,3,"DL",947,"N602DL","LGA","ATL",107,762,19,0,2013-03-04 19:00:00 +2013,3,4,2024,2029,-5,2252,2322,-30,"UA",686,"N828UA","EWR","MCO",126,937,20,29,2013-03-04 20:00:00 +2013,3,5,1022,1001,21,1118,1116,2,"UA",1233,"N15710","EWR","BOS",37,200,10,1,2013-03-05 10:00:00 +2013,3,5,1114,1106,8,1416,1431,-15,"UA",642,"N557UA","JFK","SFO",340,2586,11,6,2013-03-05 11:00:00 +2013,3,5,1449,1458,-9,1604,1629,-25,"B6",8,"N627JB","JFK","BUF",52,301,14,58,2013-03-05 14:00:00 +2013,3,5,1630,1610,20,1822,1800,22,"AA",341,"N596AA","LGA","ORD",135,733,16,10,2013-03-05 16:00:00 +2013,3,5,1758,1800,-2,2028,2035,-7,"DL",1047,"N641DL","LGA","ATL",115,762,18,0,2013-03-05 18:00:00 +2013,3,5,1931,1940,-9,2249,2245,4,"B6",381,"N662JB","LGA","FLL",165,1076,19,40,2013-03-05 19:00:00 +2013,3,5,2351,2358,-7,427,438,-11,"B6",707,"N613JB","JFK","SJU",194,1598,23,58,2013-03-05 23:00:00 +2013,3,6,723,730,-7,1006,1040,-34,"AA",715,"N4UBAA","LGA","DFW",185,1389,7,30,2013-03-06 07:00:00 +2013,3,6,816,820,-4,1125,1124,1,"B6",901,"N590JB","JFK","FLL",164,1069,8,20,2013-03-06 08:00:00 +2013,3,6,833,835,-2,1121,1140,-19,"DL",1959,"N993DL","JFK","MCO",139,944,8,35,2013-03-06 08:00:00 +2013,3,6,1053,1010,43,1200,1125,35,"B6",600,"N258JB","JFK","PWM",45,273,10,10,2013-03-06 10:00:00 +2013,3,6,1252,1245,7,1542,1600,-18,"AA",2253,"N3BVAA","LGA","MIA",149,1096,12,45,2013-03-06 12:00:00 +2013,3,6,1505,1435,30,1739,1728,11,"UA",355,"N437UA","EWR","MCO",127,937,14,35,2013-03-06 14:00:00 +2013,3,6,1810,1700,70,2011,1925,46,"DL",2042,"N916DL","EWR","ATL",96,746,17,0,2013-03-06 17:00:00 +2013,3,6,1836,1652,104,1937,1806,91,"B6",1176,"N323JB","EWR","BOS",38,200,16,52,2013-03-06 16:00:00 +2013,3,6,NA,700,NA,NA,807,NA,"US",2163,NA,"LGA","DCA",NA,214,7,0,2013-03-06 07:00:00 +2013,3,7,14,2046,208,126,2214,192,"EV",4571,"N16999","EWR","MKE",110,725,20,46,2013-03-07 20:00:00 +2013,3,7,817,759,18,1109,1106,3,"UA",288,"N492UA","EWR","DFW",189,1372,7,59,2013-03-07 07:00:00 +2013,3,7,948,918,30,1117,1025,52,"B6",1004,"N625JB","JFK","BOS",52,187,9,18,2013-03-07 09:00:00 +2013,3,7,1012,1010,2,1124,1125,-1,"B6",600,"N656JB","JFK","PWM",47,273,10,10,2013-03-07 10:00:00 +2013,3,7,1055,1100,-5,1317,1331,-14,"DL",1647,"N900PC","LGA","ATL",105,762,11,0,2013-03-07 11:00:00 +2013,3,7,1135,1137,-2,1429,1445,-16,"UA",1601,"N54241","EWR","FLL",155,1065,11,37,2013-03-07 11:00:00 +2013,3,7,1313,1315,-2,1511,1504,7,"US",1536,"N191UW","EWR","CLT",84,529,13,15,2013-03-07 13:00:00 +2013,3,7,1423,1355,28,1711,1648,23,"UA",510,"N467UA","EWR","MCO",136,937,13,55,2013-03-07 13:00:00 +2013,3,7,1439,1445,-6,1619,1647,-28,"US",1445,"N189UW","LGA","CLT",83,544,14,45,2013-03-07 14:00:00 +2013,3,7,1630,1600,30,1833,1712,81,"US",2134,"N963UW","LGA","BOS",66,184,16,0,2013-03-07 16:00:00 +2013,3,7,1926,1830,56,2142,2015,87,"MQ",4674,"N519MQ","LGA","CLE",70,419,18,30,2013-03-07 18:00:00 +2013,3,7,2009,2000,9,2312,2300,12,"B6",21,"N589JB","JFK","TPA",138,1005,20,0,2013-03-07 20:00:00 +2013,3,8,803,800,3,1048,1000,48,"B6",219,"N239JB","JFK","CLT",101,541,8,0,2013-03-08 08:00:00 +2013,3,8,839,835,4,1106,1105,1,"MQ",4610,"N508MQ","LGA","ATL",104,762,8,35,2013-03-08 08:00:00 +2013,3,8,858,850,8,1246,1145,61,"B6",59,"N203JB","JFK","TPA",132,1005,8,50,2013-03-08 08:00:00 +2013,3,8,1202,1030,92,1607,1340,147,"AA",19,"N335AA","JFK","LAX",348,2475,10,30,2013-03-08 10:00:00 +2013,3,8,1409,1125,164,1549,1305,164,"AA",327,"N3AMAA","LGA","ORD",111,733,11,25,2013-03-08 11:00:00 +2013,3,8,1524,1535,-11,1750,1807,-17,"9E",4147,"N8944B","JFK","IND",98,665,15,35,2013-03-08 15:00:00 +2013,3,8,1936,1645,171,2117,1850,147,"DL",1473,"N326NB","LGA","MEM",134,963,16,45,2013-03-08 16:00:00 +2013,3,8,1940,1940,0,2134,2125,9,"MQ",3783,"N514MQ","JFK","CMH",69,483,19,40,2013-03-08 19:00:00 +2013,3,8,2029,2025,4,2147,2149,-2,"DL",985,"N339NW","JFK","BOS",40,187,20,25,2013-03-08 20:00:00 +2013,3,8,NA,2000,NA,NA,2245,NA,"EV",4204,"N21130","EWR","OKC",NA,1325,20,0,2013-03-08 20:00:00 +2013,3,8,NA,1500,NA,NA,1608,NA,"US",2132,NA,"LGA","BOS",NA,184,15,0,2013-03-08 15:00:00 +2013,3,9,756,800,-4,948,1000,-12,"B6",219,"N337JB","JFK","CLT",80,541,8,0,2013-03-09 08:00:00 +2013,3,9,804,730,34,902,843,19,"B6",44,"N625JB","JFK","SYR",40,209,7,30,2013-03-09 07:00:00 +2013,3,9,837,840,-3,944,957,-13,"EV",3836,"N16571","EWR","BOS",39,200,8,40,2013-03-09 08:00:00 +2013,3,9,951,959,-8,1119,1129,-10,"MQ",4670,"N3AEMQ","LGA","BNA",106,764,9,59,2013-03-09 09:00:00 +2013,3,9,1253,1300,-7,1351,1408,-17,"US",2175,"N961UW","LGA","DCA",40,214,13,0,2013-03-09 13:00:00 +2013,3,9,1620,1610,10,1800,1804,-4,"9E",3407,"N926XJ","JFK","PIT",64,340,16,10,2013-03-09 16:00:00 +2013,3,10,609,610,-1,840,905,-25,"UA",707,"N496UA","EWR","MCO",128,937,6,10,2013-03-10 06:00:00 +2013,3,10,1156,1200,-4,1320,1330,-10,"MQ",4601,"N530MQ","LGA","BNA",107,764,12,0,2013-03-10 12:00:00 +2013,3,10,1505,1438,27,1615,1555,20,"EV",5930,"N13913","EWR","IAD",41,212,14,38,2013-03-10 14:00:00 +2013,3,10,1656,1700,-4,1939,2011,-32,"UA",404,"N492UA","LGA","IAH",198,1416,17,0,2013-03-10 17:00:00 +2013,3,10,1705,1715,-10,2014,2005,9,"WN",1035,"N778SW","EWR","HOU",223,1411,17,15,2013-03-10 17:00:00 +2013,3,10,1736,1738,-2,1955,2004,-9,"FL",806,"N977AT","LGA","ATL",112,762,17,38,2013-03-10 17:00:00 +2013,3,10,1801,1556,125,2044,1925,79,"UA",1602,"N37468","EWR","SFO",323,2565,15,56,2013-03-10 15:00:00 +2013,3,10,1823,1829,-6,2004,2032,-28,"US",1973,"N536UW","EWR","CLT",76,529,18,29,2013-03-10 18:00:00 +2013,3,10,2149,2100,49,2400,2315,45,"EV",3817,"N10575","EWR","SDF",107,642,21,0,2013-03-10 21:00:00 +2013,3,11,748,757,-9,920,945,-25,"9E",3611,"N8932C","JFK","PIT",70,340,7,57,2013-03-11 07:00:00 +2013,3,11,1208,1210,-2,1343,1325,18,"WN",3839,"N900WN","EWR","MDW",112,711,12,10,2013-03-11 12:00:00 +2013,3,11,1725,1631,54,1923,1834,49,"EV",4411,"N14952","EWR","MEM",151,946,16,31,2013-03-11 16:00:00 +2013,3,11,1813,1815,-2,2129,2147,-18,"B6",173,"N606JB","JFK","SJC",345,2569,18,15,2013-03-11 18:00:00 +2013,3,11,1814,1820,-6,2109,2150,-41,"AA",119,"N3BFAA","EWR","LAX",322,2454,18,20,2013-03-11 18:00:00 +2013,3,11,1853,1900,-7,2158,2240,-42,"DL",87,"N713TW","JFK","LAX",331,2475,19,0,2013-03-11 19:00:00 +2013,3,11,1953,1929,24,2218,2157,21,"EV",5181,"N755EV","EWR","ATL",120,746,19,29,2013-03-11 19:00:00 +2013,3,12,5,2020,225,312,2327,225,"B6",801,"N523JB","JFK","FLL",162,1069,20,20,2013-03-12 20:00:00 +2013,3,12,31,2138,173,348,29,199,"B6",383,"N624JB","LGA","FLL",164,1076,21,38,2013-03-12 21:00:00 +2013,3,12,1715,1719,-4,1833,1857,-24,"UA",16,"N39450","EWR","ORD",114,719,17,19,2013-03-12 17:00:00 +2013,3,13,620,630,-10,802,830,-28,"MQ",4599,"N535MQ","LGA","MSP",140,1020,6,30,2013-03-13 06:00:00 +2013,3,13,624,608,16,743,724,19,"EV",4354,"N11150","EWR","IAD",49,212,6,8,2013-03-13 06:00:00 +2013,3,13,700,705,-5,1035,1012,23,"DL",1879,"N952DL","LGA","FLL",164,1076,7,5,2013-03-13 07:00:00 +2013,3,13,725,730,-5,935,1005,-30,"WN",2692,"N473WN","LGA","DEN",221,1620,7,30,2013-03-13 07:00:00 +2013,3,13,857,859,-2,1215,1219,-4,"UA",1581,"N33292","EWR","SEA",338,2402,8,59,2013-03-13 08:00:00 +2013,3,13,1116,1105,11,1222,1240,-18,"WN",993,"N903WN","LGA","MDW",105,725,11,5,2013-03-13 11:00:00 +2013,3,13,1341,1345,-4,1612,1655,-43,"B6",209,"N598JB","JFK","LGB",313,2465,13,45,2013-03-13 13:00:00 +2013,3,13,1549,1553,-4,1750,1808,-18,"EV",4684,"N33182","EWR","SDF",102,642,15,53,2013-03-13 15:00:00 +2013,3,13,1943,1925,18,2302,2243,19,"DL",2139,"N909DE","LGA","MIA",166,1096,19,25,2013-03-13 19:00:00 +2013,3,13,2107,2100,7,2310,2315,-5,"EV",3817,"N16911","EWR","SDF",103,642,21,0,2013-03-13 21:00:00 +2013,3,14,601,600,1,711,720,-9,"WN",430,"N8611F","LGA","MDW",106,725,6,0,2013-03-14 06:00:00 +2013,3,14,637,642,-5,857,850,7,"EV",4626,"N10156","EWR","MSP",167,1008,6,42,2013-03-14 06:00:00 +2013,3,14,820,835,-15,1112,1134,-22,"B6",517,"N645JB","EWR","MCO",140,937,8,35,2013-03-14 08:00:00 +2013,3,14,950,959,-9,1110,1124,-14,"EV",5736,"N833AS","LGA","IAD",53,229,9,59,2013-03-14 09:00:00 +2013,3,14,1247,1250,-3,1543,1604,-21,"B6",1065,"N595JB","JFK","AUS",207,1521,12,50,2013-03-14 12:00:00 +2013,3,14,1544,1543,1,1709,1710,-1,"9E",4135,"N8604C","JFK","BWI",36,184,15,43,2013-03-14 15:00:00 +2013,3,14,1634,1635,-1,1846,1901,-15,"US",656,"N678AW","EWR","PHX",270,2133,16,35,2013-03-14 16:00:00 +2013,3,14,1959,1951,8,2326,2329,-3,"B6",91,"N623JB","JFK","OAK",340,2576,19,51,2013-03-14 19:00:00 +2013,3,14,2353,2355,-2,340,340,0,"B6",739,"N763JB","JFK","PSE",205,1617,23,55,2013-03-14 23:00:00 +2013,3,15,621,615,6,822,820,2,"US",829,"N701UW","JFK","CLT",78,541,6,15,2013-03-15 06:00:00 +2013,3,15,626,630,-4,833,914,-41,"UA",216,"N417UA","EWR","PHX",286,2133,6,30,2013-03-15 06:00:00 +2013,3,15,654,655,-1,814,825,-11,"WN",3048,"N270WN","LGA","MKE",114,738,6,55,2013-03-15 06:00:00 +2013,3,15,700,705,-5,958,951,7,"DL",2285,"N675DL","LGA","MCO",130,950,7,5,2013-03-15 07:00:00 +2013,3,15,748,800,-12,846,908,-22,"US",2118,"N952UW","LGA","BOS",37,184,8,0,2013-03-15 08:00:00 +2013,3,15,813,815,-2,948,1010,-22,"MQ",4490,"N730MQ","LGA","CMH",76,479,8,15,2013-03-15 08:00:00 +2013,3,15,922,929,-7,1313,1326,-13,"B6",215,"N653JB","EWR","SJU",205,1608,9,29,2013-03-15 09:00:00 +2013,3,15,930,930,0,1213,1255,-42,"WN",739,"N943WN","EWR","AUS",199,1504,9,30,2013-03-15 09:00:00 +2013,3,15,1051,1050,1,1332,1402,-30,"UA",1183,"N38257","EWR","RSW",138,1068,10,50,2013-03-15 10:00:00 +2013,3,15,1243,1217,26,1351,1334,17,"EV",4121,"N12157","EWR","ROC",53,246,12,17,2013-03-15 12:00:00 +2013,3,15,1354,1400,-6,1455,1503,-8,"US",2130,"N950UW","LGA","BOS",40,184,14,0,2013-03-15 14:00:00 +2013,3,15,1604,1329,155,1815,1542,153,"EV",3837,"N12567","EWR","IND",109,645,13,29,2013-03-15 13:00:00 +2013,3,15,1817,1810,7,2111,2127,-16,"B6",217,"N598JB","JFK","LGB",336,2465,18,10,2013-03-15 18:00:00 +2013,3,15,1854,1825,29,2058,2055,3,"WN",2805,"N910WN","EWR","MSY",162,1167,18,25,2013-03-15 18:00:00 +2013,3,15,1938,1935,3,2215,2240,-25,"AA",791,"N3AKAA","LGA","DFW",199,1389,19,35,2013-03-15 19:00:00 +2013,3,15,1943,1940,3,2153,2231,-38,"9E",3340,"N919XJ","JFK","JAX",110,828,19,40,2013-03-15 19:00:00 +2013,3,16,619,615,4,850,842,8,"DL",1743,"N303DQ","JFK","ATL",118,760,6,15,2013-03-16 06:00:00 +2013,3,16,737,736,1,1132,1115,17,"B6",643,"N821JB","JFK","SFO",393,2586,7,36,2013-03-16 07:00:00 +2013,3,16,859,900,-1,1125,1126,-1,"DL",485,"N773NC","EWR","ATL",113,746,9,0,2013-03-16 09:00:00 +2013,3,16,907,910,-3,1023,1032,-9,"B6",20,"N284JB","JFK","ROC",53,264,9,10,2013-03-16 09:00:00 +2013,3,16,1322,1329,-7,1549,1542,7,"EV",4163,"N11187","EWR","IND",115,645,13,29,2013-03-16 13:00:00 +2013,3,16,1457,1430,27,1625,1554,31,"EV",5766,"N834AS","LGA","IAD",49,229,14,30,2013-03-16 14:00:00 +2013,3,16,1545,1545,0,1723,1700,23,"WN",1572,"N284WN","EWR","MDW",121,711,15,45,2013-03-16 15:00:00 +2013,3,16,1913,1915,-2,2216,2208,8,"B6",155,"N592JB","JFK","MCO",135,944,19,15,2013-03-16 19:00:00 +2013,3,16,2030,2030,0,2330,2306,24,"B6",619,"N354JB","JFK","JAX",122,828,20,30,2013-03-16 20:00:00 +2013,3,17,844,835,9,1125,1134,-9,"B6",517,"N562JB","EWR","MCO",139,937,8,35,2013-03-17 08:00:00 +2013,3,17,928,930,-2,1223,1243,-20,"B6",1639,"N639JB","LGA","RSW",153,1080,9,30,2013-03-17 09:00:00 +2013,3,17,1121,1130,-9,1422,1437,-15,"UA",703,"N512UA","JFK","LAX",339,2475,11,30,2013-03-17 11:00:00 +2013,3,17,1523,1529,-6,1734,1737,-3,"EV",4352,"N13132","EWR","CVG",98,569,15,29,2013-03-17 15:00:00 +2013,3,17,1804,1810,-6,1947,1945,2,"MQ",4484,"N723MQ","LGA","BNA",128,764,18,10,2013-03-17 18:00:00 +2013,3,17,1939,1918,21,2239,2216,23,"UA",1159,"N77510","EWR","PBI",153,1023,19,18,2013-03-17 19:00:00 +2013,3,17,2111,2115,-4,5,2358,7,"B6",927,"N562JB","EWR","MCO",139,937,21,15,2013-03-17 21:00:00 +2013,3,18,626,629,-3,840,849,-9,"DL",575,"N359NB","EWR","ATL",116,746,6,29,2013-03-18 06:00:00 +2013,3,18,639,645,-6,906,846,20,"US",1281,"N182UW","EWR","CLT",90,529,6,45,2013-03-18 06:00:00 +2013,3,18,1151,1140,11,1448,1445,3,"AA",1623,"N3FAAA","EWR","MIA",152,1085,11,40,2013-03-18 11:00:00 +2013,3,18,1539,1545,-6,2228,1803,NA,"DL",1942,"N347NB","EWR","ATL",NA,746,15,45,2013-03-18 15:00:00 +2013,3,18,2024,1955,29,2332,2310,22,"AA",1709,"N3HNAA","LGA","MIA",155,1096,19,55,2013-03-18 19:00:00 +2013,3,18,2317,2005,192,319,2330,229,"VX",415,"N642VA","JFK","LAX",366,2475,20,5,2013-03-18 20:00:00 +2013,3,19,812,816,-4,1134,1146,-12,"UA",1290,"N17244","EWR","SFO",361,2565,8,16,2013-03-19 08:00:00 +2013,3,19,812,752,20,1213,1147,26,"UA",1481,"N12109","EWR","SJU",195,1608,7,52,2013-03-19 07:00:00 +2013,3,19,859,900,-1,1035,1039,-4,"UA",544,"N813UA","LGA","ORD",115,733,9,0,2013-03-19 09:00:00 +2013,3,19,1000,810,110,1318,1123,115,"DL",1271,"N332NW","JFK","FLL",171,1069,8,10,2013-03-19 08:00:00 +2013,3,19,1443,1445,-2,1704,1656,8,"EV",5475,"N615QX","LGA","CLT",96,544,14,45,2013-03-19 14:00:00 +2013,3,19,1717,1610,67,1824,1736,48,"9E",3968,"N8577D","JFK","PHL",31,94,16,10,2013-03-19 16:00:00 +2013,3,19,1754,1805,-11,1928,1945,-17,"9E",4019,"N8631E","JFK","RIC",61,288,18,5,2013-03-19 18:00:00 +2013,3,19,2001,1935,26,2244,2207,37,"EV",4333,"N11155","EWR","TUL",192,1215,19,35,2013-03-19 19:00:00 +2013,3,19,2018,2005,13,2331,2330,1,"VX",415,"N639VA","JFK","LAX",342,2475,20,5,2013-03-19 20:00:00 +2013,3,19,2103,2005,58,2214,2109,65,"EV",4566,"N12922","EWR","ALB",34,143,20,5,2013-03-19 20:00:00 +2013,3,20,558,600,-2,652,659,-7,"US",2161,"N702UW","LGA","DCA",41,214,6,0,2013-03-20 06:00:00 +2013,3,20,716,725,-9,935,948,-13,"EV",4150,"N14180","EWR","XNA",174,1131,7,25,2013-03-20 07:00:00 +2013,3,20,729,735,-6,918,935,-17,"EV",4344,"N13964","EWR","DTW",86,488,7,35,2013-03-20 07:00:00 +2013,3,20,815,810,5,1128,1124,4,"DL",2070,"N343NB","LGA","RSW",170,1080,8,10,2013-03-20 08:00:00 +2013,3,20,841,845,-4,1055,1057,-2,"US",1429,"N742PS","LGA","CLT",101,544,8,45,2013-03-20 08:00:00 +2013,3,20,934,929,5,1203,1222,-19,"UA",1597,"N15710","EWR","EGE",242,1725,9,29,2013-03-20 09:00:00 +2013,3,20,1012,1015,-3,1220,1216,4,"US",1427,"N738US","JFK","CLT",94,541,10,15,2013-03-20 10:00:00 +2013,3,20,1051,1030,21,1222,1215,7,"MQ",4471,"N725MQ","LGA","RDU",77,431,10,30,2013-03-20 10:00:00 +2013,3,20,1400,1343,17,1713,1715,-2,"UA",81,"N73278","EWR","SFO",356,2565,13,43,2013-03-20 13:00:00 +2013,3,20,1529,1530,-1,1730,1725,5,"MQ",4146,"N624MQ","JFK","CMH",78,483,15,30,2013-03-20 15:00:00 +2013,3,20,1902,1900,2,2124,2131,-7,"DL",947,"N636DL","LGA","ATL",116,762,19,0,2013-03-20 19:00:00 +2013,3,20,1936,1922,14,2256,2220,36,"UA",1057,"N27724","EWR","PBI",168,1023,19,22,2013-03-20 19:00:00 +2013,3,21,617,630,-13,903,926,-23,"B6",983,"N603JB","LGA","TPA",144,1010,6,30,2013-03-21 06:00:00 +2013,3,21,858,900,-2,1216,1220,-4,"AA",1,"N320AA","JFK","LAX",334,2475,9,0,2013-03-21 09:00:00 +2013,3,21,1059,1100,-1,1418,1414,4,"DL",930,"N952DL","LGA","FLL",156,1076,11,0,2013-03-21 11:00:00 +2013,3,21,1310,1200,70,1427,1314,73,"EV",4229,"N16571","EWR","BUF",59,282,12,0,2013-03-21 12:00:00 +2013,3,21,1317,1310,7,1721,1706,15,"UA",1708,"N37468","EWR","SJU",221,1608,13,10,2013-03-21 13:00:00 +2013,3,21,1538,944,354,1702,1138,324,"EV",4389,"N15973","EWR","STL",132,872,9,44,2013-03-21 09:00:00 +2013,3,21,1646,1650,-4,1809,1820,-11,"AA",1790,"N3KBAA","JFK","BOS",35,187,16,50,2013-03-21 16:00:00 +2013,3,21,1751,1800,-9,1907,1917,-10,"B6",1307,"N183JB","JFK","IAD",52,228,18,0,2013-03-21 18:00:00 +2013,3,21,2054,1930,84,4,2238,86,"UA",1292,"N38268","EWR","FLL",149,1065,19,30,2013-03-21 19:00:00 +2013,3,22,623,630,-7,833,843,-10,"US",1433,"N185UW","LGA","CLT",81,544,6,30,2013-03-22 06:00:00 +2013,3,22,812,815,-3,1052,1115,-23,"DL",1167,"N305DQ","JFK","TPA",142,1005,8,15,2013-03-22 08:00:00 +2013,3,22,1306,1249,17,1548,1539,9,"B6",991,"N638JB","JFK","PBI",147,1028,12,49,2013-03-22 12:00:00 +2013,3,22,1324,1329,-5,1518,1533,-15,"EV",4612,"N31131","EWR","MSP",152,1008,13,29,2013-03-22 13:00:00 +2013,3,22,1452,1455,-3,1744,1757,-13,"B6",141,"N635JB","JFK","PBI",144,1028,14,55,2013-03-22 14:00:00 +2013,3,22,1714,1658,16,2012,2007,5,"B6",139,"N292JB","JFK","RSW",158,1074,16,58,2013-03-22 16:00:00 +2013,3,22,1729,1645,44,1842,1800,42,"EV",4216,"N14959","EWR","BUF",59,282,16,45,2013-03-22 16:00:00 +2013,3,22,1821,1800,21,2015,1940,35,"UA",578,"N414UA","EWR","ORD",108,719,18,0,2013-03-22 18:00:00 +2013,3,22,2124,2125,-1,2233,2240,-7,"MQ",4449,"N806MQ","JFK","DCA",51,213,21,25,2013-03-22 21:00:00 +2013,3,23,954,955,-1,1325,1257,28,"B6",503,"N603JB","EWR","FLL",156,1065,9,55,2013-03-23 09:00:00 +2013,3,23,1146,1128,18,1331,1335,-4,"DL",2219,"N338NW","LGA","MSP",148,1020,11,28,2013-03-23 11:00:00 +2013,3,23,1431,1430,1,1703,1659,4,"B6",119,"N292JB","JFK","MSY",190,1182,14,30,2013-03-23 14:00:00 +2013,3,23,1444,1435,9,1818,1744,34,"B6",347,"N193JB","JFK","SRQ",166,1041,14,35,2013-03-23 14:00:00 +2013,3,23,1605,1600,5,1835,1831,4,"EV",4699,"N12136","EWR","MSY",192,1167,16,0,2013-03-23 16:00:00 +2013,3,23,1828,1830,-2,2145,2205,-20,"AA",269,"N3FEAA","JFK","SEA",326,2422,18,30,2013-03-23 18:00:00 +2013,3,23,2134,2140,-6,2310,2305,5,"B6",104,"N324JB","JFK","BUF",62,301,21,40,2013-03-23 21:00:00 +2013,3,24,1057,1100,-3,1349,1414,-25,"DL",1275,"N3756","JFK","SLC",271,1990,11,0,2013-03-24 11:00:00 +2013,3,24,1115,1120,-5,1448,1422,26,"B6",1,"N662JB","JFK","FLL",167,1069,11,20,2013-03-24 11:00:00 +2013,3,24,1310,1313,-3,1455,1450,5,"EV",4306,"N13964","EWR","GSO",90,445,13,13,2013-03-24 13:00:00 +2013,3,24,1510,1512,-2,1847,1824,23,"UA",1739,"N14230","EWR","RSW",196,1068,15,12,2013-03-24 15:00:00 +2013,3,24,1541,1535,6,1914,1844,30,"9E",3325,"N918XJ","JFK","DFW",218,1391,15,35,2013-03-24 15:00:00 +2013,3,24,1713,1710,3,1813,1826,-13,"EV",4701,"N14920","EWR","BTV",46,266,17,10,2013-03-24 17:00:00 +2013,3,24,1714,1715,-1,2121,2024,57,"DL",1779,"N364NW","LGA","FLL",222,1076,17,15,2013-03-24 17:00:00 +2013,3,24,1826,1515,191,1945,1628,197,"EV",4583,"N16911","EWR","PWM",47,284,15,15,2013-03-24 15:00:00 +2013,3,24,1955,1940,15,2238,2231,7,"9E",3340,"N604LR","JFK","JAX",133,828,19,40,2013-03-24 19:00:00 +2013,3,25,551,600,-9,657,733,-36,"UA",997,"N414UA","LGA","ORD",111,733,6,0,2013-03-25 06:00:00 +2013,3,25,610,615,-5,839,844,-5,"DL",1743,"N305DQ","JFK","ATL",124,760,6,15,2013-03-25 06:00:00 +2013,3,25,648,700,-12,802,850,-48,"AA",305,"N511AA","LGA","ORD",113,733,7,0,2013-03-25 07:00:00 +2013,3,25,918,925,-7,1043,1047,-4,"B6",108,"N709JB","JFK","BUF",51,301,9,25,2013-03-25 09:00:00 +2013,3,25,943,950,-7,1058,1103,-5,"9E",3739,"N8409N","JFK","PHL",40,94,9,50,2013-03-25 09:00:00 +2013,3,25,954,935,19,1102,1120,-18,"WN",2074,"N916WN","LGA","MDW",107,725,9,35,2013-03-25 09:00:00 +2013,3,25,1259,1300,-1,1410,1425,-15,"WN",3295,"N750SA","EWR","BNA",111,748,13,0,2013-03-25 13:00:00 +2013,3,25,1422,1422,0,1715,1715,0,"UA",1166,"N19136","EWR","TPA",151,997,14,22,2013-03-25 14:00:00 +2013,3,25,1456,1500,-4,1821,1825,-4,"AA",1925,"N3AMAA","LGA","MIA",159,1096,15,0,2013-03-25 15:00:00 +2013,3,25,1730,1710,20,2020,2015,5,"AA",695,"N3BUAA","JFK","AUS",208,1521,17,10,2013-03-25 17:00:00 +2013,3,25,1816,1753,23,2118,2105,13,"UA",535,"N554UA","JFK","LAX",329,2475,17,53,2013-03-25 17:00:00 +2013,3,25,1821,1820,1,1945,2005,-20,"AA",353,"N3GWAA","LGA","ORD",114,733,18,20,2013-03-25 18:00:00 +2013,3,25,1842,1800,42,2010,1940,30,"UA",597,"N808UA","EWR","ORD",99,719,18,0,2013-03-25 18:00:00 +2013,3,25,2042,2055,-13,2223,2250,-27,"MQ",4573,"N735MQ","LGA","DTW",80,502,20,55,2013-03-25 20:00:00 +2013,3,25,2131,2055,36,2226,2220,6,"WN",115,"N749SW","LGA","MDW",100,725,20,55,2013-03-25 20:00:00 +2013,3,25,NA,1500,NA,NA,1638,NA,"9E",3393,NA,"JFK","DCA",NA,213,15,0,2013-03-25 15:00:00 +2013,3,26,620,620,0,951,1002,-11,"B6",709,"N629JB","JFK","SJU",194,1598,6,20,2013-03-26 06:00:00 +2013,3,26,814,810,4,1026,1030,-4,"FL",346,"N894AT","LGA","ATL",110,762,8,10,2013-03-26 08:00:00 +2013,3,26,839,845,-6,1047,1057,-10,"US",1429,"N747UW","LGA","CLT",86,544,8,45,2013-03-26 08:00:00 +2013,3,26,924,929,-5,1203,1212,-9,"UA",657,"N556UA","EWR","LAS",303,2227,9,29,2013-03-26 09:00:00 +2013,3,26,1256,1259,-3,1522,1534,-12,"DL",781,"N612DL","LGA","ATL",109,762,12,59,2013-03-26 12:00:00 +2013,3,26,1543,1545,-2,1831,1856,-25,"DL",4,"N387DA","JFK","MCO",142,944,15,45,2013-03-26 15:00:00 +2013,3,26,1841,1847,-6,2201,2219,-18,"UA",389,"N512UA","JFK","SFO",344,2586,18,47,2013-03-26 18:00:00 +2013,3,26,1952,2000,-8,2104,2117,-13,"US",2189,"N765US","LGA","DCA",40,214,20,0,2013-03-26 20:00:00 +2013,3,27,534,540,-6,832,850,-18,"AA",1141,"N5BSAA","JFK","MIA",152,1089,5,40,2013-03-27 05:00:00 +2013,3,27,600,600,0,923,925,-2,"UA",303,"N505UA","JFK","SFO",356,2586,6,0,2013-03-27 06:00:00 +2013,3,27,628,630,-2,835,914,-39,"UA",216,"N417UA","EWR","PHX",288,2133,6,30,2013-03-27 06:00:00 +2013,3,27,907,914,-7,1203,1210,-7,"B6",57,"N585JB","JFK","PBI",144,1028,9,14,2013-03-27 09:00:00 +2013,3,27,944,950,-6,1057,1103,-6,"9E",3739,"N8747B","JFK","PHL",31,94,9,50,2013-03-27 09:00:00 +2013,3,27,950,955,-5,1237,1257,-20,"B6",503,"N556JB","EWR","FLL",147,1065,9,55,2013-03-27 09:00:00 +2013,3,27,1520,1525,-5,1640,1655,-15,"MQ",3823,"N517MQ","JFK","DCA",56,213,15,25,2013-03-27 15:00:00 +2013,3,27,1700,1704,-4,1855,1929,-34,"UA",1668,"N38451","EWR","DEN",215,1605,17,4,2013-03-27 17:00:00 +2013,3,28,708,709,-1,1003,1009,-6,"B6",987,"N506JB","JFK","MCO",138,944,7,9,2013-03-28 07:00:00 +2013,3,28,856,900,-4,1002,1017,-15,"B6",56,"N192JB","JFK","BTV",48,266,9,0,2013-03-28 09:00:00 +2013,3,28,929,935,-6,1201,1230,-29,"VX",251,"N838VA","JFK","LAS",314,2248,9,35,2013-03-28 09:00:00 +2013,3,28,1546,1545,1,1900,1910,-10,"AA",133,"N332AA","JFK","LAX",337,2475,15,45,2013-03-28 15:00:00 +2013,3,28,1554,1600,-6,1903,1925,-22,"AA",1467,"N3CXAA","LGA","MIA",156,1096,16,0,2013-03-28 16:00:00 +2013,3,28,2050,2100,-10,2317,2346,-29,"B6",399,"N662JB","LGA","MCO",131,950,21,0,2013-03-28 21:00:00 +2013,3,29,654,659,-5,937,959,-22,"AA",1815,"N5FSAA","JFK","MCO",134,944,6,59,2013-03-29 06:00:00 +2013,3,29,1001,1000,1,1237,1252,-15,"UA",1003,"N14731","EWR","MCO",136,937,10,0,2013-03-29 10:00:00 +2013,3,29,1236,1245,-9,1538,1600,-22,"AA",2253,"N3JKAA","LGA","MIA",161,1096,12,45,2013-03-29 12:00:00 +2013,3,29,1448,1450,-2,1732,1755,-23,"AA",1813,"N5FGAA","JFK","MCO",139,944,14,50,2013-03-29 14:00:00 +2013,3,29,1553,1605,-12,1724,1750,-26,"MQ",4415,"N719MQ","LGA","RDU",69,431,16,5,2013-03-29 16:00:00 +2013,3,29,1930,1933,-3,2149,2201,-12,"EV",4509,"N13133","EWR","MSY",163,1167,19,33,2013-03-29 19:00:00 +2013,3,29,1952,1956,-4,2118,2115,3,"EV",4258,"N16546","EWR","IAD",49,212,19,56,2013-03-29 19:00:00 +2013,3,29,2027,2019,8,2310,2310,0,"UA",353,"N516UA","EWR","SEA",321,2402,20,19,2013-03-29 20:00:00 +2013,3,29,2033,2045,-12,2210,2225,-15,"AA",371,"N4WPAA","LGA","ORD",120,733,20,45,2013-03-29 20:00:00 +2013,3,30,629,630,-1,835,905,-30,"WN",878,"N299WN","LGA","DEN",229,1620,6,30,2013-03-30 06:00:00 +2013,3,30,733,735,-2,902,915,-13,"WN",1075,"N760SW","EWR","STL",128,872,7,35,2013-03-30 07:00:00 +2013,3,30,907,910,-3,1023,1053,-30,"B6",885,"N229JB","JFK","RDU",61,427,9,10,2013-03-30 09:00:00 +2013,3,30,927,930,-3,1051,1101,-10,"9E",3613,"N8516C","JFK","ROC",51,264,9,30,2013-03-30 09:00:00 +2013,3,30,1038,1041,-3,1205,1220,-15,"EV",4298,"N15973","EWR","RDU",67,416,10,41,2013-03-30 10:00:00 +2013,3,30,1441,1450,-9,1553,1625,-32,"9E",4357,"N833AY","JFK","ORF",53,290,14,50,2013-03-30 14:00:00 +2013,3,30,1624,1629,-5,1835,1850,-15,"9E",3384,"N919XJ","JFK","DTW",94,509,16,29,2013-03-30 16:00:00 +2013,3,30,1650,1658,-8,1946,2007,-21,"B6",139,"N258JB","JFK","RSW",150,1074,16,58,2013-03-30 16:00:00 +2013,3,30,1707,1720,-13,1829,1905,-36,"MQ",4479,"N720MQ","LGA","RDU",69,431,17,20,2013-03-30 17:00:00 +2013,3,30,1741,1645,56,1847,1801,46,"EV",4216,"N16963","EWR","BUF",48,282,16,45,2013-03-30 16:00:00 +2013,3,30,1901,1905,-4,2106,2139,-33,"DL",1097,"N321NB","JFK","MSY",164,1182,19,5,2013-03-30 19:00:00 +2013,3,30,1949,1955,-6,2245,2310,-25,"AA",1709,"N3CKAA","LGA","MIA",143,1096,19,55,2013-03-30 19:00:00 +2013,3,31,721,730,-9,1026,1040,-14,"AA",715,"N4XBAA","LGA","DFW",222,1389,7,30,2013-03-31 07:00:00 +2013,3,31,805,810,-5,956,1020,-24,"DL",2119,"N980DL","LGA","MSP",149,1020,8,10,2013-03-31 08:00:00 +2013,3,31,1342,1350,-8,1554,1607,-13,"US",186,"N658AW","EWR","PHX",297,2133,13,50,2013-03-31 13:00:00 +2013,3,31,1637,1640,-3,1847,1857,-10,"9E",3442,"N907XJ","JFK","CVG",102,589,16,40,2013-03-31 16:00:00 +2013,3,31,1822,1829,-7,2023,2034,-11,"EV",4155,"N13964","EWR","GRR",93,605,18,29,2013-03-31 18:00:00 +2013,3,31,1824,1829,-5,2027,2024,3,"EV",4451,"N21154","EWR","CAE",94,602,18,29,2013-03-31 18:00:00 +2013,3,31,2105,2005,60,2336,2213,83,"EV",4536,"N16546","EWR","CVG",101,569,20,5,2013-03-31 20:00:00 +2013,3,31,2218,2220,-2,206,209,-3,"B6",713,"N580JB","JFK","SJU",202,1598,22,20,2013-03-31 22:00:00 +2013,3,31,2332,2150,102,223,40,103,"B6",515,"N258JB","EWR","FLL",146,1065,21,50,2013-03-31 21:00:00 +2013,4,1,601,605,-4,905,906,-1,"B6",135,"N554JB","JFK","RSW",168,1074,6,5,2013-04-01 06:00:00 +2013,4,1,636,640,-4,853,853,0,"B6",117,"N316JB","JFK","MSY",179,1182,6,40,2013-04-01 06:00:00 +2013,4,1,1139,1145,-6,1458,1451,7,"DL",1174,"N320US","LGA","PBI",156,1035,11,45,2013-04-01 11:00:00 +2013,4,1,1535,1535,0,1823,1845,-22,"AA",763,"N3EGAA","LGA","DFW",201,1389,15,35,2013-04-01 15:00:00 +2013,4,1,1537,1435,62,1809,1707,62,"EV",3810,"N12569","EWR","JAX",131,820,14,35,2013-04-01 14:00:00 +2013,4,1,1608,1610,-2,1736,1736,0,"9E",3968,"N8604C","JFK","PHL",29,94,16,10,2013-04-01 16:00:00 +2013,4,1,1843,1855,-12,2017,2051,-34,"9E",3374,"N929XJ","JFK","PIT",73,340,18,55,2013-04-01 18:00:00 +2013,4,1,1929,1930,-1,2237,2228,9,"UA",1632,"N36280","EWR","PBI",150,1023,19,30,2013-04-01 19:00:00 +2013,4,1,1953,1925,28,2201,2141,20,"9E",3798,"N8532G","JFK","CLT",94,541,19,25,2013-04-01 19:00:00 +2013,4,1,1955,2000,-5,2138,2150,-12,"EV",5038,"N723EV","LGA","BHM",138,866,20,0,2013-04-01 20:00:00 +2013,4,1,2027,1935,52,2112,2056,16,"9E",3650,"N8604C","JFK","PHL",27,94,19,35,2013-04-01 19:00:00 +2013,4,1,2111,2100,11,2213,2215,-2,"US",2191,"N737US","LGA","DCA",42,214,21,0,2013-04-01 21:00:00 +2013,4,1,2122,2000,82,2323,2136,107,"EV",5681,"N13994","EWR","RDU",78,416,20,0,2013-04-01 20:00:00 +2013,4,2,657,700,-3,1019,1031,-12,"UA",205,"N477UA","EWR","SFO",355,2565,7,0,2013-04-02 07:00:00 +2013,4,2,804,810,-6,1035,1030,5,"FL",346,"N950AT","LGA","ATL",115,762,8,10,2013-04-02 08:00:00 +2013,4,2,1032,915,77,1325,1232,53,"DL",2379,"N343NW","LGA","FLL",152,1076,9,15,2013-04-02 09:00:00 +2013,4,2,1155,1200,-5,1440,1505,-25,"AA",3,"N324AA","JFK","LAX",329,2475,12,0,2013-04-02 12:00:00 +2013,4,2,1305,1315,-10,1602,1612,-10,"B6",431,"N635JB","LGA","SRQ",157,1047,13,15,2013-04-02 13:00:00 +2013,4,2,1341,1345,-4,1643,1700,-17,"AA",1073,"N3FTAA","LGA","MIA",155,1096,13,45,2013-04-02 13:00:00 +2013,4,2,1424,1430,-6,1733,1732,1,"UA",1744,"N16709","LGA","IAH",230,1416,14,30,2013-04-02 14:00:00 +2013,4,2,1457,1500,-3,1756,1800,-4,"AA",883,"N4XMAA","EWR","DFW",215,1372,15,0,2013-04-02 15:00:00 +2013,4,2,1555,1600,-5,1931,1934,-3,"DL",1461,"N727TW","JFK","LAX",353,2475,16,0,2013-04-02 16:00:00 +2013,4,2,1600,1559,1,1856,1836,20,"US",35,"N521UW","JFK","PHX",316,2153,15,59,2013-04-02 15:00:00 +2013,4,2,1723,1730,-7,1951,1957,-6,"F9",797,"N208FR","LGA","DEN",248,1620,17,30,2013-04-02 17:00:00 +2013,4,2,2017,2015,2,2309,2320,-11,"UA",531,"N826UA","EWR","DFW",215,1372,20,15,2013-04-02 20:00:00 +2013,4,3,557,600,-3,711,725,-14,"WN",1972,"N497WN","EWR","MDW",112,711,6,0,2013-04-03 06:00:00 +2013,4,3,658,700,-2,1012,945,27,"AA",1949,"N3FFAA","JFK","LAS",333,2248,7,0,2013-04-03 07:00:00 +2013,4,3,851,900,-9,1012,1019,-7,"US",2120,"N947UW","LGA","BOS",41,184,9,0,2013-04-03 09:00:00 +2013,4,3,1236,1240,-4,1429,1434,-5,"DL",1544,"N901DE","EWR","DTW",93,488,12,40,2013-04-03 12:00:00 +2013,4,3,1306,1315,-9,1604,1612,-8,"B6",431,"N505JB","LGA","SRQ",160,1047,13,15,2013-04-03 13:00:00 +2013,4,3,1320,1329,-9,1531,1526,5,"EV",4100,"N14116","EWR","MEM",162,946,13,29,2013-04-03 13:00:00 +2013,4,3,1446,1449,-3,1643,1625,18,"EV",4323,"N16559","EWR","RDU",71,416,14,49,2013-04-03 14:00:00 +2013,4,3,1530,1530,0,1734,1732,2,"US",980,"N742PS","LGA","CLT",90,544,15,30,2013-04-03 15:00:00 +2013,4,3,1551,1553,-2,1800,1808,-8,"EV",4684,"N11539","EWR","SDF",109,642,15,53,2013-04-03 15:00:00 +2013,4,3,1728,1735,-7,1921,1942,-21,"DL",2331,"N377NW","LGA","DTW",80,502,17,35,2013-04-03 17:00:00 +2013,4,3,1853,1900,-7,2240,2256,-16,"DL",1465,"N704X","JFK","SFO",358,2586,19,0,2013-04-03 19:00:00 +2013,4,3,1856,1900,-4,2228,2240,-12,"DL",87,"N727TW","JFK","LAX",338,2475,19,0,2013-04-03 19:00:00 +2013,4,3,1954,2000,-6,2318,2318,0,"B6",801,"N807JB","JFK","FLL",157,1069,20,0,2013-04-03 20:00:00 +2013,4,3,2013,2005,8,2350,2330,20,"VX",415,"N640VA","JFK","LAX",343,2475,20,5,2013-04-03 20:00:00 +2013,4,3,2122,2125,-3,2228,2235,-7,"MQ",4660,"N539MQ","LGA","BNA",109,764,21,25,2013-04-03 21:00:00 +2013,4,3,2139,2140,-1,47,28,19,"B6",43,"N612JB","JFK","MCO",155,944,21,40,2013-04-03 21:00:00 +2013,4,3,2210,2129,41,2303,2231,32,"EV",4350,"N12567","EWR","DCA",37,199,21,29,2013-04-03 21:00:00 +2013,4,4,907,900,7,1025,1039,-14,"UA",544,"N847UA","LGA","ORD",114,733,9,0,2013-04-04 09:00:00 +2013,4,4,1337,1339,-2,1628,1655,-27,"B6",209,"N591JB","JFK","LGB",333,2465,13,39,2013-04-04 13:00:00 +2013,4,4,1411,1355,16,1729,1645,44,"B6",1783,"N779JB","JFK","MCO",159,944,13,55,2013-04-04 13:00:00 +2013,4,4,1439,1445,-6,1637,1645,-8,"US",1445,"N558UW","LGA","CLT",93,544,14,45,2013-04-04 14:00:00 +2013,4,4,1657,1700,-3,1823,1850,-27,"AA",345,"N4WVAA","LGA","ORD",115,733,17,0,2013-04-04 17:00:00 +2013,4,4,2053,2056,-3,2344,2349,-5,"UA",696,"N459UA","EWR","MCO",149,937,20,56,2013-04-04 20:00:00 +2013,4,5,605,600,5,838,815,23,"FL",345,"N284AT","LGA","ATL",123,762,6,0,2013-04-05 06:00:00 +2013,4,5,628,633,-5,753,745,8,"EV",4241,"N13132","EWR","DCA",59,199,6,33,2013-04-05 06:00:00 +2013,4,5,703,700,3,1029,1006,23,"UA",1701,"N39415","EWR","FLL",188,1065,7,0,2013-04-05 07:00:00 +2013,4,5,736,740,-4,932,948,-16,"EV",4676,"N16976","EWR","GRR",102,605,7,40,2013-04-05 07:00:00 +2013,4,5,925,829,56,1033,955,38,"EV",4224,"N16999","EWR","PWM",50,284,8,29,2013-04-05 08:00:00 +2013,4,5,1138,1137,1,1511,1445,26,"UA",1601,"N17244","EWR","FLL",184,1065,11,37,2013-04-05 11:00:00 +2013,4,5,1256,1259,-3,1512,1456,16,"US",1459,"N191UW","LGA","CLT",95,544,12,59,2013-04-05 12:00:00 +2013,4,5,1433,1345,48,1813,1700,73,"AA",1073,"N3FMAA","LGA","MIA",186,1096,13,45,2013-04-05 13:00:00 +2013,4,5,1629,1631,-2,1827,1834,-7,"EV",4411,"N22909","EWR","MEM",149,946,16,31,2013-04-05 16:00:00 +2013,4,5,1730,1729,1,2056,2105,-9,"VX",193,"N530VA","EWR","SFO",367,2565,17,29,2013-04-05 17:00:00 +2013,4,5,1824,1829,-5,2119,2038,41,"DL",2019,"N353NB","LGA","MSP",184,1020,18,29,2013-04-05 18:00:00 +2013,4,5,2009,2006,3,2323,2315,8,"UA",1680,"N37281","EWR","MIA",146,1085,20,6,2013-04-05 20:00:00 +2013,4,5,2209,2129,40,2319,2231,48,"EV",4350,"N12563","EWR","DCA",40,199,21,29,2013-04-05 21:00:00 +2013,4,6,612,615,-3,759,810,-11,"US",829,"N716UW","JFK","CLT",80,541,6,15,2013-04-06 06:00:00 +2013,4,6,650,600,50,922,857,25,"UA",583,"N493UA","EWR","TPA",132,997,6,0,2013-04-06 06:00:00 +2013,4,6,1110,1110,0,1300,1325,-25,"EV",5500,"N717EV","LGA","DTW",85,502,11,10,2013-04-06 11:00:00 +2013,4,6,1120,1125,-5,1316,1325,-9,"EV",5277,"N712EV","EWR","MSP",154,1008,11,25,2013-04-06 11:00:00 +2013,4,6,1202,1200,2,1429,1438,-9,"DL",1947,"N917DE","LGA","ATL",109,762,12,0,2013-04-06 12:00:00 +2013,4,6,1243,1250,-7,1431,1447,-16,"DL",1131,"N316US","LGA","DTW",85,502,12,50,2013-04-06 12:00:00 +2013,4,7,908,910,-2,1058,1110,-12,"MQ",4582,"N513MQ","LGA","CLT",84,544,9,10,2013-04-07 09:00:00 +2013,4,7,1016,1015,1,1215,1212,3,"US",1427,"N764US","JFK","CLT",89,541,10,15,2013-04-07 10:00:00 +2013,4,7,1147,1155,-8,1253,1310,-17,"MQ",4425,"N821MQ","JFK","DCA",52,213,11,55,2013-04-07 11:00:00 +2013,4,7,1229,1130,59,1429,1346,43,"EV",5664,"N11176","EWR","MCI",164,1092,11,30,2013-04-07 11:00:00 +2013,4,7,1241,1248,-7,1524,1559,-35,"UA",292,"N498UA","LGA","IAH",206,1416,12,48,2013-04-07 12:00:00 +2013,4,7,1254,1259,-5,1446,1500,-14,"UA",1405,"N68453","EWR","CHS",91,628,12,59,2013-04-07 12:00:00 +2013,4,7,1556,1600,-4,1711,1720,-9,"US",2181,"N965UW","LGA","DCA",48,214,16,0,2013-04-07 16:00:00 +2013,4,7,1606,1610,-4,1756,1758,-2,"9E",3437,"N901XJ","JFK","MKE",123,745,16,10,2013-04-07 16:00:00 +2013,4,7,1940,1930,10,2105,2048,17,"EV",5714,"N909EV","JFK","IAD",44,228,19,30,2013-04-07 19:00:00 +2013,4,7,2046,2050,-4,2148,2221,-33,"B6",1020,"N607JB","JFK","BOS",37,187,20,50,2013-04-07 20:00:00 +2013,4,7,2058,2059,-1,2317,2256,21,"EV",4368,"N11539","EWR","DAY",88,533,20,59,2013-04-07 20:00:00 +2013,4,8,556,600,-4,702,715,-13,"EV",5716,"N836AS","JFK","IAD",45,228,6,0,2013-04-08 06:00:00 +2013,4,8,627,630,-3,803,820,-17,"WN",112,"N8328A","LGA","STL",144,888,6,30,2013-04-08 06:00:00 +2013,4,8,906,830,36,1203,1142,21,"UA",986,"N581UA","EWR","SAN",335,2425,8,30,2013-04-08 08:00:00 +2013,4,8,912,915,-3,1220,1232,-12,"DL",2379,"N353NW","LGA","FLL",155,1076,9,15,2013-04-08 09:00:00 +2013,4,8,1030,1030,0,1402,1410,-8,"VX",23,"N844VA","JFK","SFO",364,2586,10,30,2013-04-08 10:00:00 +2013,4,8,1445,1455,-10,1742,1805,-23,"AA",759,"N3ENAA","LGA","DFW",206,1389,14,55,2013-04-08 14:00:00 +2013,4,8,1513,1520,-7,1741,1745,-4,"MQ",4669,"N520MQ","LGA","ATL",108,762,15,20,2013-04-08 15:00:00 +2013,4,8,1525,1530,-5,1832,1905,-33,"AA",85,"N365AA","JFK","SFO",353,2586,15,30,2013-04-08 15:00:00 +2013,4,8,1848,1845,3,2103,2110,-7,"9E",3403,"N919XJ","JFK","MCI",174,1113,18,45,2013-04-08 18:00:00 +2013,4,9,653,655,-2,937,935,2,"AA",1815,"N5ELAA","JFK","MCO",134,944,6,55,2013-04-09 06:00:00 +2013,4,9,727,729,-2,1017,1020,-3,"B6",361,"N597JB","LGA","PBI",140,1035,7,29,2013-04-09 07:00:00 +2013,4,9,1442,1445,-3,1613,1625,-12,"AA",2223,"N472AA","LGA","STL",133,888,14,45,2013-04-09 14:00:00 +2013,4,9,1459,1459,0,1620,1637,-17,"B6",8,"N657JB","JFK","BUF",55,301,14,59,2013-04-09 14:00:00 +2013,4,9,1832,1835,-3,2052,2042,10,"DL",2131,"N932DL","LGA","DTW",87,502,18,35,2013-04-09 18:00:00 +2013,4,9,1856,1855,1,2210,2240,-30,"VX",29,"N637VA","JFK","SFO",356,2586,18,55,2013-04-09 18:00:00 +2013,4,10,617,600,17,918,915,3,"UA",32,"N17133","JFK","LAX",333,2475,6,0,2013-04-10 06:00:00 +2013,4,10,745,745,0,907,903,4,"EV",4243,"N13994","EWR","BNA",110,748,7,45,2013-04-10 07:00:00 +2013,4,10,911,902,9,1135,1128,7,"UA",1643,"N14115","EWR","DEN",223,1605,9,2,2013-04-10 09:00:00 +2013,4,10,1425,1317,68,1515,1413,62,"EV",4190,"N14905","EWR","BDL",24,116,13,17,2013-04-10 13:00:00 +2013,4,10,1438,1440,-2,1601,1605,-4,"EV",5745,"N830AS","LGA","IAD",46,229,14,40,2013-04-10 14:00:00 +2013,4,10,1513,1459,14,1622,1637,-15,"9E",3393,"N926XJ","JFK","DCA",44,213,14,59,2013-04-10 14:00:00 +2013,4,10,1617,1110,307,1903,1246,377,"UA",793,"N814UA","LGA","ORD",146,733,11,10,2013-04-10 11:00:00 +2013,4,10,1720,1720,0,2027,2025,2,"AA",695,"N3HDAA","JFK","AUS",218,1521,17,20,2013-04-10 17:00:00 +2013,4,10,1826,1500,206,2111,1638,273,"UA",314,"N811UA","LGA","ORD",131,733,15,0,2013-04-10 15:00:00 +2013,4,10,1844,1627,137,2137,1824,193,"EV",4180,"N13968","EWR","DAY",90,533,16,27,2013-04-10 16:00:00 +2013,4,10,1855,1859,-4,2234,2159,35,"DL",2159,"N379DA","JFK","MCO",123,944,18,59,2013-04-10 18:00:00 +2013,4,10,1859,1730,89,2239,1956,163,"F9",419,"N205FR","LGA","DEN",222,1620,17,30,2013-04-10 17:00:00 +2013,4,10,NA,2159,NA,NA,2302,NA,"EV",4276,"N13133","EWR","BDL",NA,116,21,59,2013-04-10 21:00:00 +2013,4,10,NA,1605,NA,NA,1731,NA,"9E",3603,NA,"JFK","PHL",NA,94,16,5,2013-04-10 16:00:00 +2013,4,11,901,908,-7,1155,1209,-14,"UA",212,"N836UA","EWR","PBI",141,1023,9,8,2013-04-11 09:00:00 +2013,4,11,1159,1200,-1,1350,1345,5,"MQ",4553,"N839MQ","LGA","CLE",73,419,12,0,2013-04-11 12:00:00 +2013,4,11,1409,1200,129,1608,1338,150,"UA",617,"N823UA","LGA","ORD",122,733,12,0,2013-04-11 12:00:00 +2013,4,11,1600,1600,0,1836,1906,-30,"DL",161,"N394DA","JFK","LAS",301,2248,16,0,2013-04-11 16:00:00 +2013,4,11,1724,1725,-1,2021,2040,-19,"AA",145,"N3BLAA","JFK","SAN",329,2446,17,25,2013-04-11 17:00:00 +2013,4,11,2015,2000,15,2245,2245,0,"DL",1147,"N907DE","LGA","ATL",119,762,20,0,2013-04-11 20:00:00 +2013,4,11,2019,1925,54,2316,2243,33,"DL",2139,"N911DE","LGA","MIA",154,1096,19,25,2013-04-11 19:00:00 +2013,4,11,2150,1935,135,2305,2100,125,"EV",4131,"N12567","EWR","RIC",50,277,19,35,2013-04-11 19:00:00 +2013,4,11,NA,1947,NA,NA,2100,NA,"EV",4312,"N11535","EWR","DCA",NA,199,19,47,2013-04-11 19:00:00 +2013,4,12,559,600,-1,818,832,-14,"DL",461,"N903DE","LGA","ATL",117,762,6,0,2013-04-12 06:00:00 +2013,4,12,624,630,-6,744,805,-21,"AA",303,"N526AA","LGA","ORD",111,733,6,30,2013-04-12 06:00:00 +2013,4,12,708,715,-7,910,916,-6,"DL",831,"N332NW","LGA","DTW",81,502,7,15,2013-04-12 07:00:00 +2013,4,12,908,910,-2,1221,1235,-14,"VX",407,"N846VA","JFK","LAX",325,2475,9,10,2013-04-12 09:00:00 +2013,4,12,1304,1307,-3,1421,1425,-4,"B6",32,"N309JB","JFK","ROC",56,264,13,7,2013-04-12 13:00:00 +2013,4,12,1353,1359,-6,1718,1714,4,"AA",677,"N640AA","JFK","MIA",161,1089,13,59,2013-04-12 13:00:00 +2013,4,12,1625,1500,85,1829,1653,96,"US",720,"N432US","EWR","CLT",85,529,15,0,2013-04-12 15:00:00 +2013,4,12,1858,1855,3,2214,2240,-26,"VX",29,"N627VA","JFK","SFO",344,2586,18,55,2013-04-12 18:00:00 +2013,4,12,1924,1820,64,2055,1955,60,"WN",962,"N731SA","LGA","BNA",125,764,18,20,2013-04-12 18:00:00 +2013,4,12,2133,1820,193,3,2131,152,"AS",7,"N552AS","EWR","SEA",312,2402,18,20,2013-04-12 18:00:00 +2013,4,13,734,725,9,852,900,-8,"WN",1224,"N955WN","EWR","BNA",125,748,7,25,2013-04-13 07:00:00 +2013,4,13,1416,1339,37,1748,1655,53,"B6",209,"N529JB","JFK","LGB",356,2465,13,39,2013-04-13 13:00:00 +2013,4,13,1427,1420,7,1706,1700,6,"UA",1114,"N37281","EWR","IAH",206,1400,14,20,2013-04-13 14:00:00 +2013,4,13,1649,1652,-3,1944,1920,24,"DL",1715,"N338NW","LGA","MSY",178,1183,16,52,2013-04-13 16:00:00 +2013,4,13,1655,1620,35,2022,1916,66,"B6",985,"N584JB","LGA","TPA",160,1010,16,20,2013-04-13 16:00:00 +2013,4,13,1906,1910,-4,2109,2130,-21,"9E",3367,"N919XJ","JFK","CVG",104,589,19,10,2013-04-13 19:00:00 +2013,4,13,2351,2355,-4,341,345,-4,"B6",739,"N630JB","JFK","PSE",211,1617,23,55,2013-04-13 23:00:00 +2013,4,14,750,759,-9,1055,1014,41,"EV",4136,"N14116","EWR","MSY",206,1167,7,59,2013-04-14 07:00:00 +2013,4,14,817,825,-8,1153,1152,1,"UA",397,"N557UA","JFK","SFO",369,2586,8,25,2013-04-14 08:00:00 +2013,4,14,822,825,-3,1025,1026,-1,"US",487,"N664AW","JFK","CLT",88,541,8,25,2013-04-14 08:00:00 +2013,4,14,903,908,-5,1223,1210,13,"B6",1061,"N348JB","JFK","AUS",234,1521,9,8,2013-04-14 09:00:00 +2013,4,14,918,925,-7,1207,1235,-28,"AA",1097,"N526AA","LGA","DFW",206,1389,9,25,2013-04-14 09:00:00 +2013,4,14,1056,1050,6,1224,1224,0,"UA",792,"N434UA","EWR","ORD",118,719,10,50,2013-04-14 10:00:00 +2013,4,14,1056,1100,-4,1156,1213,-17,"US",2171,"N946UW","LGA","DCA",45,214,11,0,2013-04-14 11:00:00 +2013,4,14,1150,1200,-10,1335,1345,-10,"MQ",4553,"N725MQ","LGA","CLE",71,419,12,0,2013-04-14 12:00:00 +2013,4,14,1152,1200,-8,1518,1511,7,"DL",863,"N709TW","JFK","LAX",349,2475,12,0,2013-04-14 12:00:00 +2013,4,14,1453,1454,-1,1731,1739,-8,"UA",639,"N452UA","EWR","MCO",137,937,14,54,2013-04-14 14:00:00 +2013,4,14,1556,1545,11,1721,1712,9,"9E",3580,"N805AY","JFK","BWI",39,184,15,45,2013-04-14 15:00:00 +2013,4,14,1727,1731,-4,2017,2012,5,"B6",179,"N779JB","JFK","PHX",315,2153,17,31,2013-04-14 17:00:00 +2013,4,14,1756,1800,-4,2054,2114,-20,"B6",989,"N706JB","JFK","FLL",151,1069,18,0,2013-04-14 18:00:00 +2013,4,14,1947,1950,-3,2308,2311,-3,"DL",1854,"N985DL","LGA","FLL",160,1076,19,50,2013-04-14 19:00:00 +2013,4,14,2015,2030,-15,2155,2201,-6,"FL",354,"N980AT","LGA","CAK",66,397,20,30,2013-04-14 20:00:00 +2013,4,14,2138,2140,-2,38,28,10,"B6",43,"N526JB","JFK","MCO",151,944,21,40,2013-04-14 21:00:00 +2013,4,14,2153,1800,233,134,2140,234,"AA",177,"N332AA","JFK","SFO",368,2586,18,0,2013-04-14 18:00:00 +2013,4,15,751,755,-4,939,949,-10,"US",1733,"N165US","LGA","CLT",84,544,7,55,2013-04-15 07:00:00 +2013,4,15,755,800,-5,1009,1024,-15,"DL",689,"N338NB","LGA","MSY",170,1183,8,0,2013-04-15 08:00:00 +2013,4,15,825,825,0,1023,1026,-3,"US",487,"N601AW","JFK","CLT",80,541,8,25,2013-04-15 08:00:00 +2013,4,15,923,915,8,1237,1230,7,"VX",161,"N842VA","EWR","LAX",345,2454,9,15,2013-04-15 09:00:00 +2013,4,15,1001,932,29,1058,1042,16,"B6",1004,"N641JB","JFK","BOS",33,187,9,32,2013-04-15 09:00:00 +2013,4,15,1100,1015,45,1320,1230,50,"US",75,"N678AW","EWR","PHX",295,2133,10,15,2013-04-15 10:00:00 +2013,4,15,1322,1325,-3,1631,1626,5,"UA",1054,"N18119","EWR","LAX",346,2454,13,25,2013-04-15 13:00:00 +2013,4,15,1657,1700,-3,1844,1850,-6,"AA",345,"N595AA","LGA","ORD",138,733,17,0,2013-04-15 17:00:00 +2013,4,15,1746,1735,11,2042,2105,-23,"AA",543,"N5FSAA","JFK","MIA",154,1089,17,35,2013-04-15 17:00:00 +2013,4,15,1820,1535,165,2130,1820,190,"UA",563,"N476UA","EWR","LAS",335,2227,15,35,2013-04-15 15:00:00 +2013,4,15,1957,2000,-3,2155,2209,-14,"EV",3826,"N13903","EWR","TYS",93,631,20,0,2013-04-15 20:00:00 +2013,4,15,2135,2045,50,2242,2219,23,"9E",3395,"N930XJ","JFK","DCA",44,213,20,45,2013-04-15 20:00:00 +2013,4,16,712,655,17,834,820,14,"WN",404,"N269WN","LGA","MKE",120,738,6,55,2013-04-16 06:00:00 +2013,4,16,918,912,6,1154,1200,-6,"B6",59,"N216JB","JFK","TPA",139,1005,9,12,2013-04-16 09:00:00 +2013,4,16,1234,1151,43,1444,1414,30,"FL",347,"N896AT","LGA","ATL",112,762,11,51,2013-04-16 11:00:00 +2013,4,16,1810,1815,-5,2030,2036,-6,"9E",3542,"N922XJ","JFK","MSP",159,1029,18,15,2013-04-16 18:00:00 +2013,4,16,1825,1830,-5,2102,2100,2,"UA",1523,"N17730","EWR","DEN",244,1605,18,30,2013-04-16 18:00:00 +2013,4,16,2142,2145,-3,17,48,-31,"B6",11,"N656JB","JFK","FLL",138,1069,21,45,2013-04-16 21:00:00 +2013,4,17,557,601,-4,714,720,-6,"EV",4252,"N11192","EWR","MKE",115,725,6,1,2013-04-17 06:00:00 +2013,4,17,721,730,-9,1032,1105,-33,"VX",183,"N846VA","EWR","SFO",348,2565,7,30,2013-04-17 07:00:00 +2013,4,17,1030,1030,0,1336,1410,-34,"VX",23,"N851VA","JFK","SFO",344,2586,10,30,2013-04-17 10:00:00 +2013,4,17,1152,1200,-8,1326,1343,-17,"EV",5679,"N14998","EWR","CMH",80,463,12,0,2013-04-17 12:00:00 +2013,4,17,1627,1630,-3,1938,1918,20,"UA",1112,"N18112","EWR","IAH",202,1400,16,30,2013-04-17 16:00:00 +2013,4,17,1635,1632,3,2001,2006,-5,"UA",489,"N806UA","EWR","SFO",345,2565,16,32,2013-04-17 16:00:00 +2013,4,17,1718,1545,93,2008,1907,61,"DL",1982,"N932DL","LGA","MIA",144,1096,15,45,2013-04-17 15:00:00 +2013,4,17,2030,2040,-10,2129,2154,-25,"B6",1178,"N239JB","EWR","BOS",36,200,20,40,2013-04-17 20:00:00 +2013,4,18,903,905,-2,1214,1154,20,"B6",57,"N562JB","JFK","PBI",138,1028,9,5,2013-04-18 09:00:00 +2013,4,18,905,910,-5,1115,1110,5,"MQ",4582,"N509MQ","LGA","CLT",76,544,9,10,2013-04-18 09:00:00 +2013,4,18,925,922,3,1213,1131,42,"EV",4495,"N13133","EWR","SAV",104,708,9,22,2013-04-18 09:00:00 +2013,4,18,1013,959,14,1143,1110,33,"EV",5711,"N820AS","JFK","IAD",50,228,9,59,2013-04-18 09:00:00 +2013,4,18,1451,1447,4,1632,1639,-7,"EV",3853,"N13538","EWR","CMH",71,463,14,47,2013-04-18 14:00:00 +2013,4,18,1522,1530,-8,1646,1710,-24,"9E",4178,"N8505Q","JFK","ROC",48,264,15,30,2013-04-18 15:00:00 +2013,4,18,1829,1800,29,2129,2114,15,"B6",989,"N537JB","JFK","FLL",136,1069,18,0,2013-04-18 18:00:00 +2013,4,18,1838,1755,43,1956,1930,26,"WN",3962,"N430WN","LGA","MDW",108,725,17,55,2013-04-18 17:00:00 +2013,4,18,1935,1832,63,2221,2155,26,"UA",722,"N409UA","EWR","LAX",306,2454,18,32,2013-04-18 18:00:00 +2013,4,18,2046,1925,81,2329,2230,59,"AA",1787,"N3JGAA","JFK","TPA",132,1005,19,25,2013-04-18 19:00:00 +2013,4,18,NA,1700,NA,NA,1838,NA,"UA",689,NA,"LGA","ORD",NA,733,17,0,2013-04-18 17:00:00 +2013,4,19,156,2105,291,317,2234,283,"EV",4641,"N14950","EWR","MKE",113,725,21,5,2013-04-19 21:00:00 +2013,4,19,600,605,-5,756,800,-4,"MQ",4401,"N725MQ","LGA","DTW",89,502,6,5,2013-04-19 06:00:00 +2013,4,19,600,600,0,839,903,-24,"UA",282,"N459UA","EWR","LAX",316,2454,6,0,2013-04-19 06:00:00 +2013,4,19,745,755,-10,1025,1036,-11,"B6",389,"N712JB","LGA","MCO",128,950,7,55,2013-04-19 07:00:00 +2013,4,19,813,814,-1,1021,1025,-4,"EV",4625,"N14143","EWR","CHS",95,628,8,14,2013-04-19 08:00:00 +2013,4,19,919,829,50,1116,1024,52,"MQ",4607,"N539MQ","LGA","CMH",73,479,8,29,2013-04-19 08:00:00 +2013,4,19,927,915,12,1252,1232,20,"DL",2379,"N322US","LGA","FLL",157,1076,9,15,2013-04-19 09:00:00 +2013,4,19,954,910,44,1303,1235,28,"VX",407,"N629VA","JFK","LAX",331,2475,9,10,2013-04-19 09:00:00 +2013,4,19,1246,1210,36,1417,1355,22,"MQ",4431,"N717MQ","LGA","RDU",68,431,12,10,2013-04-19 12:00:00 +2013,4,19,1809,1650,79,2003,1845,78,"WN",197,"N486WN","LGA","STL",138,888,16,50,2013-04-19 16:00:00 +2013,4,19,1852,1730,82,2107,1858,129,"B6",1307,"N306JB","JFK","IAD",52,228,17,30,2013-04-19 17:00:00 +2013,4,19,2111,2040,31,112,2356,76,"B6",165,"N637JB","JFK","PDX",329,2454,20,40,2013-04-19 20:00:00 +2013,4,19,2250,2057,113,234,2359,155,"UA",459,"N565UA","EWR","FLL",182,1065,20,57,2013-04-19 20:00:00 +2013,4,19,NA,1915,NA,NA,2139,NA,"9E",3826,NA,"JFK","CHS",NA,636,19,15,2013-04-19 19:00:00 +2013,4,19,NA,2245,NA,NA,2359,NA,"B6",128,"N178JB","JFK","BTV",NA,266,22,45,2013-04-19 22:00:00 +2013,4,20,830,835,-5,1130,1135,-5,"AA",717,"N3CTAA","LGA","DFW",211,1389,8,35,2013-04-20 08:00:00 +2013,4,20,1713,1430,163,1822,1555,147,"EV",5745,"N877AS","LGA","IAD",49,229,14,30,2013-04-20 14:00:00 +2013,4,20,2115,2115,0,5,2356,9,"B6",927,"N593JB","EWR","MCO",154,937,21,15,2013-04-20 21:00:00 +2013,4,21,550,600,-10,856,854,2,"B6",507,"N807JB","EWR","FLL",167,1065,6,0,2013-04-21 06:00:00 +2013,4,21,957,1000,-3,1224,1234,-10,"DL",1847,"N635DL","LGA","ATL",124,762,10,0,2013-04-21 10:00:00 +2013,4,21,1159,1210,-11,1402,1355,7,"MQ",4431,"N842MQ","LGA","RDU",78,431,12,10,2013-04-21 12:00:00 +2013,4,21,1457,1450,7,1843,1745,58,"AA",1813,"N5FHAA","JFK","MCO",180,944,14,50,2013-04-21 14:00:00 +2013,4,21,1545,1530,15,1823,1803,20,"9E",3579,"N8797A","JFK","IND",105,665,15,30,2013-04-21 15:00:00 +2013,4,21,1643,1645,-2,1947,2004,-17,"B6",139,"N193JB","JFK","RSW",167,1074,16,45,2013-04-21 16:00:00 +2013,4,22,1113,1115,-2,1223,1224,-1,"B6",24,"N317JB","JFK","BTV",45,266,11,15,2013-04-22 11:00:00 +2013,4,22,1328,1225,63,1534,1405,89,"AA",329,"N592AA","LGA","ORD",110,733,12,25,2013-04-22 12:00:00 +2013,4,22,1812,1555,137,1926,1715,131,"MQ",3695,"N525MQ","EWR","ORD",103,719,15,55,2013-04-22 15:00:00 +2013,4,23,747,749,-2,1033,1101,-28,"UA",681,"N463UA","EWR","MIA",152,1085,7,49,2013-04-23 07:00:00 +2013,4,23,751,755,-4,940,1018,-38,"9E",3353,"N916XJ","JFK","DTW",84,509,7,55,2013-04-23 07:00:00 +2013,4,23,1623,1440,103,1814,1605,129,"EV",5745,"N830AS","LGA","IAD",53,229,14,40,2013-04-23 14:00:00 +2013,4,23,1723,1730,-7,2030,2059,-29,"DL",1459,"N317NB","JFK","SAT",227,1587,17,30,2013-04-23 17:00:00 +2013,4,23,1820,1700,80,1937,1830,67,"MQ",4323,"N636MQ","JFK","ORF",49,290,17,0,2013-04-23 17:00:00 +2013,4,24,936,940,-4,1218,1242,-24,"B6",1101,"N566JB","JFK","FLL",143,1069,9,40,2013-04-24 09:00:00 +2013,4,24,937,945,-8,1102,1124,-22,"B6",885,"N323JB","JFK","RDU",69,427,9,45,2013-04-24 09:00:00 +2013,4,24,1505,1440,25,1745,1733,12,"UA",1687,"N77510","EWR","MCO",132,937,14,40,2013-04-24 14:00:00 +2013,4,24,1540,1545,-5,1758,1803,-5,"DL",1942,"N336NB","EWR","ATL",112,746,15,45,2013-04-24 15:00:00 +2013,4,24,1834,1830,4,2032,1955,37,"MQ",4484,"N842MQ","LGA","BNA",132,764,18,30,2013-04-24 18:00:00 +2013,4,24,1915,1830,45,2109,2010,59,"MQ",4674,"N519MQ","LGA","CLE",71,419,18,30,2013-04-24 18:00:00 +2013,4,24,1936,1855,41,2357,2240,77,"VX",29,"N634VA","JFK","SFO",363,2586,18,55,2013-04-24 18:00:00 +2013,4,24,2117,2105,12,2350,2359,-9,"UA",570,"N561UA","EWR","MCO",135,937,21,5,2013-04-24 21:00:00 +2013,4,25,626,625,1,930,925,5,"WN",1794,"N224WN","EWR","HOU",228,1411,6,25,2013-04-25 06:00:00 +2013,4,25,855,900,-5,1236,1157,39,"UA",636,"N803UA","EWR","IAH",224,1400,9,0,2013-04-25 09:00:00 +2013,4,25,1005,1008,-3,1151,1148,3,"EV",4711,"N14543","EWR","STL",139,872,10,8,2013-04-25 10:00:00 +2013,4,25,1604,1610,-6,1756,1758,-2,"9E",3400,"N928XJ","JFK","MKE",114,745,16,10,2013-04-25 16:00:00 +2013,4,25,1829,1830,-1,2156,2200,-4,"AA",119,"N3FDAA","EWR","LAX",342,2454,18,30,2013-04-25 18:00:00 +2013,4,25,1845,1845,0,2208,2217,-9,"B6",171,"N603JB","JFK","SMF",334,2521,18,45,2013-04-25 18:00:00 +2013,4,26,534,530,4,830,813,17,"UA",696,"N507UA","LGA","IAH",209,1416,5,30,2013-04-26 05:00:00 +2013,4,26,654,659,-5,828,823,5,"B6",208,"N595JB","JFK","BUF",58,301,6,59,2013-04-26 06:00:00 +2013,4,26,723,723,0,1103,957,66,"UA",709,"N509UA","EWR","IAH",203,1400,7,23,2013-04-26 07:00:00 +2013,4,26,744,749,-5,1107,1101,6,"UA",453,"N423UA","EWR","MIA",152,1085,7,49,2013-04-26 07:00:00 +2013,4,26,1127,1130,-3,1348,1307,41,"EV",4581,"N12172","EWR","RDU",65,416,11,30,2013-04-26 11:00:00 +2013,4,26,1305,1307,-2,1423,1425,-2,"B6",32,"N354JB","JFK","ROC",57,264,13,7,2013-04-26 13:00:00 +2013,4,26,1334,1339,-5,1642,1655,-13,"B6",209,"N591JB","JFK","LGB",345,2465,13,39,2013-04-26 13:00:00 +2013,4,26,1500,1500,0,1802,1801,1,"DL",2181,"N669DN","LGA","MCO",131,950,15,0,2013-04-26 15:00:00 +2013,4,26,1538,1505,33,1732,1659,33,"EV",4326,"N12540","EWR","CLT",81,529,15,5,2013-04-26 15:00:00 +2013,4,26,1539,1545,-6,1757,1803,-6,"DL",1942,"N320NB","EWR","ATL",114,746,15,45,2013-04-26 15:00:00 +2013,4,26,1633,1623,10,1835,1840,-5,"DL",1619,"N340NW","LGA","MSP",145,1020,16,23,2013-04-26 16:00:00 +2013,4,26,1829,1835,-6,2140,2205,-25,"UA",389,"N555UA","JFK","SFO",338,2586,18,35,2013-04-26 18:00:00 +2013,4,26,2206,2050,76,2355,2229,86,"EV",5661,"N14168","EWR","GSO",70,445,20,50,2013-04-26 20:00:00 +2013,4,26,2320,2125,115,36,2235,121,"MQ",4660,"N504MQ","LGA","BNA",113,764,21,25,2013-04-26 21:00:00 +2013,4,27,711,710,1,910,925,-15,"WN",1010,"N934WN","EWR","DEN",218,1605,7,10,2013-04-27 07:00:00 +2013,4,27,949,1000,-11,1414,1510,-56,"HA",51,"N391HA","JFK","HNL",602,4983,10,0,2013-04-27 10:00:00 +2013,4,27,1222,1200,22,1511,1508,3,"DL",1174,"N962DL","LGA","PBI",136,1035,12,0,2013-04-27 12:00:00 +2013,4,27,1911,1915,-4,2106,2157,-51,"DL",245,"N3773D","JFK","PHX",275,2153,19,15,2013-04-27 19:00:00 +2013,4,28,600,600,0,841,840,1,"B6",79,"N641JB","JFK","MCO",128,944,6,0,2013-04-28 06:00:00 +2013,4,28,748,750,-2,1137,1155,-18,"AA",655,"N5EUAA","JFK","STT",202,1623,7,50,2013-04-28 07:00:00 +2013,4,28,814,825,-11,1111,1152,-41,"UA",397,"N518UA","JFK","SFO",322,2586,8,25,2013-04-28 08:00:00 +2013,4,28,821,825,-4,1024,1104,-40,"DL",2170,"N375DA","JFK","PHX",268,2153,8,25,2013-04-28 08:00:00 +2013,4,28,1504,1459,5,1806,1801,5,"B6",153,"N534JB","JFK","MCO",130,944,14,59,2013-04-28 14:00:00 +2013,4,28,1635,1629,6,1917,1922,-5,"UA",1698,"N17139","EWR","IAH",202,1400,16,29,2013-04-28 16:00:00 +2013,4,28,1752,1800,-8,1855,1919,-24,"US",2138,"N959UW","LGA","BOS",41,184,18,0,2013-04-28 18:00:00 +2013,4,28,2056,2030,26,2345,2331,14,"UA",1299,"N34282","EWR","RSW",149,1068,20,30,2013-04-28 20:00:00 +2013,4,28,2112,2029,43,2311,2247,24,"EV",4642,"N12145","EWR","OMA",158,1134,20,29,2013-04-28 20:00:00 +2013,4,29,624,625,-1,857,925,-28,"WN",1794,"N216WR","EWR","HOU",198,1411,6,25,2013-04-29 06:00:00 +2013,4,29,630,635,-5,737,739,-2,"B6",1002,"N659JB","JFK","BOS",37,187,6,35,2013-04-29 06:00:00 +2013,4,29,637,642,-5,755,808,-13,"EV",3835,"N13914","EWR","PIT",56,319,6,42,2013-04-29 06:00:00 +2013,4,29,700,700,0,1006,1027,-21,"DL",1415,"N649DL","JFK","SLC",272,1990,7,0,2013-04-29 07:00:00 +2013,4,29,704,705,-1,950,951,-1,"DL",2285,"N688DL","LGA","MCO",132,950,7,5,2013-04-29 07:00:00 +2013,4,29,805,810,-5,1110,1123,-13,"DL",1271,"N361NW","JFK","FLL",164,1069,8,10,2013-04-29 08:00:00 +2013,4,29,809,815,-6,1037,1045,-8,"DL",914,"N371NW","LGA","DEN",220,1620,8,15,2013-04-29 08:00:00 +2013,4,29,912,915,-3,1158,1230,-32,"VX",161,"N642VA","EWR","LAX",317,2454,9,15,2013-04-29 09:00:00 +2013,4,29,1122,1125,-3,1428,1421,7,"B6",1,"N564JB","JFK","FLL",164,1069,11,25,2013-04-29 11:00:00 +2013,4,29,1253,1240,13,1356,1415,-19,"WN",163,"N968WN","LGA","MKE",106,738,12,40,2013-04-29 12:00:00 +2013,4,29,1259,1300,-1,1521,1521,0,"EV",4898,"N717EV","EWR","ATL",105,746,13,0,2013-04-29 13:00:00 +2013,4,29,1339,1345,-6,1624,1700,-36,"AA",117,"N336AA","JFK","LAX",318,2475,13,45,2013-04-29 13:00:00 +2013,4,29,1446,1453,-7,1715,1751,-36,"UA",399,"N475UA","LGA","IAH",192,1416,14,53,2013-04-29 14:00:00 +2013,4,29,1525,1515,10,1826,1830,-4,"UA",1558,"N37290","EWR","SFO",340,2565,15,15,2013-04-29 15:00:00 +2013,4,29,1623,1629,-6,1857,1917,-20,"UA",1112,"N19117","EWR","IAH",188,1400,16,29,2013-04-29 16:00:00 +2013,4,29,1738,1630,68,1934,1851,43,"US",140,"N663AW","EWR","PHX",266,2133,16,30,2013-04-29 16:00:00 +2013,4,29,1756,1800,-4,2018,2035,-17,"DL",61,"N341NW","LGA","ATL",106,762,18,0,2013-04-29 18:00:00 +2013,4,29,1826,1715,71,2109,1927,102,"EV",4085,"N16561","EWR","IND",94,645,17,15,2013-04-29 17:00:00 +2013,4,30,552,600,-8,817,850,-33,"AA",707,"N3AGAA","LGA","DFW",184,1389,6,0,2013-04-30 06:00:00 +2013,4,30,754,757,-3,1001,945,16,"9E",3611,"N8516C","JFK","PIT",72,340,7,57,2013-04-30 07:00:00 +2013,4,30,807,815,-8,1049,1115,-26,"DL",1167,"N308DE","JFK","TPA",139,1005,8,15,2013-04-30 08:00:00 +2013,4,30,912,930,-18,1229,1244,-15,"B6",1639,"N588JB","LGA","RSW",146,1080,9,30,2013-04-30 09:00:00 +2013,4,30,955,1000,-5,1427,1510,-43,"HA",51,"N382HA","JFK","HNL",607,4983,10,0,2013-04-30 10:00:00 +2013,4,30,1133,1146,-13,1243,1300,-17,"EV",3815,"N12921","EWR","ORF",50,284,11,46,2013-04-30 11:00:00 +2013,4,30,1248,1250,-2,1550,1548,2,"B6",85,"N509JB","JFK","FLL",155,1069,12,50,2013-04-30 12:00:00 +2013,4,30,1253,1259,-6,1529,1604,-35,"UA",1674,"N12216","LGA","IAH",189,1416,12,59,2013-04-30 12:00:00 +2013,4,30,1426,1355,31,1618,1615,3,"WN",1638,"N203WN","EWR","PHX",272,2133,13,55,2013-04-30 13:00:00 +2013,4,30,1438,1440,-2,1730,1750,-20,"UA",1639,"N39728","EWR","RSW",155,1068,14,40,2013-04-30 14:00:00 +2013,4,30,1451,1423,28,1758,1700,58,"UA",1025,"N76505","EWR","IAH",204,1400,14,23,2013-04-30 14:00:00 +2013,4,30,1635,1640,-5,1932,1941,-9,"B6",143,"N804JB","JFK","PBI",140,1028,16,40,2013-04-30 16:00:00 +2013,4,30,1702,1700,2,2049,2100,-11,"DL",329,"N391DA","JFK","SJU",191,1598,17,0,2013-04-30 17:00:00 +2013,4,30,1825,1829,-4,2034,2032,2,"US",297,"N535UW","JFK","CLT",84,541,18,29,2013-04-30 18:00:00 +2013,5,1,752,755,-3,913,910,3,"MQ",4418,"N852MQ","JFK","DCA",44,213,7,55,2013-05-01 07:00:00 +2013,5,1,815,825,-10,1040,1023,17,"B6",219,"N317JB","JFK","CLT",93,541,8,25,2013-05-01 08:00:00 +2013,5,1,823,830,-7,952,1015,-23,"AA",309,"N589AA","LGA","ORD",107,733,8,30,2013-05-01 08:00:00 +2013,5,1,858,900,-2,1127,1225,-58,"AA",1,"N320AA","JFK","LAX",306,2475,9,0,2013-05-01 09:00:00 +2013,5,1,1514,1435,39,1815,1735,40,"UA",1534,"N35260","EWR","MIA",155,1085,14,35,2013-05-01 14:00:00 +2013,5,1,1656,1700,-4,1824,1827,-3,"B6",24,"N236JB","JFK","SYR",41,209,17,0,2013-05-01 17:00:00 +2013,5,1,2238,2130,68,113,17,56,"B6",383,"N564JB","LGA","FLL",136,1076,21,30,2013-05-01 21:00:00 +2013,5,2,628,625,3,732,745,-13,"WN",3493,"N8603F","LGA","MDW",104,725,6,25,2013-05-02 06:00:00 +2013,5,2,708,644,24,817,813,4,"UA",1137,"N37437","EWR","ORD",109,719,6,44,2013-05-02 06:00:00 +2013,5,2,821,829,-8,1019,1034,-15,"MQ",4478,"N717MQ","LGA","DTW",81,502,8,29,2013-05-02 08:00:00 +2013,5,2,827,825,2,1032,1049,-17,"DL",2170,"N703TW","JFK","PHX",280,2153,8,25,2013-05-02 08:00:00 +2013,5,2,1002,1000,2,1129,1137,-8,"UA",1267,"N24211","LGA","ORD",115,733,10,0,2013-05-02 10:00:00 +2013,5,2,1010,1015,-5,1204,1230,-26,"US",75,"N678AW","EWR","PHX",281,2133,10,15,2013-05-02 10:00:00 +2013,5,2,1034,1035,-1,1206,1235,-29,"MQ",4589,"N1EAMQ","LGA","DTW",72,502,10,35,2013-05-02 10:00:00 +2013,5,2,1157,1200,-3,1301,1313,-12,"B6",1303,"N306JB","JFK","IAD",45,228,12,0,2013-05-02 12:00:00 +2013,5,2,1305,1245,20,2027,1543,NA,"B6",505,"N595JB","EWR","FLL",NA,1065,12,45,2013-05-02 12:00:00 +2013,5,2,1307,1315,-8,1420,1435,-15,"MQ",3765,"N535MQ","EWR","ORD",114,719,13,15,2013-05-02 13:00:00 +2013,5,2,1445,1444,1,1827,1844,-17,"B6",705,"N630JB","JFK","SJU",185,1598,14,44,2013-05-02 14:00:00 +2013,5,2,1511,1435,36,2047,1735,NA,"UA",1534,"N68452","EWR","MIA",NA,1085,14,35,2013-05-02 14:00:00 +2013,5,2,1514,1515,-1,1804,1806,-2,"DL",2181,"N904DL","LGA","MCO",131,950,15,15,2013-05-02 15:00:00 +2013,5,2,1542,1545,-3,1814,1802,12,"DL",1942,"N317NB","EWR","ATL",109,746,15,45,2013-05-02 15:00:00 +2013,5,2,1953,1955,-2,2142,2139,3,"EV",4088,"N10575","LGA","CLE",71,419,19,55,2013-05-02 19:00:00 +2013,5,2,2007,2015,-8,2105,2139,-34,"B6",1016,"N187JB","JFK","BOS",38,187,20,15,2013-05-02 20:00:00 +2013,5,3,721,725,-4,938,1015,-37,"AS",21,"N403AS","EWR","SEA",299,2402,7,25,2013-05-03 07:00:00 +2013,5,3,804,800,4,1017,1017,0,"DL",715,"N334NB","LGA","MSY",162,1183,8,0,2013-05-03 08:00:00 +2013,5,3,851,855,-4,1040,1100,-20,"DL",2179,"N782NC","EWR","DTW",78,488,8,55,2013-05-03 08:00:00 +2013,5,3,855,859,-4,1137,1138,-1,"DL",1747,"N689DL","LGA","ATL",119,762,8,59,2013-05-03 08:00:00 +2013,5,3,1208,1055,73,1317,1228,49,"UA",1210,"N13750","EWR","ORD",104,719,10,55,2013-05-03 10:00:00 +2013,5,3,1426,1430,-4,1800,1845,-45,"AA",1635,"N5FLAA","JFK","SJU",192,1598,14,30,2013-05-03 14:00:00 +2013,5,3,1451,1445,6,1814,1805,9,"AA",1925,"N3DPAA","LGA","MIA",156,1096,14,45,2013-05-03 14:00:00 +2013,5,3,1543,1530,13,1634,1635,-1,"EV",4133,"N18120","EWR","PVD",34,160,15,30,2013-05-03 15:00:00 +2013,5,3,1839,1847,-8,2016,2034,-18,"9E",4019,"N833AY","JFK","RIC",51,288,18,47,2013-05-03 18:00:00 +2013,5,3,1900,1855,5,2046,2056,-10,"US",1491,"N184US","LGA","CLT",83,544,18,55,2013-05-03 18:00:00 +2013,5,3,NA,1500,NA,NA,1722,NA,"EV",4971,"N708EV","LGA","CHS",NA,641,15,0,2013-05-03 15:00:00 +2013,5,4,554,600,-6,817,826,-9,"DL",461,"N6715C","LGA","ATL",113,762,6,0,2013-05-04 06:00:00 +2013,5,4,931,940,-9,1100,1052,8,"9E",3608,"N8688C","JFK","PHL",36,94,9,40,2013-05-04 09:00:00 +2013,5,4,1025,1030,-5,1329,1323,6,"UA",341,"N509UA","LGA","IAH",195,1416,10,30,2013-05-04 10:00:00 +2013,5,4,1853,1736,77,2031,1924,67,"B6",1111,"N316JB","JFK","RDU",72,427,17,36,2013-05-04 17:00:00 +2013,5,4,2012,2015,-3,2129,2156,-27,"EV",3834,"N16954","EWR","CLE",61,404,20,15,2013-05-04 20:00:00 +2013,5,4,2213,1940,153,2347,2130,137,"MQ",4423,"N840MQ","JFK","RDU",71,427,19,40,2013-05-04 19:00:00 +2013,5,5,611,615,-4,807,810,-3,"US",1288,"N746UW","JFK","CLT",86,541,6,15,2013-05-05 06:00:00 +2013,5,5,715,720,-5,939,1013,-34,"UA",642,"N462UA","LGA","IAH",191,1416,7,20,2013-05-05 07:00:00 +2013,5,5,813,820,-7,1106,1110,-4,"DL",1959,"N924DL","JFK","MCO",131,944,8,20,2013-05-05 08:00:00 +2013,5,5,1310,1315,-5,1602,1616,-14,"UA",1516,"N19117","EWR","LAX",326,2454,13,15,2013-05-05 13:00:00 +2013,5,5,1439,1445,-6,1557,1617,-20,"UA",619,"N479UA","EWR","CLE",63,404,14,45,2013-05-05 14:00:00 +2013,5,5,1524,1526,-2,1713,1725,-12,"EV",4231,"N14562","EWR","CVG",90,569,15,26,2013-05-05 15:00:00 +2013,5,5,1554,1525,29,1726,1715,11,"MQ",4447,"N735MQ","LGA","RDU",71,431,15,25,2013-05-05 15:00:00 +2013,5,5,1945,1955,-10,2238,2253,-15,"9E",3450,"N923XJ","JFK","JAX",117,828,19,55,2013-05-05 19:00:00 +2013,5,5,2004,2006,-2,2233,2250,-17,"UA",1265,"N38727","EWR","IAH",179,1400,20,6,2013-05-05 20:00:00 +2013,5,5,2152,2146,6,2246,2251,-5,"EV",4400,"N13965","EWR","DCA",34,199,21,46,2013-05-05 21:00:00 +2013,5,6,601,605,-4,729,735,-6,"MQ",4518,"N711MQ","LGA","RDU",70,431,6,5,2013-05-06 06:00:00 +2013,5,6,726,725,1,1022,1015,NA,"AS",21,"N407AS","EWR","SEA",NA,2402,7,25,2013-05-06 07:00:00 +2013,5,6,746,746,0,915,927,-12,"EV",3854,"N13989","EWR","GSO",74,445,7,46,2013-05-06 07:00:00 +2013,5,6,854,900,-6,1131,1120,11,"EV",4940,"N707EV","LGA","CHS",91,641,9,0,2013-05-06 09:00:00 +2013,5,6,1104,1107,-3,1153,1212,-19,"EV",4125,"N12142","EWR","ALB",29,143,11,7,2013-05-06 11:00:00 +2013,5,6,1825,1825,0,1939,2005,-26,"WN",1354,"N943WN","LGA","BNA",106,764,18,25,2013-05-06 18:00:00 +2013,5,6,2107,1910,117,2344,2240,64,"AA",21,"N335AA","JFK","LAX",303,2475,19,10,2013-05-06 19:00:00 +2013,5,6,2247,2245,2,2346,2357,-11,"B6",22,"N258JB","JFK","SYR",37,209,22,45,2013-05-06 22:00:00 +2013,5,7,720,725,-5,1018,1040,-22,"AA",443,"N336AA","JFK","MIA",153,1089,7,25,2013-05-07 07:00:00 +2013,5,7,739,740,-1,1001,1017,-16,"B6",203,"N527JB","JFK","LAS",288,2248,7,40,2013-05-07 07:00:00 +2013,5,7,818,822,-4,935,940,-5,"UA",385,"N464UA","EWR","BOS",42,200,8,22,2013-05-07 08:00:00 +2013,5,7,1104,1102,2,1155,1207,-12,"EV",4120,"N17169","EWR","ALB",28,143,11,2,2013-05-07 11:00:00 +2013,5,7,1158,1210,-12,1401,1355,6,"MQ",4431,"N738MQ","LGA","RDU",65,431,12,10,2013-05-07 12:00:00 +2013,5,7,1333,1330,3,1639,1622,17,"B6",431,"N504JB","LGA","SRQ",149,1047,13,30,2013-05-07 13:00:00 +2013,5,7,1426,1435,-9,1656,1710,-14,"B6",615,"N216JB","JFK","JAX",123,828,14,35,2013-05-07 14:00:00 +2013,5,7,1455,1455,0,1731,1752,-21,"B6",63,"N561JB","JFK","TPA",130,1005,14,55,2013-05-07 14:00:00 +2013,5,7,1706,1710,-4,1921,1934,-13,"DL",2042,"N301DQ","EWR","ATL",98,746,17,10,2013-05-07 17:00:00 +2013,5,7,2107,2102,5,2223,2227,-4,"EV",4119,"N12967","EWR","RIC",59,277,21,2,2013-05-07 21:00:00 +2013,5,7,2149,2159,-10,2247,2313,-26,"EV",3813,"N21537","EWR","BTV",43,266,21,59,2013-05-07 21:00:00 +2013,5,8,553,600,-7,832,914,-42,"UA",1209,"N75433","EWR","LAX",316,2454,6,0,2013-05-08 06:00:00 +2013,5,8,700,705,-5,1025,1011,14,"DL",1879,"N314US","LGA","FLL",156,1076,7,5,2013-05-08 07:00:00 +2013,5,8,1309,1300,9,1540,1610,-30,"VX",165,"N637VA","EWR","LAX",309,2454,13,0,2013-05-08 13:00:00 +2013,5,8,1901,1900,1,2303,2238,25,"DL",87,"N718TW","JFK","LAX",316,2475,19,0,2013-05-08 19:00:00 +2013,5,8,2035,2028,7,2340,2336,4,"UA",1241,"N38446","EWR","TPA",139,997,20,28,2013-05-08 20:00:00 +2013,5,8,2148,1815,213,21,2039,222,"9E",3285,"N918XJ","JFK","DTW",75,509,18,15,2013-05-08 18:00:00 +2013,5,9,625,630,-5,847,832,15,"US",1433,"N183UW","LGA","CLT",98,544,6,30,2013-05-09 06:00:00 +2013,5,9,812,805,7,1121,1117,4,"DL",1271,"N349NW","JFK","FLL",148,1069,8,5,2013-05-09 08:00:00 +2013,5,9,848,855,-7,1101,1120,-19,"MQ",4619,"N520MQ","LGA","ATL",102,762,8,55,2013-05-09 08:00:00 +2013,5,9,921,915,6,1228,1234,-6,"DL",2379,"N363NW","LGA","FLL",148,1076,9,15,2013-05-09 09:00:00 +2013,5,9,1123,1129,-6,1220,1235,-15,"B6",1174,"N323JB","EWR","BOS",39,200,11,29,2013-05-09 11:00:00 +2013,5,9,1517,1459,18,1737,1732,5,"DL",2347,"N674DL","LGA","ATL",102,762,14,59,2013-05-09 14:00:00 +2013,5,9,1522,1518,4,1736,1738,-2,"UA",745,"N553UA","LGA","DEN",222,1620,15,18,2013-05-09 15:00:00 +2013,5,9,1749,1730,19,1930,1935,-5,"DL",2331,"N330NW","LGA","DTW",78,502,17,30,2013-05-09 17:00:00 +2013,5,9,1933,1855,38,2122,2050,32,"MQ",4649,"N542MQ","LGA","MSP",139,1020,18,55,2013-05-09 18:00:00 +2013,5,9,1943,1900,43,2147,2135,12,"DL",947,"N670DN","LGA","ATL",97,762,19,0,2013-05-09 19:00:00 +2013,5,9,2053,2050,3,2208,2229,-21,"EV",5057,"N612QX","LGA","RIC",48,292,20,50,2013-05-09 20:00:00 +2013,5,9,NA,1459,NA,NA,1654,NA,"EV",4381,"N12569","EWR","DTW",NA,488,14,59,2013-05-09 14:00:00 +2013,5,10,556,600,-4,853,912,-19,"UA",453,"N816UA","EWR","LAX",319,2454,6,0,2013-05-10 06:00:00 +2013,5,10,606,610,-4,743,809,-26,"DL",1919,"N982DL","LGA","MSP",139,1020,6,10,2013-05-10 06:00:00 +2013,5,10,723,630,53,857,820,37,"MQ",4599,"N532MQ","LGA","MSP",137,1020,6,30,2013-05-10 06:00:00 +2013,5,10,752,746,6,926,927,-1,"EV",3854,"N15986","EWR","GSO",67,445,7,46,2013-05-10 07:00:00 +2013,5,10,802,800,2,1108,1135,-27,"AA",59,"N324AA","JFK","SFO",340,2586,8,0,2013-05-10 08:00:00 +2013,5,10,922,925,-3,1111,1110,1,"AA",1855,"N4XDAA","LGA","STL",137,888,9,25,2013-05-10 09:00:00 +2013,5,10,1300,1300,0,1546,1615,-29,"VX",411,"N625VA","JFK","LAX",322,2475,13,0,2013-05-10 13:00:00 +2013,5,10,1458,1430,28,1623,1601,22,"UA",1608,"N37253","EWR","ORD",115,719,14,30,2013-05-10 14:00:00 +2013,5,10,1504,1457,7,1750,1751,-1,"B6",151,"N524JB","JFK","MCO",136,944,14,57,2013-05-10 14:00:00 +2013,5,10,1543,1451,52,1706,1605,61,"EV",3829,"N13975","EWR","IAD",44,212,14,51,2013-05-10 14:00:00 +2013,5,10,1548,1520,28,1723,1639,44,"EV",4141,"N13995","EWR","MKE",116,725,15,20,2013-05-10 15:00:00 +2013,5,10,1732,1740,-8,1926,1943,-17,"YV",2751,"N906FJ","LGA","CLT",80,544,17,40,2013-05-10 17:00:00 +2013,5,10,1827,1829,-2,2048,2035,13,"DL",2131,"N990DL","LGA","DTW",95,502,18,29,2013-05-10 18:00:00 +2013,5,10,1929,1931,-2,2313,2305,8,"B6",171,"N554JB","JFK","SMF",321,2521,19,31,2013-05-10 19:00:00 +2013,5,10,2244,2245,-1,16,1,15,"B6",30,"N304JB","JFK","ROC",51,264,22,45,2013-05-10 22:00:00 +2013,5,11,743,710,33,946,925,21,"WN",1010,"N942WN","EWR","DEN",221,1605,7,10,2013-05-11 07:00:00 +2013,5,11,954,1000,-6,1456,1500,-4,"HA",51,"N388HA","JFK","HNL",640,4983,10,0,2013-05-11 10:00:00 +2013,5,11,1026,1029,-3,1124,1154,-30,"UA",1177,"N75436","EWR","BOS",43,200,10,29,2013-05-11 10:00:00 +2013,5,11,1244,1246,-2,1527,1530,-3,"UA",1687,"N12109","EWR","MCO",141,937,12,46,2013-05-11 12:00:00 +2013,5,11,1304,1315,-11,1528,1538,-10,"FL",348,"N895AT","LGA","ATL",120,762,13,15,2013-05-11 13:00:00 +2013,5,12,452,500,-8,642,640,2,"US",1579,"N762US","EWR","CLT",90,529,5,0,2013-05-12 05:00:00 +2013,5,12,706,710,-4,816,840,-24,"WN",1171,"N729SW","EWR","BNA",116,748,7,10,2013-05-12 07:00:00 +2013,5,12,751,759,-8,915,925,-10,"EV",4422,"N11121","EWR","PIT",62,319,7,59,2013-05-12 07:00:00 +2013,5,12,951,955,-4,1113,1140,-27,"AA",319,"N553AA","LGA","ORD",111,733,9,55,2013-05-12 09:00:00 +2013,5,12,1255,1300,-5,1553,1550,3,"DL",1685,"N916DE","LGA","MCO",148,950,13,0,2013-05-12 13:00:00 +2013,5,12,1305,1315,-10,1623,1616,7,"B6",1601,"N809JB","LGA","RSW",162,1080,13,15,2013-05-12 13:00:00 +2013,5,12,1316,1325,-9,1439,1500,-21,"AA",331,"N584AA","LGA","ORD",109,733,13,25,2013-05-12 13:00:00 +2013,5,12,1353,1355,-2,1609,1606,3,"UA",765,"N809UA","EWR","MSY",185,1167,13,55,2013-05-12 13:00:00 +2013,5,12,1430,1433,-3,1652,1656,-4,"FL",349,"N921AT","LGA","ATL",120,762,14,33,2013-05-12 14:00:00 +2013,5,12,1532,1525,7,1632,1635,-3,"EV",4133,"N11107","EWR","PVD",36,160,15,25,2013-05-12 15:00:00 +2013,5,12,1927,1931,-4,2229,2212,17,"EV",4204,"N14148","EWR","OKC",187,1325,19,31,2013-05-12 19:00:00 +2013,5,12,2028,1950,38,2143,2128,15,"UA",1243,"N78448","EWR","ORD",109,719,19,50,2013-05-12 19:00:00 +2013,5,12,2242,2159,43,12,2344,28,"B6",1109,"N323JB","JFK","RDU",75,427,21,59,2013-05-12 21:00:00 +2013,5,13,631,630,1,912,913,-1,"US",19,"N542UW","JFK","PHX",274,2153,6,30,2013-05-13 06:00:00 +2013,5,13,639,632,7,916,920,-4,"UA",388,"N423UA","LGA","IAH",194,1416,6,32,2013-05-13 06:00:00 +2013,5,13,655,700,-5,800,808,-8,"US",2163,"N714US","LGA","DCA",48,214,7,0,2013-05-13 07:00:00 +2013,5,13,808,815,-7,1000,1010,-10,"US",675,"N673AW","EWR","CLT",84,529,8,15,2013-05-13 08:00:00 +2013,5,13,1054,1100,-6,1146,1212,-26,"US",2124,"N948UW","LGA","BOS",38,184,11,0,2013-05-13 11:00:00 +2013,5,13,1337,1345,-8,1512,1530,-18,"MQ",4491,"N735MQ","LGA","CLE",70,419,13,45,2013-05-13 13:00:00 +2013,5,13,1512,1500,12,1708,1722,-14,"EV",4971,"N604QX","LGA","CHS",94,641,15,0,2013-05-13 15:00:00 +2013,5,13,1619,1600,19,1809,1833,-24,"9E",3315,"N928XJ","JFK","MSP",152,1029,16,0,2013-05-13 16:00:00 +2013,5,13,1825,1829,-4,2000,2035,-35,"DL",2131,"N919DE","LGA","DTW",77,502,18,29,2013-05-13 18:00:00 +2013,5,13,1837,1840,-3,2103,2050,13,"EV",4348,"N12136","EWR","MCI",149,1092,18,40,2013-05-13 18:00:00 +2013,5,13,2140,2019,81,2344,2249,55,"B6",179,"N521JB","JFK","PHX",257,2153,20,19,2013-05-13 20:00:00 +2013,5,14,654,700,-6,913,950,-37,"AA",2083,"N516AA","EWR","DFW",177,1372,7,0,2013-05-14 07:00:00 +2013,5,14,656,700,-4,829,830,-1,"UA",1730,"N27239","LGA","ORD",117,733,7,0,2013-05-14 07:00:00 +2013,5,14,1146,1151,-5,1401,1414,-13,"FL",347,"N923AT","LGA","ATL",102,762,11,51,2013-05-14 11:00:00 +2013,5,14,1307,1310,-3,1415,1423,-8,"EV",4681,"N11164","EWR","IAD",48,212,13,10,2013-05-14 13:00:00 +2013,5,14,1343,1223,80,1520,1406,74,"EV",4316,"N18102","EWR","CMH",72,463,12,23,2013-05-14 12:00:00 +2013,5,14,1432,1435,-3,1552,1600,-8,"9E",4205,"N8933B","JFK","BWI",39,184,14,35,2013-05-14 14:00:00 +2013,5,14,1531,1535,-4,1648,1655,-7,"WN",1153,"N364SW","EWR","MDW",111,711,15,35,2013-05-14 15:00:00 +2013,5,14,1548,1545,3,1853,1916,-23,"DL",1773,"N3754A","JFK","SLC",262,1990,15,45,2013-05-14 15:00:00 +2013,5,14,1710,1710,0,1847,1915,-28,"AA",1351,"N3BSAA","JFK","ORD",131,740,17,10,2013-05-14 17:00:00 +2013,5,14,1820,1825,-5,1924,2005,-41,"WN",1354,"N756SA","LGA","BNA",109,764,18,25,2013-05-14 18:00:00 +2013,5,14,1953,2000,-7,2057,2119,-22,"US",2189,"N767UW","LGA","DCA",40,214,20,0,2013-05-14 20:00:00 +2013,5,14,2056,2058,-2,2207,2219,-12,"UA",1604,"N36472","EWR","BOS",46,200,20,58,2013-05-14 20:00:00 +2013,5,14,2115,2100,15,2329,2338,-9,"B6",399,"N635JB","LGA","MCO",115,950,21,0,2013-05-14 21:00:00 +2013,5,15,555,600,-5,759,756,3,"DL",731,"N321NB","LGA","DTW",87,502,6,0,2013-05-15 06:00:00 +2013,5,15,652,700,-8,954,1007,-13,"DL",2003,"N915DL","LGA","MIA",144,1096,7,0,2013-05-15 07:00:00 +2013,5,15,701,705,-4,922,932,-10,"B6",611,"N603JB","JFK","JAX",110,828,7,5,2013-05-15 07:00:00 +2013,5,15,824,829,-5,1011,1024,-13,"MQ",4607,"N503MQ","LGA","CMH",77,479,8,29,2013-05-15 08:00:00 +2013,5,15,959,1004,-5,1207,1215,-8,"DL",2319,"N365NW","LGA","MSP",151,1020,10,4,2013-05-15 10:00:00 +2013,5,15,1227,1223,4,1430,1418,12,"EV",4178,"N14162","EWR","DTW",91,488,12,23,2013-05-15 12:00:00 +2013,5,15,1446,1455,-9,1626,1638,-12,"9E",3318,"N908XJ","JFK","BUF",60,301,14,55,2013-05-15 14:00:00 +2013,5,15,1448,1455,-7,1741,1805,-24,"AA",759,"N3DPAA","LGA","DFW",206,1389,14,55,2013-05-15 14:00:00 +2013,5,15,1633,1640,-7,1820,1845,-25,"MQ",4540,"N722MQ","LGA","DTW",82,502,16,40,2013-05-15 16:00:00 +2013,5,16,621,630,-9,906,913,-7,"US",19,"N544UW","JFK","PHX",291,2153,6,30,2013-05-16 06:00:00 +2013,5,16,657,700,-3,957,1015,-18,"VX",399,"N637VA","JFK","LAX",322,2475,7,0,2013-05-16 07:00:00 +2013,5,16,824,835,-11,1014,1020,-6,"MQ",4558,"N735MQ","LGA","CLE",71,419,8,35,2013-05-16 08:00:00 +2013,5,16,853,900,-7,958,1025,-27,"US",2167,"N754UW","LGA","DCA",43,214,9,0,2013-05-16 09:00:00 +2013,5,16,1147,1145,2,1401,1400,1,"DL",401,"N341NB","EWR","ATL",105,746,11,45,2013-05-16 11:00:00 +2013,5,16,1301,1250,11,1506,1501,5,"UA",368,"N463UA","EWR","MSY",163,1167,12,50,2013-05-16 12:00:00 +2013,5,16,1509,1430,39,1616,1601,15,"UA",1608,"N33286","EWR","ORD",108,719,14,30,2013-05-16 14:00:00 +2013,5,16,1511,1458,13,1618,1615,3,"UA",1146,"N33262","EWR","BOS",44,200,14,58,2013-05-16 14:00:00 +2013,5,16,1533,1415,78,1805,1633,92,"DL",935,"N309DE","EWR","ATL",121,746,14,15,2013-05-16 14:00:00 +2013,5,16,1619,1629,-10,1818,1814,4,"MQ",4415,"N738MQ","LGA","RDU",68,431,16,29,2013-05-16 16:00:00 +2013,5,16,1729,1725,4,2017,2034,-17,"DL",1185,"N357NW","EWR","SLC",264,1969,17,25,2013-05-16 17:00:00 +2013,5,16,1750,1735,15,2100,2105,-5,"AA",543,"N5FKAA","JFK","MIA",145,1089,17,35,2013-05-16 17:00:00 +2013,5,16,1859,1859,0,2107,2059,8,"9E",3455,"N908XJ","JFK","PIT",63,340,18,59,2013-05-16 18:00:00 +2013,5,16,2131,2055,36,23,2359,24,"UA",425,"N475UA","EWR","FLL",138,1065,20,55,2013-05-16 20:00:00 +2013,5,17,631,630,1,856,914,-18,"UA",1144,"N33714","EWR","MCO",126,937,6,30,2013-05-17 06:00:00 +2013,5,17,827,835,-8,1003,1020,-17,"MQ",4558,"N723MQ","LGA","CLE",69,419,8,35,2013-05-17 08:00:00 +2013,5,17,959,1000,-1,1316,1319,-3,"UA",642,"N555UA","JFK","SFO",339,2586,10,0,2013-05-17 10:00:00 +2013,5,17,1133,1135,-2,1304,1255,9,"MQ",4661,"N504MQ","LGA","BNA",109,764,11,35,2013-05-17 11:00:00 +2013,5,17,1155,1200,-5,1331,1338,-7,"UA",619,"N427UA","LGA","ORD",118,733,12,0,2013-05-17 12:00:00 +2013,5,17,1302,1245,17,1410,1353,17,"UA",587,"N460UA","EWR","BOS",36,200,12,45,2013-05-17 12:00:00 +2013,5,17,1350,1350,0,1552,1607,-15,"US",186,"N651AW","EWR","PHX",279,2133,13,50,2013-05-17 13:00:00 +2013,5,17,1658,1659,-1,1829,1842,-13,"UA",1189,"N21723","EWR","ORD",122,719,16,59,2013-05-17 16:00:00 +2013,5,17,2009,2015,-6,2247,2240,7,"9E",4033,"N831AY","LGA","TYS",99,647,20,15,2013-05-17 20:00:00 +2013,5,17,2103,2020,43,2339,2322,17,"UA",489,"N824UA","EWR","DFW",185,1372,20,20,2013-05-17 20:00:00 +2013,5,18,801,805,-4,1101,1115,-14,"DL",1271,"N348NW","JFK","FLL",140,1069,8,5,2013-05-18 08:00:00 +2013,5,18,842,845,-3,1113,1144,-31,"DL",1885,"N329NW","LGA","MCO",126,950,8,45,2013-05-18 08:00:00 +2013,5,18,1242,1245,-3,1348,1354,-6,"B6",658,"N193JB","JFK","SYR",47,209,12,45,2013-05-18 12:00:00 +2013,5,18,1406,1359,7,1702,1714,-12,"AA",677,"N5BYAA","JFK","MIA",153,1089,13,59,2013-05-18 13:00:00 +2013,5,18,1416,1425,-9,1518,1539,-21,"EV",3267,"N15983","EWR","ORF",50,284,14,25,2013-05-18 14:00:00 +2013,5,18,1440,1445,-5,1627,1649,-22,"DL",1231,"N910DL","LGA","DTW",87,502,14,45,2013-05-18 14:00:00 +2013,5,19,628,630,-2,830,913,-43,"US",19,"N521UW","JFK","PHX",280,2153,6,30,2013-05-19 06:00:00 +2013,5,19,753,800,-7,1117,1135,-18,"AA",59,"N329AA","JFK","SFO",361,2586,8,0,2013-05-19 08:00:00 +2013,5,19,1159,1200,-1,1312,1338,-26,"UA",754,"N415UA","LGA","ORD",113,733,12,0,2013-05-19 12:00:00 +2013,5,19,1208,1200,8,1356,1354,2,"US",1089,"N118US","JFK","CLT",82,541,12,0,2013-05-19 12:00:00 +2013,5,19,1553,1555,-2,1657,1715,-18,"MQ",4622,"N8EGMQ","LGA","BNA",104,764,15,55,2013-05-19 15:00:00 +2013,5,19,1734,1639,55,2011,1913,58,"EV",4705,"N13994","EWR","ATL",116,746,16,39,2013-05-19 16:00:00 +2013,5,19,1817,1710,67,1954,1857,57,"EV",4202,"N14952","EWR","STL",126,872,17,10,2013-05-19 17:00:00 +2013,5,20,553,600,-7,653,659,-6,"US",2161,"N717UW","LGA","DCA",45,214,6,0,2013-05-20 06:00:00 +2013,5,20,636,640,-4,739,745,-6,"B6",1010,"N298JB","JFK","BOS",42,187,6,40,2013-05-20 06:00:00 +2013,5,20,808,750,18,1203,1148,15,"UA",1216,"N37419","EWR","SJU",205,1608,7,50,2013-05-20 07:00:00 +2013,5,20,1130,1115,15,1302,1305,-3,"MQ",4485,"N738MQ","LGA","CMH",72,479,11,15,2013-05-20 11:00:00 +2013,5,20,1157,1115,42,1428,1410,18,"AA",739,"N3CPAA","LGA","DFW",184,1389,11,15,2013-05-20 11:00:00 +2013,5,20,1336,1315,21,1447,1435,12,"MQ",3765,"N532MQ","EWR","ORD",105,719,13,15,2013-05-20 13:00:00 +2013,5,20,1413,1250,83,1523,1408,75,"EV",4104,"N12921","EWR","BNA",105,748,12,50,2013-05-20 12:00:00 +2013,5,20,1419,1425,-6,1536,1550,-14,"B6",8,"N358JB","JFK","BUF",54,301,14,25,2013-05-20 14:00:00 +2013,5,20,1558,1600,-2,1658,1720,-22,"US",2181,"N745VJ","LGA","DCA",41,214,16,0,2013-05-20 16:00:00 +2013,5,20,1822,1740,42,2029,1943,46,"YV",2751,"N930LR","LGA","CLT",75,544,17,40,2013-05-20 17:00:00 +2013,5,20,1928,1935,-7,2104,2121,-17,"9E",4127,"N8914A","JFK","IAD",44,228,19,35,2013-05-20 19:00:00 +2013,5,20,1952,1930,22,2127,2117,10,"DL",975,"N340NB","LGA","PIT",54,335,19,30,2013-05-20 19:00:00 +2013,5,20,2203,1943,140,2328,2100,148,"EV",3267,"N22971","EWR","PWM",48,284,19,43,2013-05-20 19:00:00 +2013,5,21,822,829,-7,1031,1034,-3,"MQ",4478,"N738MQ","LGA","DTW",80,502,8,29,2013-05-21 08:00:00 +2013,5,21,837,839,-2,1103,1143,-40,"B6",175,"N559JB","JFK","SEA",307,2422,8,39,2013-05-21 08:00:00 +2013,5,21,1013,1003,10,1217,1212,5,"EV",4298,"N13550","EWR","SAV",108,708,10,3,2013-05-21 10:00:00 +2013,5,21,1155,1155,0,1316,1310,6,"MQ",4425,"N827MQ","JFK","DCA",56,213,11,55,2013-05-21 11:00:00 +2013,5,21,1204,1210,-6,1452,1510,-18,"B6",143,"N556JB","JFK","RSW",149,1074,12,10,2013-05-21 12:00:00 +2013,5,21,1243,1130,73,1515,1431,44,"DL",1875,"N987DL","LGA","TPA",139,1010,11,30,2013-05-21 11:00:00 +2013,5,21,1435,1435,0,1713,1710,3,"B6",615,"N193JB","JFK","JAX",114,828,14,35,2013-05-21 14:00:00 +2013,5,21,1641,1640,1,1922,1956,-34,"B6",185,"N606JB","JFK","SAN",315,2446,16,40,2013-05-21 16:00:00 +2013,5,21,2107,1929,98,2357,2229,88,"AA",2075,"N545AA","EWR","DFW",194,1372,19,29,2013-05-21 19:00:00 +2013,5,21,2123,2031,52,2253,2200,53,"EV",4224,"N13550","EWR","MKE",111,725,20,31,2013-05-21 20:00:00 +2013,5,22,626,630,-4,851,916,-25,"B6",27,"N662JB","JFK","TPA",132,1005,6,30,2013-05-22 06:00:00 +2013,5,22,637,640,-3,745,745,0,"B6",1010,"N193JB","JFK","BOS",48,187,6,40,2013-05-22 06:00:00 +2013,5,22,651,700,-9,749,805,-16,"US",2116,"N963UW","LGA","BOS",41,184,7,0,2013-05-22 07:00:00 +2013,5,22,658,700,-2,952,1011,-19,"DL",763,"N711ZX","JFK","LAX",316,2475,7,0,2013-05-22 07:00:00 +2013,5,22,743,746,-3,1045,1109,-24,"UA",1466,"N73299","EWR","LAX",323,2454,7,46,2013-05-22 07:00:00 +2013,5,22,823,825,-2,1022,1026,-4,"US",487,"N507AY","JFK","CLT",76,541,8,25,2013-05-22 08:00:00 +2013,5,22,1027,1030,-3,1353,1400,-7,"VX",187,"N524VA","EWR","SFO",340,2565,10,30,2013-05-22 10:00:00 +2013,5,22,1516,1455,21,1814,1753,21,"UA",572,"N448UA","LGA","IAH",197,1416,14,55,2013-05-22 14:00:00 +2013,5,22,1834,1815,19,2216,2135,41,"DL",1433,"N312US","JFK","MIA",145,1089,18,15,2013-05-22 18:00:00 +2013,5,22,2013,2020,-7,1,2245,76,"MQ",4662,"N543MQ","LGA","ATL",107,762,20,20,2013-05-22 20:00:00 +2013,5,22,NA,1433,NA,NA,1629,NA,"EV",4558,"N27200","EWR","CHS",NA,628,14,33,2013-05-22 14:00:00 +2013,5,23,1056,1000,56,1244,1137,67,"UA",1210,"N77518","LGA","ORD",128,733,10,0,2013-05-23 10:00:00 +2013,5,23,1100,1105,-5,1416,1410,6,"UA",1493,"N87513","EWR","LAX",332,2454,11,5,2013-05-23 11:00:00 +2013,5,23,1155,1150,5,1403,1305,58,"MQ",3697,"N509MQ","EWR","ORD",111,719,11,50,2013-05-23 11:00:00 +2013,5,23,2016,1805,131,2359,2128,151,"B6",217,"N809JB","JFK","LGB",319,2465,18,5,2013-05-23 18:00:00 +2013,5,23,2139,2117,22,12,2351,21,"B6",97,"N613JB","JFK","DEN",212,1626,21,17,2013-05-23 21:00:00 +2013,5,23,NA,1538,NA,NA,1856,NA,"B6",133,"N809JB","JFK","RSW",NA,1074,15,38,2013-05-23 15:00:00 +2013,5,24,554,600,-6,701,700,1,"US",2114,"N754UW","LGA","BOS",40,184,6,0,2013-05-24 06:00:00 +2013,5,24,826,834,-8,1046,1050,-4,"EV",5679,"N17146","EWR","XNA",155,1131,8,34,2013-05-24 08:00:00 +2013,5,24,1123,1125,-2,1421,1427,-6,"UA",703,"N525UA","JFK","LAX",333,2475,11,25,2013-05-24 11:00:00 +2013,5,24,1208,1159,9,1530,1459,31,"DL",1174,"N960DL","LGA","PBI",146,1035,11,59,2013-05-24 11:00:00 +2013,5,24,1437,1256,101,1554,1434,80,"UA",522,"N842UA","LGA","ORD",111,733,12,56,2013-05-24 12:00:00 +2013,5,24,1529,1450,39,1828,1746,42,"B6",629,"N216JB","JFK","HOU",202,1428,14,50,2013-05-24 14:00:00 +2013,5,24,1720,1700,20,2157,2054,63,"DL",329,"N3744F","JFK","SJU",225,1598,17,0,2013-05-24 17:00:00 +2013,5,24,1725,1645,40,1857,1813,44,"B6",1012,"N351JB","JFK","BOS",38,187,16,45,2013-05-24 16:00:00 +2013,5,24,1727,1639,48,2005,1930,35,"B6",547,"N624JB","EWR","PBI",140,1023,16,39,2013-05-24 16:00:00 +2013,5,24,1733,1700,33,1911,1832,39,"B6",618,"N334JB","JFK","PWM",53,273,17,0,2013-05-24 17:00:00 +2013,5,24,2032,2012,20,2324,2330,-6,"UA",1615,"N14242","EWR","AUS",201,1504,20,12,2013-05-24 20:00:00 +2013,5,24,2116,1855,141,2317,2050,147,"MQ",4649,"N506MQ","LGA","MSP",145,1020,18,55,2013-05-24 18:00:00 +2013,5,24,2123,1955,88,2248,2110,98,"AA",1762,"N3APAA","JFK","BOS",38,187,19,55,2013-05-24 19:00:00 +2013,5,24,2233,2031,122,2351,2200,111,"EV",4224,"N13978","EWR","MKE",112,725,20,31,2013-05-24 20:00:00 +2013,5,25,622,605,17,747,735,12,"MQ",4518,"N713MQ","LGA","RDU",63,431,6,5,2013-05-25 06:00:00 +2013,5,25,958,1000,-2,1234,1246,-12,"B6",65,"N715JB","JFK","TPA",134,1005,10,0,2013-05-25 10:00:00 +2013,5,25,1021,1021,0,1256,1306,-10,"B6",57,"N618JB","JFK","PBI",132,1028,10,21,2013-05-25 10:00:00 +2013,5,25,2226,2159,27,2347,2344,3,"B6",1109,"N267JB","JFK","RDU",63,427,21,59,2013-05-25 21:00:00 +2013,5,26,806,800,6,1056,1105,-9,"B6",25,"N569JB","JFK","FLL",144,1069,8,0,2013-05-26 08:00:00 +2013,5,26,1058,1100,-2,1314,1312,2,"EV",5010,"N718EV","LGA","CVG",90,585,11,0,2013-05-26 11:00:00 +2013,5,26,1150,1159,-9,1248,1312,-24,"EV",4511,"N34110","EWR","ROC",42,246,11,59,2013-05-26 11:00:00 +2013,5,26,1514,1359,75,1740,1631,69,"DL",2043,"N339NB","JFK","ATL",98,760,13,59,2013-05-26 13:00:00 +2013,5,26,1725,1730,-5,1854,1904,-10,"B6",38,"N351JB","JFK","ROC",51,264,17,30,2013-05-26 17:00:00 +2013,5,26,2106,1915,111,2208,2047,81,"EV",5062,"N760EV","LGA","BTV",42,258,19,15,2013-05-26 19:00:00 +2013,5,27,833,839,-6,1117,1143,-26,"B6",175,"N621JB","JFK","SEA",324,2422,8,39,2013-05-27 08:00:00 +2013,5,27,917,925,-8,1204,1235,-31,"AA",1097,"N526AA","LGA","DFW",191,1389,9,25,2013-05-27 09:00:00 +2013,5,27,1015,1021,-6,1125,1135,-10,"EV",4136,"N22909","EWR","IAD",44,212,10,21,2013-05-27 10:00:00 +2013,5,27,1227,1230,-3,1403,1413,-10,"EV",4704,"N13903","EWR","CMH",76,463,12,30,2013-05-27 12:00:00 +2013,5,27,1324,1328,-4,1448,1512,-24,"EV",4628,"N15572","EWR","STL",125,872,13,28,2013-05-27 13:00:00 +2013,5,27,1858,1900,-2,2138,2203,-25,"UA",1630,"N78285","EWR","SEA",312,2402,19,0,2013-05-27 19:00:00 +2013,5,27,1947,1951,-4,2133,2130,3,"UA",1657,"N38458","EWR","ORD",118,719,19,51,2013-05-27 19:00:00 +2013,5,28,641,645,-4,853,908,-15,"US",654,"N544UW","JFK","PHX",291,2153,6,45,2013-05-28 06:00:00 +2013,5,28,728,725,3,957,1010,-13,"UA",386,"N465UA","EWR","MCO",125,937,7,25,2013-05-28 07:00:00 +2013,5,28,748,755,-7,1036,1045,-9,"B6",341,"N537JB","JFK","SRQ",143,1041,7,55,2013-05-28 07:00:00 +2013,5,28,755,739,16,844,841,3,"EV",3825,"N15912","EWR","BDL",23,116,7,39,2013-05-28 07:00:00 +2013,5,28,953,1000,-7,1055,1113,-18,"US",2122,"N956UW","LGA","BOS",33,184,10,0,2013-05-28 10:00:00 +2013,5,28,1047,1025,22,1249,1222,27,"US",29,"N604AW","EWR","PHX",286,2133,10,25,2013-05-28 10:00:00 +2013,5,28,1049,1051,-2,1339,1405,-26,"DL",1903,"N900DE","LGA","SRQ",146,1047,10,51,2013-05-28 10:00:00 +2013,5,28,1629,1635,-6,1738,1754,-16,"EV",4499,"N14143","EWR","ROC",46,246,16,35,2013-05-28 16:00:00 +2013,5,28,1736,1745,-9,2015,2050,-35,"AA",785,"N3CFAA","LGA","DFW",192,1389,17,45,2013-05-28 17:00:00 +2013,5,28,1754,1800,-6,1852,1913,-21,"US",2138,"N956UW","LGA","BOS",33,184,18,0,2013-05-28 18:00:00 +2013,5,28,1852,1900,-8,2130,2016,74,"US",2187,"N730US","LGA","DCA",76,214,19,0,2013-05-28 19:00:00 +2013,5,28,1853,1900,-7,1950,2012,-22,"US",2140,"N963UW","LGA","BOS",31,184,19,0,2013-05-28 19:00:00 +2013,5,28,1926,1900,26,2054,2031,23,"EV",4191,"N12900","EWR","BNA",107,748,19,0,2013-05-28 19:00:00 +2013,5,28,2028,1940,48,2154,2130,24,"MQ",4423,"N815MQ","JFK","RDU",64,427,19,40,2013-05-28 19:00:00 +2013,5,28,2050,2055,-5,2241,2230,11,"AA",371,"N4XKAA","LGA","ORD",118,733,20,55,2013-05-28 20:00:00 +2013,5,29,558,600,-2,925,931,-6,"UA",1527,"N34455","EWR","SFO",351,2565,6,0,2013-05-29 06:00:00 +2013,5,29,755,805,-10,1043,1102,-19,"DL",1109,"N938DL","LGA","TPA",135,1010,8,5,2013-05-29 08:00:00 +2013,5,29,1001,1000,1,1117,1137,-20,"UA",1262,"N14250","LGA","ORD",110,733,10,0,2013-05-29 10:00:00 +2013,5,29,1111,1115,-4,1401,1410,-9,"AA",739,"N3AMAA","LGA","DFW",193,1389,11,15,2013-05-29 11:00:00 +2013,5,29,1212,1159,13,1424,1427,-3,"EV",4666,"N16987","EWR","JAX",112,820,11,59,2013-05-29 11:00:00 +2013,5,29,1520,1518,2,1814,1738,36,"UA",745,"N548UA","LGA","DEN",265,1620,15,18,2013-05-29 15:00:00 +2013,5,29,1721,1635,46,1845,1814,31,"EV",4230,"N16546","EWR","GSO",65,445,16,35,2013-05-29 16:00:00 +2013,5,29,1755,1800,-5,1909,1913,-4,"US",2138,"N961UW","LGA","BOS",42,184,18,0,2013-05-29 18:00:00 +2013,5,29,1907,1908,-1,2121,2053,28,"UA",1408,"N47414","EWR","ORD",107,719,19,8,2013-05-29 19:00:00 +2013,5,29,2053,2015,38,2217,2139,38,"B6",1016,"N373JB","JFK","BOS",40,187,20,15,2013-05-29 20:00:00 +2013,5,29,2055,2040,15,2228,2200,28,"MQ",4449,"N800MQ","JFK","DCA",47,213,20,40,2013-05-29 20:00:00 +2013,5,29,2101,2030,31,2257,2227,30,"EV",4247,"N13956","EWR","DTW",80,488,20,30,2013-05-29 20:00:00 +2013,5,30,647,655,-8,749,820,-31,"WN",404,"N916WN","LGA","MKE",99,738,6,55,2013-05-30 06:00:00 +2013,5,30,753,801,-8,923,951,-28,"EV",4485,"N12924","EWR","RDU",62,416,8,1,2013-05-30 08:00:00 +2013,5,30,827,830,-3,1058,1128,-30,"DL",857,"N3734B","JFK","SAN",313,2446,8,30,2013-05-30 08:00:00 +2013,5,30,829,835,-6,1110,1135,-25,"AA",717,"N3DSAA","LGA","DFW",188,1389,8,35,2013-05-30 08:00:00 +2013,5,30,831,755,36,929,910,19,"MQ",4418,"N800MQ","JFK","DCA",39,213,7,55,2013-05-30 07:00:00 +2013,5,30,843,845,-2,1028,1044,-16,"US",1429,"N700UW","LGA","CLT",79,544,8,45,2013-05-30 08:00:00 +2013,5,30,855,900,-5,1117,1121,-4,"DL",485,"N912DE","EWR","ATL",110,746,9,0,2013-05-30 09:00:00 +2013,5,30,1024,1030,-6,1134,1210,-36,"AA",321,"N519AA","LGA","ORD",102,733,10,30,2013-05-30 10:00:00 +2013,5,30,1035,1030,5,1320,1336,-16,"UA",1183,"N16732","EWR","RSW",148,1068,10,30,2013-05-30 10:00:00 +2013,5,30,1345,1345,0,1445,1505,-20,"WN",2226,"N755SA","LGA","MDW",104,725,13,45,2013-05-30 13:00:00 +2013,5,30,1529,1530,-1,1832,1837,-5,"9E",3325,"N929XJ","JFK","DFW",200,1391,15,30,2013-05-30 15:00:00 +2013,5,30,1638,1645,-7,1909,1850,19,"US",681,"N648AW","EWR","PHX",293,2133,16,45,2013-05-30 16:00:00 +2013,5,30,1701,1500,121,1937,1638,179,"UA",741,"N467UA","LGA","ORD",109,733,15,0,2013-05-30 15:00:00 +2013,5,30,1923,1723,120,2147,1943,124,"UA",296,"N585UA","LGA","DEN",237,1620,17,23,2013-05-30 17:00:00 +2013,5,30,1946,1945,1,2231,2224,7,"DL",245,"N396DA","JFK","PHX",298,2153,19,45,2013-05-30 19:00:00 +2013,5,30,2107,2115,-8,2242,2310,-28,"MQ",4584,"N510MQ","LGA","CLT",73,544,21,15,2013-05-30 21:00:00 +2013,5,31,627,630,-3,750,803,-13,"EV",3809,"N13955","EWR","RDU",62,416,6,30,2013-05-31 06:00:00 +2013,5,31,634,625,9,859,925,-26,"WN",1794,"N948WN","EWR","HOU",183,1411,6,25,2013-05-31 06:00:00 +2013,5,31,745,740,5,850,900,-10,"WN",3052,"N555LV","EWR","MDW",101,711,7,40,2013-05-31 07:00:00 +2013,5,31,803,810,-7,917,936,-19,"B6",1204,"N354JB","JFK","BUF",53,301,8,10,2013-05-31 08:00:00 +2013,5,31,822,820,2,1122,1156,-34,"UA",1532,"N38451","EWR","SFO",335,2565,8,20,2013-05-31 08:00:00 +2013,5,31,836,839,-3,1057,1143,-46,"B6",175,"N746JB","JFK","SEA",302,2422,8,39,2013-05-31 08:00:00 +2013,5,31,955,1004,-9,1146,1215,-29,"DL",2319,"N376NW","LGA","MSP",146,1020,10,4,2013-05-31 10:00:00 +2013,5,31,1014,1020,-6,1144,1204,-20,"US",1002,"N450UW","EWR","CLT",74,529,10,20,2013-05-31 10:00:00 +2013,5,31,1554,1600,-6,1906,1951,-45,"DL",2065,"N723TW","JFK","SFO",339,2586,16,0,2013-05-31 16:00:00 +2013,5,31,1641,1629,12,1911,1820,NA,"EV",4411,"N11547","EWR","MEM",NA,946,16,29,2013-05-31 16:00:00 +2013,5,31,1846,1840,6,2124,2132,-8,"DL",1629,"N3749D","JFK","LAS",303,2248,18,40,2013-05-31 18:00:00 +2013,5,31,2001,1610,231,2138,1807,211,"9E",3400,"N910XJ","JFK","MKE",110,745,16,10,2013-05-31 16:00:00 +2013,6,1,745,750,-5,1202,1155,7,"AA",655,"N5FMAA","JFK","STT",209,1623,7,50,2013-06-01 07:00:00 +2013,6,1,900,900,0,1154,1210,-16,"DL",120,"N721TW","JFK","LAX",324,2475,9,0,2013-06-01 09:00:00 +2013,6,1,939,943,-4,1053,1118,-25,"EV",4989,"N611QX","LGA","BNA",102,764,9,43,2013-06-01 09:00:00 +2013,6,1,1209,1210,-1,1509,1510,-1,"AA",743,"N529AA","LGA","DFW",195,1389,12,10,2013-06-01 12:00:00 +2013,6,1,1255,1228,27,1418,1347,31,"B6",66,"N203JB","JFK","BUF",56,301,12,28,2013-06-01 12:00:00 +2013,6,1,1415,1359,16,1603,1635,-32,"UA",1177,"N47414","EWR","DEN",209,1605,13,59,2013-06-01 13:00:00 +2013,6,1,1809,1250,319,2000,1448,312,"DL",1131,"N348NB","LGA","DTW",77,502,12,50,2013-06-01 12:00:00 +2013,6,1,1822,1830,-8,2137,2200,-23,"AA",119,"N3EYAA","EWR","LAX",321,2454,18,30,2013-06-01 18:00:00 +2013,6,2,739,744,-5,1017,1047,-30,"UA",1701,"N73251","EWR","FLL",141,1065,7,44,2013-06-02 07:00:00 +2013,6,2,830,830,0,1145,1147,-2,"UA",1201,"N41135","JFK","LAX",333,2475,8,30,2013-06-02 08:00:00 +2013,6,2,1022,1027,-5,1202,1227,-25,"EV",4398,"N11189","EWR","DSM",144,1017,10,27,2013-06-02 10:00:00 +2013,6,2,1119,1120,-1,1221,1226,-5,"B6",1174,"N274JB","EWR","BOS",45,200,11,20,2013-06-02 11:00:00 +2013,6,2,1307,1310,-3,1504,1510,-6,"MQ",4564,"N735MQ","LGA","DTW",89,502,13,10,2013-06-02 13:00:00 +2013,6,2,1722,1525,117,1810,1635,95,"EV",4133,"N11193","EWR","PVD",34,160,15,25,2013-06-02 15:00:00 +2013,6,2,1744,1745,-1,2109,2106,3,"DL",1394,"N3763D","JFK","PDX",332,2454,17,45,2013-06-02 17:00:00 +2013,6,2,1845,1610,155,2048,1825,143,"EV",4328,"N14117","EWR","MSY",166,1167,16,10,2013-06-02 16:00:00 +2013,6,2,2229,2130,59,6,2300,66,"MQ",4617,"N544MQ","LGA","RDU",69,431,21,30,2013-06-02 21:00:00 +2013,6,3,626,630,-4,753,800,-7,"B6",905,"N351JB","JFK","ORD",120,740,6,30,2013-06-03 06:00:00 +2013,6,3,857,859,-2,1119,1138,-19,"DL",1747,"N919DL","LGA","ATL",116,762,8,59,2013-06-03 08:00:00 +2013,6,3,1005,1005,0,1256,1257,-1,"UA",1414,"N37290","EWR","TPA",146,997,10,5,2013-06-03 10:00:00 +2013,6,3,1456,1457,-1,1812,1751,21,"B6",151,"N529JB","JFK","MCO",142,944,14,57,2013-06-03 14:00:00 +2013,6,3,1458,1455,3,1641,1638,3,"9E",3318,"N914XJ","JFK","BUF",55,301,14,55,2013-06-03 14:00:00 +2013,6,3,1509,1430,39,1646,1558,48,"FL",721,"N964AT","LGA","CAK",66,397,14,30,2013-06-03 14:00:00 +2013,6,3,1730,1650,40,2001,1919,42,"9E",3383,"N929XJ","JFK","CVG",92,589,16,50,2013-06-03 16:00:00 +2013,6,3,1757,1735,22,1913,1902,11,"DL",2383,"N340NW","LGA","PWM",42,269,17,35,2013-06-03 17:00:00 +2013,6,3,1933,1829,64,2131,2033,58,"US",1973,"N561UW","EWR","CLT",81,529,18,29,2013-06-03 18:00:00 +2013,6,4,556,600,-4,705,712,-7,"EV",5747,"N909EV","LGA","IAD",49,229,6,0,2013-06-04 06:00:00 +2013,6,4,845,850,-5,1230,1300,-30,"AA",1357,"N5ETAA","JFK","SJU",193,1598,8,50,2013-06-04 08:00:00 +2013,6,4,902,825,37,1050,1017,33,"US",1831,"N704US","JFK","CLT",77,541,8,25,2013-06-04 08:00:00 +2013,6,4,1025,1030,-5,1229,1243,-14,"DL",2343,"N308DE","EWR","ATL",104,746,10,30,2013-06-04 10:00:00 +2013,6,4,1140,1100,40,1249,1210,39,"MQ",3792,"N514MQ","JFK","DCA",53,213,11,0,2013-06-04 11:00:00 +2013,6,4,1211,1220,-9,1358,1415,-17,"EV",3845,"N13988","EWR","DTW",83,488,12,20,2013-06-04 12:00:00 +2013,6,4,1248,1245,3,1357,1401,-4,"EV",4088,"N14972","EWR","BTV",51,266,12,45,2013-06-04 12:00:00 +2013,6,4,1450,1450,0,1632,1635,-3,"MQ",4403,"N822MQ","JFK","RDU",71,427,14,50,2013-06-04 14:00:00 +2013,6,4,1512,1520,-8,1635,1639,-4,"EV",4561,"N27962","EWR","MKE",116,725,15,20,2013-06-04 15:00:00 +2013,6,4,1652,1655,-3,1959,2005,-6,"VX",413,"N623VA","JFK","LAX",324,2475,16,55,2013-06-04 16:00:00 +2013,6,4,1707,1709,-2,2018,2039,-21,"UA",512,"N512UA","JFK","SFO",356,2586,17,9,2013-06-04 17:00:00 +2013,6,4,1755,1800,-5,1930,1915,15,"US",2185,"N769US","LGA","DCA",44,214,18,0,2013-06-04 18:00:00 +2013,6,4,1816,1821,-5,2055,2041,14,"DL",1715,"N354NW","LGA","MSY",156,1183,18,21,2013-06-04 18:00:00 +2013,6,4,2158,2159,-1,2335,2344,-9,"B6",1109,"N294JB","JFK","RDU",70,427,21,59,2013-06-04 21:00:00 +2013,6,5,600,605,-5,716,720,-4,"WN",3574,"N716SW","EWR","MDW",111,711,6,5,2013-06-05 06:00:00 +2013,6,5,855,900,-5,1144,1201,-17,"DL",1885,"N320US","LGA","MCO",137,950,9,0,2013-06-05 09:00:00 +2013,6,5,903,909,-6,1228,1218,10,"UA",1626,"N33292","EWR","SAN",340,2425,9,9,2013-06-05 09:00:00 +2013,6,5,1056,1005,51,1212,1131,41,"EV",5736,"N827AS","LGA","IAD",46,229,10,5,2013-06-05 10:00:00 +2013,6,5,1258,1259,-1,1507,1457,10,"US",1459,"N406US","LGA","CLT",84,544,12,59,2013-06-05 12:00:00 +2013,6,5,1723,1730,-7,1856,1858,-2,"B6",1307,"N337JB","JFK","IAD",46,228,17,30,2013-06-05 17:00:00 +2013,6,6,659,700,-1,839,835,4,"WN",1696,"N378SW","EWR","STL",132,872,7,0,2013-06-06 07:00:00 +2013,6,6,831,840,-9,954,1012,-18,"9E",3300,"N602LR","JFK","DCA",42,213,8,40,2013-06-06 08:00:00 +2013,6,6,1026,1030,-4,1244,1243,1,"DL",2343,"N303DQ","EWR","ATL",110,746,10,30,2013-06-06 10:00:00 +2013,6,6,1054,1050,4,1157,1206,-9,"EV",3817,"N13988","EWR","MKE",106,725,10,50,2013-06-06 10:00:00 +2013,6,6,1443,1415,28,1626,1610,16,"MQ",4588,"N511MQ","LGA","MSP",141,1020,14,15,2013-06-06 14:00:00 +2013,6,6,1458,1500,-2,1658,1652,6,"US",802,"N118US","EWR","CLT",88,529,15,0,2013-06-06 15:00:00 +2013,6,6,1553,1559,-6,1722,1745,-23,"B6",6,"N265JB","JFK","BUF",61,301,15,59,2013-06-06 15:00:00 +2013,6,6,1601,1455,66,1746,1640,66,"MQ",4172,"N655MQ","JFK","CLE",78,425,14,55,2013-06-06 14:00:00 +2013,6,6,1607,1600,7,1750,1833,-43,"9E",3315,"N928XJ","JFK","MSP",142,1029,16,0,2013-06-06 16:00:00 +2013,6,6,1728,1716,12,1941,1944,-3,"UA",1424,"N37434","EWR","DEN",221,1605,17,16,2013-06-06 17:00:00 +2013,6,7,853,859,-6,1129,1138,-9,"DL",1747,"N332NW","LGA","ATL",111,762,8,59,2013-06-07 08:00:00 +2013,6,7,1214,1205,9,1436,1425,11,"MQ",4658,"N526MQ","LGA","ATL",110,762,12,5,2013-06-07 12:00:00 +2013,6,7,1350,1345,5,1528,1530,-2,"MQ",4491,"N735MQ","LGA","CLE",76,419,13,45,2013-06-07 13:00:00 +2013,6,7,1405,1415,-10,1603,1610,-7,"MQ",4588,"N502MQ","LGA","MSP",140,1020,14,15,2013-06-07 14:00:00 +2013,6,7,1445,1445,0,1642,1651,-9,"DL",1231,"N327NB","LGA","DTW",87,502,14,45,2013-06-07 14:00:00 +2013,6,7,1704,1705,-1,1857,1927,-30,"UA",509,"N575UA","LGA","DEN",212,1620,17,5,2013-06-07 17:00:00 +2013,6,7,1721,1700,21,1829,1843,-14,"UA",689,"N421UA","LGA","ORD",107,733,17,0,2013-06-07 17:00:00 +2013,6,7,1816,1610,126,2020,1751,149,"9E",3410,"N910XJ","JFK","BOS",44,187,16,10,2013-06-07 16:00:00 +2013,6,8,657,702,-5,936,941,-5,"UA",231,"N803UA","EWR","MCO",140,937,7,2,2013-06-08 07:00:00 +2013,6,8,759,804,-5,954,1010,-16,"EV",4225,"N12175","EWR","MSP",148,1008,8,4,2013-06-08 08:00:00 +2013,6,8,812,800,12,1131,1105,26,"B6",25,"N583JB","JFK","FLL",172,1069,8,0,2013-06-08 08:00:00 +2013,6,8,839,830,9,1040,1031,9,"EV",4419,"N16170","EWR","CHS",99,628,8,30,2013-06-08 08:00:00 +2013,6,8,1107,1110,-3,1348,1355,-7,"DL",695,"N337NW","JFK","MCO",138,944,11,10,2013-06-08 11:00:00 +2013,6,8,1220,1230,-10,1421,1436,-15,"9E",4142,"N8794B","LGA","CVG",99,585,12,30,2013-06-08 12:00:00 +2013,6,8,1232,1235,-3,1530,1540,-10,"DL",1375,"N394DA","JFK","SLC",269,1990,12,35,2013-06-08 12:00:00 +2013,6,8,1241,1225,16,1452,1430,22,"WN",2003,"N912WN","EWR","MSY",172,1167,12,25,2013-06-08 12:00:00 +2013,6,8,1521,1520,1,1634,1638,-4,"EV",3267,"N15910","EWR","ORF",54,284,15,20,2013-06-08 15:00:00 +2013,6,8,1600,1600,0,1917,1916,1,"DL",1043,"N717TW","JFK","SEA",324,2422,16,0,2013-06-08 16:00:00 +2013,6,8,1853,1835,18,2155,2213,-18,"B6",173,"N659JB","JFK","SJC",343,2569,18,35,2013-06-08 18:00:00 +2013,6,8,2118,2125,-7,2223,2243,-20,"EV",4695,"N15910","EWR","MHT",43,209,21,25,2013-06-08 21:00:00 +2013,6,8,NA,1315,NA,NA,1435,NA,"MQ",3765,"N534MQ","EWR","ORD",NA,719,13,15,2013-06-08 13:00:00 +2013,6,9,651,659,-8,750,810,-20,"EV",5819,"N14904","EWR","MHT",36,209,6,59,2013-06-09 06:00:00 +2013,6,9,750,755,-5,917,920,-3,"MQ",3737,"N5PBMQ","EWR","ORD",109,719,7,55,2013-06-09 07:00:00 +2013,6,9,801,805,-4,1046,1102,-16,"DL",1109,"N948DL","LGA","TPA",150,1010,8,5,2013-06-09 08:00:00 +2013,6,9,825,825,0,1126,1147,-21,"UA",397,"N555UA","JFK","SFO",333,2586,8,25,2013-06-09 08:00:00 +2013,6,9,923,930,-7,1224,1255,-31,"AA",179,"N323AA","JFK","SFO",329,2586,9,30,2013-06-09 09:00:00 +2013,6,9,1025,1018,7,1223,1220,3,"EV",4255,"N12167","EWR","CHS",91,628,10,18,2013-06-09 10:00:00 +2013,6,9,1056,1053,3,1237,1250,-13,"EV",4519,"N14162","EWR","AVL",89,583,10,53,2013-06-09 10:00:00 +2013,6,9,1150,1155,-5,1353,1420,-27,"WN",1836,"N787SA","LGA","DEN",221,1620,11,55,2013-06-09 11:00:00 +2013,6,9,1153,1200,-7,1258,1313,-15,"B6",1303,"N354JB","JFK","IAD",44,228,12,0,2013-06-09 12:00:00 +2013,6,9,1256,1305,-9,1434,1455,-21,"MQ",4426,"N721MQ","LGA","CMH",76,479,13,5,2013-06-09 13:00:00 +2013,6,9,1549,1550,-1,1752,1805,-13,"WN",1939,"N288WN","EWR","DEN",219,1605,15,50,2013-06-09 15:00:00 +2013,6,9,1642,1559,43,1842,1810,32,"EV",4091,"N13975","EWR","IND",100,645,15,59,2013-06-09 15:00:00 +2013,6,9,1700,1709,-9,1825,1856,-31,"EV",4662,"N16951","EWR","RDU",65,416,17,9,2013-06-09 17:00:00 +2013,6,10,624,627,-3,835,900,-25,"B6",203,"N599JB","JFK","LAS",290,2248,6,27,2013-06-10 06:00:00 +2013,6,10,708,630,38,917,835,42,"US",1100,"N170US","LGA","CLT",102,544,6,30,2013-06-10 06:00:00 +2013,6,10,1002,1012,-10,1115,1132,-17,"EV",4187,"N14907","EWR","BNA",112,748,10,12,2013-06-10 10:00:00 +2013,6,10,1052,1055,-3,1348,1411,-23,"DL",1903,"N335NB","LGA","SRQ",150,1047,10,55,2013-06-10 10:00:00 +2013,6,10,1150,1200,-10,1442,1510,-28,"AA",977,"N3AYAA","EWR","MIA",148,1085,12,0,2013-06-10 12:00:00 +2013,6,10,1340,1300,40,1605,1519,46,"EV",5148,"N717EV","EWR","ATL",109,746,13,0,2013-06-10 13:00:00 +2013,6,10,1411,1352,19,1642,1624,18,"UA",755,"N417UA","EWR","DFW",176,1372,13,52,2013-06-10 13:00:00 +2013,6,10,1631,1529,62,1958,1820,98,"B6",537,"N534JB","EWR","TPA",166,997,15,29,2013-06-10 15:00:00 +2013,6,10,1753,1730,23,1939,1940,-1,"DL",2331,"N937DL","LGA","DTW",77,502,17,30,2013-06-10 17:00:00 +2013,6,10,1908,1909,-1,2308,2235,33,"B6",87,"N503JB","JFK","SLC",288,1990,19,9,2013-06-10 19:00:00 +2013,6,10,2034,1859,95,2150,2036,74,"UA",693,"N458UA","LGA","ORD",107,733,18,59,2013-06-10 18:00:00 +2013,6,10,2048,2000,48,5,2310,55,"DL",2391,"N933DL","JFK","TPA",144,1005,20,0,2013-06-10 20:00:00 +2013,6,11,642,634,8,834,835,-1,"EV",4150,"N14180","EWR","CVG",90,569,6,34,2013-06-11 06:00:00 +2013,6,11,1158,1200,-2,1410,1435,-25,"DL",1947,"N662DN","LGA","ATL",104,762,12,0,2013-06-11 12:00:00 +2013,6,11,1430,1435,-5,1747,1750,-3,"DL",1779,"N342NW","LGA","FLL",181,1076,14,35,2013-06-11 14:00:00 +2013,6,11,1703,1655,8,2026,2016,10,"UA",1284,"N30401","EWR","SFO",353,2565,16,55,2013-06-11 16:00:00 +2013,6,11,1717,1700,17,1949,1955,-6,"AA",257,"N3ARAA","JFK","LAS",299,2248,17,0,2013-06-11 17:00:00 +2013,6,11,1755,1800,-5,1955,2012,-17,"DL",1321,"N323US","EWR","MSP",146,1008,18,0,2013-06-11 18:00:00 +2013,6,11,2125,2124,1,8,14,-6,"UA",1460,"N33289","EWR","PBI",141,1023,21,24,2013-06-11 21:00:00 +2013,6,12,859,900,-1,1027,1035,-8,"UA",1477,"N27239","LGA","ORD",118,733,9,0,2013-06-12 09:00:00 +2013,6,12,1005,1012,-7,1108,1132,-24,"EV",4187,"N15572","EWR","BNA",107,748,10,12,2013-06-12 10:00:00 +2013,6,12,1245,1250,-5,1411,1425,-14,"MQ",3361,"N815MQ","JFK","RDU",66,427,12,50,2013-06-12 12:00:00 +2013,6,12,1332,1338,-6,1440,1459,-19,"B6",36,"N346JB","JFK","ROC",54,264,13,38,2013-06-12 13:00:00 +2013,6,12,1338,1344,-6,1602,1621,-19,"B6",525,"N706JB","EWR","MCO",120,937,13,44,2013-06-12 13:00:00 +2013,6,12,1450,1459,-9,1642,1649,-7,"MQ",3391,"N720MQ","LGA","CMH",81,479,14,59,2013-06-12 14:00:00 +2013,6,12,1458,1459,-1,1808,1801,7,"9E",3325,"N909XJ","JFK","DFW",181,1391,14,59,2013-06-12 14:00:00 +2013,6,12,1551,1555,-4,1749,1740,9,"WN",493,"N494WN","LGA","STL",124,888,15,55,2013-06-12 15:00:00 +2013,6,12,1729,1729,0,2048,2055,-7,"VX",193,"N635VA","EWR","SFO",352,2565,17,29,2013-06-12 17:00:00 +2013,6,12,1743,1745,-2,2019,2014,5,"DL",884,"N369NW","LGA","DEN",224,1620,17,45,2013-06-12 17:00:00 +2013,6,12,1821,1829,-8,2010,2033,-23,"US",1973,"N170US","EWR","CLT",75,529,18,29,2013-06-12 18:00:00 +2013,6,12,1837,1830,7,2029,2055,-26,"WN",1454,"N449WN","EWR","MSY",152,1167,18,30,2013-06-12 18:00:00 +2013,6,12,1906,1859,7,2018,2026,-8,"EV",4131,"N13968","EWR","RIC",50,277,18,59,2013-06-12 18:00:00 +2013,6,12,1958,1950,8,247,2130,NA,"AA",363,"N4YDAA","LGA","ORD",NA,733,19,50,2013-06-12 19:00:00 +2013,6,12,2038,1935,63,2400,2302,58,"DL",87,"N674DL","JFK","SLC",282,1990,19,35,2013-06-12 19:00:00 +2013,6,13,557,600,-3,802,815,-13,"FL",345,"N278AT","LGA","ATL",108,762,6,0,2013-06-13 06:00:00 +2013,6,13,813,815,-2,1120,1110,10,"DL",1167,"N301DQ","JFK","TPA",135,1005,8,15,2013-06-13 08:00:00 +2013,6,13,929,930,-1,1242,1234,8,"DL",1443,"N727TW","JFK","SEA",322,2422,9,30,2013-06-13 09:00:00 +2013,6,13,929,933,-4,1259,1156,63,"EV",4140,"N13994","EWR","ATL",113,746,9,33,2013-06-13 09:00:00 +2013,6,13,956,945,11,1157,1125,32,"AA",317,"N598AA","LGA","ORD",116,733,9,45,2013-06-13 09:00:00 +2013,6,13,1452,1435,17,1822,1750,32,"DL",1779,"N369NW","LGA","FLL",164,1076,14,35,2013-06-13 14:00:00 +2013,6,13,1558,1520,38,1748,1705,43,"AA",2223,"N561AA","LGA","STL",129,888,15,20,2013-06-13 15:00:00 +2013,6,13,1825,1829,-4,2129,2033,56,"US",297,"N508AY","JFK","CLT",88,541,18,29,2013-06-13 18:00:00 +2013,6,13,1840,1830,10,2233,2155,38,"UA",389,"N554UA","JFK","SFO",367,2586,18,30,2013-06-13 18:00:00 +2013,6,13,2016,1919,57,44,2210,154,"UA",1259,"N73270","LGA","IAH",181,1416,19,19,2013-06-13 19:00:00 +2013,6,13,NA,1330,NA,NA,1532,NA,"EV",4395,"N14991","EWR","IND",NA,645,13,30,2013-06-13 13:00:00 +2013,6,13,NA,1000,NA,NA,1121,NA,"EV",5736,"N829AS","LGA","IAD",NA,229,10,0,2013-06-13 10:00:00 +2013,6,14,940,940,0,1043,1110,-27,"WN",1098,"N456WN","LGA","MKE",105,738,9,40,2013-06-14 09:00:00 +2013,6,14,1002,1005,-3,1237,1251,-14,"B6",65,"N552JB","JFK","TPA",135,1005,10,5,2013-06-14 10:00:00 +2013,6,14,1014,1018,-4,1116,1139,-23,"UA",205,"N451UA","EWR","BOS",36,200,10,18,2013-06-14 10:00:00 +2013,6,14,1305,1255,10,1432,1425,7,"WN",546,"N910WN","LGA","MKE",107,738,12,55,2013-06-14 12:00:00 +2013,6,14,1437,1430,7,1547,1554,-7,"EV",4171,"N16961","EWR","MSN",118,799,14,30,2013-06-14 14:00:00 +2013,6,14,1500,1500,0,1801,1755,6,"AA",1813,"N5FNAA","JFK","MCO",132,944,15,0,2013-06-14 15:00:00 +2013,6,14,1524,1529,-5,1749,1820,-31,"B6",537,"N639JB","EWR","TPA",128,997,15,29,2013-06-14 15:00:00 +2013,6,14,1612,1520,52,1739,1710,29,"AA",341,"N436AA","LGA","ORD",117,733,15,20,2013-06-14 15:00:00 +2013,6,14,1612,1600,12,1927,1815,72,"MQ",3075,"N633MQ","JFK","CVG",92,589,16,0,2013-06-14 16:00:00 +2013,6,14,1624,1625,-1,1756,1808,-12,"DL",402,"N353NB","JFK","BOS",37,187,16,25,2013-06-14 16:00:00 +2013,6,14,1712,1655,17,1848,1837,11,"EV",5977,"N12567","EWR","RDU",66,416,16,55,2013-06-14 16:00:00 +2013,6,14,1716,1654,22,2042,2015,27,"UA",1284,"N39450","EWR","SFO",334,2565,16,54,2013-06-14 16:00:00 +2013,6,14,1828,1825,3,2141,2145,-4,"AS",7,"N402AS","EWR","SEA",335,2402,18,25,2013-06-14 18:00:00 +2013,6,14,2358,2359,-1,347,345,2,"B6",701,"N612JB","JFK","SJU",210,1598,23,59,2013-06-14 23:00:00 +2013,6,14,NA,1300,NA,NA,1540,NA,"AA",1841,"N435AA","EWR","DFW",NA,1372,13,0,2013-06-14 13:00:00 +2013,6,15,542,545,-3,758,823,-25,"UA",1714,"N17245","LGA","IAH",180,1416,5,45,2013-06-15 05:00:00 +2013,6,15,700,700,0,822,830,-8,"WN",1130,"N629SW","EWR","STL",124,872,7,0,2013-06-15 07:00:00 +2013,6,15,749,750,-1,1026,1030,-4,"AA",715,"N484AA","LGA","DFW",180,1389,7,50,2013-06-15 07:00:00 +2013,6,15,1000,955,5,1117,1115,2,"MQ",3670,"N503MQ","LGA","BNA",101,764,9,55,2013-06-15 09:00:00 +2013,6,15,1619,1625,-6,1755,1837,-42,"DL",2231,"N317NB","LGA","DTW",80,502,16,25,2013-06-15 16:00:00 +2013,6,15,1731,1725,6,1946,1947,-1,"UA",280,"N458UA","EWR","PHX",297,2133,17,25,2013-06-15 17:00:00 +2013,6,15,1733,1530,123,1932,1755,97,"MQ",3202,"N942MQ","JFK","IND",99,665,15,30,2013-06-15 15:00:00 +2013,6,15,1827,1829,-2,2006,2033,-27,"US",297,"N520UW","JFK","CLT",74,541,18,29,2013-06-15 18:00:00 +2013,6,15,1858,1900,-2,2013,2035,-22,"WN",2497,"N497WN","LGA","MDW",107,725,19,0,2013-06-15 19:00:00 +2013,6,16,824,825,-1,1004,1023,-19,"B6",219,"N329JB","JFK","CLT",78,541,8,25,2013-06-16 08:00:00 +2013,6,16,1035,1030,5,1305,1242,23,"EV",5806,"N13132","EWR","OMA",170,1134,10,30,2013-06-16 10:00:00 +2013,6,16,1157,1205,-8,1426,1430,-4,"MQ",3658,"N500MQ","LGA","ATL",112,762,12,5,2013-06-16 12:00:00 +2013,6,16,1627,1630,-3,1910,1930,-20,"AA",881,"N3HFAA","JFK","DFW",177,1391,16,30,2013-06-16 16:00:00 +2013,6,16,1638,1612,26,1834,1818,16,"EV",4667,"N11165","EWR","MSP",157,1008,16,12,2013-06-16 16:00:00 +2013,6,16,1644,1700,-16,1936,2000,-24,"AA",773,"N4XXAA","LGA","DFW",199,1389,17,0,2013-06-16 17:00:00 +2013,6,16,1732,1640,52,1834,1813,21,"9E",3788,"N812AY","JFK","PHL",37,94,16,40,2013-06-16 16:00:00 +2013,6,16,1742,1750,-8,2104,2045,19,"UA",379,"N838UA","EWR","SAN",342,2425,17,50,2013-06-16 17:00:00 +2013,6,16,1850,1859,-9,2120,2121,-1,"FL",778,"N993AT","LGA","ATL",123,762,18,59,2013-06-16 18:00:00 +2013,6,16,1858,1659,119,2117,1907,130,"EV",4532,"N14950","EWR","CHS",95,628,16,59,2013-06-16 16:00:00 +2013,6,16,2035,2023,12,21,29,-8,"UA",1244,"N38417","EWR","SJU",191,1608,20,23,2013-06-16 20:00:00 +2013,6,17,646,649,-3,858,903,-5,"UA",343,"N526UA","LGA","DEN",224,1620,6,49,2013-06-17 06:00:00 +2013,6,17,655,600,55,842,757,45,"DL",731,"N366NB","LGA","DTW",83,502,6,0,2013-06-17 06:00:00 +2013,6,17,702,705,-3,810,823,-13,"EV",4522,"N11565","EWR","BNA",109,748,7,5,2013-06-17 07:00:00 +2013,6,17,758,800,-2,858,922,-24,"UA",1199,"N27724","EWR","BOS",42,200,8,0,2013-06-17 08:00:00 +2013,6,17,803,800,3,1047,1104,-17,"DL",1271,"N3743H","JFK","FLL",138,1069,8,0,2013-06-17 08:00:00 +2013,6,17,1036,1029,7,1304,1239,25,"US",196,"N509AY","JFK","PHX",304,2153,10,29,2013-06-17 10:00:00 +2013,6,17,1200,1205,-5,1416,1430,-14,"MQ",3658,"N544MQ","LGA","ATL",107,762,12,5,2013-06-17 12:00:00 +2013,6,17,1533,1530,3,1936,1850,46,"DL",95,"N195DN","JFK","LAX",337,2475,15,30,2013-06-17 15:00:00 +2013,6,17,1852,1829,23,2224,2125,59,"UA",1165,"N75853","EWR","LAX",331,2454,18,29,2013-06-17 18:00:00 +2013,6,18,3,2359,4,339,345,-6,"B6",701,"N621JB","JFK","SJU",193,1598,23,59,2013-06-18 23:00:00 +2013,6,18,736,740,-4,927,941,-14,"EV",4104,"N12175","EWR","CHS",93,628,7,40,2013-06-18 07:00:00 +2013,6,18,748,750,-2,1020,1027,-7,"UA",753,"N441UA","EWR","DFW",191,1372,7,50,2013-06-18 07:00:00 +2013,6,18,751,800,-9,1051,1106,-15,"B6",553,"N516JB","EWR","RSW",158,1068,8,0,2013-06-18 08:00:00 +2013,6,18,1146,1145,1,1330,1320,10,"AA",1855,"N477AA","LGA","STL",128,888,11,45,2013-06-18 11:00:00 +2013,6,18,1344,1259,45,1719,1657,22,"UA",1090,"N78448","EWR","SJU",192,1608,12,59,2013-06-18 12:00:00 +2013,6,18,1352,1359,-7,1502,1513,-11,"B6",1002,"N229JB","JFK","BOS",45,187,13,59,2013-06-18 13:00:00 +2013,6,18,1400,1315,45,1545,1449,56,"EV",4552,"N13956","EWR","GSO",71,445,13,15,2013-06-18 13:00:00 +2013,6,18,1456,1455,1,1635,1635,0,"MQ",3231,"N669MQ","JFK","PIT",68,340,14,55,2013-06-18 14:00:00 +2013,6,18,1959,1738,141,2148,1944,124,"EV",4225,"N11155","EWR","MSP",149,1008,17,38,2013-06-18 17:00:00 +2013,6,18,NA,1443,NA,NA,1712,NA,"EV",4152,"N25134","EWR","ATL",NA,746,14,43,2013-06-18 14:00:00 +2013,6,19,630,635,-5,741,745,-4,"EV",4241,"N19966","EWR","DCA",45,199,6,35,2013-06-19 06:00:00 +2013,6,19,745,755,-10,1043,1045,-2,"B6",341,"N612JB","JFK","SRQ",154,1041,7,55,2013-06-19 07:00:00 +2013,6,19,920,915,5,1130,1115,15,"MQ",3565,"N530MQ","LGA","CLT",87,544,9,15,2013-06-19 09:00:00 +2013,6,19,952,959,-7,1219,1201,18,"US",1277,"N701UW","LGA","CLT",98,544,9,59,2013-06-19 09:00:00 +2013,6,19,1355,1349,6,1524,1516,8,"UA",1631,"N11206","EWR","ORD",120,719,13,49,2013-06-19 13:00:00 +2013,6,19,1454,1455,-1,1643,1635,8,"MQ",3231,"N650MQ","JFK","PIT",66,340,14,55,2013-06-19 14:00:00 +2013,6,19,1630,1630,0,1856,1930,-34,"AA",881,"N3FNAA","JFK","DFW",181,1391,16,30,2013-06-19 16:00:00 +2013,6,19,1827,1829,-2,2014,2033,-19,"US",297,"N534UW","JFK","CLT",79,541,18,29,2013-06-19 18:00:00 +2013,6,19,1919,1745,94,2111,1925,106,"MQ",3301,"N507MQ","LGA","RDU",70,431,17,45,2013-06-19 17:00:00 +2013,6,19,1928,1930,-2,2300,2244,16,"DL",1854,"N329NW","LGA","FLL",169,1076,19,30,2013-06-19 19:00:00 +2013,6,19,2108,2110,-2,2220,2245,-25,"B6",10,"N178JB","JFK","BUF",58,301,21,10,2013-06-19 21:00:00 +2013,6,19,2223,2225,-2,2325,2330,-5,"EV",5258,"N709EV","LGA","MHT",39,195,22,25,2013-06-19 22:00:00 +2013,6,20,810,815,-5,1003,1008,-5,"US",1509,"N457UW","EWR","CLT",83,529,8,15,2013-06-20 08:00:00 +2013,6,20,1411,1415,-4,1612,1629,-17,"DL",673,"N304DQ","EWR","ATL",103,746,14,15,2013-06-20 14:00:00 +2013,6,20,1917,1910,7,2231,2237,-6,"DL",1091,"N330NB","JFK","SAT",204,1587,19,10,2013-06-20 19:00:00 +2013,6,20,1924,1859,25,2030,2036,-6,"UA",693,"N417UA","LGA","ORD",109,733,18,59,2013-06-20 18:00:00 +2013,6,21,640,641,-1,933,940,-7,"UA",1701,"N30401","EWR","FLL",155,1065,6,41,2013-06-21 06:00:00 +2013,6,21,716,720,-4,904,921,-17,"EV",3824,"N14904","EWR","GRR",90,605,7,20,2013-06-21 07:00:00 +2013,6,21,731,735,-4,959,1005,-6,"AA",1949,"N3FCAA","JFK","LAS",293,2248,7,35,2013-06-21 07:00:00 +2013,6,21,826,829,-3,1025,1028,-3,"DL",1157,"N345NB","EWR","MSP",143,1008,8,29,2013-06-21 08:00:00 +2013,6,21,1154,1159,-5,1429,1500,-31,"UA",1593,"N16709","EWR","SNA",310,2434,11,59,2013-06-21 11:00:00 +2013,6,21,1405,1410,-5,1615,1630,-15,"FL",349,"N892AT","LGA","ATL",106,762,14,10,2013-06-21 14:00:00 +2013,6,21,1522,1145,217,1723,1358,205,"DL",401,"N326NB","EWR","ATL",100,746,11,45,2013-06-21 11:00:00 +2013,6,21,1646,1636,10,1757,1805,-8,"B6",918,"N231JB","JFK","BOS",35,187,16,36,2013-06-21 16:00:00 +2013,6,21,1646,1651,-5,1814,1900,-46,"DL",1473,"N364NB","LGA","MEM",125,963,16,51,2013-06-21 16:00:00 +2013,6,21,1807,1738,29,2038,1944,54,"EV",4225,"N11137","EWR","MSP",143,1008,17,38,2013-06-21 17:00:00 +2013,6,22,553,600,-7,726,732,-6,"EV",4108,"N12167","EWR","RDU",65,416,6,0,2013-06-22 06:00:00 +2013,6,22,610,615,-5,752,806,-14,"US",874,"N105UW","EWR","CLT",80,529,6,15,2013-06-22 06:00:00 +2013,6,22,611,615,-4,901,910,-9,"AA",1895,"N3HGAA","EWR","MIA",147,1085,6,15,2013-06-22 06:00:00 +2013,6,22,706,715,-9,1031,1030,1,"AA",443,"N332AA","JFK","MIA",168,1089,7,15,2013-06-22 07:00:00 +2013,6,22,1307,1314,-7,1604,1620,-16,"B6",1639,"N655JB","LGA","RSW",157,1080,13,14,2013-06-22 13:00:00 +2013,6,22,1502,1345,77,1747,1639,68,"DL",1685,"N985DL","LGA","MCO",132,950,13,45,2013-06-22 13:00:00 +2013,6,22,1617,1555,22,1910,1900,10,"DL",1753,"N384DA","JFK","MCO",128,944,15,55,2013-06-22 15:00:00 +2013,6,22,1828,1805,23,1946,1932,14,"DL",2383,"N335NB","LGA","PWM",46,269,18,5,2013-06-22 18:00:00 +2013,6,23,639,645,-6,828,908,-40,"US",15,"N521UW","JFK","PHX",271,2153,6,45,2013-06-23 06:00:00 +2013,6,23,733,730,3,912,944,-32,"UA",561,"N576UA","LGA","DEN",200,1620,7,30,2013-06-23 07:00:00 +2013,6,23,835,840,-5,1143,1146,-3,"UA",1125,"N48127","JFK","LAX",322,2475,8,40,2013-06-23 08:00:00 +2013,6,23,1006,1010,-4,1301,1309,-8,"UA",1425,"N24706","EWR","FLL",162,1065,10,10,2013-06-23 10:00:00 +2013,6,23,1148,1155,-7,1255,1310,-15,"MQ",3386,"N830MQ","JFK","DCA",48,213,11,55,2013-06-23 11:00:00 +2013,6,23,1849,1750,59,2147,2049,58,"UA",535,"N502UA","JFK","LAX",313,2475,17,50,2013-06-23 17:00:00 +2013,6,23,2307,2115,112,103,2349,74,"DL",1729,"N3758Y","JFK","LAS",277,2248,21,15,2013-06-23 21:00:00 +2013,6,24,627,630,-3,928,924,4,"B6",929,"N644JB","JFK","RSW",158,1074,6,30,2013-06-24 06:00:00 +2013,6,24,715,720,-5,908,921,-13,"EV",3824,"N12924","EWR","GRR",91,605,7,20,2013-06-24 07:00:00 +2013,6,24,837,845,-8,1024,1044,-20,"US",1429,"N710UW","LGA","CLT",80,544,8,45,2013-06-24 08:00:00 +2013,6,24,942,940,2,1053,1110,-17,"WN",1098,"N292WN","LGA","MKE",103,738,9,40,2013-06-24 09:00:00 +2013,6,24,1029,1030,-1,1245,1248,-3,"DL",1529,"N3760C","JFK","LAS",296,2248,10,30,2013-06-24 10:00:00 +2013,6,24,1258,1301,-3,1431,1411,20,"EV",4129,"N26545","EWR","DCA",50,199,13,1,2013-06-24 13:00:00 +2013,6,24,1343,1345,-2,1635,1645,-10,"AA",117,"N328AA","JFK","LAX",318,2475,13,45,2013-06-24 13:00:00 +2013,6,24,1621,1625,-4,1742,1808,-26,"DL",402,"N368NB","JFK","BOS",37,187,16,25,2013-06-24 16:00:00 +2013,6,25,703,700,3,946,1003,-17,"DL",763,"N192DN","JFK","LAX",315,2475,7,0,2013-06-25 07:00:00 +2013,6,25,757,800,-3,1047,1104,-17,"DL",1271,"N393DA","JFK","FLL",140,1069,8,0,2013-06-25 08:00:00 +2013,6,25,1153,1057,56,1424,1342,42,"UA",1493,"N53441","EWR","LAX",307,2454,10,57,2013-06-25 10:00:00 +2013,6,25,1206,1210,-4,1502,1500,2,"AA",743,"N4YLAA","LGA","DFW",180,1389,12,10,2013-06-25 12:00:00 +2013,6,25,1258,1300,-2,1410,1409,1,"US",2128,"N947UW","LGA","BOS",40,184,13,0,2013-06-25 13:00:00 +2013,6,25,1342,1259,43,1727,1657,30,"UA",1090,"N57439","EWR","SJU",200,1608,12,59,2013-06-25 12:00:00 +2013,6,25,1930,1721,129,2143,1926,137,"EV",3847,"N14562","EWR","IND",97,645,17,21,2013-06-25 17:00:00 +2013,6,25,1937,1916,21,2256,2225,31,"UA",1439,"N27239","EWR","LAX",313,2454,19,16,2013-06-25 19:00:00 +2013,6,25,2316,2245,31,234,135,59,"B6",623,"N807JB","JFK","LAX",324,2475,22,45,2013-06-25 22:00:00 +2013,6,25,2335,2120,135,103,2239,144,"EV",4141,"N29906","EWR","DCA",48,199,21,20,2013-06-25 21:00:00 +2013,6,26,605,605,0,837,839,-2,"B6",583,"N632JB","JFK","MCO",128,944,6,5,2013-06-26 06:00:00 +2013,6,26,657,700,-3,939,951,-12,"B6",23,"N708JB","JFK","LAX",323,2475,7,0,2013-06-26 07:00:00 +2013,6,26,755,755,0,1031,1057,-26,"DL",2395,"N980DL","LGA","PBI",138,1035,7,55,2013-06-26 07:00:00 +2013,6,26,1021,1025,-4,1210,1222,-12,"US",604,"N642AW","EWR","PHX",271,2133,10,25,2013-06-26 10:00:00 +2013,6,26,1408,1356,12,1621,1628,-7,"UA",330,"N416UA","EWR","DFW",174,1372,13,56,2013-06-26 13:00:00 +2013,6,26,1451,1455,-4,1631,1635,-4,"MQ",3231,"N663MQ","JFK","PIT",65,340,14,55,2013-06-26 14:00:00 +2013,6,26,1451,1455,-4,1642,1645,-3,"MQ",2815,"N928MQ","JFK","CLE",79,425,14,55,2013-06-26 14:00:00 +2013,6,26,1505,1500,5,1658,1717,-19,"UA",745,"N521UA","LGA","DEN",208,1620,15,0,2013-06-26 15:00:00 +2013,6,26,1910,1900,10,2156,2143,13,"DL",971,"N393DA","JFK","DEN",216,1626,19,0,2013-06-26 19:00:00 +2013,6,26,2219,1900,199,113,2150,203,"UA",1269,"N30401","EWR","PBI",144,1023,19,0,2013-06-26 19:00:00 +2013,6,27,558,600,-2,802,815,-13,"FL",345,"N285AT","LGA","ATL",109,762,6,0,2013-06-27 06:00:00 +2013,6,27,641,645,-4,846,902,-16,"UA",1138,"N23707","EWR","PHX",276,2133,6,45,2013-06-27 06:00:00 +2013,6,27,825,830,-5,1010,1028,-18,"EV",4297,"N16571","EWR","DTW",82,488,8,30,2013-06-27 08:00:00 +2013,6,27,846,848,-2,1048,1058,-10,"EV",4181,"N41104","EWR","MCI",151,1092,8,48,2013-06-27 08:00:00 +2013,6,27,852,900,-8,1008,1022,-14,"US",2167,"N745VJ","LGA","DCA",43,214,9,0,2013-06-27 09:00:00 +2013,6,27,1058,1100,-2,1210,1230,-20,"WN",3297,"N7746C","LGA","BNA",107,764,11,0,2013-06-27 11:00:00 +2013,6,27,1213,1147,26,1505,1454,11,"UA",1120,"N37267","EWR","SFO",329,2565,11,47,2013-06-27 11:00:00 +2013,6,27,1454,1500,-6,1756,1755,1,"AA",1813,"N5EYAA","JFK","MCO",129,944,15,0,2013-06-27 15:00:00 +2013,6,27,1539,1520,19,1819,1805,14,"DL",1773,"N3731T","JFK","LAS",291,2248,15,20,2013-06-27 15:00:00 +2013,6,27,1630,1630,0,2035,1845,110,"MQ",3556,"N713MQ","LGA","DTW",77,502,16,30,2013-06-27 16:00:00 +2013,6,27,1946,1900,46,2316,2143,93,"DL",971,"N381DN","JFK","DEN",225,1626,19,0,2013-06-27 19:00:00 +2013,6,27,1948,1830,78,2349,2038,191,"DL",2131,"N344NB","LGA","DTW",73,502,18,30,2013-06-27 18:00:00 +2013,6,27,NA,2054,NA,NA,2314,NA,"EV",3812,"N31131","EWR","SDF",NA,642,20,54,2013-06-27 20:00:00 +2013,6,28,702,700,2,827,811,16,"EV",5819,"N13914","EWR","MHT",56,209,7,0,2013-06-28 07:00:00 +2013,6,28,733,730,3,1029,1045,-16,"UA",1668,"N39450","EWR","SFO",331,2565,7,30,2013-06-28 07:00:00 +2013,6,28,954,955,-1,1241,1300,-19,"UA",1170,"N76505","EWR","FLL",149,1065,9,55,2013-06-28 09:00:00 +2013,6,28,1038,1018,20,1145,1139,6,"UA",732,"N817UA","EWR","BOS",47,200,10,18,2013-06-28 10:00:00 +2013,6,28,1107,1114,-7,1341,1349,-8,"B6",127,"N657JB","EWR","MCO",127,937,11,14,2013-06-28 11:00:00 +2013,6,28,2209,2025,104,113,2321,112,"B6",1295,"N258JB","JFK","AUS",207,1521,20,25,2013-06-28 20:00:00 +2013,6,29,553,600,-7,823,823,0,"DL",461,"N687DL","LGA","ATL",115,762,6,0,2013-06-29 06:00:00 +2013,6,29,740,745,-5,936,939,-3,"B6",1273,"N358JB","JFK","CHS",98,636,7,45,2013-06-29 07:00:00 +2013,6,29,900,855,5,1205,1205,0,"AA",647,"N5EUAA","JFK","MIA",151,1089,8,55,2013-06-29 08:00:00 +2013,6,29,1054,1046,8,1402,1402,0,"DL",1903,"N359NW","LGA","SRQ",152,1047,10,46,2013-06-29 10:00:00 +2013,6,29,1105,1105,0,1308,1313,-5,"DL",1031,"N364NB","LGA","DTW",80,502,11,5,2013-06-29 11:00:00 +2013,6,29,1125,1115,10,1232,1235,-3,"WN",1506,"N7726A","LGA","MDW",107,725,11,15,2013-06-29 11:00:00 +2013,6,29,1449,1450,-1,1736,1746,-10,"UA",392,"N402UA","EWR","FLL",149,1065,14,50,2013-06-29 14:00:00 +2013,6,29,1906,1820,46,2120,2048,32,"9E",3476,"N602LR","JFK","DTW",77,509,18,20,2013-06-29 18:00:00 +2013,6,30,749,750,-1,1121,1041,40,"B6",1717,"N806JB","LGA","TPA",155,1010,7,50,2013-06-30 07:00:00 +2013,6,30,1645,1556,49,1801,1720,41,"UA",1199,"N33284","EWR","BOS",40,200,15,56,2013-06-30 15:00:00 +2013,6,30,1741,1550,111,2009,1805,124,"WN",1939,"N295WN","EWR","DEN",230,1605,15,50,2013-06-30 15:00:00 +2013,6,30,1900,1630,150,2144,1930,134,"AA",881,"N3ELAA","JFK","DFW",187,1391,16,30,2013-06-30 16:00:00 +2013,6,30,NA,1523,NA,NA,1709,NA,"9E",3742,NA,"JFK","ROC",NA,264,15,23,2013-06-30 15:00:00 +2013,7,1,641,641,0,935,940,-5,"UA",1701,"N37408","EWR","FLL",159,1065,6,41,2013-07-01 06:00:00 +2013,7,1,649,655,-6,935,930,5,"AA",711,"N3EGAA","LGA","DFW",191,1389,6,55,2013-07-01 06:00:00 +2013,7,1,910,815,55,1212,955,137,"MQ",3531,"N711MQ","LGA","RDU",79,431,8,15,2013-07-01 08:00:00 +2013,7,1,959,1000,-1,1330,1314,16,"UA",510,"N525UA","JFK","SFO",314,2586,10,0,2013-07-01 10:00:00 +2013,7,1,1140,1025,75,1333,1225,68,"MQ",3689,"N9EAMQ","LGA","DTW",80,502,10,25,2013-07-01 10:00:00 +2013,7,1,1331,1252,39,1545,1500,45,"UA",1686,"N75410","EWR","MSY",173,1167,12,52,2013-07-01 12:00:00 +2013,7,1,1438,1255,103,1739,1546,113,"UA",1641,"N29129","EWR","MCO",149,937,12,55,2013-07-01 12:00:00 +2013,7,1,1610,1545,25,1720,1710,10,"MQ",3694,"N546MQ","EWR","ORD",112,719,15,45,2013-07-01 15:00:00 +2013,7,1,1908,1900,8,2122,2140,-18,"DL",971,"N3756","JFK","DEN",207,1626,19,0,2013-07-01 19:00:00 +2013,7,1,2359,2049,190,239,2348,171,"B6",523,"N789JB","JFK","LAX",314,2475,20,49,2013-07-01 20:00:00 +2013,7,1,NA,1355,NA,NA,1550,NA,"MQ",3567,"N6EAMQ","LGA","CLT",NA,544,13,55,2013-07-01 13:00:00 +2013,7,2,643,645,-2,740,752,-12,"B6",318,"N178JB","JFK","BOS",37,187,6,45,2013-07-02 06:00:00 +2013,7,2,955,1000,-5,1231,1244,-13,"UA",1148,"N75410","EWR","TPA",143,997,10,0,2013-07-02 10:00:00 +2013,7,2,1356,1340,16,1457,1510,-13,"WN",427,"N779SW","LGA","MDW",106,725,13,40,2013-07-02 13:00:00 +2013,7,2,1451,1455,-4,1704,1645,19,"MQ",3359,"N811MQ","JFK","RDU",77,427,14,55,2013-07-02 14:00:00 +2013,7,2,1604,1500,64,1824,1724,60,"EV",5199,"N614QX","LGA","CHS",106,641,15,0,2013-07-02 15:00:00 +2013,7,2,1620,1609,11,1851,1928,-37,"UA",1677,"N75428","EWR","SFO",312,2565,16,9,2013-07-02 16:00:00 +2013,7,2,1859,1900,-1,2216,2141,35,"UA",1159,"N12238","EWR","DFW",197,1372,19,0,2013-07-02 19:00:00 +2013,7,3,743,730,13,1023,1010,13,"B6",683,"N586JB","JFK","MCO",129,944,7,30,2013-07-03 07:00:00 +2013,7,3,1224,1230,-6,1357,1403,-6,"9E",4087,"N8747B","LGA","IAD",44,229,12,30,2013-07-03 12:00:00 +2013,7,3,1249,1300,-11,1500,1505,-5,"MQ",3340,"N722MQ","LGA","DTW",92,502,13,0,2013-07-03 13:00:00 +2013,7,3,1250,1225,25,1439,1435,4,"WN",226,"N731SA","EWR","DEN",208,1605,12,25,2013-07-03 12:00:00 +2013,7,3,1454,1455,-1,1647,1715,-28,"DL",127,"N336NB","JFK","DTW",78,509,14,55,2013-07-03 14:00:00 +2013,7,3,1458,1500,-2,1734,1755,-21,"AA",1813,"N5FEAA","JFK","MCO",124,944,15,0,2013-07-03 15:00:00 +2013,7,3,1520,1530,-10,1752,1755,-3,"MQ",3202,"N649MQ","JFK","IND",104,665,15,30,2013-07-03 15:00:00 +2013,7,3,1530,1520,10,1756,1814,-18,"UA",1600,"N34137","EWR","LAX",298,2454,15,20,2013-07-03 15:00:00 +2013,7,3,1714,1620,54,2000,1902,58,"DL",843,"N174DN","JFK","ATL",111,760,16,20,2013-07-03 16:00:00 +2013,7,3,1828,1830,-2,1952,1955,-3,"MQ",3486,"N722MQ","LGA","BNA",116,764,18,30,2013-07-03 18:00:00 +2013,7,3,2055,1935,80,2325,2142,103,"9E",3443,"N904XJ","JFK","RDU",66,427,19,35,2013-07-03 19:00:00 +2013,7,3,2118,2030,48,2229,2202,27,"9E",4079,"N8896A","JFK","BWI",38,184,20,30,2013-07-03 20:00:00 +2013,7,3,2129,1716,253,2322,1848,274,"B6",408,"N229JB","JFK","PWM",43,273,17,16,2013-07-03 17:00:00 +2013,7,4,825,830,-5,941,1027,-46,"EV",5304,"N608QX","LGA","RDU",64,431,8,30,2013-07-04 08:00:00 +2013,7,4,930,935,-5,1214,1237,-23,"B6",271,"N636JB","LGA","FLL",148,1076,9,35,2013-07-04 09:00:00 +2013,7,4,1350,1300,50,1603,1519,44,"EV",5148,"N137EV","EWR","ATL",113,746,13,0,2013-07-04 13:00:00 +2013,7,4,1712,1659,13,1815,1834,-19,"UA",1492,"N78509","EWR","ORD",103,719,16,59,2013-07-04 16:00:00 +2013,7,4,1910,1905,5,2037,2108,-31,"9E",3525,"N604LR","JFK","ORD",111,740,19,5,2013-07-04 19:00:00 +2013,7,5,626,630,-4,838,843,-5,"DL",575,"N331NB","EWR","ATL",112,746,6,30,2013-07-05 06:00:00 +2013,7,5,644,645,-1,911,845,26,"B6",675,"N328JB","JFK","MSY",180,1182,6,45,2013-07-05 06:00:00 +2013,7,5,819,825,-6,1047,1115,-28,"UA",807,"N491UA","EWR","MCO",128,937,8,25,2013-07-05 08:00:00 +2013,7,5,858,905,-7,956,1016,-20,"B6",1634,"N273JB","JFK","BTV",46,266,9,5,2013-07-05 09:00:00 +2013,7,5,1354,1400,-6,1507,1512,-5,"US",2177,"N947UW","LGA","DCA",43,214,14,0,2013-07-05 14:00:00 +2013,7,5,1549,1552,-3,1824,1840,-16,"UA",566,"N491UA","EWR","MCO",132,937,15,52,2013-07-05 15:00:00 +2013,7,5,1619,1625,-6,1810,1839,-29,"9E",3440,"N933XJ","JFK","RDU",68,427,16,25,2013-07-05 16:00:00 +2013,7,5,1937,1940,-3,2202,2224,-22,"EV",4204,"N14158","EWR","OKC",181,1325,19,40,2013-07-05 19:00:00 +2013,7,6,550,600,-10,653,725,-32,"UA",635,"N805UA","LGA","ORD",107,733,6,0,2013-07-06 06:00:00 +2013,7,6,813,815,-2,952,1012,-20,"EV",4295,"N27152","EWR","AVL",84,583,8,15,2013-07-06 08:00:00 +2013,7,6,1451,1455,-4,1633,1635,-2,"MQ",3231,"N601MQ","JFK","PIT",71,340,14,55,2013-07-06 14:00:00 +2013,7,6,1511,1430,41,1615,1556,19,"EV",5713,"N828AS","LGA","IAD",43,229,14,30,2013-07-06 14:00:00 +2013,7,6,1707,1711,-4,2010,2039,-29,"B6",167,"N517JB","JFK","OAK",339,2576,17,11,2013-07-06 17:00:00 +2013,7,6,1709,1655,14,1823,1824,-1,"EV",4508,"N13566","EWR","ROC",43,246,16,55,2013-07-06 16:00:00 +2013,7,6,1728,1700,28,1837,1845,-8,"MQ",3216,"N902MQ","JFK","ORF",48,290,17,0,2013-07-06 17:00:00 +2013,7,6,1753,1759,-6,2024,2058,-34,"DL",1585,"N982DL","LGA","MCO",131,950,17,59,2013-07-06 17:00:00 +2013,7,6,2001,2007,-6,2218,2259,-41,"B6",1505,"N809JB","JFK","ABQ",230,1826,20,7,2013-07-06 20:00:00 +2013,7,7,50,2059,231,209,2245,204,"EV",4672,"N14125","EWR","STL",121,872,20,59,2013-07-07 20:00:00 +2013,7,7,647,647,0,921,943,-22,"UA",506,"N482UA","EWR","LAX",306,2454,6,47,2013-07-07 06:00:00 +2013,7,7,739,729,10,919,939,-20,"UA",311,"N483UA","EWR","DEN",200,1605,7,29,2013-07-07 07:00:00 +2013,7,7,757,800,-3,1004,1021,-17,"B6",677,"N296JB","JFK","JAX",110,828,8,0,2013-07-07 08:00:00 +2013,7,7,905,915,-10,1045,1115,-30,"MQ",3565,"N518MQ","LGA","CLT",79,544,9,15,2013-07-07 09:00:00 +2013,7,7,1229,1230,-1,1521,1558,-37,"DL",2098,"N939DL","LGA","MIA",144,1096,12,30,2013-07-07 12:00:00 +2013,7,7,1450,1455,-5,1618,1635,-17,"MQ",3231,"N923MQ","JFK","PIT",66,340,14,55,2013-07-07 14:00:00 +2013,7,7,1535,1347,108,1838,1644,114,"DL",1685,"N920DE","LGA","MCO",130,950,13,47,2013-07-07 13:00:00 +2013,7,7,1701,1328,213,NA,1530,NA,"9E",3698,"N836AY","EWR","CVG",NA,569,13,28,2013-07-07 13:00:00 +2013,7,7,1756,1710,46,2230,1932,178,"UA",387,"N423UA","EWR","PHX",297,2133,17,10,2013-07-07 17:00:00 +2013,7,7,NA,2000,NA,NA,2116,NA,"US",2189,NA,"LGA","DCA",NA,214,20,0,2013-07-07 20:00:00 +2013,7,8,759,802,-3,906,930,-24,"EV",5463,"N741EV","LGA","BNA",99,764,8,2,2013-07-08 08:00:00 +2013,7,8,816,820,-4,1048,1026,22,"EV",4380,"N12136","EWR","MSP",174,1008,8,20,2013-07-08 08:00:00 +2013,7,8,1015,1025,-10,1204,1222,-18,"US",604,"N668AW","EWR","PHX",265,2133,10,25,2013-07-08 10:00:00 +2013,7,8,1246,1244,2,1352,1356,-4,"EV",4109,"N14923","EWR","BNA",102,748,12,44,2013-07-08 12:00:00 +2013,7,8,1400,1400,0,1519,1512,7,"US",2177,"N764US","LGA","DCA",58,214,14,0,2013-07-08 14:00:00 +2013,7,8,1459,1359,60,1721,1636,45,"UA",1108,"N37255","EWR","IAH",174,1400,13,59,2013-07-08 13:00:00 +2013,7,8,1531,1529,2,1727,1736,-9,"UA",485,"N540UA","EWR","DEN",213,1605,15,29,2013-07-08 15:00:00 +2013,7,8,1947,1711,156,2246,2039,127,"B6",167,"N651JB","JFK","OAK",330,2576,17,11,2013-07-08 17:00:00 +2013,7,9,656,700,-4,811,807,4,"US",2163,"N760US","LGA","DCA",39,214,7,0,2013-07-09 07:00:00 +2013,7,9,659,700,-1,823,835,-12,"WN",1696,"N621SW","EWR","STL",121,872,7,0,2013-07-09 07:00:00 +2013,7,9,755,755,0,937,955,-18,"MQ",3478,"N711MQ","LGA","DTW",77,502,7,55,2013-07-09 07:00:00 +2013,7,9,914,915,-1,1144,1210,-26,"AA",1,"N332AA","JFK","LAX",303,2475,9,15,2013-07-09 09:00:00 +2013,7,9,1014,959,15,1207,1207,0,"EV",4495,"N21537","EWR","SAV",99,708,9,59,2013-07-09 09:00:00 +2013,7,9,1737,1640,57,1956,1815,101,"MQ",2949,"N605MQ","JFK","BNA",104,765,16,40,2013-07-09 16:00:00 +2013,7,9,1820,1830,-10,2126,2145,-19,"AA",119,"N3HBAA","EWR","LAX",311,2454,18,30,2013-07-09 18:00:00 +2013,7,9,1931,1930,1,2305,2224,41,"DL",1485,"N3753","LGA","MCO",140,950,19,30,2013-07-09 19:00:00 +2013,7,9,2026,2025,1,2306,2321,-15,"B6",1295,"N607JB","JFK","AUS",188,1521,20,25,2013-07-09 20:00:00 +2013,7,9,2138,2100,38,15,22,-7,"DL",2363,"N187DN","JFK","LAX",301,2475,21,0,2013-07-09 21:00:00 +2013,7,9,2151,1950,121,2352,2215,97,"EV",5092,"N133EV","EWR","ATL",97,746,19,50,2013-07-09 19:00:00 +2013,7,9,2250,2142,68,2400,2259,61,"EV",3832,"N14125","EWR","DCA",38,199,21,42,2013-07-09 21:00:00 +2013,7,10,47,2130,197,311,2359,192,"B6",1677,"N198JB","JFK","JAX",110,828,21,30,2013-07-10 21:00:00 +2013,7,10,603,600,3,715,711,4,"EV",6177,"N12157","EWR","IAD",44,212,6,0,2013-07-10 06:00:00 +2013,7,10,620,630,-10,902,923,-21,"UA",319,"N554UA","JFK","LAX",306,2475,6,30,2013-07-10 06:00:00 +2013,7,10,657,700,-3,1007,1006,1,"DL",1415,"N668DN","JFK","SLC",271,1990,7,0,2013-07-10 07:00:00 +2013,7,10,726,730,-4,922,930,-8,"EV",5813,"N12900","EWR","DTW",87,488,7,30,2013-07-10 07:00:00 +2013,7,10,838,842,-4,1142,1152,-10,"UA",1079,"N39450","EWR","SEA",329,2402,8,42,2013-07-10 08:00:00 +2013,7,10,910,915,-5,1202,1231,-29,"DL",2379,"N957DL","LGA","FLL",142,1076,9,15,2013-07-10 09:00:00 +2013,7,10,1507,1455,12,NA,1645,NA,"MQ",2815,"N918MQ","JFK","CLE",NA,425,14,55,2013-07-10 14:00:00 +2013,7,10,1900,1900,0,2237,2210,27,"DL",2159,"N3730B","JFK","MCO",149,944,19,0,2013-07-10 19:00:00 +2013,7,10,2250,1930,200,230,2304,206,"UA",1532,"N79279","EWR","SFO",351,2565,19,30,2013-07-10 19:00:00 +2013,7,11,600,600,0,831,840,-9,"WN",488,"N493WN","EWR","HOU",187,1411,6,0,2013-07-11 06:00:00 +2013,7,11,1049,1049,0,1254,1308,-14,"UA",454,"N566UA","EWR","LAS",286,2227,10,49,2013-07-11 10:00:00 +2013,7,11,1542,1455,47,1753,1701,52,"9E",4120,"N8839E","JFK","CLE",78,425,14,55,2013-07-11 14:00:00 +2013,7,11,1613,1505,68,1928,1835,53,"AA",1769,"N397AA","JFK","MIA",163,1089,15,5,2013-07-11 15:00:00 +2013,7,11,1736,1708,28,1937,1925,12,"UA",509,"N571UA","LGA","DEN",212,1620,17,8,2013-07-11 17:00:00 +2013,7,11,2059,2059,0,2215,2220,-5,"EV",3830,"N14543","EWR","RIC",52,277,20,59,2013-07-11 20:00:00 +2013,7,11,2112,2050,22,52,42,10,"UA",1071,"N77525","EWR","BQN",198,1585,20,50,2013-07-11 20:00:00 +2013,7,11,2213,2101,72,153,100,53,"B6",1103,"N789JB","JFK","SJU",193,1598,21,1,2013-07-11 21:00:00 +2013,7,12,957,959,-2,1200,1225,-25,"B6",411,"N566JB","JFK","LAS",275,2248,9,59,2013-07-12 09:00:00 +2013,7,12,1107,1115,-8,1231,1255,-24,"AA",327,"N525AA","LGA","ORD",95,733,11,15,2013-07-12 11:00:00 +2013,7,12,1124,1122,2,1306,1332,-26,"UA",1625,"N38424","EWR","DEN",199,1605,11,22,2013-07-12 11:00:00 +2013,7,12,1505,1500,5,1816,1755,21,"AA",1813,"N5FKAA","JFK","MCO",136,944,15,0,2013-07-12 15:00:00 +2013,7,12,1525,1529,-4,1811,1821,-10,"B6",573,"N746JB","EWR","TPA",144,997,15,29,2013-07-12 15:00:00 +2013,7,12,1631,1625,6,1915,1839,36,"9E",3440,"N915XJ","JFK","RDU",74,427,16,25,2013-07-12 16:00:00 +2013,7,12,1843,1625,138,2014,1815,119,"MQ",3411,"N836MQ","LGA","RDU",76,431,16,25,2013-07-12 16:00:00 +2013,7,12,1852,1800,52,2039,1930,69,"WN",625,"N291WN","EWR","MDW",96,711,18,0,2013-07-12 18:00:00 +2013,7,12,1926,1930,-4,2201,2224,-23,"DL",1485,"N3730B","LGA","MCO",129,950,19,30,2013-07-12 19:00:00 +2013,7,12,2002,1825,97,2224,2131,53,"UA",1595,"N33294","EWR","SNA",293,2434,18,25,2013-07-12 18:00:00 +2013,7,12,2309,2030,159,24,2202,142,"9E",4079,"N8976E","JFK","BWI",34,184,20,30,2013-07-12 20:00:00 +2013,7,13,745,747,-2,850,902,-12,"B6",8,"N358JB","JFK","PWM",49,273,7,47,2013-07-13 07:00:00 +2013,7,13,757,807,-10,958,1016,-18,"UA",561,"N587UA","LGA","DEN",192,1620,8,7,2013-07-13 08:00:00 +2013,7,13,1011,1014,-3,1130,1134,-4,"EV",4240,"N11187","EWR","BUF",44,282,10,14,2013-07-13 10:00:00 +2013,7,13,1301,1300,1,1435,1425,10,"UA",1171,"N18119","EWR","ORD",102,719,13,0,2013-07-13 13:00:00 +2013,7,13,1718,1550,88,1959,1747,132,"9E",3523,"N906XJ","JFK","ORD",107,740,15,50,2013-07-13 15:00:00 +2013,7,13,2130,1916,134,14,2214,120,"B6",883,"N793JB","JFK","MCO",122,944,19,16,2013-07-13 19:00:00 +2013,7,13,2328,2135,113,216,30,106,"B6",1201,"N629JB","JFK","FLL",139,1069,21,35,2013-07-13 21:00:00 +2013,7,14,714,630,44,958,924,34,"B6",929,"N563JB","JFK","RSW",141,1074,6,30,2013-07-14 06:00:00 +2013,7,14,1128,1135,-7,1431,1451,-20,"DL",954,"N916DL","LGA","FLL",150,1076,11,35,2013-07-14 11:00:00 +2013,7,14,1134,1135,-1,1304,1341,-37,"DL",2219,"N374NW","LGA","MSP",131,1020,11,35,2013-07-14 11:00:00 +2013,7,14,1320,1325,-5,1417,1432,-15,"US",1279,"N967UW","LGA","PHL",34,96,13,25,2013-07-14 13:00:00 +2013,7,14,1449,1455,-6,1727,1800,-33,"AA",1751,"N3BHAA","JFK","TPA",135,1005,14,55,2013-07-14 14:00:00 +2013,7,14,1819,1825,-6,2002,2032,-30,"DL",1715,"N301NB","LGA","MSY",143,1183,18,25,2013-07-14 18:00:00 +2013,7,14,1917,1915,2,2127,2211,-44,"DL",1629,"N3745B","JFK","LAS",272,2248,19,15,2013-07-14 19:00:00 +2013,7,14,2119,2100,19,2223,2235,-12,"AA",371,"N4WMAA","LGA","ORD",100,733,21,0,2013-07-14 21:00:00 +2013,7,15,628,630,-2,736,753,-17,"EV",4422,"N11535","EWR","PIT",50,319,6,30,2013-07-15 06:00:00 +2013,7,15,702,700,2,913,940,-27,"AA",2083,"N488AA","EWR","DFW",170,1372,7,0,2013-07-15 07:00:00 +2013,7,15,1125,1125,0,1337,1414,-37,"UA",703,"N597UA","JFK","LAX",291,2475,11,25,2013-07-15 11:00:00 +2013,7,15,1235,1237,-2,1450,1508,-18,"UA",1615,"N17719","EWR","ATL",106,746,12,37,2013-07-15 12:00:00 +2013,7,15,1424,1429,-5,1520,1540,-20,"EV",4103,"N12564","EWR","DCA",37,199,14,29,2013-07-15 14:00:00 +2013,7,15,1728,1728,0,1955,1938,17,"EV",4382,"N14952","EWR","DTW",87,488,17,28,2013-07-15 17:00:00 +2013,7,15,2029,2029,0,2315,2359,-44,"B6",915,"N536JB","JFK","SFO",317,2586,20,29,2013-07-15 20:00:00 +2013,7,15,2035,1959,36,2236,2146,50,"EV",6120,"N18557","LGA","CLE",63,419,19,59,2013-07-15 19:00:00 +2013,7,16,556,600,-4,720,725,-5,"AA",301,"N4XRAA","LGA","ORD",102,733,6,0,2013-07-16 06:00:00 +2013,7,16,559,604,-5,659,725,-26,"UA",230,"N830UA","EWR","BOS",36,200,6,4,2013-07-16 06:00:00 +2013,7,16,741,743,-2,1022,1103,-41,"UA",1668,"N14228","EWR","SFO",314,2565,7,43,2013-07-16 07:00:00 +2013,7,16,823,830,-7,1000,1015,-15,"EV",4537,"N14993","EWR","MEM",124,946,8,30,2013-07-16 08:00:00 +2013,7,16,952,1000,-8,1415,1430,-15,"HA",51,"N380HA","JFK","HNL",599,4983,10,0,2013-07-16 10:00:00 +2013,7,16,1026,1030,-4,1227,1240,-13,"DL",2343,"N302DQ","EWR","ATL",101,746,10,30,2013-07-16 10:00:00 +2013,7,16,1214,1200,14,1357,1351,6,"US",931,"N109UW","JFK","CLT",74,541,12,0,2013-07-16 12:00:00 +2013,7,16,1925,1900,25,2155,2132,23,"DL",947,"N961DL","LGA","ATL",102,762,19,0,2013-07-16 19:00:00 +2013,7,16,2148,2110,38,2314,2243,31,"B6",702,"N190JB","JFK","BUF",54,301,21,10,2013-07-16 21:00:00 +2013,7,17,553,600,-7,730,806,-36,"EV",4535,"N11176","EWR","MSP",136,1008,6,0,2013-07-17 06:00:00 +2013,7,17,755,752,3,1033,1041,-8,"B6",163,"N329JB","JFK","SRQ",140,1041,7,52,2013-07-17 07:00:00 +2013,7,17,857,900,-3,1029,1025,4,"UA",1171,"N38459","EWR","ORD",99,719,9,0,2013-07-17 09:00:00 +2013,7,17,1020,1029,-9,1137,1209,-32,"EV",4711,"N11565","EWR","STL",119,872,10,29,2013-07-17 10:00:00 +2013,7,17,1032,1029,3,1218,1239,-21,"US",196,"N547UW","JFK","PHX",261,2153,10,29,2013-07-17 10:00:00 +2013,7,17,1155,1200,-5,1314,1314,0,"US",2173,"N747UW","LGA","DCA",39,214,12,0,2013-07-17 12:00:00 +2013,7,17,1229,1230,-1,1507,1520,-13,"WN",40,"N269WN","LGA","HOU",183,1428,12,30,2013-07-17 12:00:00 +2013,7,17,1257,1259,-2,1509,1457,12,"US",1459,"N193UW","LGA","CLT",79,544,12,59,2013-07-17 12:00:00 +2013,7,17,1442,1445,-3,1707,1720,-13,"B6",477,"N292JB","JFK","JAX",112,828,14,45,2013-07-17 14:00:00 +2013,7,17,1612,1555,17,1735,1739,-4,"9E",3459,"N936XJ","JFK","BNA",104,765,15,55,2013-07-17 15:00:00 +2013,7,17,1809,1735,34,1941,1915,26,"WN",19,"N7726A","EWR","STL",116,872,17,35,2013-07-17 17:00:00 +2013,7,17,1823,1715,68,2047,1952,55,"9E",3310,"N925XJ","JFK","MCI",136,1113,17,15,2013-07-17 17:00:00 +2013,7,17,1823,1830,-7,2059,2155,-56,"UA",389,"N554UA","JFK","SFO",307,2586,18,30,2013-07-17 18:00:00 +2013,7,17,1831,1822,9,2121,2155,-34,"UA",1141,"N28457","EWR","SFO",307,2565,18,22,2013-07-17 18:00:00 +2013,7,17,1919,1905,14,2052,2057,-5,"UA",779,"N825UA","EWR","ORD",103,719,19,5,2013-07-17 19:00:00 +2013,7,17,1959,2000,-1,2209,2244,-35,"UA",288,"N413UA","EWR","IAH",166,1400,20,0,2013-07-17 20:00:00 +2013,7,18,753,800,-7,851,909,-18,"B6",1491,"N354JB","JFK","ACK",42,199,8,0,2013-07-18 08:00:00 +2013,7,18,1056,900,116,1301,1120,101,"DL",485,"N321NB","EWR","ATL",101,746,9,0,2013-07-18 09:00:00 +2013,7,18,1059,1044,15,1256,1246,10,"EV",5955,"N16561","EWR","IND",90,645,10,44,2013-07-18 10:00:00 +2013,7,18,1501,1500,1,1600,1612,-12,"US",2132,"N944UW","LGA","BOS",34,184,15,0,2013-07-18 15:00:00 +2013,7,19,641,611,30,1015,954,21,"B6",1403,"N587JB","JFK","SJU",197,1598,6,11,2013-07-19 06:00:00 +2013,7,19,717,720,-3,904,924,-20,"EV",4676,"N17115","EWR","GRR",89,605,7,20,2013-07-19 07:00:00 +2013,7,19,727,730,-3,1018,1045,-27,"VX",183,"N843VA","EWR","SFO",323,2565,7,30,2013-07-19 07:00:00 +2013,7,19,1023,1030,-7,1154,1231,-37,"EV",4412,"N11109","EWR","DSM",133,1017,10,30,2013-07-19 10:00:00 +2013,7,19,1244,1245,-1,1454,1535,-41,"AA",745,"N3HVAA","LGA","DFW",172,1389,12,45,2013-07-19 12:00:00 +2013,7,19,1258,1250,8,1446,1450,-4,"DL",1131,"N335NB","LGA","DTW",82,502,12,50,2013-07-19 12:00:00 +2013,7,19,1512,1452,20,1808,1747,21,"UA",1242,"N37434","EWR","FLL",150,1065,14,52,2013-07-19 14:00:00 +2013,7,19,1556,1555,1,1737,1740,-3,"WN",493,"N785SW","LGA","STL",128,888,15,55,2013-07-19 15:00:00 +2013,7,19,1809,1720,49,2024,1932,52,"EV",3841,"N14974","EWR","CVG",91,569,17,20,2013-07-19 17:00:00 +2013,7,19,1825,1830,-5,2156,2155,1,"UA",389,"N502UA","JFK","SFO",335,2586,18,30,2013-07-19 18:00:00 +2013,7,19,2016,1920,56,2247,2210,37,"AA",1691,"N566AA","EWR","DFW",177,1372,19,20,2013-07-19 19:00:00 +2013,7,19,2337,2028,189,131,2247,164,"B6",135,"N653JB","JFK","PHX",265,2153,20,28,2013-07-19 20:00:00 +2013,7,20,807,815,-8,930,930,0,"MQ",3370,"N856MQ","JFK","DCA",51,213,8,15,2013-07-20 08:00:00 +2013,7,20,810,816,-6,1006,1028,-22,"EV",4380,"N18101","EWR","MSP",153,1008,8,16,2013-07-20 08:00:00 +2013,7,20,1147,1200,-13,1410,1451,-41,"UA",817,"N498UA","EWR","PBI",129,1023,12,0,2013-07-20 12:00:00 +2013,7,20,1402,1405,-3,1523,1550,-27,"AA",337,"N4YHAA","LGA","ORD",112,733,14,5,2013-07-20 14:00:00 +2013,7,20,1451,1450,1,1631,1633,-2,"9E",4115,"N8488D","JFK","IAD",45,228,14,50,2013-07-20 14:00:00 +2013,7,20,1557,1555,2,1845,1900,-15,"DL",2459,"N383DN","JFK","MCO",124,944,15,55,2013-07-20 15:00:00 +2013,7,20,1829,1829,0,2049,2035,14,"US",297,"N547UW","JFK","CLT",76,541,18,29,2013-07-20 18:00:00 +2013,7,20,1931,1905,26,2248,2210,38,"UA",1680,"N30401","EWR","MIA",160,1085,19,5,2013-07-20 19:00:00 +2013,7,20,1938,1805,93,2236,2035,121,"DL",569,"N3760C","JFK","ATL",102,760,18,5,2013-07-20 18:00:00 +2013,7,20,2105,2051,14,44,2358,46,"B6",165,"N599JB","JFK","PDX",327,2454,20,51,2013-07-20 20:00:00 +2013,7,21,626,630,-4,848,904,-16,"B6",1099,"N590JB","LGA","MCO",119,950,6,30,2013-07-21 06:00:00 +2013,7,21,1312,1255,17,1439,1425,14,"WN",546,"N285WN","LGA","MKE",116,738,12,55,2013-07-21 12:00:00 +2013,7,21,1600,1455,65,1825,1645,100,"MQ",2815,"N657MQ","JFK","CLE",89,425,14,55,2013-07-21 14:00:00 +2013,7,21,1658,1550,68,1913,1805,68,"WN",1939,"N441WN","EWR","DEN",222,1605,15,50,2013-07-21 15:00:00 +2013,7,21,1702,1645,17,1836,1815,21,"WN",1795,"N947WN","LGA","MDW",108,725,16,45,2013-07-21 16:00:00 +2013,7,21,2031,1915,76,14,2230,104,"AA",21,"N327AA","JFK","LAX",327,2475,19,15,2013-07-21 19:00:00 +2013,7,21,2110,2000,70,2217,2125,52,"US",2189,"N751UW","LGA","DCA",41,214,20,0,2013-07-21 20:00:00 +2013,7,21,2110,2106,4,2208,2227,-19,"UA",1163,"N73291","EWR","BOS",35,200,21,6,2013-07-21 21:00:00 +2013,7,21,2150,2054,56,26,2328,58,"EV",4645,"N14991","EWR","JAX",118,820,20,54,2013-07-21 20:00:00 +2013,7,21,2211,1930,161,23,2201,142,"EV",4152,"N14907","EWR","ATL",109,746,19,30,2013-07-21 19:00:00 +2013,7,22,646,651,-5,857,905,-8,"UA",343,"N535UA","LGA","DEN",217,1620,6,51,2013-07-22 06:00:00 +2013,7,22,702,710,-8,922,915,7,"MQ",3547,"N722MQ","LGA","XNA",170,1147,7,10,2013-07-22 07:00:00 +2013,7,22,845,1600,1005,1044,1815,989,"MQ",3075,"N665MQ","JFK","CVG",96,589,16,0,2013-07-22 16:00:00 +2013,7,22,1044,1034,10,1211,1206,5,"EV",4662,"N25134","EWR","RDU",74,416,10,34,2013-07-22 10:00:00 +2013,7,22,1700,1635,25,2051,1815,156,"B6",2302,"N324JB","JFK","BUF",57,301,16,35,2013-07-22 16:00:00 +2013,7,22,1831,1655,96,2235,1950,165,"AA",1507,"N517AA","EWR","DFW",181,1372,16,55,2013-07-22 16:00:00 +2013,7,22,2353,2055,178,110,2230,160,"WN",579,"N751SW","LGA","MDW",109,725,20,55,2013-07-22 20:00:00 +2013,7,22,NA,1955,NA,NA,2116,NA,"EV",4969,"N748EV","LGA","MHT",NA,195,19,55,2013-07-22 19:00:00 +2013,7,22,NA,1550,NA,NA,1749,NA,"9E",3523,NA,"JFK","ORD",NA,740,15,50,2013-07-22 15:00:00 +2013,7,22,NA,1950,NA,NA,2130,NA,"AA",363,"N583AA","LGA","ORD",NA,733,19,50,2013-07-22 19:00:00 +2013,7,22,NA,1900,NA,NA,2016,NA,"US",2187,NA,"LGA","DCA",NA,214,19,0,2013-07-22 19:00:00 +2013,7,23,718,630,48,853,835,18,"US",1433,"N565UW","LGA","CLT",82,544,6,30,2013-07-23 06:00:00 +2013,7,23,853,825,28,1035,1017,18,"US",1831,"N554UW","JFK","CLT",77,541,8,25,2013-07-23 08:00:00 +2013,7,23,1227,1155,32,1343,1310,33,"MQ",3386,"N849MQ","JFK","DCA",46,213,11,55,2013-07-23 11:00:00 +2013,7,23,1257,1230,27,1540,1520,20,"WN",40,"N223WN","LGA","HOU",193,1428,12,30,2013-07-23 12:00:00 +2013,7,23,1404,1205,119,1653,1430,143,"MQ",3658,"N534MQ","LGA","ATL",108,762,12,5,2013-07-23 12:00:00 +2013,7,23,1702,1659,3,2009,2012,-3,"UA",1284,"N37434","EWR","SFO",336,2565,16,59,2013-07-23 16:00:00 +2013,7,23,1904,1845,19,2117,2115,2,"DL",245,"N3745B","JFK","PHX",282,2153,18,45,2013-07-23 18:00:00 +2013,7,23,2008,1735,153,2145,1937,128,"YV",2751,"N938LR","LGA","CLT",79,544,17,35,2013-07-23 17:00:00 +2013,7,23,2153,1940,133,2349,2142,127,"EV",4361,"N14974","EWR","TYS",91,631,19,40,2013-07-23 19:00:00 +2013,7,23,NA,1300,NA,NA,1409,NA,"US",2128,NA,"LGA","BOS",NA,184,13,0,2013-07-23 13:00:00 +2013,7,24,633,633,0,908,928,-20,"UA",1701,"N75435","EWR","FLL",131,1065,6,33,2013-07-24 06:00:00 +2013,7,24,700,700,0,830,835,-5,"WN",1696,"N362SW","EWR","STL",129,872,7,0,2013-07-24 07:00:00 +2013,7,24,748,745,3,906,905,1,"WN",3841,"N297WN","EWR","MDW",109,711,7,45,2013-07-24 07:00:00 +2013,7,24,758,801,-3,931,941,-10,"EV",4099,"N18102","EWR","STL",131,872,8,1,2013-07-24 08:00:00 +2013,7,24,1244,1245,-1,1507,1530,-23,"WN",3316,"N241WN","EWR","HOU",188,1411,12,45,2013-07-24 12:00:00 +2013,7,24,1442,1445,-3,1709,1720,-11,"B6",477,"N324JB","JFK","JAX",115,828,14,45,2013-07-24 14:00:00 +2013,7,24,1555,1545,10,1806,1814,-8,"DL",1705,"N346NB","LGA","MSY",162,1183,15,45,2013-07-24 15:00:00 +2013,7,24,1653,1445,128,1831,1642,109,"9E",3318,"N936XJ","JFK","BUF",50,301,14,45,2013-07-24 14:00:00 +2013,7,24,1714,1555,79,1826,1739,47,"9E",3459,"N906XJ","JFK","BNA",108,765,15,55,2013-07-24 15:00:00 +2013,7,24,1823,1819,4,2105,2118,-13,"B6",153,"N562JB","JFK","PBI",130,1028,18,19,2013-07-24 18:00:00 +2013,7,24,2053,1940,73,2308,2142,86,"EV",4361,"N14158","EWR","TYS",95,631,19,40,2013-07-24 19:00:00 +2013,7,24,2101,2057,4,2,2359,3,"UA",1241,"N12218","EWR","TPA",139,997,20,57,2013-07-24 20:00:00 +2013,7,24,2102,2059,3,2233,2225,8,"UA",994,"N819UA","EWR","BOS",33,200,20,59,2013-07-24 20:00:00 +2013,7,24,2113,2114,-1,10,2358,12,"UA",1712,"N77261","EWR","IAH",190,1400,21,14,2013-07-24 21:00:00 +2013,7,24,2126,2030,56,2247,2211,36,"EV",5048,"N605QX","LGA","RIC",51,292,20,30,2013-07-24 20:00:00 +2013,7,24,2134,2129,5,2255,2244,11,"UA",1451,"N75425","EWR","BOS",34,200,21,29,2013-07-24 21:00:00 +2013,7,25,457,500,-3,637,640,-3,"US",1431,"N165US","EWR","CLT",87,529,5,0,2013-07-25 05:00:00 +2013,7,25,608,610,-2,709,725,-16,"WN",273,"N8312C","LGA","MDW",102,725,6,10,2013-07-25 06:00:00 +2013,7,25,830,835,-5,1020,1024,-4,"EV",4519,"N12167","EWR","AVL",89,583,8,35,2013-07-25 08:00:00 +2013,7,25,859,901,-2,1203,1204,-1,"B6",63,"N563JB","JFK","SEA",335,2422,9,1,2013-07-25 09:00:00 +2013,7,25,928,929,-1,1212,1214,-2,"B6",795,"N569JB","JFK","AUS",200,1521,9,29,2013-07-25 09:00:00 +2013,7,25,1156,1200,-4,1515,1507,8,"UA",580,"N557UA","JFK","SFO",347,2586,12,0,2013-07-25 12:00:00 +2013,7,25,1446,1430,16,1822,1735,47,"B6",301,"N516JB","JFK","FLL",153,1069,14,30,2013-07-25 14:00:00 +2013,7,25,2112,2115,-3,2357,2349,8,"DL",1729,"N3742C","JFK","LAS",298,2248,21,15,2013-07-25 21:00:00 +2013,7,25,2228,1939,169,127,2250,157,"UA",206,"N404UA","EWR","SEA",333,2402,19,39,2013-07-25 19:00:00 +2013,7,25,2356,2359,-3,354,350,4,"B6",745,"N775JB","JFK","PSE",211,1617,23,59,2013-07-25 23:00:00 +2013,7,26,624,630,-6,915,923,-8,"UA",712,"N518UA","JFK","LAX",321,2475,6,30,2013-07-26 06:00:00 +2013,7,26,629,630,-1,917,924,-7,"B6",929,"N638JB","JFK","RSW",141,1074,6,30,2013-07-26 06:00:00 +2013,7,26,1055,1100,-5,1205,1213,-8,"US",2171,"N766US","LGA","DCA",43,214,11,0,2013-07-26 11:00:00 +2013,7,26,1248,1250,-2,1452,1450,2,"DL",1131,"N341NB","LGA","DTW",76,502,12,50,2013-07-26 12:00:00 +2013,7,26,1341,1330,11,1625,1625,0,"B6",505,"N579JB","EWR","FLL",139,1065,13,30,2013-07-26 13:00:00 +2013,7,26,1455,1448,7,2005,1717,NA,"EV",4336,"N48901","EWR","ATL",NA,746,14,48,2013-07-26 14:00:00 +2013,7,26,1558,1455,63,1804,1715,49,"DL",127,"N357NB","JFK","DTW",78,509,14,55,2013-07-26 14:00:00 +2013,7,26,1658,1705,-7,1905,1855,10,"AA",345,"N4UCAA","LGA","ORD",120,733,17,5,2013-07-26 17:00:00 +2013,7,26,2034,2030,4,2203,2155,8,"WN",1271,"N770SA","EWR","MDW",103,711,20,30,2013-07-26 20:00:00 +2013,7,26,2127,2001,86,2349,2254,55,"B6",1083,"N597JB","JFK","MCO",122,944,20,1,2013-07-26 20:00:00 +2013,7,26,2244,2245,-1,2350,3,-13,"B6",486,"N368JB","JFK","ROC",45,264,22,45,2013-07-26 22:00:00 +2013,7,27,600,600,0,711,715,-4,"WN",2043,"N200WN","EWR","MDW",103,711,6,0,2013-07-27 06:00:00 +2013,7,27,623,630,-7,905,920,-15,"UA",797,"N554UA","JFK","LAX",320,2475,6,30,2013-07-27 06:00:00 +2013,7,27,749,751,-2,1030,1059,-29,"UA",537,"N401UA","EWR","LAX",319,2454,7,51,2013-07-27 07:00:00 +2013,7,27,830,835,-5,1109,1120,-11,"B6",1783,"N618JB","JFK","MCO",127,944,8,35,2013-07-27 08:00:00 +2013,7,27,900,901,-1,1150,1158,-8,"UA",259,"N496UA","EWR","SAN",318,2425,9,1,2013-07-27 09:00:00 +2013,7,27,1159,1155,4,1454,1455,-1,"AA",2147,"N3APAA","EWR","MIA",148,1085,11,55,2013-07-27 11:00:00 +2013,7,27,1432,1430,2,1745,1735,10,"B6",301,"N507JB","JFK","FLL",145,1069,14,30,2013-07-27 14:00:00 +2013,7,27,1511,1305,126,1702,1457,125,"EV",4471,"N16561","EWR","CLT",86,529,13,5,2013-07-27 13:00:00 +2013,7,27,1513,1520,-7,1656,1705,-9,"AA",2223,"N4WPAA","LGA","STL",133,888,15,20,2013-07-27 15:00:00 +2013,7,27,1826,1830,-4,1955,2025,-30,"EV",5048,"N741EV","LGA","RDU",67,431,18,30,2013-07-27 18:00:00 +2013,7,27,2048,2051,-3,2344,2358,-14,"B6",165,"N658JB","JFK","PDX",315,2454,20,51,2013-07-27 20:00:00 +2013,7,27,2117,2130,-13,2354,14,-20,"B6",1371,"N746JB","LGA","FLL",142,1076,21,30,2013-07-27 21:00:00 +2013,7,28,855,859,-4,1123,1137,-14,"DL",1747,"N932DL","LGA","ATL",115,762,8,59,2013-07-28 08:00:00 +2013,7,28,857,900,-3,1148,1156,-8,"DL",120,"N707TW","JFK","LAX",322,2475,9,0,2013-07-28 09:00:00 +2013,7,28,1115,1115,0,1258,1305,-7,"MQ",3281,"N717MQ","LGA","CMH",79,479,11,15,2013-07-28 11:00:00 +2013,7,28,1313,1315,-2,1507,1505,2,"US",1291,"N105UW","EWR","CLT",88,529,13,15,2013-07-28 13:00:00 +2013,7,28,1743,1725,18,2114,2022,52,"DL",479,"N372DA","EWR","SLC",267,1969,17,25,2013-07-28 17:00:00 +2013,7,28,2000,1930,30,2309,2215,54,"DL",2041,"N333NW","JFK","ATL",121,760,19,30,2013-07-28 19:00:00 +2013,7,28,2158,1959,119,2341,2146,115,"EV",6120,"N27200","LGA","CLE",75,419,19,59,2013-07-28 19:00:00 +2013,7,28,NA,1640,NA,NA,1813,NA,"9E",4013,NA,"JFK","PHL",NA,94,16,40,2013-07-28 16:00:00 +2013,7,29,310,2305,245,402,13,229,"B6",718,"N216JB","JFK","BOS",34,187,23,5,2013-07-29 23:00:00 +2013,7,29,556,600,-4,816,826,-10,"DL",461,"N912DE","LGA","ATL",112,762,6,0,2013-07-29 06:00:00 +2013,7,29,634,630,4,900,912,-12,"UA",1454,"N39726","LGA","IAH",186,1416,6,30,2013-07-29 06:00:00 +2013,7,29,645,650,-5,801,808,-7,"EV",5811,"N13988","EWR","BUF",52,282,6,50,2013-07-29 06:00:00 +2013,7,29,1032,1035,-3,1146,1154,-8,"B6",2602,"N193JB","JFK","BUF",58,301,10,35,2013-07-29 10:00:00 +2013,7,29,1113,1115,-2,1433,1400,33,"AA",739,"N3EHAA","LGA","DFW",186,1389,11,15,2013-07-29 11:00:00 +2013,7,29,1514,1400,74,1610,1511,59,"B6",2480,"N358JB","EWR","BOS",39,200,14,0,2013-07-29 14:00:00 +2013,7,29,1516,1520,-4,1712,1741,-29,"EV",6002,"N15574","EWR","SDF",96,642,15,20,2013-07-29 15:00:00 +2013,7,29,1702,1453,129,2011,1755,136,"B6",1171,"N627JB","LGA","FLL",155,1076,14,53,2013-07-29 14:00:00 +2013,7,29,1730,1720,10,2028,2011,17,"UA",1109,"N76065","EWR","MCO",128,937,17,20,2013-07-29 17:00:00 +2013,7,30,746,750,-4,1026,1030,-4,"AA",715,"N4XRAA","LGA","DFW",192,1389,7,50,2013-07-30 07:00:00 +2013,7,30,959,1005,-6,1113,1120,-7,"MQ",3611,"N542MQ","EWR","ORD",110,719,10,5,2013-07-30 10:00:00 +2013,7,30,1349,1325,24,1514,1500,14,"MQ",3305,"N532MQ","LGA","RDU",64,431,13,25,2013-07-30 13:00:00 +2013,7,30,1441,1310,91,1645,1532,73,"FL",348,"N946AT","LGA","ATL",102,762,13,10,2013-07-30 13:00:00 +2013,7,30,1536,1540,-4,1711,1703,8,"US",1607,"N958UW","LGA","PHL",44,96,15,40,2013-07-30 15:00:00 +2013,7,30,1555,1600,-5,1651,1718,-27,"US",2134,"N950UW","LGA","BOS",34,184,16,0,2013-07-30 16:00:00 +2013,7,30,1843,1820,23,2042,2048,-6,"9E",3472,"N930XJ","JFK","DTW",87,509,18,20,2013-07-30 18:00:00 +2013,7,30,1856,1905,-9,2008,2045,-37,"WN",542,"N271LV","LGA","MKE",117,738,19,5,2013-07-30 19:00:00 +2013,7,30,1907,1909,-2,2132,2200,-28,"UA",1259,"N79279","LGA","IAH",185,1416,19,9,2013-07-30 19:00:00 +2013,7,31,657,700,-3,834,833,1,"UA",544,"N425UA","LGA","ORD",110,733,7,0,2013-07-31 07:00:00 +2013,7,31,700,704,-4,955,1004,-9,"UA",1103,"N39415","EWR","PDX",332,2434,7,4,2013-07-31 07:00:00 +2013,7,31,810,815,-5,943,955,-12,"EV",4872,"N723EV","LGA","RIC",55,292,8,15,2013-07-31 08:00:00 +2013,7,31,858,900,-2,1115,1126,-11,"EV",5109,"N724EV","LGA","CHS",89,641,9,0,2013-07-31 09:00:00 +2013,7,31,910,915,-5,1219,1215,4,"VX",161,"N846VA","EWR","LAX",321,2454,9,15,2013-07-31 09:00:00 +2013,7,31,938,940,-2,1059,1110,-11,"WN",1098,"N489WN","LGA","MKE",111,738,9,40,2013-07-31 09:00:00 +2013,7,31,1115,1120,-5,1225,1233,-8,"B6",208,"N292JB","JFK","PWM",50,273,11,20,2013-07-31 11:00:00 +2013,7,31,1258,1205,53,1533,1430,63,"MQ",3658,"N522MQ","LGA","ATL",117,762,12,5,2013-07-31 12:00:00 +2013,7,31,1414,1410,4,1632,1630,2,"FL",349,"N921AT","LGA","ATL",114,762,14,10,2013-07-31 14:00:00 +2013,7,31,1444,1430,14,1731,1735,-4,"B6",301,"N585JB","JFK","FLL",147,1069,14,30,2013-07-31 14:00:00 +2013,7,31,1452,1455,-3,1638,1701,-23,"9E",4120,"N831AY","JFK","CLE",71,425,14,55,2013-07-31 14:00:00 +2013,7,31,1712,1659,13,1811,1825,-14,"UA",244,"N841UA","EWR","BOS",40,200,16,59,2013-07-31 16:00:00 +2013,7,31,1724,1709,15,1853,1855,-2,"UA",1443,"N16217","LGA","ORD",113,733,17,9,2013-07-31 17:00:00 +2013,7,31,1851,1859,-8,2123,2121,2,"FL",778,"N893AT","LGA","ATL",105,762,18,59,2013-07-31 18:00:00 +2013,7,31,1855,1859,-4,2121,2147,-26,"B6",711,"N568JB","JFK","LAS",297,2248,18,59,2013-07-31 18:00:00 +2013,8,1,655,700,-5,812,833,-21,"UA",544,"N475UA","LGA","ORD",107,733,7,0,2013-08-01 07:00:00 +2013,8,1,828,835,-7,1052,1024,28,"EV",4519,"N12567","EWR","AVL",91,583,8,35,2013-08-01 08:00:00 +2013,8,1,829,830,-1,1038,1028,10,"EV",4297,"N17984","EWR","DTW",80,488,8,30,2013-08-01 08:00:00 +2013,8,1,1726,1605,81,1828,1740,48,"AA",1750,"N3AJAA","JFK","BOS",41,187,16,5,2013-08-01 16:00:00 +2013,8,1,1730,1725,5,2051,2045,6,"AA",221,"N5FRAA","JFK","MIA",160,1089,17,25,2013-08-01 17:00:00 +2013,8,1,1950,1731,139,2110,1849,141,"B6",2580,"N249JB","EWR","BOS",45,200,17,31,2013-08-01 17:00:00 +2013,8,2,854,759,55,1159,1100,59,"UA",518,"N533UA","EWR","LAX",330,2454,7,59,2013-08-02 07:00:00 +2013,8,2,1009,1015,-6,1111,1129,-18,"UA",1163,"N33714","EWR","BOS",45,200,10,15,2013-08-02 10:00:00 +2013,8,2,1237,1240,-3,1518,1545,-27,"UA",1186,"N14107","EWR","MIA",141,1085,12,40,2013-08-02 12:00:00 +2013,8,2,1332,1315,17,1505,1449,16,"EV",4552,"N14171","EWR","GSO",73,445,13,15,2013-08-02 13:00:00 +2013,8,2,1347,1345,2,1625,1635,-10,"AA",753,"N3CAAA","LGA","DFW",187,1389,13,45,2013-08-02 13:00:00 +2013,8,2,1404,1359,5,1635,1636,-1,"UA",1108,"N27205","EWR","IAH",179,1400,13,59,2013-08-02 13:00:00 +2013,8,2,1513,1521,-8,1733,1738,-5,"UA",354,"N572UA","LGA","DEN",239,1620,15,21,2013-08-02 15:00:00 +2013,8,2,1516,1505,11,1746,1758,-12,"UA",503,"N848UA","EWR","AUS",196,1504,15,5,2013-08-02 15:00:00 +2013,8,2,2108,2059,9,2343,2359,-16,"UA",1682,"N57439","EWR","FLL",139,1065,20,59,2013-08-02 20:00:00 +2013,8,2,2145,2057,48,13,2359,14,"UA",1241,"N77258","EWR","TPA",133,997,20,57,2013-08-02 20:00:00 +2013,8,3,841,829,12,1022,1004,18,"MQ",3363,"N805MQ","JFK","RDU",77,427,8,29,2013-08-03 08:00:00 +2013,8,3,1022,1025,-3,1255,1308,-13,"B6",925,"N629JB","JFK","TPA",131,1005,10,25,2013-08-03 10:00:00 +2013,8,3,1105,1015,50,1422,1315,67,"UA",317,"N526UA","EWR","SFO",357,2565,10,15,2013-08-03 10:00:00 +2013,8,3,1120,1120,0,1224,1233,-9,"B6",208,"N328JB","JFK","PWM",48,273,11,20,2013-08-03 11:00:00 +2013,8,3,1129,1130,-1,1247,1256,-9,"EV",4974,"N720EV","LGA","BTV",41,258,11,30,2013-08-03 11:00:00 +2013,8,3,1146,1130,16,1234,1230,4,"EV",3264,"N15983","EWR","ALB",31,143,11,30,2013-08-03 11:00:00 +2013,8,3,1309,1310,-1,1530,1532,-2,"FL",348,"N982AT","LGA","ATL",108,762,13,10,2013-08-03 13:00:00 +2013,8,3,1330,1330,0,1534,1553,-19,"DL",2043,"N333NB","JFK","ATL",102,760,13,30,2013-08-03 13:00:00 +2013,8,3,1357,1405,-8,1458,1516,-18,"B6",2480,"N183JB","EWR","BOS",41,200,14,5,2013-08-03 14:00:00 +2013,8,3,1609,1540,29,2105,1750,NA,"WN",2269,"N446WN","EWR","DEN",NA,1605,15,40,2013-08-03 15:00:00 +2013,8,3,2113,1705,248,2351,2000,231,"DL",503,"N3760C","JFK","SAN",305,2446,17,5,2013-08-03 17:00:00 +2013,8,3,2151,2150,1,38,45,-7,"B6",1201,"N729JB","JFK","FLL",137,1069,21,50,2013-08-03 21:00:00 +2013,8,4,711,700,11,842,835,7,"WN",1696,"N605SW","EWR","STL",133,872,7,0,2013-08-04 07:00:00 +2013,8,4,832,834,-2,1032,1032,0,"B6",219,"N216JB","JFK","CLT",94,541,8,34,2013-08-04 08:00:00 +2013,8,4,1144,1100,44,1421,1349,32,"DL",695,"N906DE","JFK","MCO",133,944,11,0,2013-08-04 11:00:00 +2013,8,4,1545,1543,2,1919,1909,10,"DL",31,"N377DA","JFK","SLC",282,1990,15,43,2013-08-04 15:00:00 +2013,8,4,1619,1445,94,1825,1642,103,"9E",3318,"N905XJ","JFK","BUF",57,301,14,45,2013-08-04 14:00:00 +2013,8,5,738,742,-4,847,857,-10,"B6",8,"N183JB","JFK","PWM",50,273,7,42,2013-08-05 07:00:00 +2013,8,5,1058,1100,-2,1208,1211,-3,"US",2144,"N948UW","LGA","BOS",36,184,11,0,2013-08-05 11:00:00 +2013,8,5,1239,1155,44,1349,1323,26,"EV",4974,"N741EV","LGA","BTV",41,258,11,55,2013-08-05 11:00:00 +2013,8,5,1649,1650,-1,1843,1859,-16,"DL",1473,"N327NB","LGA","MEM",141,963,16,50,2013-08-05 16:00:00 +2013,8,5,1731,1734,-3,2002,1956,6,"FL",771,"N326AT","LGA","ATL",108,762,17,34,2013-08-05 17:00:00 +2013,8,5,1742,1731,11,1903,1849,14,"B6",2580,"N346JB","EWR","BOS",37,200,17,31,2013-08-05 17:00:00 +2013,8,5,2106,2021,45,2252,2200,52,"UA",1464,"N37462","EWR","CLE",65,404,20,21,2013-08-05 20:00:00 +2013,8,5,2132,2129,3,2331,2326,5,"EV",4700,"N17984","EWR","CLT",79,529,21,29,2013-08-05 21:00:00 +2013,8,5,2255,2255,0,15,19,-4,"B6",2002,"N179JB","JFK","BUF",54,301,22,55,2013-08-05 22:00:00 +2013,8,6,659,700,-1,850,900,-10,"9E",3879,"N8674A","EWR","CVG",91,569,7,0,2013-08-06 07:00:00 +2013,8,6,753,800,-7,920,915,5,"US",2171,"N746UW","LGA","DCA",44,214,8,0,2013-08-06 08:00:00 +2013,8,6,836,836,0,1110,1137,-27,"UA",1058,"N23707","LGA","IAH",182,1416,8,36,2013-08-06 08:00:00 +2013,8,6,1015,1015,0,1118,1129,-11,"UA",1163,"N37462","EWR","BOS",38,200,10,15,2013-08-06 10:00:00 +2013,8,6,1057,1105,-8,1302,1314,-12,"DL",1031,"N359NB","LGA","DTW",80,502,11,5,2013-08-06 11:00:00 +2013,8,6,1448,1431,17,1603,1605,-2,"EV",5713,"N833AS","LGA","IAD",53,229,14,31,2013-08-06 14:00:00 +2013,8,6,1517,1520,-3,1640,1705,-25,"AA",2223,"N553AA","LGA","STL",125,888,15,20,2013-08-06 15:00:00 +2013,8,6,1616,1605,11,1930,1925,5,"DL",1394,"N3749D","JFK","PDX",343,2454,16,5,2013-08-06 16:00:00 +2013,8,6,1654,1700,-6,1950,2000,-10,"AA",773,"N4XXAA","LGA","DFW",187,1389,17,0,2013-08-06 17:00:00 +2013,8,6,1732,1705,27,1956,1935,21,"UA",1269,"N13716","EWR","DEN",222,1605,17,5,2013-08-06 17:00:00 +2013,8,6,1758,1800,-2,2015,2039,-24,"DL",61,"N685DA","LGA","ATL",105,762,18,0,2013-08-06 18:00:00 +2013,8,6,1819,1820,-1,2126,2052,34,"9E",3542,"N601LR","JFK","MSP",203,1029,18,20,2013-08-06 18:00:00 +2013,8,6,1824,1830,-6,2021,2038,-17,"DL",2131,"N333NB","LGA","DTW",79,502,18,30,2013-08-06 18:00:00 +2013,8,7,825,830,-5,930,950,-20,"AA",1838,"N3KKAA","JFK","BOS",39,187,8,30,2013-08-07 08:00:00 +2013,8,7,859,901,-2,1215,1204,11,"B6",63,"N605JB","JFK","SEA",348,2422,9,1,2013-08-07 09:00:00 +2013,8,7,905,915,-10,1209,1231,-22,"DL",2379,"N927DA","LGA","FLL",142,1076,9,15,2013-08-07 09:00:00 +2013,8,7,952,957,-5,1150,1201,-11,"US",2075,"N766US","LGA","CLT",80,544,9,57,2013-08-07 09:00:00 +2013,8,7,1134,1133,1,1432,1451,-19,"UA",1201,"N38473","EWR","SFO",342,2565,11,33,2013-08-07 11:00:00 +2013,8,7,1336,1325,11,1803,1801,2,"UA",15,"N67052","EWR","HNL",590,4963,13,25,2013-08-07 13:00:00 +2013,8,7,1839,1800,39,2030,1950,40,"MQ",3526,"N546MQ","LGA","CMH",70,479,18,0,2013-08-07 18:00:00 +2013,8,7,1859,1754,65,2028,1905,83,"EV",4394,"N13202","EWR","DCA",41,199,17,54,2013-08-07 17:00:00 +2013,8,8,912,915,-3,1046,1039,7,"DL",867,"N353NB","JFK","BOS",50,187,9,15,2013-08-08 09:00:00 +2013,8,8,1032,1000,32,1207,1125,42,"EV",5736,"N835AS","LGA","IAD",42,229,10,0,2013-08-08 10:00:00 +2013,8,8,1140,1145,-5,1337,1359,-22,"DL",401,"N302DQ","EWR","ATL",97,746,11,45,2013-08-08 11:00:00 +2013,8,8,1155,1200,-5,1302,1317,-15,"DL",1006,"N338NB","JFK","BOS",42,187,12,0,2013-08-08 12:00:00 +2013,8,8,1242,1245,-3,1507,1535,-28,"AA",745,"N3FHAA","LGA","DFW",178,1389,12,45,2013-08-08 12:00:00 +2013,8,8,2041,1929,72,13,2212,121,"UA",1506,"N37420","EWR","LAS",323,2227,19,29,2013-08-08 19:00:00 +2013,8,8,NA,2155,NA,NA,2329,NA,"EV",3267,"N13994","EWR","ORF",NA,284,21,55,2013-08-08 21:00:00 +2013,8,8,NA,1625,NA,NA,1815,NA,"MQ",3411,"N722MQ","LGA","RDU",NA,431,16,25,2013-08-08 16:00:00 +2013,8,9,545,536,9,808,806,2,"UA",1591,"N24211","EWR","IAH",176,1400,5,36,2013-08-09 05:00:00 +2013,8,9,841,815,26,1008,955,13,"EV",4872,"N738EV","LGA","RIC",55,292,8,15,2013-08-09 08:00:00 +2013,8,9,952,901,51,1328,1204,84,"B6",63,"N621JB","JFK","SEA",343,2422,9,1,2013-08-09 09:00:00 +2013,8,9,1118,1000,78,1431,1307,84,"UA",642,"N505UA","JFK","SFO",346,2586,10,0,2013-08-09 10:00:00 +2013,8,9,1604,1520,44,1738,1636,62,"EV",4580,"N14570","EWR","MKE",125,725,15,20,2013-08-09 15:00:00 +2013,8,9,1832,1830,2,2054,2038,16,"DL",2131,"N340NB","LGA","DTW",82,502,18,30,2013-08-09 18:00:00 +2013,8,9,1910,1901,9,2123,2024,59,"EV",4131,"N12996","EWR","RIC",59,277,19,1,2013-08-09 19:00:00 +2013,8,9,1932,1659,153,2143,1825,198,"UA",244,"N839UA","EWR","BOS",45,200,16,59,2013-08-09 16:00:00 +2013,8,9,2111,1920,111,2230,2045,105,"AA",1762,"N3FBAA","JFK","BOS",50,187,19,20,2013-08-09 19:00:00 +2013,8,10,557,602,-5,837,843,-6,"UA",1289,"N27724","EWR","MCO",132,937,6,2,2013-08-10 06:00:00 +2013,8,10,559,600,-1,746,752,-6,"DL",731,"N357NB","LGA","DTW",86,502,6,0,2013-08-10 06:00:00 +2013,8,10,814,818,-4,955,1014,-19,"EV",3825,"N14916","EWR","CMH",75,463,8,18,2013-08-10 08:00:00 +2013,8,10,830,834,-4,1021,1032,-11,"B6",219,"N265JB","JFK","CLT",85,541,8,34,2013-08-10 08:00:00 +2013,8,10,941,945,-4,1227,1305,-38,"AA",1871,"N3KAAA","LGA","MIA",145,1096,9,45,2013-08-10 09:00:00 +2013,8,10,1103,1105,-2,1252,1313,-21,"DL",1031,"N319NB","LGA","DTW",87,502,11,5,2013-08-10 11:00:00 +2013,8,11,823,825,-2,1115,1104,11,"DL",857,"N380DA","JFK","SAN",322,2446,8,25,2013-08-11 08:00:00 +2013,8,11,1328,1329,-1,1518,1514,4,"EV",4201,"N13969","EWR","MEM",141,946,13,29,2013-08-11 13:00:00 +2013,8,11,1452,1435,17,1651,1642,9,"EV",4572,"N11539","EWR","GSP",92,594,14,35,2013-08-11 14:00:00 +2013,8,11,2019,1825,114,2233,2032,121,"DL",1715,"N325NB","LGA","MSY",156,1183,18,25,2013-08-11 18:00:00 +2013,8,12,628,625,3,901,915,-14,"WN",16,"N708SW","EWR","HOU",189,1411,6,25,2013-08-12 06:00:00 +2013,8,12,638,632,6,855,841,14,"EV",4122,"N18556","EWR","SDF",108,642,6,32,2013-08-12 06:00:00 +2013,8,12,843,800,43,945,909,36,"B6",1491,"N328JB","JFK","ACK",40,199,8,0,2013-08-12 08:00:00 +2013,8,12,957,1000,-3,1132,1133,-1,"UA",673,"N810UA","LGA","ORD",120,733,10,0,2013-08-12 10:00:00 +2013,8,12,1155,1200,-5,1349,1358,-9,"EV",4302,"N14180","EWR","MCI",155,1092,12,0,2013-08-12 12:00:00 +2013,8,12,1156,1155,1,1458,1454,4,"DL",1174,"N399DA","LGA","PBI",134,1035,11,55,2013-08-12 11:00:00 +2013,8,12,1341,1345,-4,1646,1645,1,"AA",117,"N320AA","JFK","LAX",345,2475,13,45,2013-08-12 13:00:00 +2013,8,12,1604,1610,-6,1809,1810,-1,"EV",5461,"N758EV","LGA","RDU",66,431,16,10,2013-08-12 16:00:00 +2013,8,12,1653,1700,-7,1812,1815,-3,"US",2156,"N946UW","LGA","BOS",42,184,17,0,2013-08-12 17:00:00 +2013,8,12,1801,1755,6,2202,2120,42,"AA",177,"N329AA","JFK","SFO",376,2586,17,55,2013-08-12 17:00:00 +2013,8,12,2248,2255,-7,5,19,-14,"B6",2002,"N353JB","JFK","BUF",56,301,22,55,2013-08-12 22:00:00 +2013,8,13,558,600,-2,837,834,3,"B6",27,"N651JB","EWR","MCO",127,937,6,0,2013-08-13 06:00:00 +2013,8,13,710,715,-5,1040,1030,10,"AA",443,"N323AA","JFK","MIA",149,1089,7,15,2013-08-13 07:00:00 +2013,8,13,805,805,0,1131,1055,36,"DL",1109,"N313US","LGA","TPA",146,1010,8,5,2013-08-13 08:00:00 +2013,8,13,1027,1017,10,1147,1124,23,"B6",518,"N351JB","JFK","BOS",41,187,10,17,2013-08-13 10:00:00 +2013,8,13,1505,1456,9,1742,1747,-5,"UA",1289,"N77261","EWR","MCO",137,937,14,56,2013-08-13 14:00:00 +2013,8,13,1516,1525,-9,1640,1642,-2,"EV",4580,"N16963","EWR","MKE",121,725,15,25,2013-08-13 15:00:00 +2013,8,13,1708,1659,9,1931,1919,12,"DL",2042,"N359NB","EWR","ATL",109,746,16,59,2013-08-13 16:00:00 +2013,8,13,NA,1100,NA,NA,1211,NA,"US",2144,NA,"LGA","BOS",NA,184,11,0,2013-08-13 11:00:00 +2013,8,14,1105,1059,6,1352,1336,16,"UA",1712,"N76522","EWR","IAH",203,1400,10,59,2013-08-14 10:00:00 +2013,8,14,1215,1200,15,1512,1450,22,"AA",3,"N319AA","JFK","LAX",331,2475,12,0,2013-08-14 12:00:00 +2013,8,14,1505,1505,0,1849,1835,14,"AA",1769,"N396AA","JFK","MIA",159,1089,15,5,2013-08-14 15:00:00 +2013,8,14,1550,1550,0,1849,1845,4,"AA",763,"N3CHAA","LGA","DFW",190,1389,15,50,2013-08-14 15:00:00 +2013,8,14,1554,1555,-1,1704,1729,-25,"UA",220,"N409UA","EWR","ORD",106,719,15,55,2013-08-14 15:00:00 +2013,8,14,1641,1643,-2,1905,1907,-2,"EV",5601,"N717EV","LGA","CLT",93,544,16,43,2013-08-14 16:00:00 +2013,8,14,1712,1706,6,2154,2111,43,"B6",803,"N630JB","JFK","SJU",202,1598,17,6,2013-08-14 17:00:00 +2013,8,14,1813,1725,48,2139,2045,54,"AA",221,"N5CSAA","JFK","MIA",150,1089,17,25,2013-08-14 17:00:00 +2013,8,15,556,600,-4,646,656,-10,"US",1909,"N950UW","LGA","PHL",31,96,6,0,2013-08-15 06:00:00 +2013,8,15,750,755,-5,911,930,-19,"AA",309,"N4XMAA","LGA","ORD",110,733,7,55,2013-08-15 07:00:00 +2013,8,15,843,843,0,1041,1044,-3,"US",2071,"N746UW","LGA","CLT",89,544,8,43,2013-08-15 08:00:00 +2013,8,15,1101,850,131,1204,1014,110,"9E",3466,"N915XJ","JFK","DCA",40,213,8,50,2013-08-15 08:00:00 +2013,8,15,1158,1200,-2,1350,1354,-4,"US",1879,"N154UW","JFK","CLT",83,541,12,0,2013-08-15 12:00:00 +2013,8,15,1411,1325,46,1538,1505,33,"MQ",3493,"N738MQ","LGA","CLE",62,419,13,25,2013-08-15 13:00:00 +2013,8,15,1429,1429,0,1656,1659,-3,"MQ",3669,"N539MQ","LGA","ATL",119,762,14,29,2013-08-15 14:00:00 +2013,8,15,1506,1459,7,1735,1756,-21,"UA",595,"N823UA","EWR","SAN",314,2425,14,59,2013-08-15 14:00:00 +2013,8,15,1615,1524,51,1833,1807,26,"UA",1178,"N39423","EWR","IAH",183,1400,15,24,2013-08-15 15:00:00 +2013,8,15,1654,1543,71,1921,1840,41,"UA",404,"N504UA","EWR","SEA",300,2402,15,43,2013-08-15 15:00:00 +2013,8,15,1756,1700,56,2050,1955,55,"WN",3928,"N932WN","EWR","HOU",197,1411,17,0,2013-08-15 17:00:00 +2013,8,15,1908,1900,8,2146,2216,-30,"DL",1643,"N711ZX","JFK","SEA",312,2422,19,0,2013-08-15 19:00:00 +2013,8,15,1937,1930,7,2143,2156,-13,"9E",3285,"N917XJ","JFK","MSY",167,1182,19,30,2013-08-15 19:00:00 +2013,8,15,2024,2029,-5,2253,2247,6,"EV",5804,"N14158","EWR","OMA",155,1134,20,29,2013-08-15 20:00:00 +2013,8,15,2122,2119,3,2352,2354,-2,"B6",527,"N703JB","EWR","MCO",127,937,21,19,2013-08-15 21:00:00 +2013,8,16,627,631,-4,907,905,2,"UA",224,"N407UA","LGA","IAH",193,1416,6,31,2013-08-16 06:00:00 +2013,8,16,633,634,-1,836,826,10,"US",745,"N195UW","EWR","CLT",93,529,6,34,2013-08-16 06:00:00 +2013,8,16,725,729,-4,1031,1019,12,"B6",461,"N729JB","LGA","PBI",155,1035,7,29,2013-08-16 07:00:00 +2013,8,16,730,703,27,1004,940,24,"UA",390,"N842UA","EWR","MCO",131,937,7,3,2013-08-16 07:00:00 +2013,8,16,758,800,-2,936,1005,-29,"DL",2119,"N916DL","LGA","MSP",138,1020,8,0,2013-08-16 08:00:00 +2013,8,16,834,825,9,1112,1105,7,"AA",719,"N3CWAA","LGA","DFW",186,1389,8,25,2013-08-16 08:00:00 +2013,8,16,1059,1100,-1,1340,1349,-9,"DL",695,"N991DL","JFK","MCO",138,944,11,0,2013-08-16 11:00:00 +2013,8,16,1150,1155,-5,1301,1310,-9,"MQ",3386,"N836MQ","JFK","DCA",50,213,11,55,2013-08-16 11:00:00 +2013,8,16,1408,1415,-7,1630,1629,1,"DL",673,"N301DQ","EWR","ATL",123,746,14,15,2013-08-16 14:00:00 +2013,8,16,1452,1455,-3,1808,1800,8,"AA",1751,"N3JVAA","JFK","TPA",173,1005,14,55,2013-08-16 14:00:00 +2013,8,16,1604,1555,9,1714,1729,-15,"UA",655,"N449UA","EWR","ORD",109,719,15,55,2013-08-16 15:00:00 +2013,8,16,1708,1710,-2,2004,2015,-11,"AA",181,"N319AA","JFK","LAX",315,2475,17,10,2013-08-16 17:00:00 +2013,8,16,1746,1706,40,2212,2111,61,"B6",803,"N552JB","JFK","SJU",204,1598,17,6,2013-08-16 17:00:00 +2013,8,16,1759,1800,-1,2028,2102,-34,"B6",359,"N621JB","JFK","BUR",311,2465,18,0,2013-08-16 18:00:00 +2013,8,17,755,755,0,917,930,-13,"AA",309,"N4YRAA","LGA","ORD",111,733,7,55,2013-08-17 07:00:00 +2013,8,17,1021,820,121,1225,1041,104,"9E",4105,"N8696C","JFK","CHS",101,636,8,20,2013-08-17 08:00:00 +2013,8,17,1539,1540,-1,1750,1740,10,"US",2081,"N722US","LGA","CLT",100,544,15,40,2013-08-17 15:00:00 +2013,8,17,1721,1729,-8,2012,2055,-43,"VX",193,"N527VA","EWR","SFO",333,2565,17,29,2013-08-17 17:00:00 +2013,8,17,1738,1734,4,2007,2000,7,"FL",623,"N603AT","LGA","ATL",123,762,17,34,2013-08-17 17:00:00 +2013,8,17,2009,1659,190,2155,1920,155,"UA",485,"N820UA","EWR","DEN",204,1605,16,59,2013-08-17 16:00:00 +2013,8,18,540,545,-5,918,921,-3,"B6",939,"N589JB","JFK","BQN",194,1576,5,45,2013-08-18 05:00:00 +2013,8,18,744,750,-6,1011,1030,-19,"AA",715,"N426AA","LGA","DFW",186,1389,7,50,2013-08-18 07:00:00 +2013,8,18,903,906,-3,1139,1152,-13,"UA",436,"N434UA","EWR","IAH",188,1400,9,6,2013-08-18 09:00:00 +2013,8,18,1005,1007,-2,1231,1255,-24,"UA",1412,"N24224","EWR","LAX",308,2454,10,7,2013-08-18 10:00:00 +2013,8,18,1026,1030,-4,1310,1325,-15,"AA",19,"N320AA","JFK","LAX",303,2475,10,30,2013-08-18 10:00:00 +2013,8,18,1250,1250,0,1531,1547,-16,"DL",1375,"N385DN","JFK","SLC",258,1990,12,50,2013-08-18 12:00:00 +2013,8,18,1415,1355,20,1603,1615,-12,"EV",5816,"N13997","EWR","TVC",93,644,13,55,2013-08-18 13:00:00 +2013,8,18,1617,1615,2,1843,1900,-17,"9E",3926,"N8965E","JFK","SDF",109,662,16,15,2013-08-18 16:00:00 +2013,8,18,1804,1805,-1,2051,2040,11,"DL",569,"N3749D","JFK","ATL",124,760,18,5,2013-08-18 18:00:00 +2013,8,18,1817,1825,-8,2122,2147,-25,"AS",7,"N419AS","EWR","SEA",324,2402,18,25,2013-08-18 18:00:00 +2013,8,18,1818,1830,-12,2116,2140,-24,"B6",305,"N805JB","EWR","FLL",140,1065,18,30,2013-08-18 18:00:00 +2013,8,18,2052,2055,-3,2237,2245,-8,"EV",4672,"N29917","EWR","STL",135,872,20,55,2013-08-18 20:00:00 +2013,8,18,2123,2100,23,2215,2210,5,"US",2164,"N967UW","LGA","BOS",36,184,21,0,2013-08-18 21:00:00 +2013,8,19,538,545,-7,811,813,-2,"UA",439,"N585UA","LGA","IAH",184,1416,5,45,2013-08-19 05:00:00 +2013,8,19,1058,1100,-2,1342,1349,-7,"DL",695,"N943DL","JFK","MCO",139,944,11,0,2013-08-19 11:00:00 +2013,8,19,1156,1200,-4,1347,1409,-22,"UA",791,"N821UA","EWR","PHX",278,2133,12,0,2013-08-19 12:00:00 +2013,8,19,1341,1349,-8,1630,1639,-9,"UA",1149,"N15710","EWR","PBI",143,1023,13,49,2013-08-19 13:00:00 +2013,8,19,1523,1519,4,1825,1813,12,"UA",1600,"N58101","EWR","LAX",335,2454,15,19,2013-08-19 15:00:00 +2013,8,19,1558,1559,-1,1843,1910,-27,"DL",706,"N3757D","JFK","AUS",192,1521,15,59,2013-08-19 15:00:00 +2013,8,19,1601,1555,6,1735,1739,-4,"9E",3459,"N605LR","JFK","BNA",113,765,15,55,2013-08-19 15:00:00 +2013,8,19,1629,1630,-1,1948,1959,-11,"VX",27,"N854VA","JFK","SFO",331,2586,16,30,2013-08-19 16:00:00 +2013,8,19,1658,1659,-1,1845,1928,-43,"UA",485,"N459UA","EWR","DEN",203,1605,16,59,2013-08-19 16:00:00 +2013,8,19,1910,1915,-5,2146,2205,-19,"AA",791,"N3GDAA","LGA","DFW",189,1389,19,15,2013-08-19 19:00:00 +2013,8,19,2013,2021,-8,2122,2200,-38,"UA",1464,"N16713","EWR","CLE",58,404,20,21,2013-08-19 20:00:00 +2013,8,20,600,605,-5,848,855,-7,"B6",601,"N659JB","JFK","FLL",147,1069,6,5,2013-08-20 06:00:00 +2013,8,20,1053,1100,-7,1230,1253,-23,"9E",3767,"N8492C","EWR","DTW",76,488,11,0,2013-08-20 11:00:00 +2013,8,20,1109,1115,-6,1224,1254,-30,"EV",5273,"N753EV","LGA","PIT",51,335,11,15,2013-08-20 11:00:00 +2013,8,20,1318,1322,-4,1601,1617,-16,"UA",1164,"N77510","EWR","FLL",146,1065,13,22,2013-08-20 13:00:00 +2013,8,20,1440,1444,-4,1636,1642,-6,"EV",4633,"N14558","EWR","GSP",96,594,14,44,2013-08-20 14:00:00 +2013,8,20,1745,1700,45,1909,1845,24,"MQ",3216,"N694MQ","JFK","ORF",54,290,17,0,2013-08-20 17:00:00 +2013,8,20,2043,2011,32,2315,2254,21,"UA",1416,"N76516","EWR","IAH",198,1400,20,11,2013-08-20 20:00:00 +2013,8,21,557,602,-5,658,729,-31,"UA",569,"N401UA","EWR","ORD",105,719,6,2,2013-08-21 06:00:00 +2013,8,21,558,600,-2,830,815,15,"FL",347,"N168AT","LGA","ATL",116,762,6,0,2013-08-21 06:00:00 +2013,8,21,722,615,67,1027,910,77,"AA",1895,"N3KFAA","EWR","MIA",156,1085,6,15,2013-08-21 06:00:00 +2013,8,21,737,740,-3,1039,1055,-16,"VX",11,"N837VA","JFK","SFO",344,2586,7,40,2013-08-21 07:00:00 +2013,8,21,1500,1505,-5,1650,1710,-20,"EV",4181,"N27152","EWR","MCI",147,1092,15,5,2013-08-21 15:00:00 +2013,8,21,1515,1525,-10,1730,1740,-10,"MQ",3532,"N717MQ","LGA","XNA",157,1147,15,25,2013-08-21 15:00:00 +2013,8,21,1651,1655,-4,1916,1950,-34,"AA",1507,"N454AA","EWR","DFW",178,1372,16,55,2013-08-21 16:00:00 +2013,8,21,2001,2000,1,2222,2230,-8,"DL",1147,"N936DL","LGA","ATL",108,762,20,0,2013-08-21 20:00:00 +2013,8,21,2103,2101,2,48,100,-12,"B6",1103,"N784JB","JFK","SJU",196,1598,21,1,2013-08-21 21:00:00 +2013,8,21,2151,2159,-8,2246,2319,-33,"EV",4625,"N14974","EWR","BWI",32,169,21,59,2013-08-21 21:00:00 +2013,8,22,27,2155,152,308,43,145,"B6",425,"N663JB","JFK","TPA",125,1005,21,55,2013-08-22 21:00:00 +2013,8,22,628,630,-2,851,923,-32,"UA",236,"N595UA","JFK","LAX",298,2475,6,30,2013-08-22 06:00:00 +2013,8,22,800,815,-15,910,935,-25,"MQ",3355,"N502MQ","LGA","BNA",97,764,8,15,2013-08-22 08:00:00 +2013,8,22,801,805,-4,1123,1055,28,"DL",1109,"N320US","LGA","TPA",136,1010,8,5,2013-08-22 08:00:00 +2013,8,22,1028,1030,-2,1401,1345,16,"AA",179,"N339AA","JFK","SFO",326,2586,10,30,2013-08-22 10:00:00 +2013,8,22,1529,1411,78,1837,1702,95,"B6",1883,"N536JB","JFK","MCO",126,944,14,11,2013-08-22 14:00:00 +2013,8,22,1531,1455,36,1755,1645,70,"MQ",3359,"N806MQ","JFK","RDU",68,427,14,55,2013-08-22 14:00:00 +2013,8,22,1613,1535,38,1917,1750,87,"WN",1873,"N949WN","EWR","DEN",271,1605,15,35,2013-08-22 15:00:00 +2013,8,22,1806,1810,-4,1951,2005,-14,"UA",1053,"N17233","EWR","CLE",64,404,18,10,2013-08-22 18:00:00 +2013,8,22,2259,2000,179,57,2225,152,"MQ",3662,"N5PBMQ","LGA","ATL",101,762,20,0,2013-08-22 20:00:00 +2013,8,23,611,614,-3,805,809,-4,"US",2063,"N536UW","JFK","CLT",83,541,6,14,2013-08-23 06:00:00 +2013,8,23,616,620,-4,823,840,-17,"DL",1743,"N3753","JFK","ATL",109,760,6,20,2013-08-23 06:00:00 +2013,8,23,826,834,-8,1022,1032,-10,"EV",3854,"N15980","EWR","DTW",84,488,8,34,2013-08-23 08:00:00 +2013,8,23,1002,1006,-4,1113,1123,-10,"EV",4348,"N26549","EWR","IAD",52,212,10,6,2013-08-23 10:00:00 +2013,8,23,1038,1040,-2,1220,1240,-20,"EV",5512,"N750EV","LGA","MEM",136,963,10,40,2013-08-23 10:00:00 +2013,8,23,1630,1610,20,1903,1845,18,"MQ",3357,"N519MQ","LGA","ATL",105,762,16,10,2013-08-23 16:00:00 +2013,8,23,1653,1705,-12,2007,2020,-13,"AA",1999,"N3KGAA","EWR","MIA",156,1085,17,5,2013-08-23 17:00:00 +2013,8,23,1852,1900,-8,2015,2012,3,"US",2160,"N956UW","LGA","BOS",36,184,19,0,2013-08-23 19:00:00 +2013,8,23,1915,1920,-5,2202,2210,-8,"AA",1691,"N200AA","EWR","DFW",185,1372,19,20,2013-08-23 19:00:00 +2013,8,23,2058,2051,7,11,2358,13,"B6",165,"N641JB","JFK","PDX",328,2454,20,51,2013-08-23 20:00:00 +2013,8,23,2126,2125,1,17,2359,18,"UA",611,"N447UA","EWR","IAH",186,1400,21,25,2013-08-23 21:00:00 +2013,8,24,642,647,-5,803,809,-6,"B6",905,"N563JB","JFK","ORD",109,740,6,47,2013-08-24 06:00:00 +2013,8,24,1055,1055,0,1441,1445,-4,"B6",403,"N621JB","JFK","SJU",201,1598,10,55,2013-08-24 10:00:00 +2013,8,24,1502,1505,-3,1700,1715,-15,"MQ",3402,"N723MQ","LGA","TVC",96,655,15,5,2013-08-24 15:00:00 +2013,8,24,1550,1555,-5,1716,1744,-28,"B6",1105,"N231JB","JFK","ORD",110,740,15,55,2013-08-24 15:00:00 +2013,8,24,1823,1829,-6,2114,2148,-34,"UA",212,"N524UA","EWR","SFO",319,2565,18,29,2013-08-24 18:00:00 +2013,8,25,700,700,0,957,1004,-7,"DL",763,"N191DN","JFK","LAX",314,2475,7,0,2013-08-25 07:00:00 +2013,8,25,749,755,-6,1047,1115,-28,"AA",59,"N323AA","JFK","SFO",340,2586,7,55,2013-08-25 07:00:00 +2013,8,25,953,955,-2,1141,1213,-32,"9E",4060,"N8932C","LGA","DAY",74,549,9,55,2013-08-25 09:00:00 +2013,8,25,1120,1120,0,1226,1230,-4,"B6",34,"N298JB","JFK","BTV",46,266,11,20,2013-08-25 11:00:00 +2013,8,25,1133,1138,-5,1358,1415,-17,"UA",1550,"N41135","EWR","MCO",118,937,11,38,2013-08-25 11:00:00 +2013,8,25,1529,1529,0,1714,1730,-16,"EV",4576,"N11165","EWR","GRR",84,605,15,29,2013-08-25 15:00:00 +2013,8,25,1649,1655,-6,1826,1900,-34,"US",681,"N650AW","EWR","PHX",257,2133,16,55,2013-08-25 16:00:00 +2013,8,25,1828,1815,13,2105,2140,-35,"DL",17,"N195DN","JFK","LAX",306,2475,18,15,2013-08-25 18:00:00 +2013,8,25,1834,1835,-1,2140,2155,-15,"AA",269,"N3GKAA","JFK","SEA",335,2422,18,35,2013-08-25 18:00:00 +2013,8,25,1852,1855,-3,2044,2050,-6,"MQ",3349,"N521MQ","LGA","MSP",144,1020,18,55,2013-08-25 18:00:00 +2013,8,25,2043,2045,-2,2319,2354,-35,"UA",1241,"N13750","EWR","TPA",131,997,20,45,2013-08-25 20:00:00 +2013,8,25,NA,1300,NA,NA,1555,NA,"UA",207,NA,"EWR","SFO",NA,2565,13,0,2013-08-25 13:00:00 +2013,8,26,626,625,1,736,740,-4,"WN",1708,"N8614M","LGA","MDW",103,725,6,25,2013-08-26 06:00:00 +2013,8,26,748,750,-2,1006,1030,-24,"AA",715,"N488AA","LGA","DFW",176,1389,7,50,2013-08-26 07:00:00 +2013,8,26,952,905,47,1122,1111,11,"EV",4172,"N17196","EWR","MSP",137,1008,9,5,2013-08-26 09:00:00 +2013,8,26,1148,1200,-12,1406,1450,-44,"AA",3,"N338AA","JFK","LAX",293,2475,12,0,2013-08-26 12:00:00 +2013,8,26,1151,1200,-9,1257,1309,-12,"US",2146,"N961UW","LGA","BOS",43,184,12,0,2013-08-26 12:00:00 +2013,8,26,1517,1514,3,1628,1648,-20,"UA",253,"N412UA","EWR","ORD",109,719,15,14,2013-08-26 15:00:00 +2013,8,26,1539,1545,-6,1656,1710,-14,"MQ",3694,"N508MQ","EWR","ORD",104,719,15,45,2013-08-26 15:00:00 +2013,8,26,1719,1735,-16,1911,1938,-27,"YV",2751,"N905FJ","LGA","CLT",83,544,17,35,2013-08-26 17:00:00 +2013,8,26,1950,1955,-5,2127,2145,-18,"MQ",3374,"N852MQ","JFK","RDU",64,427,19,55,2013-08-26 19:00:00 +2013,8,26,2054,2100,-6,2155,2214,-19,"US",2197,"N705UW","LGA","DCA",45,214,21,0,2013-08-26 21:00:00 +2013,8,27,555,600,-5,828,851,-23,"B6",371,"N593JB","LGA","FLL",136,1076,6,0,2013-08-27 06:00:00 +2013,8,27,738,745,-7,841,855,-14,"B6",1818,"N587JB","JFK","BOS",35,187,7,45,2013-08-27 07:00:00 +2013,8,27,844,852,-8,1127,1208,-41,"UA",223,"N426UA","EWR","SNA",293,2434,8,52,2013-08-27 08:00:00 +2013,8,27,933,940,-7,1146,1212,-26,"9E",4065,"N8896A","LGA","SDF",96,659,9,40,2013-08-27 09:00:00 +2013,8,27,1033,1038,-5,1230,1247,-17,"EV",4237,"N16183","EWR","OMA",150,1134,10,38,2013-08-27 10:00:00 +2013,8,27,1208,1139,29,1309,1254,15,"B6",1307,"N249JB","JFK","IAD",44,228,11,39,2013-08-27 11:00:00 +2013,8,27,1355,1405,-10,1449,1516,-27,"B6",2480,"N229JB","EWR","BOS",38,200,14,5,2013-08-27 14:00:00 +2013,8,27,1509,1510,-1,1735,1735,0,"MQ",3202,"N606MQ","JFK","IND",94,665,15,10,2013-08-27 15:00:00 +2013,8,27,1520,1527,-7,1655,1701,-6,"UA",274,"N463UA","EWR","CLE",61,404,15,27,2013-08-27 15:00:00 +2013,8,27,1859,1900,-1,2057,2143,-46,"DL",961,"N3746H","JFK","DEN",209,1626,19,0,2013-08-27 19:00:00 +2013,8,28,1123,1125,-2,1249,1300,-11,"WN",1517,"N751SW","LGA","BNA",104,764,11,25,2013-08-28 11:00:00 +2013,8,28,1219,1030,109,1634,1331,183,"UA",1257,"N76528","LGA","IAH",184,1416,10,30,2013-08-28 10:00:00 +2013,8,28,1224,1200,24,1524,1334,110,"UA",255,"N812UA","LGA","ORD",134,733,12,0,2013-08-28 12:00:00 +2013,8,28,1323,1330,-7,1447,1458,-11,"B6",286,"N236JB","JFK","ROC",61,264,13,30,2013-08-28 13:00:00 +2013,8,28,1433,1256,97,1633,1521,72,"EV",4682,"N14105","EWR","MSY",159,1167,12,56,2013-08-28 12:00:00 +2013,8,28,1926,1606,200,2216,1909,187,"B6",283,"N506JB","JFK","MCO",120,944,16,6,2013-08-28 16:00:00 +2013,8,28,2221,2125,56,26,2354,32,"B6",97,"N712JB","JFK","DEN",210,1626,21,25,2013-08-28 21:00:00 +2013,8,28,2223,2100,83,2350,2245,65,"MQ",3384,"N503MQ","LGA","CLT",73,544,21,0,2013-08-28 21:00:00 +2013,8,29,607,611,-4,953,954,-1,"B6",1403,"N627JB","JFK","SJU",202,1598,6,11,2013-08-29 06:00:00 +2013,8,29,659,705,-6,947,955,-8,"AA",707,"N3BUAA","LGA","DFW",175,1389,7,5,2013-08-29 07:00:00 +2013,8,29,706,710,-4,923,957,-34,"UA",478,"N403UA","EWR","MCO",119,937,7,10,2013-08-29 07:00:00 +2013,8,29,801,805,-4,957,950,7,"9E",3611,"N8928A","JFK","PIT",62,340,8,5,2013-08-29 08:00:00 +2013,8,29,813,815,-2,1050,1110,-20,"DL",1167,"N305DQ","JFK","TPA",134,1005,8,15,2013-08-29 08:00:00 +2013,8,29,1322,1325,-3,1601,1627,-26,"UA",483,"N562UA","EWR","FLL",145,1065,13,25,2013-08-29 13:00:00 +2013,8,29,1729,1735,-6,1938,1944,-6,"EV",6065,"N14916","EWR","IND",93,645,17,35,2013-08-29 17:00:00 +2013,8,29,1747,1734,13,2003,2000,3,"FL",623,"N934AT","LGA","ATL",102,762,17,34,2013-08-29 17:00:00 +2013,8,29,1812,1800,12,2002,2011,-9,"DL",1321,"N329NB","EWR","MSP",138,1008,18,0,2013-08-29 18:00:00 +2013,8,29,1820,1828,-8,2026,2034,-8,"US",2039,"N172US","EWR","CLT",79,529,18,28,2013-08-29 18:00:00 +2013,8,29,1935,1945,-10,2135,2156,-21,"EV",4361,"N16981","EWR","TYS",85,631,19,45,2013-08-29 19:00:00 +2013,8,29,2004,2013,-9,2159,2242,-43,"EV",4333,"N12172","EWR","TUL",151,1215,20,13,2013-08-29 20:00:00 +2013,8,29,2047,2100,-13,2328,2323,5,"DL",1247,"N905DE","LGA","ATL",100,762,21,0,2013-08-29 21:00:00 +2013,8,30,653,700,-7,755,833,-38,"UA",331,"N437UA","LGA","ORD",109,733,7,0,2013-08-30 07:00:00 +2013,8,30,1257,1300,-3,1417,1430,-13,"UA",1734,"N41135","EWR","ORD",108,719,13,0,2013-08-30 13:00:00 +2013,8,30,1427,1429,-2,1817,1830,-13,"B6",703,"N703JB","JFK","SJU",198,1598,14,29,2013-08-30 14:00:00 +2013,8,30,1634,1635,-1,1906,1944,-38,"B6",423,"N519JB","JFK","LAX",305,2475,16,35,2013-08-30 16:00:00 +2013,8,30,1645,1650,-5,1818,1859,-41,"DL",1473,"N357NB","LGA","MEM",128,963,16,50,2013-08-30 16:00:00 +2013,8,30,1659,1700,-1,1905,1945,-40,"AA",257,"N624AA","JFK","LAS",280,2248,17,0,2013-08-30 17:00:00 +2013,8,30,1911,1825,46,2035,2009,26,"EV",5207,"N744EV","LGA","BGR",59,378,18,25,2013-08-30 18:00:00 +2013,8,30,2057,2059,-2,2323,2358,-35,"B6",523,"N779JB","JFK","LAX",302,2475,20,59,2013-08-30 20:00:00 +2013,8,31,606,605,1,831,839,-8,"B6",583,"N190JB","JFK","MCO",125,944,6,5,2013-08-31 06:00:00 +2013,8,31,618,620,-2,830,837,-7,"DL",1743,"N373DA","JFK","ATL",104,760,6,20,2013-08-31 06:00:00 +2013,8,31,655,700,-5,922,957,-35,"DL",763,"N713TW","JFK","LAX",299,2475,7,0,2013-08-31 07:00:00 +2013,8,31,843,847,-4,1045,1129,-44,"UA",1289,"N36444","EWR","LAS",283,2227,8,47,2013-08-31 08:00:00 +2013,8,31,913,920,-7,1152,1220,-28,"VX",407,"N634VA","JFK","LAX",315,2475,9,20,2013-08-31 09:00:00 +2013,8,31,926,930,-4,1201,1218,-17,"B6",199,"N521JB","LGA","MCO",118,950,9,30,2013-08-31 09:00:00 +2013,8,31,1958,2001,-3,2248,2254,-6,"B6",1083,"N537JB","JFK","MCO",131,944,20,1,2013-08-31 20:00:00 +2013,9,1,751,800,-9,1035,1104,-29,"B6",1511,"N612JB","EWR","RSW",146,1068,8,0,2013-09-01 08:00:00 +2013,9,1,817,820,-3,1201,1230,-29,"AA",1357,"N5FFAA","JFK","SJU",199,1598,8,20,2013-09-01 08:00:00 +2013,9,1,1503,1510,-7,1615,1630,-15,"MQ",3433,"N503MQ","JFK","DCA",46,213,15,10,2013-09-01 15:00:00 +2013,9,1,1609,1615,-6,1854,1845,9,"MQ",3357,"N519MQ","LGA","ATL",109,762,16,15,2013-09-01 16:00:00 +2013,9,1,1748,1810,-22,1914,1955,-41,"MQ",3526,"N521MQ","LGA","CMH",69,479,18,10,2013-09-01 18:00:00 +2013,9,1,1907,1819,48,2202,2118,44,"B6",153,"N796JB","JFK","PBI",134,1028,18,19,2013-09-01 18:00:00 +2013,9,1,1936,1940,-4,2127,2125,2,"MQ",3374,"N828MQ","JFK","RDU",74,427,19,40,2013-09-01 19:00:00 +2013,9,1,1959,2005,-6,2215,2149,26,"B6",105,"N520JB","JFK","ORD",135,740,20,5,2013-09-01 20:00:00 +2013,9,1,2104,2025,39,2206,2140,26,"AA",1742,"N3BPAA","JFK","BOS",38,187,20,25,2013-09-01 20:00:00 +2013,9,2,711,715,-4,821,840,-19,"WN",1022,"N298WN","EWR","BNA",107,748,7,15,2013-09-02 07:00:00 +2013,9,2,743,726,17,1109,1048,21,"UA",1296,"N38451","EWR","SFO",360,2565,7,26,2013-09-02 07:00:00 +2013,9,2,854,901,-7,1114,1143,-29,"B6",189,"N595JB","JFK","SAN",296,2446,9,1,2013-09-02 09:00:00 +2013,9,2,927,929,-2,1114,1129,-15,"MQ",3565,"N519MQ","LGA","CLT",83,544,9,29,2013-09-02 09:00:00 +2013,9,2,1433,1433,0,1559,1607,-8,"UA",667,"N842UA","EWR","CLE",68,404,14,33,2013-09-02 14:00:00 +2013,9,2,1552,1559,-7,1849,1919,-30,"DL",1373,"N3739P","JFK","MIA",150,1089,15,59,2013-09-02 15:00:00 +2013,9,2,1828,1500,208,2126,1724,242,"EV",5215,"N708EV","LGA","CHS",125,641,15,0,2013-09-02 15:00:00 +2013,9,2,1840,1805,35,2119,2040,39,"DL",569,"N3740C","JFK","ATL",103,760,18,5,2013-09-02 18:00:00 +2013,9,2,1931,1908,23,2223,2220,3,"UA",1515,"N17730","EWR","MIA",146,1085,19,8,2013-09-02 19:00:00 +2013,9,2,2135,2140,-5,2251,2250,1,"MQ",3660,"N519MQ","LGA","BNA",107,764,21,40,2013-09-02 21:00:00 +2013,9,3,603,605,-2,705,734,-29,"UA",1622,"N38403","EWR","ORD",102,719,6,5,2013-09-03 06:00:00 +2013,9,3,610,600,10,725,740,-15,"WN",452,"N792SW","LGA","STL",120,888,6,0,2013-09-03 06:00:00 +2013,9,3,706,710,-4,1026,1025,1,"AA",1345,"N328AA","JFK","MIA",162,1089,7,10,2013-09-03 07:00:00 +2013,9,3,940,939,1,1151,1208,-17,"EV",4140,"N27962","EWR","ATL",116,746,9,39,2013-09-03 09:00:00 +2013,9,3,957,1000,-3,1218,1237,-19,"DL",1847,"N926DL","LGA","ATL",110,762,10,0,2013-09-03 10:00:00 +2013,9,3,1138,1125,13,1245,1300,-15,"WN",1517,"N952WN","LGA","BNA",106,764,11,25,2013-09-03 11:00:00 +2013,9,3,1623,1627,-4,1800,1754,6,"EV",6101,"N12967","LGA","IAD",55,229,16,27,2013-09-03 16:00:00 +2013,9,3,1626,1550,36,1818,1753,25,"EV",4667,"N11193","EWR","MSP",148,1008,15,50,2013-09-03 15:00:00 +2013,9,3,1903,1903,0,2054,2109,-15,"EV",5795,"N18101","EWR","CLT",84,529,19,3,2013-09-03 19:00:00 +2013,9,3,1955,1959,-4,2211,2249,-38,"UA",1022,"N76269","EWR","IAH",171,1400,19,59,2013-09-03 19:00:00 +2013,9,4,817,820,-3,1051,1110,-19,"B6",281,"N231JB","JFK","HOU",182,1428,8,20,2013-09-04 08:00:00 +2013,9,4,852,854,-2,1143,1213,-30,"B6",15,"N505JB","JFK","SFO",323,2586,8,54,2013-09-04 08:00:00 +2013,9,4,1052,1100,-8,1157,1215,-18,"US",2144,"N959UW","LGA","BOS",41,184,11,0,2013-09-04 11:00:00 +2013,9,4,1154,1200,-6,1412,1455,-43,"AA",3,"N336AA","JFK","LAX",300,2475,12,0,2013-09-04 12:00:00 +2013,9,4,1432,1439,-7,1553,1607,-14,"9E",3712,"N8942A","JFK","BWI",36,184,14,39,2013-09-04 14:00:00 +2013,9,4,1649,1700,-11,1925,1955,-30,"WN",3928,"N410WN","EWR","HOU",184,1411,17,0,2013-09-04 17:00:00 +2013,9,4,1704,1640,24,1941,1947,-6,"B6",423,"N635JB","JFK","LAX",307,2475,16,40,2013-09-04 16:00:00 +2013,9,4,1707,1715,-8,1832,1905,-33,"AA",345,"N4XPAA","LGA","ORD",107,733,17,15,2013-09-04 17:00:00 +2013,9,4,1729,1735,-6,1910,1933,-23,"EV",4382,"N16963","EWR","DTW",79,488,17,35,2013-09-04 17:00:00 +2013,9,4,1810,1815,-5,1934,1957,-23,"UA",1053,"N36272","EWR","CLE",67,404,18,15,2013-09-04 18:00:00 +2013,9,4,1951,2000,-9,2047,2114,-27,"US",2162,"N948UW","LGA","BOS",38,184,20,0,2013-09-04 20:00:00 +2013,9,4,1958,2001,-3,2209,2248,-39,"B6",65,"N509JB","JFK","ABQ",227,1826,20,1,2013-09-04 20:00:00 +2013,9,5,807,810,-3,1032,1054,-22,"DL",857,"N384DA","JFK","SAN",305,2446,8,10,2013-09-05 08:00:00 +2013,9,5,946,950,-4,1056,1120,-24,"WN",172,"N277WN","LGA","MKE",110,738,9,50,2013-09-05 09:00:00 +2013,9,5,1012,1020,-8,1310,1309,1,"B6",53,"N536JB","JFK","PBI",140,1028,10,20,2013-09-05 10:00:00 +2013,9,5,1039,929,70,1334,1234,60,"UA",456,"N418UA","EWR","FLL",150,1065,9,29,2013-09-05 09:00:00 +2013,9,5,1101,1105,-4,1217,1215,2,"MQ",3230,"N505MQ","JFK","DCA",49,213,11,5,2013-09-05 11:00:00 +2013,9,5,1354,1400,-6,1453,1507,-14,"US",2150,"N945UW","LGA","BOS",31,184,14,0,2013-09-05 14:00:00 +2013,9,5,1452,1500,-8,1602,1618,-16,"US",2185,"N753US","LGA","DCA",44,214,15,0,2013-09-05 15:00:00 +2013,9,5,1556,1559,-3,1742,1750,-8,"EV",3846,"N26545","EWR","AVL",90,583,15,59,2013-09-05 15:00:00 +2013,9,5,1719,1725,-6,1900,1921,-21,"EV",3850,"N13913","EWR","DAY",83,533,17,25,2013-09-05 17:00:00 +2013,9,5,1725,1730,-5,1919,1950,-31,"EV",5298,"N712EV","LGA","OMA",154,1148,17,30,2013-09-05 17:00:00 +2013,9,5,1854,1900,-6,1952,2014,-22,"US",2160,"N954UW","LGA","BOS",33,184,19,0,2013-09-05 19:00:00 +2013,9,5,2105,2108,-3,2254,2328,-34,"B6",775,"N206JB","JFK","MSY",155,1182,21,8,2013-09-05 21:00:00 +2013,9,5,2150,2049,61,2312,2232,40,"EV",4672,"N13913","EWR","STL",126,872,20,49,2013-09-05 20:00:00 +2013,9,6,610,620,-10,748,818,-30,"EV",5599,"N200PQ","EWR","MSP",141,1008,6,20,2013-09-06 06:00:00 +2013,9,6,643,640,3,746,810,-24,"WN",465,"N400WN","LGA","MKE",103,738,6,40,2013-09-06 06:00:00 +2013,9,6,726,735,-9,1030,1035,-5,"AA",2279,"N3DVAA","LGA","MIA",158,1096,7,35,2013-09-06 07:00:00 +2013,9,6,852,900,-8,1154,1158,-4,"DL",120,"N713TW","JFK","LAX",305,2475,9,0,2013-09-06 09:00:00 +2013,9,6,906,912,-6,1018,1025,-7,"B6",208,"N316JB","JFK","PWM",52,273,9,12,2013-09-06 09:00:00 +2013,9,6,1123,1120,3,1218,1235,-17,"MQ",3704,"N537MQ","EWR","ORD",100,719,11,20,2013-09-06 11:00:00 +2013,9,6,1142,1145,-3,1340,1400,-20,"DL",401,"N324NB","EWR","ATL",100,746,11,45,2013-09-06 11:00:00 +2013,9,6,1241,1247,-6,1550,1535,15,"B6",553,"N527JB","JFK","PBI",161,1028,12,47,2013-09-06 12:00:00 +2013,9,6,1253,1300,-7,1404,1415,-11,"US",2181,"N769US","LGA","DCA",41,214,13,0,2013-09-06 13:00:00 +2013,9,6,1323,1329,-6,1431,1509,-38,"AA",331,"N4XYAA","LGA","ORD",102,733,13,29,2013-09-06 13:00:00 +2013,9,6,1554,1600,-6,1659,1715,-16,"US",2154,"N948UW","LGA","BOS",40,184,16,0,2013-09-06 16:00:00 +2013,9,6,1717,1715,2,1940,2015,-35,"AA",2488,"N4WVAA","EWR","DFW",169,1372,17,15,2013-09-06 17:00:00 +2013,9,6,1732,1734,-2,1939,2000,-21,"FL",623,"N330AT","LGA","ATL",105,762,17,34,2013-09-06 17:00:00 +2013,9,6,1943,1900,43,2235,2151,44,"B6",883,"N715JB","JFK","MCO",128,944,19,0,2013-09-06 19:00:00 +2013,9,7,655,700,-5,924,945,-21,"DL",2285,"N360NB","LGA","MCO",129,950,7,0,2013-09-07 07:00:00 +2013,9,7,721,730,-9,1001,1045,-44,"VX",183,"N853VA","EWR","SFO",320,2565,7,30,2013-09-07 07:00:00 +2013,9,7,809,815,-6,1008,1037,-29,"DL",914,"N365NB","LGA","DEN",205,1620,8,15,2013-09-07 08:00:00 +2013,9,7,1112,1100,12,1212,1218,-6,"US",2177,"N944UW","LGA","DCA",39,214,11,0,2013-09-07 11:00:00 +2013,9,7,1120,1115,5,1402,1428,-26,"9E",3493,"N909XJ","LGA","SRQ",141,1047,11,15,2013-09-07 11:00:00 +2013,9,7,1122,1110,12,1237,1315,-38,"EV",5299,"N710EV","LGA","MEM",117,963,11,10,2013-09-07 11:00:00 +2013,9,7,1142,1145,-3,1340,1357,-17,"DL",401,"N320NB","EWR","ATL",96,746,11,45,2013-09-07 11:00:00 +2013,9,7,1317,1325,-8,1459,1534,-35,"EV",4417,"N16170","EWR","OMA",149,1134,13,25,2013-09-07 13:00:00 +2013,9,7,1323,1329,-6,1433,1444,-11,"MQ",3760,"N517MQ","EWR","ORD",106,719,13,29,2013-09-07 13:00:00 +2013,9,7,1357,1345,12,1649,1700,-11,"AA",1073,"N3DYAA","LGA","MIA",146,1096,13,45,2013-09-07 13:00:00 +2013,9,7,1503,1450,13,1628,1627,1,"9E",3393,"N602LR","JFK","DCA",39,213,14,50,2013-09-07 14:00:00 +2013,9,7,1755,1750,5,2015,2053,-38,"UA",535,"N560UA","JFK","LAX",301,2475,17,50,2013-09-07 17:00:00 +2013,9,7,1815,1629,106,1947,1836,71,"US",423,"N524UW","JFK","CLT",73,541,16,29,2013-09-07 16:00:00 +2013,9,7,2057,2054,3,2354,2359,-5,"B6",523,"N599JB","JFK","LAX",301,2475,20,54,2013-09-07 20:00:00 +2013,9,8,805,815,-10,932,948,-16,"9E",3317,"N931XJ","JFK","BUF",57,301,8,15,2013-09-08 08:00:00 +2013,9,8,1545,1545,0,1846,1855,-9,"DL",31,"N3769L","JFK","SLC",257,1990,15,45,2013-09-08 15:00:00 +2013,9,8,1636,1620,16,1931,1935,-4,"AA",172,"N3ELAA","EWR","MIA",139,1085,16,20,2013-09-08 16:00:00 +2013,9,8,1652,1635,17,1941,1951,-10,"B6",1801,"N537JB","JFK","FLL",137,1069,16,35,2013-09-08 16:00:00 +2013,9,8,1656,1700,-4,1842,1839,3,"UA",689,"N469UA","LGA","ORD",119,733,17,0,2013-09-08 17:00:00 +2013,9,8,1701,1700,1,1935,1955,-20,"AA",211,"N3BRAA","JFK","IAH",176,1417,17,0,2013-09-08 17:00:00 +2013,9,8,1715,1720,-5,1819,1851,-32,"EV",4109,"N10156","EWR","BNA",104,748,17,20,2013-09-08 17:00:00 +2013,9,9,845,850,-5,1111,1144,-33,"UA",1626,"N38473","EWR","SAN",301,2425,8,50,2013-09-09 08:00:00 +2013,9,9,849,835,14,947,1001,-14,"9E",3492,"N905XJ","JFK","DCA",40,213,8,35,2013-09-09 08:00:00 +2013,9,9,1223,1230,-7,1408,1405,3,"AA",329,"N468AA","LGA","ORD",106,733,12,30,2013-09-09 12:00:00 +2013,9,9,1444,1352,52,1537,1453,44,"EV",4201,"N19554","EWR","MHT",37,209,13,52,2013-09-09 13:00:00 +2013,9,9,1542,1550,-8,1800,1818,-18,"9E",3488,"N922XJ","LGA","MCI",145,1107,15,50,2013-09-09 15:00:00 +2013,9,9,1619,1625,-6,1726,1743,-17,"EV",4473,"N11544","EWR","ROC",43,246,16,25,2013-09-09 16:00:00 +2013,9,9,1747,1759,-12,2015,2052,-37,"B6",299,"N623JB","LGA","MCO",120,950,17,59,2013-09-09 17:00:00 +2013,9,9,1818,1820,-2,2013,2041,-28,"9E",4245,"N834AY","JFK","CHS",86,636,18,20,2013-09-09 18:00:00 +2013,9,9,1937,1930,7,2216,2244,-28,"UA",1224,"N24224","EWR","LAX",311,2454,19,30,2013-09-09 19:00:00 +2013,9,9,1956,2000,-4,2138,2211,-33,"EV",4361,"N13964","EWR","TYS",84,631,20,0,2013-09-09 20:00:00 +2013,9,9,2026,2029,-3,2255,2331,-36,"UA",1615,"N35407","EWR","AUS",186,1504,20,29,2013-09-09 20:00:00 +2013,9,10,635,639,-4,833,852,-19,"EV",4122,"N15980","EWR","SDF",94,642,6,39,2013-09-10 06:00:00 +2013,9,10,637,645,-8,906,938,-32,"B6",525,"N503JB","JFK","TPA",133,1005,6,45,2013-09-10 06:00:00 +2013,9,10,739,746,-7,928,943,-15,"B6",1273,"N317JB","JFK","CHS",85,636,7,46,2013-09-10 07:00:00 +2013,9,10,812,817,-5,1103,1127,-24,"B6",929,"N643JB","JFK","RSW",145,1074,8,17,2013-09-10 08:00:00 +2013,9,10,929,929,0,1128,1129,-1,"MQ",3565,"N534MQ","LGA","CLT",73,544,9,29,2013-09-10 09:00:00 +2013,9,10,945,1000,-15,1402,1445,-43,"HA",51,"N383HA","JFK","HNL",601,4983,10,0,2013-09-10 10:00:00 +2013,9,10,1535,1540,-5,1825,1901,-36,"DL",2280,"N909DE","JFK","FLL",144,1069,15,40,2013-09-10 15:00:00 +2013,9,10,1552,1600,-8,1846,1905,-19,"AA",1156,"N3JJAA","LGA","DFW",185,1389,16,0,2013-09-10 16:00:00 +2013,9,10,1557,1545,12,1708,1733,-25,"9E",3459,"N908XJ","JFK","BNA",99,765,15,45,2013-09-10 15:00:00 +2013,9,10,1803,1648,75,2028,1919,69,"EV",4705,"N13123","EWR","ATL",106,746,16,48,2013-09-10 16:00:00 +2013,9,10,1948,2000,-12,2055,2114,-19,"US",2162,"N955UW","LGA","BOS",41,184,20,0,2013-09-10 20:00:00 +2013,9,10,2158,2205,-7,2310,2331,-21,"EV",5311,"N612QX","LGA","BGR",55,378,22,5,2013-09-10 22:00:00 +2013,9,11,15,2245,90,111,2351,80,"B6",1816,"N284JB","JFK","SYR",39,209,22,45,2013-09-11 22:00:00 +2013,9,11,634,640,-6,825,910,-45,"US",621,"N523UW","JFK","PHX",274,2153,6,40,2013-09-11 06:00:00 +2013,9,11,702,710,-8,1002,1025,-23,"AA",1345,"N332AA","JFK","MIA",147,1089,7,10,2013-09-11 07:00:00 +2013,9,11,712,730,-18,946,1045,-59,"VX",183,"N852VA","EWR","SFO",318,2565,7,30,2013-09-11 07:00:00 +2013,9,11,845,850,-5,1102,1108,-6,"UA",1643,"N67134","EWR","DEN",221,1605,8,50,2013-09-11 08:00:00 +2013,9,11,1241,1245,-4,1433,1444,-11,"DL",1131,"N345NW","LGA","DTW",91,502,12,45,2013-09-11 12:00:00 +2013,9,11,1322,1329,-7,1606,1625,-19,"UA",464,"N830UA","EWR","PBI",146,1023,13,29,2013-09-11 13:00:00 +2013,9,11,1331,1325,6,1558,1545,13,"F9",507,"N216FR","LGA","DEN",223,1620,13,25,2013-09-11 13:00:00 +2013,9,11,1455,1455,0,1704,1718,-14,"B6",575,"N317JB","JFK","MSY",153,1182,14,55,2013-09-11 14:00:00 +2013,9,11,1459,1505,-6,1701,1701,0,"EV",4326,"N11184","EWR","CLT",83,529,15,5,2013-09-11 15:00:00 +2013,9,11,1553,1600,-7,1837,1905,-28,"AA",1156,"N3KTAA","LGA","DFW",191,1389,16,0,2013-09-11 16:00:00 +2013,9,11,1639,1627,12,1752,1754,-2,"EV",6101,"N16561","LGA","IAD",43,229,16,27,2013-09-11 16:00:00 +2013,9,12,902,910,-8,1109,1104,5,"DL",1152,"N359NB","EWR","DTW",87,488,9,10,2013-09-12 09:00:00 +2013,9,12,907,910,-3,1206,1215,-9,"AA",1121,"N3DCAA","LGA","DFW",180,1389,9,10,2013-09-12 09:00:00 +2013,9,12,954,1000,-6,1218,1133,45,"FL",353,"N928AT","LGA","CAK",64,397,10,0,2013-09-12 10:00:00 +2013,9,12,1419,1415,4,NA,1550,NA,"AA",1170,"N592AA","LGA","STL",NA,888,14,15,2013-09-12 14:00:00 +2013,9,12,1557,1529,28,NA,1742,NA,"EV",4684,"N14977","EWR","SDF",NA,642,15,29,2013-09-12 15:00:00 +2013,9,12,1657,1659,-2,NA,2006,NA,"UA",1078,"N76516","EWR","SAT",NA,1569,16,59,2013-09-12 16:00:00 +2013,9,12,NA,1520,NA,NA,1705,NA,"AA",341,"N4YAAA","LGA","ORD",NA,733,15,20,2013-09-12 15:00:00 +2013,9,13,616,610,6,724,725,-1,"WN",249,"N915WN","EWR","MDW",110,711,6,10,2013-09-13 06:00:00 +2013,9,13,756,800,-4,1010,1020,-10,"DL",1743,"N3773D","JFK","ATL",104,760,8,0,2013-09-13 08:00:00 +2013,9,13,1005,1005,0,1213,1214,-1,"DL",2319,"N911DE","LGA","MSP",139,1020,10,5,2013-09-13 10:00:00 +2013,9,13,1252,1115,97,1627,1428,119,"9E",3493,"N914XJ","LGA","SRQ",153,1047,11,15,2013-09-13 11:00:00 +2013,9,13,1319,1059,140,1558,1254,184,"MQ",3281,"N724MQ","LGA","CMH",75,479,10,59,2013-09-13 10:00:00 +2013,9,13,1342,1345,-3,1509,1523,-14,"EV",4552,"N48901","EWR","GSO",74,445,13,45,2013-09-13 13:00:00 +2013,9,13,1446,1450,-4,1724,1744,-20,"UA",1200,"N15710","EWR","SAN",320,2425,14,50,2013-09-13 14:00:00 +2013,9,13,1457,1459,-2,1755,1734,21,"DL",2347,"N913DL","LGA","ATL",112,762,14,59,2013-09-13 14:00:00 +2013,9,13,1513,1520,-7,1708,1705,3,"AA",341,"N554AA","LGA","ORD",113,733,15,20,2013-09-13 15:00:00 +2013,9,13,1842,1841,1,2006,2010,-4,"B6",2202,"N197JB","JFK","BUF",59,301,18,41,2013-09-13 18:00:00 +2013,9,13,2033,1935,58,2333,2250,43,"AA",2437,"N3EWAA","LGA","MIA",154,1096,19,35,2013-09-13 19:00:00 +2013,9,13,NA,630,NA,NA,833,NA,"EV",4535,"N27200","EWR","MSP",NA,1008,6,30,2013-09-13 06:00:00 +2013,9,14,524,530,-6,736,808,-32,"UA",1441,"N74856","EWR","IAH",167,1400,5,30,2013-09-14 05:00:00 +2013,9,14,730,735,-5,923,950,-27,"WN",849,"N244WN","EWR","MSY",158,1167,7,35,2013-09-14 07:00:00 +2013,9,14,1326,1325,1,1551,1625,-34,"WN",3133,"N421LV","EWR","AUS",191,1504,13,25,2013-09-14 13:00:00 +2013,9,14,1805,1815,-10,2048,2135,-47,"AA",1611,"N3GKAA","LGA","MIA",142,1096,18,15,2013-09-14 18:00:00 +2013,9,15,658,700,-2,817,835,-18,"WN",329,"N290WN","EWR","STL",125,872,7,0,2013-09-15 07:00:00 +2013,9,15,758,635,83,930,833,57,"US",2023,"N564UW","EWR","CLT",74,529,6,35,2013-09-15 06:00:00 +2013,9,15,830,830,0,1009,1030,-21,"DL",2119,"N322US","LGA","MSP",144,1020,8,30,2013-09-15 08:00:00 +2013,9,15,1227,1235,-8,1445,1503,-18,"UA",1605,"N26208","EWR","LAS",296,2227,12,35,2013-09-15 12:00:00 +2013,9,15,1302,1312,-10,1601,1624,-23,"B6",1639,"N621JB","LGA","RSW",152,1080,13,12,2013-09-15 13:00:00 +2013,9,15,1447,1455,-8,1551,1634,-43,"9E",3393,"N922XJ","JFK","DCA",46,213,14,55,2013-09-15 14:00:00 +2013,9,15,1637,1645,-8,1755,1820,-25,"MQ",3216,"N642MQ","JFK","ORF",53,290,16,45,2013-09-15 16:00:00 +2013,9,15,1651,1655,-4,1823,1845,-22,"AA",2223,"N200AA","LGA","STL",128,888,16,55,2013-09-15 16:00:00 +2013,9,15,1712,1715,-3,1909,1905,4,"AA",345,"N494AA","LGA","ORD",117,733,17,15,2013-09-15 17:00:00 +2013,9,15,1807,1810,-3,2044,2007,37,"EV",4278,"N11547","EWR","CAE",89,602,18,10,2013-09-15 18:00:00 +2013,9,15,1837,1830,7,1958,1950,8,"MQ",3486,"N522MQ","LGA","BNA",105,764,18,30,2013-09-15 18:00:00 diff --git a/radiant.data/tests/testthat/data/jpeg_example.jpeg b/radiant.data/tests/testthat/data/jpeg_example.jpeg new file mode 100644 index 0000000000000000000000000000000000000000..766b8a92dbefe8ff1998e419991fc1bdb7b68efe Binary files /dev/null and b/radiant.data/tests/testthat/data/jpeg_example.jpeg differ diff --git a/radiant.data/tests/testthat/data/js_example.js b/radiant.data/tests/testthat/data/js_example.js new file mode 100644 index 0000000000000000000000000000000000000000..5a1ecdff68e66d6ebc50221ad484fd9450092427 --- /dev/null +++ b/radiant.data/tests/testthat/data/js_example.js @@ -0,0 +1,5 @@ +$(document).keydown(function(event) { + if ($("#rmd_knit").is(":visible") && (event.metaKey || event.ctrlKey) && event.keyCode == 13) { + $("#rmd_knit").click(); + } +}); diff --git a/radiant.data/tests/testthat/data/markdown_example.md b/radiant.data/tests/testthat/data/markdown_example.md new file mode 100644 index 0000000000000000000000000000000000000000..44c761680d7c3901878914c5d250beed597968ba --- /dev/null +++ b/radiant.data/tests/testthat/data/markdown_example.md @@ -0,0 +1,17 @@ +## Sample report + +This is an example of the type of report you can write in Radiant. + +* You can create +* bullet lists + +1. And numbered +2. lists + +Note: Markdown is used to format the report. Go to [commonmark.org](http://commonmark.org/help/) for an interactive tutorial. + +### Math + +You can even include math if you want: + +$$y_t = \alpha + \beta x_t + \epsilon_t.$$ diff --git a/radiant.data/tests/testthat/data/python_example.py b/radiant.data/tests/testthat/data/python_example.py new file mode 100644 index 0000000000000000000000000000000000000000..be53da527d2fb07cb98108818384fec78a74645f --- /dev/null +++ b/radiant.data/tests/testthat/data/python_example.py @@ -0,0 +1,14 @@ +import pandas +import feather + +# Read flights data and select flights to O'Hare +flights = pandas.read_csv("tests/testthat/data/flights.csv") +flights = flights[flights['dest'] == "ORD"] + +# Select carrier and delay columns and drop rows with missing values +flights = flights[['carrier', 'dep_delay', 'arr_delay']] +flights = flights.dropna() +flights.head(10) + +# Write to feather file for reading from R +feather.write_dataframe(flights, "tests/testthat/data/flights.feather") diff --git a/radiant.data/tests/testthat/data/r_example.R b/radiant.data/tests/testthat/data/r_example.R new file mode 100644 index 0000000000000000000000000000000000000000..7b1354d100dc75e532719cbaf2bfce88183e6bb7 --- /dev/null +++ b/radiant.data/tests/testthat/data/r_example.R @@ -0,0 +1,13 @@ +radiant.data::visualize( + diamonds, + xvar = "carat", + yvar = "price", + type = "scatter", + color = "clarity", + custom = TRUE +) + + labs( + title = "Diamond prices", + x = "Carats", + y = "Price ($)" + ) diff --git a/radiant.data/tests/testthat/data/rda_example.rda b/radiant.data/tests/testthat/data/rda_example.rda new file mode 100644 index 0000000000000000000000000000000000000000..4f71067a2656ec0fa898bed7819b8cca0eb767e4 Binary files /dev/null and b/radiant.data/tests/testthat/data/rda_example.rda differ diff --git a/radiant.data/tests/testthat/data/rds_example.rds b/radiant.data/tests/testthat/data/rds_example.rds new file mode 100644 index 0000000000000000000000000000000000000000..8755d94cd165dd38a6a87fab94730f3cbc734850 Binary files /dev/null and b/radiant.data/tests/testthat/data/rds_example.rds differ diff --git a/radiant.data/tests/testthat/data/sql_example.sql b/radiant.data/tests/testthat/data/sql_example.sql new file mode 100644 index 0000000000000000000000000000000000000000..000de666a0fc3d2e36614dd5197d911e513e0870 --- /dev/null +++ b/radiant.data/tests/testthat/data/sql_example.sql @@ -0,0 +1 @@ +SELECT * FROM sleep diff --git a/radiant.data/tests/testthat/data/sqlite_example.sqlite b/radiant.data/tests/testthat/data/sqlite_example.sqlite new file mode 100644 index 0000000000000000000000000000000000000000..a63cb4a7ce50c5924d22cfb47cb92ab40c5e0c70 Binary files /dev/null and b/radiant.data/tests/testthat/data/sqlite_example.sqlite differ diff --git a/radiant.data/tests/testthat/data/tsv_example.tsv b/radiant.data/tests/testthat/data/tsv_example.tsv new file mode 100644 index 0000000000000000000000000000000000000000..3017ee811a99ce1be28cb005d1f561abd5b42145 --- /dev/null +++ b/radiant.data/tests/testthat/data/tsv_example.tsv @@ -0,0 +1 @@ +name alignment gender publisher Magneto bad male Marvel Storm good female Marvel Mystique bad female Marvel Batman good male DC Joker bad male DC Catwoman bad female DC Hellboy good male Dark Horse Comics \ No newline at end of file diff --git a/radiant.data/tests/testthat/data/unknow_example.unknown b/radiant.data/tests/testthat/data/unknow_example.unknown new file mode 100644 index 0000000000000000000000000000000000000000..2f7c31c83762f402e757a62389458373e30e071d --- /dev/null +++ b/radiant.data/tests/testthat/data/unknow_example.unknown @@ -0,0 +1 @@ +Unknown content type \ No newline at end of file diff --git a/radiant.data/tests/testthat/data/xlsx_example.xlsx b/radiant.data/tests/testthat/data/xlsx_example.xlsx new file mode 100644 index 0000000000000000000000000000000000000000..c7b684b4179c79454551860f7ef7be29be92becb Binary files /dev/null and b/radiant.data/tests/testthat/data/xlsx_example.xlsx differ diff --git a/radiant.data/tests/testthat/data/yaml_example.yaml b/radiant.data/tests/testthat/data/yaml_example.yaml new file mode 100644 index 0000000000000000000000000000000000000000..b27a7228e7589c13e10f26f91bc0412efa4ff8b2 --- /dev/null +++ b/radiant.data/tests/testthat/data/yaml_example.yaml @@ -0,0 +1,18 @@ +name: Sign contract +variables: + legal fees: 5000 +type: decision +Sign with Movie Company: + cost: legal fees + type: chance + Small Box Office: + p: 0.3 + payoff: 200000 + Medium Box Office: + p: 0.6 + payoff: 1000000 + Large Box Office: + p: 0.1 + payoff: 3000000 +Sign with TV Network: + payoff: 900000 diff --git a/radiant.data/tests/testthat/test_funs.R b/radiant.data/tests/testthat/test_funs.R new file mode 100644 index 0000000000000000000000000000000000000000..7e9f8742b2724f572c7bd8402c8aa1ddeac70faa --- /dev/null +++ b/radiant.data/tests/testthat/test_funs.R @@ -0,0 +1,225 @@ +library(radiant.data) +library(testthat) + +context("R deparse") + +## See https://stackoverflow.com/questions/50422627/different-results-from-deparse-in-r-3-4-4-and-r-3-5 +test_that("deparse R 3.4.4 vs R 3.5", { + dctrl <- if (getRversion() > "3.4.4") c("keepNA", "niceNames") else "keepNA" + expect_equal(deparse(list(dec = 4L, b = "a"), control = dctrl), "list(dec = 4, b = \"a\")") +}) + +context("Radiant functions") + +test_that("set_attr", { + foo <- . %>% set_attr("foo", "something") + expect_equal(3 %>% foo() %>% attr("foo"), "something") +}) + +test_that("add_class", { + foo <- . %>% + .^2 %>% + add_class("foo") + expect_equal(3 %>% foo() %>% class(), c("foo", "numeric")) +}) + +test_that("sig_star", { + sig_stars(c(.0009, .049, .009, .4, .09)) %>% + expect_equal(c("***", "*", "**", "", ".")) +}) + +test_that("sshh", { + expect_equal(sshh(c(message("should be null"), test = 3)), NULL) + expect_equal(sshh(warning("should be null")), NULL) +}) + +test_that("sshhr", { + test <- 3 %>% set_names("test") + expect_equal(sshhr(c(message("should be null"), test = 3)), test) + expect_equal(sshhr(c(warning("should be null"), test = 3)), c("should be null", test)) +}) + +test_that("get_data", { + res1 <- get_data(mtcars, "mpg:disp", filt = "mpg > 20", rows = 1:5) + rownames(res1) <- seq_len(nrow(res1)) + res2 <- mtcars[mtcars$mpg > 20, c("mpg", "cyl", "disp")][1:5, 1:3] + rownames(res2) <- seq_len(nrow(res2)) + expect_equal(res1, res2) +}) + +test_that("get_class", { + expect_equal(get_class(diamonds), sapply(diamonds, class) %>% tolower()) +}) + +test_that("is.empty(", { + expect_true(is.empty("")) + expect_true(is.empty(NULL)) + expect_true(is.empty(NA)) + expect_false(is.empty(3)) + expect_true(is.empty(c())) + expect_true(is.empty("nothing", empty = "nothing")) +}) + +test_that("select column", { + dataset <- get_data(diamonds, vars = "price:clarity") + expect_equal(colnames(dataset), c("price", "carat", "clarity")) +}) + +test_that("select character vector", { + dataset <- get_data(diamonds, vars = c("price", "carat", "clarity")) + expect_equal(colnames(dataset), c("price", "carat", "clarity")) +}) + +test_that("filter", { + dataset <- get_data(diamonds, filt = "cut == 'Very Good'") + expect_equal(nrow(dataset), 677) +}) + +test_that("filter_data", { + dataset <- filter_data(diamonds, filt = "cut == 'Very Good' & price > 5000") + expect_equal(nrow(dataset), 187) + expect_equal(sum(dataset$price), 1700078) +}) + +test_that("filter_data factor", { + dataset <- filter_data(diamonds, filt = "clarity %in% c('SI2','SI1') & price > 18000") + expect_equal(nrow(dataset), 14) + expect_equal(sum(dataset$price), 256587) +}) + +context("Explore") + +test_that("explore 8 x 2", { + result <- explore(diamonds, "price:x") + expect_equal(colnames(result$tab), c("variable", "mean", "sd")) + # dput(result) + expect_equal(result, structure(list( + tab = structure(list( + variable = structure(1:8, + .Label = c("price", "carat", "clarity", "cut", "color", "depth", "table", "x"), class = "factor" + ), + mean = c( + 3907.186, 0.794283333333333, 0.0133333333333333, + 0.0336666666666667, 0.127333333333333, 61.7526666666667, + 57.4653333333333, 5.72182333333333 + ), sd = c( + 3956.91540005997, + 0.473826329139292, 0.114716791286006, 0.180399751234967, + 0.333401571319236, 1.44602785395269, 2.24110219949434, 1.12405453974662 + ) + ), class = "data.frame", row.names = c(NA, -8L), radiant_nrow = 8L), + df_name = "diamonds", vars = c( + "price", "carat", "clarity", + "cut", "color", "depth", "table", "x" + ), byvar = NULL, fun = c( + "mean", + "sd" + ), top = "fun", tabfilt = "", tabsort = "", tabslice = "", + nr = Inf, data_filter = "", arr = "", rows = NULL + ), class = c("explore", "list"))) +}) + +test_that("explore 1 x 2", { + result <- explore(diamonds, "price") + expect_equal(result, structure(list( + tab = structure(list( + variable = structure(1L, .Label = "price", class = "factor"), + mean = 3907.186, sd = 3956.91540005997 + ), class = "data.frame", row.names = c( + NA, + -1L + ), radiant_nrow = 1L), df_name = "diamonds", vars = "price", byvar = NULL, + fun = c("mean", "sd"), top = "fun", tabfilt = "", tabsort = "", tabslice = "", + nr = Inf, data_filter = "", arr = "", rows = NULL + ), class = c( + "explore", + "list" + ))) +}) + +test_that("explore 1 x 1", { + result <- explore(diamonds, "price", fun = "n_obs") + expect_equal(colnames(result$tab), c("variable", "n_obs")) +}) + +test_that("explore 1 x 1 x 1", { + result <- explore(diamonds, "price", byvar = "color", fun = "n_obs") + expect_equal(colnames(result$tab), c("color", "variable", "n_obs")) +}) + +test_that("explore 1 x 1 x 2", { + result <- explore(diamonds, "price", byvar = c("color", "cut"), fun = "n_obs") + expect_equal(colnames(result$tab), c("color", "cut", "variable", "n_obs")) + expect_equal(result$tab[1, ], structure(list( + color = structure(1L, .Label = c( + "D", "E", "F", + "G", "H", "I", "J" + ), class = "factor"), cut = structure(1L, .Label = c( + "Fair", + "Good", "Very Good", "Premium", "Ideal" + ), class = "factor"), + variable = structure(1L, .Label = "price", class = "factor"), + n_obs = 15L + ), radiant_nrow = 35L, row.names = 1L, class = "data.frame")) +}) + +test_that("explore 2 x 2 x 2", { + result <- explore(diamonds, c("price", "carat"), byvar = c("color", "cut"), fun = c("n_obs", "mean")) + expect_equal(colnames(result$tab), c("color", "cut", "variable", "n_obs", "mean")) +}) + +test_that("transform ts", { + input <- list( + tr_ts_start_year = 1971, + tr_ts_start_period = 1, + tr_ts_end_year = NA, + tr_ts_end_period = NA, + tr_ts_frequency = 52 + ) + tr_ts <- list( + start = c(input$tr_ts_start_year, input$tr_ts_start_period), + end = c(input$tr_ts_end_year, input$tr_ts_end_period), + frequency = input$tr_ts_frequency + ) + tr_ts <- lapply(tr_ts, function(x) x[!is.na(x)]) %>% + { + .[sapply(., length) > 0] + } + dat <- do.call(mutate_at, c(list(.tbl = mtcars, .vars = c("mpg", "cyl")), .funs = ts, tr_ts)) + + expect_equal(dat$mpg, ts(mtcars$mpg, start = c(1971, 1), frequency = 52)) + expect_equal(dat$cyl, ts(mtcars$cyl, start = c(1971, 1), frequency = 52)) + + dctrl <- if (getRversion() > "3.4.4") c("keepNA", "niceNames") else "keepNA" + + tr_ts <- deparse(tr_ts, control = dctrl, width.cutoff = 500L) %>% + sub("list\\(", ", ", .) %>% + sub("\\)$", "", .) + + expect_equal(tr_ts, ", start = c(1971, 1), frequency = 52") +}) + +## 'manual' testing of read_files to avoid adding numerous dataset to package +# files <- list.files("tests/testthat/data", full.names = TRUE) +# for (f in files) { +# radiant.data::read_files(f, type = "rmd", clipboard = FALSE) +# radiant.data::read_files(f, type = "r", clipboard = FALSE) +# } + +## 'manual' testing with Dropbox folder +# files <- list.files("~/Dropbox/radiant.data/data", full.names = TRUE) +# for (f in files) { +# radiant.data::read_files(f, type = "rmd", clipboard = FALSE) +# radiant.data::read_files(f, type = "r", clipboard = FALSE) +# } + +## 'manual' testing with Google Drive folder +# files <- list.files("~/Google Drive/radiant.data/data", full.names = TRUE) +# for (f in files) { +# radiant.data::read_files(f, type = "rmd", clipboard = FALSE) +# radiant.data::read_files(f, type = "r", clipboard = FALSE) +# } + +## load code into clipboard +# radiant.data::read_files(type = "r") +# radiant.data::read_files(type = "rmd") \ No newline at end of file diff --git a/radiant.data/vignettes/pkgdown/_combine.Rmd b/radiant.data/vignettes/pkgdown/_combine.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..8bb9c11957a8a51c546758817859880d492df659 --- /dev/null +++ b/radiant.data/vignettes/pkgdown/_combine.Rmd @@ -0,0 +1,314 @@ +> Combine two datasets + +There are six _join_ (or _merge_) options available in Radiant from the dplyr package developed by Hadley Wickham et.al. + +The examples below are adapted from the Cheatsheet for dplyr join functions by Jenny Bryan and focus on three small datasets, `superheroes`, `publishers`, and `avengers`, to illustrate the different _join_ types and other ways to combine datasets in R and Radiant. The data are also available in csv format through the links below: + +* superheroes.csv +* publishers.csv +* avengers.csv + +```{r results = 'asis', echo = FALSE} +tab_small <- "class='table table-condensed table-hover' style='width:30%;'" +tab_big <- "class='table table-condensed table-hover' style='width:70%;'" +data(superheroes, package = "radiant.data", envir = environment()) +knitr::kable( + superheroes, align = 'l', format = 'html', + caption = "Superheroes", table.attr = tab_big +) +``` + +```{r results = 'asis', echo = FALSE} +data(publishers, package = "radiant.data", envir = environment()) +knitr::kable( + publishers, align = 'l', format = 'html', + caption = "Publishers", table.attr = tab_small +) +``` + +In the screen-shot of the _Data > Combine_ tab below we see the two datasets. The tables share the variable _publisher_ which is automatically selected for the join. Different join options are available from the `Combine type` dropdown. You can also specify a name for the combined dataset in the `Combined dataset` text input box. + +

    + +
    + +### Inner join (superheroes, publishers) + +If x = superheroes and y = publishers: + +> An inner join returns all rows from x with matching values in y, and all columns from both x and y. If there are multiple matches between x and y, all match combinations are returned. + +```{r results = 'asis', echo = FALSE} +dplyr::inner_join(superheroes, publishers, by = "publisher") %>% + knitr::kable(., align = 'l', format = 'html', table.attr = tab_big) +``` + +In the table above we lose _Hellboy_ because, although this hero does appear in `superheroes`, the publisher (_Dark Horse Comics_) does not appear in `publishers`. The join result has all variables from `superheroes`, plus _yr\_founded_, from `publishers`. We can visualize an inner join with the venn-diagram below: + +

    + +The R(adiant) commands are: + +```r +# Radiant +combine_data(superheroes, publishers, by = "publisher", type = "inner_join") + +# R +inner_join(superheroes, publishers, by = "publisher") +``` + +
    + +### Left join (superheroes, publishers) + +> A left join returns all rows from x, and all columns from x and y. If there are multiple matches between x and y, all match combinations are returned. + +```{r results = 'asis', echo = FALSE} +dplyr::left_join(superheroes, publishers, by = "publisher") %>% + knitr::kable(., align = 'l', format = 'html', table.attr = tab_big) +``` + +The join result contains `superheroes` with variable `yr_founded` from `publishers`. _Hellboy_, whose publisher does not appear in `publishers`, has an `NA` for _yr_founded_. We can visualize a left join with the venn-diagram below: + +

    + +The R(adiant) commands are: + +```r +# Radiant +combine_data(superheroes, publishers, by = "publisher", type = "left_join") + +# R +left_join(superheroes, publishers, by = "publisher") +``` + +
    + +### Right join (superheroes, publishers) + +> A right join returns all rows from y, and all columns from y and x. If there are multiple matches between y and x, all match combinations are returned. + +```{r results = 'asis', echo = FALSE} +dplyr::right_join(superheroes, publishers, by = "publisher") %>% + knitr::kable(., align = 'l', format = 'html', table.attr = tab_big) +``` + +The join result contains all rows and columns from `publishers` and all variables from `superheroes`. We lose _Hellboy_, whose publisher does not appear in `publishers`. _Image_ is retained in the table but has `NA` values for the variables _name_, _alignment_, and _gender_ from `superheroes`. Notice that a join can change both the row and variable order so you should not rely on these in your analysis. We can visualize a right join with the venn-diagram below: + +

    + +The R(adiant) commands are: + +```r +# Radiant +combine_data(superheroes, publishers, by = "publisher", type = "right_join") + +# R +right_join(superheroes, publishers, by = "publisher") +``` + +
    + +### Full join (superheroes, publishers) + +> A full join combines two datasets, keeping rows and columns that appear in either. + +```{r results = 'asis', echo = FALSE} +dplyr::full_join(superheroes, publishers, by = "publisher") %>% + knitr::kable(., align = 'l', format = 'html', table.attr = tab_big) +``` + +In this table we keep _Hellboy_ (even though _Dark Horse Comics_ is not in `publishers`) and _Image_ (even though the publisher is not listed in `superheroes`) and get variables from both datasets. Observations without a match are assigned the value NA for variables from the _other_ dataset. We can visualize a full join with the venn-diagram below: + +

    + +The R(adiant) commands are: + +```r +# Radiant +combine_data(superheroes, publishers, by = "publisher", type = "full_join") + +# R +full_join(superheroes, publishers, by = "publisher") +``` + +### Semi join (superheroes, publishers) + +> A semi join keeps only columns from x. Whereas an inner join will return one row of x for each matching row of y, a semi join will never duplicate rows of x. + +```{r results = 'asis', echo = FALSE} +dplyr::semi_join(superheroes, publishers, by = "publisher") %>% + knitr::kable(., align = 'l', format = 'html', table.attr = tab_big) +``` + +We get a similar table as with `inner_join` but it contains only the variables in `superheroes`. The R(adiant) commands are: + +```r +# Radiant +combine_data(superheroes, publishers, by = "publisher", type = "semi_join") + +# R +semi_join(superheroes, publishers, by = "publisher") +``` + +
    + +### Anti join (superheroes, publishers) + +> An anti join returns all rows from x without matching values in y, keeping only columns from x + +```{r results = 'asis', echo = FALSE} +dplyr::anti_join(superheroes, publishers, by = "publisher") %>% + knitr::kable(., align = 'l', format = 'html', table.attr = tab_big) +``` + +We now get **only** _Hellboy_, the only superhero not in `publishers` and we do not get the variable _yr\_founded_ either. We can visualize an anti join with the venn-diagram below: + +

    + +
    + +### Dataset order + +Note that the order of the datasets selected may matter for a join. If we setup the _Data > Combine_ tab as below the results are as follows: + +

    + +
    + +### Inner join (publishers, superheroes) + +```{r results = 'asis', echo = FALSE} +dplyr::inner_join(publishers, superheroes, by = "publisher") %>% + knitr::kable(., align = 'l', format = 'html', table.attr = tab_big) +``` + +Every publisher that has a match in `superheroes` appears multiple times, once for each match. Apart from variable and row order, this is the same result we had for the inner join shown above. + +
    + +### Left and Right join (publishers, superheroes) + +Apart from row and variable order, a left join of `publishers` and `superheroes` is equivalent to a right join of `superheroes` and `publishers`. Similarly, a right join of `publishers` and `superheroes` is equivalent to a left join of `superheroes` and `publishers`. + +
    + +### Full join (publishers, superheroes) + +As you might expect, apart from row and variable order, a full join of `publishers` and `superheroes` is equivalent to a full join of `superheroes` and `publishers`. + +
    + +### Semi join (publishers, superheroes) + +```{r results = 'asis', echo = FALSE} +dplyr::semi_join(publishers, superheroes, by = "publisher") %>% + knitr::kable(., align = 'l', format = 'html', table.attr = tab_small) +``` + +With semi join the effect of switching the dataset order is more clear. Even though there are multiple matches for each publisher only one is shown. Contrast this with an inner join where "If there are multiple matches between x and y, all match combinations are returned." We see that publisher _Image_ is lost in the table because it is not in `superheroes`. + +
    + +### Anti join (publishers, superheroes) + +```{r results = 'asis', echo = FALSE} +dplyr::anti_join(publishers, superheroes, by = "publisher") %>% + knitr::kable(., align = 'l', format = 'html', table.attr = tab_small) +``` + +Only publisher _Image_ is retained because both _Marvel_ and _DC_ are in `superheroes`. We keep only variables in `publishers`. + +
    + +### Additional tools to combine datasets (avengers, superheroes) + +When two datasets have the same columns (or rows) there are additional ways in which we can combine them into a new dataset. We have already used the `superheroes` dataset and will now try to combine it with the `avengers` data. These two datasets have the same number of rows and columns and the columns have the same names. + +In the screen-shot of the _Data > Combine_ tab below we see the two datasets. There is no need to select variables to combine the datasets here. Any variables in `Select variables` are ignored in the commands below. Again, you can specify a name for the combined dataset in the `Combined dataset` text input box. + +

    + +
    + +### Bind rows + +```{r results = 'asis', echo = FALSE} +data(avengers, package = "radiant.data", envir = environment()) +dplyr::bind_rows(avengers, superheroes) %>% + knitr::kable(., align = 'l', format = 'html', table.attr = tab_big) +``` + +If the `avengers` dataset were meant to extend the list of superheroes we could just stack the two datasets, one below the other. The new datasets has 14 rows and 4 columns. Due to a coding error in the `avengers` dataset (i.e.., _Magneto_ is *not* an _Avenger_) there is a duplicate row in the new combined dataset. Something we probably don't want. + +The R(adiant) commands are: + +```r +# Radiant +combine_data(avengers, superheroes, type = "bind_rows") + +# R +bind_rows(avengers, superheroes) +``` + +
    + +### Bind columns + +```{r results = 'asis', echo = FALSE} +dplyr::bind_cols(avengers, superheroes) %>% + knitr::kable(., align = 'l', format = 'html', table.attr = tab_big) +``` + +If the dataset had different columns for the same superheroes we could combine the two datasets, side by side. In radiant you will see an error message if you try to bind these columns because they have the same name. Something that we should always avoid. The method can be useful if we *know* the order of the row ids of two dataset are the same but the columns are all different. + +
    + +### Intersect + +```{r results = 'asis', echo = FALSE} +dplyr::intersect(avengers, superheroes) %>% + knitr::kable(., align = 'l', format = 'html', table.attr = tab_big) +``` + +A good way to check if two datasets with the same columns have duplicate rows is to choose `intersect` from the `Combine type` dropdown. There is indeed one row that is identical in the `avengers` and `superheroes` data (i.e., _Magneto_). + +The R(adiant) commands are the same as shown above, except you will need to replace `bind_rows` by `intersect`. + +
    + +### Union + +```{r results = 'asis', echo = FALSE} +dplyr::union(avengers, superheroes) %>% + knitr::kable(., align = 'l', format = 'html', table.attr = tab_big) +``` + +A `union` of `avengers` and `superheroes` will combine the datasets but will omit duplicate rows (i.e., it will keep only one _copy_ of the row for _Magneto_). Likely what we want here. + +The R(adiant) commands are the same as shown above, except you will need to replace `bind_rows` by `union`. + +
    + +### Setdiff + +```{r results = 'asis', echo = FALSE} +dplyr::setdiff(avengers, superheroes) %>% + knitr::kable(., align = 'l', format = 'html', table.attr = tab_big) +``` + +Finally, a `setdiff` will keep rows from `avengers` that are _not_ in `superheroes`. If we reverse the inputs (i.e., choose `superheroes` from the `Datasets` dropdown and `superheroes` from the `Combine with` dropdown) we will end up with all rows from `superheroes` that are not in `avengers`. In both cases the entry for _Magneto_ will be omitted. + +The R(adiant) commands are the same as shown above, except you will need to replace `bind_rows` by `setdiff`. + +
    + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the combined dataset by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +For additional discussion see the chapter on relational data in R for data science and Tidy Explain + +### R-functions + +For help with the `combine_data` function see _Data > Combine_ diff --git a/radiant.data/vignettes/pkgdown/_explore.Rmd b/radiant.data/vignettes/pkgdown/_explore.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..0d2100190a85fdd2d7033adcebf102958c881b4e --- /dev/null +++ b/radiant.data/vignettes/pkgdown/_explore.Rmd @@ -0,0 +1,41 @@ +> Summarize and explore your data + +Generate summary statistics for one or more variables in your data. The most powerful feature in _Data > Explore_ is that you can easily describe the data _by_ one or more other variables. Where the _Data > Pivot_ tab works best for frequency tables and to summarize a single numeric variable, the _Data > Explore_ tab allows you to summarize multiple variables at the same time using various statistics. + +For example, if we select `price` from the `diamonds` dataset and click the `Create table` button we can see the number of observations (n), the mean, the variance, etc. However, the mean price for each clarity level of the diamond can also be easily provided by choosing `clarity` as the `Group by` variable. + +> Note that when a categorical variable (`factor`) is selected from the `Numeric variable(s)` dropdown menu it will be converted to a numeric variable if required for the selected function. If the factor levels are numeric these will be used in all calculations. Since the mean, standard deviation, etc. are not relevant for non-binary categorical variables, these will be converted to 0-1 (binary) variables where the first level is coded as 1 and all other levels as 0. + +The created summary table can be stored in Radiant by clicking the `Store` button. This can be useful if you want to create plots of the summarized data in _Data > Visualize_. To download the table to _csv_ format click the download icon on the top-right. + +You can select options from `Column header` dropdown to switch between different column headers. Select either `Function` (e.g., mean, median, etc), `Variable` (e.g., price, carat, etc), or the levels of the (first) `Group by` variable (e.g., Fair-Ideal). + +

    + +## Functions + +Below you will find a brief description of several functions available from the `Apply function(s)` dropdown menu. Most functions, however, will be self-explanatory. + +* `n` calculates the number of observations, or rows, in the data or in a group if a `Group by` variable has been selected (`n` uses the `length` function in R) +* `n_distinct` calculates the number of distinct values +* `n_missing` calculates the number of missing values +* `cv` is the coefficient of variation (i.e., mean(x) / sd(x)) +* `sd` and `var` calculate the sample standard deviation and variance for numeric data +* `me` calculates the margin of error for a numeric variable using a 95% confidence level +* `prop` calculates a proportion. For a variable with only values 0 or 1 this is equivalent to `mean`. For other numeric variables it captures the occurrence of the maximum value. +For a `factor` it captures the occurrence of the first level. +* `sdprop` and `varprop` calculate the sample standard deviation and variance for a proportion +* `meprop` calculates the margin of error for a proportion using a 95% confidence level +* `sdpop` and `varpop` calculate the population standard deviation and variance + +### Filter data + +Use the `Filter data` box to select (or omit) specific sets of rows from the data. See the helpfile for _Data > View_ for details. + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the summary table by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +### R-functions + +For an overview of related R-functions used by Radiant to summarize and explore data see _Data > Explore_ diff --git a/radiant.data/vignettes/pkgdown/_footer.md b/radiant.data/vignettes/pkgdown/_footer.md new file mode 100644 index 0000000000000000000000000000000000000000..c9f6da4d3e25ebe3f853d29f3bc20a632fdc6c7f --- /dev/null +++ b/radiant.data/vignettes/pkgdown/_footer.md @@ -0,0 +1,2 @@ + +© Vincent Nijs (2023) Creative Commons License diff --git a/radiant.data/vignettes/pkgdown/_manage.Rmd b/radiant.data/vignettes/pkgdown/_manage.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..740d66c8566dcbdfd679c4fa57b86115f29c10fb --- /dev/null +++ b/radiant.data/vignettes/pkgdown/_manage.Rmd @@ -0,0 +1,57 @@ +> Manage data and state: Load data into Radiant, Save data to disk, Remove a dataset from memory, or Save/Load the state of the app + +### Datasets + +When you first start Radiant a dataset (`diamonds`) with information on diamond prices is shown. + +It is good practice to add a description of the data and variables to each file you use. For the files that are bundled with Radiant you will see a brief overview of the variables etc. below a table of the first 10 rows of the data. To add a description for your own data click the `Add/edit data description` check-box. A text-input box will open below the table where you can add text in +markdown format. The description provided for the `diamonds` data included with Radiant should serve as a good example. After adding or editing a description click the `Update description` button. + +To rename a dataset loaded in Radiant click the `Rename data` check box, enter a new name, and click the `Rename` button + +### Load data + +The best way to load and save data for use in Radiant (and R) is to use the R-data format (rds or rda). These are binary files that can be stored compactly and read into R quickly. Select `rds` (or `rda`) from the `Load data of type` dropdown and click `Browse` to locate the file(s) you want to load on your computer. + +You can get data from a spreadsheet (e.g., Excel or Google sheets) into Radiant in two ways. First, you can save data from the spreadsheet in csv format and then, in Radiant, choose `csv` from the `Load data of type` dropdown. Most likely you will have a header row in the csv file with variable names. If the data are not comma separated you can choose semicolon or tab separated. To load a csv file click 'Browse' and locate the file on your computer. + +Alternatively, you can select and copy the data in the spreadsheet using CTRL-C (or CMD-C on mac), go to Radiant, choose `clipboard` from the `Load data of type` dropdown, and click the `Paste` button. This is a short-cut that can be convenient for smaller datasets that are cleanly formatted. + +If the data is available in R's global workspace (e.g., you opened a data set in Rstudio and then started Radiant from the `addins` menu) you can move (or copy) it to Radiant by selecting `from global workspace`. Select the data.frame(s) you want to use and click the `Load` button. + +To access all data files bundled with Radiant choose `examples` from the `Load data of type` dropdown and then click the `Load` button. These files are used to illustrate the various data and analysis tools accessible in Radiant. For example, the `avengers` and `publishers` data are used to illustrate how to combine data in R(adiant) (i.e., _Data > Combine_). + +If `csv` data is available online choose `csv (url)` from the dropdown, paste the url into the text input shown, and press `Load`. If an `rda` file is available online choose `rda (url)` from the dropdown, paste the url into the text input, and press `Load`. + +### Save data + +As mentioned above, the most convenient way to get data in and out of Radiant is to use the R-data format (rds or rda). Choose `rds` (or `rda`) from the `Save data to type` dropdown and click the `Save` button to save the selected dataset to file. + +Again, it is good practice to add a description of the data and variables to each file you use. To add a description for your own data click the 'Add/edit data description' check-box, add text to the text-input window shown in +markdown format, and then click the `Update description` button. When you save the data as an rds (or rda) file the description you created (or edited) will automatically be added to the file as an `attribute`. + +Getting data from Radiant into a spreadsheet can be achieved in two ways. First, you can save data in csv format and load the file into the spreadsheet (i.e., choose `csv` from the `Save data to type` dropdown and click the `Save` button). Alternatively, you can copy the data from Radiant into the clipboard by choosing `clipboard` from the dropdown and clicking the `Copy` button, open the spreadsheet, and paste the data from Radiant using CTRL-V (or CMD-V on mac). + +To move or copy data from Radiant into R(studio)'s global workspace select `to global workspace` from the `Save data to type` dropdown and click the `Save` button. + +### Save and load state + +It is convenient to work with state files if you want complete your work at another time, perhaps on another computer, or to review previous work you completed using Radiant. You can save and load the state of the Radiant app just as you would a data file. The state file (extension `.state.rda`) will contain (1) the data loaded in Radiant, (2) settings for the analyses you were working on, (3) and any reports or code from the _Report_ menu. To save the current state of the app to your hard-disk click the icon in the navbar and then click `Save radiant state file`. To load load a previous state click the icon in the navbar and the click `Load radiant state file`. + +You can also share a state file with others that would like to replicate your analyses. As an example, download and then load the state file radiant-example.state.rda as described above. You will navigate automatically to the _Data > Visualize_ tab and will see a plot. See also the _Data > View_ tab for some additional settings loaded from the state file. There is also a report in _Report > Rmd_ created using the Radiant interface. The html file radiant-example.nb.html contains the output created by clicking the `Knit report` button. + +Loading and saving state also works with Rstudio. If you start Radiant from Rstudio and use and then click `Stop`, the `r_data` environment and the `r_info` and `r_state` lists will be put into Rstudio's global workspace. If you start radiant again from the `Addins` menu it will use `r_data`, `r_info`, and `r_state` to restore state. Also, if you load a state file directly into Rstudio it will be used when you start Radiant. + +Use `Refresh` in the menu in the navbar to return to a clean/new state. + +### Remove data from memory + +If data are loaded in memory that you no longer need in the current session check the `Remove data from memory` box. Then select the data to remove and click the `Remove data` button. One datafile will always remain open. + +### Using commands to load and save data + +R-code can be used in _Report > Rmd_ or _Report > R_ to load data from a file directly into the active Radiant session. Use `register("insert-dataset-name")` to add a dataset to the `Datasets` dropdown. R-code can also be used to extract data from Radiant and save it to disk. + +### R-functions + +For an overview of related R-functions used by Radiant to load and save data see _Data > Manage_ diff --git a/radiant.data/vignettes/pkgdown/_pivotr.Rmd b/radiant.data/vignettes/pkgdown/_pivotr.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..c8e0388033cb1b1ad12335fac9b1432e45f49814 --- /dev/null +++ b/radiant.data/vignettes/pkgdown/_pivotr.Rmd @@ -0,0 +1,45 @@ +> Create pivot tables to explore your data + +If you have used pivot-tables in Excel the functionality provided in the _Data > Pivot_ tab should be familiar to you. Similar to the _Data > Explore_ tab, you can generate summary statistics for variables in your data. You can also generate frequency tables. Perhaps the most powerful feature in _Data > Pivot_ is that you can easily describe the data _by_ one or more other variables. + +For example, with the `diamonds` data loaded, select `clarity` and `cut` from the `Categorical variables` drop-down. The categories for the first variable will be the column headers but you can drag-and-drop the selected variables to change their ordering. After selecting these two variables, and clicking on the `Create pivot table` button, a frequency table of diamonds with different levels of clarity and quality of cut is shown. Choose `Row`, `Column`, or `Total` from the `Normalize by` drop-down to normalize cell frequencies or create an index from a summary statistic by the row, column, or overall total. If a normalize option is selected it can be convenient to check the `Percentage` box to express the numbers as percentages. Choose `Color bar` or `Heat map` from the `Conditional formatting` drop-down to emphasize the highest frequency counts. + +It is also possible to summarize numerical variables. Select `price` from the `Numeric variables` drop-down. This will create the table shown below. Just as in the _Data > View_ tab you can sort the table by clicking on the column headers. You can also use sliders (e.g., click in the input box below `I1`) to limit the view to values in a specified range. To view only information for diamonds with a `Very good`, `Premium` or `Ideal` cut click in the input box below the `cut` header. + +

    + +Below you will find a brief description of several functions available from the `Apply function` dropdown menu. Most functions, however, will be self-explanatory. + +* `n` calculates the number of observations, or rows, in the data or in a group if a `Group by` variable has been selected (`n` uses the `length` function in R) +* `n_distinct` calculates the number of distinct values +* `n_missing` calculates the number of missing values +* `cv` is the coefficient of variation (i.e., mean(x) / sd(x)) +* `sd` and `var` calculate the sample standard deviation and variance for numeric data +* `me` calculates the margin of error for a numeric variable using a 95% confidence level +* `prop` calculates a proportion. For a variable with only values 0 or 1 this is equivalent to `mean`. For other numeric variables it captures the occurrence of the maximum value. +For a `factor` it captures the occurrence of the first level. +* `sdprop` and `varprop` calculate the sample standard deviation and variance for a proportion +* `meprop` calculates the margin of error for a proportion using a 95% confidence level +* `sdpop` and `varpop` calculate the population standard deviation and variance + +You can also create a bar chart based on the generated table (see image above). To download the table in _csv_ format or the plot in _png_ format click the appropriate download icon on the right. + +> Note that when a categorical variable (`factor`) is selected from the `Numeric variable(s)` dropdown menu it will be converted to a numeric variable if required for the selected function(s). If the factor levels are numeric these will be used in all calculations. Since the mean, standard deviation, etc. are not relevant for non-binary categorical variables, these will be converted to 0-1 (binary) variables where the first level is coded as 1 and all other levels as 0. + +### Filter data + +Use the `Filter data` box to select (or omit) specific sets of rows from the data to tabulate. See the help file for _Data > View_ for details. + +### Store + +The created pivot table can be stored in Radiant by clicking the `Store` button. This can be useful if you want do additional analysis on the table or to create plots of the summarized data in _Data > Visualize_. To download the table to _csv_ format click the download icon on the top-right. + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the pivot table by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If a plot was created it can be customized using `ggplot2` commands (e.g., `plot(result) + labs(title = "Pivot graph")`). See _Data > Visualize_ for details. + +### R-functions + +For an overview of related R-functions used by Radiant to create pivot tables see _Data > Pivot_ diff --git a/radiant.data/vignettes/pkgdown/_report_r.Rmd b/radiant.data/vignettes/pkgdown/_report_r.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..ac337ee691486e048add2f76a8f23133c32676ef --- /dev/null +++ b/radiant.data/vignettes/pkgdown/_report_r.Rmd @@ -0,0 +1,71 @@ +> Create a (reproducible) report using R + +The _Report > R_ tab allows you to run R-code with access to all functions and data in Radiant. By clicking the `Knit report (R)` button, the code will be evaluated and the output will be shown on the right of the _Report > R_ page. To evaluate only a part of the code use the cursor to select a section and press `CTRL-enter` (`CMD-enter` on mac). + +You can load an R-code file into Radiant by clicking the `Load report` button and selecting an .r or .R file. If you started Radiant from Rstudio you can save a report in HTML, Word, or PDF format by selecting the desired format from the drop-down menu and clicking `Save report`. To save just the code choose `R` from the dropdown and press the `Save report` button. + +If you started Radiant from Rstudio, you can also click the `Read files` button to browse for files and generate code to read it into Radiant. For example, read rda, rds, xls, yaml, and feather and add them to the `Datasets` dropdown. If the file type you want to load is not currently supported, the path to the file will be returned. The file path used will be relative to the Rstudio-project root. Paths to files synced to a local Dropbox or Google Drive folder will use the `find_dropbox` and `find_gdrive` functions to enhances reproducibility. + +As an example you can copy-and-paste the code below into the editor and press `Knit report (R)` to generate results. + +```r +## get the active dataset and show the first few observations +.get_data() %>% + head() + +## access a dataset +diamonds %>% + select(price, clarity) %>% + head() + +## add a variable to the diamonds data +diamonds <- mutate(diamonds, log_price = log(price)) + +## show the first observations in the price and log_price columns +diamonds %>% + select(price, log_price) %>% + head() + +## create a histogram of prices +diamonds %>% + ggplot(aes(x = price)) + + geom_histogram() + +## and a histogram of log-prices using radiant.data::visualize +visualize(diamonds, xvar = "log_price", custom = TRUE) + +## open help in the R-studio viewer from Radiant +help(package = "radiant.data") + +## If you are familiar with Shiny you can call reactives when the code +## is evaluated inside a Shiny app. For example, if you transformed +## some variables in Data > Transform you can call the transform_main +## reacive to see the latest result. Very useful for debugging +# transform_main() %>% head() +head() +``` + +## Options + +The editor used in _Report > Rmd_ and _Report > R_ has several options that can be set in `.Rprofile`. + +```r +options(radiant.ace_vim.keys = FALSE) +options(radiant.ace_theme = "cobalt") +options(radiant.ace_tabSize = 2) +options(radiant.ace_useSoftTabs = TRUE) +options(radiant.ace_showInvisibles = TRUE) +options(radiant.ace_autoComplete = "live") +``` + +Notes: + +* `vim.keys` enables a set of special keyboard short-cuts. If you have never used VIM you probably don't want this +* For an overview of available editor themes see: `shinyAce::getAceThemes()` +* Tabs are converted to 2 spaces by default (i.e., 'soft' tabs). You can change the number of spaces used from 2 to, for example, 4 +* `showInvisibles` shows tabs and spaces in the editor +* Autocomplete has options "live", "enabled", and "disabled" + +### R-functions + +For an overview of related R-functions used by Radiant to generate reproducible reports see _Report_ diff --git a/radiant.data/vignettes/pkgdown/_report_rmd.Rmd b/radiant.data/vignettes/pkgdown/_report_rmd.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..03423da34ed9aa760f831e3df74c07a88cd5ce7a --- /dev/null +++ b/radiant.data/vignettes/pkgdown/_report_rmd.Rmd @@ -0,0 +1,61 @@ +> Create a (reproducible) report using Rmarkdown + +The best way to store your work in Radiant is to use the _Report > Rmd_ feature and save a state file with all your results and settings. The report feature in Radiant should be used in conjunction with the icons shown on the bottom left of your screen on most pages. + +The editor shown on the left in _Report > Rmd_ shows past commands in **R-code chunks**. These _chunks_ can include R-code you typed or R-code generated by Radiant and added to the report after clicking an icon. All code chunks start with ```` ```{r} ```` and are closed by ```` ``` ```` + +By default Radiant will add the R-code generated for the analysis you just completed to the bottom of the report. After clicking a icon Radiant will, by default, switch to the _Report > Rmd_ tab. Click inside the editor window on the left and scroll down to see the generated commands. + +If you want more control over where the R-code generated by Radiant is put into your report, choose `Manual paste` instead or `Auto paste` from the appropriate drop-down in the _Report > Rmd_ tab. When `Manual paste` is selected, the code is put into the clipboard when you click and you can paste it where you want in the editor window. + +If you started Radiant from Rstudio, you can also choose to have commands sent to an Rmarkdown (R-code) document open in Rstudio by selecting `To Rmd` (`To R`) instead of `Auto paste` or `Manual paste`. If you choose `To Rmd` the editor in _Report > Rmd_ will be hidden (i.e., "Preview only") and clicking on `Knit report (Rmd)` will source the text and code directly from Rstudio. + +By default, the app will switch to the _Report > Rmd_ tab after you click the icon. However, if you don't want to switch tabs after clicking a icon, choose `Don't switch tab` from the appropriate drop-down in the _Report > Rmd_ tab. `Don't switch tab` is the default option when you choose `To Rmd`. + +You can add text or additional commands to create an Rmarkdown document. An Rmarkdown file (extension .Rmd) is a plain text file that can be opened in Notepad (Windows), TextEdit (Mac), Rstudio, Sublime Text, or any other text editor. Please do **not** use Word to edit Rmarkdown files. + +Using Rmarkdown is extremely powerful because you can replicate your entire analysis quickly without having to generate all the required R-code again. By clicking the `Knit report (Rmd)` button on the top-left of your screen, the output from the analysis will be (re)created and shown on the right of the _Report > Rmd_ page. To evaluate only a part of the report use the cursor to select a section and press `CTRL-enter` (`CMD-enter` on mac) to create the (partial) output. + +You can add text, bullets, headers, etc. around the code chunks to describe and explain the results using markdown. For an interactive markdown tutorial visit commonmark.org. + +If you started Radiant from Rstudio you can save the report in various formats (i.e., Notebook, HTML, Word, Powerpoint, or PDF). For more on generating powerpoint presentation see https://bookdown.org/yihui/rmarkdown/powerpoint-presentation.html. To save the Rmarkdown file open in the editor select `Rmd` (or `Rmd + Data (zip)`) and press `Save report`. Previously saved Rmarkdown files can be loaded into Radiant by using the `Load report` button. For more + +You can also click the `Read files` button to browse for files and generate code to read it into Radiant. For example, read rda, rds, xls, yaml, and feather and add them to the `Datasets` dropdown. You can also read images, R-code, and text (e.g., Rmd or md) to include in your report. If the file type you want to load is not currently supported, the path to the file will be returned. If Radiant was started from an Rstudio project, the file paths used will be relative to the project root. Paths to files synced to local Dropbox or Google Drive folder will use the `find_dropbox` and `find_gdrive` functions to enhances reproducibility. + +## State + +The best way to save your analyses and settings is to save the `state` of the application to a file by clicking on the icon in the navbar and then clicking on `Save radiant state file`. The state file (extension rda) will contain (1) the data loaded in Radiant, (2) settings for the analyses you were working on, (3) and any reports or code from the _Report > Rmd_ and _Report > R_. Save the state file to your hard-disk and, when you are ready to continue, simply load it by icon in the navbar and then clicking on `Load radiant state file` + +If you are using Radiant for a class I suggest you use the _Report > Rmd_ feature to complete assignments and cases. When you are done, generate an (HTML) Notebook (or Word or PDF) report by clicking the `Save report` button. Submit both the report and your state file. + +## Options + +The editor used in _Report > Rmd_ and _Report > R_ has several options that can be set in `.Rprofile`. You can use `usethis::edit_r_profile()` to alter the settings in .Rprofile + +```r +options(radiant.ace_vim.keys = FALSE) +options(radiant.ace_theme = "cobalt") +options(radiant.ace_tabSize = 2) +options(radiant.ace_useSoftTabs = TRUE) +options(radiant.ace_showInvisibles = TRUE) +options(radiant.ace_autoComplete = "live") +options(radiant.powerpoint_style = "~/Dropbox/rmd-styles/style.potx") +options(radiant.word_style = "~/Dropbox/rmd-styles/style.docx") +options(radiant.theme = bslib::bs_theme(version = 4, bootswatch = "darkly")) +``` + +Notes: + +* `vim.keys` enables a set of special keyboard short-cuts. If you have never used VIM you probably don't want this +* For an overview of available editor themes see: `shinyAce::getAceThemes()` +* Tabs are converted to 2 spaces by default (i.e., 'soft' tabs). You can change the number of spaces used from 2 to, for example, 4 +* `showInvisibles` shows tabs and spaces in the editor +* Autocomplete has options "live", "enabled", and "disabled" +* Radiant has default styles for Word and Powerpoint files. These can be replaced with styles files you created however. Click the links below to download the style files used in Radiant to your computer. Edit the files and use `options` as shown above to tell Radiant where to find the style files you want to use. + * Word style file + * Powerpoint style file +* The `theme` option can be used to change the appearance of the Radiant interface. For an overview of available themes see: https://rstudio.github.io/bslib/articles/theming/index.html#bootswatch + +### R-functions + +For an overview of related R-functions used by Radiant to generate reproducible reports see _Report_ diff --git a/radiant.data/vignettes/pkgdown/_state.Rmd b/radiant.data/vignettes/pkgdown/_state.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..e21c166d92eee567bd9eb835f9c726d54894135d --- /dev/null +++ b/radiant.data/vignettes/pkgdown/_state.Rmd @@ -0,0 +1,9 @@ +> Save, load, share, or view state + +It is convenient to work with state files if you want complete your work at another time, perhaps on another computer, or to review previous work you completed using Radiant. You can save and load the state of the Radiant app just as you would a data file. The state file (extension `.rda`) will contain (1) the data loaded in Radiant, (2) settings for the analyses you were working on, (3) and any reports or code from the _Report_ menu. To save the current state of the app to your hard-disk click the icon in the navbar and then click `Save radiant state file`. To load load a previous state click the icon in the navbar and the click `Load radiant state file`. + +You can also share a state file with others that would like to replicate your analyses. As an example, download and then load the state file radiant-example.state.rda as described above. You will navigate automatically to the _Data > Visualize_ tab and will see a plot. See also the _Data > View_ tab for some additional settings loaded from the state file. There is also a report in _Report > Rmd_ created using the Radiant interface. The html file radiant-example.nb.html contains the output created by clicking the `Knit report` button. + +Loading and saving state also works with Rstudio. If you start Radiant from Rstudio and use and then click `Stop`, the `r_data` environment and the `r_info` and `r_state` lists will be put into Rstudio's global workspace. If you start radiant again from the `Addins` menu it will use `r_data`, `r_info`, and `r_state` to restore state. Also, if you load a state file directly into Rstudio it will be used when you start Radiant. + +Use `Refresh` in the menu in the navbar to return to a clean/new state. diff --git a/radiant.data/vignettes/pkgdown/_transform.Rmd b/radiant.data/vignettes/pkgdown/_transform.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..5ea1b1e397ff5bc6146906f6af34cb63535e7cf7 --- /dev/null +++ b/radiant.data/vignettes/pkgdown/_transform.Rmd @@ -0,0 +1,315 @@ +> Transform variables + +### Transform command log + +All transformations applied in the _Data > Transform_ tab can be logged. If, for example, you apply a `Ln (natural log)` transformation to numeric variables the following code is generated and put in the `Transform command log` window at the bottom of your screen when you click the `Store` button. + +```r +## transform variable +diamonds <- mutate_ext( + diamonds, + .vars = vars(price, carat), + .funs = log, + .ext = "_ln" +) +``` + +This is an important feature if you want to re-run a report with new, but similar, data. Even more important is that there is a record of the steps taken to transform the data and to generate results, i.e., your work is now reproducible. + +To add commands contained in the command log window to a report in _Report > Rmd_ click the icon. + +### Filter data + +Even if a filter has been specified it will be ignored for (most) functions available in _Data > Transform_. To create a new dataset based on a filter navigate to the _Data > View_ tab and click the `Store` button. Alternatively, to create a new dataset based on a filter, select `Split data > Holdout sample` from the `Transformation type` dropdown. + +### Hide summaries + +For larger datasets, or when summaries are not needed, it can useful to click `Hide summaries`before selecting the transformation type and specifying how you want to alter the data. If you do want to see summaries make sure that `Hide summaries` is not checked. + + +### Change variables + +#### Bin + +The `Bin` command is a convenience function for the `xtile` command discussed below when you want to create multiple quintile/decile/... variables. To calculate quintiles enter `5` as the `Nr bins`. The `reverse` option replaces 1 by 5, 2 by 4, ..., 5 by 1. Choose an appropriate extension for the new variable(s). + +#### Change type + +When you select `Type` from the `Transformation type` drop-down another drop-down menu is shown that will allow you to change the type (or class) of one or more variables. For example, you can change a variable of type integer to a variable of type factor. Click the `Store` button to commit the changes to the data set. A description of the transformation options is provided below. + +1. As factor: convert a variable to type factor (i.e., a categorical variable) +2. As number: convert a variable to type numeric +3. As integer: convert a variable to type integer +4. As character: convert a variable to type character (i.e., strings) +4. As times series: convert a variable to type ts +5. As date (mdy): convert a variable to a date if the dates are structured as month-day-year +6. As date (dmy): convert a variable to a date if the dates are structured as day-month-year +7. As date (ymd): convert a variable to a date if the dates are structured as year-month-day +8. As date/time (mdy_hms): convert a variable to a date if the dates are structured as month-day-year-hour-minute-second +9. As date/time (mdy_hm): convert a variable to a date if the dates are structured as month-day-year-hour-minute +10. As date/time (dmy\_hms): convert a variable to a date if the dates are structured as day-month-year-hour-minute-second +11. As date/time (dmy\_hm): convert a variable to a date if the dates are structured as day-month-year-hour-minute +12. As date/time (ymd\_hms): convert a variable to a date if the dates are structured as year-month-day-hour-minute-second +13. As date/time (ymd\_hm): convert a variable to a date if the dates are structured as year-month-day-hour-minute + +**Note:** When converting a variable to type `ts` (i.e., time series) you should, at least, specify a starting period and the frequency data. For example, for weekly data that starts in the 4th week of the year, enter `4` as the `Start period` and set `Frequency` to `52`. + +#### Normalize + +Choose `Normalize` from the `Transformation type` drop-down to standardize one or more variables. For example, in the diamonds data we may want to express price of a diamond per-carat. Select `carat` as the `Normalizing variable` and `price` in the `Select variable(s)` box. You will see summary statistics for the new variable (e.g., `price_carat`) in the main panel. Commit changes to the data by clicking the `Store` button. + +#### Recode + +To use the recode feature select the variable you want to change and choose `Recode` from the `Transformation type` drop-down. Provide one or more recode commands, separated by a `;`, and press return to see information about the changed variable. Note that you can specify a name for the recoded variable in the `Recoded variable name` input box (press return to submit changes). Finally, click `Store` to add the recoded variable to the data. Some examples are given below. + +1. Set values below 20 to `Low` and all others to `High` + + ```r + lo:20 = 'Low'; else = 'High' + ``` + +2. Set above 20 to `High` and all others to `Low` + + ```r + 20:hi = 'High'; else = 'Low' + ``` + +3. Set values 1 through 12 to `A`, 13:24 to `B`, and the remainder to `C` + + ```r + 1:12 = 'A'; 13:24 = 'B'; else = 'C' + ``` + +4. Collapse age categories for a _Basics > Tables > Cross-tabs_ cross-tab analysis. In the example below `<25` and `25-34` are recoded to `<35`, `35-44` and `35-44` are recoded to `35-54`, and `55-64` and `>64` are recoded to `>54` + + + ```r + '<25' = '<35'; '25-34' = '<35'; '35-44' = '35-54'; '45-54' = '35-54'; '55-64' = '>54'; '>64' = '>54' + ``` + +5. To exclude a particular value (e.g., an outlier in the data) for subsequent analyses we can recode it to a missing value. For example, if we want to remove the maximum value from a variable called `sales` that is equal to 400 we would (1) select the variable `sales` in the `Select variable(s)` box and enter the command below in the `Recode` box. Press `return` and `Store` to add the recoded variable to the data + + + ```r + 400 = NA + ``` + +5. To recode specific numeric values (e.g., carat) to a new value (1) select the variable `carat` in the `Select variable(s)` box and enter the command below in the `Recode` box to set the value for carat to 2 in all rows where carat is currently larger than or equal to 2. Press `return` and `Store` to add the recoded variable to the data + + ```r + 2:hi = 2 + ``` + +**Note:** Do not use `=` in a variable label when using the recode function (e.g., `50:hi = '>= 50'`) as this will cause an error. + +#### Reorder or remove levels + +If a (single) variable of type `factor` is selected in `Select variable(s)`, choose `Reorder/Remove levels` from the `Transformation type` drop-down to reorder and/or remove levels. Drag-and-drop levels to reorder them or click the $\times$ to remove them. Note that, by default, removing one or more levels will introduce missing values in the data. If you prefer to recode the removed levels into a new level, for example "other", simply type "other" in the `Replacement level name` input box and press `return`. If the resulting factor levels appear as intended, press `Store` to commit the changes. To temporarily exclude levels from the data use the `Filter data` box (see the help file linked in the _Data > View_ tab). + +#### Rename + +Choose `Rename` from the `Transformation type` drop-down, select one or more variables, and enter new names for them in the `Rename` box. Separate names by a `,`. Press return to see summaries for the renamed variables on screen and press `Store` to alter the variable names in the data. + +#### Replace + +Choose `Replace` from the `Transformation type` drop-down if you want to replace existing variables in the data with new ones created using, for example, `Create`, `Transform`, `Clipboard`, etc.. Select one or more variables to overwrite and the same number of replacement variables. Press `Store` to alter the data. + +#### Transform + +When you select `Transform` from the `Transformation type` drop-down another drop-down menu is shown you can use to apply common transformations to one or more variables in the data. For example, to take the (natural) log of a variable select the variable(s) you want to transform and choose `Ln (natural log)` from the `Apply function` drop-down. The transformed variable will have the extension specified in the `Variable name extension` input (e.g,. `_ln`). Make sure to press `return` after changing the extension. Click the `Store` button to add the (changed) variable(s) to the data set. A description of the transformation functions included in Radiant is provided below. + +1. Ln: create a natural log-transformed version of the selected variable (i.e., log(x) or ln(x)) +2. Square: multiply a variable by itself (i.e., x^2 or square(x)) +3. Square-root: take the square-root of a variable (i.e., x^.5) +4. Absolute: Absolute value of a variable (i.e., abs(x)) +5. Center: create a new variable with a mean of zero (i.e., x - mean(x)) +6. Standardize: create a new variable with a mean of zero and standard deviation of one (i.e., (x - mean(x))/sd(x)) +7. Inverse: 1/x + +### Create new variable(s) + +#### Clipboard + +Although not recommended, you can manipulate your data in a spreadsheet (e.g., Excel or Google sheets) and copy-and-paste the data back into Radiant. If you don't have the original data in a spreadsheet already use the clipboard feature in _Data > Manage_ so you can paste it into the spreadsheet or click the download icon on the top right of your screen in the _Data > View_ tab. Apply your transformations in the spreadsheet program and then copy the new variable(s), with a header label, to the clipboard (i.e., CTRL-C on windows and CMD-C on mac). Select `Clipboard` from the `Transformation type` drop-down and paste the new data into the `Paste from spreadsheet` box. It is key that new variable(s) have the same number of observations as the data in Radiant. To add the new variables to the data click `Store`. + +> **Note:** Using the clipboard feature for data transformation is discouraged because it is not reproducible. + +#### Create + +Choose `Create` from the `Transformation type` drop-down. This is the most flexible command to create new or transform existing variables. However, it also requires some basic knowledge of R-syntax. A new variable can be any function of other variables in the (active) dataset. Some examples are given below. In each example the name to the left of the `=` sign is the name of the new variable. To the right of the `=` sign you can include other variable names and basic R-functions. After you type the command press `return` to see summary statistics for the new variable. If the result is as expected press `Store` to add it to the dataset. + +> **Note:** If one or more variables is selected from the `Select variables` list they will be used to _group_ the data before creating the new variable (see example 1. below). If this is not the intended result make sure that no variables are selected when creating new variables + +1. Create a new variable `z` that is equal to the mean of price. To calculate the mean of price per group (e.g., per level of clarity) select `clarity` from the `Select variables` list before creating `z` + + ```r + z = mean(price) + ``` + +2. Create a new variable `z` that is the difference between variables x and y + + ```r + z = x - y + ``` + +3. Create a new variable `z` that is a transformation of variable `x` with mean equal to zero (see also `Transform > Center`): + + ```r + z = x - mean(x) + ``` + +4. Create a new _logical) variable `z` that takes on the value TRUE when `x > y` and FALSE otherwise + + ```r + z = x > y + ``` + +5. Create a new _logical_ `z` that takes on the value TRUE when `x` is equal to `y` and FALSE otherwise + + ```r + z = x == y + ``` + +6. Create a variable `z` that is equal to `x` lagged by 3 periods + + ```r + z = lag(x,3) + ``` + +7. Create a categorical variable with two levels (i.e., `smaller` and `bigger`) + + ```r + z = ifelse(x < y, 'smaller', 'bigger') + ``` + +8. Create a categorical variable with three levels. An alternative approach would be to use the `Recode` function described below + + ```r + z = ifelse(x < 60, '< 60', ifelse(x > 65, '> 65', '60-65')) + ``` + +9. Convert an outlier to a missing value. For example, if we want to remove the maximum value from a variable called `sales` that is equal to 400 we could use an `ifelse` statement and enter the command below in the `Create` box. Press `return` and `Store` to add the `sales_rc` to the data. Note that if we had entered `sales` on the left-hand side of the `=` sign the original variable would have been overwritten + + ```r + sales_rc = ifelse(sales > 400, NA, sales) + ``` + +10. If a respondent with ID 3 provided information on the wrong scale in a survey (e.g., income in \$1s rather than in \$1000s) we could use an `ifelse` statement and enter the command below in the `Create` box. As before, press `return` and `Store` to add `sales_rc` to the data + + ```r + income_rc = ifelse(ID == 3, income/1000, income) + ``` + +11. If multiple respondents made the same scaling mistake (e.g., those with ID 1, 3, and 15) we again use `Create` and enter: + + ```r + income_rc = ifelse(ID %in% c(1, 3, 15), income/1000, income) + ``` + +12. If a date variable is in a format not available through the `Type` menu you can use the `parse_date_time` function. For a date formatted as `2-1-14` you would specify the command below (note that this format will also be parsed correctly by the `mdy` function in the `Type` menu) + + ```r + date = parse_date_time(x, '%m%d%y') + ``` + +13. Determine the time difference between two dates/times in seconds + + ```r + tdiff = as_duration(time2 - time1) + ``` + +14. Extract the month from a date variable + + ```r + m = month(date) + ``` + +15. Other attributes that can be extracted from a date or date-time variable are `minute`, `hour`, `day`, `week`, `quarter`, `year`, `wday` (for weekday). For `wday` and `month` it can be convenient to add `label = TRUE` to the call. For example, to extract the weekday from a date variable and use a label rather than a number + + ```r + wd = wday(date, label = TRUE) + ``` + +16. Calculate the distance between two locations using lat-long information + + ```r + dist = as_distance(lat1, long1, lat2, long2) + ``` + +17. Calculate quintiles for a variable `recency` by using the `xtile` command. To create deciles replace `5` by `10`. + + ```r + rec_iq = xtile(recency, 5) + ``` + +18. To reverse the ordering of the quintiles created in 17 above use `rev = TRUE` + + ```r + rec_iq = xtile(recency, 5, rev = TRUE) + ``` + +19. To remove text from entries in a character or factor variable use `sub` to remove only the first instance or `gsub` to remove all instances. For example, suppose each row for a variable `bk_score` has the letters "clv" before a number (e.g., "clv150"). We could replace each occurrence of "clv" by "" as follows: + + ```r + bk_score = sub("clv", "", bk_score) + ``` + +Note: For examples 7, 8, and 15 above you may need to change the new variable to type `factor` before using it for further analysis (see also `Change type` above) + + +### Clean data + +#### Remove missing values + +Choose `Remove missing` from the `Transformation type` drop-down to eliminate rows with one or more missing values. Rows with missing values for `Select variables` will be removed. Press `Store` to change the data. If missing values were present you will see the number of observations in the data summary change (i.e., the value of _n_ changes) as variables are selected. + +#### Reorder or remove variables + +Choose `Reorder/Remove variables` from the `Transformation type` drop-down. Drag-and-drop variables to reorder them in the data. To remove a variable click the $\times$ symbol next to the label. Press `Store` to commit the changes. + +#### Remove duplicates + +It is common to have one or more variables in a dataset that have only unique values (i.e., no duplicates). Customer IDs, for example, should be unique unless the dataset contains multiple orders for the same customer. To remove duplicates select one or more variables to determine _uniqueness_. Choose `Remove duplicates` from the `Transformation type` drop-down and check how the displayed summary statistics change. Press `Store` to change the data. If there are duplicate rows you will see the number of observations in the data summary change (i.e., the value of _n_ and _n\_distinct_ will change). + +#### Show duplicates + +If there are duplicates in the data use `Show duplicates` to get a better sense for the data points that have the same value in multiple rows. If you want to explore duplicates using the _Data > View_ tab make sure to `Store` them in a different dataset (i.e., make sure **not** to overwrite the data you are working on). If you choose to show duplicates based on all columns in the data only one of the duplicate rows will be shown. These rows are **exactly** the same so showing 2 or 3 isn't helpful. If, however, we are looking for duplicates based on a subset of the available variables Radiant will generate a dataset with **all** relevant rows. + +### Expand data + +#### Expand grid + +Create a dataset with all combinations of values for a selection of variables. This is useful to generate datasets for prediction in, for example, _Model > Estimate > Linear regression (OLS)_ or _Model > Estimate > Logistic regression (GLM)_. Suppose you want to create a dataset with all possible combinations of values for `cut` and `color` of a diamond. By selecting `Expand grid` from the `Transformation type` dropdown and `cut` and `color` in the `Select variable(s)` box we can see in the screenshot below that there are 35 possible combinations (i.e., `cut` has 5 unique values and `color` has 7 unique values so 5 x 7 combinations are possible). Choose a name for the new dataset (e.g., diamonds\_expand) and click the `Store` button to add it to the `Datasets` dropdown. + +

    + +#### Table-to-data + +Turn a frequency table into a dataset. The number of rows will equal the sum of all frequencies. + + +### Split data + +#### Holdout sample + +To create a holdout sample based on a filter, select `Holdout sample` from the `Transformation type` dropdown. By default the _opposite_ of the active filter is used. For example, if analysis is conducted on observations with `date < '2014-12-13'` then the holdout sample will contain rows with `date >= '2014-12-13'` if the `Reverse filter` box is checked. + +#### Training variable + +To create a variable that can be used to (randomly) filter a dataset for model training and testing, select `Training variable` from the `Transformation type` dropdown. Specify either the number of observations to use for training (e.g., set `Size` to 2000) or a proportion of observations to select (e.g., set `Size` to .7). The new variable will have a value `1` for training and `0` test data. + +It is also possible to select one or morel variables for `blocking` in random assignment to the training and test samples. This can help ensure that, for example, the proportion of positive and negative and negative cases (e.g., "buy" vs "no buy") for a variable of interest is (almost) identical in the training and test sample. + +### Tidy data + +#### Gather columns + +Combine multiple variables into one column. If you have the `diamonds` dataset loaded, select `cut` and `color` in the `Select variable(s)` box after selecting `Gather columns` from the `Transformation type` dropdown. This will create new variables `key` and `value`. `key` has two levels (i.e., `cut` and `color`) and `value` captures all values in `cut` and `color`. + +#### Spread column + +_Spread_ one column into multiple columns. The opposite of `gather`. For a detailed discussion about _tidy_ data see the tidy-data vignette. + +### R-functions + +For an overview of related R-functions used by Radiant to transform data see _Data > Transform_ diff --git a/radiant.data/vignettes/pkgdown/_view.Rmd b/radiant.data/vignettes/pkgdown/_view.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..2b21c504de33bf03eca36cbc57c0d935fc1d6907 --- /dev/null +++ b/radiant.data/vignettes/pkgdown/_view.Rmd @@ -0,0 +1,61 @@ +> Show data as an interactive table + +### Datasets + +Choose one of the datasets from the `Datasets` dropdown. Files are loaded into Radiant through the _Data > Manage_ tab. + +### Filter data + +There are several ways to select a subset of the data to view. The `Filter data` box on the left (click the check-box) can be used with `>` and `<` symbols. You can also combine subset commands, for example, `x > 3 & y == 2` would show only those rows for which the variable `x` has values larger than 3 **AND** for which `y` is equal to 2. Note that in R, and most other programming languages, `=` is used to _assign_ a value and `==` to determine if values are equal to each other. In contrast, `!=` is used to determine if two values are _unequal_. You can also use expressions that have an **OR** condition. For example, to select rows where `Salary` is smaller than \$100,000 **OR** larger than \$20,000 use `Salary > 20000 | Salary < 100000`. `|` is the symbol for **OR** and `&` is the symbol for **AND** + +It is also possible to filter using dates. For example, to select rows with dates before June 1st, 2014 enter `date < "2014-6-1"` into the filter box and press return. + +You can also use string matching to select rows. For example, type `grepl('ood', cut)` to select rows with `Good` or `Very good` cut. This search is case sensitive by default. For case insensitive search use `grepl("GOOD", cut, ignore.case = TRUE)`. Type your statement in the `Filter` box and press return to see the result on screen or an error below the box if the expression is invalid. + +It is important to note that these filters are _persistent_ and will be applied to any analysis conducted through in Radiant. To deactivate a filter un-check the `Filter data` check-box. To remove a filter simply delete it. + + +```{r operators, results = 'asis', echo = FALSE} +tab_large <- "class='table table-condensed table-hover' style='width:60%;'" +data.frame( + "Operator" = c("`<`","`<=`","`>`","`>=`","`==`","`!=`","`|`","`&`", "`%in%`", "is.na"), + "Description" = c("less than", "less than or equal to", "greater than", "greater than or equal to", "exactly equal to", "not equal to", "x OR y", "x AND y", "x is one of y", "is missing"), + "Example" = c("`price < 5000`", "`carat <= 2`", "`price > 1000`", "`carat >= 2`", "`cut == 'Fair'`", "`cut != 'Fair'`", "`price > 10000 | cut == 'Premium'`", "`carat < 2 & cut == 'Fair'`", "`cut %in% c('Fair', 'Good')`", "`is.na(price)`") + ) %>% +knitr::kable(align = 'l', format = 'html', escape = FALSE, table.attr = tab_large) +``` + +Filters can also be used with R-code to quickly view a sample from the selected dataset. For example, `runif(n()) > .9` could be used to sample approximately 10% of the rows in the data and `1:n() < 101` would select only the first 100 rows in the data. + +### Select variables to show + +By default all columns in the data are shown. Click on any variable to focus on it alone. To select several variables use the SHIFT and ARROW keys on your keyboard. On a mac the CMD key can also be used to select multiple variables. The same effect is achieved on windows using the CTRL key. To select all variable use CTRL-A (or CMD-A on mac). + +### Browse the data + +By default only 10 rows of data are shown at a time. You can change this setting through the `Show ... entries` dropdown. Press the `Next` and `Previous` buttons at the bottom-right of the screen to page through the data. + +### Sort + +Click on a column header in the table to sort the data. Clicking again will toggle between sorting in ascending and descending order. To sort on multiple columns at once press shift and then click on the 2nd, 3rd, etc. column to sort by. + +### Column filters and Search + +For variables that have a limited number of different values (i.e., a factor) you can select the levels to keep from the column filter below the variable name. For example, to filter on rows with ideal cut click in the box below the `cut` column header and select `Ideal` from the dropdown menu shown. You can also type a string into these column filters and then press return. Note that matching is case-insensitive. In fact, typing `eal` would produce the same result because the search will match any part of a string. Similarly, you can type a string to select rows based on character variables (e.g., street names). + +For numeric variables the column filter boxes have some special features that make them almost as powerful as the `Filter data` box. For numeric and integer variables you can use `...` to indicate a range. For example, to select `price` values between \$500 and \$2000 type `500 ... 2000` and press return. The range is inclusive of the values typed. Furthermore, if we want to filter on `carat` `0.32 ...` will show only diamonds with carat values larger than or equal to 0.32. Numeric variables also have a slider that you can use to define the range of values to keep. + +If you want to get _really_ fancy you can use the search box on the top right to search across all columns in the data using **regular expressions**. For example, to find all rows that have an entry in _any_ column ending with the number 72 type `72$` (i.e., the `$` sign is used to indicate the end of an entry). For all rows with entries that start with 60 use `^60` (i.e., the `^` is used to indicate the first character in an entry). Regular expressions are incredibly powerful for search but this is a _big_ topic area. To learn more about regular expressions see this tutorial. + + +### Store filters + +It is important to note that column sorting, column filters, and search are **not** persistent. To store these settings for use in other parts of Radiant press the `Store` button. You can store the data and settings under a different dataset name by changing the value in the text input to the left of the `Store` button. This feature can also be used to select a subset of variables to keep. Just select the ones you want to keep and press the `Store` button. For more control over the variables you want to keep or remove and to specify their order in the dataset use the _Data > Transform_ tab. + +To download the data in _csv_ format click the icon on the top right of your screen. + +Click the report () icon on the bottom left of your screen or press `ALT-enter` on your keyboard to add the filter and sort commands used by Radiant to a (reproducible) report in _Report > Rmd_. + +### R-functions + +For an overview of related R-functions used by Radiant to view, search, and filter data see _Data > View_ diff --git a/radiant.data/vignettes/pkgdown/_visualize.Rmd b/radiant.data/vignettes/pkgdown/_visualize.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..da0f788690080fc5f5dbb56562d2db1ee01823f1 --- /dev/null +++ b/radiant.data/vignettes/pkgdown/_visualize.Rmd @@ -0,0 +1,141 @@ +> Visualize data + +### Filter data + +Use the `Filter data` box to select (or omit) specific sets of rows from the data. See the help file for _Data > View_ for details. + +### Plot-type + +Select the plot type you want. For example, with the `diamonds` data loaded select `Distribution` and all (X) variables (use CTRL-a or CMD-a). This will create a histogram for all numeric variables and a bar-plot for all categorical variables in the data set. Density plots can only be used with numeric variables. Scatter plots are used to visualize the relationship between two variables. Select one or more variables to plot on the Y-axis and one or more variables to plot on the X-axis. If one of the variables is categorical (i.e., a {factor}) it should be specified as an X-variable. Information about additional variables can be added through the `Color` or `Size` dropdown. Line plots are similar to scatter plots but they connect-the-dots and are particularly useful for time-series data. Surface plots are similar to `Heat maps` and require 3 input variables: X, Y, and Fill. Bar plots are used to show the relationship between a categorical (or integer) variable (X) and the (mean) value of a numeric variable (Y). Box-plots are also used when we have a numeric Y-variable and a categorical X-variable. They are more informative than bar charts but also require a bit more effort to evaluate. + +> Note that when a categorical variable (`factor`) is selected as the `Y-variable` in a Bar chart it will be converted to a numeric variable if required for the selected function. If the factor levels are numeric these will be used in all calculations. Since the mean, standard deviation, etc. are not relevant for non-binary categorical variables, these will be converted to 0-1 (binary) variables where the first level is coded as 1 and all other levels as 0. For example, if we select `color` from the `diamonds` data as the Y-variable, and `mean` as the function to apply, then each bar will represent the proportion of observations with the value `D`. + +### Box plots + +The upper and lower "hinges" of the box correspond to the first and third quartiles (the 25th and 75th percentiles) in the data. The middle hinge is the median value of the data. The upper whisker extends from the upper hinge (i.e., the top of the box) to the highest value in the data that is within 1.5 x IQR of the upper hinge. IQR is the inter-quartile range, or distance, between the 25th and 75th percentile. The lower whisker extends from the lower hinge to the lowest value in the data within 1.5 x IQR of the lower hinge. Data beyond the end of the whiskers could be outliers and are plotted as points (as suggested by Tukey). + +In sum: +1. The lower whisker extends from Q1 to max(min(data), Q1 - 1.5 x IQR) +2. The upper whisker extends from Q3 to min(max(data), Q3 + 1.5 x IQR) + +where Q1 is the 25th percentile and Q3 is the 75th percentile. You may have to read the two bullets above a few times before it sinks in. The plot below should help to explain the structure of the box plot. + +

    +Source + +### Sub-plots and heat-maps + +`Facet row` and `Facet column` can be used to split the data into different groups and create separate plots for each group. + +If you select a scatter or line plot a `Color` drop-down will be shown. Selecting a `Color` variable will create a type of heat-map where the colors are linked to the values of the `Color` variable. Selecting a categorical variable from the `Color` dropdown for a line plot will split the data into groups and will show a line of a different color for each group. + +### Line, loess, and jitter + +To add a linear or non-linear regression line to a scatter plot check the `Line` and/or `Loess` boxes. If your data take on a limited number of values, `Jitter` can be useful to get a better feel for where most of the data points are located. `Jitter`-ing simply adds a small random value to each data point so they do not overlap completely in the plot(s). + +### Axis scale + +The relationship between variables depicted in a scatter plot may be non-linear. There are numerous transformations we might apply to the data so this relationship becomes (approximately) linear (see _Data > Transform_) and easier to estimate using, for example, _Model > Estimate > Linear regression (OLS)_. Perhaps the most common data transformation applied to business data is the (natural) logarithm. To see if log transformation(s) may be appropriate for your data check the `Log X` and/or `Log Y` boxes (e.g., for a scatter or bar plot). + +By default the scale of the Y-axis is the same across sub-plots when using `Facet row`. To allow the Y-axis to be specific to each sub-plot click the `Scale-y` check-box. + +### Flip axes + +To switch the variables on the X- and Y-axis check the `Flip` box. + +### Plot height and width + +To make plots bigger or smaller adjust the values in the height and width boxes on the bottom left of the screen. + +### Keep plots + +The best way to keep/store plots is to generate a `visualize` command by clicking the report () icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. Alternatively, click the icon on the top right of your screen to save a png-file to disk. + +### Customizing plots in _Report > Rmd_ + +To customize a plot first generate the `visualize` command by clicking the report () icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. The example below illustrates how to customize a command in the _Report > Rmd_ tab. Notice that `custom` is set to `TRUE`. + +```r +visualize(diamonds, yvar = "price", xvar = "carat", type = "scatter", custom = TRUE) + + labs( + title = "A scatterplot", + y = "Price in $", + x = "Carats" + ) +``` + +The default resolution for plots is 144 dots per inch (dpi). You can change this setting up or down in _Report > Rmd_. For example, the code-chunk header below ensures the plot will be 7" wide, 3.5" tall, with a resolution of 600 dpi. + +```` ```{r fig.width = 7, fig.height = 3.5, dpi = 600} ```` + +If you have the `svglite` package installed, the code-chunk header below will produce graphs in high quality `svg` format. + +```` ```{r fig.width = 7, fig.height = 3.5, dev = "svglite"} ```` + +**Some common customization commands:** + +* Add a title: `+ labs(title = "my title")` +* Add a sub-title: `+ labs(subtitle = "my sub-title")` +* Add a caption below figure: `+ labs(caption = "Based on data from ...")` +* Change label: `+ labs(x = "my X-axis label")` or `+ labs(y = "my Y-axis label")` +* Remove all legends: `+ theme(legend.position = "none")` +* Change legend title: `+ labs(color = "New legend title")` or `+ labs(fill = "New legend title")` +* Rotate tick labels: `+ theme(axis.text.x = element_text(angle = 90, hjust = 1))` +* Set plot limits: `+ ylim(5000, 8000)` or `+ xlim("VS1","VS2")` +* Remove size legend: `+ scale_size(guide = "none")` +* Change size range: `+ scale_size(range=c(1,6))` +* Draw a horizontal line: `+ geom_hline(yintercept = 0.1)` +* Draw a vertical line: `+ geom_vline(xintercept = 8)` +* Scale the y-axis as a percentage: `+ scale_y_continuous(labels = scales::percent)` +* Scale the y-axis in millions: `+ scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6))` +* Display y-axis in \$'s: `+ scale_y_continuous(labels = scales::dollar_format())` +* Use `,` as a thousand separator for the y-axis: `+ scale_y_continuous(labels = scales::comma)` + +For more on how to customize plots for communication see http://r4ds.had.co.nz/graphics-for-communication.html. + +See also the ggplot2 documentation site https://ggplot2.tidyverse.org. + +Suppose we create a set of three bar charts in _Data > Visualize_ using the `Diamond` data. To add a title above the group of plots and impose a one-column layout we could use `patchwork` as follows: + +```r +library(patchwork) +plot_list <- visualize( + diamonds, + xvar = c("clarity", "cut", "color"), + yvar = "price", + type = "bar", + custom = TRUE +) +wrap_plots(plot_list, ncol = 1) + plot_annotation(title = "Three bar plots") +``` + +See the patchwork documentation site for additional information on how to customize groups of plots. + +### Making plots interactive in _Report > Rmd_ + +It is possible to transform (most) plots generated in Radiant into interactive graphics using the `plotly` library. After setting `custom = TRUE` you can use the `ggplotly` function to convert a single plot. See example below: + +```r +visualize(diamonds, xvar = "price", custom = TRUE) %>% + ggplotly() %>% + render() +``` + +If more than one plot is created, you can use the `subplot` function from the `plotly` package. Provide a value for the `nrows` argument to setup the plot layout grid. In the example below four plots are created. Because `nrow = 2` the plots will be displayed in a 2 X 2 grid. + +```r +visualize(diamonds, xvar = c("carat", "clarity", "cut", "color"), custom = TRUE) %>% + subplot(nrows = 2) %>% + render() +``` + +For additional information on the `plotly` library see the links below: + +* Getting started: https://plot.ly/r/getting-started/ +* Reference: https://plot.ly/r/reference/ +* Book: https://cpsievert.github.io/plotly_book +* Code: https://github.com/ropensci/plotly + +### R-functions + +For an overview of related R-functions used by Radiant to visualize data see _Data > Visualize_ diff --git a/radiant.data/vignettes/pkgdown/combine.Rmd b/radiant.data/vignettes/pkgdown/combine.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..1d3184b98fa9a6c3a9a667a1549c777a6e61876f --- /dev/null +++ b/radiant.data/vignettes/pkgdown/combine.Rmd @@ -0,0 +1,14 @@ +--- +title: "Combine data sets (Data > Combine)" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r include = FALSE} +library(dplyr) +``` + +```{r child = "_combine.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.data/vignettes/pkgdown/explore.Rmd b/radiant.data/vignettes/pkgdown/explore.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..504e9d739a8615470f0e484052dcbe6c7ca6fb72 --- /dev/null +++ b/radiant.data/vignettes/pkgdown/explore.Rmd @@ -0,0 +1,14 @@ +--- +title: "Summarize and explore your data (Data > Explore)" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r include = FALSE} +library(dplyr) +``` + +```{r child = "_explore.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.data/vignettes/pkgdown/images/by-sa.png b/radiant.data/vignettes/pkgdown/images/by-sa.png new file mode 100644 index 0000000000000000000000000000000000000000..2332cc49dd634c62e4013e13e5e4f06747c7e250 Binary files /dev/null and b/radiant.data/vignettes/pkgdown/images/by-sa.png differ diff --git a/radiant.data/vignettes/pkgdown/manage.Rmd b/radiant.data/vignettes/pkgdown/manage.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..1e69511fdd3ede6fe204a3566d90798d2c9b3e94 --- /dev/null +++ b/radiant.data/vignettes/pkgdown/manage.Rmd @@ -0,0 +1,10 @@ +--- +title: "Loading and Saving data (Data > Manage)" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_manage.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.data/vignettes/pkgdown/pivotr.Rmd b/radiant.data/vignettes/pkgdown/pivotr.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..43d44c80bbd408fae1da2901fc366fee178cb1db --- /dev/null +++ b/radiant.data/vignettes/pkgdown/pivotr.Rmd @@ -0,0 +1,10 @@ +--- +title: "Create pivot tables (Data > Pivot)" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_pivotr.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.data/vignettes/pkgdown/report_r.Rmd b/radiant.data/vignettes/pkgdown/report_r.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..a3a48b6098c2f3820730ccbfaa0c6441c6d61f89 --- /dev/null +++ b/radiant.data/vignettes/pkgdown/report_r.Rmd @@ -0,0 +1,10 @@ +--- +title: "Create a reproducible report using R (Report > R)" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_report_r.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.data/vignettes/pkgdown/report_rmd.Rmd b/radiant.data/vignettes/pkgdown/report_rmd.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..4a2987af7c963b95e1cd71dd7a829121a54473bd --- /dev/null +++ b/radiant.data/vignettes/pkgdown/report_rmd.Rmd @@ -0,0 +1,10 @@ +--- +title: "Create a reproducible report using Rmarkdown (Report > Rmd)" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_report_rmd.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.data/vignettes/pkgdown/state.Rmd b/radiant.data/vignettes/pkgdown/state.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..c9ad1495a8d0aa3014459492ddf691652a852f3e --- /dev/null +++ b/radiant.data/vignettes/pkgdown/state.Rmd @@ -0,0 +1,10 @@ +--- +title: "Loading and Saving the State of the application" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_state.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.data/vignettes/pkgdown/transform.Rmd b/radiant.data/vignettes/pkgdown/transform.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..4b103118fb76f06b7e9723155b1b7095eafdd4c4 --- /dev/null +++ b/radiant.data/vignettes/pkgdown/transform.Rmd @@ -0,0 +1,11 @@ +--- +title: "Transform variables (Data > Transform)" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_transform.Rmd"} +``` + +```{r child = "_footer.md"} +``` + diff --git a/radiant.data/vignettes/pkgdown/view.Rmd b/radiant.data/vignettes/pkgdown/view.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..baf25c9ed36d193ccc43bb40109fa14e2a9e2db1 --- /dev/null +++ b/radiant.data/vignettes/pkgdown/view.Rmd @@ -0,0 +1,14 @@ +--- +title: "View data in an interactive table (Data > View)" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r include = FALSE} +library(dplyr) +``` + +```{r child = "_view.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.data/vignettes/pkgdown/visualize.Rmd b/radiant.data/vignettes/pkgdown/visualize.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..4036eddf3b01308538f4bc95a990240bd46620b3 --- /dev/null +++ b/radiant.data/vignettes/pkgdown/visualize.Rmd @@ -0,0 +1,10 @@ +--- +title: "Visualize data (Data > Visualize)" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_visualize.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.design b/radiant.design deleted file mode 160000 index faefeb7e9be7ed855df176babf6d61909227ed2d..0000000000000000000000000000000000000000 --- a/radiant.design +++ /dev/null @@ -1 +0,0 @@ -Subproject commit faefeb7e9be7ed855df176babf6d61909227ed2d diff --git a/radiant.design/.Rbuildignore b/radiant.design/.Rbuildignore new file mode 100644 index 0000000000000000000000000000000000000000..8005c25ba1572f2f676db583b3bfed0471f2d7bf --- /dev/null +++ b/radiant.design/.Rbuildignore @@ -0,0 +1,13 @@ +^CRAN-RELEASE$ +^.*\.Rproj$ +^\.Rproj\.user$ +^inst/rstudio$ +^build$ +^docs$ +^vignettes$ +^\.travis\.yml$ +radiant.design.code-workspace +_pkgdown.yml +cran-comments.md +.vscode/ +^CRAN-SUBMISSION$ diff --git a/radiant.design/.gitignore b/radiant.design/.gitignore new file mode 100644 index 0000000000000000000000000000000000000000..7bddf7c9698fed1cf3c1f56298ceef02cd900821 --- /dev/null +++ b/radiant.design/.gitignore @@ -0,0 +1,11 @@ +.Rproj.user +.Rhistory +.Rapp.history +.RData +.Ruserdata +radiant.design.Rproj +.DS_Store +revdep/ +docs/ +cran-comments.md +.vscode/ diff --git a/radiant.design/.travis.yml b/radiant.design/.travis.yml new file mode 100644 index 0000000000000000000000000000000000000000..86973d348ac754ccd2723ea463757835be13adaa --- /dev/null +++ b/radiant.design/.travis.yml @@ -0,0 +1,29 @@ +language: r +# cache: packages +r: + - oldrel + - release + - devel +warnings_are_errors: true +sudo: required +dist: trusty + +r_packages: + - devtools + +r_github_packages: + - trestletech/shinyAce + - radiant-rstats/radiant.data + +after_success: + - Rscript -e 'pkgdown::build_site()' + +## based on https://www.datacamp.com/community/tutorials/cd-package-docs-pkgdown-travis +deploy: + provider: pages + skip-cleanup: true + github-token: $GITHUB_PAT + keep-history: true + local-dir: docs + on: + branch: master diff --git a/radiant.design/CRAN-RELEASE b/radiant.design/CRAN-RELEASE new file mode 100644 index 0000000000000000000000000000000000000000..34f8590838221c000bcf40d14b1b7c35dd4b79a4 --- /dev/null +++ b/radiant.design/CRAN-RELEASE @@ -0,0 +1,2 @@ +This package was submitted to CRAN on 2019-03-04. +Once it is accepted, delete this file and tag the release (commit 17986a2df3). diff --git a/radiant.design/CRAN-SUBMISSION b/radiant.design/CRAN-SUBMISSION new file mode 100644 index 0000000000000000000000000000000000000000..26c6b8949dbc4ea6580a531aff2696e0803fba04 --- /dev/null +++ b/radiant.design/CRAN-SUBMISSION @@ -0,0 +1,3 @@ +Version: 1.6.6 +Date: 2024-05-15 02:25:41 UTC +SHA: 8c714199cc6e55d627dd53a7469ffb154cc7302f diff --git a/radiant.design/DESCRIPTION b/radiant.design/DESCRIPTION new file mode 100644 index 0000000000000000000000000000000000000000..29040ebfa59426b4876fcdab6ef124a3178ffba2 --- /dev/null +++ b/radiant.design/DESCRIPTION @@ -0,0 +1,34 @@ +Package: radiant.design +Type: Package +Title: Design Menu for Radiant: Business Analytics using R and Shiny +Version: 1.6.6 +Date: 2024-5-14 +Authors@R: person("Vincent", "Nijs", , "radiant@rady.ucsd.edu", c("aut", "cre")) +Description: The Radiant Design menu includes interfaces for design of + experiments, sampling, and sample size calculation. The application extends + the functionality in 'radiant.data'. +Depends: + R (>= 4.3.0), + radiant.data (>= 1.6.6), +Imports: + dplyr (>= 1.0.7), + magrittr (>= 1.5), + shiny (>= 1.8.1), + AlgDesign (>= 1.1.7.3), + import (>= 1.1.0), + pwr (>= 1.1.2), + randomizr (>= 0.20.0), + mvtnorm (>= 1.2.0), + polycor, + shiny.i18n +Suggests: + testthat (>= 2.0.0), + pkgdown (>= 1.1.0) +URL: https://github.com/radiant-rstats/radiant.design/, + https://radiant-rstats.github.io/radiant.design/, + https://radiant-rstats.github.io/docs/ +BugReports: https://github.com/radiant-rstats/radiant.design/issues/ +License: AGPL-3 | file LICENSE +LazyData: true +Encoding: UTF-8 +RoxygenNote: 7.3.1 diff --git a/radiant.design/LICENSE b/radiant.design/LICENSE new file mode 100644 index 0000000000000000000000000000000000000000..fa3c0433841c97a748da9d2f3c01688f5faa7a43 --- /dev/null +++ b/radiant.design/LICENSE @@ -0,0 +1,105 @@ +Radiant is licensed under AGPL3 (see https://tldrlegal.com/license/gnu-affero-general-public-license-v3-(agpl-3.0) and https://www.r-project.org/Licenses/AGPL-3). The radiant help files are licensed under the creative commons attribution, non-commercial, share-alike license CC-NC-SA (https://creativecommons.org/licenses/by-nc-sa/4.0/). + +As a summary, the AGPLv3 license requires, attribution, including copyright and license information in copies of the software, stating changes if the code is modified, and disclosure of all source code. Details are in the COPYING file. + +If you are interested in using Radiant please email me at radiant@rady.ucsd.edu + +ALL HELPFILES IN THE RADIANT APPLICATION USE THE FOLLOWING LICENSE (https://creativecommons.org/licenses/by-nc-sa/4.0/) +======================================================================================================================== + +Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International Public License + +By exercising the Licensed Rights (defined below), You accept and agree to be bound by the terms and conditions of this Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International Public License ("Public License"). To the extent this Public License may be interpreted as a contract, You are granted the Licensed Rights in consideration of Your acceptance of these terms and conditions, and the Licensor grants You such rights in consideration of benefits the Licensor receives from making the Licensed Material available under these terms and conditions. + +Section 1 – Definitions. + +Adapted Material means material subject to Copyright and Similar Rights that is derived from or based upon the Licensed Material and in which the Licensed Material is translated, altered, arranged, transformed, or otherwise modified in a manner requiring permission under the Copyright and Similar Rights held by the Licensor. For purposes of this Public License, where the Licensed Material is a musical work, performance, or sound recording, Adapted Material is always produced where the Licensed Material is synched in timed relation with a moving image. +Adapter's License means the license You apply to Your Copyright and Similar Rights in Your contributions to Adapted Material in accordance with the terms and conditions of this Public License. +BY-NC-SA Compatible License means a license listed at creativecommons.org/compatiblelicenses, approved by Creative Commons as essentially the equivalent of this Public License. +Copyright and Similar Rights means copyright and/or similar rights closely related to copyright including, without limitation, performance, broadcast, sound recording, and Sui Generis Database Rights, without regard to how the rights are labeled or categorized. For purposes of this Public License, the rights specified in Section 2(b)(1)-(2) are not Copyright and Similar Rights. +Effective Technological Measures means those measures that, in the absence of proper authority, may not be circumvented under laws fulfilling obligations under Article 11 of the WIPO Copyright Treaty adopted on December 20, 1996, and/or similar international agreements. +Exceptions and Limitations means fair use, fair dealing, and/or any other exception or limitation to Copyright and Similar Rights that applies to Your use of the Licensed Material. +License Elements means the license attributes listed in the name of a Creative Commons Public License. The License Elements of this Public License are Attribution, NonCommercial, and ShareAlike. +Licensed Material means the artistic or literary work, database, or other material to which the Licensor applied this Public License. +Licensed Rights means the rights granted to You subject to the terms and conditions of this Public License, which are limited to all Copyright and Similar Rights that apply to Your use of the Licensed Material and that the Licensor has authority to license. +Licensor means the individual(s) or entity(ies) granting rights under this Public License. +NonCommercial means not primarily intended for or directed towards commercial advantage or monetary compensation. For purposes of this Public License, the exchange of the Licensed Material for other material subject to Copyright and Similar Rights by digital file-sharing or similar means is NonCommercial provided there is no payment of monetary compensation in connection with the exchange. +Share means to provide material to the public by any means or process that requires permission under the Licensed Rights, such as reproduction, public display, public performance, distribution, dissemination, communication, or importation, and to make material available to the public including in ways that members of the public may access the material from a place and at a time individually chosen by them. +Sui Generis Database Rights means rights other than copyright resulting from Directive 96/9/EC of the European Parliament and of the Council of 11 March 1996 on the legal protection of databases, as amended and/or succeeded, as well as other essentially equivalent rights anywhere in the world. +You means the individual or entity exercising the Licensed Rights under this Public License. Your has a corresponding meaning. +Section 2 – Scope. + +License grant. +Subject to the terms and conditions of this Public License, the Licensor hereby grants You a worldwide, royalty-free, non-sublicensable, non-exclusive, irrevocable license to exercise the Licensed Rights in the Licensed Material to: +reproduce and Share the Licensed Material, in whole or in part, for NonCommercial purposes only; and +produce, reproduce, and Share Adapted Material for NonCommercial purposes only. +Exceptions and Limitations. For the avoidance of doubt, where Exceptions and Limitations apply to Your use, this Public License does not apply, and You do not need to comply with its terms and conditions. +Term. The term of this Public License is specified in Section 6(a). +Media and formats; technical modifications allowed. The Licensor authorizes You to exercise the Licensed Rights in all media and formats whether now known or hereafter created, and to make technical modifications necessary to do so. The Licensor waives and/or agrees not to assert any right or authority to forbid You from making technical modifications necessary to exercise the Licensed Rights, including technical modifications necessary to circumvent Effective Technological Measures. For purposes of this Public License, simply making modifications authorized by this Section 2(a)(4) never produces Adapted Material. +Downstream recipients. +Offer from the Licensor – Licensed Material. Every recipient of the Licensed Material automatically receives an offer from the Licensor to exercise the Licensed Rights under the terms and conditions of this Public License. +Additional offer from the Licensor – Adapted Material. Every recipient of Adapted Material from You automatically receives an offer from the Licensor to exercise the Licensed Rights in the Adapted Material under the conditions of the Adapter’s License You apply. +No downstream restrictions. You may not offer or impose any additional or different terms or conditions on, or apply any Effective Technological Measures to, the Licensed Material if doing so restricts exercise of the Licensed Rights by any recipient of the Licensed Material. +No endorsement. Nothing in this Public License constitutes or may be construed as permission to assert or imply that You are, or that Your use of the Licensed Material is, connected with, or sponsored, endorsed, or granted official status by, the Licensor or others designated to receive attribution as provided in Section 3(a)(1)(A)(i). +Other rights. + +Moral rights, such as the right of integrity, are not licensed under this Public License, nor are publicity, privacy, and/or other similar personality rights; however, to the extent possible, the Licensor waives and/or agrees not to assert any such rights held by the Licensor to the limited extent necessary to allow You to exercise the Licensed Rights, but not otherwise. +Patent and trademark rights are not licensed under this Public License. +To the extent possible, the Licensor waives any right to collect royalties from You for the exercise of the Licensed Rights, whether directly or through a collecting society under any voluntary or waivable statutory or compulsory licensing scheme. In all other cases the Licensor expressly reserves any right to collect such royalties, including when the Licensed Material is used other than for NonCommercial purposes. +Section 3 – License Conditions. + +Your exercise of the Licensed Rights is expressly made subject to the following conditions. + +Attribution. + +If You Share the Licensed Material (including in modified form), You must: + +retain the following if it is supplied by the Licensor with the Licensed Material: +identification of the creator(s) of the Licensed Material and any others designated to receive attribution, in any reasonable manner requested by the Licensor (including by pseudonym if designated); +a copyright notice; +a notice that refers to this Public License; +a notice that refers to the disclaimer of warranties; +a URI or hyperlink to the Licensed Material to the extent reasonably practicable; +indicate if You modified the Licensed Material and retain an indication of any previous modifications; and +indicate the Licensed Material is licensed under this Public License, and include the text of, or the URI or hyperlink to, this Public License. +You may satisfy the conditions in Section 3(a)(1) in any reasonable manner based on the medium, means, and context in which You Share the Licensed Material. For example, it may be reasonable to satisfy the conditions by providing a URI or hyperlink to a resource that includes the required information. +If requested by the Licensor, You must remove any of the information required by Section 3(a)(1)(A) to the extent reasonably practicable. +ShareAlike. +In addition to the conditions in Section 3(a), if You Share Adapted Material You produce, the following conditions also apply. + +The Adapter’s License You apply must be a Creative Commons license with the same License Elements, this version or later, or a BY-NC-SA Compatible License. +You must include the text of, or the URI or hyperlink to, the Adapter's License You apply. You may satisfy this condition in any reasonable manner based on the medium, means, and context in which You Share Adapted Material. +You may not offer or impose any additional or different terms or conditions on, or apply any Effective Technological Measures to, Adapted Material that restrict exercise of the rights granted under the Adapter's License You apply. +Section 4 – Sui Generis Database Rights. + +Where the Licensed Rights include Sui Generis Database Rights that apply to Your use of the Licensed Material: + +for the avoidance of doubt, Section 2(a)(1) grants You the right to extract, reuse, reproduce, and Share all or a substantial portion of the contents of the database for NonCommercial purposes only; +if You include all or a substantial portion of the database contents in a database in which You have Sui Generis Database Rights, then the database in which You have Sui Generis Database Rights (but not its individual contents) is Adapted Material, including for purposes of Section 3(b); and +You must comply with the conditions in Section 3(a) if You Share all or a substantial portion of the contents of the database. +For the avoidance of doubt, this Section 4 supplements and does not replace Your obligations under this Public License where the Licensed Rights include other Copyright and Similar Rights. +Section 5 – Disclaimer of Warranties and Limitation of Liability. + +Unless otherwise separately undertaken by the Licensor, to the extent possible, the Licensor offers the Licensed Material as-is and as-available, and makes no representations or warranties of any kind concerning the Licensed Material, whether express, implied, statutory, or other. This includes, without limitation, warranties of title, merchantability, fitness for a particular purpose, non-infringement, absence of latent or other defects, accuracy, or the presence or absence of errors, whether or not known or discoverable. Where disclaimers of warranties are not allowed in full or in part, this disclaimer may not apply to You. +To the extent possible, in no event will the Licensor be liable to You on any legal theory (including, without limitation, negligence) or otherwise for any direct, special, indirect, incidental, consequential, punitive, exemplary, or other losses, costs, expenses, or damages arising out of this Public License or use of the Licensed Material, even if the Licensor has been advised of the possibility of such losses, costs, expenses, or damages. Where a limitation of liability is not allowed in full or in part, this limitation may not apply to You. +The disclaimer of warranties and limitation of liability provided above shall be interpreted in a manner that, to the extent possible, most closely approximates an absolute disclaimer and waiver of all liability. +Section 6 – Term and Termination. + +This Public License applies for the term of the Copyright and Similar Rights licensed here. However, if You fail to comply with this Public License, then Your rights under this Public License terminate automatically. +Where Your right to use the Licensed Material has terminated under Section 6(a), it reinstates: + +automatically as of the date the violation is cured, provided it is cured within 30 days of Your discovery of the violation; or +upon express reinstatement by the Licensor. +For the avoidance of doubt, this Section 6(b) does not affect any right the Licensor may have to seek remedies for Your violations of this Public License. +For the avoidance of doubt, the Licensor may also offer the Licensed Material under separate terms or conditions or stop distributing the Licensed Material at any time; however, doing so will not terminate this Public License. +Sections 1, 5, 6, 7, and 8 survive termination of this Public License. +Section 7 – Other Terms and Conditions. + +The Licensor shall not be bound by any additional or different terms or conditions communicated by You unless expressly agreed. +Any arrangements, understandings, or agreements regarding the Licensed Material not stated herein are separate from and independent of the terms and conditions of this Public License. +Section 8 – Interpretation. + +For the avoidance of doubt, this Public License does not, and shall not be interpreted to, reduce, limit, restrict, or impose conditions on any use of the Licensed Material that could lawfully be made without permission under this Public License. +To the extent possible, if any provision of this Public License is deemed unenforceable, it shall be automatically reformed to the minimum extent necessary to make it enforceable. If the provision cannot be reformed, it shall be severed from this Public License without affecting the enforceability of the remaining terms and conditions. +No term or condition of this Public License will be waived and no failure to comply consented to unless expressly agreed to by the Licensor. +Nothing in this Public License constitutes or may be interpreted as a limitation upon, or waiver of, any privileges and immunities that apply to the Licensor or You, including from the legal processes of any jurisdiction or authority. diff --git a/radiant.design/NAMESPACE b/radiant.design/NAMESPACE new file mode 100644 index 0000000000000000000000000000000000000000..06d8cf51fd756e2c52a054858448870ef30281cc --- /dev/null +++ b/radiant.design/NAMESPACE @@ -0,0 +1,52 @@ +# Generated by roxygen2: do not edit by hand + +S3method(plot,sample_size_comp) +S3method(summary,doe) +S3method(summary,randomizer) +S3method(summary,sample_size) +S3method(summary,sample_size_comp) +S3method(summary,sampling) +export(doe) +export(estimable) +export(radiant.design) +export(radiant.design_viewer) +export(radiant.design_window) +export(randomizer) +export(sample_size) +export(sample_size_comp) +export(sampling) +import(radiant.data) +import(shiny) +importFrom(AlgDesign,optFederov) +importFrom(dplyr,"%>%") +importFrom(dplyr,arrange) +importFrom(dplyr,arrange_at) +importFrom(dplyr,bind_cols) +importFrom(dplyr,desc) +importFrom(dplyr,distinct) +importFrom(dplyr,right_join) +importFrom(dplyr,select_at) +importFrom(import,from) +importFrom(magrittr,"%<>%") +importFrom(magrittr,set_colnames) +importFrom(mvtnorm,pmvnorm) +importFrom(polycor,hetcor) +importFrom(pwr,ES.h) +importFrom(pwr,plot.power.htest) +importFrom(pwr,pwr.2p.test) +importFrom(pwr,pwr.2p2n.test) +importFrom(pwr,pwr.t.test) +importFrom(pwr,pwr.t2n.test) +importFrom(radiant.data,launch) +importFrom(randomizr,block_ra) +importFrom(randomizr,complete_ra) +importFrom(stats,addmargins) +importFrom(stats,as.formula) +importFrom(stats,coef) +importFrom(stats,cor) +importFrom(stats,lm) +importFrom(stats,na.omit) +importFrom(stats,power.prop.test) +importFrom(stats,power.t.test) +importFrom(stats,qnorm) +importFrom(stats,runif) diff --git a/radiant.design/NEWS.md b/radiant.design/NEWS.md new file mode 100644 index 0000000000000000000000000000000000000000..42a9f565c226e9bcaa0b9c8cd0b995abde62af54 --- /dev/null +++ b/radiant.design/NEWS.md @@ -0,0 +1,125 @@ +# radiant.design 1.6.6 + +* Require Shiny 1.8.1. Adjustments related to icon-buttons were made to address a breaking change in Shiny 1.8.1 +* Reverting changes that removed `req(input$dataset)` in different places + +# radiant.design 1.6.2 + +* Require shiny 1.8.0. This fixes a bug in the shiny 1.7 versions that caused issues with all radiant packages. + +# radiant.design 1.6.1 + +* Addressed package documentation issue due changes in roxygen2 + +# radiant.design 1.6.0 + +* Add option to slice and sort data before sampling (requires radiant.data 1.5.0) +* Update dependency on mvtnorm to address issue with conflicting 'standardize' function + +# radiant.design 1.5.0 + +* Improvements to screenshot feature. Navigation bar is omitted and the image is adjusted to the length of the UI. +* Removed all references to `aes_string` which is being depricated in ggplot soon +* Code cleanup + +# radiant.design 1.4.1.0 + +* Fixed `is_empty` function clash with `rlang` +* Adjustments to work with the latest version of `shiny` and `bootstrap4` + +# radiant.design 1.3.4.0 + +* Minor adjustments in anticipation of dplyr 1.0.0 + +# radiant.design 1.3.0.0 + +* Allow for missing values in `randomizer` and `sampling` functions +* Added note that the design factors used as input to calculate a correlation using polycor::hetcor are assumed to be ordinal + +# radiant.design 1.2.0.0 + +* Update action buttons that initiate calculations when one or more relevant inputs are changed. When, for example, an experimental design should be updated, a spinning "refresh" icon will be shown +* Allow fractions as input for the `Random assignment` tool + +# radiant.design 1.1.3.0 + +* Added `estimable` function that can be used to determine which coefficients could be estimated based on a partial factorial design. Adapted from a function written by Blakeley MsShane at https://github.com/fzettelmeyer/mktg482/blob/master/R/expdesign.R +* Documentation updates (i.e., key functions for each tool) +* New `Random assignment` tool based on the `randomizr` package. Uses the `randomizr::block_ra` function for stratified random sampling. See the help file for more information +* Various enhancements to make _Design > Random sampling_ more flexible. See the updated help file + +# radiant.design 1.1.0.0 + +* Numerous small code changes to support enhanced auto-completion, tooltips, and annotations in shinyAce 0.4.1 + +# radiant.design 0.9.9.0 + +* Checked for issues with upcoming dplyr 0.8.0 +* Option to pass additional arguments to `shiny::runApp` when starting radiant such as the port to use. For example, radiant.design::radiant.design("https://github.com/radiant-rstats/docs/raw/gh-pages/examples/demo-dvd-rnd.state.rda", port = 8080) +* Use the `pwr` package for sample size calculations when comparing groups (i.e., Design > Sample size (compare)) +* Load a state file on startup by providing a (relative) file path or a url + +# radiant.design 0.9.7.0 + +## Major changes + +* Using [`shinyFiles`](https://github.com/thomasp85/shinyFiles) to provide convenient access to data located on a server + +## Minor changes + +* Revert from `svg` to `png` for plots in `_Report > Rmd_ and _Report > R_. `svg` scatter plots with many point get to big for practical use on servers that have to transfer images to a local browser +* Removed dependency on `methods` package + +# radiant.design 0.9.5.0 + +## Major changes + +* Various changes to the code to accomodate the use of `shiny::makeReactiveBinding`. The advantage is that the code generated for _Report > Rmd_ and _Report > R_ will no longer have to use `r_data` to store and access data. This means that code generated and used in the Radiant browser interface will be directly usable without the browser interface as well. + +# radiant.design 0.9.2.0 + +## Major changes + +* Upload and download data using the Rstudio file browser. Allows using relative paths to files (e.g., data or images inside an Rstudio project) +* Enhanced keyboard shortcuts +* `Create design` button indicates when the design should be updated based on changes in user input + +# radiant.design 0.8.9.0 + +## Minor changes + +* Upgraded tidyr dependency to 0.7.2 +* Upgraded dplyr dependency to 0.7.4 +* Applied `styler` on code + +# radiant.design 0.8.1.0 + +## Minor changes + +- Code cleanup +- Documentation updates + +## Bug fixes + +- Fix for incomplete final line warning in sampling.md + +# radiant.design 0.8.0.0 + +## Minor changes + +- Option to set random seed in Design > Sampling +- UI updates for DOE +- Show df name in output +- Use ALT-enter as a short-cut to report +- Documentation added on how to customize plots + +## Bug fixes + +- Fix for random seed when input is NA +- Cleanup report arguments for sample size calculations +- Print full factorial up to 5,000 lines +- Check that return value from optFederov was not a try-error + +## Deprecated + +- Use of *_each is deprecated diff --git a/radiant.design/R/aaa.R b/radiant.design/R/aaa.R new file mode 100644 index 0000000000000000000000000000000000000000..2c313b99caf22fe4fed23498c042fa174eb092f4 --- /dev/null +++ b/radiant.design/R/aaa.R @@ -0,0 +1,21 @@ +# to avoid 'no visible binding for global variable' NOTE +globalVariables(c(".", "rnd_number")) + +#' radiant.design +#' +#' @name radiant.design +#' @import radiant.data shiny +#' @importFrom dplyr %>% arrange arrange_at desc +#' @importFrom magrittr %<>% +#' @importFrom stats as.formula cor na.omit power.prop.test power.t.test qnorm runif coef lm +#' @importFrom import from +NULL + +#' 100 random names +#' @details A list of 100 random names. Description provided in attr(rndnames,"description") +#' @docType data +#' @keywords datasets +#' @name rndnames +#' @usage data(rndnames) +#' @format A data frame with 100 rows and 2 variables +NULL diff --git a/radiant.design/R/doe.R b/radiant.design/R/doe.R new file mode 100644 index 0000000000000000000000000000000000000000..bf9a1fdf5772b062f0c4a290e5ed9718a621c326 --- /dev/null +++ b/radiant.design/R/doe.R @@ -0,0 +1,240 @@ +#' Create (partial) factorial design +#' +#' @details See \url{https://radiant-rstats.github.io/docs/design/doe.html} for an example in Radiant +#' +#' @param factors Categorical variables used as input for design +#' @param int Vector of interaction terms to consider when generating design +#' @param trials Number of trials to create. If NA then all feasible designs will be considered until a design with perfect D-efficiency is found +#' @param seed Random seed to use as the starting point +#' +#' @return A list with all variables defined in the function as an object of class doe +#' +#' @examples +#' doe(c("price; $10; $13; $16", "food; popcorn; gourmet; no food")) +#' doe( +#' c("price; $10; $13; $16", "food; popcorn; gourmet; no food"), +#' int = "price:food", trials = 9, seed = 1234 +#' ) +#' +#' @seealso \code{\link{summary.doe}} to summarize results +#' +#' @importFrom AlgDesign optFederov +#' @importFrom mvtnorm pmvnorm +#' @importFrom polycor hetcor +#' @importFrom dplyr right_join +#' +#' @export +doe <- function(factors, int = "", trials = NA, seed = NA) { + df_list <- gsub("[ ]{2,}", " ", paste0(factors, collapse = "\n")) %>% + gsub("/", "", .) %>% + gsub("\\\\n", "\n", .) %>% + gsub("[ ]*;[ ]*", ";", .) %>% + gsub(";{2,}", ";", .) %>% + gsub("[;]+[ ]{0,}\n", "\n", .) %>% + gsub("[ ]{1,}\n", "\n", .) %>% + gsub("\n[ ]+", "\n", .) %>% + gsub("[\n]{2,}", "\n", .) %>% + gsub("[ ]+", "_", .) %>% + strsplit(., "\n") %>% + .[[1]] %>% + strsplit(";\\s*") + + df_names <- c() + if (length(df_list) < 2) { + return("DOE requires at least two factors" %>% add_class("doe")) + } + + for (i in seq_len(length(df_list))) { + dt <- df_list[[i]] %>% gsub("^\\s+|\\s+$", "", .) + df_names <- c(df_names, dt[1]) + df_list[[i]] <- dt[-1] + } + names(df_list) <- df_names + model <- paste0("~ ", paste0(df_names, collapse = " + ")) + nInt <- 0 + if (!is.empty(int)) { + model <- paste0(model, " + ", paste0(int, collapse = " + ")) + nInt <- length(int) + } + + part_fac <- function(df, model = ~., int = 0, trials = NA, seed = 172110) { + full <- expand.grid(df) + + ############################################### + # eliminate combinations from full + # by removing then from the variable _experiment_ + # http://stackoverflow.com/questions/18459311/creating-a-fractional-factorial-design-in-r-without-prohibited-pairs?rq=1 + ############################################### + + levs <- sapply(df, length) + nr_levels <- sum(levs) + min_trials <- nr_levels - length(df) + 1 + max_trials <- nrow(full) + + ## make sure the number of trials set by the user is within an appropriate range + if (!is.empty(trials)) { + max_trials <- min_trials <- max(min(trials, max_trials), min_trials) + } + + ## define a data.frame that will store design spec + eff <- data.frame( + Trials = min_trials:max_trials, + "D-efficiency" = NA, + "Balanced" = NA, + check.names = FALSE, + stringsAsFactors = FALSE + ) + + for (i in min_trials:max_trials) { + seed %>% + gsub("[^0-9]", "", .) %>% + (function(x) if (!is.empty(x)) set.seed(seed)) + design <- try(AlgDesign::optFederov( + model, + data = full, nRepeats = 50, + nTrials = i, maxIteration = 1000, + approximate = FALSE + ), silent = TRUE) + + if (inherits(design, "try-error")) next + ind <- which(eff$Trials %in% i) + eff[ind, "D-efficiency"] <- design$Dea + eff[ind, "Balanced"] <- all(i %% levs == 0) + + if (design$Dea == 1) break + } + + if (!inherits(design, "try-error")) { + cor_mat <- sshhr(polycor::hetcor(design$design, std.err = FALSE)$correlations) + } + + if (exists("cor_mat")) { + detcm <- det(cor_mat) + + full <- arrange_at(full, .vars = names(df)) %>% + data.frame(trial = 1:nrow(full), ., stringsAsFactors = FALSE) + + part <- arrange_at(design$design, .vars = names(df)) %>% + (function(x) suppressMessages(dplyr::right_join(full, x))) + + list( + df = df, + cor_mat = cor_mat, + detcm = detcm, + Dea = design$Dea, + part = part, + full = full, + eff = na.omit(eff), + seed = seed + ) + } else if (!is.na(trials)) { + "No solution exists for the selected number of trials" + } else { + "No solution found" + } + } + + part_fac(df_list, model = as.formula(model), int = nInt, trials = trials, seed = seed) %>% + add_class("doe") +} + +#' Summary method for doe function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/design/doe.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{doe}} +#' @param eff If TRUE print efficiency output +#' @param part If TRUE print partial factorial +#' @param full If TRUE print full factorial +#' @param est If TRUE print number of effects that will be estimable using the partial factorial design +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods. +#' +#' @seealso \code{\link{doe}} to calculate results +#' +#' @examples +#' c("price; $10; $13; $16", "food; popcorn; gourmet; no food") %>% +#' doe() %>% +#' summary() +#' +#' @export +summary.doe <- function(object, eff = TRUE, part = TRUE, full = TRUE, est = TRUE, dec = 3, ...) { + if (!is.list(object)) { + return(object) + } + + cat("Experimental design\n") + cat("# trials for partial factorial:", nrow(object$part), "\n") + cat("# trials for full factorial :", nrow(object$full), "\n") + if (!is.empty(object$seed)) { + cat("Random seed :", object$seed, "\n") + } + + cat("\nAttributes and levels:\n") + nl <- names(object$df) + for (i in nl) { + cat(paste0(i, ":"), paste0(object$df[[i]], collapse = ", "), "\n") + } + + if (eff) { + cat("\nDesign efficiency:\n") + format_df(object$eff, dec = dec) %>% + print(row.names = FALSE) + + cat("\nPartial factorial design correlations:\n") + cat("** Note: Variables are assumed to be ordinal **\n") + round(object$cor_mat, ifelse(object$detcm == 1, 0, dec)) %>% + print(row.names = FALSE) + } + + if (part) { + cat("\nPartial factorial design:\n") + print(object$part, row.names = FALSE) + } + + if (est) { + cat("\nEstimable effects from partial factorial design:\n\n") + cat(paste(" ", estimable(object), collapse = "\n"), "\n") + } + + if (full) { + cat("\nFull factorial design:\n") + print(object$full, row.names = FALSE) + } +} + +#' Determine coefficients that can be estimated based on a partial factorial design +#' +#' @description A function to determine which coefficients can be estimated based on a partial factorial design. Adapted from a function written by Blakeley McShane at https://github.com/fzettelmeyer/mktg482/blob/master/R/expdesign.R +#' +#' @param design An experimental design generated by the doe function that includes a partial and full factorial design +#' @examples +#' design <- doe(c("price; $10; $13; $16", "food; popcorn; gourmet; no food"), trials = 6) +#' estimable(design) +#' +#' @export +estimable <- function(design) { + if (!inherits(design, "doe")) { + return(add_class("The estimable function requires input of type 'doe'. Please use the ratiant.design::doe function to generate an appropriate design", "doe")) + } + + full <- design$full + fm <- as.formula(paste("trial ~ ", paste(colnames(full)[-1], collapse = "*"))) + mod1 <- lm(fm, data = full) + coef1 <- coef(mod1) + + mod2 <- lm(fm, data = design$part) + coef2 <- coef(mod2) + coef2 <- coef2[!is.na(coef2)] + + ## format levels + hasLevs <- sapply(full[, -1, drop = FALSE], function(x) is.factor(x) || is.logical(x) || is.character(x)) + if (sum(hasLevs) > 0) { + for (i in names(hasLevs[hasLevs])) { + names(coef2) %<>% gsub(paste0("^", i), paste0(i, "|"), .) %>% + gsub(paste0(":", i), paste0(":", i, "|"), .) + } + } + + names(coef2[-1]) +} diff --git a/radiant.design/R/radiant.R b/radiant.design/R/radiant.R new file mode 100644 index 0000000000000000000000000000000000000000..4b8ac0f5d5543b1121331408a35e48b8a5605112 --- /dev/null +++ b/radiant.design/R/radiant.R @@ -0,0 +1,48 @@ +#' Launch radiant.design in the default browser +#' +#' @description Launch radiant.design in the default web browser +#' @details See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +#' +#' @param state Path to state file to load +#' @param ... additional arguments to pass to shiny::runApp (e.g, port = 8080) +#' +#' @importFrom radiant.data launch +#' +#' @examples +#' \dontrun{ +#' radiant.design() +#' } +#' @export +radiant.design <- function(state, ...) radiant.data::launch(package = "radiant.design", run = "browser", state, ...) + +#' Launch radiant.design in an Rstudio window +#' +#' @details See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +#' +#' @param state Path to state file to load +#' @param ... additional arguments to pass to shiny::runApp (e.g, port = 8080) +#' +#' @importFrom radiant.data launch +#' +#' @examples +#' \dontrun{ +#' radiant.design_window() +#' } +#' @export +radiant.design_window <- function(state, ...) radiant.data::launch(package = "radiant.design", run = "window", state, ...) + +#' Launch radiant.design in the Rstudio viewer +#' +#' @details See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +#' +#' @param state Path to state file to load +#' @param ... additional arguments to pass to shiny::runApp (e.g, port = 8080) +#' +#' @importFrom radiant.data launch +#' +#' @examples +#' \dontrun{ +#' radiant.design_viewer() +#' } +#' @export +radiant.design_viewer <- function(state, ...) radiant.data::launch(package = "radiant.design", run = "viewer", state, ...) diff --git a/radiant.design/R/randomizer.R b/radiant.design/R/randomizer.R new file mode 100644 index 0000000000000000000000000000000000000000..2f8c0957b9109644dba20239b08dd5808c90071c --- /dev/null +++ b/radiant.design/R/randomizer.R @@ -0,0 +1,142 @@ +#' Randomize cases into experimental conditions +#' +#' @details Wrapper for the complete_ra and block_ra from the randomizr package. See \url{https://radiant-rstats.github.io/docs/design/randomizer.html} for an example in Radiant +#' +#' @param dataset Dataset to sample from +#' @param vars The variables to sample +#' @param conditions Conditions to assign to +#' @param blocks A vector to use for blocking or a data.frame from which to construct a blocking vector +#' @param probs A vector of assignment probabilities for each treatment conditions. By default each condition is assigned with equal probability +#' @param label Name to use for the generated condition variable +#' @param seed Random seed to use as the starting point +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param arr Expression to arrange (sort) the data on (e.g., "color, desc(price)") +#' @param rows Rows to select from the specified dataset +#' @param na.rm Remove rows with missing values (FALSE or TRUE) +#' @param envir Environment to extract data from +#' +#' @return A list of variables defined in randomizer as an object of class randomizer +#' +#' @importFrom randomizr complete_ra block_ra +#' @importFrom dplyr select_at bind_cols +#' @importFrom magrittr set_colnames +#' +#' @examples +#' randomizer(rndnames, "Names", conditions = c("test", "control")) %>% str() +#' +#' @seealso \code{\link{summary.sampling}} to summarize results +#' @export +randomizer <- function(dataset, vars, + conditions = c("A", "B"), + blocks = NULL, probs = NULL, + label = ".conditions", + seed = 1234, + data_filter = "", + arr = "", + rows = NULL, + na.rm = FALSE, + envir = parent.frame()) { + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + + if (!is.empty(blocks)) { + vars <- c(vars, blocks) + } + + dataset <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, na.rm = na.rm, envir = envir) + + ## use seed if provided + seed <- gsub("[^0-9]", "", seed) + if (!is.empty(seed)) set.seed(seed) + + if (is.empty(probs)) { + probs <- length(conditions) %>% + (function(x) rep(1 / x, x)) + } else if (length(probs) == 1) { + probs <- rep(probs, length(conditions)) + } else if (length(probs) != length(conditions)) { + probs <- NULL + } + + if (length(blocks) > 0) { + blocks_vct <- do.call(paste, c(select_at(dataset, .vars = blocks), sep = "-")) + cond <- randomizr::block_ra(blocks = blocks_vct, conditions = conditions, prob_each = probs) %>% + as.data.frame() %>% + set_colnames(label) + } else { + cond <- randomizr::complete_ra(N = nrow(dataset), conditions = conditions, prob_each = probs) %>% + as.data.frame() %>% + set_colnames(label) + } + + dataset <- bind_cols(cond, dataset) + + # removing unneeded arguments + rm(cond, envir) + + as.list(environment()) %>% add_class("randomizer") +} + +#' Summary method for the randomizer function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/design/randomizer.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{randomizer}} +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @importFrom stats addmargins +#' @importFrom dplyr distinct +#' +#' @examples +#' randomizer(rndnames, "Names", conditions = c("test", "control")) %>% summary() +#' +#' @seealso \code{\link{randomizer}} to generate the results +#' +#' @export +summary.randomizer <- function(object, dec = 3, ...) { + if (is.empty(object$blocks)) { + cat("Random assignment (simple random)\n") + } else { + cat("Random assignment (blocking)\n") + } + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + if (!is.empty(object$arr)) { + cat("Arrange :", gsub("\\n", "", object$arr), "\n") + } + if (!is.empty(object$rows)) { + cat("Slice :", gsub("\\n", "", object$rows), "\n") + } + if (!is.empty(object$blocks)) { + cat("Variables :", setdiff(object$vars, object$blocks), "\n") + cat("Blocks :", object$blocks, "\n") + } else { + cat("Variables :", object$vars, "\n") + } + cat("Conditions :", object$conditions, "\n") + cat("Probabilities:", round(object$probs, dec), "\n") + if (!is.empty(object$seed)) { + cat("Random seed :", object$seed, "\n") + } + is_unique <- object$dataset[, -1, drop = FALSE] %>% + (function(x) ifelse(nrow(x) > nrow(distinct(x)), "Based on selected variables some duplicate rows exist", "Based on selected variables, no duplicate rows exist")) + cat("Duplicates :", is_unique, "\n\n") + + cat("Assigment frequencies:\n") + if (is.empty(object$blocks_vct)) { + tab <- table(object$dataset[[object$label]]) + } else { + tab <- table(object$blocks_vct, object$dataset[[object$label]]) + } + tab %>% + addmargins() %>% + print() + + cat("\nAssigment proportions:\n") + tab %>% + prop.table() %>% + round(dec) %>% + print() +} diff --git a/radiant.design/R/sample_size.R b/radiant.design/R/sample_size.R new file mode 100644 index 0000000000000000000000000000000000000000..15f185669b34aa6bd932ad6da535b47df4eff3d2 --- /dev/null +++ b/radiant.design/R/sample_size.R @@ -0,0 +1,103 @@ +#' Sample size calculation +#' +#' @details See \url{https://radiant-rstats.github.io/docs/design/sample_size.html} for an example in Radiant +#' +#' @param type Choose "mean" or "proportion" +#' @param err_mean Acceptable Error for Mean +#' @param sd_mean Standard deviation for Mean +#' @param err_prop Acceptable Error for Proportion +#' @param p_prop Initial proportion estimate for Proportion +#' @param conf_lev Confidence level +#' @param incidence Incidence rate (i.e., fraction of valid respondents) +#' @param response Response rate +#' @param pop_correction Apply correction for population size ("yes","no") +#' @param pop_size Population size +#' +#' @return A list of variables defined in sample_size as an object of class sample_size +#' +#' @examples +#' sample_size(type = "mean", err_mean = 2, sd_mean = 10) +#' +#' @seealso \code{\link{summary.sample_size}} to summarize results +#' @export +sample_size <- function(type, err_mean = 2, sd_mean = 10, err_prop = .1, + p_prop = .5, conf_lev = 0.95, incidence = 1, + response = 1, pop_correction = "no", pop_size = 1000000) { + if (pop_correction == "yes" && is_not(pop_size)) pop_size <- 1000000 + if (is_not(conf_lev) || conf_lev < 0 || conf_lev > 1) conf_lev <- 0.95 + zval <- -qnorm((1 - conf_lev) / 2) + + if (type == "mean") { + if (is_not(err_mean)) { + return("Please select an acceptable error greater than 0" %>% + add_class("sample_size")) + } + n <- (zval^2 * sd_mean^2) / err_mean^2 + rm(err_prop, p_prop) + } else { + if (is_not(err_prop)) { + return("Please select an acceptable error greater than 0" %>% + add_class("sample_size")) + } + n <- (zval^2 * p_prop * (1 - p_prop)) / err_prop^2 + rm(err_mean, sd_mean) + } + + if (pop_correction == "yes") { + n <- n * pop_size / ((n - 1) + pop_size) + } else { + rm(pop_size) + } + + n <- ceiling(n) + + as.list(environment()) %>% add_class("sample_size") +} + +#' Summary method for the sample_size function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/design/sample_size.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{sample_size}} +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' sample_size(type = "mean", err_mean = 2, sd_mean = 10) %>% +#' summary() +#' +#' @seealso \code{\link{sample_size}} to generate the results +#' +#' @export +summary.sample_size <- function(object, ...) { + if (is.character(object)) { + return(object) + } + + cat("Sample size calculation\n") + + if (object$type == "mean") { + cat("Calculation type : Mean\n") + cat("Acceptable Error :", object$err_mean, "\n") + cat("Standard deviation :", object$sd_mean, "\n") + } else { + cat("Calculation type : Proportion\n") + cat("Acceptable Error :", object$err_prop, "\n") + cat("Proportion :", object$p_prop, "\n") + } + + cat("Confidence level :", object$conf_lev, "\n") + cat("Incidence rate :", object$incidence, "\n") + cat("Response rate :", object$response, "\n") + + if (object$pop_correction == "no") { + cat("Population correction: None\n") + } else { + cat("Population correction: Yes\n") + cat("Population size :", format_nr(object$pop_size, dec = 0), "\n") + } + + cat("\nRequired sample size :", format_nr(object$n, dec = 0)) + cat("\nRequired contact attempts:", format_nr(ceiling(object$n / object$incidence / object$response), dec = 0)) + + rm(object) +} diff --git a/radiant.design/R/sample_size_comp.R b/radiant.design/R/sample_size_comp.R new file mode 100644 index 0000000000000000000000000000000000000000..6a23687654189b988db097ffbe4fb01e0dffebf0 --- /dev/null +++ b/radiant.design/R/sample_size_comp.R @@ -0,0 +1,211 @@ +#' Sample size calculation for comparisons +#' +#' @details See \url{https://radiant-rstats.github.io/docs/design/sample_size_comp.html} for an example in Radiant +#' +#' @param type Choose "mean" or "proportion" +#' @param n1 Sample size for group 1 +#' @param n2 Sample size for group 2 +#' @param p1 Proportion 1 (only used when "proportion" is selected) +#' @param p2 Proportion 2 (only used when "proportion" is selected) +#' @param delta Difference in means between two groups (only used when "mean" is selected) +#' @param sd Standard deviation (only used when "mean" is selected) +#' @param conf_lev Confidence level +#' @param power Power +#' @param ratio Sampling ratio (n1 / n2) +#' @param alternative Two or one sided test +#' +#' @return A list of variables defined in sample_size_comp as an object of class sample_size_comp +#' +#' @seealso \code{\link{summary.sample_size_comp}} to summarize results +#' +#' @examples +#' sample_size_comp( +#' type = "proportion", p1 = 0.1, p2 = 0.15, +#' conf_lev = 0.95, power = 0.8 +#' ) +#' +#' @importFrom pwr pwr.2p.test pwr.2p2n.test ES.h pwr.t.test pwr.t2n.test +#' +#' @export +sample_size_comp <- function(type, n1 = NULL, n2 = NULL, p1 = NULL, p2 = NULL, delta = NULL, + sd = NULL, conf_lev = NULL, power = NULL, ratio = 1, + alternative = "two.sided") { + if (!is.null(n1) && is.na(n1)) n1 <- NULL + if (!is.null(n2) && is.na(n2)) n2 <- NULL + if (!is.null(power) && is.na(power)) power <- NULL + if (!is.null(conf_lev) && is.na(conf_lev)) conf_lev <- NULL + sig.level <- if (is.empty(conf_lev)) NULL else 1 - conf_lev + adj <- ifelse(alternative == "two.sided", 2, 1) + + if (type == "mean") { + if (!is.null(delta) && is.na(delta)) delta <- NULL + if (!is.null(delta)) delta <- abs(delta) + if (!is.null(sd) && is.na(sd)) sd <- NULL + + if (!is.empty(sd) && sd <= 0) { + return("The standard deviation must be larger than 0" %>% add_class("sample_size_comp")) + } + + nr_null <- any(is.null(n2), is.null(n1)) + is.null(delta) + is.null(sd) + is.null(power) + is.null(conf_lev) + if (nr_null == 0 || nr_null > 1) { + return("Exactly one of 'Sample size', 'Delta', 'Std. deviation',\n'Confidence level', and 'Power' must be blank or NULL" %>% add_class("sample_size_comp")) + } + + if (is.null(power) || is.null(sig.level)) { + res <- try(pwr::pwr.t2n.test(n1 = as.numeric(n1), n2 = as.numeric(n2), d = delta / sd, sig.level = sig.level, power = power, alternative = alternative), silent = TRUE) + } else if (is.null(n1) && is.null(n2)) { + res <- try(pwr::pwr.t.test(d = delta / sd, sig.level = sig.level, power = power, alternative = alternative), silent = TRUE) + if (!inherits(res, "try-error")) n1 <- n2 <- res$n + } else if (is.null(n1)) { + res <- try(pwr::pwr.t2n.test(n2 = as.numeric(n2), d = delta / sd, sig.level = sig.level, power = power, alternative = alternative), silent = TRUE) + if (!inherits(res, "try-error")) n1 <- res$n1 + } else if (is.null(n2)) { + res <- try(pwr::pwr.t2n.test(n1 = as.numeric(n1), d = delta / sd, sig.level = sig.level, power = power, alternative = alternative), silent = TRUE) + if (!inherits(res, "try-error")) n2 <- res$n2 + } else { + res <- try(pwr::pwr.t2n.test(n1 = as.numeric(n1), n2 = as.numeric(n2), sig.level = sig.level, power = power, alternative = alternative), silent = TRUE) + if (!inherits(res, "try-error")) { + if (is.null(delta)) { + delta <- res$d * sd + } else { + sd <- abs(delta / res$d) + } + } + } + } else { + if (!is.null(p1) && is.na(p1)) p1 <- NULL + if (!is.null(p2) && is.na(p2)) p2 <- NULL + + if (!is.null(p1) && !is.null(p2)) { + if (p1 == p2) { + return("Proportion 1 and 2 should not be set equal. Please change the proportion values" %>% add_class("sample_size_comp")) + } else if (p1 > p2 && alternative == "less") { + return("Proportion 1 must be smaller than proportion 2 if the alternative\n hypothesis is 'p1 less than p2'" %>% add_class("sample_size_comp")) + } else if (p1 < p2 && alternative == "greater") { + return("Proportion 1 must be larger than proportion 2 if the alternative\nhypothesis is 'p1 greater than p2'" %>% add_class("sample_size_comp")) + } + } + + if (!is.empty(p1) && (p1 < 0 || p1 > 1)) { + return("Proportion 1 must be between 0 and 1" %>% add_class("sample_size_comp")) + } + if (!is.empty(p2) && (p2 < 0 || p2 > 1)) { + return("Proportion 2 must be between 0 and 1" %>% add_class("sample_size_comp")) + } + + nr_null <- any(is.null(n2), is.null(n1)) + is.null(power) + is.null(p1) + is.null(p2) + is.null(conf_lev) + if (nr_null == 0 || nr_null > 1) { + return("Exactly one of 'Sample size', 'Proportion 1', 'Proportion 2',\n'Confidence level', and 'Power' must be blank or NULL" %>% add_class("sample_size_comp")) + } + + backout.ES.h <- function(h, p) { + sort( + c( + sin((h - 2 * asin(sqrt(p))) / 2)^2, + sin((-h - 2 * asin(sqrt(p))) / 2)^2 + ), + decreasing = TRUE + ) + } + + if (is.null(power) || is.null(sig.level)) { + res <- try(pwr::pwr.2p2n.test(n1 = as.numeric(n1), n2 = as.numeric(n2), h = pwr::ES.h(p1 = p1, p2 = p2), sig.level = sig.level, power = power, alternative = alternative), silent = TRUE) + } else if (is.null(n1) && is.null(n2)) { + res <- try(pwr::pwr.2p.test(h = pwr::ES.h(p1 = p1, p2 = p2), sig.level = sig.level, power = power, alternative = alternative), silent = TRUE) + if (!inherits(res, "try-error")) n1 <- n2 <- res$n + } else if (is.null(n1)) { + res <- try(pwr::pwr.2p2n.test(n2 = as.numeric(n2), h = pwr::ES.h(p1 = p1, p2 = p2), sig.level = sig.level, power = power, alternative = alternative), silent = TRUE) + if (!inherits(res, "try-error")) n1 <- res$n1 + } else if (is.null(n2)) { + res <- try(pwr::pwr.2p2n.test(n1 = as.numeric(n1), h = pwr::ES.h(p1 = p1, p2 = p2), sig.level = sig.level, power = power, alternative = alternative), silent = TRUE) + if (!inherits(res, "try-error")) n2 <- res$n2 + } else { + res <- try(pwr::pwr.2p2n.test(n1 = as.numeric(n1), n2 = as.numeric(n2), sig.level = sig.level, power = power, alternative = alternative), silent = TRUE) + if (!inherits(res, "try-error")) { + if (is.null(p1)) { + p1 <- backout.ES.h(res$h, p2) + if (alternative != "two.sided") { + p1 <- ifelse(alternative == "less", p1[2], p1[1]) + } + } else { + p2 <- backout.ES.h(res$h, p1) + if (alternative != "two.sided") { + p2 <- ifelse(alternative == "less", p2[1], p2[2]) + } + } + } + } + } + + as.list(environment()) %>% add_class("sample_size_comp") +} + +#' Summary method for the sample_size_comp function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/design/sample_size_comp.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{sample_size_comp}} +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{sample_size_comp}} to generate the results +#' +#' @examples +#' sample_size_comp( +#' type = "proportion", p1 = 0.1, p2 = 0.15, +#' conf_lev = 0.95, power = 0.8 +#' ) %>% summary() +#' +#' @importFrom pwr ES.h +#' +#' @export +summary.sample_size_comp <- function(object, ...) { + if (is.character(object)) { + return(object) + } + if (inherits(object$res, "try-error")) { + return("Provided input does not generate valid results. Update input values ...") + } + + cat("Sample size calculation for comparison of", ifelse(object$type == "proportion", "proportions", "means"), "\n") + cat(paste0("Sample size 1 : ", format_nr(ceiling(object$n1), dec = 0), "\n")) + cat(paste0("Sample size 2 : ", format_nr(ceiling(object$n2), dec = 0), "\n")) + cat(paste0("Total sample size: ", format_nr(ceiling(object$n1) + ceiling(object$n2), dec = 0), "\n")) + + if (object$type == "mean") { + cat("Delta :", object$delta, "\n") + cat("Std. deviation :", object$sd, "\n") + cat("Effect size :", object$delta / object$sd, "\n") + } else { + cat("Proportion 1 :", object$p1, "\n") + cat("Proportion 2 :", object$p2, "\n") + cat("Effect size :", pwr::ES.h(p1 = object$p1[1], p2 = object$p2[1]) %>% abs(), "\n") + } + cat("Confidence level :", 1 - object$res$sig.level, "\n") + cat("Power :", object$res$power, "\n") + cat("Alternative :", object$alternative, "\n\n") +} + +#' Plot method for the sample_size_comp function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/design/sample_size_comp.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{sample_size_comp}} +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{sample_size_comp}} to generate the results +#' +#' @examples +#' sample_size_comp( +#' type = "proportion", p1 = 0.1, p2 = 0.15, +#' conf_lev = 0.95, power = 0.8 +#' ) %>% plot() +#' +#' @importFrom pwr plot.power.htest +#' +#' @export +plot.sample_size_comp <- function(x, ...) { + if (is.character(x) || inherits(x$res, "try-error")) { + return(" ") + } + pwr::plot.power.htest(x$res) +} diff --git a/radiant.design/R/sampling.R b/radiant.design/R/sampling.R new file mode 100644 index 0000000000000000000000000000000000000000..6898695524d1fd6d1a9d5a623a54f1bc98ed57cd --- /dev/null +++ b/radiant.design/R/sampling.R @@ -0,0 +1,89 @@ +#' Simple random sampling +#' +#' @details See \url{https://radiant-rstats.github.io/docs/design/sampling.html} for an example in Radiant +#' +#' @param dataset Dataset to sample from +#' @param vars The variables to sample +#' @param sample_size Number of units to select +#' @param seed Random seed to use as the starting point +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param arr Expression to arrange (sort) the data on (e.g., "color, desc(price)") +#' @param rows Rows to select from the specified dataset +#' @param na.rm Remove rows with missing values (FALSE or TRUE) +#' @param envir Environment to extract data from +#' +#' @return A list of class 'sampling' with all variables defined in the sampling function +#' +#' @examples +#' sampling(rndnames, "Names", 10) +#' +#' @seealso \code{\link{summary.sampling}} to summarize results +#' @export +sampling <- function(dataset, vars, sample_size, + seed = 1234, data_filter = "", + arr = "", rows = NULL, + na.rm = FALSE, envir = parent.frame()) { + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, na.rm = na.rm, envir = envir) + if (is_not(sample_size)) { + return(add_class("Please select a sample size of 1 or greater", "sampling")) + } + + ## use seed if provided + seed %>% + gsub("[^0-9]", "", .) %>% + (function(x) if (!is.empty(x)) set.seed(x)) + + rnd_number <- data.frame(rnd_number = runif(nrow(dataset), min = 0, max = 1)) + dataset <- bind_cols(rnd_number, dataset) + seldat <- arrange(dataset, desc(rnd_number)) %>% + .[seq_len(max(1, sample_size)), , drop = FALSE] + + # removing unneeded arguments + rm(envir) + + as.list(environment()) %>% add_class("sampling") +} + +#' Summary method for the sampling function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/design/sampling.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{sampling}} +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @importFrom dplyr distinct +#' +#' @examples +#' sampling(rndnames, "Names", 10) %>% summary() +#' +#' @seealso \code{\link{sampling}} to generate the results +#' +#' @export +summary.sampling <- function(object, dec = 3, ...) { + cat("Sampling (simple random)\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + if (!is.empty(object$arr)) { + cat("Arrange :", gsub("\\n", "", object$arr), "\n") + } + if (!is.empty(object$rows)) { + cat("Slice :", gsub("\\n", "", object$rows), "\n") + } + cat("Variables :", object$var, "\n") + if (!is.empty(object$seed)) { + cat("Random seed:", object$seed, "\n") + } + if (is.empty(object$sample_size) || object$sample_size < 1) { + cat("Sample size: 1 (invalid input provided)\n") + } else { + cat("Sample size:", object$sample_size, "\n") + } + + is_unique <- object$dataset[, -1, drop = FALSE] %>% + (function(x) ifelse(nrow(x) > nrow(distinct(x)), "Based on selected variables some duplicate rows exist", "Based on selected variables, no duplicate rows exist")) + cat("Duplicates :", is_unique, "\n\n") +} diff --git a/radiant.design/README.md b/radiant.design/README.md new file mode 100644 index 0000000000000000000000000000000000000000..71774d3c8cef9058da6c62fa607962c828a2aef3 --- /dev/null +++ b/radiant.design/README.md @@ -0,0 +1,188 @@ +# Radiant - Business analytics using R and Shiny + + + +[![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/radiant.design)](https://CRAN.R-project.org/package=radiant.design) + + +Radiant is an open-source platform-independent browser-based interface for business analytics in [R](https://www.r-project.org/). The application is based on the [Shiny](https://shiny.posit.co/) package and can be run locally or on a server. Radiant was developed by Vincent Nijs. Please use the issue tracker on GitHub to suggest enhancements or report problems: https://github.com/radiant-rstats/radiant.design/issues. For other questions and comments please use radiant@rady.ucsd.edu. + +## Key features + +- Explore: Quickly and easily summarize, visualize, and analyze your data +- Cross-platform: It runs in a browser on Windows, Mac, and Linux +- Reproducible: Recreate results and share work with others as a state file or an [Rmarkdown](https://rmarkdown.rstudio.com/) report +- Programming: Integrate Radiant's analysis functions with your own R-code +- Context: Data and examples focus on business applications + + + + +#### Playlists + +There are two youtube playlists with video tutorials. The first provides a general introduction to key features in Radiant. The second covers topics relevant in a course on business analytics (i.e., Probability, Decision Analysis, Hypothesis Testing, Linear Regression, and Simulation). + +* Introduction to Radiant +* Radiant Tutorial Series + +#### Explore + +Radiant is interactive. Results update immediately when inputs are changed (i.e., no separate dialog boxes) and/or when a button is pressed (e.g., `Estimate` in _Model > Estimate > Logistic regression (GLM)_). This facilitates rapid exploration and understanding of the data. + +#### Cross-platform + +Radiant works on Windows, Mac, or Linux. It can run without an Internet connection and no data will leave your computer. You can also run the app as a web application on a server. + +#### Reproducible + +To conduct high-quality analysis, simply saving output is not enough. You need the ability to reproduce results for the same data and/or when new data become available. Moreover, others may want to review your analysis and results. Save and load the state of the application to continue your work at a later time or on another computer. Share state files with others and create reproducible reports using [Rmarkdown](https://rmarkdown.rstudio.com/). See also the section on `Saving and loading state` below + +If you are using Radiant on a server you can even share the URL (include the SSUID) with others so they can see what you are working on. Thanks for this feature go to [Joe Cheng](https://github.com/jcheng5). + +#### Programming + +Although Radiant's web-interface can handle quite a few data and analysis tasks, you may prefer to write your own R-code. Radiant provides a bridge to programming in R(studio) by exporting the functions used for analysis (i.e., you can conduct your analysis using the Radiant web-interface or by calling Radiant's functions directly from R-code). For more information about programming with Radiant see the [programming](https://radiant-rstats.github.io/docs/programming.html) page on the documentation site. + +#### Context + +Radiant focuses on business data and decisions. It offers tools, examples, and documentation relevant for that context, effectively reducing the business analytics learning curve. + +## How to install Radiant + +- Required: [R](https://cran.r-project.org/) version 4.0.0 or later +- Required: [Rstudio](https://posit.co/download/rstudio-server/) + +In Rstudio you can start and update Radiant through the `Addins` menu at the top of the screen. To install the latest version of Radiant for Windows or Mac, with complete documentation for off-line access, open R(studio) and copy-and-paste the command below: + +```r +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org")) +install.packages("radiant") +``` + +Once all packages are installed, select `Start radiant` from the `Addins` menu in Rstudio or use the command below to launch the app: + +```r +radiant::radiant() +``` + +To launch Radiant in Rstudio's viewer pane use the command below: + +```r +radiant::radiant_viewer() +``` + +To launch Radiant in an Rstudio Window use the command below: + +```r +radiant::radiant_window() +``` + +To easily update Radiant and the required packages, install the `radiant.update` package using: + +```r +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org")) +install.packages("remotes") +remotes::install_github("radiant-rstats/radiant.update", upgrade = "never") +``` + +Then select `Update radiant` from the `Addins` menu in Rstudio or use the command below: + +```r +radiant.update::radiant.update() +``` + +See the [installing radiant](https://radiant-rstats.github.io/docs/install.html) page additional for details. + +**Optional:** You can also create a launcher on your Desktop to start Radiant by typing `radiant::launcher()` in the R(studio) console and pressing return. A file called `radiant.bat` (windows) or `radiant.command` (mac) will be created that you can double-click to start Radiant in your default browser. The `launcher` command will also create a file called `update_radiant.bat` (windows) or `update_radiant.command` (mac) that you can double-click to update Radiant to the latest release. + +When Radiant starts you will see data on diamond prices. To close the application click the icon in the navigation bar and then click `Stop`. The Radiant process will stop and the browser window will close (Chrome) or gray-out. + +## Documentation + +Documentation and tutorials are available at and in the Radiant web interface (the icons on each page and the icon in the navigation bar). + +Individual Radiant packages also each have their own [pkgdown](https://github.com/r-lib/pkgdown) sites: + +* http://radiant-rstats.github.io/radiant +* http://radiant-rstats.github.io/radiant.data +* http://radiant-rstats.github.io/radiant.design +* http://radiant-rstats.github.io/radiant.basics +* http://radiant-rstats.github.io/radiant.model +* http://radiant-rstats.github.io/radiant.multivariate + +Want some help getting started? Watch the tutorials on the [documentation site](https://radiant-rstats.github.io/docs/tutorials.html). + + +## Reporting issues + +Please use the GitHub issue tracker at github.com/radiant-rstats/radiant/issues if you have any problems using Radiant. + +## Try Radiant online + +Not ready to install Radiant on your computer? Try it online at the link below: + +https://vnijs.shinyapps.io/radiant + +Do **not** upload sensitive data to this public server. The size of data upload has been restricted to 10MB for security reasons. + +## Running Radiant on shinyapps.io + +To run your own instance of Radiant on shinyapps.io first install Radiant and its dependencies. Then clone the radiant repo and ensure you have the latest version of the Radiant packages installed by running `radiant/inst/app/for.shinyapps.io.R`. Finally, open `radiant/inst/app/ui.R` and [deploy](https://shiny.posit.co/articles/shinyapps.html) the application. + +## Running Radiant on shiny-server + +You can also host Radiant using [shiny-server](https://posit.co/download/shiny-server/). First, install radiant on the server using the command below: + +```r +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org")) +install.packages("radiant") +``` + +Then clone the radiant repo and point shiny-server to the `inst/app/` directory. As a courtesy, please let me know if you intend to use Radiant on a server. + +When running Radiant on a server, by default, file uploads are limited to 10MB and R-code in _Report > Rmd_ and _Report > R_ will not be evaluated for security reasons. If you have `sudo` access to the server and have appropriate security in place you can change these settings by adding the following lines to `.Rprofile` for the `shiny` user on the server. + +```bash +options(radiant.maxRequestSize = -1) ## no file size limit +options(radiant.report = TRUE) +``` + +## Running Radiant in the cloud (e.g., AWS) + +To run radiant in the cloud you can use the customized Docker container. See https://github.com/radiant-rstats/docker for details + +## Saving and loading state + +To save your analyses save the state of the app to a file by clicking on the icon in the navbar and then on `Save radiant state file` (see also the _Data > Manage_ tab). You can open this state file at a later time or on another computer to continue where you left off. You can also share the file with others that may want to replicate your analyses. As an example, load the state file [`radiant-example.state.rda`](https://radiant-rstats.github.io/docs/examples/radiant-example.state.rda) by clicking on the icon in the navbar and then on `Load radiant state file`. Go to _Data > View_ and _Data > Visualize_ to see some of the settings from the previous "state" of the app. There is also a report in _Report > Rmd_ that was created using the Radiant interface. The html file `radiant-example.nb.html` contains the output. + +A related feature in Radiant is that state is maintained if you accidentally navigate to another web page, close (and reopen) the browser, and/or hit refresh. Use `Refresh` in the menu in the navigation bar to return to a clean/new state. + +Loading and saving state also works with Rstudio. If you start Radiant from Rstudio and use > `Stop` to stop the app, lists called `r_data`, `r_info`, and `r_state` will be put into Rstudio's global workspace. If you start radiant again using `radiant::radiant()` it will use these lists to restore state. Also, if you load a state file directly into Rstudio it will be used when you start Radiant to recreate a previous state. + +**Technical note**: Loading state works as follows in Radiant: When an input is initialized in a Shiny app you set a default value in the call to, for example, numericInput. In Radiant, when a state file has been loaded and an input is initialized it looks to see if there is a value for an input of that name in a list called `r_state`. If there is, this value is used. The `r_state` list is created when saving state using `reactiveValuesToList(input)`. An example of a call to `numericInput` is given below where the `state_init` function from `radiant.R` is used to check if a value from `r_state` can be used. + +```r +numericInput("sm_comp_value", "Comparison value:", state_init("sm_comp_value", 0)) +``` + +## Source code + +The source code for the radiant application is available on GitHub at . `radiant.data`, offers tools to load, save, view, visualize, summarize, combine, and transform data. `radiant.design` builds on `radiant.data` and adds tools for experimental design, sampling, and sample size calculation. `radiant.basics` covers the basics of statistical analysis (e.g., comparing means and proportions, cross-tabs, correlation, etc.) and includes a probability calculator. `radiant.model` covers model estimation (e.g., logistic regression and neural networks), model evaluation (e.g., gains chart, profit curve, confusion matrix, etc.), and decision tools (e.g., decision analysis and simulation). Finally, `radiant.multivariate` includes tools to generate brand maps and conduct cluster, factor, and conjoint analysis. + +These tools are used in the _Business Analytics_, _Quantitative Analysis_, _Research for Marketing Decisions_, _Applied Market Research_, _Consumer Behavior_, _Experiments in Firms_, _Pricing_, _Pricing Analytics_, and _Customer Analytics_ classes at the Rady School of Management (UCSD). + +## Credits + +Radiant would not be possible without [R](https://cran.r-project.org/) and [Shiny](https://shiny.posit.co/). I would like to thank [Joe Cheng](https://github.com/jcheng5), [Winston Chang](https://github.com/wch), and [Yihui Xie](https://github.com/yihui) for answering questions, providing suggestions, and creating amazing tools for the R community. Other key components used in Radiant are ggplot2, dplyr, tidyr, magrittr, broom, shinyAce, shinyFiles, rmarkdown, and DT. For an overview of other packages that Radiant relies on please see the about page. + + +## License + + +Radiant is licensed under the AGPLv3. As a summary, the AGPLv3 license requires, attribution, including copyright and license information in copies of the software, stating changes if the code is modified, and disclosure of all source code. Details are in the COPYING file. + +The documentation, images, and videos for the `radiant.data` package are licensed under the creative commons attribution and share-alike license CC-BY-SA. All other documentation and videos on this site, as well as the help files for `radiant.design`, `radiant.basics`, `radiant.model`, and `radiant.multivariate`, are licensed under the creative commons attribution, non-commercial, share-alike license CC-NC-SA. + +If you are interested in using any of the radiant packages please email me at radiant@rady.ucsd.edu + +© Vincent Nijs (2023) Creative Commons License \ No newline at end of file diff --git a/radiant.design/_pkgdown.yml b/radiant.design/_pkgdown.yml new file mode 100644 index 0000000000000000000000000000000000000000..c4cfe585a6e364806063eb80bb8af3ca9c1386bd --- /dev/null +++ b/radiant.design/_pkgdown.yml @@ -0,0 +1,80 @@ +url: https://radiant-rstats.github.io/radiant.design + +template: + params: + docsearch: + api_key: f8828bfa522c01496b23a387c7bec90e + index_name: radiant_design + +navbar: + title: "radiant.design" + left: + - icon: fa-home fa-lg + href: index.html + - text: "Reference" + href: reference/index.html + - text: "Articles" + href: articles/index.html + - text: "Changelog" + href: news/index.html + - text: "Other Packages" + menu: + - text: "radiant" + href: https://radiant-rstats.github.io/radiant/ + - text: "radiant.data" + href: https://radiant-rstats.github.io/radiant.data/ + - text: "radiant.design" + href: https://radiant-rstats.github.io/radiant.design/ + - text: "radiant.basics" + href: https://radiant-rstats.github.io/radiant.basics/ + - text: "radiant.model" + href: https://radiant-rstats.github.io/radiant.model/ + - text: "radiant.multivariate" + href: https://radiant-rstats.github.io/radiant.multivariate/ + - text: "docker" + href: https://github.com/radiant-rstats/docker + right: + - icon: fa-twitter fa-lg + href: https://twitter.com/vrnijs + - icon: fa-github fa-lg + href: https://github.com/radiant-rstats + +reference: +- title: Design > Design of Experiments (DOE) + desc: Functions used to create (fractional) factorial experimental designs + contents: + - doe + - summary.doe + - estimable +- title: Design > Sample + desc: Functions used with Design > Sample + contents: + - sampling + - summary.sampling + - randomizer + - summary.randomizer + - sample_size + - summary.sample_size + - sample_size_comp + - summary.sample_size_comp + - plot.sample_size_comp +- title: Data sets + desc: Data sets bundled with radiant.design + contents: + - rndnames +- title: Starting radiant.design + desc: Functions used to start the radiant.design shiny app + contents: + - radiant.design + - radiant.design_viewer + - radiant.design_window +articles: +- title: Design Menu + desc: > + These vignettes provide an introduction to the Design menu in radiant + contents: + - pkgdown/doe + - pkgdown/sampling + - pkgdown/randomizer + - pkgdown/sample_size + - pkgdown/sample_size_comp diff --git a/radiant.design/build/build.R b/radiant.design/build/build.R new file mode 100644 index 0000000000000000000000000000000000000000..0f6d467bbc9f5ea41763ee2f0e2af16325bb8a99 --- /dev/null +++ b/radiant.design/build/build.R @@ -0,0 +1,87 @@ +setwd(rstudioapi::getActiveProject()) +curr <- getwd() +pkg <- basename(curr) + +## building package for mac and windows +rv <- R.Version() +rv <- paste(rv$major, substr(rv$minor, 1, 1), sep = ".") + +rvprompt <- readline(prompt = paste0("Running for R version: ", rv, ". Is that what you wanted y/n: ")) +if (grepl("[nN]", rvprompt)) stop("Change R-version") + +dirsrc <- "../minicran/src/contrib" + +if (rv < "3.4") { + dirmac <- fs::path("../minicran/bin/macosx/mavericks/contrib", rv) +} else if (rv > "3.6") { + dirmac <- c( + fs::path("../minicran/bin/macosx/big-sur-arm64/contrib", rv), + fs::path("../minicran/bin/macosx/contrib", rv) + ) +} else { + dirmac <- fs::path("../minicran/bin/macosx/el-capitan/contrib", rv) +} + +dirwin <- fs::path("../minicran/bin/windows/contrib", rv) + +if (!fs::file_exists(dirsrc)) fs::dir_create(dirsrc, recursive = TRUE) +for (d in dirmac) { + if (!fs::file_exists(d)) fs::dir_create(d, recursive = TRUE) +} +if (!fs::file_exists(dirwin)) fs::dir_create(dirwin, recursive = TRUE) + +# delete older version of radiant +rem_old <- function(pkg) { + unlink(paste0(dirsrc, "/", pkg, "*")) + for (d in dirmac) { + unlink(paste0(d, "/", pkg, "*")) + } + unlink(paste0(dirwin, "/", pkg, "*")) +} + +sapply(pkg, rem_old) + +## avoid 'loaded namespace' stuff when building for mac +system(paste0(Sys.which("R"), " -e \"setwd('", getwd(), "'); app <- '", pkg, "'; source('build/build_mac.R')\"")) + +win <- readline(prompt = "Did you build on Windows? y/n: ") +if (grepl("[yY]", win)) { + + fl <- list.files(pattern = "*.zip", path = "~/Dropbox/r-packages/", full.names = TRUE) + for (f in fl) { + print(f) + file.copy(f, "~/gh/") + } + + ## move packages to radiant_miniCRAN. must package in Windows first + # path <- normalizePath("../") + pth <- fs::path_abs("../") + + sapply(list.files(pth, pattern = "*.tar.gz", full.names = TRUE), file.copy, dirsrc) + unlink("../*.tar.gz") + for (d in dirmac) { + sapply(list.files(pth, pattern = "*.tgz", full.names = TRUE), file.copy, d) + } + unlink("../*.tgz") + sapply(list.files(pth, pattern = "*.zip", full.names = TRUE), file.copy, dirwin) + unlink("../*.zip") + + tools::write_PACKAGES(dirwin, type = "win.binary") + for (d in dirmac) { + tools::write_PACKAGES(d, type = "mac.binary") + } + tools::write_PACKAGES(dirsrc, type = "source") + + # commit to repo + setwd("../minicran") + system("git add --all .") + mess <- paste0(pkg, " package update: ", format(Sys.Date(), format = "%m-%d-%Y")) + system(paste0("git commit -m '", mess, "'")) + system("git push") +} + +setwd(curr) + +# remove.packages(c("radiant.model", "radiant.data")) +# radiant.update::radiant.update() +# install.packages("radiant.update") diff --git a/radiant.design/build/build_mac.R b/radiant.design/build/build_mac.R new file mode 100644 index 0000000000000000000000000000000000000000..1452bac080e154c24c6cd9acb6eef6c09a76c6ae --- /dev/null +++ b/radiant.design/build/build_mac.R @@ -0,0 +1,6 @@ +## build for mac +app <- basename(getwd()) +curr <- setwd("../") +f <- devtools::build(app) +system(paste0("R CMD INSTALL --build ", f)) +setwd(curr) diff --git a/radiant.design/build/build_win.R b/radiant.design/build/build_win.R new file mode 100644 index 0000000000000000000000000000000000000000..e6861ceb5e94157a4ed21359a4d3339b9f1de8fb --- /dev/null +++ b/radiant.design/build/build_win.R @@ -0,0 +1,26 @@ +## build for windows +rv <- R.Version() +rv <- paste(rv$major, substr(rv$minor, 1, 1), sep = ".") + +rvprompt <- readline(prompt = paste0("Running for R version: ", rv, ". Is that what you wanted y/n: ")) +if (grepl("[nN]", rvprompt)) + stop("Change R-version using Rstudio > Tools > Global Options > Rversion") + +## build for windows +setwd(rstudioapi::getActiveProject()) +f <- devtools::build(binary = TRUE) +devtools::install(upgrade = "never") + +fl <- list.files(pattern = "*.zip", path = "../", full.names = TRUE) + +for (f in fl) { + print(glue::glue("Copying: {f}")) + file.copy(f, "C:/Users/vnijs/Dropbox/r-packages/", overwrite = TRUE) + unlink(f) +} + +#options(repos = c(RSM = "https://radiant-rstats.github.io/minicran")) +#install.packages("radiant.data", type = "binary") +# remove.packages(c("radiant.data", "radiant.model")) +#install.packages("radiant.update") +# radiant.update::radiant.update() diff --git a/radiant.design/data/rndnames.rda b/radiant.design/data/rndnames.rda new file mode 100644 index 0000000000000000000000000000000000000000..52dc57afd4407d75b05822dcf2ea48cd2a070815 Binary files /dev/null and b/radiant.design/data/rndnames.rda differ diff --git a/radiant.design/inst/app/global.R b/radiant.design/inst/app/global.R new file mode 100644 index 0000000000000000000000000000000000000000..32b0ac137dafd84b1b6d6cba2d26d8cdbff8c04d --- /dev/null +++ b/radiant.design/inst/app/global.R @@ -0,0 +1,33 @@ +# translation code +library(shiny.i18n) +# file with translations +i18n <- Translator$new(translation_csvs_path = "../translations") + +# change this to zh +i18n$set_translation_language("zh") +# translation code end + +## sourcing from radiant.data +options(radiant.path.data = system.file(package = "radiant.data")) +source(file.path(getOption("radiant.path.data"), "app/global.R"), encoding = getOption("radiant.encoding", default = "UTF-8"), local = TRUE) + +ifelse(grepl("radiant.design", getwd()) && file.exists("../../inst"), "..", system.file(package = "radiant.design")) %>% + options(radiant.path.design = .) + +## setting path for figures in help files +addResourcePath("figures_design", "tools/help/figures/") + +## setting path for www resources +addResourcePath("www_design", file.path(getOption("radiant.path.design"), "app/www/")) + +## loading urls and ui +source("init.R", encoding = getOption("radiant.encoding", "UTF-8"), local = TRUE) +options(radiant.url.patterns = make_url_patterns()) + +if (!"package:radiant.design" %in% search() && + isTRUE(getOption("radiant.development")) && + getOption("radiant.path.design") == "..") { + options(radiant.from.package = FALSE) +} else { + options(radiant.from.package = TRUE) +} diff --git a/radiant.design/inst/app/help.R b/radiant.design/inst/app/help.R new file mode 100644 index 0000000000000000000000000000000000000000..b7ed7a043ca641fed9cd4ba0e079dcdfd2ed5012 --- /dev/null +++ b/radiant.design/inst/app/help.R @@ -0,0 +1,24 @@ +help_design <- c( + "Design of Experiments" = "doe.md", "Random sampling" = "sampling.md", + "Random assignment" = "randomizer.md", "Sample size (single)" = "sample_size.Rmd", + "Sample size (compare)" = "sample_size_comp.Rmd" +) +output$help_design <- reactive(append_help("help_design", file.path(getOption("radiant.path.design"), "app/tools/help"), Rmd = TRUE)) + +observeEvent(input$help_design_all, { + help_switch(input$help_design_all, "help_design") +}) +observeEvent(input$help_design_none, { + help_switch(input$help_design_none, "help_design", help_on = FALSE) +}) + +help_design_panel <- tagList( + wellPanel( + HTML(""), + checkboxGroupInput( + "help_design", NULL, help_design, + selected = state_group("help_design"), inline = TRUE + ) + ) +) diff --git a/radiant.design/inst/app/init.R b/radiant.design/inst/app/init.R new file mode 100644 index 0000000000000000000000000000000000000000..faf0a3b61d9374a3d613382f65fb17245f9c6afb --- /dev/null +++ b/radiant.design/inst/app/init.R @@ -0,0 +1,31 @@ +# import_fs("radiant.design", libs = "mvtnorm", incl = "pmvnorm") + +## urls for menu +r_url_list <- getOption("radiant.url.list") +r_url_list[["Random sampling"]] <- "design/sampling/" +r_url_list[["Random assignment"]] <- "design/randomize/" +r_url_list[["Sample size (single)"]] <- "design/sample-size/" +r_url_list[["Sample size (compare)"]] <- "design/sample-size-comp/" +r_url_list[["Design of Experiments"]] <- "design/doe/" +options(radiant.url.list = r_url_list) +rm(r_url_list) + +## design menu +options( + radiant.design_ui = + tagList( + navbarMenu( + i18n$t("Design"), + tags$head( + tags$script(src = "www_design/js/run_return.js") + ), + "DOE", + tabPanel(i18n$t("Design of Experiments"), uiOutput("doe")), + "----", i18n$t("Sample"), + tabPanel(i18n$t("Random sampling"), uiOutput("sampling")), + tabPanel(i18n$t("Random assignment"), uiOutput("randomizer")), + tabPanel(i18n$t("Sample size (single)"), uiOutput("sample_size")), + tabPanel(i18n$t("Sample size (compare)"), uiOutput("sample_size_comp")) + ) + ) +) diff --git a/radiant.design/inst/app/server.R b/radiant.design/inst/app/server.R new file mode 100644 index 0000000000000000000000000000000000000000..73bd791a763ae4b151f982c4d69b988143757a24 --- /dev/null +++ b/radiant.design/inst/app/server.R @@ -0,0 +1,59 @@ +if (isTRUE(getOption("radiant.from.package"))) { + library(radiant.design) +} + +shinyServer(function(input, output, session) { + + ## source shared functions + source(file.path(getOption("radiant.path.data"), "app/init.R"), encoding = getOption("radiant.encoding"), local = TRUE) + source(file.path(getOption("radiant.path.data"), "app/radiant.R"), encoding = getOption("radiant.encoding"), local = TRUE) + + ## source data & app tools from radiant.data + for (file in list.files( + c( + file.path(getOption("radiant.path.data"), "app/tools/app"), + file.path(getOption("radiant.path.data"), "app/tools/data") + ), + pattern = "\\.(r|R)$", + full.names = TRUE)) { + source(file, encoding = getOption("radiant.encoding"), local = TRUE) + } + + ## setting up help + source("help.R", encoding = getOption("radiant.encoding"), local = TRUE) + + ## help ui + output$help_design_ui <- renderUI({ + sidebarLayout( + sidebarPanel( + help_data_panel, + help_design_panel, + uiOutput("help_text"), + width = 3 + ), + mainPanel( + HTML(paste0("

    Select help files to show and search

    ")), + htmlOutput("help_data"), + htmlOutput("help_design") + ) + ) + }) + + ## packages to use for example data + options(radiant.example.data = c("radiant.data", "radiant.design")) + + ## 'sourcing' package functions in the server.R environment for development + if (!isTRUE(getOption("radiant.from.package"))) { + for (file in list.files("../../R", pattern = "\\.(r|R)$", full.names = TRUE)) { + source(file, encoding = getOption("radiant.encoding"), local = TRUE) + } + cat("\nGetting radiant.design from source ...\n") + } + + ## source analysis tools for design app + for (file in list.files(c("tools/analysis"), pattern = "\\.(r|R)$", full.names = TRUE)) + source(file, encoding = getOption("radiant.encoding"), local = TRUE) + + ## save state on refresh or browser close + saveStateOnRefresh(session) +}) diff --git a/radiant.design/inst/app/tools/analysis/doe_ui.R b/radiant.design/inst/app/tools/analysis/doe_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..b01cec407553c365190390aae2cb5e0806b3c473 --- /dev/null +++ b/radiant.design/inst/app/tools/analysis/doe_ui.R @@ -0,0 +1,352 @@ +## list of function arguments +doe_args <- as.list(formals(doe)) + +## list of function inputs selected by user +doe_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(doe_args)) { + doe_args[[i]] <- input[[paste0("doe_", i)]] + } + doe_args +}) + +output$ui_doe_int <- renderUI({ + req(!is.empty(input$doe_factors)) + vars <- gsub("[ ]{2,}", " ", input$doe_factors) %>% + gsub("/", "", .) %>% + gsub("\\\\n", "\n", .) %>% + gsub("[ ]*;[ ]*", ";", .) %>% + gsub(";{2,}", ";", .) %>% + gsub("[;]+[ ]{0,}\n", "\n", .) %>% + gsub("[ ]{1,}\n", "\n", .) %>% + gsub("\n[ ]+", "\n", .) %>% + gsub("[\n]{2,}", "\n", .) %>% + gsub("[ ]+", "_", .) %>% + strsplit(., "\n") %>% + .[[1]] %>% + strsplit(";\\s*") %>% + sapply(function(x) x[1]) %>% + unique() + + req(length(vars) > 1) + choices <- iterms(vars, 2) + + selectInput( + "doe_int", + label = "Interactions:", choices = choices, + selected = state_init("doe_int"), + multiple = TRUE, size = min(3, length(choices)), selectize = FALSE + ) +}) + +output$ui_doe_levels <- renderUI({ + req(input$doe_max > 2) + make_level <- function(nr) { + textInput( + paste0("doe_level", nr), paste0("Level ", nr, ":"), + value = state_init(paste0("doe_level", nr)) + ) + } + lapply(3:input$doe_max, make_level) +}) + +## add a spinning refresh icon if the design needs to be (re)calculated +run_refresh(doe_args, "doe", init = "factors", label = i18n$t("Create design"), relabel = "Update design", data = FALSE) + +output$ui_doe <- renderUI({ + tagList( + wellPanel( + actionButton("doe_run", "Create design", width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ), + wellPanel( + tags$table( + tags$td( + numericInput( + "doe_max", + label = i18n$t("Max levels:"), min = 2, max = 10, + value = state_init("doe_max", init = 2), + width = "80px" + ) + ), + tags$td( + numericInput( + "doe_trials", + label = i18n$t("# trials:"), min = 1, step = 1, + value = state_init("doe_trials", init = NA), + width = "65px" + ) + ), + tags$td( + numericInput( + "doe_seed", + label = i18n$t("Rnd. seed:"), min = 0, + value = state_init("doe_seed", init = 1234), ## prev default seed 172110 + width = "100%" + ) + ) + ), + tagList( + tags$label(i18n$t("Variable name:")), + actionLink( + inputId = "doe_add", + label = NULL, + icon = icon("plus-circle", verify_fa = FALSE), + title = i18n$t("Add variable") + ), + actionLink( + inputId = "doe_del", + label = NULL, + icon = icon("minus-circle", verify_fa = FALSE), + title = i18n$t("Remove variable") + ) + ), + textInput("doe_name", NULL, value = state_init("doe_name", "")), + textInput("doe_level1", label = i18n$t("Level 1:"), value = state_init("doe_level1")), + textInput("doe_level2", label = i18n$t("Level 2:"), value = state_init("doe_level2")), + uiOutput("ui_doe_levels"), + uiOutput("ui_doe_int") + ), + wellPanel( + HTML(sprintf( + "
    ", + i18n$t("Save factorial design:") + )), + tags$table( + tags$td(download_button("doe_download_part", i18n$t("Partial"))), + tags$td(download_button("doe_download_full", i18n$t("Full"))) + ), + HTML(sprintf( + "

    ", + i18n$t("Save factors:") + )), + download_button("doe_download", i18n$t("Factors"), class = "btn-primary"), + HTML(sprintf( + "

    ", + i18n$t("Upload factors:") + )), + file_upload_button( + "doe_upload", + label = i18n$t("Upload factors:"), accept = ".txt", + buttonLabel = i18n$t("Factors"), title = i18n$t("Upload DOE factors"), class = "btn-primary" + ) + ), + help_and_report( + modal_title = i18n$t("Design of Experiments"), + fun_name = "doe", + help_file = inclMD(file.path(getOption("radiant.path.design"), "app/tools/help/doe.md")) + ) + ) +}) + +observeEvent(input$doe_add, { + req(input$doe_max) + dup <- input$doe_name + for (i in 1:input$doe_max) { + dtmp <- input[[paste0("doe_level", i)]] + if (!is.empty(dtmp)) dup <- c(dup, dtmp) + } + dup <- paste(dup, collapse = "; ") + + if (is.empty(input$doe_factors)) { + val <- dup + } else { + val <- paste0(input$doe_factors, "\n", dup) + } + + updateTextInput(session = session, "doe_factors", value = val) +}) + +observeEvent(input$doe_del, { + input$doe_factors %>% + strsplit("\n") %>% + unlist() %>% + head(., -1) %>% + paste0(collapse = "\n") %>% + updateTextInput(session = session, "doe_factors", value = .) +}) + +doe_maker <- function(id = "factors", rows = 5, pre = "doe_", + placeholder = i18n$t("Upload an experimental design using the 'Upload factors' button or create a new design using the inputs on the left of the screen. For help, click the ? icon on the bottom left of the screen") + ) { + id <- paste0(pre, id) + tags$textarea( + state_init(id), + id = id, + type = "text", + rows = rows, + autocomplete = "off", + autocorrect = "off", + autocapitalize = "off", + spellcheck = "false", + placeholder = placeholder, + class = "form-control" + ) +} + +## output is called from the main radiant ui.R +output$doe <- renderUI({ + register_print_output("summary_doe", ".summary_doe") + + ## single tab with components stacked + doe_output_panels <- tagList( + tabPanel( + i18n$t("Summary"), + HTML(sprintf("", i18n$t("Design factors:"))), + doe_maker("factors", rows = 5), + HTML(sprintf( + "
    ", + i18n$t("Generated experimental design:") + )), + verbatimTextOutput("summary_doe") + ) + ) + + stat_tab_panel( + menu = i18n$t("Design > DOE"), + tool = i18n$t("Design of Experiments"), + data = NULL, + tool_ui = "ui_doe", + output_panels = doe_output_panels + ) +}) + +.doe <- eventReactive(input$doe_run, { + req(!is.empty(input$doe_factors)) + + int <- "" + if (length(input$doe_int) > 0) { + int <- input$doe_int + } + + withProgress(message = "Generating design", value = 1, { + do.call(doe, doe_inputs()) + }) +}) + +.summary_doe <- reactive({ + summary(.doe(), eff = TRUE, part = TRUE, full = TRUE) +}) + +dl_doe_download_part <- function(path) { + .doe() %>% + (function(x) if (class(x)[1] == "character") x else x$part) %>% + write.csv(path, row.names = FALSE) +} + +download_handler( + id = "doe_download_part", + label = i18n$t("Partial"), + fun = dl_doe_download_part, + fn = "part_factorial", + caption = "Save partial factorial", + btn = "button" +) + +dl_doe_download_full <- function(path) { + .doe() %>% + (function(x) if (class(x)[1] == "character") x else x$full) %>% + write.csv(path, row.names = FALSE) +} + +download_handler( + id = "doe_download_full", + label = i18n$t("Full"), + fun = dl_doe_download_full, + fn = "full_factorial", + caption = "Save full factorial", + btn = "button" +) + +dl_doe_download <- function(path) { + cat(paste0(input$doe_factors, "\n"), file = path) +} + +download_handler( + id = "doe_download", + label = i18n$t("Factors"), + fun = dl_doe_download, + fn = "doe_factors", + caption = "Save DOE factors", + type = "txt", + class = "btn-primary", + btn = "button" +) + +if (!getOption("radiant.shinyFiles", FALSE)) { + doe_uploadfile <- shinyFiles::shinyFileChoose( + input = input, + id = "doe_upload", + session = session, + roots = volumes, + filetype = "txt" + ) +} + +observeEvent(input$doe_upload, { + if (getOption("radiant.shinyFiles", FALSE)) { + path <- shinyFiles::parseFilePaths(sf_volumes, input$doe_upload) + if (inherits(path, "try-error") || is.empty(path$datapath)) { + return() + } else { + path <- path$datapath + } + inFile <- data.frame( + name = basename(path), + datapath = path, + stringsAsFactors = FALSE + ) + } else { + inFile <- input$doe_upload + } + + fct <- paste0(readLines(inFile$datapath), collapse = "\n") + updateTextInput(session = session, "doe_factors", value = fct) + + ## cleaning out previous settings + updateNumericInput(session = session, "doe_max", value = 2) + updateNumericInput(session = session, "doe_trials", value = NA) + updateTextInput(session = session, "doe_name", value = "") + for (i in 1:10) { + r_state[[paste0("doe_level", i)]] <<- NULL + updateTextInput(session = session, paste0("doe_level", i), value = "") + } +}) + +doe_report <- function() { + if (getOption("radiant.local", default = FALSE)) { + pdir <- getOption("radiant.launch_dir") + xcmd <- paste0('# write.csv(result$part, file = "part_factorial.csv")') + } else { + xcmd <- "" + } + inp_out <- list(list(eff = TRUE, part = TRUE, full = TRUE)) + + inp <- clean_args(doe_inputs(), doe_args) + if (!is.empty(inp[["factors"]])) { + inp[["factors"]] <- strsplit(inp[["factors"]], "\n")[[1]] + } + + update_report( + inp_main = inp, + fun_name = "doe", + outputs = "summary", + inp_out = inp_out, + figs = FALSE, + xcmd = xcmd + ) +} + +observeEvent(input$doe_report, { + r_info[["latest_screenshot"]] <- NULL + doe_report() +}) + +observeEvent(input$doe_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_doe_screenshot") +}) + +observeEvent(input$modal_doe_screenshot, { + doe_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.design/inst/app/tools/analysis/randomizer_ui.R b/radiant.design/inst/app/tools/analysis/randomizer_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..9139a59c2b13dd9fa887422c10a24528be406f84 --- /dev/null +++ b/radiant.design/inst/app/tools/analysis/randomizer_ui.R @@ -0,0 +1,245 @@ +## list of function arguments +rndr_args <- as.list(formals(randomizer)) + +## list of function inputs selected by user +rndr_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + rndr_args$data_filter <- if (input$show_filter) input$data_filter else "" + rndr_args$arr <- if (input$show_filter) input$data_arrange else "" + rndr_args$rows <- if (input$show_filter) input$data_rows else "" + rndr_args$dataset <- input$dataset + for (i in r_drop(names(rndr_args))) { + rndr_args[[i]] <- input[[paste0("rndr_", i)]] + } + + rndr_args$conditions <- unlist(strsplit(rndr_args$conditions, "(\\s*,\\s*|\\s*;\\s*)")) %>% + fix_names() %T>% { + updateTextInput(session, "rndr_conditions", value = paste0(., collapse = ", ")) + } + + rndr_args +}) + +output$ui_rndr_vars <- renderUI({ + vars <- varnames() + selectInput( + inputId = "rndr_vars", label = i18n$t("Variables:"), + choices = vars, selected = state_multiple("rndr_vars", vars, vars), + multiple = TRUE, selectize = FALSE, + size = min(12, length(vars)) + ) +}) + +output$ui_rndr_blocks <- renderUI({ + vars <- varnames() + selectizeInput( + inputId = "rndr_blocks", label = i18n$t("Blocking variables:"), + choices = vars, selected = state_multiple("rndr_blocks", vars, c()), + multiple = TRUE, + options = list( + placeholder = i18n$t("Select blocking variables"), + plugins = list("remove_button") + ) + ) +}) + +output$ui_rndr_conditions <- renderUI({ + textAreaInput( + "rndr_conditions", label = i18n$t("Condition labels:"), + rows = 2, + placeholder = i18n$t("Type condition labels separated by comma's and press return"), + value = state_init("rndr_conditions", "A, B") + ) +}) + +output$ui_rndr_probs <- renderUI({ + req(input$rndr_conditions) + textInput( + "rndr_probs", label = i18n$t("Probabilities:"), + value = state_init("rndr_probs", ""), + placeholder = i18n$t("Probabilities:") + ) +}) + +output$ui_rndr_name <- renderUI({ + req(input$dataset) + textInput("rndr_name", label = i18n$t("Store as:"), placeholder = i18n$t("Provide a name"), value = "") +}) + +## add a spinning refresh icon if the simulation needs to be (re)run +run_refresh(rndr_args, "rndr", init = "vars", label = i18n$t("Assign conditions"), relabel = i18n$t("Re-assign conditions"), data = FALSE) + +output$ui_randomizer <- renderUI({ + req(input$dataset) + tagList( + wellPanel( + actionButton("rndr_run", label = i18n$t("Assign conditions"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ), + wellPanel( + uiOutput("ui_rndr_vars"), + uiOutput("ui_rndr_blocks"), + uiOutput("ui_rndr_conditions"), + uiOutput("ui_rndr_probs"), + textInput( + "rndr_label", label = i18n$t("Condition variable name:"), + placeholder = i18n$t("Provide a variable name"), + value = state_init("rndr_label", "默认变量名") + ), + numericInput("rndr_seed", label = i18n$t("Rnd. seed:"), min = 0, value = state_init("rndr_seed", init = 1234)) + ), + wellPanel( + tags$table( + tags$td(uiOutput("ui_rndr_name")), + tags$td(actionButton("rndr_store", label = i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ), + help_and_report( + modal_title = i18n$t("Random assignment"), + fun_name = "randomizer", + help_file = inclMD(file.path(getOption("radiant.path.design"), "app/tools/help/randomizer.md")) + ) + ) +}) + +output$randomizer <- renderUI({ + register_print_output("summary_randomizer", ".summary_randomizer") + + ## one output with components stacked + rndr_output_panels <- tagList( + tabPanel( + i18n$t("Summary"), + download_link("dl_randomizer"), br(), + verbatimTextOutput("summary_randomizer"), + conditionalPanel( + "input.rndr_vars != undefined && input.rndr_vars != null && input.rndr_vars.length > 0", + DT::dataTableOutput("table_randomizer") + ) + ) + ) + + stat_tab_panel( + menu = i18n$t("Design > Sample"), + tool = i18n$t("Random assignment"), + tool_ui = "ui_randomizer", + output_panels = rndr_output_panels + ) +}) + +.randomizer <- eventReactive(input$rndr_run, { + validate( + need(input$rndr_vars, "Select at least one variables") + ) + + withProgress(message = "Randomly assigning", value = 1, { + rndi <- rndr_inputs() + rndi$envir <- r_data + asNum <- function(x) ifelse(length(x) > 1, as.numeric(x[1]) / as.numeric(x[2]), as.numeric(x)) + rndi$probs <- unlist(strsplit(rndi$probs, "(\\s*,\\s*|\\s*;\\s*|\\s+)")) %>% + strsplit("/") %>% + sapply(asNum) + do.call(randomizer, rndi) + }) +}) + +.summary_randomizer <- reactive({ + if (not_pressed(input$rndr_run) || not_available(input$rndr_vars)) { + i18n$t( + "For random assignment each row in the data should be distinct (i.e., no duplicates). Please select an appropriate dataset." + ) %>% + suggest_data("rndnames") + } else { + summary(.randomizer()) + } +}) + +output$table_randomizer <- DT::renderDataTable({ + req(input$rndr_run) + withProgress(message = "Generating assignments", value = 1, { + isolate(.randomizer()$dataset) %>% dtab(dom = "tip") + }) +}) + +randomizer_report <- function() { + xcmd <- "# dtab(result$dataset, dom = \"tip\", nr = 100)" + + if (!is.empty(input$rndr_name)) { + dataset <- fix_names(input$rndr_name) + if (input$rndr_name != dataset) { + updateTextInput(session, inputId = "rndr_name", value = dataset) + } + xcmd <- paste0(xcmd, "\n", dataset, " <- result$dataset\nregister(\"", dataset, "\")") + } + + rndi <- rndr_inputs() + rndi$probs <- radiant.data::make_vec(rndi$probs) + + update_report( + inp_main = clean_args(rndi, rndr_args), + fun_name = "randomizer", outputs = "summary", + xcmd = xcmd, figs = FALSE + ) +} + +dl_randomizer <- function(path) { + resp <- .randomizer() + if ("dataset" %in% names(resp)) { + resp$dataset %>% write.csv(file = path, row.names = FALSE) + } else { + cat("No valid dataset available", file = path) + } +} + +download_handler( + id = "dl_randomizer", + fun = dl_randomizer, + fn = function() paste0(input$dataset, "_rnd"), + type = "csv", + caption = i18n$t("Save random assignment") +) + +observeEvent(input$rndr_store, { + req(input$rndr_name) + resp <- .randomizer() + if (!"dataset" %in% names(resp)) { + cat("No valid dataset available") + return() + } + + dataset <- fix_names(input$rndr_name) + if (input$rndr_name != dataset) { + updateTextInput(session, inputId = "rndr_name", value = dataset) + } + + r_data[[dataset]] <- resp$dataset + register(dataset) + updateSelectInput(session, "dataset", selected = input$dataset) + + ## See https://shiny.posit.co/reference/shiny/latest/modalDialog.html + showModal( + modalDialog( + title = i18n$t("Data Stored"), + span( + sprintf(i18n$t("Dataset '%s' was successfully added to the datasets dropdown. Add code to Report > Rmd or Report > R to (re)create the results by clicking the report icon on the bottom left of your screen."), + dataset) + ), + footer = modalButton(i18n$t("OK")), + size = "s", + easyClose = TRUE + ) + ) +}) + +observeEvent(input$randomizer_report, { + r_info[["latest_screenshot"]] <- NULL + randomizer_report() +}) + +observeEvent(input$randomizer_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_randomizer_screenshot") +}) + +observeEvent(input$modal_randomizer_screenshot, { + randomizer_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.design/inst/app/tools/analysis/sample_size_comp_ui.R b/radiant.design/inst/app/tools/analysis/sample_size_comp_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..a01668b329a08814902709851f5fceb913ec9f55 --- /dev/null +++ b/radiant.design/inst/app/tools/analysis/sample_size_comp_ui.R @@ -0,0 +1,192 @@ +############################### +# Sample size +############################### +ssc_type <- setNames( + c("mean", "proportion"), + c(i18n$t("Mean"), i18n$t("Proportion")) +) +# ssc_alternative <- c("Two sided" = "two.sided", "One sided" = "one.sided") +ssc_alternative <- setNames( + c("two.sided", "less", "greater"), + c(i18n$t("Two sided"), i18n$t("Group 1 less than Group 2"), i18n$t("Group 1 greater than Group 2")) +) +## list of function arguments +ssc_args <- as.list(formals(sample_size_comp)) + +## list of function inputs selected by user +ssc_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(ssc_args)) { + ssc_args[[i]] <- input[[paste0("ssc_", i)]] + } + ssc_args +}) + +output$ui_sample_size_comp <- renderUI({ + tagList( + wellPanel( + radioButtons( + inputId = "ssc_type", label = NULL, choices = ssc_type, + selected = state_init("ssc_type", "mean"), inline = TRUE + ), + numericInput( + "ssc_n1", i18n$t("Sample size (n1):"), + min = 1, + value = state_init("ssc_n1", NA), step = 1 + ), + numericInput( + "ssc_n2", i18n$t("Sample size (n2):"), + min = 1, + value = state_init("ssc_n2", NA), step = 1 + ), + conditionalPanel( + condition = "input.ssc_type == 'mean'", + numericInput( + "ssc_delta", i18n$t("Delta:"), + value = state_init("ssc_delta", 2), step = 1 + ), + numericInput( + "ssc_sd", i18n$t("Standard deviation:"), + min = 0, + value = state_init("ssc_sd", 10), step = 1 + ) + ), + conditionalPanel( + condition = "input.ssc_type != 'mean'", + numericInput( + "ssc_p1", i18n$t("Proportion 1 (p1):"), + min = 0, + max = 1, value = state_init("ssc_p1", .1), step = .05 + ), + numericInput( + "ssc_p2", i18n$t("Proportion 2 (p2):"), + min = 0, max = 1, + value = state_init("ssc_p2", .15), step = .05 + ) + ), + numericInput( + "ssc_conf_lev", i18n$t("Confidence level:"), + min = 0, max = 1, + value = state_init("ssc_conf_lev", 0.95), step = .05 + ), + numericInput( + "ssc_power", i18n$t("Power:"), + min = 0, max = 1, + value = state_init("ssc_power", 0.8), step = .05 + ), + selectInput( + inputId = "ssc_alternative", label = i18n$t("Alternative hypothesis:"), + choices = ssc_alternative, + selected = state_single("ssc_alternative", ssc_alternative, "two.sided") + ), + checkboxInput("ssc_show_plot", i18n$t("Show plot"), state_init("ssc_show_plot", FALSE)) + ), + help_and_report( + modal_title = i18n$t("Sample size (compare)"), fun_name = "sample_size_comp", + help_file = inclRmd(file.path(getOption("radiant.path.design"), "app/tools/help/sample_size_comp.Rmd")) + ) + ) +}) + +ssc_plot_width <- function() 650 +ssc_plot_height <- function() 650 + +output$sample_size_comp <- renderUI({ + register_print_output("summary_sample_size_comp", ".summary_sample_size_comp") + register_plot_output( + "plot_sample_size_comp", ".plot_sample_size_comp", + width_fun = "ssc_plot_width", + height_fun = "ssc_plot_height" + ) + + ## one output with components stacked + ssc_output_panels <- tagList( + tabPanel(i18n$t("Summary"), verbatimTextOutput("summary_sample_size_comp")), + tabPanel( + i18n$t("Summary"), + conditionalPanel( + "input.ssc_show_plot == true", + download_link("dlp_ssc"), + plotOutput("plot_sample_size_comp", height = "100%") + ) + ) + ) + + stat_tab_panel( + menu = i18n$t("Design > Sample"), + tool = i18n$t("Sample size (compare)"), + data = NULL, + tool_ui = "ui_sample_size_comp", + output_panels = ssc_output_panels + ) +}) + +.sample_size_comp <- reactive({ + do.call(sample_size_comp, ssc_inputs()) +}) + +.summary_sample_size_comp <- reactive({ + if (is.null(input$ssc_type)) { + return(invisible()) + } + summary(.sample_size_comp()) +}) + +.plot_sample_size_comp <- reactive({ + req(input$ssc_show_plot == TRUE) + plot(.sample_size_comp()) +}) + +sample_size_comp_report <- function() { + ssc <- ssc_inputs() + if (input$ssc_type == "mean") { + ssc$p1 <- ssc$p2 <- NULL + } else { + ssc$delta <- ssc$sd <- NULL + } + + inp_out <- list("", "") + outputs <- "summary" + figs <- FALSE + if (isTRUE(input$ssc_show_plot)) { + inp_out[[2]] <- list(custom = FALSE) + outputs <- c("summary", "plot") + figs <- TRUE + } + + update_report( + inp_main = clean_args(ssc, ssc_args), + fun_name = "sample_size_comp", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = ssc_plot_width(), + fig.height = ssc_plot_height() + ) +} + +download_handler( + id = "dlp_ssc", + fun = download_handler_plot, + fn = function() paste0("sample_size_comp_", input$ssc_type), + type = "png", + caption = i18n$t("Save sample size comparison plot"), + plot = .plot_sample_size_comp, + width = ssc_plot_width, + height = ssc_plot_height +) + +observeEvent(input$sample_size_comp_report, { + r_info[["latest_screenshot"]] <- NULL + sample_size_comp_report() +}) + +observeEvent(input$sample_size_comp_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_sample_size_comp_screenshot") +}) + +observeEvent(input$modal_sample_size_comp_screenshot, { + sample_size_comp_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.design/inst/app/tools/analysis/sample_size_ui.R b/radiant.design/inst/app/tools/analysis/sample_size_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..ef8eb152aa3c87431bf20a48358a696076854b81 --- /dev/null +++ b/radiant.design/inst/app/tools/analysis/sample_size_ui.R @@ -0,0 +1,181 @@ +############################### +# Sample size +############################### +ss_type <- setNames( + c("mean", "proportion"), + c(i18n$t("Mean"), i18n$t("Proportion")) +) + +ss_pop_correction <- setNames( + c("yes", "no"), + c(i18n$t("Yes"), i18n$t("No")) +) + +## list of function arguments +ss_args <- as.list(formals(sample_size)) + +## list of function inputs selected by user +ss_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(ss_args)) { + ss_args[[i]] <- input[[paste0("ss_", i)]] + } + ss_args +}) + +output$ui_sample_size <- renderUI({ + tagList( + wellPanel( + radioButtons( + inputId = "ss_type", label = NULL, choices = ss_type, + selected = state_init("ss_type", "mean"), inline = TRUE + ), + conditionalPanel( + condition = "input.ss_type == 'mean'", + tags$div( + title = i18n$t("The acceptable error is the level of precision you require (i.e., the range within which the true mean should lie). For example, ± $10. A lower acceptable error requires a larger sample size."), + # HTML(''), + numericInput( + "ss_err_mean", i18n$t("Acceptable Error:"), + min = 0, + value = state_init("ss_err_mean", 2), step = .1 + ) + ), + tags$div( + title = i18n$t("How much variation is there likely to be in the population? This number is often determined from a previous survey or a pilot study. The higher the standard deviation, the larger the required sample size."), + numericInput( + "ss_sd_mean", i18n$t("Standard deviation:"), + min = 0, + value = state_init("ss_sd_mean", 10), step = .1 + ) + ) + ), + conditionalPanel( + condition = "input.ss_type != 'mean'", + tags$div( + title = i18n$t("The acceptable error is the level of precision you require (i.e., the range within which the true proportion should lie). For example, ± 0.02. A lower acceptable error requires a larger sample size."), + numericInput( + "ss_err_prop", i18n$t("Acceptable Error:"), + min = 0, + max = 1, value = state_init("ss_err_prop", .1), step = .01 + ) + ), + tags$div( + title = i18n$t("What do you expect the sample proportion to be? This number is often determined from a previous survey or a pilot study. If no such information is availabvle use 0.5."), + numericInput( + "ss_p_prop", i18n$t("Proportion:"), + min = 0, max = 1, + value = state_init("ss_p_prop", .5), step = .05 + ) + ) + ), + tags$div( + title = i18n$t("Common values for the confidence level are 0.9, 0.95, and 0.99"), + numericInput( + "ss_conf_lev", i18n$t("Confidence level:"), + min = 0, max = 1, + value = state_init("ss_conf_lev", 0.95), step = .1 + ) + ), + tags$div( + title = i18n$t("The probability that a respondent will be part of the target segment of interest"), + numericInput( + "ss_incidence", i18n$t("Incidence rate:"), + min = 0, max = 1, + value = state_init("ss_incidence", 1), step = .05 + ) + ), + tags$div( + title = i18n$t("The probability of a response"), + numericInput( + "ss_response", i18n$t("Response rate:"), + min = 0, max = 1, + value = state_init("ss_response", 1), step = .05 + ) + ), + tags$div( + title = i18n$t("If the sample size is relatively larger compared to the size of the target population you should consider adjusting for population size"), + radioButtons( + inputId = "ss_pop_correction", + choices = ss_pop_correction, + label = i18n$t("Correct for population size:"), + selected = state_init("ss_pop_correction", "no"), + inline = TRUE + ) + ), + conditionalPanel( + condition = "input.ss_pop_correction == 'yes'", + tags$div( + title = i18n$t("Size of the target population of interest"), + numericInput( + "ss_pop_size", i18n$t("Population size:"), + min = 1, + value = state_init("ss_pop_size", 10^6), step = 1000 + ) + ) + ) + ), + help_and_report( + modal_title = i18n$t("Sample size (single)"), fun_name = "sample_size", + help_file = inclRmd(file.path(getOption("radiant.path.design"), "app/tools/help/sample_size.Rmd")) + ) + ) +}) + +output$sample_size <- renderUI({ + register_print_output("summary_sample_size", ".summary_sample_size") + + ## one output with components stacked + ss_output_panels <- tagList( + tabPanel(i18n$t("Summary"), verbatimTextOutput("summary_sample_size")) + ) + + stat_tab_panel( + menu = i18n$t("Design > Sample"), + tool = i18n$t("Sample size (single)"), + data = NULL, + tool_ui = "ui_sample_size", + output_panels = ss_output_panels + ) +}) + +.sample_size <- reactive({ + do.call(sample_size, ss_inputs()) +}) + +.summary_sample_size <- reactive({ + if (is.null(input$ss_type)) { + return(invisible()) + } + summary(.sample_size()) +}) + +sample_size_report <- function() { + ss <- ss_inputs() + if (input$ss_type == "mean") { + ss$err_prop <- ss$p_prop <- NULL + } else { + ss$err_mean <- ss$sd_mean <- NULL + } + + inp_main <- clean_args(ss, ss_args) + update_report( + inp_main = inp_main, + fun_name = "sample_size", outputs = "summary", figs = FALSE + ) +} + +observeEvent(input$sample_size_report, { + r_info[["latest_screenshot"]] <- NULL + sample_size_report() +}) + +observeEvent(input$sample_size_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_sample_size_screenshot") +}) + +observeEvent(input$modal_sample_size_screenshot, { + sample_size_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.design/inst/app/tools/analysis/sampling_ui.R b/radiant.design/inst/app/tools/analysis/sampling_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..31611bc7e9d1d560ea5cbb28770f6d48c795371d --- /dev/null +++ b/radiant.design/inst/app/tools/analysis/sampling_ui.R @@ -0,0 +1,218 @@ +############################### +# Sampling +############################### + +## list of function arguments +smp_args <- as.list(formals(sampling)) + +## list of function inputs selected by user +smp_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + smp_args$data_filter <- if (input$show_filter) input$data_filter else "" + smp_args$arr <- if (input$show_filter) input$data_arrange else "" + smp_args$rows <- if (input$show_filter) input$data_rows else "" + smp_args$dataset <- input$dataset + for (i in r_drop(names(smp_args))) { + smp_args[[i]] <- input[[paste0("smp_", i)]] + } + smp_args +}) + +output$ui_smp_vars <- renderUI({ + vars <- varnames() + selectInput( + inputId = "smp_vars", label = i18n$t("Variables:"), + choices = vars, selected = state_multiple("smp_vars", vars, vars), + multiple = TRUE, selectize = FALSE, + size = min(12, length(vars)) + ) +}) + +output$ui_smp_name <- renderUI({ + req(input$dataset) + textInput("smp_name", i18n$t("Store as:"), "", placeholder = i18n$t("Provide a name")) +}) + +output$ui_sampling <- renderUI({ + req(input$dataset) + tagList( + wellPanel( + uiOutput("ui_smp_vars"), + tags$table( + tags$td(numericInput( + "smp_sample_size", i18n$t("Sample size:"), + min = 1, + value = state_init("smp_sample_size", 1) + )), + tags$td(numericInput( + "smp_seed", + label = i18n$t("Rnd. seed:"), min = 0, + value = state_init("smp_seed", init = 1234) + )) + ), + checkboxInput("smp_sframe", i18n$t("Show sampling frame "), value = state_init("smp_sframe", FALSE)) + ), + wellPanel( + tags$table( + tags$td(uiOutput("ui_smp_name")), + tags$td(actionButton("smp_store", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ), + help_and_report( + modal_title = i18n$t("Sampling"), fun_name = "sampling", + help_file = inclMD(file.path(getOption("radiant.path.design"), "app/tools/help/sampling.md")) + ) + ) +}) + +output$sampling <- renderUI({ + register_print_output("summary_sampling", ".summary_sampling") + + ## one output with components stacked + smp_output_panels <- tagList( + tabPanel( + i18n$t("Summary"), + download_link("dl_sample"), br(), + verbatimTextOutput("summary_sampling"), + DT::dataTableOutput("table_sampling"), + conditionalPanel( + "input.smp_sframe == true", + DT::dataTableOutput("table_sampling_frame") + ) + ) + ) + + stat_tab_panel( + menu = i18n$t("Design > Sample"), + tool = i18n$t("Random sampling"), + tool_ui = "ui_sampling", + output_panels = smp_output_panels + ) +}) + +.sampling <- reactive({ + validate( + need(input$smp_vars, i18n$t("Select at least one variable")), + need(available(input$smp_vars), i18n$t("Some selected variables are not available in this dataset")) + ) + smpi <- smp_inputs() + smpi$envir <- r_data + do.call(sampling, smpi) +}) + +.summary_sampling <- reactive({ + if (not_available(input$smp_vars)) { + i18n$t("For random sampling each row in the data should be distinct(i.e., no duplicates). Please select an appropriate dataset.") %>% + suggest_data("rndnames") + } else if (is.empty(input$smp_sample_size)) { + i18n$t("Please select a sample size of 1 or greater") + } else { + summary(.sampling()) + } +}) + +output$table_sampling <- DT::renderDataTable({ + req(input$smp_vars, input$smp_sample_size) + withProgress(message = "Generating sample", value = 1, { + smp <- .sampling()$seldat + dom <- ifelse(nrow(smp) <= 10, "t", "tip") + dtab(smp, dom = dom, caption = i18n$t("Selected cases")) + }) +}) + +output$table_sampling_frame <- DT::renderDataTable({ + req(input$smp_vars, input$smp_sample_size, input$smp_sframe) + withProgress(message = "Show sampling frame", value = 1, { + smp <- .sampling() + dtab(smp$dataset, dom = "tip", caption = i18n$t("Sampling frame")) + }) +}) + +sampling_report <- function() { + req(input$smp_sample_size) + nr <- min(100, max(input$smp_sample_size, 1)) + xcmd <- paste0("# dtab(result$seldat, dom = \"tip\", caption = \"Selected cases\", nr = ", nr, ")") + if (isTRUE(input$smp_sframe)) { + xcmd <- paste0(xcmd, "\n# dtab(result$dataset, dom = \"tip\", caption = \"Sampling frame\", nr = 100)") + } + if (!is.empty(input$smp_name)) { + dataset <- fix_names(input$smp_name) + if (input$smp_name != dataset) { + updateTextInput(session, inputId = "smp_name", value = dataset) + } + xcmd <- paste0(xcmd, "\n", dataset, " <- select(result$seldat, -rnd_number)\nregister(\"", dataset, "\")") + } + + update_report( + inp_main = clean_args(smp_inputs(), smp_args), + fun_name = "sampling", outputs = "summary", + xcmd = xcmd, figs = FALSE + ) +} + +dl_sample <- function(path) { + resp <- .sampling() + if ("seldat" %in% names(resp)) { + seldat <- resp$seldat %>% select_at(setdiff(colnames(.), "rnd_number")) + write.csv(seldat, file = path, row.names = FALSE) + } else { + cat("No valid sample available", file = path) + } +} + +download_handler( + id = "dl_sample", + fun = dl_sample, + fn = function() paste0(input$dataset, "_sample"), + type = "csv", + caption = "Save random sample" +) + +observeEvent(input$smp_store, { + req(input$smp_name) + resp <- .sampling() + if (!"seldat" %in% names(resp)) { + cat(i18n$t("No valid sample available")) + return() + } + + dataset <- fix_names(input$smp_name) + if (input$smp_name != dataset) { + updateTextInput(session, inputId = "smp_name", value = dataset) + } + + r_data[[dataset]] <- resp$seldat %>% select_at(setdiff(colnames(.), "rnd_number")) + register(dataset) + updateSelectInput(session, "dataset", selected = input$dataset) + + ## See https://shiny.posit.co/reference/shiny/latest/modalDialog.html + showModal( + modalDialog( + title = i18n$t("Data Stored"), + span( + sprintf( + i18n$t("Dataset '%s' was successfully added to the datasets dropdown. Add code to Report > Rmd or Report > R to (re)create the results by clicking the report icon on the bottom left of your screen."), + dataset + ) + ), + footer = modalButton(i18n$t("OK")), + size = "s", + easyClose = TRUE + ) + ) +}) + +observeEvent(input$sampling_report, { + r_info[["latest_screenshot"]] <- NULL + sampling_report() +}) + +observeEvent(input$sampling_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_sampling_screenshot") +}) + +observeEvent(input$modal_sampling_screenshot, { + sampling_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.design/inst/app/tools/help/doe.md b/radiant.design/inst/app/tools/help/doe.md new file mode 100644 index 0000000000000000000000000000000000000000..21d45da06bb51ccdacb6ad1f1eccd6b1abae658f --- /dev/null +++ b/radiant.design/inst/app/tools/help/doe.md @@ -0,0 +1,69 @@ +> 实验设计 + +## 示例 + +假设我们想使用三个因素测试不同的电影院设计方案。 + +- **价格（Price）**：10 美元、13 美元或 16 美元 +- **视线（Sight）**：确定影院座位布局应为阶梯式还是非阶梯式 +- **食物（Food）**：确定应提供热狗和爆米花、美食，还是不提供任何食物 + +## 最大水平数 + +纳入分析的因素分别有 3、2 和 3 个水平，因此我们在 “最大水平数（Max levels）” 输入框中输入`3`。 + +## 变量名和水平 + +这里我们输入感兴趣的因素。例如，输入`price`作为变量名，将 10 美元作为水平 1，13 美元作为水平 2，16 美元作为水平 3。然后点击图标。这会将所提供的因素信息以 Radiant 分析所需的格式添加到 “设计因素（Design factors）” 窗口中。要删除 “设计因素” 窗口中的最后一行，点击图标。 + +输入三个因素的必要信息后，屏幕应显示如下： + +

    + +## 创建设计 + +现在可以通过点击 “创建设计（Create design）” 按钮生成实验设计，将产生以下输出。 + +

    + +在我们的示例中，理想设计包含 18 次试验。然而，这意味着部分因子设计和完全因子设计的规模相同。我们想知道是否可以减少试验次数，详见下方的 “试验次数（# trials）” 部分。 + +## 试验次数 + +该输入可用于控制生成的试验次数。如果留空，Radiant 将尝试使用AlgDesign包中的`optFederov`函数找到合适的试验次数。 + +让我们查看 “设计效率（Design efficiency）” 中的输出。在我们的示例中，目标是找到一个试验次数少于 18 次的设计，且该设计仍能让我们估计感兴趣的效应（例如，不同价格、视线和食物水平的主效应）。注意，有几个设计被认为是 “平衡的（balanced）”（即每个水平包含在相同数量的试验中）。我们要寻找一个平衡且因素间相关性最小的设计（例如，D 效率评分高于 0.8）。可以将 D 效率评分视为运行测试 / 实验后，我们能多清晰地估计感兴趣效应的度量。理想的 D 效率评分为 1，但高于 0.8 的评分被认为是合理的。 + +具有平衡设计的最小试验次数是 6 次。该设计之所以平衡，只是因为 6 能被 3 和 2（即我们因素的水平数）整除。然而，其 D 效率评分相当低（0.513）。下一个最小的平衡设计有 12 次试验，且具有高得多的 D 效率。如果我们想估计每个因素水平对电影院选择或偏好的主效应，这个设计是合理的选择。 + +要生成所需的部分因子设计，在 “试验次数（# trials）” 输入框中输入`12`，然后按 “创建设计（Create design）”，将产生以下输出。 + +

    + +输出中的 “试验（trial）” 列显示了从完全因子设计中选择的轮廓。请注意，只有当 D 效率等于 1 时，部分因子设计的（多系列）相关矩阵的非对角线元素才都会等于 0。polycor包用于估计因素间的相关性。 + +## 随机种子 + +部分因子设计可能不是唯一的（即可能存在多个同样好的试验或轮廓组合）。通过设置随机种子，每次点击 “创建设计” 时，都会生成相同的试验集。然而，要查看其他部分因子设计，清空 “随机种子（Rnd. seed）” 框并多次点击 “创建设计”，观察所选试验集的变化。 + +## 交互作用 + +请注意，如果我们使用包含 12 次试验的设计，将无法估计`price`、`sight`和`food`之间所有可能的交互作用。这是部分因子设计固有的权衡！事实上，如果我们确实想估计哪怕一个交互作用（例如，选择`price:sight`），合适的设计需要 18 次试验（即包含所有可能因素水平组合的完全因子设计的试验次数）。 + +## 部分因子和完全因子设计 + +点击 “部分（Partial）” 或 “完全（Full）” 按钮，以 csv 格式下载部分因子或完全因子设计。 + +## 上传和下载 + +要下载输入的因素列表，点击 “下载（Download）” 按钮。要上传先前创建的因素集，点击 “上传（Upload）” 按钮并浏览找到所需文件。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建设计。 + +### R 函数 + +有关 Radiant 中用于实验设计的相关 R 函数概述，请参见*设计 > 实验设计*。 + +`doe`工具中使用的来自`AlgDesign`包的核心函数是`optFederov`。 diff --git a/radiant.design/inst/app/tools/help/figures/doe_factors.png b/radiant.design/inst/app/tools/help/figures/doe_factors.png new file mode 100644 index 0000000000000000000000000000000000000000..4d07aa4cf383cdc82a77ca8adfea2f48c3d6c608 Binary files /dev/null and b/radiant.design/inst/app/tools/help/figures/doe_factors.png differ diff --git a/radiant.design/inst/app/tools/help/figures/doe_output.png b/radiant.design/inst/app/tools/help/figures/doe_output.png new file mode 100644 index 0000000000000000000000000000000000000000..e79efdf783b9f5e80bd8670200cbe11e9d714597 Binary files /dev/null and b/radiant.design/inst/app/tools/help/figures/doe_output.png differ diff --git a/radiant.design/inst/app/tools/help/figures/doe_output_partial.png b/radiant.design/inst/app/tools/help/figures/doe_output_partial.png new file mode 100644 index 0000000000000000000000000000000000000000..772eb649b44c1dfd5a5cfbc3af135d49b63ae182 Binary files /dev/null and b/radiant.design/inst/app/tools/help/figures/doe_output_partial.png differ diff --git a/radiant.design/inst/app/tools/help/figures/randomizer.png b/radiant.design/inst/app/tools/help/figures/randomizer.png new file mode 100644 index 0000000000000000000000000000000000000000..8798be044c37e5e89a43f1a43ef4d061f15f72a0 Binary files /dev/null and b/radiant.design/inst/app/tools/help/figures/randomizer.png differ diff --git a/radiant.design/inst/app/tools/help/figures/randomizer_block.png b/radiant.design/inst/app/tools/help/figures/randomizer_block.png new file mode 100644 index 0000000000000000000000000000000000000000..d922b0f239b9f642f65b1c38109d62b2e9e9e1fc Binary files /dev/null and b/radiant.design/inst/app/tools/help/figures/randomizer_block.png differ diff --git a/radiant.design/inst/app/tools/help/figures/sample_size_ex1a.png b/radiant.design/inst/app/tools/help/figures/sample_size_ex1a.png new file mode 100644 index 0000000000000000000000000000000000000000..7f6e492fe159cc69453f1793d8ace96785870b64 Binary files /dev/null and b/radiant.design/inst/app/tools/help/figures/sample_size_ex1a.png differ diff --git a/radiant.design/inst/app/tools/help/figures/sample_size_ex1b.png b/radiant.design/inst/app/tools/help/figures/sample_size_ex1b.png new file mode 100644 index 0000000000000000000000000000000000000000..f4a00bc2468031f8f2d332ecbbecdd98ea2cfdbe Binary files /dev/null and b/radiant.design/inst/app/tools/help/figures/sample_size_ex1b.png differ diff --git a/radiant.design/inst/app/tools/help/figures/sample_size_ex2a.png b/radiant.design/inst/app/tools/help/figures/sample_size_ex2a.png new file mode 100644 index 0000000000000000000000000000000000000000..4f1fcfe31135f4f21575bd8548a681e24cc3bc79 Binary files /dev/null and b/radiant.design/inst/app/tools/help/figures/sample_size_ex2a.png differ diff --git a/radiant.design/inst/app/tools/help/figures/sample_size_ex2b.png b/radiant.design/inst/app/tools/help/figures/sample_size_ex2b.png new file mode 100644 index 0000000000000000000000000000000000000000..2303ed46dc0659e862d09e55973ae81445c6a8bc Binary files /dev/null and b/radiant.design/inst/app/tools/help/figures/sample_size_ex2b.png differ diff --git a/radiant.design/inst/app/tools/help/figures/sampling.png b/radiant.design/inst/app/tools/help/figures/sampling.png new file mode 100644 index 0000000000000000000000000000000000000000..e63474072efc40436269a41f88136ac12352559c Binary files /dev/null and b/radiant.design/inst/app/tools/help/figures/sampling.png differ diff --git a/radiant.design/inst/app/tools/help/randomizer.md b/radiant.design/inst/app/tools/help/randomizer.md new file mode 100644 index 0000000000000000000000000000000000000000..a774f9e7c0dced52c91ea1ea737665441a8c6942 --- /dev/null +++ b/radiant.design/inst/app/tools/help/randomizer.md @@ -0,0 +1,29 @@ +> 随机分配受访者到实验条件 + +使用随机分配工具时，需选择数据集中每行均唯一（即无重复）的数据集。Radiant 中捆绑了一个符合此要求的数据集，可通过 “数据> 管理” 标签页获取（即从 “加载数据类型” 下拉菜单中选择`Examples`，然后点击 “加载”）。从 “数据集” 下拉菜单中选择`rndnames`。 + +`Names`是该数据集中的唯一标识符。如果我们选择这个变量并指定两个（或更多）“条件（Conditions）”（例如 “test（测试）” 和 “control（对照）”），将显示一个表格，其中包含`.conditions`列，表明每个人被（随机）分配到哪个条件。 + +默认情况下，“随机分配” 工具会为每个条件使用相等的概率。但如下方截图所示，也可以指定分配概率（例如 30% 分配到 “test”，70% 分配到 “control” 条件）。 + +

    + +如果我们预期某些变量可能预测实验结果，则可以使用 “区组化（blocking）” 来减少抽样变异。在区组随机分配（或分层随机分配）中，受试者首先根据一个或多个特征被分为不同区组（或层），然后在每个区组内进行随机分配。例如，如果我们选择`Gender`作为 “区组变量（Blocking variable）”，“随机分配” 工具将根据我们预先指定的 “概率（Probabilities）”，尝试将恰好 30% 的男性和恰好 30% 的女性分配到处理条件。如下方截图所示，男性和女性到测试组和对照组的分配结果完全符合预期。 + +

    + +默认情况下，随机种子设为`1234`，以确保抽样结果可重复。如果 “随机种子（Rnd. seed）” 输入框为空，每次生成样本时所选行都会变化。 + +要下载包含`.conditions`列分配结果的数据（CSV 格式），点击屏幕右上角的图标。也可以通过为数据集命名并点击 “存储（Store）” 按钮，将相同数据存储到 Radiant 中。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）生成样本。 + +### R 函数 + +有关 Radiant 中用于抽样和样本量计算的相关 R 函数概述，请参见*设计 > 样本*。 + +更多信息请参见 Radiant 的 “随机分配” 工具所使用的`randomizr`包的说明文档。 + +`randomizer`工具中使用的来自`randomizr`包的核心函数是`complete_ra`和`block_ra`。 diff --git a/radiant.design/inst/app/tools/help/sample_size.Rmd b/radiant.design/inst/app/tools/help/sample_size.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..37333a4cc76d260c18dd252e316863afa6dc8ea2 --- /dev/null +++ b/radiant.design/inst/app/tools/help/sample_size.Rmd @@ -0,0 +1,100 @@ +> 确定测试样本数据计算出的均值或比例所需的样本量 + +### 示例 1 + +我们计划开展一家互联网服务提供商（ISP）业务，需要为商业计划和模型估计家庭一周的平均互联网使用时间。为了有 95% 的把握使样本均值在总体均值的 10 分钟范围内，我们必须随机选择多少户家庭？假设之前的家庭使用情况调查显示标准差为 60.95 分钟。 + +**答案：** + +由于我们感兴趣的是估计总体中的平均（或均值）互联网使用时间，因此选择 “均值（Mean）” 的样本量计算。在下方截图中，我们输入 10（分钟）作为可接受误差，60.95 作为样本标准差的估计值，置信水平为 95%。 + +

    + +如你所见，所需样本量为 143，即我们需要从目标总体中获得 143 份有效响应，才能在给定的可接受误差、置信水平和样本标准差下对总体均值进行推断。该数值假设发生率和响应率均为 1（或 100%）。假设我们市场中只有 75% 的家庭在家中接入互联网，且预期响应率为 20%，那么需要联系的家庭数量是多少？ + +

    + +在上方截图中，发生率设为 75%，响应率设为 20%。所需有效响应数量与之前相同（143），但联系请求数量现在为 143÷0.75÷0.2 = 954。 + +来源 + +### 示例 2 + +假设你想调查某人群中 HIV 抗体的真实流行率是否为 10%。你计划随机抽样以估计该流行率，并希望有 95% 的置信度使总体真实比例落在根据样本计算的误差范围内。 + +假设总体规模为 5000，流行率的初始估计值为 10%，可接受误差为 4%。 + +**答案：** + +由于我们想要估计目标人群中 HIV 抗体阳性者的比例，因此选择 “比例（Proportion）” 的样本量计算。在下方截图中，我们输入 4% 作为可接受误差，10% 作为比例（p）的初始估计值，置信水平为 95%。 + +

    + +如你所见，所需样本量为 217，即我们需要 217 份有效响应，才能在给定的可接受误差和置信水平下对总体比例进行推断。该数值同样假设发生率和响应率为 100%。示例表明目标总体仅为 5000 人，因此可能值得应用总体规模校正。 + +

    + +在上方截图中，我们点击 “是（Yes）” 以应用总体校正，然后输入 5000 作为总体规模。所需有效响应数量从 217 略微降至 208。 + +一般而言，当所需样本量（n）相对于总体规模（N）较大时，总体规模会对所需样本量产生显著影响。例如，如果总体仅为 250 人，校正后的样本量将为 117，而非 217。 + +来源 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建样本量计算。 + +### 技术说明 + +#### 均值的样本量： + +$$ + n = \frac{ z^2 \times s^2 }{ E^2 } +$$ + +其中n为样本量，z是与期望置信水平相关的 z 值（例如，95% 置信水平对应的 z 值为 1.96），s是样本标准差，E是可接受误差。即使你之前没见过上述公式，可能也记得置信区间的公式： + +$$ + x \pm z \frac{s}{\sqrt{n}} +$$ + +xˉ两侧的区间等于E（即可接受误差）。两边平方并整理项可得样本量公式： + +$$ + E = z \frac{s}{\sqrt{n}} \; \Rightarrow \; n = \frac{ z^2 \times s^2 }{ E^2 } +$$ + +#### 比例的样本量： + +$$ + n = \frac{ z^2 \times p(1-p) }{ E^2 } +$$ + +其中n为样本量，z是与期望置信水平相关的 z 值（例如，95% 置信水平对应的 z 值为 1.96），p是样本比例，E是可接受误差。即使你之前没见过上述公式，可能也记得置信区间的公式： + +$$ + p \pm z \sqrt{ \frac{p(1-p)}{n} } +$$ + +p两侧的区间等于E（即可接受误差）。两边平方并整理项可得样本量公式： + +$$ + E = z \sqrt{ \frac{p(1-p)}{n} } \; \Rightarrow \; n = \frac{ z^2 p(1-p) }{ E^2 } +$$ + +#### 总体校正 + +虽然我们始终可以应用总体校正，但当所需样本量（n）相对于总体规模（N）较大时，总体规模才会对所需样本量产生显著影响。 +$$ + n^* = \frac{ nN }{ n - 1 + N } +$$ + +例如，假设我们确定需要从 5000 人的总体中抽取 217 人的样本，那么经总体规模校正后的样本量（n∗）计算如下： + +$$ + n^* = \frac{ 217 \times 5000 }{ 217 - 1 + 5000 } = 208 +$$ + +### R 函数 + +有关 Radiant 中用于抽样和样本量计算的相关 R 函数概述，请参见*设计 > 样本* 。 diff --git a/radiant.design/inst/app/tools/help/sample_size.md b/radiant.design/inst/app/tools/help/sample_size.md new file mode 100644 index 0000000000000000000000000000000000000000..37333a4cc76d260c18dd252e316863afa6dc8ea2 --- /dev/null +++ b/radiant.design/inst/app/tools/help/sample_size.md @@ -0,0 +1,100 @@ +> 确定测试样本数据计算出的均值或比例所需的样本量 + +### 示例 1 + +我们计划开展一家互联网服务提供商（ISP）业务，需要为商业计划和模型估计家庭一周的平均互联网使用时间。为了有 95% 的把握使样本均值在总体均值的 10 分钟范围内，我们必须随机选择多少户家庭？假设之前的家庭使用情况调查显示标准差为 60.95 分钟。 + +**答案：** + +由于我们感兴趣的是估计总体中的平均（或均值）互联网使用时间，因此选择 “均值（Mean）” 的样本量计算。在下方截图中，我们输入 10（分钟）作为可接受误差，60.95 作为样本标准差的估计值，置信水平为 95%。 + +

    + +如你所见，所需样本量为 143，即我们需要从目标总体中获得 143 份有效响应，才能在给定的可接受误差、置信水平和样本标准差下对总体均值进行推断。该数值假设发生率和响应率均为 1（或 100%）。假设我们市场中只有 75% 的家庭在家中接入互联网，且预期响应率为 20%，那么需要联系的家庭数量是多少？ + +

    + +在上方截图中，发生率设为 75%，响应率设为 20%。所需有效响应数量与之前相同（143），但联系请求数量现在为 143÷0.75÷0.2 = 954。 + +来源 + +### 示例 2 + +假设你想调查某人群中 HIV 抗体的真实流行率是否为 10%。你计划随机抽样以估计该流行率，并希望有 95% 的置信度使总体真实比例落在根据样本计算的误差范围内。 + +假设总体规模为 5000，流行率的初始估计值为 10%，可接受误差为 4%。 + +**答案：** + +由于我们想要估计目标人群中 HIV 抗体阳性者的比例，因此选择 “比例（Proportion）” 的样本量计算。在下方截图中，我们输入 4% 作为可接受误差，10% 作为比例（p）的初始估计值，置信水平为 95%。 + +

    + +如你所见，所需样本量为 217，即我们需要 217 份有效响应，才能在给定的可接受误差和置信水平下对总体比例进行推断。该数值同样假设发生率和响应率为 100%。示例表明目标总体仅为 5000 人，因此可能值得应用总体规模校正。 + +

    + +在上方截图中，我们点击 “是（Yes）” 以应用总体校正，然后输入 5000 作为总体规模。所需有效响应数量从 217 略微降至 208。 + +一般而言，当所需样本量（n）相对于总体规模（N）较大时，总体规模会对所需样本量产生显著影响。例如，如果总体仅为 250 人，校正后的样本量将为 117，而非 217。 + +来源 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建样本量计算。 + +### 技术说明 + +#### 均值的样本量： + +$$ + n = \frac{ z^2 \times s^2 }{ E^2 } +$$ + +其中n为样本量，z是与期望置信水平相关的 z 值（例如，95% 置信水平对应的 z 值为 1.96），s是样本标准差，E是可接受误差。即使你之前没见过上述公式，可能也记得置信区间的公式： + +$$ + x \pm z \frac{s}{\sqrt{n}} +$$ + +xˉ两侧的区间等于E（即可接受误差）。两边平方并整理项可得样本量公式： + +$$ + E = z \frac{s}{\sqrt{n}} \; \Rightarrow \; n = \frac{ z^2 \times s^2 }{ E^2 } +$$ + +#### 比例的样本量： + +$$ + n = \frac{ z^2 \times p(1-p) }{ E^2 } +$$ + +其中n为样本量，z是与期望置信水平相关的 z 值（例如，95% 置信水平对应的 z 值为 1.96），p是样本比例，E是可接受误差。即使你之前没见过上述公式，可能也记得置信区间的公式： + +$$ + p \pm z \sqrt{ \frac{p(1-p)}{n} } +$$ + +p两侧的区间等于E（即可接受误差）。两边平方并整理项可得样本量公式： + +$$ + E = z \sqrt{ \frac{p(1-p)}{n} } \; \Rightarrow \; n = \frac{ z^2 p(1-p) }{ E^2 } +$$ + +#### 总体校正 + +虽然我们始终可以应用总体校正，但当所需样本量（n）相对于总体规模（N）较大时，总体规模才会对所需样本量产生显著影响。 +$$ + n^* = \frac{ nN }{ n - 1 + N } +$$ + +例如，假设我们确定需要从 5000 人的总体中抽取 217 人的样本，那么经总体规模校正后的样本量（n∗）计算如下： + +$$ + n^* = \frac{ 217 \times 5000 }{ 217 - 1 + 5000 } = 208 +$$ + +### R 函数 + +有关 Radiant 中用于抽样和样本量计算的相关 R 函数概述，请参见*设计 > 样本* 。 diff --git a/radiant.design/inst/app/tools/help/sample_size_comp.Rmd b/radiant.design/inst/app/tools/help/sample_size_comp.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..041d36ea9cd36c3c60797c128717ad6d43d166c7 --- /dev/null +++ b/radiant.design/inst/app/tools/help/sample_size_comp.Rmd @@ -0,0 +1,37 @@ +> 确定均值或比例比较所需的样本量 + +留一个输入项为空以确定其数值。默认情况下，样本量输入项（*n1_和_n2*）留空，此时会计算两组的所需样本量。如果为_n1_和_n2_都提供了数值，则会计算其他留空输入项中的任意一项的数值。如果仅输入了_n1_（或_n2_）的数值，则必须提供所有其他输入项的数值，以确定_n2_（或_n1_）的所需样本量。 + +### 输入项 + +- 样本量：所需受访者数量 +- 置信水平：1 - 显著性水平（例如，0.95 = 1 - 0.05）。1, 2 +- 检验效能：1 - β（例如，0.8 = 1 - 0.2）。3 + +### 均值比较的输入项 + +- 差异（Delta）：我们希望检测到的组间均值差异 +- 标准差：假设的标准差 + +### 比例比较的输入项 + +- 比例 1：组 1 中的假设比例（例如，0.1） +- 比例 2：比例 1 加上我们希望检测到的差异（例如，0.1 + 0.05 = 0.15） + +**注意：** 要使对照组样本量（*n1*）与测试组样本量（*n2*）匹配，需将两个样本量输入项都留空（即两组规模相同）。如果提供了_n1_或_n2_的数值，组规模可能会不同。 + +1**显著性水平**（通常用α表示）是你愿意接受的、在原假设实际为真时拒绝原假设的最高概率。常用的显著性水平为 0.05（或 5%）。 + +21−α称为**置信水平**。常用的置信水平为 0.95（或 95%）。 + +3β（Beta）是原假设实际为假时接受原假设的概率。检验效能计算为 1 - β。常用的检验效能水平为 0.8（或 80%）。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建样本量计算。 + +### R 函数 + +有关 Radiant 中用于抽样和样本量计算的相关 R 函数概述，请参见*设计 > 样本*。 + +`sample_size_comp`工具中使用的来自`pwr`包的核心函数是`pwr.t2n.test`、`pwr.t.test`、`pwr.2p.test`、`pwr.2p2n.test`和`pwr.2p2n.test`。 diff --git a/radiant.design/inst/app/tools/help/sample_size_comp.md b/radiant.design/inst/app/tools/help/sample_size_comp.md new file mode 100644 index 0000000000000000000000000000000000000000..041d36ea9cd36c3c60797c128717ad6d43d166c7 --- /dev/null +++ b/radiant.design/inst/app/tools/help/sample_size_comp.md @@ -0,0 +1,37 @@ +> 确定均值或比例比较所需的样本量 + +留一个输入项为空以确定其数值。默认情况下，样本量输入项（*n1_和_n2*）留空，此时会计算两组的所需样本量。如果为_n1_和_n2_都提供了数值，则会计算其他留空输入项中的任意一项的数值。如果仅输入了_n1_（或_n2_）的数值，则必须提供所有其他输入项的数值，以确定_n2_（或_n1_）的所需样本量。 + +### 输入项 + +- 样本量：所需受访者数量 +- 置信水平：1 - 显著性水平（例如，0.95 = 1 - 0.05）。1, 2 +- 检验效能：1 - β（例如，0.8 = 1 - 0.2）。3 + +### 均值比较的输入项 + +- 差异（Delta）：我们希望检测到的组间均值差异 +- 标准差：假设的标准差 + +### 比例比较的输入项 + +- 比例 1：组 1 中的假设比例（例如，0.1） +- 比例 2：比例 1 加上我们希望检测到的差异（例如，0.1 + 0.05 = 0.15） + +**注意：** 要使对照组样本量（*n1*）与测试组样本量（*n2*）匹配，需将两个样本量输入项都留空（即两组规模相同）。如果提供了_n1_或_n2_的数值，组规模可能会不同。 + +1**显著性水平**（通常用α表示）是你愿意接受的、在原假设实际为真时拒绝原假设的最高概率。常用的显著性水平为 0.05（或 5%）。 + +21−α称为**置信水平**。常用的置信水平为 0.95（或 95%）。 + +3β（Beta）是原假设实际为假时接受原假设的概率。检验效能计算为 1 - β。常用的检验效能水平为 0.8（或 80%）。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建样本量计算。 + +### R 函数 + +有关 Radiant 中用于抽样和样本量计算的相关 R 函数概述，请参见*设计 > 样本*。 + +`sample_size_comp`工具中使用的来自`pwr`包的核心函数是`pwr.t2n.test`、`pwr.t.test`、`pwr.2p.test`、`pwr.2p2n.test`和`pwr.2p2n.test`。 diff --git a/radiant.design/inst/app/tools/help/sampling.md b/radiant.design/inst/app/tools/help/sampling.md new file mode 100644 index 0000000000000000000000000000000000000000..0a1ac088149680d1752ee69a1222de1a4a4dff3b --- /dev/null +++ b/radiant.design/inst/app/tools/help/sampling.md @@ -0,0 +1,23 @@ +> 使用简单随机抽样从抽样框中选择观测值 + +使用抽样工具时，需选择数据集中每行均唯一（即无重复）的数据集。Radiant 中捆绑了一个符合此要求的数据集，可通过 “数据> 管理” 标签页获取（即从 “加载数据类型（Load data of type）” 下拉菜单中选择`Examples`，然后点击 “加载（Load）”）。从 “数据集（Datasets）” 下拉菜单中选择`rndnames`。 + +`Names`是该数据集中的唯一标识符。如果我们选择这个变量并选择所需的样本量（例如 10），将生成所需长度的名称列表。 + +抽样原理是什么？数据中的每个人被分配一个来自均匀分布的 0 到 1 之间的随机数。然后根据该随机数对行进行排序，从列表中选取得分最高的n人作为样本。通过使用随机数，每个受访者被选入样本的概率相同。例如，如果我们需要从`rndnames`数据集中的 100 人中抽取 10 人的样本，每个人被纳入样本的概率为 10%。默认情况下，随机种子设为`1234`，以确保抽样结果可重复。如果 “随机种子（Rnd. seed）” 输入框为空，每次生成样本时所选行都会变化。 + +

    + +这 100 人的完整列表称为 “抽样框（sampling frame）”。理想情况下，这是目标市场中**所有**抽样单位（如客户或公司）的综合列表。要确定n的适当值，请使用 “设计（Design）” 菜单中的样本量工具。要显示完整的抽样框，点击 “显示抽样框（Show sampling frame）” 复选框。 + +要下载生成的样本数据（CSV 格式），点击屏幕右上角的图标。也可以通过为数据集命名并点击 “存储（Store）” 按钮，将创建的样本存储到 Radiant 中。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）生成样本。 + +### R 函数 + +有关 Radiant 中用于抽样和样本量计算的相关 R 函数概述，请参见*设计 > 样本*。 + +`sampling`工具中使用的来自`stats`包的核心函数是`runif`。该函数用于生成分配给可用数据中每行的随机数。 diff --git a/radiant.design/inst/app/ui.R b/radiant.design/inst/app/ui.R new file mode 100644 index 0000000000000000000000000000000000000000..7cc91e7ef40b725e07f7c22335b0cb625b57b714 --- /dev/null +++ b/radiant.design/inst/app/ui.R @@ -0,0 +1,13 @@ +## ui for design menu in radiant +navbar_proj( + do.call( + navbarPage, + c( + "Radiant for R", + getOption("radiant.nav_ui"), + getOption("radiant.design_ui"), + getOption("radiant.shared_ui"), + help_menu("help_design_ui") + ) + ) +) diff --git a/radiant.design/inst/app/www/js/run_return.js b/radiant.design/inst/app/www/js/run_return.js new file mode 100644 index 0000000000000000000000000000000000000000..1f75ae7f1fde89f00578f677ee4bf7f054860546 --- /dev/null +++ b/radiant.design/inst/app/www/js/run_return.js @@ -0,0 +1,25 @@ +// based on http://stackoverflow.com/a/32340906/1974918 +// and http://stackoverflow.com/a/8774101/1974918 +// run_return.js file not correctly loaded when running radiant design ui.R +$(document).keydown(function (event) { + // ...uploads don't have a visibility property/method ... + if ($("#doe_download").is(":visible") && (event.metaKey || event.ctrlKey) && event.shiftKey === false && event.keyCode == 79) { + // file dialog pops up twice for some weird reason when using ui.R + // ... but it works when running radiant from package ... + // CMD-o to load factors + $("#doe_upload").click(); + // document.getElementById("doe_upload").click(); + event.preventDefault(); + } else if ($("#doe_download").is(":visible") && (event.metaKey || event.ctrlKey) && event.shiftKey === false && event.keyCode == 83) { + // CMD-s to save factors + document.getElementById("doe_download").click(); + event.preventDefault(); + } + + if ($("#smp_name").is(":focus") && event.keyCode == 13) { + $("#smp_store").click(); + } else if ($("#rndr_name").is(":focus") && event.keyCode == 13) { + $("#rndr_store").click(); + } + +}); \ No newline at end of file diff --git a/radiant.design/inst/translations/translation_zh.csv b/radiant.design/inst/translations/translation_zh.csv new file mode 100644 index 0000000000000000000000000000000000000000..29e239ab4b51c8c2dc27e3df10b73c49d1fd2234 --- /dev/null +++ b/radiant.design/inst/translations/translation_zh.csv @@ -0,0 +1,102 @@ +en,zh,source +Help,帮助,"global.R, radiant.R" +Keyboard shortcuts,键盘快捷键,global.R +Rnd. seed:,随机种子：,"doe_ui.R, randomizer.R, sampling_ui.R" +Interactions:,交互：,doe_ui.R +Level :,水平 ：,doe_ui.R +Create design,生成设计,doe_ui.R +Max levels:,最大水平数：,doe_ui.R +# trials:,试验次数：,doe_ui.R +"Upload an experimental design using the 'Upload factors' button or create a new design using the inputs on the left of the screen. For help, click the ? icon on the bottom left of the screen",使用“上传因素”按钮上传实验设计，或通过页面左侧的输入创建新设计。如需帮助，请点击左下角的？图标。,doe.R +Variable name:,变量名：,doe.R +Add variable,添加变量,doe.R +Remove variable,移除变量,doe.R +Partial,部分,doe_ui.R +Full,全部,doe_ui.R +Factors,因素,doe_ui.R +Upload factors:,上传因素：,doe.R +Upload DOE factors,上传实验因素,doe_ui.R +Save factorial design:,保存实验设计：,doe_ui.R +Save factors:,保存因素：,doe_ui.R +Summary,摘要,"doe_ui.R, randomizer.R, sample_size_comp.R, sample_size_ui.R, sampling_ui.R" +Design factors:,实验因素,doe_ui.R +Generated experimental design:,生成的实验设计：,doe.R +Level 1:,水平 1：,doe.R +Level 2:,水平 2：,doe.R +Design > DOE,设计 > 实验设计,doe.R +Design of Experiments,实验设计,doe.R +Variables:,变量：,"randomizer.R, sampling_ui.R" +Blocking variables:,分组变量：,randomizer.R +Select blocking variables,选择分组变量,randomizer.R +Condition labels:,条件标签：,randomizer.R +Probabilities:,概率：,randomizer.R +"Enter probabilities (e.g., 1/2 1/2)",输入概率（例如 1/2 1/2）,randomizer.R +Store as:,存储为：,"randomizer.R, sampling_ui.R" +Provide a name,请输入名称,"randomizer.R, sampling_ui.R" +Assign conditions,分配条件,randomizer.R +Re-assign conditions,重新分配条件,randomizer.R +Store,存储,"randomizer.R, sampling_ui.R" +Design > Sample,设计 > 抽样,"randomizer.R, sample_size_comp.R, sample_size_ui.R, sampling_ui.R" +Random assignment,随机分配,randomizer.R +Save random assignment,保存随机分配,randomizer.R +"For random assignment each row in the data should be distinct (i.e., no duplicates). Please select an appropriate dataset.",每条记录都应唯一（无重复）。请选择合适的数据集。,randomizer.R +Type condition labels separated by comma's and press return,输入条件标签（用逗号分隔），然后按回车,randomizer.R +Data Stored,数据已存储,"randomizer.R, sampling_ui.R" +OK,确定,"randomizer.R, sampling_ui.R" +Dataset '%s' was successfully added to the datasets dropdown. Add code to Report > Rmd or Report > R to (re)create the results by clicking the report icon on the bottom left of your screen.,数据集‘%s’已成功添加到数据集下拉列表中。要在报告中复现结果，请点击左下角的报告图标，并将代码添加到 Report > Rmd 或 Report > R 中。,"randomizer.R, sampling_ui.R" +Condition variable name:,条件变量名：,randomizer.R +Provide a variable name,请输入变量名,randomizer.R +Sample size (compare),样本量（比较）,sample_size_comp.R +Sample size (n1):,样本量 (n1):,sample_size_comp.R +Sample size (n2):,样本量 (n2):,sample_size_comp.R +Mean,均值,"sample_size_comp.R, sample_size_ui.R" +Proportion:,比例,"sample_size_comp.R, sample_size_ui.R" +Delta:,差异值：,sample_size_comp.R +Standard deviation:,标准差,"sample_size_comp.R, sample_size_ui.R" +Confidence level:,置信水平,"sample_size_comp.R, sample_size_ui.R" +Power:,效能,sample_size_comp.R +Alternative hypothesis:,备择假设：,sample_size_comp.R +Two sided,双尾检验,sample_size_comp.R +Group 1 less than Group 2,组1 小于 组2,sample_size_comp.R +Group 1 greater than Group 2,组1 大于 组2,sample_size_comp.R +Show plot,显示图形,sample_size_comp.R +Plot,图表,sample_size_comp.R +Save sample size comparison plot,保存样本量比较图,sample_size_comp.R +Yes,是,sample_size_ui.R +No,否,sample_size_ui.R +"The acceptable error is the level of precision you require (i.e., the range within which the true mean should lie). For example, ± $10. A lower acceptable error requires a larger sample size.",可接受误差是您要求的精度范围（例如，±10美元）。更小的误差要求更大的样本量。,sample_size_ui.R +Acceptable Error:,可接受误差：,sample_size_ui.R +"How much variation is there likely to be in the population? This number is often determined from a previous survey or a pilot study. The higher the standard deviation, the larger the required sample size.",总体可能存在多大的变异？通常通过前期调查或试点研究确定。标准差越大，所需样本量越大。,sample_size_ui.R +What do you expect the sample proportion to be? This number is often determined from a previous survey or a pilot study. If no such information is availabvle use 0.5.,您期望的样本比例是多少？通常通过前期调查或试点研究确定。如无信息请使用0.5。,sample_size_ui.R +"Common values for the confidence level are 0.9, 0.95, and 0.99",置信水平常用值为0.9、0.95 和 0.99,sample_size_ui.R +The probability that a respondent will be part of the target segment of interest,受访者属于目标群体的概率,sample_size_ui.R +Incidence rate:,发生率：,sample_size_ui.R +The probability of a response,响应的概率,sample_size_ui.R +Response rate:,响应率：,sample_size_ui.R +If the sample size is relatively larger compared to the size of the target population you should consider adjusting for population size,如果样本量相对于总体较大，建议调整总体规模,sample_size_ui.R +Correct for population size:,考虑总体规模修正：,sample_size_ui.R +Size of the target population of interest,目标总体的规模,sample_size_ui.R +Population size:,总体规模：,sample_size_ui.R +Sample size (single),样本量（单个）,sample_size_ui.R +"The acceptable error is the level of precision you require (i.e., the range within which the true proportion should lie). For example, ± 0.02. A lower acceptable error requires a larger sample size.",可接受误差是您要求的精度范围（例如，±0.02）。更小的误差要求更大的样本量。,sample_size_ui.R +Proportion 1 (p1):,比例 1（p1）：,sample_size_comp.R +Proportion 2 (p2):,比例 2（p2）：,sample_size_comp.R +No valid sample available,无可用的样本数据,sampling_ui.R +Select at least one variable,请至少选择一个变量,sampling_ui.R +Some selected variables are not available in this dataset,部分选择的变量在数据集中不可用,sampling_ui.R +"For random sampling each row in the data should be distinct(i.e., no duplicates). Please select an appropriate dataset.",为了进行随机抽样，数据中的每一行都应是唯一的（即没有重复项）。请选择一个合适的数据集。\n\n,sampling_ui.R +Please select a sample size of 1 or greater,请选择一个大于等于 1 的样本量,sampling_ui.R +Selected cases,选中的样本,sampling_ui.R +Sampling frame,抽样框架,sampling_ui.R +Sampling,随机抽样,sampling_ui.R +Random sampling,随机抽样,sampling_ui.R +Show sampling frame ,显示抽样框,sampling_ui.R +Proportion,比例,sample_size_ui.R +Sample size:,样本量：,sampling_ui.R +Design,设计,init.R +Design of Experiments,实验设计,init.R +Sample,样本,init.R +Random sampling,随机抽样,init.R +Random assignment,随机分配,init.R +Sample size (single),单样本量,init.R +Sample size (compare),对比样本量,init.R diff --git a/radiant.design/man/doe.Rd b/radiant.design/man/doe.Rd new file mode 100644 index 0000000000000000000000000000000000000000..24e9e3de247724c06a2cbb3a859b2b901f07169b --- /dev/null +++ b/radiant.design/man/doe.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/doe.R +\name{doe} +\alias{doe} +\title{Create (partial) factorial design} +\usage{ +doe(factors, int = "", trials = NA, seed = NA) +} +\arguments{ +\item{factors}{Categorical variables used as input for design} + +\item{int}{Vector of interaction terms to consider when generating design} + +\item{trials}{Number of trials to create. If NA then all feasible designs will be considered until a design with perfect D-efficiency is found} + +\item{seed}{Random seed to use as the starting point} +} +\value{ +A list with all variables defined in the function as an object of class doe +} +\description{ +Create (partial) factorial design +} +\details{ +See \url{https://radiant-rstats.github.io/docs/design/doe.html} for an example in Radiant +} +\examples{ +doe(c("price; $10; $13; $16", "food; popcorn; gourmet; no food")) +doe( + c("price; $10; $13; $16", "food; popcorn; gourmet; no food"), + int = "price:food", trials = 9, seed = 1234 +) + +} +\seealso{ +\code{\link{summary.doe}} to summarize results +} diff --git a/radiant.design/man/estimable.Rd b/radiant.design/man/estimable.Rd new file mode 100644 index 0000000000000000000000000000000000000000..688278a6c50b2b6a8a641ed07dc0564e715b8e03 --- /dev/null +++ b/radiant.design/man/estimable.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/doe.R +\name{estimable} +\alias{estimable} +\title{Determine coefficients that can be estimated based on a partial factorial design} +\usage{ +estimable(design) +} +\arguments{ +\item{design}{An experimental design generated by the doe function that includes a partial and full factorial design} +} +\description{ +A function to determine which coefficients can be estimated based on a partial factorial design. Adapted from a function written by Blakeley McShane at https://github.com/fzettelmeyer/mktg482/blob/master/R/expdesign.R +} +\examples{ +design <- doe(c("price; $10; $13; $16", "food; popcorn; gourmet; no food"), trials = 6) +estimable(design) + +} diff --git a/radiant.design/man/plot.sample_size_comp.Rd b/radiant.design/man/plot.sample_size_comp.Rd new file mode 100644 index 0000000000000000000000000000000000000000..57e67128dfdb6a4a84ed2c3c8fa966ab12ff66bf --- /dev/null +++ b/radiant.design/man/plot.sample_size_comp.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sample_size_comp.R +\name{plot.sample_size_comp} +\alias{plot.sample_size_comp} +\title{Plot method for the sample_size_comp function} +\usage{ +\method{plot}{sample_size_comp}(x, ...) +} +\arguments{ +\item{x}{Return value from \code{\link{sample_size_comp}}} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the sample_size_comp function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/design/sample_size_comp.html} for an example in Radiant +} +\examples{ +sample_size_comp( + type = "proportion", p1 = 0.1, p2 = 0.15, + conf_lev = 0.95, power = 0.8 +) \%>\% plot() + +} +\seealso{ +\code{\link{sample_size_comp}} to generate the results +} diff --git a/radiant.design/man/radiant.design.Rd b/radiant.design/man/radiant.design.Rd new file mode 100644 index 0000000000000000000000000000000000000000..16b327f4b4f636ea9dfe5a871b07edca6bdb2d3d --- /dev/null +++ b/radiant.design/man/radiant.design.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R, R/radiant.R +\name{radiant.design} +\alias{radiant.design} +\title{radiant.design} +\usage{ +radiant.design(state, ...) +} +\arguments{ +\item{state}{Path to state file to load} + +\item{...}{additional arguments to pass to shiny::runApp (e.g, port = 8080)} +} +\description{ +Launch radiant.design in the default web browser +} +\details{ +See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +} +\examples{ +\dontrun{ +radiant.design() +} +} diff --git a/radiant.design/man/radiant.design_viewer.Rd b/radiant.design/man/radiant.design_viewer.Rd new file mode 100644 index 0000000000000000000000000000000000000000..2a3856fb965604730ed5402796230fb485da6435 --- /dev/null +++ b/radiant.design/man/radiant.design_viewer.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{radiant.design_viewer} +\alias{radiant.design_viewer} +\title{Launch radiant.design in the Rstudio viewer} +\usage{ +radiant.design_viewer(state, ...) +} +\arguments{ +\item{state}{Path to state file to load} + +\item{...}{additional arguments to pass to shiny::runApp (e.g, port = 8080)} +} +\description{ +Launch radiant.design in the Rstudio viewer +} +\details{ +See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +} +\examples{ +\dontrun{ +radiant.design_viewer() +} +} diff --git a/radiant.design/man/radiant.design_window.Rd b/radiant.design/man/radiant.design_window.Rd new file mode 100644 index 0000000000000000000000000000000000000000..4ccc74a16c2b7f801a219048423574454c03be8b --- /dev/null +++ b/radiant.design/man/radiant.design_window.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{radiant.design_window} +\alias{radiant.design_window} +\title{Launch radiant.design in an Rstudio window} +\usage{ +radiant.design_window(state, ...) +} +\arguments{ +\item{state}{Path to state file to load} + +\item{...}{additional arguments to pass to shiny::runApp (e.g, port = 8080)} +} +\description{ +Launch radiant.design in an Rstudio window +} +\details{ +See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +} +\examples{ +\dontrun{ +radiant.design_window() +} +} diff --git a/radiant.design/man/randomizer.Rd b/radiant.design/man/randomizer.Rd new file mode 100644 index 0000000000000000000000000000000000000000..36974eae1b759963171a32da58a60b3086abc707 --- /dev/null +++ b/radiant.design/man/randomizer.Rd @@ -0,0 +1,62 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/randomizer.R +\name{randomizer} +\alias{randomizer} +\title{Randomize cases into experimental conditions} +\usage{ +randomizer( + dataset, + vars, + conditions = c("A", "B"), + blocks = NULL, + probs = NULL, + label = ".conditions", + seed = 1234, + data_filter = "", + arr = "", + rows = NULL, + na.rm = FALSE, + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset to sample from} + +\item{vars}{The variables to sample} + +\item{conditions}{Conditions to assign to} + +\item{blocks}{A vector to use for blocking or a data.frame from which to construct a blocking vector} + +\item{probs}{A vector of assignment probabilities for each treatment conditions. By default each condition is assigned with equal probability} + +\item{label}{Name to use for the generated condition variable} + +\item{seed}{Random seed to use as the starting point} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{arr}{Expression to arrange (sort) the data on (e.g., "color, desc(price)")} + +\item{rows}{Rows to select from the specified dataset} + +\item{na.rm}{Remove rows with missing values (FALSE or TRUE)} + +\item{envir}{Environment to extract data from} +} +\value{ +A list of variables defined in randomizer as an object of class randomizer +} +\description{ +Randomize cases into experimental conditions +} +\details{ +Wrapper for the complete_ra and block_ra from the randomizr package. See \url{https://radiant-rstats.github.io/docs/design/randomizer.html} for an example in Radiant +} +\examples{ +randomizer(rndnames, "Names", conditions = c("test", "control")) \%>\% str() + +} +\seealso{ +\code{\link{summary.sampling}} to summarize results +} diff --git a/radiant.design/man/rndnames.Rd b/radiant.design/man/rndnames.Rd new file mode 100644 index 0000000000000000000000000000000000000000..58a3464788c1aee610c9f527f3de55a00fa1a5d6 --- /dev/null +++ b/radiant.design/man/rndnames.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{rndnames} +\alias{rndnames} +\title{100 random names} +\format{ +A data frame with 100 rows and 2 variables +} +\usage{ +data(rndnames) +} +\description{ +100 random names +} +\details{ +A list of 100 random names. Description provided in attr(rndnames,"description") +} +\keyword{datasets} diff --git a/radiant.design/man/sample_size.Rd b/radiant.design/man/sample_size.Rd new file mode 100644 index 0000000000000000000000000000000000000000..dba2c1b591d4cb9f677d428e313e89f79d0cc2c3 --- /dev/null +++ b/radiant.design/man/sample_size.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sample_size.R +\name{sample_size} +\alias{sample_size} +\title{Sample size calculation} +\usage{ +sample_size( + type, + err_mean = 2, + sd_mean = 10, + err_prop = 0.1, + p_prop = 0.5, + conf_lev = 0.95, + incidence = 1, + response = 1, + pop_correction = "no", + pop_size = 1e+06 +) +} +\arguments{ +\item{type}{Choose "mean" or "proportion"} + +\item{err_mean}{Acceptable Error for Mean} + +\item{sd_mean}{Standard deviation for Mean} + +\item{err_prop}{Acceptable Error for Proportion} + +\item{p_prop}{Initial proportion estimate for Proportion} + +\item{conf_lev}{Confidence level} + +\item{incidence}{Incidence rate (i.e., fraction of valid respondents)} + +\item{response}{Response rate} + +\item{pop_correction}{Apply correction for population size ("yes","no")} + +\item{pop_size}{Population size} +} +\value{ +A list of variables defined in sample_size as an object of class sample_size +} +\description{ +Sample size calculation +} +\details{ +See \url{https://radiant-rstats.github.io/docs/design/sample_size.html} for an example in Radiant +} +\examples{ +sample_size(type = "mean", err_mean = 2, sd_mean = 10) + +} +\seealso{ +\code{\link{summary.sample_size}} to summarize results +} diff --git a/radiant.design/man/sample_size_comp.Rd b/radiant.design/man/sample_size_comp.Rd new file mode 100644 index 0000000000000000000000000000000000000000..0e8b368ae906b29b45102d516bce435a51d5b0e3 --- /dev/null +++ b/radiant.design/man/sample_size_comp.Rd @@ -0,0 +1,62 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sample_size_comp.R +\name{sample_size_comp} +\alias{sample_size_comp} +\title{Sample size calculation for comparisons} +\usage{ +sample_size_comp( + type, + n1 = NULL, + n2 = NULL, + p1 = NULL, + p2 = NULL, + delta = NULL, + sd = NULL, + conf_lev = NULL, + power = NULL, + ratio = 1, + alternative = "two.sided" +) +} +\arguments{ +\item{type}{Choose "mean" or "proportion"} + +\item{n1}{Sample size for group 1} + +\item{n2}{Sample size for group 2} + +\item{p1}{Proportion 1 (only used when "proportion" is selected)} + +\item{p2}{Proportion 2 (only used when "proportion" is selected)} + +\item{delta}{Difference in means between two groups (only used when "mean" is selected)} + +\item{sd}{Standard deviation (only used when "mean" is selected)} + +\item{conf_lev}{Confidence level} + +\item{power}{Power} + +\item{ratio}{Sampling ratio (n1 / n2)} + +\item{alternative}{Two or one sided test} +} +\value{ +A list of variables defined in sample_size_comp as an object of class sample_size_comp +} +\description{ +Sample size calculation for comparisons +} +\details{ +See \url{https://radiant-rstats.github.io/docs/design/sample_size_comp.html} for an example in Radiant +} +\examples{ +sample_size_comp( + type = "proportion", p1 = 0.1, p2 = 0.15, + conf_lev = 0.95, power = 0.8 +) + +} +\seealso{ +\code{\link{summary.sample_size_comp}} to summarize results +} diff --git a/radiant.design/man/sampling.Rd b/radiant.design/man/sampling.Rd new file mode 100644 index 0000000000000000000000000000000000000000..c26a208126e5791939c8443693199ab236166860 --- /dev/null +++ b/radiant.design/man/sampling.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sampling.R +\name{sampling} +\alias{sampling} +\title{Simple random sampling} +\usage{ +sampling( + dataset, + vars, + sample_size, + seed = 1234, + data_filter = "", + arr = "", + rows = NULL, + na.rm = FALSE, + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset to sample from} + +\item{vars}{The variables to sample} + +\item{sample_size}{Number of units to select} + +\item{seed}{Random seed to use as the starting point} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{arr}{Expression to arrange (sort) the data on (e.g., "color, desc(price)")} + +\item{rows}{Rows to select from the specified dataset} + +\item{na.rm}{Remove rows with missing values (FALSE or TRUE)} + +\item{envir}{Environment to extract data from} +} +\value{ +A list of class 'sampling' with all variables defined in the sampling function +} +\description{ +Simple random sampling +} +\details{ +See \url{https://radiant-rstats.github.io/docs/design/sampling.html} for an example in Radiant +} +\examples{ +sampling(rndnames, "Names", 10) + +} +\seealso{ +\code{\link{summary.sampling}} to summarize results +} diff --git a/radiant.design/man/summary.doe.Rd b/radiant.design/man/summary.doe.Rd new file mode 100644 index 0000000000000000000000000000000000000000..12ec239504ed3ed40dfcd67c5d7a2a85a87678f4 --- /dev/null +++ b/radiant.design/man/summary.doe.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/doe.R +\name{summary.doe} +\alias{summary.doe} +\title{Summary method for doe function} +\usage{ +\method{summary}{doe}(object, eff = TRUE, part = TRUE, full = TRUE, est = TRUE, dec = 3, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{doe}}} + +\item{eff}{If TRUE print efficiency output} + +\item{part}{If TRUE print partial factorial} + +\item{full}{If TRUE print full factorial} + +\item{est}{If TRUE print number of effects that will be estimable using the partial factorial design} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods.} +} +\description{ +Summary method for doe function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/design/doe.html} for an example in Radiant +} +\examples{ +c("price; $10; $13; $16", "food; popcorn; gourmet; no food") \%>\% + doe() \%>\% + summary() + +} +\seealso{ +\code{\link{doe}} to calculate results +} diff --git a/radiant.design/man/summary.randomizer.Rd b/radiant.design/man/summary.randomizer.Rd new file mode 100644 index 0000000000000000000000000000000000000000..4c980c43c1222c9984dbe57b4dd20e9889f27407 --- /dev/null +++ b/radiant.design/man/summary.randomizer.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/randomizer.R +\name{summary.randomizer} +\alias{summary.randomizer} +\title{Summary method for the randomizer function} +\usage{ +\method{summary}{randomizer}(object, dec = 3, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{randomizer}}} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the randomizer function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/design/randomizer.html} for an example in Radiant +} +\examples{ +randomizer(rndnames, "Names", conditions = c("test", "control")) \%>\% summary() + +} +\seealso{ +\code{\link{randomizer}} to generate the results +} diff --git a/radiant.design/man/summary.sample_size.Rd b/radiant.design/man/summary.sample_size.Rd new file mode 100644 index 0000000000000000000000000000000000000000..3a4a7cc3636a328d31e5ddb7012c605686d3111f --- /dev/null +++ b/radiant.design/man/summary.sample_size.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sample_size.R +\name{summary.sample_size} +\alias{summary.sample_size} +\title{Summary method for the sample_size function} +\usage{ +\method{summary}{sample_size}(object, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{sample_size}}} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the sample_size function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/design/sample_size.html} for an example in Radiant +} +\examples{ +sample_size(type = "mean", err_mean = 2, sd_mean = 10) \%>\% + summary() + +} +\seealso{ +\code{\link{sample_size}} to generate the results +} diff --git a/radiant.design/man/summary.sample_size_comp.Rd b/radiant.design/man/summary.sample_size_comp.Rd new file mode 100644 index 0000000000000000000000000000000000000000..1e87faed84ce05e8123cdb0d987601346b89c00c --- /dev/null +++ b/radiant.design/man/summary.sample_size_comp.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sample_size_comp.R +\name{summary.sample_size_comp} +\alias{summary.sample_size_comp} +\title{Summary method for the sample_size_comp function} +\usage{ +\method{summary}{sample_size_comp}(object, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{sample_size_comp}}} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the sample_size_comp function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/design/sample_size_comp.html} for an example in Radiant +} +\examples{ +sample_size_comp( + type = "proportion", p1 = 0.1, p2 = 0.15, + conf_lev = 0.95, power = 0.8 +) \%>\% summary() + +} +\seealso{ +\code{\link{sample_size_comp}} to generate the results +} diff --git a/radiant.design/man/summary.sampling.Rd b/radiant.design/man/summary.sampling.Rd new file mode 100644 index 0000000000000000000000000000000000000000..29eb07b194e799b4667ed9f50d33cd28c414dfc5 --- /dev/null +++ b/radiant.design/man/summary.sampling.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sampling.R +\name{summary.sampling} +\alias{summary.sampling} +\title{Summary method for the sampling function} +\usage{ +\method{summary}{sampling}(object, dec = 3, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{sampling}}} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the sampling function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/design/sampling.html} for an example in Radiant +} +\examples{ +sampling(rndnames, "Names", 10) \%>\% summary() + +} +\seealso{ +\code{\link{sampling}} to generate the results +} diff --git a/radiant.design/tests/testthat.R b/radiant.design/tests/testthat.R new file mode 100644 index 0000000000000000000000000000000000000000..c2fa8eec0fd17f1aa001d03c203eea3d47a85113 --- /dev/null +++ b/radiant.design/tests/testthat.R @@ -0,0 +1,3 @@ +## use shift-cmd-t to run all tests +library(testthat) +test_check("radiant.design") diff --git a/radiant.design/tests/testthat/output/regress1.txt b/radiant.design/tests/testthat/output/regress1.txt new file mode 100644 index 0000000000000000000000000000000000000000..6c84363d395075f86aa9cdc9c98780f89eeb2099 --- /dev/null +++ b/radiant.design/tests/testthat/output/regress1.txt @@ -0,0 +1,24 @@ +Linear regression (OLS) + Data : diamonds + Response variable : price + Explanatory variables: carat, clarity + Null hyp.: the effect of x on price is zero + Alt. hyp.: the effect of x on price is not zero + + coefficient std.error t.value p.value + (Intercept) -6780.993 204.952 -33.086 < .001 *** + carat 8438.030 51.101 165.125 < .001 *** + clarity|SI2 2790.760 201.395 13.857 < .001 *** + clarity|SI1 3608.531 200.508 17.997 < .001 *** + clarity|VS2 4249.906 201.607 21.080 < .001 *** + clarity|VS1 4461.956 204.592 21.809 < .001 *** + clarity|VVS2 5109.476 210.207 24.307 < .001 *** + clarity|VVS1 5027.669 214.251 23.466 < .001 *** + clarity|IF 5265.170 233.658 22.534 < .001 *** + + Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + + R-squared: 0.904, Adjusted R-squared: 0.904 + F-statistic: 3530.024 df(8,2991), p.value < .001 + Nr obs: 3,000 + diff --git a/radiant.design/tests/testthat/test_stats.R b/radiant.design/tests/testthat/test_stats.R new file mode 100644 index 0000000000000000000000000000000000000000..ad9ba0a91471519866303ce77080ac70ac308438 --- /dev/null +++ b/radiant.design/tests/testthat/test_stats.R @@ -0,0 +1,69 @@ +# library(radiant.design) +# library(testthat) + +######### tests ######## +test_that("DOE", { + res1 <- "price; $10; $13; $16\nfood; popcorn; gourmet; no food" %>% doe() + expect_equal(unlist(res1$eff[5, ]), c(Trials = 9, `D-efficiency` = 1, Balanced = TRUE)) +}) + +test_that("Sample size", { + res1 <- sample_size(type = "mean", err_mean = 2, sd_mean = 10) + expect_equal(res1$n, 97) +}) + +test_that("Sample size (compare) -- n2", { + res <- sample_size_comp( + type = "proportion", + n1 = 38073, + p1 = 0.008, + p2 = 0.01, + conf_lev = 0.95, + power = 0.9, + alternative = "less" + ) + # summary(res) + expect_equal(ceiling(res$n2), 38073) +}) + +test_that("Sample size (compare) -- n1 and n2", { + res <- sample_size_comp( + type = "proportion", + p1 = 0.008, + p2 = 0.01, + conf_lev = 0.95, + power = 0.9, + alternative = "less" + ) + # summary(res) + expect_equal(ceiling(res$n1), 38073) + expect_equal(ceiling(res$n2), 38073) +}) + +test_that("Sample size (compare) -- power", { + res <- sample_size_comp( + type = "proportion", + n1 = 38073, + n2 = 38073, + p1 = 0.008, + p2 = 0.01, + conf_lev = 0.95, + alternative = "less" + ) + # summary(res) + expect_equal(round(res$res$power, 1), 0.9) +}) + +test_that("Sample size (compare) -- sig", { + res <- sample_size_comp( + type = "proportion", + n1 = 38073, + n2 = 38073, + p1 = 0.008, + p2 = 0.01, + power = 0.9, + alternative = "less" + ) + # summary(res) + expect_equal(round(res$res$sig.level, 2), 0.05) +}) diff --git a/radiant.design/vignettes/pkgdown/_doe.Rmd b/radiant.design/vignettes/pkgdown/_doe.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..c3673367ec9b0ebeef672cb04d60f655a8220c54 --- /dev/null +++ b/radiant.design/vignettes/pkgdown/_doe.Rmd @@ -0,0 +1,69 @@ +> Design of Experiments + +## Example + +Suppose we want to test alternative movie theater designs using three factors. + +* **Price** at \$10, \$13, or $16 +* **Sight** to determine if theater setting should be staggered or not staggered +* **Food** to determine if we should offer hot dogs and popcorn, gourmet food, or no food at all + +## Max levels + +The factors to include in the analysis have 3, 2, and 3 levels so we enter `3` in the `Max levels` input. + +## Variable name and level + +Here we enter the factors of interest. For example, enter `price` as the variable name, \$10 as level 1, \$13, as level 2, and \$16 as level 3. Then click the icon. This will add the provided information about the factor to the `Design factors` window in the format Radiant needs for analysis. To remove the last line in the `Design factors` window click the icon. + +After entering the required information for each of the three factors your screen should look as follows: + +

    + +## Create design + +You are now ready to create an experimental design by clicking on the `Create design` button. This will generate the following output. + +

    + +For our example, the ideal design has 18 trials. However, this implies that the partial and the full factorial are the same size. We'd like to find out if it is possible to reduce the number of trials. See `# trials` below. + +## # trials + +This input can be used to control the number of trials to generate. If left blank Radiant will try to find an appropriate number of trials using the `optFederov` function in the AlgDesign package. + +Lets review the output in `Design efficiency`. For our example, the goal is to find a design with less than 18 trials that will still allow us to estimate the effects we are interested in (e.g., the main-effects of the different levels of price, sight, and food). Notice that there are several designs that are considered `balanced` (i.e., each level is included in the same number of trials). We are looking for a design that is balanced and has minimal correlation between factors (e.g., a D-efficiency score above 0.8). You can think of the D-efficiency score as a measure of how cleanly we will be able to estimate the effects of interest after running the test/experiment. The ideal D-efficiency score is 1 but a number above 0.8 is considered reasonable. + +The smallest number of trials with a balanced design is 6. This design is balanced simply because 6 is divisible by 3 and 2 (i.e., the number of levels in our factors). However, the D-efficiency score is rather low (.513). The next smallest balanced design has 12 trials and has a much higher D-efficiency. This design is a reasonable choice if we want to estimate the main-effects of each factor level on movie-theater choice or preference. + +To generate the desired partial factorial design enter `12` in the `# trials` input and press `Create design`. This will generate the following output. + +

    + +The `trial` column in the output shows which profiles have been selected from the full factorial design. Note that the off-diagonal elements of the (polychoric) correlation matrix for a partial factorial design will all be equal to 0 *only* when D-efficiency is equal to 1. The polycor package is used to the estimate the correlations between the factors. + +## Rnd. seed: + +A partial factorial design may not be unique (i.e., there might be multiple combinations of trials or profiles that are equally good). By setting a random seed you ensure the same set of trials will be generated each time you press `Create design`. However, to see alternative partials factorial designs empty the `Rnd. seed` box and press `Create design` a few times to see how the set of selected trials changes. + +## Interactions + +Note that we will not be able to estimate all possible interactions between `price`, `sight`, and `food` if we use a design with 12 trials. This is the trade-off inherent in partial factorial designs! In fact, if we do want to estimate even one interaction (e.g., select `price:sight`) the appropriate design has 18 trials (i.e., the number in the full factorial design that includes all possible combinations of factor levels). + +## Partial and Full factorial design + +Click on the `Partial` or the `Full` button to download the Partial or Full factorial design in csv format . + +## Upload and Download + +To download the list of factors you entered click the `Download` button. To upload a previously created set of factors click the `Upload` button and browse to find the desired file. + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the design by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +### R-functions + +For an overview of related R-functions used by Radiant for experimental design see _Design > Design of Experiments_ + +The key function from the `AlgDesign` package used in the `doe` tool is `optFederov`. diff --git a/radiant.design/vignettes/pkgdown/_footer.md b/radiant.design/vignettes/pkgdown/_footer.md new file mode 100644 index 0000000000000000000000000000000000000000..05010f02dd76f9e82c3cb8a79ee3cfcec670384d --- /dev/null +++ b/radiant.design/vignettes/pkgdown/_footer.md @@ -0,0 +1,2 @@ + +© Vincent Nijs (2023) Creative Commons License diff --git a/radiant.design/vignettes/pkgdown/_randomizer.Rmd b/radiant.design/vignettes/pkgdown/_randomizer.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..85e4baf6619af0a26148c8fb78cd99b6cc4ed8fd --- /dev/null +++ b/radiant.design/vignettes/pkgdown/_randomizer.Rmd @@ -0,0 +1,29 @@ +> Randomly assign respondents to experimental conditions + +To use the random assignment tool, select a data set where each row in the data set is unique (i.e., no duplicates). A dataset that fits these requirements is bundled with Radiant and is available through the _Data > Manage_ tab (i.e., choose `Examples` from the `Load data of type` drop-down and press `Load`). Select `rndnames` from the `Datasets` dropdown. + +`Names` is a unique identifier in this dataset. If we select this variable and specify two (or more) `Conditions` (e.g., "test" and "control") a table will be shown with a columns `.conditions` that indicates to which condition each person was (randomly) assigned. + +By default, the `Random assignment` tool will use equal probabilities for each condition. However, as can be seen in the screenshot below, it is also possible to specify the probabilities to use in assignment (e.g., 30% to "test" and 70% to the "control" condition). + +

    + +If we expect that some variables are likely predictive of the outcome of our experiment then we can use `blocking` to decrease sampling variability. In block random assignment (or stratified random assignment) subjects are first sorted into blocks (or strata) based on one or more characteristics before being randomly assigned within each block. For example, if we select `Gender` as a `Blocking variable` the `Random assignment` tool will attempt to put exactly 30% of men and exactly 30% of women in the treatment condition based on the `Probabilities` we specified in advance. As we can see in the screenshot below, the assignment of men and women to the test and control condition turned out exactly as intended. + +

    + +By default, the random seed is set to `1234` to ensure the sampling results are reproducible. If there is no input in `Rnd. seed`, the selected rows will change every time we generate a sample. + +To download data with the assignments in the `.conditions` column in CSV format, click on the icon in the top-right of your screen. The same data can also be stored in Radiant by providing a name for the dataset and then clicking on the `Store` button. + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the sample by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +### R-functions + +For an overview of related R-functions used by Radiant for sampling and sample size calculations see _Design > Sample_ + +For more information see the vignette for the `randomizr` package that radiant uses for the `Random assignment` tool. + +The key functions from the `randomizr` package used in the `randomizer` tool are `complete_ra` and `block_ra`. diff --git a/radiant.design/vignettes/pkgdown/_sample_size.Rmd b/radiant.design/vignettes/pkgdown/_sample_size.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..30ce4b5646059cb6d4ae21cb77025e865c178d39 --- /dev/null +++ b/radiant.design/vignettes/pkgdown/_sample_size.Rmd @@ -0,0 +1,102 @@ +> Determine the required sample size to test a mean or proportion calculated from sample data + +### Example 1 + +We would like to start an ISP and need to estimate the average Internet usage of households in one week for our business plan and model. How many households must we randomly select to be 95% sure that the sample mean is within 10 minute of the population mean? Assume that a previous survey of household usage has shown a standard deviation of 60.95 minutes. + +**Answer:** + +Since we are interested in estimating the average (or mean) internet usage in the population we select sample size calculation for `Mean`. In the screen shot below we entered 10 (minutes) as the Acceptable error and 60.95 as the estimate of the Sample standard deviation. The Confidence level is 95%. + +

    + +As you can see the required sample size is equal to 143, i.e., we need 143 valid responses from our target population to make an inference of the population average with the required Acceptable Error, Confidence level, and Sample standard deviation. This number assumes an Incidence and Response rate of 1 (or 100%). Suppose that only 75% of the household in our market have access to internet at home. In addition, suppose that the anticipated response rate is 20%. What would be the required number of households to contact? + +

    + +In the screen shot above the incidence rate is set to 75% and the response rate to 20%. The required number of valid responses is the same as before (143), however the number of contact requests is now equal to 143 / .75 / .2 = 954. + +Source + +### Example 2 + +Suppose that you want to investigate if the true prevalence of HIV antibodies in a population is 10%. You plan to take a random sample of the population to estimate the prevalence. You would like 95% confidence that the true proportion in the population will fall within the error bounds calculated from your sample. + +Let's say that the population size is 5000 and the initial estimate of the prevalence is 10% with an acceptable error of 4%. + +**Answer:** + +Because we want to estimate the proportion of people with HIV antibodies in the population of interest we select sample size calculation for a `Proportion`. In the screen shot below we entered 4% as the Acceptable error and 10% as the initial estimate of the proportion (p). The Confidence level is 95%. + +

    + +As you can see the required sample size is equal to 217, i.e., we need 217 valid responses to make an inference of the population proportion with the required Acceptable error and Confidence level. This number again assumes an Incidence and Response rate of 100%. The example suggests the population of interest has only 5000 people so it may be worthwhile to apply a correction for population size. + +

    + +In the screen shot above we clicked `Yes` to apply the population correction and then entered 5000 as the population size. The required number of valid responses drops only slightly from 217 to 208. + +In general, the size of the population can be influential when the sample size we need ($n$) is large compared to the size of the total population ($N$). For example, if the population was only 250 people the adjusted sample size would have been 117 rather than 217. + +Source + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the sample size calculations by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +### Technical notes + +#### Sample size for a mean: + +$$ + n = \frac{ z^2 \times s^2 }{ E^2 } +$$ + +where $n$ is the sample size, $z$ is the z-value associated with the desired level of confidence (e.g., 1.96 for 95% confidence), $s$ is the sample standard deviation, and $E$ is the acceptable error. Even if you have not seen the equation above before you may recall the formula for a confidence interval: + +$$ + x \pm z \frac{s}{\sqrt{n}} +$$ + +The boundaries around $x$ are equal to $E$, i.e., the acceptable error. Squaring both sides and rearranging terms gives the formula for sample size: + +$$ + E = z \frac{s}{\sqrt{n}} \; \Rightarrow \; n = \frac{ z^2 \times s^2 }{ E^2 } +$$ + + +#### Sample size for a proportion: + +$$ + n = \frac{ z^2 \times p(1-p) }{ E^2 } +$$ + +where $n$ is the sample size, $z$ is the z-value associated with the desired level of confidence (e.g., 1.96 for 95% confidence), $p$ is the sample proportion, and $E$ is the acceptable error. Even if you have not seen the equation above before you may recall the formula for a confidence interval: + +$$ + p \pm z \sqrt{ \frac{p(1-p)}{n} } +$$ + +The boundaries around $p$ are equal to $E$, i.e., the acceptable error. Squaring both sides and rearranging terms gives the formula for sample size: + +$$ + E = z \sqrt{ \frac{p(1-p)}{n} } \; \Rightarrow \; n = \frac{ z^2 p(1-p) }{ E^2 } +$$ + +#### Population correction + +While we can always apply a population correction, the size of the population can have a substantial impact on the required sample size when ($n$) is large compared to the size of the total population ($N$). + +$$ + n^* = \frac{ nN }{ n - 1 + N } +$$ + +As an example, suppose we determine that we need to draw a sample of size 217 from a population of 5000. The the sample size adjusted for population size ($n^*$) would be calculated as follows: + +$$ + n^* = \frac{ 217 \times 5000 }{ 217 - 1 + 5000 } = 208 +$$ + +### R-functions + +For an overview of related R-functions used by Radiant for sampling and sample size calculations see _Design > Sample_ diff --git a/radiant.design/vignettes/pkgdown/_sample_size_comp.Rmd b/radiant.design/vignettes/pkgdown/_sample_size_comp.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..2150f588e739026d42e479f521f7a8723a0a5043 --- /dev/null +++ b/radiant.design/vignettes/pkgdown/_sample_size_comp.Rmd @@ -0,0 +1,37 @@ +> Determine the required sample size for comparisons of means or proportions + +Leave one of the inputs blank to determine its value. By default the sample size inputs (_n1_ and _n2_) are left empty and the required sample size for both groups is calculated. If values are provided for both _n1_ and _n2_ the value for any one of the other inputs left blank will be calculated. If only a value for _n1_ (_n2_) is entered, all other inputs must be provided to determine the required sample size for _n2_ (_n1_) + +### Input + +* Sample size: Number of respondents required +* Confidence level: 1 - significance level (e.g, .95 = 1 - .05).1, 2 +* Power: 1 - $\beta$ (e.g, .8 = 1 - .2).3 + +### Input for a comparison of means + +* Delta: Difference between group means that we hope to detect +* Std. deviation: Assumed standard deviation + +### Input for a comparison of proportions + +* Proportion 1: Assumed proportion in group 1 (e.g., .1) +* Proportion 2: Proportion 1 plus the difference we hope to detect (e.g., .1 + .05 = .15) + +**Note:** The (match) the control group sample size (_n1_) to the test group sample size (_n2_) leave both inputs for sample size blank (i.e., groups are of the same size). If a value for _n1_ or _n2_ is provided group sizes are likely to differ + +1 The **significance level**, often denoted by $\alpha$, is the highest probability you are willing to accept of rejecting the null hypothesis when it is actually true. A commonly used significance level is 0.05 (or 5%) + +2 $1 - \alpha$ is called the **confidence level**. A commonly used confidence level is 0.95 (or 95%) + +3 Beta ($\beta$), is the probability of accepting the null hypothesis when it is actually false. The power of a test is calculated as 1 - $\beta$. A commonly used power level is 0.8 (or 80%) + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the sample size calculations by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +### R-functions + +For an overview of related R-functions used by Radiant for sampling and sample size calculations see _Design > Sample_ + +The key functions from the `pwr` package used in the `sample_size_comp` tool are `pwr.t2n.test`, `pwr.t.test`, `pwr.2p.test`, `pwr.2p2n.test`, and `pwr.2p2n.test`. diff --git a/radiant.design/vignettes/pkgdown/_sampling.Rmd b/radiant.design/vignettes/pkgdown/_sampling.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..0c4604cc94ea00edc936095cec797fee3cb92a44 --- /dev/null +++ b/radiant.design/vignettes/pkgdown/_sampling.Rmd @@ -0,0 +1,23 @@ +> Use simple random sampling to select observations from a sampling frame + +To use the sampling tool, select a data set where each row in the data set is unique (i.e., no duplicates). A dataset that fits these requirements is bundled with Radiant and is available through the _Data > Manage_ tab (i.e., choose `Examples` from the `Load data of type` drop-down and press `Load`). Select `rndnames` from the `Datasets` dropdown. + +`Names` is a unique identifier in this dataset. If we select this variable and choose the desired sample size, e.g., 10, list of names of the desired length will be created. + +How does this work? Each person in the data is assigned a random number between 0 and 1 from a uniform distribution. Rows are then sorted on that random number and the $n$ people from the list with the highest score are selected for the sample. By using a random number, every respondent has the same probability of being in the sample. For example, if we need a sample of 10 people from the 100 included in the `rndnames` dataset, each individual has a 10% chances of being included in the sample. By default, the random seed is set to `1234` to ensure the sampling results are reproducible. If there is no input in `Rnd. seed`, the selected rows will change every time we generate a sample. + +

    + +The full list of 100 people is called the `sampling frame`. Ideally, this is a comprehensive list of _all_ sampling units (e.g., customers or companies) in your target market. To determine the appropriate value for _n_, use the sample size tools in the _Design_ menu. To show the full sampling frame, click on the `Show sampling frame` check box. + +To download data for the generated sample in CSV format, click on the icon in the top-right of your screen. The created sample can also be stored in Radiant by providing a name for the dataset and then clicking on the `Store` button. + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the sample by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +### R-functions + +For an overview of related R-functions used by Radiant for sampling and sample size calculations see _Design > Sample_ + +The key function from the `stats` package used in the `sampling` tool is `runif`. This function is used to generate the random numbers assigned to each row in the available data. diff --git a/radiant.design/vignettes/pkgdown/doe.Rmd b/radiant.design/vignettes/pkgdown/doe.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..62a661572cac694085a34888ddf1edb3a721840a --- /dev/null +++ b/radiant.design/vignettes/pkgdown/doe.Rmd @@ -0,0 +1,10 @@ +--- +title: "Design > Design of Experiments" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_doe.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.design/vignettes/pkgdown/images/by-nc-sa.png b/radiant.design/vignettes/pkgdown/images/by-nc-sa.png new file mode 100644 index 0000000000000000000000000000000000000000..76eb5da461b41405c500a557253eec5f65169519 Binary files /dev/null and b/radiant.design/vignettes/pkgdown/images/by-nc-sa.png differ diff --git a/radiant.design/vignettes/pkgdown/randomizer.Rmd b/radiant.design/vignettes/pkgdown/randomizer.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..9ab7d241950f588479ba9b1c2d711b8e256ae013 --- /dev/null +++ b/radiant.design/vignettes/pkgdown/randomizer.Rmd @@ -0,0 +1,10 @@ +--- +title: "Design > Random assignment" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_randomizer.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.design/vignettes/pkgdown/sample_size.Rmd b/radiant.design/vignettes/pkgdown/sample_size.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..1855a7f128e3ba4b534f67c4f90afeeb8f66e425 --- /dev/null +++ b/radiant.design/vignettes/pkgdown/sample_size.Rmd @@ -0,0 +1,10 @@ +--- +title: "Design > Sample size" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_sample_size.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.design/vignettes/pkgdown/sample_size_comp.Rmd b/radiant.design/vignettes/pkgdown/sample_size_comp.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..1aaf13a13a1ea93bc4829fbb327f0763e03a5d89 --- /dev/null +++ b/radiant.design/vignettes/pkgdown/sample_size_comp.Rmd @@ -0,0 +1,10 @@ +--- +title: "Design > Sample size (compare)" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_sample_size_comp.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.design/vignettes/pkgdown/sampling.Rmd b/radiant.design/vignettes/pkgdown/sampling.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..142c19e265410e87bccf75e535783c7040efe98a --- /dev/null +++ b/radiant.design/vignettes/pkgdown/sampling.Rmd @@ -0,0 +1,10 @@ +--- +title: "Design > Random sampling" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_sampling.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.model b/radiant.model deleted file mode 160000 index f18fa8c52bc21719f428338b8786009a48b23e66..0000000000000000000000000000000000000000 --- a/radiant.model +++ /dev/null @@ -1 +0,0 @@ -Subproject commit f18fa8c52bc21719f428338b8786009a48b23e66 diff --git a/radiant.model/.Rbuildignore b/radiant.model/.Rbuildignore new file mode 100644 index 0000000000000000000000000000000000000000..61f0b4f756a7c99d43f493fc6c45f84b8654cc58 --- /dev/null +++ b/radiant.model/.Rbuildignore @@ -0,0 +1,15 @@ +^CRAN-RELEASE$ +^.*\.Rproj$ +^\.Rproj\.user$ +^inst/rstudio$ +build/ +^\.travis\.yml$ +cran-comments.md +_pkgdown.yml +docs/ +vignettes/ +.vscode/ +docker/ +^CRAN-SUBMISSION$ +^.*\.state\.rda$ +solutions/ diff --git a/radiant.model/.gitignore b/radiant.model/.gitignore new file mode 100644 index 0000000000000000000000000000000000000000..6a1a179726cd9b74994334c43c8b1717b1cfece3 --- /dev/null +++ b/radiant.model/.gitignore @@ -0,0 +1,13 @@ +.Rproj.user +.Rhistory +.Rapp.history +.RData +.Ruserdata +radiant.model.Rproj +.DS_Store +cran-comments.md +docs/ +.vscode/ +docker/ +*.state.rda +solutions/ diff --git a/radiant.model/.travis.yml b/radiant.model/.travis.yml new file mode 100644 index 0000000000000000000000000000000000000000..efb6cada0291487bb4ce5a6506f01e42924628ac --- /dev/null +++ b/radiant.model/.travis.yml @@ -0,0 +1,30 @@ +language: r +cache: packages +r: + - oldrel + - release + - devel +warnings_are_errors: true +sudo: required +dist: bionic + +r_packages: + - devtools + +r_github_packages: + - trestletech/shinyAce + - radiant-rstats/radiant.data + - radiant-rstats/radiant.basics + +## based on https://www.datacamp.com/community/tutorials/cd-package-docs-pkgdown-travis +after_success: + - Rscript -e 'pkgdown::build_site()' + +deploy: + provider: pages + skip-cleanup: true + github-token: $GITHUB_PAT + keep-history: true + local-dir: docs + on: + branch: master diff --git a/radiant.model/COPYING b/radiant.model/COPYING new file mode 100644 index 0000000000000000000000000000000000000000..a1489137162245876dc640a463870e53017ca015 --- /dev/null +++ b/radiant.model/COPYING @@ -0,0 +1,728 @@ +The radiant package is licensed to you under the AGPLv3, the terms of +which are included below. The help files are licensed under the creative +commons attribution non-commercial share-alike license [CC-NC-SA]. + +Radiant code license +-------------------------------------------------------------------------------------------- + GNU AFFERO GENERAL PUBLIC LICENSE + Version 3, 19 November 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU Affero General Public License is a free, copyleft license for +software and other kinds of works, specifically designed to ensure +cooperation with the community in the case of network server software. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +our General Public Licenses are intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + Developers that use our General Public Licenses protect your rights +with two steps: (1) assert copyright on the software, and (2) offer +you this License which gives you legal permission to copy, distribute +and/or modify the software. + + A secondary benefit of defending all users' freedom is that +improvements made in alternate versions of the program, if they +receive widespread use, become available for other developers to +incorporate. Many developers of free software are heartened and +encouraged by the resulting cooperation. However, in the case of +software used on network servers, this result may fail to come about. +The GNU General Public License permits making a modified version and +letting the public access it on a server without ever releasing its +source code to the public. + + The GNU Affero General Public License is designed specifically to +ensure that, in such cases, the modified source code becomes available +to the community. It requires the operator of a network server to +provide the source code of the modified version running there to the +users of that server. Therefore, public use of a modified version, on +a publicly accessible server, gives the public access to the source +code of the modified version. + + An older license, called the Affero General Public License and +published by Affero, was designed to accomplish similar goals. This is +a different license, not a version of the Affero GPL, but Affero has +released a new version of the Affero GPL which permits relicensing under +this license. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU Affero General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Remote Network Interaction; Use with the GNU General Public License. + + Notwithstanding any other provision of this License, if you modify the +Program, your modified version must prominently offer all users +interacting with it remotely through a computer network (if your version +supports such interaction) an opportunity to receive the Corresponding +Source of your version by providing access to the Corresponding Source +from a network server at no charge, through some standard or customary +means of facilitating copying of software. This Corresponding Source +shall include the Corresponding Source for any work covered by version 3 +of the GNU General Public License that is incorporated pursuant to the +following paragraph. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the work with which it is combined will remain governed by version +3 of the GNU General Public License. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU Affero General Public License from time to time. Such new versions +will be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU Affero General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU Affero General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU Affero General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If your software can interact with users remotely through a computer +network, you should also make sure that it provides a way for users to +get its source. For example, if your program is a web application, its +interface could display a "Source" link that leads users to an archive +of the code. There are many ways you could offer source, and different +solutions will be better for different programs; see section 13 for the +specific requirements. + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU AGPL, see +. + + +Help file License +-------------------------------------------------------------------------------------------- + +THE WORK (AS DEFINED BELOW) IS PROVIDED UNDER THE TERMS OF THIS CREATIVE COMMONS PUBLIC LICENSE ("CCPL" OR "LICENSE"). THE WORK IS PROTECTED BY COPYRIGHT AND/OR OTHER APPLICABLE LAW. ANY USE OF THE WORK OTHER THAN AS AUTHORIZED UNDER THIS LICENSE OR COPYRIGHT LAW IS PROHIBITED. + +BY EXERCISING ANY RIGHTS TO THE WORK PROVIDED HERE, YOU ACCEPT AND AGREE TO BE BOUND BY THE TERMS OF THIS LICENSE. TO THE EXTENT THIS LICENSE MAY BE CONSIDERED TO BE A CONTRACT, THE LICENSOR GRANTS YOU THE RIGHTS CONTAINED HERE IN CONSIDERATION OF YOUR ACCEPTANCE OF SUCH TERMS AND CONDITIONS. + +1. Definitions + +"Adaptation" means a work based upon the Work, or upon the Work and other pre-existing works, such as a translation, adaptation, derivative work, arrangement of music or other alterations of a literary or artistic work, or phonogram or performance and includes cinematographic adaptations or any other form in which the Work may be recast, transformed, or adapted including in any form recognizably derived from the original, except that a work that constitutes a Collection will not be considered an Adaptation for the purpose of this License. For the avoidance of doubt, where the Work is a musical work, performance or phonogram, the synchronization of the Work in timed-relation with a moving image ("synching") will be considered an Adaptation for the purpose of this License. +"Collection" means a collection of literary or artistic works, such as encyclopedias and anthologies, or performances, phonograms or broadcasts, or other works or subject matter other than works listed in Section 1(g) below, which, by reason of the selection and arrangement of their contents, constitute intellectual creations, in which the Work is included in its entirety in unmodified form along with one or more other contributions, each constituting separate and independent works in themselves, which together are assembled into a collective whole. A work that constitutes a Collection will not be considered an Adaptation (as defined above) for the purposes of this License. +"Distribute" means to make available to the public the original and copies of the Work or Adaptation, as appropriate, through sale or other transfer of ownership. +"License Elements" means the following high-level license attributes as selected by Licensor and indicated in the title of this License: Attribution, Noncommercial, ShareAlike. +"Licensor" means the individual, individuals, entity or entities that offer(s) the Work under the terms of this License. +"Original Author" means, in the case of a literary or artistic work, the individual, individuals, entity or entities who created the Work or if no individual or entity can be identified, the publisher; and in addition (i) in the case of a performance the actors, singers, musicians, dancers, and other persons who act, sing, deliver, declaim, play in, interpret or otherwise perform literary or artistic works or expressions of folklore; (ii) in the case of a phonogram the producer being the person or legal entity who first fixes the sounds of a performance or other sounds; and, (iii) in the case of broadcasts, the organization that transmits the broadcast. +"Work" means the literary and/or artistic work offered under the terms of this License including without limitation any production in the literary, scientific and artistic domain, whatever may be the mode or form of its expression including digital form, such as a book, pamphlet and other writing; a lecture, address, sermon or other work of the same nature; a dramatic or dramatico-musical work; a choreographic work or entertainment in dumb show; a musical composition with or without words; a cinematographic work to which are assimilated works expressed by a process analogous to cinematography; a work of drawing, painting, architecture, sculpture, engraving or lithography; a photographic work to which are assimilated works expressed by a process analogous to photography; a work of applied art; an illustration, map, plan, sketch or three-dimensional work relative to geography, topography, architecture or science; a performance; a broadcast; a phonogram; a compilation of data to the extent it is protected as a copyrightable work; or a work performed by a variety or circus performer to the extent it is not otherwise considered a literary or artistic work. +"You" means an individual or entity exercising rights under this License who has not previously violated the terms of this License with respect to the Work, or who has received express permission from the Licensor to exercise rights under this License despite a previous violation. +"Publicly Perform" means to perform public recitations of the Work and to communicate to the public those public recitations, by any means or process, including by wire or wireless means or public digital performances; to make available to the public Works in such a way that members of the public may access these Works from a place and at a place individually chosen by them; to perform the Work to the public by any means or process and the communication to the public of the performances of the Work, including by public digital performance; to broadcast and rebroadcast the Work by any means including signs, sounds or images. +"Reproduce" means to make copies of the Work by any means including without limitation by sound or visual recordings and the right of fixation and reproducing fixations of the Work, including storage of a protected performance or phonogram in digital form or other electronic medium. +2. Fair Dealing Rights. Nothing in this License is intended to reduce, limit, or restrict any uses free from copyright or rights arising from limitations or exceptions that are provided for in connection with the copyright protection under copyright law or other applicable laws. + +3. License Grant. Subject to the terms and conditions of this License, Licensor hereby grants You a worldwide, royalty-free, non-exclusive, perpetual (for the duration of the applicable copyright) license to exercise the rights in the Work as stated below: + +to Reproduce the Work, to incorporate the Work into one or more Collections, and to Reproduce the Work as incorporated in the Collections; +to create and Reproduce Adaptations provided that any such Adaptation, including any translation in any medium, takes reasonable steps to clearly label, demarcate or otherwise identify that changes were made to the original Work. For example, a translation could be marked "The original work was translated from English to Spanish," or a modification could indicate "The original work has been modified."; +to Distribute and Publicly Perform the Work including as incorporated in Collections; and, +to Distribute and Publicly Perform Adaptations. +The above rights may be exercised in all media and formats whether now known or hereafter devised. The above rights include the right to make such modifications as are technically necessary to exercise the rights in other media and formats. Subject to Section 8(f), all rights not expressly granted by Licensor are hereby reserved, including but not limited to the rights described in Section 4(e). + +4. Restrictions. The license granted in Section 3 above is expressly made subject to and limited by the following restrictions: + +You may Distribute or Publicly Perform the Work only under the terms of this License. You must include a copy of, or the Uniform Resource Identifier (URI) for, this License with every copy of the Work You Distribute or Publicly Perform. You may not offer or impose any terms on the Work that restrict the terms of this License or the ability of the recipient of the Work to exercise the rights granted to that recipient under the terms of the License. You may not sublicense the Work. You must keep intact all notices that refer to this License and to the disclaimer of warranties with every copy of the Work You Distribute or Publicly Perform. When You Distribute or Publicly Perform the Work, You may not impose any effective technological measures on the Work that restrict the ability of a recipient of the Work from You to exercise the rights granted to that recipient under the terms of the License. This Section 4(a) applies to the Work as incorporated in a Collection, but this does not require the Collection apart from the Work itself to be made subject to the terms of this License. If You create a Collection, upon notice from any Licensor You must, to the extent practicable, remove from the Collection any credit as required by Section 4(d), as requested. If You create an Adaptation, upon notice from any Licensor You must, to the extent practicable, remove from the Adaptation any credit as required by Section 4(d), as requested. +You may Distribute or Publicly Perform an Adaptation only under: (i) the terms of this License; (ii) a later version of this License with the same License Elements as this License; (iii) a Creative Commons jurisdiction license (either this or a later license version) that contains the same License Elements as this License (e.g., Attribution-NonCommercial-ShareAlike 3.0 US) ("Applicable License"). You must include a copy of, or the URI, for Applicable License with every copy of each Adaptation You Distribute or Publicly Perform. You may not offer or impose any terms on the Adaptation that restrict the terms of the Applicable License or the ability of the recipient of the Adaptation to exercise the rights granted to that recipient under the terms of the Applicable License. You must keep intact all notices that refer to the Applicable License and to the disclaimer of warranties with every copy of the Work as included in the Adaptation You Distribute or Publicly Perform. When You Distribute or Publicly Perform the Adaptation, You may not impose any effective technological measures on the Adaptation that restrict the ability of a recipient of the Adaptation from You to exercise the rights granted to that recipient under the terms of the Applicable License. This Section 4(b) applies to the Adaptation as incorporated in a Collection, but this does not require the Collection apart from the Adaptation itself to be made subject to the terms of the Applicable License. +You may not exercise any of the rights granted to You in Section 3 above in any manner that is primarily intended for or directed toward commercial advantage or private monetary compensation. The exchange of the Work for other copyrighted works by means of digital file-sharing or otherwise shall not be considered to be intended for or directed toward commercial advantage or private monetary compensation, provided there is no payment of any monetary compensation in con-nection with the exchange of copyrighted works. +If You Distribute, or Publicly Perform the Work or any Adaptations or Collections, You must, unless a request has been made pursuant to Section 4(a), keep intact all copyright notices for the Work and provide, reasonable to the medium or means You are utilizing: (i) the name of the Original Author (or pseudonym, if applicable) if supplied, and/or if the Original Author and/or Licensor designate another party or parties (e.g., a sponsor institute, publishing entity, journal) for attribution ("Attribution Parties") in Licensor's copyright notice, terms of service or by other reasonable means, the name of such party or parties; (ii) the title of the Work if supplied; (iii) to the extent reasonably practicable, the URI, if any, that Licensor specifies to be associated with the Work, unless such URI does not refer to the copyright notice or licensing information for the Work; and, (iv) consistent with Section 3(b), in the case of an Adaptation, a credit identifying the use of the Work in the Adaptation (e.g., "French translation of the Work by Original Author," or "Screenplay based on original Work by Original Author"). The credit required by this Section 4(d) may be implemented in any reasonable manner; provided, however, that in the case of a Adaptation or Collection, at a minimum such credit will appear, if a credit for all contributing authors of the Adaptation or Collection appears, then as part of these credits and in a manner at least as prominent as the credits for the other contributing authors. For the avoidance of doubt, You may only use the credit required by this Section for the purpose of attribution in the manner set out above and, by exercising Your rights under this License, You may not implicitly or explicitly assert or imply any connection with, sponsorship or endorsement by the Original Author, Licensor and/or Attribution Parties, as appropriate, of You or Your use of the Work, without the separate, express prior written permission of the Original Author, Licensor and/or Attribution Parties. +For the avoidance of doubt: + +Non-waivable Compulsory License Schemes. In those jurisdictions in which the right to collect royalties through any statutory or compulsory licensing scheme cannot be waived, the Licensor reserves the exclusive right to collect such royalties for any exercise by You of the rights granted under this License; +Waivable Compulsory License Schemes. In those jurisdictions in which the right to collect royalties through any statutory or compulsory licensing scheme can be waived, the Licensor reserves the exclusive right to collect such royalties for any exercise by You of the rights granted under this License if Your exercise of such rights is for a purpose or use which is otherwise than noncommercial as permitted under Section 4(c) and otherwise waives the right to collect royalties through any statutory or compulsory licensing scheme; and, +Voluntary License Schemes. The Licensor reserves the right to collect royalties, whether individually or, in the event that the Licensor is a member of a collecting society that administers voluntary licensing schemes, via that society, from any exercise by You of the rights granted under this License that is for a purpose or use which is otherwise than noncommercial as permitted under Section 4(c). +Except as otherwise agreed in writing by the Licensor or as may be otherwise permitted by applicable law, if You Reproduce, Distribute or Publicly Perform the Work either by itself or as part of any Adaptations or Collections, You must not distort, mutilate, modify or take other derogatory action in relation to the Work which would be prejudicial to the Original Author's honor or reputation. Licensor agrees that in those jurisdictions (e.g. Japan), in which any exercise of the right granted in Section 3(b) of this License (the right to make Adaptations) would be deemed to be a distortion, mutilation, modification or other derogatory action prejudicial to the Original Author's honor and reputation, the Licensor will waive or not assert, as appropriate, this Section, to the fullest extent permitted by the applicable national law, to enable You to reasonably exercise Your right under Section 3(b) of this License (right to make Adaptations) but not otherwise. +5. Representations, Warranties and Disclaimer + +UNLESS OTHERWISE MUTUALLY AGREED TO BY THE PARTIES IN WRITING AND TO THE FULLEST EXTENT PERMITTED BY APPLICABLE LAW, LICENSOR 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, NONINFRINGEMENT, OR THE ABSENCE OF LATENT OR OTHER DEFECTS, ACCURACY, OR THE PRESENCE OF ABSENCE OF ERRORS, WHETHER OR NOT DISCOVERABLE. SOME JURISDICTIONS DO NOT ALLOW THE EXCLUSION OF IMPLIED WARRANTIES, SO THIS EXCLUSION MAY NOT APPLY TO YOU. + +6. Limitation on Liability. EXCEPT TO THE EXTENT REQUIRED BY APPLICABLE LAW, IN NO EVENT WILL LICENSOR BE LIABLE TO YOU ON ANY LEGAL THEORY FOR ANY SPECIAL, INCIDENTAL, CONSEQUENTIAL, PUNITIVE OR EXEMPLARY DAMAGES ARISING OUT OF THIS LICENSE OR THE USE OF THE WORK, EVEN IF LICENSOR HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. + +7. Termination + +This License and the rights granted hereunder will terminate automatically upon any breach by You of the terms of this License. Individuals or entities who have received Adaptations or Collections from You under this License, however, will not have their licenses terminated provided such individuals or entities remain in full compliance with those licenses. Sections 1, 2, 5, 6, 7, and 8 will survive any termination of this License. +Subject to the above terms and conditions, the license granted here is perpetual (for the duration of the applicable copyright in the Work). Notwithstanding the above, Licensor reserves the right to release the Work under different license terms or to stop distributing the Work at any time; provided, however that any such election will not serve to withdraw this License (or any other license that has been, or is required to be, granted under the terms of this License), and this License will continue in full force and effect unless terminated as stated above. +8. Miscellaneous + +Each time You Distribute or Publicly Perform the Work or a Collection, the Licensor offers to the recipient a license to the Work on the same terms and conditions as the license granted to You under this License. +Each time You Distribute or Publicly Perform an Adaptation, Licensor offers to the recipient a license to the original Work on the same terms and conditions as the license granted to You under this License. +If any provision of this License is invalid or unenforceable under applicable law, it shall not affect the validity or enforceability of the remainder of the terms of this License, and without further action by the parties to this agreement, such provision shall be reformed to the minimum extent necessary to make such provision valid and enforceable. +No term or provision of this License shall be deemed waived and no breach consented to unless such waiver or consent shall be in writing and signed by the party to be charged with such waiver or consent. +This License constitutes the entire agreement between the parties with respect to the Work licensed here. There are no understandings, agreements or representations with respect to the Work not specified here. Licensor shall not be bound by any additional provisions that may appear in any communication from You. This License may not be modified without the mutual written agreement of the Licensor and You. +The rights granted under, and the subject matter referenced, in this License were drafted utilizing the terminology of the Berne Convention for the Protection of Literary and Artistic Works (as amended on September 28, 1979), the Rome Convention of 1961, the WIPO Copyright Treaty of 1996, the WIPO Performances and Phonograms Treaty of 1996 and the Universal Copyright Convention (as revised on July 24, 1971). These rights and subject matter take effect in the relevant jurisdiction in which the License terms are sought to be enforced according to the corresponding provisions of the implementation of those treaty provisions in the applicable national law. If the standard suite of rights granted under applicable copyright law includes additional rights not granted under this License, such additional rights are deemed to be included in the License; this License is not intended to restrict the license of any rights under applicable law. diff --git a/radiant.model/CRAN-RELEASE b/radiant.model/CRAN-RELEASE new file mode 100644 index 0000000000000000000000000000000000000000..934c07ab4c8c2694fec909f3dce225aef0629698 --- /dev/null +++ b/radiant.model/CRAN-RELEASE @@ -0,0 +1,2 @@ +This package was submitted to CRAN on 2020-08-05. +Once it is accepted, delete this file and tag the release (commit a233110bdb). diff --git a/radiant.model/CRAN-SUBMISSION b/radiant.model/CRAN-SUBMISSION new file mode 100644 index 0000000000000000000000000000000000000000..cb60db6e9a874bd06c1cb01e081560a166ac19b4 --- /dev/null +++ b/radiant.model/CRAN-SUBMISSION @@ -0,0 +1,3 @@ +Version: 1.6.7 +Date: 2024-10-11 05:08:01 UTC +SHA: 0ec5376c00fe3f02bf1f1cf7187883fed3784620 diff --git a/radiant.model/DESCRIPTION b/radiant.model/DESCRIPTION new file mode 100644 index 0000000000000000000000000000000000000000..5c0210bef65b8db9fa3b018093b700a01fec2544 --- /dev/null +++ b/radiant.model/DESCRIPTION @@ -0,0 +1,57 @@ +Package: radiant.model +Type: Package +Title: Model Menu for Radiant: Business Analytics using R and Shiny +Version: 1.6.7 +Date: 2024-10-7 +Authors@R: person("Vincent", "Nijs", , "radiant@rady.ucsd.edu", c("aut", "cre")) +Description: The Radiant Model menu includes interfaces for linear and logistic + regression, naive Bayes, neural networks, classification and regression trees, + model evaluation, collaborative filtering, decision analysis, and simulation. + The application extends the functionality in 'radiant.data'. +Depends: + R (>= 4.3.0), + radiant.data (>= 1.6.6) +Imports: + radiant.basics (>= 1.6.6), + shiny (>= 1.8.1), + nnet (>= 7.3.12), + NeuralNetTools (>= 1.5.1), + sandwich (>= 2.3.4), + car (>= 2.1.3), + ggplot2 (>= 3.4.2), + scales (>= 1.2.1), + data.tree (>= 0.7.4), + stringr (>= 1.1.0), + lubridate (>= 1.7.2), + tidyr (>= 0.8.2), + dplyr (>= 1.1.2), + tidyselect (>= 1.2.0), + rlang (>= 0.4.10), + magrittr (>= 1.5), + DiagrammeR (>= 1.0.9), + import (>= 1.1.0), + psych (>= 1.8.4), + e1071 (>= 1.6.8), + rpart (>= 4.1.11), + ggrepel (>= 0.8), + broom (>= 0.7.0), + patchwork (>= 1.0.0), + ranger (>= 0.11.2), + xgboost (>= 1.6.0.1), + pdp (>= 0.8.1), + vip (>= 0.3.2), + stringi, + yaml, + shiny.i18n +Suggests: + testthat (>= 2.0.0), + pkgdown (>= 1.1.0) +URL: https://github.com/radiant-rstats/radiant.model/, + https://radiant-rstats.github.io/radiant.model/, + https://radiant-rstats.github.io/docs/ +BugReports: https://github.com/radiant-rstats/radiant.model/issues/ +License: AGPL-3 | file LICENSE +LazyData: true +Encoding: UTF-8 +Language: en-US +RoxygenNote: 7.3.2 diff --git a/radiant.model/LICENSE b/radiant.model/LICENSE new file mode 100644 index 0000000000000000000000000000000000000000..fa3c0433841c97a748da9d2f3c01688f5faa7a43 --- /dev/null +++ b/radiant.model/LICENSE @@ -0,0 +1,105 @@ +Radiant is licensed under AGPL3 (see https://tldrlegal.com/license/gnu-affero-general-public-license-v3-(agpl-3.0) and https://www.r-project.org/Licenses/AGPL-3). The radiant help files are licensed under the creative commons attribution, non-commercial, share-alike license CC-NC-SA (https://creativecommons.org/licenses/by-nc-sa/4.0/). + +As a summary, the AGPLv3 license requires, attribution, including copyright and license information in copies of the software, stating changes if the code is modified, and disclosure of all source code. Details are in the COPYING file. + +If you are interested in using Radiant please email me at radiant@rady.ucsd.edu + +ALL HELPFILES IN THE RADIANT APPLICATION USE THE FOLLOWING LICENSE (https://creativecommons.org/licenses/by-nc-sa/4.0/) +======================================================================================================================== + +Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International Public License + +By exercising the Licensed Rights (defined below), You accept and agree to be bound by the terms and conditions of this Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International Public License ("Public License"). To the extent this Public License may be interpreted as a contract, You are granted the Licensed Rights in consideration of Your acceptance of these terms and conditions, and the Licensor grants You such rights in consideration of benefits the Licensor receives from making the Licensed Material available under these terms and conditions. + +Section 1 – Definitions. + +Adapted Material means material subject to Copyright and Similar Rights that is derived from or based upon the Licensed Material and in which the Licensed Material is translated, altered, arranged, transformed, or otherwise modified in a manner requiring permission under the Copyright and Similar Rights held by the Licensor. For purposes of this Public License, where the Licensed Material is a musical work, performance, or sound recording, Adapted Material is always produced where the Licensed Material is synched in timed relation with a moving image. +Adapter's License means the license You apply to Your Copyright and Similar Rights in Your contributions to Adapted Material in accordance with the terms and conditions of this Public License. +BY-NC-SA Compatible License means a license listed at creativecommons.org/compatiblelicenses, approved by Creative Commons as essentially the equivalent of this Public License. +Copyright and Similar Rights means copyright and/or similar rights closely related to copyright including, without limitation, performance, broadcast, sound recording, and Sui Generis Database Rights, without regard to how the rights are labeled or categorized. For purposes of this Public License, the rights specified in Section 2(b)(1)-(2) are not Copyright and Similar Rights. +Effective Technological Measures means those measures that, in the absence of proper authority, may not be circumvented under laws fulfilling obligations under Article 11 of the WIPO Copyright Treaty adopted on December 20, 1996, and/or similar international agreements. +Exceptions and Limitations means fair use, fair dealing, and/or any other exception or limitation to Copyright and Similar Rights that applies to Your use of the Licensed Material. +License Elements means the license attributes listed in the name of a Creative Commons Public License. The License Elements of this Public License are Attribution, NonCommercial, and ShareAlike. +Licensed Material means the artistic or literary work, database, or other material to which the Licensor applied this Public License. +Licensed Rights means the rights granted to You subject to the terms and conditions of this Public License, which are limited to all Copyright and Similar Rights that apply to Your use of the Licensed Material and that the Licensor has authority to license. +Licensor means the individual(s) or entity(ies) granting rights under this Public License. +NonCommercial means not primarily intended for or directed towards commercial advantage or monetary compensation. For purposes of this Public License, the exchange of the Licensed Material for other material subject to Copyright and Similar Rights by digital file-sharing or similar means is NonCommercial provided there is no payment of monetary compensation in connection with the exchange. +Share means to provide material to the public by any means or process that requires permission under the Licensed Rights, such as reproduction, public display, public performance, distribution, dissemination, communication, or importation, and to make material available to the public including in ways that members of the public may access the material from a place and at a time individually chosen by them. +Sui Generis Database Rights means rights other than copyright resulting from Directive 96/9/EC of the European Parliament and of the Council of 11 March 1996 on the legal protection of databases, as amended and/or succeeded, as well as other essentially equivalent rights anywhere in the world. +You means the individual or entity exercising the Licensed Rights under this Public License. Your has a corresponding meaning. +Section 2 – Scope. + +License grant. +Subject to the terms and conditions of this Public License, the Licensor hereby grants You a worldwide, royalty-free, non-sublicensable, non-exclusive, irrevocable license to exercise the Licensed Rights in the Licensed Material to: +reproduce and Share the Licensed Material, in whole or in part, for NonCommercial purposes only; and +produce, reproduce, and Share Adapted Material for NonCommercial purposes only. +Exceptions and Limitations. For the avoidance of doubt, where Exceptions and Limitations apply to Your use, this Public License does not apply, and You do not need to comply with its terms and conditions. +Term. The term of this Public License is specified in Section 6(a). +Media and formats; technical modifications allowed. The Licensor authorizes You to exercise the Licensed Rights in all media and formats whether now known or hereafter created, and to make technical modifications necessary to do so. The Licensor waives and/or agrees not to assert any right or authority to forbid You from making technical modifications necessary to exercise the Licensed Rights, including technical modifications necessary to circumvent Effective Technological Measures. For purposes of this Public License, simply making modifications authorized by this Section 2(a)(4) never produces Adapted Material. +Downstream recipients. +Offer from the Licensor – Licensed Material. Every recipient of the Licensed Material automatically receives an offer from the Licensor to exercise the Licensed Rights under the terms and conditions of this Public License. +Additional offer from the Licensor – Adapted Material. Every recipient of Adapted Material from You automatically receives an offer from the Licensor to exercise the Licensed Rights in the Adapted Material under the conditions of the Adapter’s License You apply. +No downstream restrictions. You may not offer or impose any additional or different terms or conditions on, or apply any Effective Technological Measures to, the Licensed Material if doing so restricts exercise of the Licensed Rights by any recipient of the Licensed Material. +No endorsement. Nothing in this Public License constitutes or may be construed as permission to assert or imply that You are, or that Your use of the Licensed Material is, connected with, or sponsored, endorsed, or granted official status by, the Licensor or others designated to receive attribution as provided in Section 3(a)(1)(A)(i). +Other rights. + +Moral rights, such as the right of integrity, are not licensed under this Public License, nor are publicity, privacy, and/or other similar personality rights; however, to the extent possible, the Licensor waives and/or agrees not to assert any such rights held by the Licensor to the limited extent necessary to allow You to exercise the Licensed Rights, but not otherwise. +Patent and trademark rights are not licensed under this Public License. +To the extent possible, the Licensor waives any right to collect royalties from You for the exercise of the Licensed Rights, whether directly or through a collecting society under any voluntary or waivable statutory or compulsory licensing scheme. In all other cases the Licensor expressly reserves any right to collect such royalties, including when the Licensed Material is used other than for NonCommercial purposes. +Section 3 – License Conditions. + +Your exercise of the Licensed Rights is expressly made subject to the following conditions. + +Attribution. + +If You Share the Licensed Material (including in modified form), You must: + +retain the following if it is supplied by the Licensor with the Licensed Material: +identification of the creator(s) of the Licensed Material and any others designated to receive attribution, in any reasonable manner requested by the Licensor (including by pseudonym if designated); +a copyright notice; +a notice that refers to this Public License; +a notice that refers to the disclaimer of warranties; +a URI or hyperlink to the Licensed Material to the extent reasonably practicable; +indicate if You modified the Licensed Material and retain an indication of any previous modifications; and +indicate the Licensed Material is licensed under this Public License, and include the text of, or the URI or hyperlink to, this Public License. +You may satisfy the conditions in Section 3(a)(1) in any reasonable manner based on the medium, means, and context in which You Share the Licensed Material. For example, it may be reasonable to satisfy the conditions by providing a URI or hyperlink to a resource that includes the required information. +If requested by the Licensor, You must remove any of the information required by Section 3(a)(1)(A) to the extent reasonably practicable. +ShareAlike. +In addition to the conditions in Section 3(a), if You Share Adapted Material You produce, the following conditions also apply. + +The Adapter’s License You apply must be a Creative Commons license with the same License Elements, this version or later, or a BY-NC-SA Compatible License. +You must include the text of, or the URI or hyperlink to, the Adapter's License You apply. You may satisfy this condition in any reasonable manner based on the medium, means, and context in which You Share Adapted Material. +You may not offer or impose any additional or different terms or conditions on, or apply any Effective Technological Measures to, Adapted Material that restrict exercise of the rights granted under the Adapter's License You apply. +Section 4 – Sui Generis Database Rights. + +Where the Licensed Rights include Sui Generis Database Rights that apply to Your use of the Licensed Material: + +for the avoidance of doubt, Section 2(a)(1) grants You the right to extract, reuse, reproduce, and Share all or a substantial portion of the contents of the database for NonCommercial purposes only; +if You include all or a substantial portion of the database contents in a database in which You have Sui Generis Database Rights, then the database in which You have Sui Generis Database Rights (but not its individual contents) is Adapted Material, including for purposes of Section 3(b); and +You must comply with the conditions in Section 3(a) if You Share all or a substantial portion of the contents of the database. +For the avoidance of doubt, this Section 4 supplements and does not replace Your obligations under this Public License where the Licensed Rights include other Copyright and Similar Rights. +Section 5 – Disclaimer of Warranties and Limitation of Liability. + +Unless otherwise separately undertaken by the Licensor, to the extent possible, the Licensor offers the Licensed Material as-is and as-available, and makes no representations or warranties of any kind concerning the Licensed Material, whether express, implied, statutory, or other. This includes, without limitation, warranties of title, merchantability, fitness for a particular purpose, non-infringement, absence of latent or other defects, accuracy, or the presence or absence of errors, whether or not known or discoverable. Where disclaimers of warranties are not allowed in full or in part, this disclaimer may not apply to You. +To the extent possible, in no event will the Licensor be liable to You on any legal theory (including, without limitation, negligence) or otherwise for any direct, special, indirect, incidental, consequential, punitive, exemplary, or other losses, costs, expenses, or damages arising out of this Public License or use of the Licensed Material, even if the Licensor has been advised of the possibility of such losses, costs, expenses, or damages. Where a limitation of liability is not allowed in full or in part, this limitation may not apply to You. +The disclaimer of warranties and limitation of liability provided above shall be interpreted in a manner that, to the extent possible, most closely approximates an absolute disclaimer and waiver of all liability. +Section 6 – Term and Termination. + +This Public License applies for the term of the Copyright and Similar Rights licensed here. However, if You fail to comply with this Public License, then Your rights under this Public License terminate automatically. +Where Your right to use the Licensed Material has terminated under Section 6(a), it reinstates: + +automatically as of the date the violation is cured, provided it is cured within 30 days of Your discovery of the violation; or +upon express reinstatement by the Licensor. +For the avoidance of doubt, this Section 6(b) does not affect any right the Licensor may have to seek remedies for Your violations of this Public License. +For the avoidance of doubt, the Licensor may also offer the Licensed Material under separate terms or conditions or stop distributing the Licensed Material at any time; however, doing so will not terminate this Public License. +Sections 1, 5, 6, 7, and 8 survive termination of this Public License. +Section 7 – Other Terms and Conditions. + +The Licensor shall not be bound by any additional or different terms or conditions communicated by You unless expressly agreed. +Any arrangements, understandings, or agreements regarding the Licensed Material not stated herein are separate from and independent of the terms and conditions of this Public License. +Section 8 – Interpretation. + +For the avoidance of doubt, this Public License does not, and shall not be interpreted to, reduce, limit, restrict, or impose conditions on any use of the Licensed Material that could lawfully be made without permission under this Public License. +To the extent possible, if any provision of this Public License is deemed unenforceable, it shall be automatically reformed to the minimum extent necessary to make it enforceable. If the provision cannot be reformed, it shall be severed from this Public License without affecting the enforceability of the remaining terms and conditions. +No term or condition of this Public License will be waived and no failure to comply consented to unless expressly agreed to by the Licensor. +Nothing in this Public License constitutes or may be interpreted as a limitation upon, or waiver of, any privileges and immunities that apply to the Licensor or You, including from the legal processes of any jurisdiction or authority. diff --git a/radiant.model/NAMESPACE b/radiant.model/NAMESPACE new file mode 100644 index 0000000000000000000000000000000000000000..de1623e3bcf3f7ed2635402858945836be8e10d5 --- /dev/null +++ b/radiant.model/NAMESPACE @@ -0,0 +1,273 @@ +# Generated by roxygen2: do not edit by hand + +S3method(plot,confusion) +S3method(plot,crs) +S3method(plot,crtree) +S3method(plot,dtree) +S3method(plot,evalbin) +S3method(plot,evalreg) +S3method(plot,gbt) +S3method(plot,logistic) +S3method(plot,mnl) +S3method(plot,mnl.predict) +S3method(plot,model.predict) +S3method(plot,nb) +S3method(plot,nb.predict) +S3method(plot,nn) +S3method(plot,regress) +S3method(plot,repeater) +S3method(plot,rforest) +S3method(plot,rforest.predict) +S3method(plot,simulater) +S3method(plot,uplift) +S3method(predict,coxp) +S3method(predict,crtree) +S3method(predict,gbt) +S3method(predict,logistic) +S3method(predict,mnl) +S3method(predict,nb) +S3method(predict,nn) +S3method(predict,regress) +S3method(predict,rforest) +S3method(predict,svm) +S3method(print,coxp.predict) +S3method(print,crtree.predict) +S3method(print,gbt.predict) +S3method(print,logistic.predict) +S3method(print,mnl.predict) +S3method(print,nb.predict) +S3method(print,nn.predict) +S3method(print,regress.predict) +S3method(print,rforest.predict) +S3method(print,svm.predict) +S3method(render,DiagrammeR) +S3method(sensitivity,dtree) +S3method(store,crs) +S3method(store,mnl.predict) +S3method(store,model) +S3method(store,model.predict) +S3method(store,nb.predict) +S3method(store,rforest.predict) +S3method(summary,confusion) +S3method(summary,coxp) +S3method(summary,crs) +S3method(summary,crtree) +S3method(summary,dtree) +S3method(summary,evalbin) +S3method(summary,evalreg) +S3method(summary,gbt) +S3method(summary,logistic) +S3method(summary,mnl) +S3method(summary,nb) +S3method(summary,nn) +S3method(summary,regress) +S3method(summary,repeater) +S3method(summary,rforest) +S3method(summary,simulater) +S3method(summary,svm) +S3method(summary,uplift) +export(.as_int) +export(.as_num) +export(MAE) +export(RMSE) +export(Rsq) +export(ann) +export(auc) +export(confint_robust) +export(confusion) +export(coxp) +export(crs) +export(crtree) +export(cv.crtree) +export(cv.gbt) +export(cv.nn) +export(cv.rforest) +export(dtree) +export(dtree_parser) +export(evalbin) +export(evalreg) +export(find_max) +export(find_min) +export(gbt) +export(logistic) +export(minmax) +export(mnl) +export(nb) +export(nn) +export(onehot) +export(pdp_plot) +export(pred_plot) +export(predict_model) +export(print_predict_model) +export(profit) +export(radiant.model) +export(radiant.model_viewer) +export(radiant.model_window) +export(regress) +export(remove_comments) +export(repeater) +export(rforest) +export(rig) +export(scale_df) +export(sdw) +export(sensitivity) +export(sim_cleaner) +export(sim_cor) +export(sim_splitter) +export(sim_summary) +export(simulater) +export(svm) +export(test_specs) +export(uplift) +export(var_check) +export(varimp) +export(varimp_plot) +export(write.coeff) +import(ggplot2) +import(radiant.data) +import(shiny) +importFrom(DiagrammeR,DiagrammeR) +importFrom(DiagrammeR,DiagrammeROutput) +importFrom(DiagrammeR,mermaid) +importFrom(DiagrammeR,renderDiagrammeR) +importFrom(NeuralNetTools,garson) +importFrom(NeuralNetTools,olden) +importFrom(NeuralNetTools,plotnet) +importFrom(broom,augment) +importFrom(car,linearHypothesis) +importFrom(car,vif) +importFrom(data.tree,Clone) +importFrom(data.tree,FormatPercent) +importFrom(data.tree,Get) +importFrom(data.tree,Traverse) +importFrom(data.tree,as.Node) +importFrom(data.tree,isLeaf) +importFrom(data.tree,isNotLeaf) +importFrom(data.tree,isNotRoot) +importFrom(dplyr,across) +importFrom(dplyr,arrange) +importFrom(dplyr,arrange_at) +importFrom(dplyr,bind_cols) +importFrom(dplyr,bind_rows) +importFrom(dplyr,data_frame) +importFrom(dplyr,desc) +importFrom(dplyr,distinct_at) +importFrom(dplyr,everything) +importFrom(dplyr,filter) +importFrom(dplyr,first) +importFrom(dplyr,funs) +importFrom(dplyr,group_by) +importFrom(dplyr,group_by_) +importFrom(dplyr,group_by_at) +importFrom(dplyr,inner_join) +importFrom(dplyr,last) +importFrom(dplyr,min_rank) +importFrom(dplyr,mutate) +importFrom(dplyr,mutate_) +importFrom(dplyr,mutate_all) +importFrom(dplyr,mutate_at) +importFrom(dplyr,mutate_if) +importFrom(dplyr,near) +importFrom(dplyr,pull) +importFrom(dplyr,rename) +importFrom(dplyr,sample_n) +importFrom(dplyr,select) +importFrom(dplyr,select_at) +importFrom(dplyr,slice) +importFrom(dplyr,summarise) +importFrom(dplyr,summarise_) +importFrom(dplyr,summarise_all) +importFrom(dplyr,summarise_at) +importFrom(dplyr,summarize) +importFrom(dplyr,ungroup) +importFrom(e1071,naiveBayes) +importFrom(ggplot2,autoplot) +importFrom(ggrepel,geom_text_repel) +importFrom(graphics,par) +importFrom(import,from) +importFrom(lubridate,is.Date) +importFrom(lubridate,now) +importFrom(magrittr,"%<>%") +importFrom(magrittr,"%>%") +importFrom(magrittr,"%T>%") +importFrom(magrittr,extract2) +importFrom(magrittr,set_colnames) +importFrom(magrittr,set_names) +importFrom(magrittr,set_rownames) +importFrom(nnet,nnet) +importFrom(nnet,nnet.formula) +importFrom(patchwork,plot_annotation) +importFrom(patchwork,wrap_plots) +importFrom(pdp,partial) +importFrom(psych,cohen.kappa) +importFrom(radiant.data,launch) +importFrom(radiant.data,set_attr) +importFrom(radiant.data,visualize) +importFrom(ranger,ranger) +importFrom(rlang,":=") +importFrom(rlang,.data) +importFrom(rlang,parse_exprs) +importFrom(rpart,prune.rpart) +importFrom(rpart,rpart) +importFrom(rpart,rpart.control) +importFrom(sandwich,vcovHC) +importFrom(scales,percent) +importFrom(shiny,getDefaultReactiveDomain) +importFrom(shiny,incProgress) +importFrom(shiny,withProgress) +importFrom(stats,anova) +importFrom(stats,as.formula) +importFrom(stats,binomial) +importFrom(stats,coef) +importFrom(stats,confint) +importFrom(stats,confint.default) +importFrom(stats,contrasts) +importFrom(stats,cor) +importFrom(stats,deviance) +importFrom(stats,dnorm) +importFrom(stats,family) +importFrom(stats,formula) +importFrom(stats,glm) +importFrom(stats,lm) +importFrom(stats,logLik) +importFrom(stats,median) +importFrom(stats,model.frame) +importFrom(stats,model.matrix) +importFrom(stats,na.omit) +importFrom(stats,pnorm) +importFrom(stats,predict) +importFrom(stats,pt) +importFrom(stats,qnorm) +importFrom(stats,qt) +importFrom(stats,quantile) +importFrom(stats,rbinom) +importFrom(stats,relevel) +importFrom(stats,residuals) +importFrom(stats,rlnorm) +importFrom(stats,rnorm) +importFrom(stats,rpois) +importFrom(stats,runif) +importFrom(stats,sd) +importFrom(stats,setNames) +importFrom(stats,step) +importFrom(stats,terms) +importFrom(stats,terms.formula) +importFrom(stats,update) +importFrom(stats,weighted.mean) +importFrom(stats,wilcox.test) +importFrom(stringi,stri_trans_general) +importFrom(stringr,str_match) +importFrom(tidyr,gather) +importFrom(tidyr,spread) +importFrom(tidyselect,where) +importFrom(utils,as.relistable) +importFrom(utils,capture.output) +importFrom(utils,combn) +importFrom(utils,head) +importFrom(utils,relist) +importFrom(utils,tail) +importFrom(utils,write.table) +importFrom(vip,vi) +importFrom(xgboost,xgb.importance) +importFrom(xgboost,xgboost) +importFrom(yaml,yaml.load) diff --git a/radiant.model/NEWS.md b/radiant.model/NEWS.md new file mode 100644 index 0000000000000000000000000000000000000000..cad65044a786a56df0ea2e789973ea426b5435af --- /dev/null +++ b/radiant.model/NEWS.md @@ -0,0 +1,420 @@ +# radiant.model 1.6.7 + +- Fixed documentation for decision tree sensitivity analysis +- Added a warning in case an integer overflow occurs in decision analysis calculations +- Fixed an issue where loading a yaml file for decision analysis could overwrite an existing tree structure +- Fixed issues with Permutation Importance, Prediction, and Partial Dependence plots with stepwise regression is used. Applies to both logistic and linear regression + +# radiant.model 1.6.6 + +* Require Shiny 1.8.1. Adjustments related to icon-buttons were made to address a breaking change in Shiny 1.8.1 +* Reverting changes that removed `req(input$dataset)` in different places + +# radiant.model 1.6.3 + +* Fix for change in vip package metric name for r2 + +# radiant.model 1.6.0 + +* Added scaling factor for profit calculations in Model > Evaluate Classification +* Replace dplyr::all_equal with all.equal due deprecation warning +* Using "Radiant for R" in UI to differentiate from "Radiant for Python" +* Check if the value of mtry for random forest is less than 0 or larger than the number of variables in the model +* Addressed a package documentation issue due to a change in roxygen2 + +# radiant.model 1.5.0 + +* Improvements to screenshot feature. Navigation bar is omitted and the image is adjusted to the length of the UI. +* Removed all references to `aes_string` which is being deprecated in ggplot +* Replaced "size" argument, deprecated in ggplot2, with "linewidth" +* Added functionality to create pdp plots, prediction plots (pred_plot), and permutation importance plots (varimp) for most available models. Prediction plots are convenient to quickly check for possible interactions which would take longer to generate using PDP +* Added AUC and Adjusted Pseudo R-squared to model fit metrics for logistic regression + +# radiant.model 1.4.10 + +* Fix when parsing commands using strsplit on ';' +* Use `dplyr::near` to avoid issues with user-provided probabilities not summing to 1 due to machine tolerance + +# radiant.model 1.4.8 + +* gsub("[\x80-\xFF]", "", text) is no longer valid in R 4.2.0 and above. Non-asci symbols will now be escaped using stringi + +# radiant.model 1.4.6 + +* Added option to create screenshots of settings on a page. Approach is inspired by the snapper package by @yonicd +* Download decision analysis and decision tree plots generated using mermaid (DiagrammeR) to png format + +# radiant.model 1.4.4 + +* Fix for change in input format for XGBoost that broke cross-validation + +# radiant.model 1.4.3 + +* Fix for breaking change in as.vector for data.frames in the development version of R + +# radiant.model 1.4.2 + +* Fixed `is_empty` function clash with `rlang` +* Adjustments to work with the latest version of `shiny` and `bootstrap4` + +# radiant.model 1.4.1 + +* Fixed an issue where variables used in Decision Analysis with a one letter label caused problems evaluating the tree correctly +* Provide easier access to payoffs, probabilities, etc. from a solved Decisions Analysis tree + +# radiant.model 1.4.0 + +* Allow jitter in regression plots with scatter +* Log transformation of nnet::multinom estimates is no longer needed + +# radiant.model 1.3.16 + +* Remove missing values from _tidy_ model output + +# radiant.model 1.3.15 + +* Allow user to include or exclude variables from the coefficient plot in linear and logistic regression +* Fix for error on R-dev in _Model > Collaborative filtering_ ("Error in xtfrm.data.frame(x) : cannot xtfrm data frames") + +# radiant.model 1.3.14 + +* Fix for issue introduced by version 0.7.0 of the broom package related to degrees of freedom in linear regression +* Fix for NoLD issue (XGBoost) identified by CRAN on Linux +* Fix for NoLD issue (XGBoost) identified by CRAN on Solaris + +# radiant.model 1.3.12 + +* Fix for _Model > Decision analysis_. Indent levels could be affected when the input file contains blank lines +* Improvement in calculating PDP for categorical variables in plot.gbt based on suggestion by @benmarchi (https://github.com/radiant-rstats/radiant.model/issues/4) + +# radiant.model 1.3.9 + +* Minor adjustments in anticipation of dplyr 1.0.0 + +# radiant.model 1.3.8 + +* Fix for cv.rforest when the max of `mtry` exceeds the number of explanatory variables +* Fix to write.coeff when one or more coefficients have a missing value +* Use weighted mean and sd in write.coeff function when needed +* Added flexibility in using constants while defining the spec for other randomly generated variables + +# radiant.model 1.3.5 + +* Adding `OR%` change as a columns in output for _Model > Logistic regression_ and the `write.coeff` function +* Restrict max number of levels in a "groupable" variable used in _Model > Evaluate classification_ and _Model > Multinomial logistic regression_ to no more than 50 +* Avoid rounding the profit measures in _Model > Evaluate classificiation_ + +# radiant.model 1.3.2 + +* Improvements to cv.gbt to allow previously setup evaluation functions to be used in cross validation for hyper parameter tuning +* Random Forest module using the `ranger` package. Includes a `cv.rforest` function for tuning using cross-validation +* Gradient Boosted Trees module using the `xgboost` package. Includes a `cv.gbt` function for tuning using cross-validation. For convenience, all data.frame-to-matrix-conversion is handled by radiant +* Partial Dependence Plots for all trees-based estimation modules and for neural networks +* `onehot` function to make converting a data.frame with categorical variables to a matrix a bit easier + +# radiant.model 1.3.0 + +* Allow specification of multiple summary functions in _Model > Simulate > Repeat_ +* Documentation updates to link to new video tutorials +* Use `patchwork` for grouping multiple plots together +* Allow formula input for `logistic` and `regress` functions +* Adjust correlation plot for NB to accommodate changes in _Basics > Correlation_ +* Fix for repeated simulation (_Model > Simulate > Repeat_) where "Variables to re-simulate" and "Output variables" were not always updated correctly when the set of available variables changed + +# radiant.model 1.2.7 + +* Fix prediction issue when using I(x^2) in a stepwise estimation process and x is removed +* Fix issue finding .as_int and .as_num when use radiant through shiny server + +# radiant.model 1.2.5 + +* Option to drop the intercept for _Model > Multinomial Logistic Regression_ +* Provide access to the variables in a dataset during simulation and repeated simulation. + +# radiant.model 1.2.2 + +* Various fixes related to stepwise estimation of Multinomial, Logistic, and Linear regression model (e.g., VIF calculation, models with only an intercept, perfect multicollinearity, etc.). + +# radiant.model 1.2.1 + +* Fix to ensure environment is not attached as an attribute to data frames generated in the _Model > Simulate_ tool + +# radiant.model 1.2.0 + +* Update action buttons that initiate calculations when one or more relevant inputs are changed. When, for example, a model should be re-estimated, a spinning "refresh" icon will be shown +* Add option to use a formula for the `regress` function +* Improved description of standardization process used. Added link to [Gelman 2008](http://www.stat.columbia.edu/~gelman/research/published/standardizing7.pdf) +* Added an influence plot that shows standardized residuals and cooks-distance + +# radiant.model 1.1.10 + +* Fix for `nobs` in _Model > Multinomial logistic regression_. +* Fix for `write.coeff` for use with _Model > Multinomial logistic regression_ +* Fix for decision trees that reference sub-trees. Environment to evaluate the tree is now explicitly provided. This will now also work with (sub) trees loaded from .yaml files +* Decision analysis now allows basic formulas in all parts of the tree +* Added confusion matrix and misclassification error for _Model > Multinomial Logistic regression (MNL)_ +* Fix for saving multiple residual series for MNL +* Added a module for Multinomial Logistic regression (MNL) in the _Model > Estimate_ menu +* Fix for confusion matrix which couldn't find find the selected dataset in the web-interface +* Documentation fixes and updates +* Improved checks for variables that show no variation +* Numerous small code changes to support enhanced auto-completion, tooltips, and annotations in shinyAce 0.4.1 +* Automatically fix faulty spacing in user input in Model > Decision Analysis + +# radiant.model 1.0.0 + +* Keyboard shortcut (Enter) when defining variable in Model > Simulate +* Allow series of type ts and date in models and prediction +* Autocompletion for functions in Model > Simulate +* Require shinyAce 0.4.0 + +# radiant.model 0.9.9.3 + +* Don't use simulation variables when their type is not selected +* Provide auto-completion for variables and relevant functions in the Simulate > Functions input +* Keyboard shortcuts for add a defined variable (i.e., press enter after adding the last input value) + +# radiant.model 0.9.9.2 + +* Fix for variable definition in _Model > Simulate_ where names of discrete random variables were not properly 'fixed' +* Fix for variable selection in _Model > Decision analysis > Sensitivity_ + +# radiant.model 0.9.9.0 + +* Allow any variable in the prediction dataset to be used to customize a prediction when using _Predict > Data & Command_ +* Fix for `write.coeff` when interactions, quadratic, and/or cubic terms are included in a linear or logistic regression +* Rescale predictions in `cv.nn` so RMSE and MAE are in the original scale even if the data were standardized for estimation +* Rename `scaledf` to `scale_df` for consistency +* Fix for plot sizing and printing of missing values in collaborative filtering +* Fix for `cv.nn` when weights are used in estimation +* Improve documentation for cross-validation of `nn` and `crtree` models (i.e., `cv.nn` and `cv.crtree`) +* Fixes for breaking changes in dplyr 0.8.0 +* Fix to download tables from _Model > Evaluate classificiation_ +* Use an expandable `shinyAce` input for the formula and function inputs in _Model > Simulate_ +* Fixes for repeated simulation with grid-search +* Use `test` instead of `validation` + +# radiant.model 0.9.8.0 + +* Option to add user defined function to simulations. This dramatically increases the flexibility of the simulation tool +* Ensure variable and dataset names are valid for R (i.e., no spaces or symbols), "fixing" the input as needed +* Cross validation functions for decision trees (`cv.crtree`) and neural networks(`cv.nn`) that can use various performance metrics for during evaluation e.g., `auc` or `profit` +* Option to add square and cube terms in _Model > Linear regression_ and _Model > Logistic regression_. +* Option to pass additional arguments to `shiny::runApp` when starting radiant such as the port to use. For example, radiant.model::radiant.model("https://github.com/radiant-rstats/docs/raw/gh-pages/examples/demo-dvd-rnd.state.rda", port = 8080) +* Avoid empty string showing up in auto-generated code for model prediction (i.e., `pred_data` or `pred_cmd`) +* Fix for VIF based on `car` for `regress` and `logistic` +* Load a state file on startup by providing a (relative) file path or a url. For example, radiant.model::radiant.model("https://github.com/radiant-rstats/docs/raw/gh-pages/examples/demo-dvd-rnd.state.rda") +* Don't live-update the active tree input to make it easier to save edits to a new tree without adding edits to the existing tree (Model > Decision analysis) +* Fix for NA error when last line of a decision analysis input is a node without a payoff or probability +* Load input (CMD + O) and Save input (CMD + S) keyboard shortcuts for decision analysis + +# radiant.model 0.9.7.0 + +## Major changes + +* Using [`shinyFiles`](https://github.com/thomasp85/shinyFiles) to provide convenient access to data located on a server + +## Minor changes + +* Fix for simulations that use a data set as part of the analysis +* Replace non-ASCII characters in example datasets +* Remove `rstudioapi` as a direct import +* Revert from `svg` to `png` for plots in `_Report > Rmd_ and _Report > R_. `svg` scatter plots with many point get to big for practical use on servers that have to transfer images to a local browser +* Removed dependency on `methods` package + +# radiant.model 0.9.5.0 + +## Major changes + +* Various changes to the code to accommodate the use of `shiny::makeReactiveBinding`. The advantage is that the code generated for _Report > Rmd_ and _Report > R_ will no longer have to use `r_data` to store and access data. This means that code generated and used in the Radiant browser interface will be directly usable without the browser interface as well. +* Improved documentation and examples + +# radiant.model 0.9.2.3 + +## Bug fixes + +* Fix for https://github.com/radiant-rstats/radiant/issues/53 + +# radiant.model 0.9.2.2 + +## Major changes + +* Show the interval used in prediction for _Model > Regression_ and _Model > logistic_ (e.g., "prediction" or "confidence" for linear regression) +* Auto complete in _Model > Decision analysis_ now provides hints based on the current tree input and any others defined in the app. It also provides suggestions for the basic element of the tree (e.g., `type: decision`, `type: chance`, `payoff`, etc.) +* Updated user messages for _Model > Decision analysis_ when input has errors + +# radiant.model 0.9.2.1 + +## Major changes + +* Default interval for predictions from a linear regression is now "confidence" rather than "prediction" +* `Estimate model` button indicates when the output has been invalidated and the model should be re-estimated +* Combined _Evaluate classification_ Summary and Plot into Evaluate tab +* Upload and download data using the Rstudio file browser. Allows using relative paths to files (e.g., data or images inside an Rstudio project) + +## Minor changes + +* Require `shinyAce` 0.3.0 in `radiant.data` and `useSoftTabs` for _Model > Decision Analysis_ + +# radiant.model 0.9.1.0 + +## Major changes + +* Add Poisson as an option for _Model > Simulate_ + +## Bug fixes + +* Fix for [#43](https://github.com/radiant-rstats/radiant/issues/43) where scatter plot was not shown for a dataset with less than 1,000 rows +* Fixed example for logistic regression prediction plot +* Fix for case weights when minimum response value is 0 + +# radiant.model 0.9.0.15 + +## Minor changes + +* Allow character variables in estimation and prediction +* Depend on DiagrammeR 1.0.0 + +# radiant.model 0.9.0.13 + +## Major changes + +* Residual diagnostic plot for Neural Network regression +* Improved handling of case weights for logistic regression and neural networks + +## Minor changes +* Show number of observations used in training and validation in _Model > Evaluate classification_ +* Use Elkan's formula to adjust probabilities when using `priors` in `crtree` (`rpart`) +* Added options to customize tree generated using `crtree` (based on `rpart`) +* Better control of tree plot size in `plot.crtree` +* Cleanup of `crtree` code +* Improved printing of NN weights +* Option to change font size in NN plots +* Keyboard shortcut: Press return when cursor is in textInput to store residuals or predictions + +## Bug fixes + +* Fix for tree labels when (negative) integers are used + +# radiant.model 0.9.0.8 + +## Minor changes + +* Cleanup of lists returned by `evalbin` and `confusion` +* Add intercept in coefficient tables that can be downloaded for linear and logistic regression or using `write.coeff` +* Convert logicals to factors in `crtree` to avoid labels < 0.5 and >= 0.5 +* Improved labeling of decision tree splits in `crtree`. The tooltip (aka hover-over) will contain all levels used, but the tree label may be truncated as needed + +## Bug fixes + +* Fix input reset when screen size or zoom level is changed + +# radiant.model 0.9.0.4 + +* Renamed `ann` to `nn`. The `ann` function is now deprecated + +# radiant.model 0.9.0.3 + +## Major changes + +* Prediction confidence interval provided for logistic regression based on blog post by [Gavin Simpson] (https://www.fromthebottomoftheheap.net/2017/05/01/glm-prediction-intervals-i/) +* Argument added to `logistic` to specify if profiling or the Wald method should be used for confidence intervals. Profiling will be used by default for datasets with fewer than 5,000 rows + +# radiant.model 0.9.0.2 + +## Minor changes + +* Left align tooltip in DiagrammeR plots (i.e., _Model >Decision Analysis_ and _Model > Classification and regression trees_) +* Add information about levels in tree splits to tooltips (_Model > Classification and regression trees_) + +## Bug fixes + +* Fix to ensure DiagrammeR plots are shown in Rmarkdown report generate in _Report > Rmd_ or _Report > R_ + +# radiant.model 0.9.0.1 + +## Major changes + +* Added option to generate normally distributed correlated data in Model > Simulate +* Added option to generate normally distributed simulated data with exact mean and standard deviation in Model > Simulate +* Long lines of code generated for _Report > Rmd_ will be wrapped to enhance readability + +## Minor changes + +* Default names when saving Decision Analysis input and output are now based on tree name +* Allow browser zoom for tree plots in Model > Decision Analysis and Model > Classification and Regression Trees +* Enhanced keyboard shortcuts for estimation and reporting +* Applied `styler` to code + +## Bug fixes + +* Grid search specs ignored when _Model > Simulate > Repeat_ is set to `Simulate` +* The number of repetitions in Model > Simulate was NA when grid search was used +* Fix for large weights that may cause an integer overflow +* Minor fix for coefficient plot in `plot.logistic` +* Fixed state setting for decision analysis sensitivity input +* Fixed for special characters (e.g., curly quote) in input for Model > Decision Analysis +* Check that costs are not assigned to terminal nodes in Decision Analysis Trees. Specifying a cost is only useful if it applies to multiple nodes in a branch. If the cost only applies to a terminal node adjust the payoff instead +* Ensure : are followed by a space in the YAML input to Model > Decision Analysis + +# radiant.model 0.8.7.4 + +## Minor change + +* Upgraded dplyr dependency to 0.7.1 +* Upgraded tidyr dependency to 0.7 + +## Bug fix + +* Fix in `crs` when a tibble is passed + +# radiant.model 0.8.3.0 + +## Major change +* Added option to use robust standard errors in _Linear regression_ and _Logistic regression_. The `HC1` covariance matrix is used to produce results consistent with Stata + +## Minor changes +* Moved coefficient formatting from summary.regress and summary.logistic to make result$coeff more easily accessible +* Added F-score to _Model > Evaluate classification > Confusion_ + +## Bug fixes + +* Fixed RSME typo +* Don't calculate VIFs when stepwise regression selects only one explanatory variable + +# radiant.model 0.8.0.0 + +## Major changes + +* Added Model > Naive Bayes based on e1071 +* Added Model > Classification and regression trees based on rpart +* Added Model > Collaborative Filtering and example dataset (data/cf.rda) +* Various enhancements to evaluate (binary) classification models +* Added Garson plot and moved all plots to the ANN > Plot tab + +## Minor changes + +* Improved plot sizing for Model > Decision Analysis +* Show progress indicators if variable acquisition takes some time +* Expanded coefficient csv file for linear and logistic regression +* Show dataset name in output if dataframe passed directly to analysis function +* As an alternative to using the Estimate button to run a model you can now also use CTRL-enter (CMD-enter on mac) +* Use ALT-enter as a keyboard short-cut to generate code and sent to _Report > Rmd_ or _Report > R_ +* Improved documentation on how to customize plots in _Report > Rmd_ or _Report > R_ + +## Bug fixes + +* Multiple tooltips in sequence in Decision Analysis +* Decision Analysis plot size in PDF was too small +* Replace histogram by distribution in regression plots +* Fix bug in regex for overlapping labels in variables section of Model > Decision Analysis +* Fixes for model with only an intercept (e.g., after stepwise regression) +* Update Predict settings when dataset is changed +* Fix for predict when using center or standardize with a command to generate the predictions +* Show full confusion matrix even if some elements are missing +* Fix for warnings when creating profit and gains charts +* Product dropdown for Model > Collaborative filtering did not list all variables + +## Deprecated + +* Use of *_each is deprecated diff --git a/radiant.model/R/aaa.R b/radiant.model/R/aaa.R new file mode 100644 index 0000000000000000000000000000000000000000..6cbf130c1597ef6ea4399a3860aef748a1ddd59d --- /dev/null +++ b/radiant.model/R/aaa.R @@ -0,0 +1,108 @@ +# to avoid 'no visible binding for global variable' NOTE +globalVariables(c( + ".", "High", "Low", + ".cooksd", ".fitted", ".resid", ".std.resid", "FN", "FP", "Feature", "Importance", "Predictor", + "ROME", "TN", "TP", "TPR", "Variable", "cum_gains", "cum_prop", "cum_resp", "cum_resp_rate", + "index", "index.max", "label", "logit", "n", "nr_obs", "nr_resp", "null.deviance", "obs", + "precision", "pred", "predictor.value", "total", "variable", "llfull", "llnull", "rnk", "Prediction", + "C_resp", "C_n", "T_resp", "T_n", "bins", "inc_uplift", "incremental_resp", "cum_profit", + "incremental_profit", "max_profit" +)) + +#' radiant.model +#' +#' @name radiant.model +#' @import radiant.data shiny ggplot2 +#' @importFrom dplyr mutate_at mutate_if mutate_all summarise_at summarise_all arrange arrange_at select select_at filter mutate mutate_ funs group_by group_by_ summarise summarize summarise_ slice bind_cols bind_rows desc first last min_rank data_frame inner_join arrange_at group_by_at ungroup rename across everything pull +#' @importFrom rlang .data parse_exprs := +#' @importFrom magrittr %>% %<>% %T>% set_colnames set_rownames set_names extract2 +#' @importFrom tidyr spread gather +#' @importFrom lubridate now +#' @importFrom patchwork wrap_plots plot_annotation +#' @importFrom DiagrammeR DiagrammeROutput renderDiagrammeR DiagrammeR mermaid +#' @importFrom utils head tail relist as.relistable combn capture.output write.table +#' @importFrom stats anova as.formula binomial coef confint cor deviance dnorm glm lm na.omit pnorm predict qnorm sd setNames step update weighted.mean wilcox.test rbinom rlnorm rnorm runif rpois terms quantile +#' @importFrom stats residuals formula model.matrix pt qt confint.default family median logLik relevel terms.formula +#' @importFrom import from +NULL + +#' Catalog sales for men's and women's apparel +#' @details Description provided in attr(catalog, "description") +#' @docType data +#' @keywords datasets +#' @name catalog +#' @usage data(catalog) +#' @format A data frame with 200 rows and 5 variables +NULL + +#' Direct marketing data +#' @details Description provided in attr(direct_marketing, "description") +#' @docType data +#' @keywords datasets +#' @name direct_marketing +#' @usage data(direct_marketing) +#' @format A data frame with 1,000 rows and 12 variables +NULL + +#' Houseprices +#' @details Description provided in attr(houseprices, "description") +#' @docType data +#' @keywords datasets +#' @name houseprices +#' @usage data(houseprices) +#' @format A data frame with 128 home sales and 6 variables +NULL + +#' Ideal data for linear regression +#' @details Description provided in attr(ideal, "description") +#' @docType data +#' @keywords datasets +#' @name ideal +#' @usage data(ideal) +#' @format A data frame with 1,000 rows and 4 variables +NULL + +#' Data on DVD sales +#' @details Binary purchase response to coupon value. Description provided in attr(dvd,"description") +#' @docType data +#' @keywords datasets +#' @name dvd +#' @usage data(dvd) +#' @format A data frame with 20,000 rows and 4 variables +NULL + +#' Data on ketchup choices +#' @details Choice behavior for a sample of 300 individuals in a panel of households in Springfield, Missouri (USA). Description provided in attr(ketchup,"description") +#' @docType data +#' @keywords datasets +#' @name ketchup +#' @usage data(ketchup) +#' @format A data frame with 2,798 rows and 14 variables +NULL + +#' Movie ratings +#' @details Use collaborative filtering to create recommendations based on ratings from existing users. Description provided in attr(ratings, "description") +#' @docType data +#' @keywords datasets +#' @name ratings +#' @usage data(ratings) +#' @format A data frame with 110 rows and 4 variables +NULL + +#' Movie contract decision tree +#' @details Use decision analysis to create a decision tree for an actor facing a contract decision +#' @docType data +#' @keywords datasets +#' @name movie_contract +#' @usage data(movie_contract) +#' @format A nested list for decision and chance nodes, probabilities and payoffs +NULL + +#' Kaggle uplift +#' @details Use uplift modeling to quantify the effectiveness of an experimental treatment +#' @docType data +#' @keywords datasets +#' @name kaggle_uplift +#' @usage data(kaggle_uplift) +#' @format A data frame with 1,000 rows and 22 variables +NULL diff --git a/radiant.model/R/cox.R b/radiant.model/R/cox.R new file mode 100644 index 0000000000000000000000000000000000000000..8b1c2da3667f181ceb6018b1e81bdf2fc51f5f09 --- /dev/null +++ b/radiant.model/R/cox.R @@ -0,0 +1,80 @@ +#' Cox Proportional Hazards Regression (minimal) +#' +#' @export +coxp <- function(dataset, + time, + status, + evar, + int = "", + check = "", + form, + data_filter = "", + arr = "", + rows = NULL, + envir = parent.frame()) { + + ## ---- 公式入口 ---------------------------------------------------------- + if (!missing(form)) { + form <- as.formula(format(form)) + vars <- all.vars(form) + time <- vars[1] + status<- vars[2] + evar <- vars[-(1:2)] + } + + ## ---- 基础检查 ---------------------------------------------------------- + if (time %in% evar || status %in% evar) { + return("Time/status variable contained in explanatory variables." %>% + add_class("coxp")) + } + + vars <- unique(c(time, status, evar)) + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, envir = envir) + + ## ---- 构造公式 ---------------------------------------------------------- + if (missing(form)) { + rhs <- if (length(evar) == 0) "1" else paste(evar, collapse = " + ") + if (!is.empty(int)) rhs <- paste(rhs, paste(int, collapse = " + "), sep = " + ") + form <- as.formula(paste("Surv(", time, ", ", status, ") ~ ", rhs)) + } + + ## ---- 模型估计 ---------------------------------------------------------- + if ("robust" %in% check) { + model <- survival::coxph(form, data = dataset, robust = TRUE) + } else { + model <- survival::coxph(form, data = dataset) + } + + ## ---- 打包返回 ---------------------------------------------------------- + out <- as.list(environment()) + out$model <- model + out$df_name <- df_name + out$type <- "survival" + out$check <- check + add_class(out, c("coxp", "model")) +} + +#' Summary 占位 +#' @export +summary.coxp <- function(object, ...) { + if (is.character(object)) return(object) + summary(object$model) +} + +#' Predict 占位 +#' @export +predict.coxp <- function(object, pred_data = NULL, pred_cmd = "", + dec = 3, envir = parent.frame(), ...) { + if (is.character(object)) return(object) + ## 如需生存预测，可返回 linear.predictors 或 survival 曲线 + pfun <- function(m, newdata) predict(m, newdata = newdata, type = "lp") + predict_model(object, pfun, "coxp.predict", + pred_data, pred_cmd, dec = dec, envir = envir) +} + +#' Print 预测占位 +#' @export +print.coxp.predict <- function(x, ..., n = 10) { + print_predict_model(x, ..., n = n, header = "Cox Proportional Hazards") +} \ No newline at end of file diff --git a/radiant.model/R/crs.R b/radiant.model/R/crs.R new file mode 100644 index 0000000000000000000000000000000000000000..4824d3c972a7b7ad5c8175145ba00f7c53cb3b6c --- /dev/null +++ b/radiant.model/R/crs.R @@ -0,0 +1,319 @@ +#' Collaborative Filtering +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/crs.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param id String with name of the variable containing user ids +#' @param prod String with name of the variable with product ids +#' @param pred Products to predict for +#' @param rate String with name of the variable with product ratings +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "training == 1") +#' @param arr Expression to arrange (sort) the data on (e.g., "color, desc(price)") +#' @param rows Rows to select from the specified dataset +#' @param envir Environment to extract data from +#' +#' @return A data.frame with the original data and a new column with predicted ratings +#' +#' @seealso \code{\link{summary.crs}} to summarize results +#' @seealso \code{\link{plot.crs}} to plot results if the actual ratings are available +#' +#' @examples +#' crs(ratings, +#' id = "Users", prod = "Movies", pred = c("M6", "M7", "M8", "M9", "M10"), +#' rate = "Ratings", data_filter = "training == 1" +#' ) %>% str() +#' @importFrom dplyr distinct_at +#' +#' @export +crs <- function(dataset, id, prod, pred, rate, + data_filter = "", arr = "", rows = NULL, + envir = parent.frame()) { + vars <- c(id, prod, rate) + df_name <- if (!is_string(dataset)) deparse(substitute(dataset)) else dataset + uid <- get_data(dataset, id, filt = data_filter, arr = arr, rows = rows, na.rm = FALSE, envir = envir) %>% unique() + dataset <- get_data(dataset, vars, na.rm = FALSE, envir = envir) + + ## creating a matrix layout + ## will not be efficient for very large and sparse datasets + ## improvement possible with dplyr or sparse matrix? + + ## make sure spread doesn't complain + cn <- colnames(dataset) + nr <- dplyr::distinct_at(dataset, .vars = base::setdiff(cn, rate), .keep_all = TRUE) %>% + nrow() + if (nr < nrow(dataset)) { + return("Rows are not unique. Data not appropriate for collaborative filtering" %>% add_class("crs")) + } + + dataset <- spread(dataset, !!prod, !!rate) %>% + as.data.frame(stringsAsFactors = FALSE) + + idv <- select_at(dataset, .vars = id) + uid <- seq_len(nrow(dataset))[idv[[1]] %in% uid[[1]]] + dataset <- select_at(dataset, .vars = base::setdiff(colnames(dataset), id)) + + ## can use : for long sets of products to predict for + if (any(grepl(":", pred))) { + pred <- select( + dataset[1, , drop = FALSE], + !!!rlang::parse_exprs(paste0(pred, collapse = ";")) + ) %>% colnames() + } + + ## stop if insufficient overlap in ratings + if (length(pred) >= (ncol(dataset) - 1)) { + return("Cannot predict for all products. Ratings must overlap on at least two products." %>% add_class("crs")) + } + + if (length(vars) < (ncol(dataset) - 1)) { + vars <- evar <- colnames(dataset)[-1] + } + + ## indices + cn <- colnames(dataset) + nind <- which(cn %in% pred) + ind <- (seq_along(cn))[-nind] + + ## average scores and rankings + avg <- dataset[uid, , drop = FALSE] %>% + .[, nind, drop = FALSE] %>% + summarise_all(mean, na.rm = TRUE) + ravg <- avg + ravg[1, ] <- min_rank(desc(as.numeric(avg))) + ravg <- mutate_all(ravg, as.integer) + + ## actual scores and rankings (if available, else will be NA) + act <- dataset[-uid, , drop = FALSE] %>% .[, nind, drop = FALSE] + ract <- act + + if (nrow(act) == 0) { + return("Invalid filter used. Users to predict for should not be in the training set." %>% + add_class("crs")) + } + + rank <- apply(act, 1, function(x) as.integer(min_rank(desc(x)))) %>% + (function(x) if (length(pred) == 1) x else t(x)) + ract[, pred] <- rank + ract <- bind_cols(idv[-uid, , drop = FALSE], ract) + act <- bind_cols(idv[-uid, , drop = FALSE], act) + + ## CF calculations per row + ms <- apply(dataset[, -nind, drop = FALSE], 1, function(x) mean(x, na.rm = TRUE)) + sds <- apply(dataset[, -nind, drop = FALSE], 1, function(x) sd(x, na.rm = TRUE)) + + ## to forego standardization + # ms <- ms * 0 + # sds <- sds/sds + + ## standardized ratings + if (length(nind) < 2) { + srate <- (dataset[uid, nind] - ms[uid]) / sds[uid] + } else { + srate <- sweep(dataset[uid, nind], 1, ms[uid], "-") %>% sweep(1, sds[uid], "/") + } + ## comfirmed to produce consistent results -- see cf-demo-missing-state.rda and cf-demo-missing.xlsx + srate[is.na(srate)] <- 0 + srate <- mutate_all(as.data.frame(srate, stringsAsFactors = FALSE), ~ ifelse(is.infinite(.), 0, .)) + cors <- sshhr(cor(t(dataset[uid, ind]), t(dataset[-uid, ind]), use = "pairwise.complete.obs")) + + ## comfirmed to produce correct results -- see cf-demo-missing-state.rda and cf-demo-missing.xlsx + cors[is.na(cors)] <- 0 + dnom <- apply(cors, 2, function(x) sum(abs(x), na.rm = TRUE)) + wts <- sweep(cors, 2, dnom, "/") + cf <- (crossprod(wts, as.matrix(srate)) * sds[-uid] + ms[-uid]) %>% + as.data.frame(stringsAsFactors = FALSE) %>% + bind_cols(idv[-uid, , drop = FALSE], .) %>% + set_colnames(c(id, pred)) + + ## Ranking based on CF + rcf <- cf + rank <- apply(select(cf, -1), 1, function(x) as.integer(min_rank(desc(x)))) %>% + (function(x) if (length(pred) == 1) x else t(x)) + rcf[, pred] <- rank + + recommendations <- + inner_join( + bind_cols( + gather(act, "product", "rating", -1, factor_key = TRUE), + select_at(gather(ract, "product", "ranking", -1, factor_key = TRUE), .vars = "ranking"), + select_at(gather(cf, "product", "cf", -1, factor_key = TRUE), .vars = "cf"), + select_at(gather(rcf, "product", "cf_rank", -1, factor_key = TRUE), .vars = "cf_rank") + ), + data.frame( + product = names(avg) %>% factor(., levels = .), + average = t(avg), + avg_rank = t(ravg) + ), + by = "product" + ) %>% + arrange_at(.vars = c(id, "product")) %>% + select_at(.vars = c(id, "product", "rating", "average", "cf", "ranking", "avg_rank", "cf_rank")) + + rm(dataset, ms, sds, srate, cors, dnom, wts, cn, ind, nind, nr, uid, idv, envir) + + as.list(environment()) %>% add_class("crs") +} + +#' Summary method for Collaborative Filter +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/crs.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{crs}} +#' @param n Number of lines of recommendations to print. Use -1 to print all lines +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{crs}} to generate the results +#' @seealso \code{\link{plot.crs}} to plot results if the actual ratings are available +#' +#' @examples +#' crs(ratings, +#' id = "Users", prod = "Movies", pred = c("M6", "M7", "M8", "M9", "M10"), +#' rate = "Ratings", data_filter = "training == 1" +#' ) %>% summary() +#' @export +summary.crs <- function(object, n = 36, dec = 2, ...) { + if (is.character(object)) { + return(cat(object)) + } + + cat("Collaborative filtering") + cat("\nData :", object$df_name) + if (!is.empty(object$data_filter)) { + cat("\nFilter :", gsub("\\n", "", object$data_filter)) + } + if (!is.empty(object$arr)) { + cat("\nArrange :", gsub("\\n", "", object$arr)) + } + if (!is.empty(object$rows)) { + cat("\nFilter :", gsub("\\n", "", object$rows)) + } + cat("\nUser id :", object$id) + cat("\nProduct id :", object$prod) + cat("\nPredict for:", paste0(object$pred, collapse = ", "), "\n") + if (nrow(object$recommendations) > n) { + cat("Rows shown :", n, "out of", format_nr(nrow(object$recommendations), dec = 0), "\n") + } + + if (nrow(object$act) > 0 && !any(is.na(object$act))) { + cat("\nSummary:\n") + + ## From FZs do file output, calculate if actual ratings are available + ## best based on highest average rating + best <- which(object$ravg == 1) + ar1 <- mean(object$ract[, best + 1] == 1) + cat("\n- Average rating picks the best product", format_nr(ar1, dec = 1, perc = TRUE), "of the time") + + ## best based on cf + best <- which(object$rcf == 1, arr.ind = TRUE) + cf1 <- mean(object$ract[best] == 1) + cat("\n- Collaborative filtering picks the best product", format_nr(cf1, dec = 1, perc = TRUE), "of the time") + + ## best based on highest average rating in top 3 + best <- which(object$ravg == 1) + ar3 <- mean(object$ract[, best + 1] < 4) + cat("\n- Pick based on average rating is in the top 3 products", format_nr(ar3, dec = 1, perc = TRUE), "of the time") + + ## best based on cf in top 3 + best <- which(object$rcf == 1, arr.ind = TRUE) + cf3 <- mean(object$ract[best] < 4) + cat("\n- Pick based on collaborative filtering is in the top 3 products", format_nr(cf3, dec = 1, perc = TRUE), "of the time") + + ## best 3 based on highest average rating contains best product + best <- which(object$ravg < 4) + inar3 <- mean(rowSums(object$ract[, best + 1, drop = FALSE] == 1) > 0) + cat("\n- Top 3 based on average ratings contains the best product", format_nr(inar3, dec = 1, perc = TRUE), "of the time") + + ## best 3 based on cf contains best product + best <- which(!object$rcf[, -1, drop = FALSE] < 4, arr.ind = TRUE) + best[, "col"] <- best[, "col"] + 1 + object$ract[best] <- NA + incf3 <- mean(rowSums(object$ract == 1, na.rm = TRUE) > 0) + cat("\n- Top 3 based on collaborative filtering contains the best product", format_nr(incf3, dec = 1, perc = TRUE), "of the time\n") + } + + cat("\nRecommendations:\n\n") + if (n == -1) { + cat("\n") + format_df(object$recommendations, dec = dec) %>% + (function(x) { + x[x == "NA"] <- "" + x + }) %>% + print(row.names = FALSE) + } else { + head(object$recommendations, n) %>% + format_df(dec = dec) %>% + (function(x) { + x[x == "NA"] <- "" + x + }) %>% + print(row.names = FALSE) + } +} + +#' Plot method for the crs function +#' +#' @details Plot that compares actual to predicted ratings. See \url{https://radiant-rstats.github.io/docs/model/crs.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{crs}} +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{crs}} to generate results +#' @seealso \code{\link{summary.crs}} to summarize results +#' +#' @export +plot.crs <- function(x, ...) { + if (is.character(x)) { + return(x) + } + if (any(is.na(x$act)) || all(is.na(x$cf))) { + return("Plotting for Collaborative Filter requires the actual ratings associated\nwith the predictions") + } + + ## use quantile to avoid plotting extreme predictions + lim <- quantile(x$recommendations[, c("rating", "cf")], probs = c(.025, .975), na.rm = TRUE) + + + p <- visualize( + x$recommendations, + xvar = "cf", yvar = "rating", + type = "scatter", facet_col = "product", check = "line", + custom = TRUE + ) + + geom_segment(aes(x = 1, y = 1, xend = 5, yend = 5), color = "blue", linewidth = .05) + + coord_cartesian(xlim = lim, ylim = lim) + + labs( + title = "Recommendations based on Collaborative Filtering", + x = "Predicted ratings", + y = "Actual ratings" + ) + + theme(legend.position = "none") + + sshhr(p) +} + +#' Deprecated: Store method for the crs function +#' +#' @details Return recommendations See \url{https://radiant-rstats.github.io/docs/model/crs.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param object Return value from \code{\link{crs}} +#' @param name Name to assign to the dataset +#' @param ... further arguments passed to or from other methods +#' +#' @export +store.crs <- function(dataset, object, name, ...) { + if (missing(name)) { + object$recommendations + } else { + stop( + paste0( + "This function is deprecated. Use the code below instead:\n\n", + name, " <- ", deparse(substitute(object)), "$recommendations\nregister(\"", + name, ")" + ), + call. = FALSE + ) + } +} \ No newline at end of file diff --git a/radiant.model/R/crtree.R b/radiant.model/R/crtree.R new file mode 100644 index 0000000000000000000000000000000000000000..fcee8521b462d630983fcaacb3223e4d4688b6d5 --- /dev/null +++ b/radiant.model/R/crtree.R @@ -0,0 +1,825 @@ +#' Classification and regression trees based on the rpart package +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/crtree.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param rvar The response variable in the model +#' @param evar Explanatory variables in the model +#' @param type Model type (i.e., "classification" or "regression") +#' @param lev The level in the response variable defined as _success_ +#' @param wts Weights to use in estimation +#' @param minsplit The minimum number of observations that must exist in a node in order for a split to be attempted. +#' @param minbucket the minimum number of observations in any terminal node. If only one of minbucket or minsplit is specified, the code either sets minsplit to minbucket*3 or minbucket to minsplit/3, as appropriate. +#' @param cp Minimum proportion of root node deviance required for split (default = 0.001) +#' @param pcp Complexity parameter to use for pruning +#' @param nodes Maximum size of tree in number of nodes to return +#' @param K Number of folds use in cross-validation +#' @param seed Random seed used for cross-validation +#' @param split Splitting criterion to use (i.e., "gini" or "information") +#' @param prior Adjust the initial probability for the selected level (e.g., set to .5 in unbalanced samples) +#' @param adjprob Setting a prior will rescale the predicted probabilities. Set adjprob to TRUE to adjust the probabilities back to their original scale after estimation +#' @param cost Cost for each treatment (e.g., mailing) +#' @param margin Margin associated with a successful treatment (e.g., a purchase) +#' @param check Optional estimation parameters (e.g., "standardize") +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param arr Expression to arrange (sort) the data on (e.g., "color, desc(price)") +#' @param rows Rows to select from the specified dataset +#' @param envir Environment to extract data from +#' +#' @return A list with all variables defined in crtree as an object of class tree +#' +#' @examples +#' crtree(titanic, "survived", c("pclass", "sex"), lev = "Yes") %>% summary() +#' result <- crtree(titanic, "survived", c("pclass", "sex")) %>% summary() +#' result <- crtree(diamonds, "price", c("carat", "clarity"), type = "regression") %>% str() +#' @seealso \code{\link{summary.crtree}} to summarize results +#' @seealso \code{\link{plot.crtree}} to plot results +#' @seealso \code{\link{predict.crtree}} for prediction +#' +#' @importFrom rpart rpart rpart.control prune.rpart +#' +#' @export +crtree <- function(dataset, rvar, evar, type = "", lev = "", wts = "None", + minsplit = 2, minbucket = round(minsplit / 3), cp = 0.001, + pcp = NA, nodes = NA, K = 10, seed = 1234, split = "gini", + prior = NA, adjprob = TRUE, cost = NA, margin = NA, check = "", + data_filter = "", arr = "", rows = NULL, envir = parent.frame()) { + if (rvar %in% evar) { + return("Response variable contained in the set of explanatory variables.\nPlease update model specification." %>% + add_class("crtree")) + } + + ## allow cp to be negative so full tree is built http://stackoverflow.com/q/24150058/1974918 + if (is.empty(cp)) { + return("Please provide a complexity parameter to split the data." %>% add_class("crtree")) + } else if (!is.empty(nodes) && nodes < 2) { + return("The (maximum) number of nodes in the tree should be larger than or equal to 2." %>% add_class("crtree")) + } + + vars <- c(rvar, evar) + + if (is.empty(wts, "None")) { + wts <- NULL + } else if (is_string(wts)) { + wtsname <- wts + vars <- c(rvar, evar, wtsname) + } + + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, envir = envir) + + if (!is.empty(wts)) { + if (exists("wtsname")) { + wts <- dataset[[wtsname]] + dataset <- select_at(dataset, .vars = base::setdiff(colnames(dataset), wtsname)) + } + if (length(wts) != nrow(dataset)) { + return( + paste0("Length of the weights variable is not equal to the number of rows in the dataset (", format_nr(length(wts), dec = 0), " vs ", format_nr(nrow(dataset), dec = 0), ")") %>% + add_class("crtree") + ) + } + } + + not_vary <- colnames(dataset)[summarise_all(dataset, does_vary) == FALSE] + if (length(not_vary) > 0) { + return(paste0("The following variable(s) show no variation. Please select other variables.\n\n** ", paste0(not_vary, collapse = ", "), " **") %>% + add_class("crtree")) + } + + rv <- dataset[[rvar]] + + if (type == "classification" && !is.factor(rv)) { + dataset[[rvar]] <- as_factor(dataset[[rvar]]) + } + + if (is.factor(dataset[[rvar]])) { + if (type == "regression") { + return("Cannot estimate a regression when the response variable is of type factor." %>% add_class("crtree")) + } + + if (lev == "") { + lev <- levels(dataset[[rvar]])[1] + } else { + if (!lev %in% levels(dataset[[rvar]])) { + return(paste0("Specified level is not a level in ", rvar) %>% add_class("crtree")) + } + + dataset[[rvar]] <- factor(dataset[[rvar]], levels = unique(c(lev, levels(dataset[[rvar]])))) + } + + type <- "classification" + method <- "class" + } else { + type <- "regression" + method <- "anova" + } + + ## logicals would get < 0.5 and >= 0.5 otherwise + ## also need to update data in predict_model + ## so the correct type is used in prediction + dataset <- mutate_if(dataset, is.logical, as.factor) + + ## standardize data ... + if ("standardize" %in% check) { + dataset <- scale_df(dataset, wts = wts) + } + + vars <- evar + ## in case : is used + if (length(vars) < (ncol(dataset) - 1)) vars <- evar <- colnames(dataset)[-1] + + form <- paste(rvar, "~ . ") + + seed %>% + gsub("[^0-9]", "", .) %>% + (function(x) if (!is.empty(x)) set.seed(seed)) + + minsplit <- ifelse(is.empty(minsplit), 2, minsplit) + minbucket <- ifelse(is.empty(minbucket), round(minsplit / 3), minbucket) + + ## make max tree + # http://stackoverflow.com/questions/24150058/rpart-doesnt-build-a-full-tree-problems-with-cp + control <- rpart::rpart.control( + cp = cp, + xval = K, + minsplit = minsplit, + minbucket = minbucket, + ) + + parms <- list(split = split) + if (type == "classification") { + ind <- if (which(lev %in% levels(dataset[[rvar]])) == 1) c(1, 2) else c(2, 1) + if (!is.empty(prior) && !is_not(cost) && !is_not(cost)) { + return("Choose either a prior or cost and margin values but not both.\nPlease adjust your settings and try again" %>% add_class("crtree")) + } + + if (!is_not(cost) && !is_not(margin)) { + loss2 <- as_numeric(cost) + loss1 <- as_numeric(margin) - loss2 + + if (loss1 <= 0) { + return("Cost must be smaller than the specied margin.\nPlease adjust the settings and try again" %>% add_class("crtree")) + } else if (loss2 <= 0) { + return("Cost must be larger than zero.\nPlease adjust the settings and try again" %>% add_class("crtree")) + } else { + parms[["loss"]] <- c(loss1, loss2) %>% + .[ind] %>% + { + matrix(c(0, .[1], .[2], 0), byrow = TRUE, nrow = 2) + } + } + } else if (!is.empty(prior)) { + if (!is.numeric(prior)) { + return("Prior did not resolve to a numeric factor" %>% add_class("crtree")) + } else if (prior > 1 || prior < 0) { + return("Prior is not a valid probability" %>% add_class("crtree")) + } else { + ## prior is applied to the selected level + parms[["prior"]] <- c(prior, 1 - prior) %>% + .[ind] + } + } + } + + ## using an input list with do.call ensure that a full "call" is available for cross-validation + crtree_input <- list( + formula = as.formula(form), + data = dataset, + method = method, + parms = parms, + weights = wts, + control = control + ) + + model <- do.call(rpart::rpart, crtree_input) + + if (!is_not(nodes)) { + unpruned <- model + if (nrow(model$frame) > 1) { + cptab <- as.data.frame(model$cptable, stringsAsFactors = FALSE) + cptab$nodes <- cptab$nsplit + 1 + ind <- max(which(cptab$nodes <= nodes)) + model <- sshhr(rpart::prune.rpart(model, cp = cptab$CP[ind])) + } + } else if (!is_not(pcp)) { + unpruned <- model + if (nrow(model$frame) > 1) { + model <- sshhr(rpart::prune.rpart(model, cp = pcp)) + } + } + + ## rpart::rpart does not return residuals by default + model$residuals <- residuals(model, type = "pearson") + + if (is_not(cost) && is_not(margin) && + !is.empty(prior) && !is.empty(adjprob)) { + + ## when prior = 0.5 can use pp <- p / (p + (1 - p) * (1 - bp) / bp) + ## more generally, use Theorem 2 from "The Foundations of Cost-Sensitive Learning" by Charles Elkan + ## in the equation below prior equivalent of b + p <- model$frame$yval2[, 4] + bp <- mean(dataset[[rvar]] == lev) + model$frame$yval2[, 4] <- bp * (p - p * prior) / (prior - p * prior + bp * p - prior * bp) + model$frame$yval2[, 5] <- 1 - model$frame$yval2[, 4] + } + + ## tree model object does not include the data by default + model$model <- dataset + + ## passing on variable classes for plotting + model$var_types <- sapply(dataset, class) + + rm(dataset, envir) ## dataset not needed elsewhere + + as.list(environment()) %>% add_class(c("crtree", "model")) +} + +#' Summary method for the crtree function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/crtree.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{crtree}} +#' @param prn Print tree in text form +#' @param splits Print the tree splitting metrics used +#' @param cptab Print the cp table +#' @param modsum Print the model summary +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- crtree(titanic, "survived", c("pclass", "sex"), lev = "Yes") +#' summary(result) +#' result <- crtree(diamonds, "price", c("carat", "color"), type = "regression") +#' summary(result) +#' @seealso \code{\link{crtree}} to generate results +#' @seealso \code{\link{plot.crtree}} to plot results +#' @seealso \code{\link{predict.crtree}} for prediction +#' +#' @export +summary.crtree <- function(object, prn = TRUE, splits = FALSE, cptab = FALSE, modsum = FALSE, ...) { + if (is.character(object)) { + return(object) + } + + if (object$type == "classification") { + cat("Classification tree") + } else { + cat("Regression tree") + } + cat("\nData :", object$df_name) + if (!is.empty(object$data_filter)) { + cat("\nFilter :", gsub("\\n", "", object$data_filter)) + } + if (!is.empty(object$arr)) { + cat("\nArrange :", gsub("\\n", "", object$arr)) + } + if (!is.empty(object$rows)) { + cat("\nSlice :", gsub("\\n", "", object$rows)) + } + cat("\nResponse variable :", object$rvar) + if (object$type == "classification") { + cat("\nLevel :", object$lev, "in", object$rvar) + } + cat("\nExplanatory variables:", paste0(object$evar, collapse = ", "), "\n") + if (length(object$wtsname) > 0) { + cat("Weights used :", object$wtsname, "\n") + } + cat("Complexity parameter :", object$cp, "\n") + cat("Minimum observations :", object$minsplit, "\n") + if (!is_not(object$nodes)) { + max_nodes <- sum(object$unpruned$frame$var == "") + cat("Maximum nr. nodes :", object$nodes, "out of", max_nodes, "\n") + } + if (!is.empty(object$cost) && !is.empty(object$margin) && object$type == "classification") { + cat("Cost:Margin :", object$cost, ":", object$margin, "\n") + if (!is.empty(object$prior)) object$prior <- "Prior ignored when cost and margin set" + } + if (!is.empty(object$prior) && object$type == "classification") { + cat("Priors :", object$prior, "\n") + cat("Adjusted prob. :", object$adjprob, "\n") + } + if (!is.empty(object$wts, "None") && inherits(object$wts, "integer")) { + cat("Nr obs :", format_nr(sum(object$wts), dec = 0), "\n\n") + } else { + cat("Nr obs :", format_nr(length(object$rv), dec = 0), "\n\n") + } + + ## extra output + if (splits) { + print(object$model$split) + } + + if (cptab) { + print(object$model$cptable) + } + + if (modsum) { + object$model$call <- NULL + print(summary(object$model)) + } else if (prn) { + cat(paste0(capture.output(print(object$model))[c(-1, -2)], collapse = "\n")) + } +} + +#' Plot method for the crtree function +#' +#' @details Plot a decision tree using mermaid, permutation plots , prediction plots, or partial dependence plots. For regression trees, a residual dashboard can be plotted. See \url{https://radiant-rstats.github.io/docs/model/crtree.html} for an example in Radiant. +#' +#' @param x Return value from \code{\link{crtree}} +#' @param plots Plots to produce for the specified rpart tree. "tree" shows a tree diagram. "prune" shows a line graph to evaluate appropriate tree pruning. "imp" shows a variable importance plot +#' @param orient Plot orientation for tree: LR for vertical and TD for horizontal +#' @param width Plot width in pixels for tree (default is "900px") +#' @param labs Use factor labels in plot (TRUE) or revert to default letters used by tree (FALSE) +#' @param nrobs Number of data points to show in dashboard scatter plots (-1 for all) +#' @param dec Decimal places to round results to +#' @param incl Which variables to include in a coefficient plot or PDP plot +#' @param incl_int Which interactions to investigate in PDP plots +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- crtree(titanic, "survived", c("pclass", "sex"), lev = "Yes") +#' plot(result) +#' result <- crtree(diamonds, "price", c("carat", "clarity", "cut")) +#' plot(result, plots = "prune") +#' result <- crtree(dvd, "buy", c("coupon", "purch", "last"), cp = .01) +#' plot(result, plots = "imp") +#' +#' @importFrom DiagrammeR DiagrammeR mermaid +#' @importFrom rlang .data +#' +#' @seealso \code{\link{crtree}} to generate results +#' @seealso \code{\link{summary.crtree}} to summarize results +#' @seealso \code{\link{predict.crtree}} for prediction +#' +#' @export +plot.crtree <- function(x, plots = "tree", orient = "LR", + width = "900px", labs = TRUE, + nrobs = Inf, dec = 2, + incl = NULL, incl_int = NULL, + shiny = FALSE, custom = FALSE, ...) { + if (is.empty(plots) || "tree" %in% plots) { + if ("character" %in% class(x)) { + return(paste0("graph LR\n A[\"", x, "\"]") %>% DiagrammeR::DiagrammeR(.)) + } + + ## avoid error when dec is NA or NULL + if (is_not(dec)) dec <- 2 + + df <- x$frame + if (is.null(df)) { + df <- x$model$frame ## make it easier to call from code + type <- x$model$method + nlabs <- labels(x$model, minlength = 0, collapse = FALSE) + } else { + nlabs <- labels(x, minlength = 0, collapse = FALSE) + type <- x$method + } + + if (nrow(df) == 1) { + return(paste0("graph LR\n A[Graph unavailable for single node tree]") %>% DiagrammeR::DiagrammeR(.)) + } + + if (type == "class") { + df$yval <- format_nr(df$yval2[, 4], dec = dec, perc = TRUE) + pre <- "p: " + } else { + df$yval <- round(df$yval, dec) + pre <- "b: " + } + df$yval2 <- NULL + + df$id <- as.integer(rownames(df)) + df$to1 <- NA + df$to2 <- NA + non_leafs <- which(df$var != "") + df$to1[non_leafs] <- df$id[non_leafs + 1] + df$to2[non_leafs] <- df$to1[non_leafs] + 1 + df <- gather(df, "level", "to", !!c("to1", "to2")) + + df$split1 <- nlabs[, 1] + df$split2 <- nlabs[, 2] + + isInt <- x$model$var_types %>% + (function(x) names(x)[x == "integer"]) + if (length(isInt) > 0) { + # inspired by https://stackoverflow.com/a/35556288/1974918 + int_labs <- function(x) { + paste( + gsub("(>=|<)\\s*(-{0,1}[0-9]+.*)", "\\1", x), + gsub("(>=|<)\\s*(-{0,1}[0-9]+.*)", "\\2", x) %>% + as.numeric() %>% + ceiling(.) + ) + } + int_ind <- df$var %in% isInt + df[int_ind, "split1"] %<>% int_labs() + df[int_ind, "split2"] %<>% int_labs() + } + + df$split1_full <- df$split1 + df$split2_full <- df$split2 + + bnr <- 20 + df$split1 <- df$split1 %>% ifelse(nchar(.) > bnr, paste0(strtrim(., bnr), " ..."), .) + df$split2 <- df$split2 %>% ifelse(nchar(.) > bnr, paste0(strtrim(., bnr), " ..."), .) + + df$to <- as.integer(df$to) + df$edge <- ifelse(df$level == "to1", df$split1, df$split2) %>% + (function(x) paste0(" --- |", x, "|")) + ## seems like only unicode letters are supported in mermaid at this time + # df$edge <- ifelse (df$level == "to1", df$split1, df$split2) %>% {paste0("--- |", sub("^>", "\u2265",.), "|")} + # df$edge <- iconv(df$edge, "UTF-8", "ASCII",sub="") + non_leafs <- which(df$var != "") + df$from <- NA + df$from[non_leafs] <- paste0("id", df$id[non_leafs], "[", df$var[non_leafs], "]") + + df$to_lab <- NA + to_lab <- sapply(df$to[non_leafs], function(x) which(x == df$id))[1, ] + df$to_lab[non_leafs] <- paste0("id", df$to[non_leafs], "[", ifelse(df$var[to_lab] == "", "", paste0(df$var[to_lab], "
    ")), "n: ", format_nr(df$n[to_lab], dec = 0), "
    ", pre, df$yval[to_lab], "]") + df <- na.omit(df) + + leafs <- paste0("id", base::setdiff(df$to, df$id)) + + ## still need the below setup to keep the "chance" class + ## when a decision analysis plot is in the report + # style <- paste0( + # "classDef default fill:none, bg:none, stroke-width:0px; + # classDef leaf fill:#9ACD32,stroke:#333,stroke-width:1px; + # class ", paste(leafs, collapse = ","), " leaf;" + # ) + + ## still need this to keep the "chance" class + ## when a decision analysis plot is in the report + style <- paste0( + "classDef default fill:none, bg:none, stroke-width:0px; + classDef leaf fill:#9ACD32,stroke:#333,stroke-width:1px; + classDef chance fill:#FF8C00,stroke:#333,stroke-width:1px; + classDef chance_with_cost fill:#FF8C00,stroke:#333,stroke-width:3px,stroke-dasharray:4,5; + classDef decision fill:#9ACD32,stroke:#333,stroke-width:1px; + classDef decision_with_cost fill:#9ACD32,stroke:#333,stroke-width:3px,stroke-dasharray:4,5; + class ", paste(leafs, collapse = ","), " leaf;" + ) + + ## check orientation for branch labels + brn <- if (orient %in% c("LR", "RL")) { + c("top", "bottom") + } else { + c("left", "right") + } + brn <- paste0("", brn, ": ") + + ## don't print full labels that don't add information + df[df$split1_full == df$split1 & df$split2_full == df$split2, c("split1_full", "split2_full")] <- "" + df$split1_full <- ifelse(df$split1_full == "", "", paste0("
    ", brn[1], gsub(",", ", ", df$split1_full))) + df$split2_full <- ifelse(df$split2_full == "", "", paste0("
    ", brn[2], gsub(",", ", ", df$split2_full))) + + ttip_ind <- 1:(nrow(df) / 2) + ttip <- df[ttip_ind, , drop = FALSE] %>% + { + paste0("click id", .$id, " callback \"n: ", format_nr(.$n, dec = 0), "
    ", pre, .$yval, .$split1_full, .$split2_full, "\"", collapse = "\n") + } + + ## try to link a tooltip directly to an edge using mermaid + ## see https://github.com/rich-iannone/DiagrammeR/issues/267 + # ttip_lev <- filter(df[-ttip_ind,], split1_full != "") + # if (nrow(ttip_lev) == 0) { + # ttip_lev <- "" + # } else { + # ttip_lev <- paste0("click id", ttip_lev$id, " callback \"", ttip_lev$split1_full, "\"", collapse = "\n") + # } + + paste(paste0("graph ", orient), paste(paste0(df$from, df$edge, df$to_lab), collapse = "\n"), style, ttip, sep = "\n") %>% + DiagrammeR::mermaid(., width = width, height = "100%") + } else { + if ("character" %in% class(x)) { + return(x) + } + plot_list <- list() + nrCol <- 1 + if ("prune" %in% plots) { + if (is.null(x$unpruned)) { + df <- data.frame(x$model$cptable, stringsAsFactors = FALSE) + } else { + df <- data.frame(x$unpruned$cptable, stringsAsFactors = FALSE) + } + + if (nrow(df) < 2) { + return("Evaluation of tree pruning not available for single node tree") + } + + df$CP <- sqrt(df$CP * c(Inf, head(df$CP, -1))) %>% round(5) + df$nsplit <- as.integer(df$nsplit + 1) + ind1 <- min(which(df$xerror == min(df$xerror))) + size1 <- c(df$nsplit[ind1], df$CP[ind1]) + ind2 <- min(which(df$xerror < (df$xerror[ind1] + df$xstd[ind1]))) + size2 <- c(df$nsplit[ind2], df$CP[ind2]) + + p <- ggplot(data = df, aes(x = .data$nsplit, y = .data$xerror)) + + geom_line() + + geom_vline(xintercept = size1[1], linetype = "dashed") + + geom_hline(yintercept = min(df$xerror), linetype = "dashed") + + labs( + title = "Evaluate tree pruning based on cross-validation", + x = "Number of nodes", + y = "Relative error" + ) + if (nrow(df) < 10) p <- p + scale_x_continuous(breaks = df$nsplit) + + ## http://stats.stackexchange.com/questions/13471/how-to-choose-the-number-of-splits-in-rpart + if (size1[1] == Inf) size1[2] <- NA + footnote <- paste0("\nMinimum error achieved at prune complexity ", format(size1[2], scientific = FALSE), " (", size1[1], " nodes)") + ind2 <- min(which(df$xerror < (df$xerror[ind1] + df$xstd[ind1]))) + p <- p + + geom_vline(xintercept = size2[1], linetype = "dotdash", color = "blue") + + geom_hline(yintercept = df$xerror[ind1] + df$xstd[ind1], linetype = "dotdash", color = "blue") + + if (size2[1] < size1[1]) { + footnote <- paste0(footnote, ".\nError at pruning complexity ", format(size2[2], scientific = FALSE), " (", size2[1], " nodes) is within one std. of minimum") + } + + plot_list[["prune"]] <- p + labs(caption = footnote) + } + + if ("imp" %in% plots) { + imp <- x$model$variable.importance + if (is.null(imp)) { + return("Variable importance information not available for singlenode tree") + } + + df <- data.frame( + vars = names(imp), + imp = imp / sum(imp), + stringsAsFactors = FALSE + ) %>% + arrange_at(.vars = "imp") + df$vars <- factor(df$vars, levels = df$vars) + + plot_list[["imp"]] <- + visualize(df, yvar = "imp", xvar = "vars", type = "bar", custom = TRUE) + + labs( + title = "Variable importance", + x = "", + y = "Importance" + ) + + coord_flip() + + theme(axis.text.y = element_text(hjust = 0)) + } + + if ("vip" %in% plots) { + # imp <- x$model$variable.importance + # if (is.null(imp)) { + # return("Variable importance information not available for singlenode tree") + # } else { + vi_scores <- varimp(x) + plot_list[["vip"]] <- + visualize(vi_scores, yvar = "Importance", xvar = "Variable", type = "bar", custom = TRUE) + + labs( + title = "Permutation Importance", + x = NULL, + y = ifelse(x$type == "regression", "Importance (R-square decrease)", "Importance (AUC decrease)") + ) + + coord_flip() + + theme(axis.text.y = element_text(hjust = 0)) + } + + if ("pred_plot" %in% plots) { + nrCol <- 2 + if (length(incl) > 0 | length(incl_int) > 0) { + plot_list <- pred_plot(x, plot_list, incl, incl_int, ...) + } else { + return("Select one or more variables to generate Prediction plots") + } + } + + if ("pdp" %in% plots) { + nrCol <- 2 + if (length(incl) > 0 || length(incl_int) > 0) { + plot_list <- pdp_plot(x, plot_list, incl, incl_int, ...) + } else { + return("Select one or more variables to generate Partial Dependence Plots") + } + } + + if (x$type == "regression" && "dashboard" %in% plots) { + plot_list <- plot.regress(x, plots = "dashboard", lines = "line", nrobs = nrobs, custom = TRUE) + nrCol <- 2 + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = nrCol) %>% + (function(x) if (isTRUE(shiny)) x else print(x)) + } + } + } +} + +#' Predict method for the crtree function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/crtree.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{crtree}} +#' @param pred_data Provide the dataframe to generate predictions (e.g., titanic). The dataset must contain all columns used in the estimation +#' @param pred_cmd Generate predictions using a command. For example, `pclass = levels(pclass)` would produce predictions for the different levels of factor `pclass`. To add another variable, create a vector of prediction strings, (e.g., c('pclass = levels(pclass)', 'age = seq(0,100,20)') +#' @param conf_lev Confidence level used to estimate confidence intervals (.95 is the default) +#' @param se Logical that indicates if prediction standard errors should be calculated (default = FALSE) +#' @param dec Number of decimals to show +#' @param envir Environment to extract data from +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- crtree(titanic, "survived", c("pclass", "sex"), lev = "Yes") +#' predict(result, pred_cmd = "pclass = levels(pclass)") +#' result <- crtree(titanic, "survived", "pclass", lev = "Yes") +#' predict(result, pred_data = titanic) %>% head() +#' @seealso \code{\link{crtree}} to generate the result +#' @seealso \code{\link{summary.crtree}} to summarize results +#' +#' @export +predict.crtree <- function(object, pred_data = NULL, pred_cmd = "", + conf_lev = 0.95, se = FALSE, dec = 3, + envir = parent.frame(), ...) { + if (is.character(object)) { + return(object) + } + if (is.data.frame(pred_data)) { + df_name <- deparse(substitute(pred_data)) + } else { + df_name <- pred_data + } + + pfun <- function(model, pred, se, conf_lev) { + pred_val <- try(sshhr(predict(model, pred)), silent = TRUE) + + if (!inherits(pred_val, "try-error")) { + pred_val %<>% + as.data.frame(stringsAsFactors = FALSE) %>% + select(1) %>% + set_colnames("Prediction") + } + + pred_val + } + + predict_model(object, pfun, "crtree.predict", pred_data, pred_cmd, conf_lev, se, dec, envir = envir) %>% + set_attr("radiant_pred_data", df_name) +} + +#' Print method for predict.crtree +#' +#' @param x Return value from prediction method +#' @param ... further arguments passed to or from other methods +#' @param n Number of lines of prediction results to print. Use -1 to print all lines +#' +#' @export +print.crtree.predict <- function(x, ..., n = 10) { + print_predict_model(x, ..., n = n, header = "Classification and regression trees") +} + +#' Cross-validation for Classification and Regression Trees +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/crtree.html} for an example in Radiant +#' +#' @param object Object of type "rpart" or "crtree" to use as a starting point for cross validation +#' @param K Number of cross validation passes to use +#' @param repeats Number of times to repeat the K cross-validation steps +#' @param cp Complexity parameter used when building the (e.g., 0.0001) +#' @param pcp Complexity parameter to use for pruning +#' @param seed Random seed to use as the starting point +#' @param trace Print progress +#' @param fun Function to use for model evaluation (e.g., auc for classification or RMSE for regression) +#' @param ... Additional arguments to be passed to 'fun' +#' +#' @return A data.frame sorted by the mean, sd, min, and max of the performance metric +#' +#' @seealso \code{\link{crtree}} to generate an initial model that can be passed to cv.crtree +#' @seealso \code{\link{Rsq}} to calculate an R-squared measure for a regression +#' @seealso \code{\link{RMSE}} to calculate the Root Mean Squared Error for a regression +#' @seealso \code{\link{MAE}} to calculate the Mean Absolute Error for a regression +#' @seealso \code{\link{auc}} to calculate the area under the ROC curve for classification +#' @seealso \code{\link{profit}} to calculate profits for classification at a cost/margin threshold +#' +#' @importFrom rpart prune.rpart +#' @importFrom shiny getDefaultReactiveDomain withProgress incProgress +#' +#' @examples +#' \dontrun{ +#' result <- crtree(dvd, "buy", c("coupon", "purch", "last")) +#' cv.crtree(result, cp = 0.0001, pcp = seq(0, 0.01, length.out = 11)) +#' cv.crtree(result, cp = 0.0001, pcp = c(0, 0.001, 0.002), fun = profit, cost = 1, margin = 5) +#' result <- crtree(diamonds, "price", c("carat", "color", "clarity"), type = "regression", cp = 0.001) +#' cv.crtree(result, cp = 0.001, pcp = seq(0, 0.01, length.out = 11), fun = MAE) +#' } +#' +#' @export +cv.crtree <- function(object, K = 5, repeats = 1, cp, pcp = seq(0, 0.01, length.out = 11), seed = 1234, trace = TRUE, fun, ...) { + if (inherits(object, "crtree")) object <- object$model + if (inherits(object, "rpart")) { + dv <- as.character(object$call$formula[[2]]) + m <- eval(object$call[["data"]]) + if (is.numeric(m[[dv]])) { + type <- "regression" + } else { + type <- "classification" + if (is.factor(m[[dv]])) { + lev <- levels(m[[dv]])[1] + } else if (is.logical(m[[dv]])) { + lev <- TRUE + } else { + stop("The level to use for classification is not clear. Use a factor of logical as the response variable") + } + } + } else { + stop("The model object does not seems to be a decision tree") + } + + set.seed(seed) + if (missing(cp)) cp <- object$call$control$cp + tune_grid <- expand.grid(cp = cp, pcp = pcp) + out <- data.frame(mean = NA, std = NA, min = NA, max = NA, cp = tune_grid[["cp"]], pcp = tune_grid[["pcp"]]) + + if (missing(fun)) { + if (type == "classification") { + fun <- radiant.model::auc + cn <- "AUC (mean)" + } else { + fun <- radiant.model::RMSE + cn <- "RMSE (mean)" + } + } else { + cn <- glue("{deparse(substitute(fun))} (mean)") + } + + if (length(shiny::getDefaultReactiveDomain()) > 0) { + trace <- FALSE + incProgress <- shiny::incProgress + withProgress <- shiny::withProgress + } else { + incProgress <- function(...) {} + withProgress <- function(...) list(...)[["expr"]] + } + + nitt <- nrow(tune_grid) + withProgress(message = "Running cross-validation (crtree)", value = 0, { + for (i in seq_len(nitt)) { + perf <- double(K * repeats) + object$call[["cp"]] <- tune_grid[i, "cp"] + if (trace) cat("Working on cp", format(tune_grid[i, "cp"], scientific = FALSE), "pcp", format(tune_grid[i, "pcp"], scientific = FALSE), "\n") + for (j in seq_len(repeats)) { + rand <- sample(K, nrow(m), replace = TRUE) + for (k in seq_len(K)) { + object$call[["data"]] <- quote(m[rand != k, , drop = FALSE]) + pred <- try(rpart::prune(eval(object$call), tune_grid[i, "pcp"]), silent = TRUE) + if (inherits(pred, "try-error")) next + if (length(object$call$parms$prior) > 0) { + pred <- prob_adj(pred, object$call$parms$prior[1], mean(m[rand != k, dv, drop = FALSE] == lev)) + } + pred <- try(predict(pred, m[rand == k, , drop = FALSE]), silent = TRUE) + if (inherits(pred, "try-error")) next + + if (type == "classification") { + if (missing(...)) { + perf[k + (j - 1) * K] <- fun(pred[, lev], unlist(m[rand == k, dv]), lev) + } else { + perf[k + (j - 1) * K] <- fun(pred[, lev], unlist(m[rand == k, dv]), lev, ...) + } + } else { + if (missing(...)) { + perf[k + (j - 1) * K] <- fun(pred, unlist(m[rand == k, dv])) + } else { + perf[k + (j - 1) * K] <- fun(pred, unlist(m[rand == k, dv]), ...) + } + } + } + } + out[i, 1:4] <- c(mean(perf, na.rm = TRUE), sd(perf, na.rm = TRUE), min(perf, na.rm = TRUE), max(perf, na.rm = TRUE)) + incProgress(1 / nitt, detail = paste("\nCompleted run", i, "out of", nitt)) + } + }) + + if (type == "classification") { + out <- arrange(out, desc(mean)) + } else { + out <- arrange(out, mean) + } + + ## show evaluation metric in column name + colnames(out)[1] <- cn + + object$call[["cp"]] <- out[1, "cp"] + object$call[["data"]] <- m + object <- rpart::prune(eval(object$call), out[1, "pcp"]) + cat("\nGiven the provided tuning grid, the pruning complexity parameter\nshould be set to", out[1, "pcp"], "or the number of nodes set to", max(object$cptable[, "nsplit"]) + 1, "\n") + out +} + +prob_adj <- function(mod, prior, bp) { + p <- mod$frame$yval2[, 4] + mod$frame$yval2[, 4] <- bp * (p - p * prior) / (prior - p * prior + bp * p - prior * bp) + mod$frame$yval2[, 5] <- 1 - mod$frame$yval2[, 4] + mod +} \ No newline at end of file diff --git a/radiant.model/R/deprecated.R b/radiant.model/R/deprecated.R new file mode 100644 index 0000000000000000000000000000000000000000..fc1421ee7422c0986b373cb63635d03152b450bf --- /dev/null +++ b/radiant.model/R/deprecated.R @@ -0,0 +1,24 @@ +#' Deprecated function(s) in the radiant.model package +#' +#' These functions are provided for compatibility with previous versions of +#' radiant. They will eventually be removed. +#' @rdname radiant.model-deprecated +#' @name radiant.model-deprecated +#' @param ... Parameters to be passed to the updated functions +#' @export ann +#' @aliases ann +#' @section Details: +#' \tabular{rl}{ +#' \code{ann} is now a synonym for \code{\link{nn}}\cr +#' \code{scaledf} is now a synonym for \code{\link{scale_df}}\cr +#' } +#' +ann <- function(...) { + .Deprecated("nn", package = "radiant.model") + nn(...) +} +scaledf <- function(...) { + .Deprecated("scale_df", package = "radiant.model") + scale_df(...) +} +NULL diff --git a/radiant.model/R/dtree.R b/radiant.model/R/dtree.R new file mode 100644 index 0000000000000000000000000000000000000000..4825861d756ee3939a6ba2efb2e36b152578de46 --- /dev/null +++ b/radiant.model/R/dtree.R @@ -0,0 +1,848 @@ +#' Parse yaml input for dtree to provide (more) useful error messages +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/dtree.html} for an example in Radiant +#' +#' @param yl A yaml string +#' +#' @return An updated yaml string or a vector messages to return to the users +#' +#' @seealso \code{\link{dtree}} to calculate tree +#' @seealso \code{\link{summary.dtree}} to summarize results +#' @seealso \code{\link{plot.dtree}} to plot results +#' +#' @importFrom stringi stri_trans_general +#' +#' @export +dtree_parser <- function(yl) { + if (is_string(yl)) yl <- unlist(strsplit(yl, "\n")) + + ## remove characters that may cause problems in shinyAce or DiagrammeR/mermaid.js + yl <- stringi::stri_trans_general(yl, "latin-ascii") %>% + gsub("\t", " ", .) + + ## container to collect errors + err <- c() + + ## checking if : is present in each line + col_ln <- grepl("(?=:)|(?=^\\s*$)|(?=^\\s*#)", yl, perl = TRUE) + if (any(!col_ln)) { + err <- c(err, paste0("Each line in the tree input must have a ':'. Add a ':' in line(s): ", paste0(which(!col_ln), collapse = ", "))) + } + + ## add a space to input after the : YAML needs this + yl %<>% gsub(":([^ $])", ": \\1", .) %>% gsub(":\\s{2,}", ": ", .) + + ## replace .4 by 0.4 + yl %<>% gsub("(^\\s*p\\s*:)\\s*(\\.[0-9]+$)", "\\1 0\\2", ., perl = TRUE) + + ## make sure the labels are in lower case + yl <- yl %>% + gsub("(^\\s*)name(\\s*:)", "\\1name\\2", ., ignore.case = TRUE, perl = TRUE) %>% + gsub("(^\\s*)variables(\\s*:)", "\\1variables\\2", ., ignore.case = TRUE, perl = TRUE) %>% + gsub("(^\\s*)type(\\s*:)", "\\1type\\2", ., ignore.case = TRUE, perl = TRUE) %>% + gsub("(^\\s*)p(\\s*:)", "\\1p\\2", ., ignore.case = TRUE, perl = TRUE) %>% + gsub("(^\\s*)payoff(\\s*:)", "\\1payoff\\2", ., ignore.case = TRUE, perl = TRUE) %>% + gsub("(^\\s*)cost(\\s*:)", "\\1cost\\2", ., ignore.case = TRUE, perl = TRUE) + + ## check type line is followed by a name + type_id <- yl %>% + grepl("^\\s*type\\s*:\\s*(.*)$", ., perl = TRUE) %>% + which() + type_cid <- yl %>% + grepl("^\\s*type\\s*:\\s*((chance)|(decision)|())\\s*$", ., perl = TRUE) %>% + which() + + if (!identical(type_id, type_cid)) { + err <- c(err, paste0("Node type should be 'type: chance', or 'type: decision' in line(s): ", paste0(base::setdiff(type_id, type_cid), collapse = ", "))) + } + + ## can't have # signs anywhere if line is not a comment + nc_id <- yl %>% + grepl("^\\s*#", ., perl = TRUE) %>% + (function(x) x == FALSE) %>% + which() + + if (length(nc_id) > 0) { + yl[nc_id] %<>% gsub("#", "//", ., perl = TRUE) %>% + gsub("(^\\s*)[\\!`@%&\\*-\\+]*\\s*", "\\1", ., perl = TRUE) + } + + ## Find node names + nn_id <- gsub("(^\\s*p\\s*:\\s*$)", "\\1 0", yl) %>% + gsub("(^\\s*type\\s*:\\s*$)", "\\1 0", .) %>% + gsub("(^\\s*cost\\s*:\\s*$)", "\\1 0", .) %>% + gsub("(^\\s*payoff\\s*:\\s*$)", "\\1 0", .) %>% + grepl("^\\s*[^#]+:\\s*$", ., perl = TRUE) %>% + which() + + ## replace ( ) { } [ ] + if (length(nn_id) > 0) { + yl[nn_id] %<>% gsub("[\\(\\)\\{\\}\\[\\]<>\\@;~]", "/", ., perl = TRUE) + } + + ## non-commented next line after type + ncnl_id <- c() + for (i in type_cid) { + ncnl_id <- c(ncnl_id, nc_id[nc_id > i][1]) + } + + type_nn <- ncnl_id %in% nn_id + + if (!all(type_nn)) { + err <- c(err, paste0("The node types defined on line(s) ", paste0(type_cid[!type_nn], collapse = ", "), " must be followed by a node name.\nA valid node name could be 'mud slide:'")) + } + + ## check indent of next line is the same for type defs + indent_type <- yl[type_cid] %>% + gsub("^(\\s*).*", "\\1", .) %>% + nchar() + + ## non-commented next node-name after type + ncnn_id <- c() + for (i in type_cid) { + ncnn_id <- c(ncnn_id, nn_id[nn_id > i][1]) + } + + indent_next <- yl[ncnn_id] %>% + gsub("^(\\s*).*", "\\1", .) %>% + nchar() + + indent_issue <- is.na(indent_next) | indent_type == indent_next + + if (any(!indent_issue)) { + err <- c(err, paste0("Indent issue in line(s): ", paste0(type_cid[!indent_issue] + 1, collapse = ", "), "\nUse the tab key to ensure a node name is indented the same amount\nas the node type on the preceding line. Check the level of indentation\non each line shown, as well as the indentation on the preceding lines")) + } + + ## check indent for node names + indent_name <- yl[nn_id] %>% + gsub("^(\\s*).*", "\\1", .) %>% + nchar() + + ## check indent of next line for node names + indent_next <- yl[nn_id + 1] %>% + gsub("^(\\s*).*", "\\1", .) %>% + nchar() + indent_issue <- indent_name >= indent_next + + ## can happen when last line in input is a node without a payoff or prob + indent_issue[is.na(indent_issue)] <- TRUE + + if (any(indent_issue)) { + err <- c(err, paste0("Indent issue in line(s): ", paste0(nn_id[indent_issue] + 1, collapse = ", "), "\nAlways use the tab key to indent the line(s) after specifying a node name.")) + } + + ## determine return value + if (length(err) > 0) { + paste0("\n**\n", paste0(err, collapse = "\n"), "\n**\n") %>% add_class(c("dtree", "dtree-error")) + } else { + paste0(yl, collapse = "\n") %>% add_class("dtree") + } +} + +#' Create a decision tree +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/dtree.html} for an example in Radiant +#' +#' @param yl A yaml string or a list (e.g., from yaml::yaml.load_file()) +#' @param opt Find the maximum ("max") or minimum ("min") value for each decision node +#' @param base List of variable definitions from a base tree used when calling a sub-tree +#' @param envir Environment to extract data from +#' +#' @return A list with the initial tree, the calculated tree, and a data.frame with results (i.e., payoffs, probabilities, etc.) +#' +#' @importFrom yaml yaml.load +#' @importFrom stringr str_match +#' @importFrom data.tree as.Node Clone isLeaf isNotLeaf Get +#' @importFrom dplyr near +#' +#' @seealso \code{\link{summary.dtree}} to summarize results +#' @seealso \code{\link{plot.dtree}} to plot results +#' @seealso \code{\link{sensitivity.dtree}} to plot results +#' +#' @examples +#' yaml::as.yaml(movie_contract) %>% cat() +#' dtree(movie_contract, opt = "max") %>% summary(output = TRUE) +#' dtree(movie_contract)$payoff +#' dtree(movie_contract)$prob +#' dtree(movie_contract)$solution_df +#' +#' @export +dtree <- function(yl, opt = "max", base = character(0), envir = parent.frame()) { + ## calculations will be effected is scientific notation is used + options(scipen = max(getOption("scipen"), 100)) + + ## Adapted from https://github.com/gluc/useR15/blob/master/01_showcase/02_decision_tree.R + ## load yaml string-id if list not provide + if (is_string(yl)) { + ## get input file from r_data + if (!grepl("\\n", yl)) { + yl <- get_data(yl, envir = envir, na.rm = FALSE) + if (inherits(yl, "list")) { + yl <- yaml::as.yaml(yl, indent = 4) + } + } + yl <- dtree_parser(yl) + + ## return errors if needed + if (inherits(yl, "dtree-error")) { + return(yl) + } + + # int2float <- function(x) { + # if (is.numeric(x) && x > .Machine$integer.max) { + # x <- as.numeric(x) + # } + # return(x) + # } + + ## if the name of input-list in r_data is provided + yl <- try(yaml::yaml.load(yl), silent = TRUE) + # causes issues with some yaml files + # yl <- try(yaml::yaml.load(yl, handlers = list(int = int2float)), silent = TRUE) + + ## used when a string is provided + if (inherits(yl, "try-error")) { + err_line <- stringr::str_match(attr(yl, "condition")$message, "^Scanner error:.*line\\s([0-9]*),")[2] + if (is.na(err_line)) { + err <- paste0("**\nError reading the tree input:\n", attr(yl, "condition")$message, "\n\nPlease try again. Examples are shown in the help file (?)\n**") + } else { + err <- paste0("**\nIndentation issue found in line ", err_line, ".\nThis means that the indentation level is not correct when compared\nto prior or subsequent lines in the tree input. Use tabs to separate\nthe branches in the decision tree. Fix the indentation error and try\nagain. Examples are shown in the help file (?)\n**") + } + return(add_class(err, c("dtree", "dtree-error"))) + } else { + # recursive function to check for missing values + check_na <- function(x) { + if (is.list(x)) { + return(any(sapply(x, check_na))) + } else { + return(is.na(x)) + } + } + any_missing <- check_na(yl) + if (isTRUE(any_missing)) { + err <- paste0("**\nMissing values in the tree. The most likely cause\nis cost or payoff numbers above 2,147,483,647.\nIntegers of this size are not currently supported.\nEither add .0 after the largest numbers or scale\nall numbers in 1,000 or 1,000,000 (e.g., use 3.6\ninstead of 3,600,000)\n**\n\n") + return(add_class(err, c("dtree", "dtree-error"))) + } + } + } + + if (length(yl) == 0) { + err <- "**\nThe provided tree input list is empty or not in the correct format.\nPlease double check the tree input and try again.\n**" + return(add_class(err, c("dtree", "dtree-error"))) + } + + ## getting variables from base if available + if (!is.null(yl$variables) && is.character(yl$variables[1])) { + yl_tree <- yl$variables[1] + if (!exists(yl_tree, envir = envir)) { + err <- "**\nThe tree referenced in the 'variables:' section is not available.\nPlease correct the name and try again.\n**" + return(add_class(err, c("dtree", "dtree-error"))) + } else if (!is.character(envir[[yl_tree]]) && !inherits(envir[[yl_tree]], "list")) { + err <- "**\nThe tree referenced in the 'variables:' section is not of type\ncharacter or list and cannot be used.\n**" + return(add_class(err, c("dtree", "dtree-error"))) + } else if (inherits(envir[[yl_tree]], "list")) { + yl$variables <- envir[[yl_tree]]$variables %>% .[!grepl("dtree\\(.*\\)", .)] + } else { + yl$variables <- envir[[yl_tree]] %>% + dtree_parser() %>% + yaml::yaml.load() %>% + .$variables %>% + .[!grepl("dtree\\(.*\\)", .)] + } + } + + vars <- "" + + ## can call a sub-tree that doesn't have any variables + if (length(base) > 0) { + base <- base[!grepl("dtree\\(.*\\)", base)] + if (is.null(yl$variables)) yl$variables <- base + } + + if (!is.null(yl$variables)) { + vars <- yl$variables + + ## overwrite the values in vars that are also in base + if (length(base) > 0) vars[names(base)] <- base + + vn <- names(vars) + + if (length(vn) > 1) { + ret <- sapply(vn, function(x) grepl(x, vn, fixed = TRUE)) %>% set_rownames(vn) + overlap <- colSums(ret) > 1 + if (any(overlap)) { + cat("Some of the labels in the 'variables:' section are too similar. Each label should\nbe unique and not be part of another label (e.g., 'proceed' is part of 'do not proceed').\nAn easy fix may be to use somewhat longer labels (e.g., 'success' instead of 'S').\nInstead of 'proceed' and 'do not proceed', for example, you could use 'do proceed'\nand 'do not proceed'. To use search-and-replace in the editor press CTRL-F\n(CMD-F on mac) twice. The overlap in labels is described below:\n\n") + ret <- ret[, overlap, drop = FALSE] + for (i in 1:ncol(ret)) { + tmp <- names(ret[ret[, i], i]) + cat(paste0(paste0("'", tmp[1], "'"), " is part of '", paste0(tail(tmp, -1), collapse = "', '"), "'\n")) + } + return("\nPlease update the tree input and try again." %>% add_class(c("dtree", "dtree-error"))) + } + } + + ## is there a subtree to evaluate? + for (i in vn) { + if (grepl("dtree\\(.*\\)", vars[i])) { + tree <- gsub(".*?([\'\"]+[ A-z0-9_\\.\\-]+[\'\"]+).*", "\\1", vars[i]) %>% gsub("[\"\']", "", .) + if (exists(tree, envir = envir)) { + cmd <- gsub("\\)\\s*$", paste0(", base = ", list(vars[!grepl("dtree\\(.*\\)", vars)]), "\\)"), vars[i]) + ret <- try(eval(parse(text = cmd), envir = envir), silent = TRUE) + if (inherits(ret, "try-error") || !inherits(ret, "list")) { + return("**\nThe reference to another tree was not succesful. It is possible\nthis was caused by a problem earlier in the 'variables:' section\nor because of a typo in the name of the tree you are trying to\nreference. Please check any messages about issues in the 'variables:'\nsection and try again\n**" %>% add_class(c("dtree", "dtree-error"))) + } else { + if (!is.null(ret$jl)) { + vars[i] <- ret$jl$Get(function(x) x$payoff)[1] + } else { + vars[i] <- "No payoff was specified for one or more nodes ('payoff:'). Please check\neach `payoff:' the tree input and try again" + } + } + } else { + vars[i] <- paste0("Decision tree \"", tree, "\" is not available") + } + } + } + + for (i in 2:max(2, length(vn))) { + vars <- gsub(vn[i - 1], paste0("(", vars[[i - 1]], ")"), vars, fixed = TRUE) + vars <- sapply(vars, function(x) ifelse(grepl("[A-Za-z]+", x), x, eval(parse(text = x), envir = envir))) + } + names(vars) <- vn + + isNum <- function(x) sshhr(!is.na(as.numeric(x))) + isNot <- vars[!sapply(vars, isNum)] + if (length(isNot) > 0) { + cat("Not all variables could be resolved to a numeric value.\n") + print(as.data.frame(isNot, stringsAsFactors = FALSE) %>% set_names("")) + } + + ## cycle through a nested list recursively + ## based on http://stackoverflow.com/a/26163152/1974918 + nlapply <- function(x, fun) { + if (is.list(x)) { + lapply(x, nlapply, fun) + } else { + fun(x) + } + } + + if (any(unlist(nlapply(yl, is.null)))) { + return("**\nOne or more payoffs or probabilities were not specified.\nUpdate the tree input and try again\n**" %>% add_class(c("dtree", "dtree-error"))) + } + + ## based on http://stackoverflow.com/a/14656351/1974918 + tmp <- as.relistable(yl[base::setdiff(names(yl), "variables")]) %>% unlist() + + for (i in seq_along(vn)) { + # only substitute variable values for probabilities (p) + # payoffs (payoff) and costs (cost) + toSub <- grepl("(\\.p$)|(\\.payoff$)|(\\.cost$)|(^p$)|(^payoff$)|(^cost$)", names(tmp)) + tmp[toSub] <- gsub(vn[i], vars[[i]], tmp[toSub], fixed = TRUE) + } + + ## any characters left in p, payoff, or cost fields? + isNot <- grepl("(.p$)|(.payoff$)|(.cost$)", names(tmp)) + isNot <- tmp[isNot] + isNot <- isNot[grepl("[^0-9.+*/() -]+", isNot)] + if (length(isNot) > 0) { + names(isNot) <- gsub(".", ":", names(isNot), fixed = TRUE) + cat("Not all variables could be resolved to a numeric value.\nNote that only basic formula's are allowed but no R-functions\n") + print(as.data.frame(isNot, stringsAsFactors = FALSE) %>% set_names("")) + return("\nUpdate the tree input and try again." %>% add_class(c("dtree", "dtree-error"))) + } + + ## convert payoff, probabilities, and costs to numeric + tmp <- relist(tmp) + toNum <- function(x) { + if (!grepl("[A-Za-z]+", x)) { + px <- try(eval(parse(text = x), envir = envir), silent = TRUE) + if (inherits(px, "try-error")) { + message("There was an error parsing: ", x) + } else { + px <- sshhr(as.numeric(px)) + if (is.na(px)) { + message("There was an error parsing: ", x) + } else { + x <- px + } + } + } + x + } + + tmp <- nlapply(tmp, toNum) + + ## convert list to node object + jl <- data.tree::as.Node(tmp) + } else { + ## convert list to node object + jl <- data.tree::as.Node(yl) + } + + ## if type not set and isLeaf set to terminal + # pt <- . %>% {if (is.null(.$type)) .$Set(type = "terminal")} + # jl$Do(pt, filterFun = data.tree::isLeaf) + + isNum <- function(x) !is_not(x) && !grepl("[A-Za-z]+", x) + + cost_check <- "" + cost_checker <- function(x) { + ## if type not set and isLeaf set to terminal + if (is.null(x$type)) x$Set(type = "terminal") + + ## costs should not be set in terminal nodes, use payoff instead + if (isNum(x$cost)) { + cost_check <<- "One or more terminal nodes have been assigned a cost. Specifying a cost\nusing 'cost:' in the tree input is only useful if it applies to multiple\nnodes in a branch. If the cost only applies to a single terminal node it\nis better to adjust the payoff value for that node instead" + } + } + + jl$Do(cost_checker, filterFun = data.tree::isLeaf) + + ## making a copy of the initial Node object + jl_init <- data.tree::Clone(jl) + + chance_payoff <- function(node) { + if (!isNum(node$payoff) || !isNum(node$p)) { + 0 + } else { + node$payoff * node$p + } + } + + decision_payoff <- function(node) { + if (!isNum(node$payoff)) 0 else node$payoff + } + + prob_checker <- function(node) { + if (!isNum(node$p)) 0 else node$p + } + + type_none <- "" + prob_check <- "" + calc_payoff <- function(x) { + if (is.empty(x$type)) { + x$payoff <- 0 + x$type <- "NONE" + type_none <<- "One or more nodes do not have a 'type'. Check and update the input file" + } else if (x$type == "chance") { + x$payoff <- sum(sapply(x$children, chance_payoff)) + + probs <- sapply(x$children, prob_checker) + if (min(probs) < 0) { + prob_check <<- "One or more probabilities are smalller than 0.\nPlease correct the tree input ('p:') and re-calculate the tree" + } else if (max(probs) > 1) { + prob_check <<- "One or more probabilities are larger than 1.\nPlease correct the tree input ('p:') and re-calculate the tree" + } else if (!near(sum(probs), 1)) { + prob_check <<- glue("Probabilities for one (or more) chance nodes do not sum to 1 ({sum(probs)}).\nPlease correct the tree input ('p:') and re-calculate the tree") + } + } else if (x$type == "decision") { + x$payoff <- get(opt)(sapply(x$children, decision_payoff)) + } + + ## subtract cost if specified + if (isNum(x$cost)) x$payoff <- x$payoff - x$cost + } + + err <- try(jl$Do(calc_payoff, traversal = "post-order", filterFun = data.tree::isNotLeaf), silent = TRUE) + + if (inherits(err, "try-error")) { + err <- paste0("**\nThere was an error calculating payoffs associated with a chance or decision\nnode. Please check that each terminal node has a payoff and that probabilities\nare correctly specificied. Also check the R(studio) console for messages\n**") + return(err %>% add_class(c("dtree", "dtree-error"))) + } + + decision <- function(x) { + po <- sapply(x$children, decision_payoff) + if (isNum(x$cost)) po <- po - x$cost + x$decision <- names(po[po == x$payoff]) + } + + err <- try(jl$Do(decision, filterFun = function(x) !is.null(x$type) && x$type == "decision"), silent = TRUE) + + if (inherits(err, "try-error")) { + err <- paste0("**\nThere was an error calculating payoffs associated with a decision node.\nPlease check that each terminal node has a payoff\n**") + return(err %>% add_class(c("dtree", "dtree-error"))) + } + + payoff <- jl$Get(function(x) x$payoff) + prob <- jl$Get(function(x) x$p) + + solution_df <- data.frame( + level = jl$Get(function(x) x$level), + label = names(payoff), + payoff = payoff, + prob = prob, + cost = jl$Get(function(x) x$cost), + type = jl$Get(function(x) x$type) + ) + + list( + jl_init = jl_init, jl = jl, yl = yl, vars = vars, opt = opt, + type_none = type_none, prob_check = prob_check, cost_check = cost_check, + payoff = payoff, prob = prob, solution_df = solution_df + ) %>% + add_class("dtree") +} + +#' Summary method for the dtree function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/dtree.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{simulater}} +#' @param input Print decision tree input +#' @param output Print decision tree output +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' dtree(movie_contract, opt = "max") %>% summary(input = TRUE) +#' dtree(movie_contract, opt = "max") %>% summary(input = FALSE, output = TRUE) +#' +#' @importFrom data.tree Traverse Get FormatPercent +#' +#' @seealso \code{\link{dtree}} to generate the results +#' @seealso \code{\link{plot.dtree}} to plot results +#' @seealso \code{\link{sensitivity.dtree}} to plot results +#' +#' @export +summary.dtree <- function(object, input = TRUE, output = FALSE, + dec = 2, ...) { + if (is.character(object)) { + return(cat(object)) + } + + isNum <- function(x) !is_not(x) && !grepl("[A-Za-z]+", x) + + print_money <- function(x) { + x %>% (function(x) if (isNum(x)) x else "") %>% + formatC( + digits = dec, + decimal.mark = ".", + big.mark = ",", + format = "f" + ) + } + + print_percent <- function(x) { + x %>% (function(x) if (isNum(x)) x else NA) %>% + data.tree::FormatPercent() + } + + rm_terminal <- function(x) { + x %>% + (function(x) if (is.na(x)) "" else x) %>% + (function(x) if (x == "terminal") "" else x) + } + + format_dtree <- function(jl) { + ## set parent type + nt <- jl$Get(function(x) x$parent$type) + jl$Set(ptype = nt) + + data.tree::Traverse(jl) %>% + { + data.frame( + ` ` = data.tree::Get(., "levelName"), + Probability = data.tree::Get(., "p", format = print_percent), + Payoff = data.tree::Get(., "payoff", format = print_money), + Cost = data.tree::Get(., "cost", format = print_money), + Type = data.tree::Get(., "ptype", format = rm_terminal), + check.names = FALSE, + stringsAsFactors = FALSE + ) + } %>% + { + .[[" "]] <- format(.[[" "]], justify = "left") + . + } %>% + format_df(mark = ",", dec = dec) + } + + if (input) { + cat("Decision tree input:\n") + cat(yaml::as.yaml(object$yl, indent = 4)) + cat("\n") + } + + if (all(object$vars != "") && output) { + cat("Variable input values:\n") + print(as.data.frame(object$vars, stringsAsFactors = FALSE) %>% set_names("")) + } + + ## initial setup + if (object$type_none != "") { + cat(paste0("\n\n**\n", object$type_none, "\n**\n\n")) + } else if (!is.empty(object$cost_check)) { + cat(paste0("\n\n**\n", object$cost_check, "\n**\n\n")) + } else { + if (object$prob_check != "") { + cat(paste0("**\n", object$prob_check, "\n**\n\n")) + } + + if (output) { + cat("\nInitial decision tree:\n") + format_dtree(object$jl_init) %>% print(row.names = FALSE) + + cat("\nFinal decision tree:\n") + format_dtree(object$jl) %>% print(row.names = FALSE) + } + } +} + +#' Plot method for the dtree function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/dtree.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{dtree}} +#' @param symbol Monetary symbol to use ($ is the default) +#' @param dec Decimal places to round results to +#' @param final If TRUE plot the decision tree solution, else the initial decision tree +#' @param orient Plot orientation: LR for vertical and TD for horizontal +#' @param width Plot width in pixels (default is "900px") +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' dtree(movie_contract, opt = "max") %>% plot() +#' dtree(movie_contract, opt = "max") %>% plot(final = TRUE, orient = "TD") +#' +#' @importFrom data.tree Traverse Get isNotRoot +#' @importFrom DiagrammeR DiagrammeR mermaid +#' +#' @seealso \code{\link{dtree}} to generate the result +#' @seealso \code{\link{summary.dtree}} to summarize results +#' @seealso \code{\link{sensitivity.dtree}} to plot results +#' +#' @export +plot.dtree <- function(x, symbol = "$", dec = 2, final = FALSE, orient = "LR", width = "900px", ...) { + ## avoid error when dec is missing + if (is_not(dec)) dec <- 2 + + isNum <- function(x) !is_not(x) && !grepl("[A-Za-z]+", x) + + if ("character" %in% class(x)) { + return(paste0("graph LR\n A[Errors in the input file]") %>% DiagrammeR::DiagrammeR(.)) + } + if (x$type_none != "") { + return(paste0("graph LR\n A[Node does not have a type. Please fix the tree input]") %>% DiagrammeR::DiagrammeR(.)) + } + + ## based on https://gist.github.com/gluc/79ef7a0e747f217ca45e + jl <- if (final) x$jl else x$jl_init + + ## create ids + jl$Set(id = paste0("id", 1:jl$totalCount)) + + ## create start labels + FromLabel <- function(node) { + if (node$parent$isRoot) { + ToLabel(node$parent) + } else { + as.character(node$parent$id) + } + } + + ## create arrow labels + EdgeLabel <- function(node) { + if (node$isRoot) { + return(" ") + } else if (node$parent$type == "decision") { + lbl <- node$name + } else if (node$parent$type == "chance") { + lbl <- paste0(node$name, ": ", format_nr(as.numeric(node$p), dec = dec + 2)) + } else if (node$type == "terminal") { + lbl <- paste0(node$name, ": ", format_nr(as.numeric(node$p), dec = dec + 2)) + } + + if (length(node$parent$decision) > 0 && length(node$name) > 0) { + if (length(node$parent$decision) == 1 && node$name == node$parent$decision) { + paste0(" === |", lbl, "|") + } else if (any(node$name == node$parent$decision)) { + paste0(" === |", lbl, "|") + } else { + paste0(" --- |", lbl, "|") + } + } else { + paste0(" --- |", lbl, "|") + } + } + + FormatPayoff <- function(payoff) { + if (!isNum(payoff)) payoff <- 0 + format_nr(payoff, paste0("\"", symbol, "\""), dec = dec) + } + + ToLabel <- function(node) { + po <- if (final) FormatPayoff(node$payoff) else " " + if (node$type == "decision") { + lbl <- paste0("[", po, "]") + } else if (node$type == "chance") { + lbl <- paste0("((", po, "))") + } else if (node$type == "terminal") { + lbl <- paste0("[", FormatPayoff(node$payoff), "]") + } + paste0(" ", node$id, lbl) + } + + style_decision <- jl$Get("id", filterFun = function(x) x$type == "decision" && is.null(x$cost)) + if (is.null(style_decision)) style_decision <- "id_null" + style_decision_with_cost <- jl$Get("id", filterFun = function(x) x$type == "decision" && !is.null(x$cost)) + if (is.null(style_decision_with_cost)) style_decision_with_cost <- "id_null" + style_chance <- jl$Get("id", filterFun = function(x) x$type == "chance" && is.null(x$cost)) + if (is.null(style_chance)) style_chance <- "id_null" + style_chance_with_cost <- jl$Get("id", filterFun = function(x) x$type == "chance" && !is.null(x$cost)) + if (is.null(style_chance_with_cost)) style_chance_with_cost <- "id_null" + + ToolTip <- function(node) { + if (final == TRUE && !is.null(node$cost)) { + sym <- ifelse(node$cost < 0, " + ", " - ") + paste0(format_nr(node$payoff + node$cost, symbol, dec = dec), sym, format_nr(abs(node$cost), symbol, dec = dec)) %>% + paste0("click ", node$id, " callback \"", ., "\"") + } else if (!is.null(node$cost)) { + paste0("Cost: ", format_nr(node$cost, symbol, dec = dec)) %>% + paste0("click ", node$id, " callback \"", ., "\"") + } else { + NA + } + } + + style <- paste0( + "classDef default fill:none, bg:none, stroke-width:0px; + classDef chance fill:#FF8C00,stroke:#333,stroke-width:1px; + classDef chance_with_cost fill:#FF8C00,stroke:#333,stroke-width:3px,stroke-dasharray:4,5; + classDef decision fill:#9ACD32,stroke:#333,stroke-width:1px; + classDef decision_with_cost fill:#9ACD32,stroke:#333,stroke-width:3px,stroke-dasharray:4,5; + class ", paste(style_decision, collapse = ","), " decision; + class ", paste(style_decision_with_cost, collapse = ","), " decision_with_cost; + class ", paste(style_chance, collapse = ","), " chance; + class ", paste(style_chance_with_cost, collapse = ","), " chance_with_cost;" + ) + + trv <- data.tree::Traverse(jl, traversal = "level", filterFun = data.tree::isNotRoot) + df <- data.frame( + from = data.tree::Get(trv, FromLabel), + edge = data.tree::Get(trv, EdgeLabel), + to = data.tree::Get(trv, ToLabel), + id = data.tree::Get(trv, ToLabel), + tooltip = data.tree::Get(trv, ToolTip), + stringsAsFactors = FALSE + ) + + trv <- data.tree::Traverse(jl, traversal = "level", filterFun = data.tree::isRoot) + ttip <- c(df[["tooltip"]], data.tree::Get(trv, ToolTip)) %>% + na.omit() %>% + unique() + + ## use LR or TD + paste( + paste0("graph ", orient), paste(paste0(df$from, df$edge, df$to), collapse = "\n"), + paste(ttip, collapse = "\n"), style, + sep = "\n" + ) %>% + ## address image size in pdf and html and allow zooming + # DiagrammeR::mermaid(., width = "100%", height = "100%") + DiagrammeR::mermaid(width = width, height = "100%") +} + +## add a plot title? +# {htmltools::html_print(tagList(tags$h1("A title"), DiagrammeR::mermaid(., width = width, height = "100%")))} +# html_print(tagList( +# tags$h1("R + mermaid.js = Something Special") +# ,tags$pre(diagramSpec) +# ,tags$div(class="mermaid",diagramSpec) +# ,DiagrammeR() +# )) + +#' Evaluate sensitivity of the decision tree +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/dtree.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{dtree}} +#' @param vars Variables to include in the sensitivity analysis +#' @param decs Decisions to include in the sensitivity analysis +#' @param envir Environment to extract data from +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options. +#' @param ... Additional arguments + +#' @examples +#' dtree(movie_contract, opt = "max") %>% +#' sensitivity( +#' vars = "legal fees 0 100000 10000", +#' decs = c("Sign with Movie Company", "Sign with TV Network"), +#' custom = FALSE +#' ) +#' +#' @importFrom rlang .data +#' +#' @seealso \code{\link{dtree}} to generate the result +#' @seealso \code{\link{plot.dtree}} to summarize results +#' @seealso \code{\link{summary.dtree}} to summarize results +#' +#' @export +sensitivity.dtree <- function(object, vars = NULL, decs = NULL, + envir = parent.frame(), + shiny = FALSE, custom = FALSE, ...) { + yl <- object$yl + + if (is.empty(vars)) { + return("** No variables were specified **") + } else if (is.empty(decs)) { + return("** No decisions were specified **") + } + vars <- strsplit(vars, ";\\s*") %>% + unlist() %>% + strsplit(" ") + + calc_payoff <- function(x, nm) { + yl$variables[[nm]] <- x + ret <- dtree(yl, opt = object$opt, envir = envir)$jl + ret$Get(function(x) x$payoff)[decs] + } + + nms <- c() + sensitivity <- function(x) { + tmp <- rep("", 4) + tmp[2:4] <- tail(x, 3) + tmp[1] <- paste(head(x, -3), collapse = " ") + nms <<- c(nms, tmp[1]) + df <- data.frame( + values = tail(tmp, 3) %>% as.numeric() %>% + { + seq(.[1], .[2], .[3]) + }, + stringsAsFactors = FALSE + ) + + if (length(decs) == 1) { + df[[decs]] <- sapply(df$values, calc_payoff, tmp[1]) + } else { + df <- cbind(df, sapply(df$values, calc_payoff, tmp[1]) %>% t()) + } + df + } + ret <- lapply(vars, sensitivity) + names(ret) <- nms + + plot_list <- list() + for (i in names(ret)) { + dat <- gather(ret[[i]], "decisions", "payoffs", !!base::setdiff(names(ret[[i]]), "values")) + plot_list[[i]] <- + ggplot(dat, aes(x = .data$values, y = .data$payoffs, color = .data$decisions)) + + geom_line() + + geom_point(aes(shape = .data$decisions), size = 2) + + labs( + title = paste0("Sensitivity of decisions to changes in ", i), + x = i + ) + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = 1) %>% + { + if (shiny) . else print(.) + } + } + } +} diff --git a/radiant.model/R/evalbin.R b/radiant.model/R/evalbin.R new file mode 100644 index 0000000000000000000000000000000000000000..485421ca1bb3211dbbe8ed8190e56b86e9bb0280 --- /dev/null +++ b/radiant.model/R/evalbin.R @@ -0,0 +1,1138 @@ +#' Evaluate the performance of different (binary) classification models +#' +#' @details Evaluate different (binary) classification models based on predictions. See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param pred Predictions or predictors +#' @param rvar Response variable +#' @param lev The level in the response variable defined as success +#' @param qnt Number of bins to create +#' @param cost Cost for each connection (e.g., email or mailing) +#' @param margin Margin on each customer purchase +#' @param scale Scaling factor to apply to calculations +#' @param train Use data from training ("Training"), test ("Test"), both ("Both"), or all data ("All") to evaluate model evalbin +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param arr Expression to arrange (sort) the data on (e.g., "color, desc(price)") +#' @param rows Rows to select from the specified dataset +#' @param envir Environment to extract data from +#' +#' @return A list of results +#' +#' @seealso \code{\link{summary.evalbin}} to summarize results +#' @seealso \code{\link{plot.evalbin}} to plot results +#' +#' @examples +#' data.frame(buy = dvd$buy, pred1 = runif(20000), pred2 = ifelse(dvd$buy == "yes", 1, 0)) %>% +#' evalbin(c("pred1", "pred2"), "buy") %>% +#' str() +#' @export +evalbin <- function(dataset, pred, rvar, lev = "", + qnt = 10, cost = 1, margin = 2, scale = 1, + train = "All", data_filter = "", arr = "", + rows = NULL, envir = parent.frame()) { + ## in case no inputs were provided + if (is.na(cost)) cost <- 0 + if (is.na(margin)) margin <- 0 + if (is.na(scale)) scale <- 1 + + if (!train %in% c("", "All") && is.empty(data_filter) && is.empty(rows)) { + return("**\nFilter or Slice required to differentiate Train and Test. To set a filter or slice go to\nData > View and click the filter checkbox\n**" %>% add_class("evalbin")) + } + + if (is.empty(qnt)) qnt <- 10 + + cnf_tab <- confusion(dataset, pred, rvar, + lev = lev, cost = cost, margin = margin, scale = scale, + train = train, data_filter = data_filter, arr = arr, rows = rows, + envir = envir + ) + + df_name <- if (!is_string(dataset)) deparse(substitute(dataset)) else dataset + + dat_list <- list() + vars <- c(pred, rvar) + if (train == "Both") { + dat_list[["Training"]] <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, envir = envir) + dat_list[["Test"]] <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, rev = TRUE, envir = envir) + } else if (train == "Training") { + dat_list[["Training"]] <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, envir = envir) + } else if (train == "Test") { + dat_list[["Test"]] <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, rev = TRUE, envir = envir) + } else if (train == "Training") { + } else { + dat_list[["All"]] <- get_data(dataset, vars, envir = envir) + } + + qnt_name <- "bins" + auc_list <- list() + prof_list <- c() + pdat <- list() + pext <- c(All = "", Training = " (train)", Test = " (test)") + + for (i in names(dat_list)) { + lg_list <- list() + pl <- c() + dataset <- dat_list[[i]] + + if (nrow(dataset) == 0) { + return( + paste0("Data for ", i, " has zero rows. Please correct the filter used and try again") %>% + add_class("evalbin") + ) + } + + rv <- dataset[[rvar]] + if (is.factor(rv)) { + levs <- levels(rv) + } else { + levs <- rv %>% + as.character() %>% + as.factor() %>% + levels() + } + + if (lev == "") { + lev <- levs[1] + } else { + if (!lev %in% levs) { + return(add_class("Level provided not found", "evalbin")) + } + } + + ## transformation to TRUE/FALSE depending on the selected level (lev) + dataset[[rvar]] <- dataset[[rvar]] == lev + + ## tip for summarise_ from http://stackoverflow.com/a/27592077/1974918 + ## put summaries in list so you can print and plot + tot_resp <- sum(dataset[[rvar]]) * scale + tot_obs <- nrow(dataset) * scale + tot_rate <- tot_resp / tot_obs + + for (j in seq_along(pred)) { + pname <- paste0(pred[j], pext[i]) + auc_list[[pname]] <- auc(dataset[[pred[j]]], dataset[[rvar]], TRUE) + lg_list[[pname]] <- + dataset %>% + select_at(.vars = c(pred[j], rvar)) %>% + mutate(!!pred[j] := radiant.data::xtile(.data[[pred[j]]], n = qnt, rev = TRUE)) %>% + setNames(c(qnt_name, rvar)) %>% + group_by_at(.vars = qnt_name) %>% + summarise( + nr_obs = n() * scale, + nr_resp = sum(.data[[rvar]] * scale) + ) %>% + mutate( + resp_rate = nr_resp / nr_obs, + gains = nr_resp / tot_resp + ) %>% + (function(x) if (first(x$resp_rate) < last(x$resp_rate)) mutate_all(x, rev) else x) %>% + mutate( + profit = margin * cumsum(nr_resp) - cost * cumsum(nr_obs), + ROME = profit / (cost * cumsum(nr_obs)), + cum_prop = cumsum(nr_obs / tot_obs), + cum_resp = cumsum(nr_resp), + cum_resp_rate = cum_resp / cumsum(nr_obs), + cum_lift = cum_resp_rate / tot_rate, + cum_gains = cum_resp / tot_resp + ) %>% + mutate(pred = pname) %>% + mutate(ROME = ifelse(is.na(ROME), 0, ROME)) %>% + select(pred, everything()) + + pl <- c(pl, max(lg_list[[pname]]$profit)) + } + prof_list <- c(prof_list, pl / abs(max(pl))) + pdat[[i]] <- bind_rows(lg_list) %>% mutate(profit = profit) + } + dataset <- bind_rows(pdat) %>% mutate(profit = ifelse(is.na(profit), 0, profit)) + dataset$pred <- factor(dataset$pred, levels = unique(dataset$pred)) + + names(prof_list) <- names(auc_list) + + list( + dataset = dataset, dat_list = dat_list, df_name = df_name, data_filter = data_filter, + arr = arr, rows = rows, train = train, pred = pred, rvar = rvar, + lev = lev, qnt = qnt, cost = cost, margin = margin, scale = scale, cnf_tab = cnf_tab + ) %>% add_class("evalbin") +} + +#' Summary method for the evalbin function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{evalbin}} +#' @param prn Print full table of measures per model and bin +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{evalbin}} to summarize results +#' @seealso \code{\link{plot.evalbin}} to plot results +#' +#' @examples +#' data.frame(buy = dvd$buy, pred1 = runif(20000), pred2 = ifelse(dvd$buy == "yes", 1, 0)) %>% +#' evalbin(c("pred1", "pred2"), "buy") %>% +#' summary() +#' @export +summary.evalbin <- function(object, prn = TRUE, dec = 3, ...) { + if (is.character(object)) { + return(object) + } + + cat("Evaluate predictions for binary response models\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + if (!is.empty(object$arr)) { + cat("Arrange :", gsub("\\n", "", object$arr), "\n") + } + if (!is.empty(object$rows)) { + cat("Slice :", gsub("\\n", "", object$rows), "\n") + } + cat("Results for :", object$train, "\n") + cat("Predictors :", paste0(object$pred, collapse = ", "), "\n") + cat("Response :", object$rvar, "\n") + cat("Level :", object$lev, "in", object$rvar, "\n") + cat("Bins :", object$qnt, "\n") + cat("Cost:Margin :", object$cost, ":", object$margin, "\n") + cat("Scale :", object$scale, "\n\n") + + if (prn) { + as.data.frame(object$dataset, stringsAsFactors = FALSE) %>% + format_df(dec = dec, mark = ",") %>% + print(row.names = FALSE) + } +} + +#' Plot method for the evalbin function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{evalbin}} +#' @param plots Plots to return +#' @param size Font size used +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{evalbin}} to generate results +#' @seealso \code{\link{summary.evalbin}} to summarize results +#' +#' @importFrom scales percent +#' +#' @examples +#' data.frame(buy = dvd$buy, pred1 = runif(20000), pred2 = ifelse(dvd$buy == "yes", 1, 0)) %>% +#' evalbin(c("pred1", "pred2"), "buy") %>% +#' plot() +#' @export +plot.evalbin <- function(x, plots = c("lift", "gains"), + size = 13, shiny = FALSE, + custom = FALSE, ...) { + if (is.character(x) || is.null(x$dataset) || any(is.na(x$dataset$cum_lift)) || + is.null(plots)) { + return(invisible()) + } + + plot_list <- list() + if ("lift" %in% plots) { + plot_list[["lift"]] <- + visualize(x$dataset, xvar = "cum_prop", yvar = "cum_lift", type = "line", color = "pred", custom = TRUE) + + geom_point() + + geom_segment(aes(x = 0, y = 1, xend = 1, yend = 1), linewidth = .1, linetype = "dotdash", color = "black") + + labs(y = "Cumulative lift", x = "Proportion of population targeted") + + scale_x_continuous(labels = scales::percent) + } + + if ("gains" %in% plots) { + dataset <- x$dataset %>% + select(pred, cum_prop, cum_gains) %>% + group_by(pred) %>% + mutate(obs = 1:n()) + + init <- filter(dataset, obs == 1) + init[, c("cum_prop", "cum_gains", "obs")] <- 0 + dataset <- bind_rows(init, dataset) %>% arrange(pred, obs) + + plot_list[["gains"]] <- + visualize(dataset, xvar = "cum_prop", yvar = "cum_gains", type = "line", color = "pred", custom = TRUE) + + geom_point() + + geom_segment(aes(x = 0, y = 0, xend = 1, yend = 1), linewidth = .1, linetype = "dotdash", color = "black") + + labs(y = "Cumulative gains", x = "Proportion of population targeted") + + scale_x_continuous(labels = scales::percent) + + scale_y_continuous(labels = scales::percent) + } + + if ("profit" %in% plots) { + dataset <- select(x$dataset, pred, cum_prop, profit) %>% + group_by(pred) %>% + mutate(obs = 1:n()) + + vlines <- data.frame( + pred = x$cnf_tab$pred, + contact = x$cnf_tab$dataset$contact + ) + default_colors <- scales::hue_pal()(nrow(vlines)) + + init <- filter(dataset, obs == 1) + init[, c("profit", "cum_prop", "obs")] <- 0 + dataset <- bind_rows(init, dataset) %>% arrange(pred, obs) + + plot_list[["profit"]] <- visualize( + dataset, + xvar = "cum_prop", + yvar = "profit", + type = "line", + color = "pred", + custom = TRUE + ) + + geom_point() + + geom_segment(aes(x = 0, y = 0, xend = 1, yend = 0), linewidth = .1, linetype = "dotdash", color = "black") + + ## the next line doesn't work due to: https://github.com/tidyverse/ggplot2/issues/2492 + ## using 'default colors' instead + # geom_vline(data = vlines, aes(xintercept = contact, color = pred), linewidth = 0.5, linetype = "dotdash", show.legend = FALSE) + + geom_vline(xintercept = vlines$contact, color = default_colors, linewidth = 0.5, linetype = "dotdash") + + labs(y = "Profit", x = "Proportion of population targeted") + + scale_y_continuous(labels = scales::comma) + + scale_x_continuous(labels = scales::percent) + } + + if ("expected_profit" %in% plots) { + calc_exp_profit <- function(df, pred, n, cost, margin, scale) { + pext <- c(All = "", Training = " (train)", Test = " (test)") + prediction <- sort(df[[pred]], decreasing = TRUE) + profit <- prediction * margin - cost + data.frame( + pred = paste0(pred, pext[n]), + cum_prop = seq(1, nrow(df)) / nrow(df), + cum_profit = cumsum(profit) * scale + ) + } + dataset <- list() + for (n in names(x$dat_list)) { + dataset <- append(dataset, lapply(x$pred, function(pred) calc_exp_profit(x$dat_list[[n]], pred, n, x$cost, x$margin, x$scale))) + } + dataset <- bind_rows(dataset) + + vlines <- data.frame( + pred = x$cnf_tab$pred, + contact = x$cnf_tab$dataset$contact + ) + hlines <- data.frame( + pred = x$cnf_tab$pred, + max_profit = dataset %>% group_by(pred) %>% summarize(max_profit = max(cum_profit)) %>% pull(max_profit) + ) + default_colors <- scales::hue_pal()(nrow(vlines)) + + plot_list[["expected_profit"]] <- visualize( + dataset, + xvar = "cum_prop", + yvar = "cum_profit", + type = "line", + color = "pred", + custom = TRUE + ) + + geom_segment(aes(x = 0, y = 0, xend = 1, yend = 0), linewidth = .1, linetype = "dotdash", color = "black") + + ## the next line doesn't work due to: https://github.com/tidyverse/ggplot2/issues/2492 + ## using 'default colors' instead + # geom_vline(data = vlines, aes(xintercept = contact, color = pred), linewidth = 0.5, linetype = "dotdash", show.legend = FALSE) + + geom_hline(yintercept = hlines$max_profit, color = default_colors, linewidth = 0.5, linetype = "dotdash") + + geom_vline(xintercept = vlines$contact, color = default_colors, linewidth = 0.5, linetype = "dotdash") + + labs(y = "Expected Profit", x = "Proportion of population targeted") + + scale_y_continuous(labels = scales::comma) + + scale_x_continuous(labels = scales::percent) + } + + if ("rome" %in% plots) { + plot_list[["rome"]] <- visualize( + x$dataset, + xvar = "cum_prop", + yvar = "ROME", + type = "line", + color = "pred", + custom = TRUE + ) + + geom_point() + + geom_segment(aes(x = 0, y = 0, xend = 1, yend = 0), linewidth = .1, linetype = "dotdash", color = "black") + + labs(y = "Return on Marketing Expenditures (ROME)", x = "Proportion of population targeted") + + scale_x_continuous(labels = scales::percent) + + scale_y_continuous(labels = scales::percent) + } + + for (i in names(plot_list)) { + plot_list[[i]] <- plot_list[[i]] + theme_set(theme_gray(base_size = size)) + if (length(x$pred) < 2 && x$train != "Both") { + plot_list[[i]] <- plot_list[[i]] + theme(legend.position = "none") + } else { + plot_list[[i]] <- plot_list[[i]] + labs(color = "Predictor") + } + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = 1) %>% + (function(x) if (shiny) x else print(x)) + } + } +} + + +#' Confusion matrix +#' +#' @details Confusion matrix and additional metrics to evaluate binary classification models. See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param pred Predictions or predictors +#' @param rvar Response variable +#' @param lev The level in the response variable defined as success +#' @param cost Cost for each connection (e.g., email or mailing) +#' @param margin Margin on each customer purchase +#' @param scale Scaling factor to apply to calculations +#' @param train Use data from training ("Training"), test ("Test"), both ("Both"), or all data ("All") to evaluate model evalbin +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param arr Expression to arrange (sort) the data on (e.g., "color, desc(price)") +#' @param rows Rows to select from the specified dataset +#' @param envir Environment to extract data from +#' @param ... further arguments passed to or from other methods +#' +#' @return A list of results +#' +#' @seealso \code{\link{summary.confusion}} to summarize results +#' @seealso \code{\link{plot.confusion}} to plot results +#' +#' @examples +#' data.frame(buy = dvd$buy, pred1 = runif(20000), pred2 = ifelse(dvd$buy == "yes", 1, 0)) %>% +#' confusion(c("pred1", "pred2"), "buy") %>% +#' str() +#' @importFrom psych cohen.kappa +#' +#' @export +confusion <- function(dataset, pred, rvar, lev = "", cost = 1, margin = 2, scale = 1, + train = "All", data_filter = "", arr = "", rows = NULL, + envir = parent.frame(), ...) { + if (!train %in% c("", "All") && is.empty(data_filter) && is.empty(rows)) { + return("**\nFilter or Slice required to differentiate Train and Test. To set a filter or slice go to\nData > View and click the filter checkbox\n**" %>% add_class("confusion")) + } + + ## in case no inputs were provided + if (is_not(margin) || is_not(cost)) { + break_even <- 0.5 + } else if (margin == 0) { + break_even <- cost / 1 + } else { + break_even <- cost / margin + } + + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + + dat_list <- list() + vars <- c(pred, rvar) + if (train == "Both") { + dat_list[["Training"]] <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, envir = envir) + dat_list[["Test"]] <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, rev = TRUE, envir = envir) + } else if (train == "Training") { + dat_list[["Training"]] <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, envir = envir) + } else if (train == "Test") { + dat_list[["Test"]] <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, rev = TRUE, envir = envir) + } else { + dat_list[["All"]] <- get_data(dataset, vars, envir = envir) + } + + pdat <- list() + for (i in names(dat_list)) { + dataset <- dat_list[[i]] + rv <- dataset[[rvar]] + + if (lev == "") { + if (is.factor(rv)) { + lev <- levels(rv)[1] + } else { + lev <- as.character(rv) %>% + as.factor() %>% + levels() %>% + .[1] + } + } else { + if (!lev %in% dataset[[rvar]]) { + return(add_class("Please update the selected level in the response variable", "confusion")) + } + } + + ## transformation to TRUE/FALSE depending on the selected level (lev) + dataset[[rvar]] <- dataset[[rvar]] == lev + + auc_vec <- rig_vec <- rep(NA, length(pred)) %>% set_names(pred) + for (p in pred) { + auc_vec[p] <- auc(dataset[[p]], dataset[[rvar]], TRUE) + rig_vec[p] <- rig(dataset[[p]], dataset[[rvar]], TRUE) + } + + p_vec <- colMeans(dataset[, pred, drop = FALSE]) / mean(dataset[[rvar]]) + + dataset[, pred] <- select_at(dataset, .vars = pred) > break_even + + if (length(pred) > 1) { + dataset <- mutate_at(dataset, .vars = c(rvar, pred), .funs = ~ factor(., levels = c("FALSE", "TRUE"))) + } else { + dataset[, pred] %<>% apply(2, function(x) factor(x, levels = c("FALSE", "TRUE"))) + } + + make_tab <- function(x) { + ret <- rep(0L, 4) %>% set_names(c("TN", "FN", "FP", "TP")) + tab <- table(dataset[[rvar]], x) %>% as.data.frame(stringsAsFactors = FALSE) + ## ensure a value is available for all four options + for (i in seq_len(nrow(tab))) { + if (tab[i, 1] == "TRUE") { + if (tab[i, 2] == "TRUE") { + ret["TP"] <- tab[i, 3] + } else { + ret["FN"] <- tab[i, 3] + } + } else { + if (tab[i, 2] == "TRUE") { + ret["FP"] <- tab[i, 3] + } else { + ret["TN"] <- tab[i, 3] + } + } + } + return(ret) + } + ret <- lapply(select_at(dataset, .vars = pred), make_tab) %>% + as.data.frame(stringsAsFactors = FALSE) %>% + t() %>% + as.data.frame(stringsAsFactors = FALSE) + ret <- bind_cols( + data.frame( + Type = rep(i, length(pred)), + Predictor = pred, + stringsAsFactors = FALSE + ), + ret, + data.frame( + AUC = auc_vec, + RIG = rig_vec, + p.ratio = p_vec, + stringsAsFactors = FALSE + ) + ) + + pdat[[i]] <- ret + } + + dataset <- bind_rows(pdat) %>% + as.data.frame(stringsAsFactors = FALSE) %>% + mutate( + total = TN + FN + FP + TP, + TPR = TP / (TP + FN), + TNR = TN / (TN + FP), + precision = TP / (TP + FP), + Fscore = 2 * (precision * TPR) / (precision + TPR), + accuracy = (TP + TN) / total, + profit = (margin * TP - cost * (TP + FP)) * scale, + ROME = (margin * TP - cost * (TP + FP)) / (cost * (TP + FP)), + contact = (TP + FP) / total, + kappa = 0 + ) + + dataset <- group_by_at(dataset, .vars = "Type") %>% + mutate(index = profit / max(profit)) %>% + ungroup() + + for (i in 1:nrow(dataset)) { + tmp <- slice(dataset, i) + dataset$kappa[i] <- psych::cohen.kappa(matrix(with(tmp, c(TN, FP, FN, TP)), ncol = 2))[["kappa"]] + } + + dataset <- select_at( + dataset, + .vars = c( + "Type", "Predictor", "TP", "FP", "TN", "FN", "total", + "TPR", "TNR", "precision", "Fscore", "RIG", "accuracy", + "kappa", "profit", "index", "ROME", "contact", "AUC" + ) + ) + + list( + dataset = dataset, df_name = df_name, data_filter = data_filter, arr = arr, + rows = rows, train = train, pred = pred, rvar = rvar, lev = lev, cost = cost, + margin = margin, scale = scale + ) %>% add_class("confusion") +} + +#' Summary method for the confusion matrix +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{confusion}} +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{confusion}} to generate results +#' @seealso \code{\link{plot.confusion}} to visualize result +#' +#' @examples +#' data.frame(buy = dvd$buy, pred1 = runif(20000), pred2 = ifelse(dvd$buy == "yes", 1, 0)) %>% +#' confusion(c("pred1", "pred2"), "buy") %>% +#' summary() +#' @export +summary.confusion <- function(object, dec = 3, ...) { + if (is.character(object)) { + return(object) + } + + cat("Confusion matrix\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + if (!is.empty(object$arr)) { + cat("Arrange :", gsub("\\n", "", object$arr), "\n") + } + if (!is.empty(object$rows)) { + cat("Slice :", gsub("\\n", "", object$rows), "\n") + } + cat("Results for:", object$train, "\n") + cat("Predictors :", paste0(object$pred, collapse = ", "), "\n") + cat("Response :", object$rvar, "\n") + cat("Level :", object$lev, "in", object$rvar, "\n") + cat("Cost:Margin:", object$cost, ":", object$margin, "\n") + cat("Scale :", object$scale, "\n\n") + + dataset <- mutate(object$dataset, profit = round(profit, dec)) + as.data.frame(dataset[, 1:11], stringsAsFactors = FALSE) %>% + format_df(dec = dec, mark = ",") %>% + print(row.names = FALSE) + cat("\n") + + as.data.frame(dataset[, c(1, 2, 13:19)], stringsAsFactors = FALSE) %>% + format_df(dec = dec, mark = ",") %>% + print(row.names = FALSE) +} + +#' Plot method for the confusion matrix +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{confusion}} +#' @param vars Measures to plot, i.e., one or more of "TP", "FP", "TN", "FN", "total", "TPR", "TNR", "precision", "accuracy", "kappa", "profit", "index", "ROME", "contact", "AUC" +#' @param scale_y Free scale in faceted plot of the confusion matrix (TRUE or FALSE) +#' @param size Font size used +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{confusion}} to generate results +#' @seealso \code{\link{summary.confusion}} to summarize results +#' +#' @examples +#' data.frame(buy = dvd$buy, pred1 = runif(20000), pred2 = ifelse(dvd$buy == "yes", 1, 0)) %>% +#' confusion(c("pred1", "pred2"), "buy") %>% +#' plot() +#' @export +plot.confusion <- function(x, vars = c("kappa", "index", "ROME", "AUC"), + scale_y = TRUE, size = 13, ...) { + if (is.character(x) || is.null(x)) { + return(invisible()) + } + dataset <- x$dataset %>% + mutate_at(.vars = c("TN", "FN", "FP", "TP"), .funs = list(~ if (is.numeric(.)) . / total else .)) %>% + gather("Metric", "Value", !!vars, factor_key = TRUE) %>% + mutate(Predictor = factor(Predictor, levels = unique(Predictor))) + + ## what data was used in evaluation? All, Training, Test, or Both + type <- unique(dataset$Type) + + if (scale_y) { + p <- visualize( + dataset, + xvar = "Predictor", yvar = "Value", type = "bar", + facet_row = "Metric", fill = "Type", axes = "scale_y", custom = TRUE + ) + } else { + p <- visualize( + dataset, + xvar = "Predictor", yvar = "Value", type = "bar", + facet_row = "Metric", fill = "Type", custom = TRUE + ) + } + + p <- p + labs( + title = paste0("Classification performance plots (", paste0(type, collapse = ", "), ")"), + y = "", + x = "Predictor", + fill = "" + ) + theme_set(theme_gray(base_size = size)) + + if (length(type) < 2) { + p <- p + theme(legend.position = "none") + } + + p +} + +#' Evaluate uplift for different (binary) classification models +#' +#' @details Evaluate uplift for different (binary) classification models based on predictions. See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param pred Predictions or predictors +#' @param rvar Response variable +#' @param lev The level in the response variable defined as success +#' @param tvar Treatment variable +#' @param tlev The level in the treatment variable defined as the treatment +#' @param qnt Number of bins to create +#' @param cost Cost for each connection (e.g., email or mailing) +#' @param scale Scaling factor to apply to calculations +#' @param margin Margin on each customer purchase +#' @param train Use data from training ("Training"), test ("Test"), both ("Both"), or all data ("All") to evaluate model evalbin +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param arr Expression to arrange (sort) the data on (e.g., "color, desc(price)") +#' @param rows Rows to select from the specified dataset +#' @param envir Environment to extract data from +#' +#' @return A list of results +#' +#' @seealso \code{\link{summary.evalbin}} to summarize results +#' @seealso \code{\link{plot.evalbin}} to plot results +#' +#' @importFrom scales percent +#' +#' @examples +#' data.frame(buy = dvd$buy, pred1 = runif(20000), pred2 = ifelse(dvd$buy == "yes", 1, 0)) %>% +#' evalbin(c("pred1", "pred2"), "buy") %>% +#' str() +#' @export +uplift <- function(dataset, pred, rvar, lev = "", + tvar, tlev = "", + qnt = 10, cost = 1, margin = 2, scale = 1, + train = "All", data_filter = "", arr = "", + rows = NULL, envir = parent.frame()) { + if (!train %in% c("", "All") && is.empty(data_filter) && is.empty(rows)) { + return("**\nFilter or Slice required to differentiate Train and Test. To set a filter or slice go to\nData > View and click the filter checkbox\n**" %>% add_class("evalbin")) + } + + if (is.empty(qnt)) qnt <- 10 + + cnf_tab <- confusion(dataset, pred, rvar, + lev = lev, cost = cost, margin = margin, scale = scale, + train = train, data_filter = data_filter, arr = arr, rows = rows, + envir = envir + ) + + df_name <- if (!is_string(dataset)) deparse(substitute(dataset)) else dataset + + dat_list <- list() + vars <- c(pred, rvar, tvar) + if (train == "Both") { + dat_list[["Training"]] <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, envir = envir) + dat_list[["Test"]] <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, rev = TRUE, envir = envir) + } else if (train == "Training") { + dat_list[["Training"]] <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, envir = envir) + } else if (train == "Test") { + dat_list[["Test"]] <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, rev = TRUE, envir = envir) + } else if (train == "Training") { + } else { + dat_list[["All"]] <- get_data(dataset, vars, envir = envir) + } + + qnt_name <- "bins" + pdat <- list() + pext <- c(All = "", Training = " (train)", Test = " (test)") + + local_xtile <- function(x, treatment, n, rev = TRUE, type = 7) { + breaks <- c(-Inf, quantile(x[treatment], probs = seq(0, 1, by = 1 / n), na.rm = TRUE, type = type)[2:n], Inf) + if (length(breaks) < 2) stop(paste("Insufficient variation in x to construct", n, "breaks"), call. = FALSE) + bins <- .bincode(x, breaks, include.lowest = TRUE) + if (rev) as.integer((n + 1) - bins) else bins + } + + for (i in names(dat_list)) { + lg_list <- list() + pl <- c() + dataset <- dat_list[[i]] + + if (nrow(dataset) == 0) { + return( + paste0("Data for ", i, " has zero rows. Please correct the filter used and try again") %>% + add_class("evalbin") + ) + } + + rv <- dataset[[rvar]] + if (is.factor(rv)) { + levs <- levels(rv) + } else { + levs <- rv %>% + as.character() %>% + as.factor() %>% + levels() + } + + if (lev == "") { + lev <- levs[1] + } else { + if (!lev %in% levs) { + return(add_class("Level provided not found", "evalbin")) + } + } + + ## transformation to TRUE/FALSE depending on the selected level (lev) + dataset[[rvar]] <- dataset[[rvar]] == lev + + tv <- dataset[[tvar]] + if (is.factor(tv)) { + tlevs <- levels(tv) + } else { + tlevs <- tv %>% + as.character() %>% + as.factor() %>% + levels() + } + + if (tlev == "") { + tlev <- tlevs[1] + } else { + if (!tlev %in% tlevs) { + return(add_class("Level provided not found", "uplift")) + } + } + + ## transformation to TRUE/FALSE depending on the selected level (tlev) + dataset[[tvar]] <- dataset[[tvar]] == tlev + + ## tip for summarise_ from http://stackoverflow.com/a/27592077/1974918 + ## put summaries in list so you can print and plot + tot_resp <- sum(dataset[[rvar]]) + tot_obs <- nrow(dataset) + + for (j in seq_along(pred)) { + pred_j <- pred[j] + pname <- paste0(pred_j, pext[i]) + lg_list[[pname]] <- + dataset %>% + select_at(.vars = c(pred_j, tvar, rvar)) %>% + # mutate(!!pred_j := radiant.data::xtile(.data[[pred_j]], n = qnt, rev = TRUE)) %>% + mutate(!!pred_j := local_xtile(.data[[pred_j]], .data[[tvar]], n = qnt, rev = TRUE)) %>% + setNames(c(qnt_name, tvar, rvar)) %>% + group_by_at(.vars = qnt_name) %>% + summarise( + nr_obs = n(), + nr_resp = sum(.data[[rvar]]), + T_resp = sum(.data[[tvar]] & .data[[rvar]]) * scale, + T_n = sum(.data[[tvar]]) * scale, + C_resp = sum(!.data[[tvar]] & .data[[rvar]]) * scale, + C_n = sum(!.data[[tvar]]) * scale, + uplift = T_resp / T_n - C_resp / C_n + ) %>% + mutate( + cum_prop = bins / qnt, + T_resp = cumsum(T_resp), + T_n = cumsum(T_n), + C_resp = cumsum(C_resp), + C_n = cumsum(C_n), + incremental_resp = T_resp - C_resp * T_n / C_n, + incremental_profit = (margin * incremental_resp - cost * T_n), + inc_uplift = incremental_resp / last(T_n) * 100 + ) %>% + mutate(pred = pname) %>% + select(pred, bins, cum_prop, T_resp, T_n, C_resp, C_n, incremental_resp, incremental_profit, inc_uplift, uplift) + } + pdat[[i]] <- bind_rows(lg_list) + } + dataset <- bind_rows(pdat) + dataset$pred <- factor(dataset$pred, levels = unique(dataset$pred)) + + list( + dataset = dataset, df_name = df_name, data_filter = data_filter, + arr = arr, rows = rows, train = train, pred = pred, rvar = rvar, + lev = lev, tvar = tvar, tlev = tlev, qnt = qnt, cost = cost, + margin = margin, scale = scale, cnf_tab = cnf_tab + ) %>% add_class("uplift") +} + +#' Summary method for the uplift function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{evalbin}} +#' @param prn Print full table of measures per model and bin +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{evalbin}} to summarize results +#' @seealso \code{\link{plot.evalbin}} to plot results +#' +#' @examples +#' data.frame(buy = dvd$buy, pred1 = runif(20000), pred2 = ifelse(dvd$buy == "yes", 1, 0)) %>% +#' evalbin(c("pred1", "pred2"), "buy") %>% +#' summary() +#' @export +summary.uplift <- function(object, prn = TRUE, dec = 3, ...) { + if (is.character(object)) { + return(object) + } + + cat("Evaluate uplift for binary response models\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + if (!is.empty(object$arr)) { + cat("Arrange :", gsub("\\n", "", object$arr), "\n") + } + if (!is.empty(object$rows)) { + cat("Slice :", gsub("\\n", "", object$rows), "\n") + } + cat("Results for :", object$train, "\n") + cat("Predictors :", paste0(object$pred, collapse = ", "), "\n") + cat("Response :", object$rvar, "\n") + cat("Level :", object$lev, "in", object$rvar, "\n") + cat("Treatment :", object$tvar, "\n") + cat("Level :", object$tlev, "in", object$tvar, "\n") + cat("Bins :", object$qnt, "\n") + cat("Cost:Margin :", object$cost, ":", object$margin, "\n") + cat("Scale :", object$scale, "\n") + + if (prn) { + as.data.frame(object$dataset, stringsAsFactors = FALSE) %>% + format_df(dec = dec, mark = ",") %>% + print(row.names = FALSE) + } +} + +#' Plot method for the uplift function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{evalbin}} +#' @param plots Plots to return +#' @param size Font size used +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{evalbin}} to generate results +#' @seealso \code{\link{summary.evalbin}} to summarize results +#' +#' @examples +#' data.frame(buy = dvd$buy, pred1 = runif(20000), pred2 = ifelse(dvd$buy == "yes", 1, 0)) %>% +#' evalbin(c("pred1", "pred2"), "buy") %>% +#' plot() +#' @export +plot.uplift <- function(x, plots = c("inc_uplift", "uplift"), + size = 13, shiny = FALSE, + custom = FALSE, ...) { + if (is.character(x) || is.null(x$dataset) || any(is.na(x$dataset$inc_uplift)) || + is.null(plots)) { + return(invisible()) + } + + plot_list <- list() + + if ("inc_uplift" %in% plots) { + dataset <- x$dataset %>% + select(pred, cum_prop, inc_uplift) %>% + group_by(pred) %>% + mutate(obs = 1:n()) + + yend <- tail(dataset[["inc_uplift"]], 1) / 100 + + init <- filter(dataset, obs == 1) + init[, c("cum_prop", "inc_uplift", "obs")] <- 0 + dataset <- bind_rows(init, dataset) %>% + arrange(pred, obs) %>% + mutate(inc_uplift = inc_uplift / 100) + + plot_list[["inc_uplift"]] <- + visualize(dataset, xvar = "cum_prop", yvar = "inc_uplift", type = "line", color = "pred", custom = TRUE) + + geom_point() + + geom_segment(aes(x = 0, y = 0, xend = 1, yend = yend), linewidth = .1, linetype = "dotdash", color = "black") + + labs(y = "Incremental Uplift", x = "Proportion of population targeted") + + scale_y_continuous(labels = scales::percent) + + scale_x_continuous(labels = scales::percent) + } + + if ("uplift" %in% plots) { + dataset <- x$dataset %>% + select(pred, cum_prop, uplift) %>% + group_by(pred) %>% + mutate(obs = 1:n(), Predictor = pred) # , cum_prop = round(cum_prop, 2)) + + plot_list[["uplift"]] <- + ggplot(dataset, aes(x = .data[["cum_prop"]], y = .data[["uplift"]], fill = .data[["Predictor"]])) + + geom_col(position = "dodge") + + labs(y = "Uplift", x = "Proportion of population targeted") + + scale_y_continuous(labels = scales::percent) + + scale_x_continuous(labels = scales::percent) + } + + if ("inc_profit" %in% plots) { + dataset <- x$dataset %>% + select(pred, cum_prop, incremental_profit) %>% + group_by(pred) %>% + mutate(obs = 1:n()) + + init <- filter(dataset, obs == 1) + init[, c("cum_prop", "incremental_profit", "obs")] <- 0 + dataset <- bind_rows(init, dataset) %>% + arrange(pred, obs) + + vlines <- data.frame( + pred = x$cnf_tab$pred, + contact = x$cnf_tab$dataset$contact + ) + default_colors <- scales::hue_pal()(nrow(vlines)) + + plot_list[["inc_profit"]] <- + visualize(dataset, xvar = "cum_prop", yvar = "incremental_profit", type = "line", color = "pred", custom = TRUE) + + geom_point() + + geom_segment(aes(x = 0, y = 0, xend = 1, yend = 0), linewidth = .1, linetype = "dotdash", color = "black") + + ## the next line doesn't work due to: https://github.com/tidyverse/ggplot2/issues/2492 + ## using 'default colors' instead + # geom_vline(data = vlines, aes(xintercept = contact, color = pred), linewidth = 0.5, linetype = "dotdash", show.legend = FALSE) + + geom_vline(xintercept = vlines$contact, color = default_colors, linewidth = 0.5, linetype = "dotdash") + + labs(y = "Incremental Profit", x = "Proportion of population targeted") + + scale_y_continuous(labels = scales::comma) + + scale_x_continuous(labels = scales::percent) + } + + + for (i in names(plot_list)) { + plot_list[[i]] <- plot_list[[i]] + theme_set(theme_gray(base_size = size)) + if (length(x$pred) < 2 && x$train != "Both") { + plot_list[[i]] <- plot_list[[i]] + theme(legend.position = "none") + } else { + plot_list[[i]] <- plot_list[[i]] + labs(color = "Predictor") + } + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = 1) %>% + (function(x) if (shiny) x else print(x)) + } + } +} + +#' Area Under the RO Curve (AUC) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +#' +#' @param pred Prediction or predictor +#' @param rvar Response variable +#' @param lev The level in the response variable defined as success +#' +#' @return AUC statistic +#' +#' @seealso \code{\link{evalbin}} to calculate results +#' @seealso \code{\link{summary.evalbin}} to summarize results +#' @seealso \code{\link{plot.evalbin}} to plot results +#' +#' @examples +#' auc(runif(20000), dvd$buy, "yes") +#' auc(ifelse(dvd$buy == "yes", 1, 0), dvd$buy, "yes") +#' @export +auc <- function(pred, rvar, lev) { + ## adapted from https://stackoverflow.com/a/50202118/1974918 + if (!is.logical(rvar)) { + lev <- check_lev(rvar, lev) + rvar <- rvar == lev + } + n1 <- sum(!rvar) + n2 <- sum(rvar) + U <- sum(rank(pred)[!rvar]) - n1 * (n1 + 1) / 2 + wt <- U / n1 / n2 + ifelse(wt < .5, 1 - wt, wt) +} + +#' Relative Information Gain (RIG) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +#' +#' @param pred Prediction or predictor +#' @param rvar Response variable +#' @param lev The level in the response variable defined as success +#' @param crv Correction value to avoid log(0) +#' @param na.rm Logical that indicates if missing values should be removed (TRUE) or not (FALSE) +#' +#' @return RIG statistic +#' +#' @seealso \code{\link{evalbin}} to calculate results +#' @seealso \code{\link{summary.evalbin}} to summarize results +#' @seealso \code{\link{plot.evalbin}} to plot results +#' +#' @examples +#' rig(runif(20000), dvd$buy, "yes") +#' rig(ifelse(dvd$buy == "yes", 1, 0), dvd$buy, "yes") +#' @export +rig <- function(pred, rvar, lev, crv = 0.0000001, na.rm = TRUE) { + if (!is.logical(rvar)) { + lev <- check_lev(rvar, lev) + rvar <- rvar == lev + } + mo <- mean(rvar, na.rm = na.rm) + pred <- pmin(pmax(pred, crv, na.rm = na.rm), 1 - crv, na.rm = na.rm) + llpred <- mean(-log(pred) * rvar - log(1 - pred) * (1 - rvar)) + llbase <- mean(-log(mo) * rvar - log(1 - mo) * (1 - rvar)) + round((1 - llpred / llbase), 6) +} + +#' Calculate Profit based on cost:margin ratio +#' +#' @param pred Prediction or predictor +#' @param rvar Response variable +#' @param lev The level in the response variable defined as success +#' @param cost Cost per treatment (e.g., mailing costs) +#' @param margin Margin, or benefit, per 'success' (e.g., customer purchase). A cost:margin ratio of 1:2 implies +#' the cost of False Positive are equivalent to the benefits of a True Positive +#' +#' @return profit +#' +#' @examples +#' profit(runif(20000), dvd$buy, "yes", cost = 1, margin = 2) +#' profit(ifelse(dvd$buy == "yes", 1, 0), dvd$buy, "yes", cost = 1, margin = 20) +#' profit(ifelse(dvd$buy == "yes", 1, 0), dvd$buy) +#' @export +profit <- function(pred, rvar, lev, cost = 1, margin = 2) { + if (!is.logical(rvar)) { + lev <- check_lev(rvar, lev) + rvar <- rvar == lev + } + break_even <- cost / margin + TP <- rvar & (pred > break_even) + FP <- !rvar & (pred > break_even) + margin * sum(TP) - cost * sum(TP, FP) +} + +## Check that a relevant value for 'lev' is available +# Examples +# check_lev(1:10, 1) +# check_lev(letters, "a") +# check_lev(c(TRUE, FALSE), TRUE) +# check_lev(c(TRUE, FALSE)) +# check_lev(factor(letters)) +# check_lev(letters) +# check_lev(factor(letters), 1) +check_lev <- function(rvar, lev) { + if (missing(lev)) { + if (is.factor(rvar)) { + lev <- levels(rvar)[1] + } else if (is.logical(rvar)) { + lev <- TRUE + } else { + stop("Unless rvar is of type factor or logical you must provide the level in rvar to evaluate") + } + } else { + if (length(lev) > 1) { + stop("lev must have length 1 but is of length", length(lev)) + } else if (!lev %in% rvar) { + cat("rvar:", head(as.character(rvar))) + cat("\nlev:", head(lev), "\n") + stop("lev must be an element of rvar") + } + # stopifnot(length(lev) == 1, lev %in% rvar | is.logical(lev)) + } + lev +} diff --git a/radiant.model/R/evalreg.R b/radiant.model/R/evalreg.R new file mode 100644 index 0000000000000000000000000000000000000000..5ecbbb4d1df62f70645f1b2da5ca38e14feaf560 --- /dev/null +++ b/radiant.model/R/evalreg.R @@ -0,0 +1,190 @@ +#' Evaluate the performance of different regression models +#' +#' @details Evaluate different regression models based on predictions. See \url{https://radiant-rstats.github.io/docs/model/evalreg.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param pred Predictions or predictors +#' @param rvar Response variable +#' @param train Use data from training ("Training"), test ("Test"), both ("Both"), or all data ("All") to evaluate model evalreg +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "training == 1") +#' @param arr Expression to arrange (sort) the data on (e.g., "color, desc(price)") +#' @param rows Rows to select from the specified dataset +#' @param envir Environment to extract data from +#' +#' @return A list of results +#' +#' @seealso \code{\link{summary.evalreg}} to summarize results +#' @seealso \code{\link{plot.evalreg}} to plot results +#' +#' @examples +#' data.frame(price = diamonds$price, pred1 = rnorm(3000), pred2 = diamonds$price) %>% +#' evalreg(pred = c("pred1", "pred2"), "price") %>% +#' str() +#' +#' @export +evalreg <- function(dataset, pred, rvar, train = "All", + data_filter = "", arr = "", rows = NULL, envir = parent.frame()) { + if (!train %in% c("", "All") && is.empty(data_filter) && is.empty(rows)) { + return("**\nFilter or Slice required. To set a filter or slice go to\nData > View and click the filter checkbox\n**" %>% add_class("evalreg")) + } + + # Add an option to exponentiate predictions in case of log regression + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + + dat_list <- list() + vars <- c(pred, rvar) + if (train == "Both") { + dat_list[["Training"]] <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, envir = envir) + dat_list[["Test"]] <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, rev = TRUE, envir = envir) + } else if (train == "Training") { + dat_list[["Training"]] <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, envir = envir) + } else if (train == "Test" | train == "Validation") { + dat_list[["Test"]] <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, rev = TRUE, envir = envir) + } else { + dat_list[["All"]] <- get_data(dataset, vars, envir = envir) + } + + pdat <- list() + for (i in names(dat_list)) { + dat <- dat_list[[i]] + rv <- dat[[rvar]] + + ## see http://stackoverflow.com/a/35617817/1974918 about extracting a row + ## from a tbl_df + pdat[[i]] <- data.frame( + Type = rep(i, length(pred)), + Predictor = pred, + n = nrow(dat[pred]), + Rsq = cor(rv, select_at(dat, pred))^2 %>% .[1, ], + RMSE = summarise_at(dat, .vars = pred, .funs = ~ sqrt(mean((rv - .)^2, na.rm = TRUE))) %>% unlist(), + MAE = summarise_at(dat, .vars = pred, .funs = ~ mean(abs(rv - .), na.rm = TRUE)) %>% unlist(), + stringsAsFactors = FALSE + ) + } + + dat <- bind_rows(pdat) %>% as.data.frame(stringsAsFactors = FALSE) + rm(pdat, dat_list, i) + + as.list(environment()) %>% add_class("evalreg") +} + +#' Summary method for the evalreg function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/evalreg.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{evalreg}} +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{evalreg}} to summarize results +#' @seealso \code{\link{plot.evalreg}} to plot results +#' +#' @examples +#' data.frame(price = diamonds$price, pred1 = rnorm(3000), pred2 = diamonds$price) %>% +#' evalreg(pred = c("pred1", "pred2"), "price") %>% +#' summary() +#' +#' @export +summary.evalreg <- function(object, dec = 3, ...) { + if (is.character(object)) { + return(object) + } + cat("Evaluate predictions for regression models\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + if (!is.empty(object$arr)) { + cat("Arrange :", gsub("\\n", "", object$arr), "\n") + } + if (!is.empty(object$rows)) { + cat("Slice :", gsub("\\n", "", object$rows), "\n") + } + cat("Results for :", object$train, "\n") + cat("Predictors :", paste0(object$pred, collapse = ", "), "\n") + cat("Response :", object$rvar, "\n\n") + format_df(object$dat, dec = dec, mark = ",") %>% + print(row.names = FALSE) +} + +#' Plot method for the evalreg function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/evalreg.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{evalreg}} +#' @param vars Measures to plot, i.e., one or more of "Rsq", "RMSE", "MAE" +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{evalreg}} to generate results +#' @seealso \code{\link{summary.evalreg}} to summarize results +#' +#' @examples +#' data.frame(price = diamonds$price, pred1 = rnorm(3000), pred2 = diamonds$price) %>% +#' evalreg(pred = c("pred1", "pred2"), "price") %>% +#' plot() +#' +#' @export +plot.evalreg <- function(x, vars = c("Rsq", "RMSE", "MAE"), ...) { + if (is.character(x) || is.null(x)) { + return(invisible()) + } + + dat <- gather(x$dat, "Metric", "Value", !!vars, factor_key = TRUE) %>% + mutate(Predictor = factor(Predictor, levels = unique(Predictor))) + + ## what data was used in evaluation? All, Training, Test, or Both + type <- unique(dat$Type) + + p <- visualize( + dat, + xvar = "Predictor", + yvar = "Value", + type = "bar", + facet_row = "Metric", + fill = "Type", + axes = "scale_y", + custom = TRUE + ) + + labs( + title = glue('Regression performance plots ({glue_collapse(type, ", ")})'), + y = "", + x = "Predictor", + fill = "" + ) + + if (length(type) < 2) { + p + theme(legend.position = "none") + } else { + p + } +} + +#' R-squared +#' +#' @param pred Prediction (vector) +#' @param rvar Response (vector) +#' +#' @return R-squared +#' +#' @export +Rsq <- function(pred, rvar) cor(pred, rvar)^2 + +#' Root Mean Squared Error +#' +#' @param pred Prediction (vector) +#' @param rvar Response (vector) +#' +#' @return Root Mean Squared Error +#' +#' @export +RMSE <- function(pred, rvar) sqrt(mean(unlist((pred - rvar)^2))) + +#' Mean Absolute Error +#' +#' @param pred Prediction (vector) +#' @param rvar Response (vector) +#' +#' @return Mean Absolute Error +#' +#' @export +MAE <- function(pred, rvar) mean(unlist(abs(pred - rvar))) diff --git a/radiant.model/R/gbt.R b/radiant.model/R/gbt.R new file mode 100644 index 0000000000000000000000000000000000000000..0e82da35c24017b056abc2393dc245a4c9935827 --- /dev/null +++ b/radiant.model/R/gbt.R @@ -0,0 +1,726 @@ +#' Gradient Boosted Trees using XGBoost +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/gbt.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param rvar The response variable in the model +#' @param evar Explanatory variables in the model +#' @param type Model type (i.e., "classification" or "regression") +#' @param lev Level to use as the first column in prediction output +#' @param max_depth Maximum 'depth' of tree +#' @param learning_rate Learning rate (eta) +#' @param min_split_loss Minimal improvement (gamma) +#' @param nrounds Number of trees to create +#' @param min_child_weight Minimum number of instances allowed in each node +#' @param subsample Subsample ratio of the training instances (0-1) +#' @param early_stopping_rounds Early stopping rule +#' @param nthread Number of parallel threads to use. Defaults to 12 if available +#' @param wts Weights to use in estimation +#' @param seed Random seed to use as the starting point +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param arr Expression to arrange (sort) the data on (e.g., "color, desc(price)") +#' @param rows Rows to select from the specified dataset +#' @param envir Environment to extract data from +#' @param ... Further arguments to pass to xgboost +#' +#' @return A list with all variables defined in gbt as an object of class gbt +#' +#' @examples +#' \dontrun{ +#' gbt(titanic, "survived", c("pclass", "sex"), lev = "Yes") %>% summary() +#' gbt(titanic, "survived", c("pclass", "sex")) %>% str() +#' } +#' gbt( +#' titanic, "survived", c("pclass", "sex"), lev = "Yes", +#' early_stopping_rounds = 0, nthread = 1 +#' ) %>% summary() +#' gbt( +#' titanic, "survived", c("pclass", "sex"), +#' early_stopping_rounds = 0, nthread = 1 +#' ) %>% str() +#' gbt( +#' titanic, "survived", c("pclass", "sex"), +#' eval_metric = paste0("error@", 0.5 / 6), nthread = 1 +#' ) %>% str() +#' gbt( +#' diamonds, "price", c("carat", "clarity"), type = "regression", nthread = 1 +#' ) %>% summary() +#' +#' @seealso \code{\link{summary.gbt}} to summarize results +#' @seealso \code{\link{plot.gbt}} to plot results +#' @seealso \code{\link{predict.gbt}} for prediction +#' +#' @importFrom xgboost xgboost xgb.importance +#' @importFrom lubridate is.Date +#' +#' @export +gbt <- function(dataset, rvar, evar, type = "classification", lev = "", + max_depth = 6, learning_rate = 0.3, min_split_loss = 0, + min_child_weight = 1, subsample = 1, + nrounds = 100, early_stopping_rounds = 10, + nthread = 12, wts = "None", seed = NA, + data_filter = "", arr = "", rows = NULL, + envir = parent.frame(), ...) { + if (rvar %in% evar) { + return("Response variable contained in the set of explanatory variables.\nPlease update model specification." %>% + add_class("gbt")) + } + + vars <- c(rvar, evar) + + if (is.empty(wts, "None")) { + wts <- NULL + } else if (is_string(wts)) { + wtsname <- wts + vars <- c(rvar, evar, wtsname) + } + + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, envir = envir) %>% + mutate_if(is.Date, as.numeric) + nr_obs <- nrow(dataset) + + if (!is.empty(wts, "None")) { + if (exists("wtsname")) { + wts <- dataset[[wtsname]] + dataset <- select_at(dataset, .vars = base::setdiff(colnames(dataset), wtsname)) + } + if (length(wts) != nrow(dataset)) { + return( + paste0("Length of the weights variable is not equal to the number of rows in the dataset (", format_nr(length(wts), dec = 0), " vs ", format_nr(nrow(dataset), dec = 0), ")") %>% + add_class("gbt") + ) + } + } + + not_vary <- colnames(dataset)[summarise_all(dataset, does_vary) == FALSE] + if (length(not_vary) > 0) { + return(paste0("The following variable(s) show no variation. Please select other variables.\n\n** ", paste0(not_vary, collapse = ", "), " **") %>% + add_class("gbt")) + } + + rv <- dataset[[rvar]] + + if (type == "classification") { + if (lev == "") { + if (is.factor(rv)) { + lev <- levels(rv)[1] + } else { + lev <- as.character(rv) %>% + as.factor() %>% + levels() %>% + .[1] + } + } + if (lev != levels(rv)[1]) { + dataset[[rvar]] <- relevel(dataset[[rvar]], lev) + } + } + + vars <- evar + ## in case : is used + if (length(vars) < (ncol(dataset) - 1)) { + vars <- evar <- colnames(dataset)[-1] + } + + gbt_input <- list( + max_depth = max_depth, + learning_rate = learning_rate, + min_split_loss = min_split_loss, + nrounds = nrounds, + min_child_weight = min_child_weight, + subsample = subsample, + early_stopping_rounds = early_stopping_rounds, + nthread = nthread + ) + + ## checking for extra args + extra_args <- list(...) + extra_args_names <- names(extra_args) + check_args <- function(arg, default, inp = gbt_input) { + if (!arg %in% extra_args_names) inp[[arg]] <- default + inp + } + + if (type == "classification") { + gbt_input <- check_args("objective", "binary:logistic") + gbt_input <- check_args("eval_metric", "auc") + dty <- as.integer(dataset[[rvar]] == lev) + } else { + gbt_input <- check_args("objective", "reg:squarederror") + gbt_input <- check_args("eval_metric", "rmse") + dty <- dataset[[rvar]] + } + + ## adding data + dtx <- onehot(dataset[, -1, drop = FALSE])[, -1, drop = FALSE] + gbt_input <- c(gbt_input, list(data = dtx, label = dty), ...) + + ## based on https://stackoverflow.com/questions/14324096/setting-seed-locally-not-globally-in-r/14324316#14324316 + seed <- gsub("[^0-9]", "", seed) + if (!is.empty(seed)) { + if (exists(".Random.seed")) { + gseed <- .Random.seed + on.exit(.Random.seed <<- gseed) + } + set.seed(seed) + } + + ## capturing the iteration history + output <- capture.output(model <<- do.call(xgboost::xgboost, gbt_input)) + + ## adding residuals for regression models + if (type == "regression") { + model$residuals <- dataset[[rvar]] - predict(model, dtx) + } else { + model$residuals <- NULL + } + + ## adding feature importance information + ## replaced by premutation importance + # model$importance <- xgboost::xgb.importance(model = model) + + ## gbt model object does not include the data by default + model$model <- dataset + + rm(dataset, dty, dtx, rv, envir) ## dataset not needed elsewhere + gbt_input$data <- gbt_input$label <- NULL + + ## needed to work with prediction functions + check <- "" + + as.list(environment()) %>% add_class(c("gbt", "model")) +} + +#' Summary method for the gbt function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/gbt.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{gbt}} +#' @param prn Print iteration history +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- gbt( +#' titanic, "survived", c("pclass", "sex"), +#' early_stopping_rounds = 0, nthread = 1 +#' ) +#' summary(result) +#' @seealso \code{\link{gbt}} to generate results +#' @seealso \code{\link{plot.gbt}} to plot results +#' @seealso \code{\link{predict.gbt}} for prediction +#' +#' @export +summary.gbt <- function(object, prn = TRUE, ...) { + if (is.character(object)) { + return(object) + } + cat("Gradient Boosted Trees (XGBoost)\n") + if (object$type == "classification") { + cat("Type : Classification") + } else { + cat("Type : Regression") + } + cat("\nData :", object$df_name) + if (!is.empty(object$data_filter)) { + cat("\nFilter :", gsub("\\n", "", object$data_filter)) + } + if (!is.empty(object$arr)) { + cat("\nArrange :", gsub("\\n", "", object$arr)) + } + if (!is.empty(object$rows)) { + cat("\nSlice :", gsub("\\n", "", object$rows)) + } + cat("\nResponse variable :", object$rvar) + if (object$type == "classification") { + cat("\nLevel :", object$lev, "in", object$rvar) + } + cat("\nExplanatory variables:", paste0(object$evar, collapse = ", "), "\n") + if (length(object$wtsname) > 0) { + cat("Weights used :", object$wtsname, "\n") + } + cat("Max depth :", object$max_depth, "\n") + cat("Learning rate (eta) :", object$learning_rate, "\n") + cat("Min split loss :", object$min_split_loss, "\n") + cat("Min child weight :", object$min_child_weight, "\n") + cat("Sub-sample :", object$subsample, "\n") + cat("Nr of rounds (trees) :", object$nrounds, "\n") + cat("Early stopping rounds:", object$early_stopping_rounds, "\n") + if (length(object$extra_args)) { + extra_args <- deparse(object$extra_args) %>% + sub("list\\(", "", .) %>% + sub("\\)$", "", .) %>% + sub(" {2,}", " ", .) + cat("Additional arguments :", extra_args, "\n") + } + if (!is.empty(object$seed)) { + cat("Seed :", object$seed, "\n") + } + + if (!is.empty(object$wts, "None") && (length(unique(object$wts)) > 2 || min(object$wts) >= 1)) { + cat("Nr obs :", format_nr(sum(object$wts), dec = 0), "\n") + } else { + cat("Nr obs :", format_nr(object$nr_obs, dec = 0), "\n") + } + + if (isTRUE(prn)) { + cat("\nIteration history:\n\n") + ih <- object$output[c(-2, -3)] + if (length(ih) > 20) ih <- c(head(ih, 10), "...", tail(ih, 10)) + cat(paste0(ih, collapse = "\n")) + } +} + +#' Plot method for the gbt function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/gbt.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{gbt}} +#' @param plots Plots to produce for the specified Gradient Boosted Tree model. Use "" to avoid showing any plots (default). Options are ... +#' @param nrobs Number of data points to show in scatter plots (-1 for all) +#' @param incl Which variables to include in a coefficient plot or PDP plot +#' @param incl_int Which interactions to investigate in PDP plots +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. +#' This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). +#' See examples and \url{https://ggplot2.tidyverse.org} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- gbt( +#' titanic, "survived", c("pclass", "sex"), +#' early_stopping_rounds = 0, nthread = 1 +#' ) +#' plot(result) +#' +#' @seealso \code{\link{gbt}} to generate results +#' @seealso \code{\link{summary.gbt}} to summarize results +#' @seealso \code{\link{predict.gbt}} for prediction +#' +#' @importFrom pdp partial +#' @importFrom rlang .data +#' +#' @export +plot.gbt <- function(x, plots = "", nrobs = Inf, + incl = NULL, incl_int = NULL, + shiny = FALSE, custom = FALSE, ...) { + if (is.character(x) || !inherits(x$model, "xgb.Booster")) { + return(x) + } + plot_list <- list() + ncol <- 1 + + if (x$type == "regression" && "dashboard" %in% plots) { + plot_list <- plot.regress(x, plots = "dashboard", lines = "line", nrobs = nrobs, custom = TRUE) + ncol <- 2 + } + + if ("pdp" %in% plots) { + ncol <- 2 + if (length(incl) == 0 && length(incl_int) == 0) { + return("Select one or more variables to generate Partial Dependence Plots") + } + mod_dat <- x$model$model[, -1, drop = FALSE] + dtx <- onehot(mod_dat)[, -1, drop = FALSE] + for (pn in incl) { + if (is.factor(mod_dat[[pn]])) { + fn <- paste0(pn, levels(mod_dat[[pn]]))[-1] + effects <- rep(NA, length(fn)) + nr <- length(fn) + for (i in seq_len(nr)) { + seed <- x$seed + dtx_cat <- dtx + dtx_cat[, setdiff(fn, fn[i])] <- 0 + pdi <- pdp::partial( + x$model, + pred.var = fn[i], plot = FALSE, + prob = x$type == "classification", train = dtx_cat + ) + effects[i] <- pdi[pdi[[1]] > 0, 2] + } + pgrid <- as.data.frame(matrix(0, ncol = nr)) + colnames(pgrid) <- fn + base <- pdp::partial( + x$model, + pred.var = fn, + pred.grid = pgrid, plot = FALSE, + prob = x$type == "classification", train = dtx + )[1, "yhat"] + pd <- data.frame(label = levels(mod_dat[[pn]]), yhat = c(base, effects)) %>% + mutate(label = factor(label, levels = label)) + colnames(pd)[1] <- pn + plot_list[[pn]] <- ggplot(pd, aes(x = .data[[pn]], y = .data$yhat)) + + geom_point() + + labs(y = NULL) + } else { + plot_list[[pn]] <- pdp::partial( + x$model, + pred.var = pn, plot = TRUE, rug = TRUE, + prob = x$type == "classification", plot.engine = "ggplot2", + train = dtx + ) + labs(y = NULL) + } + } + for (pn_lab in incl_int) { + iint <- strsplit(pn_lab, ":")[[1]] + df <- mod_dat[, iint] + is_num <- sapply(df, is.numeric) + if (sum(is_num) == 2) { + # 2 numeric variables + cn <- colnames(df) + num_range1 <- df[[cn[1]]] %>% + (function(x) seq(min(x), max(x), length.out = 20)) %>% + paste0(collapse = ", ") + num_range2 <- df[[cn[2]]] %>% + (function(x) seq(min(x), max(x), length.out = 20)) %>% + paste0(collapse = ", ") + pred <- predict(x, pred_cmd = glue("{cn[1]} = c({num_range1}), {cn[2]} = c({num_range2})")) + plot_list[[pn_lab]] <- ggplot(pred, aes(x = .data[[cn[1]]], y = .data[[cn[2]]], fill = .data[["Prediction"]])) + + geom_tile() + } else if (sum(is_num) == 0) { + # 2 categorical variables + cn <- colnames(df) + pred <- predict(x, pred_cmd = glue("{cn[1]} = levels({cn[1]}), {cn[2]} = levels({cn[2]})")) + plot_list[[pn_lab]] <- visualize( + pred, + xvar = cn[1], yvar = "Prediction", type = "line", color = cn[2], custom = TRUE + ) + labs(y = NULL) + } else if (sum(is_num) == 1) { + # 1 categorical and one numeric variable + cn <- colnames(df) + cn_fct <- cn[!is_num] + cn_num <- cn[is_num] + num_range <- df[[cn_num[1]]] %>% + (function(x) seq(min(x), max(x), length.out = 20)) %>% + paste0(collapse = ", ") + pred <- predict(x, pred_cmd = glue("{cn_num[1]} = c({num_range}), {cn_fct} = levels({cn_fct})")) + plot_list[[pn_lab]] <- plot(pred, xvar = cn_num[1], color = cn_fct, custom = TRUE) + } + } + } + + if ("pred_plot" %in% plots) { + ncol <- 2 + if (length(incl) > 0 | length(incl_int) > 0) { + plot_list <- pred_plot(x, plot_list, incl, incl_int, ...) + } else { + return("Select one or more variables to generate Prediction plots") + } + } + + if ("vip" %in% plots) { + ncol <- 1 + if (length(x$evar) < 2) { + message("Model must contain at least 2 explanatory variables (features). Permutation Importance plot cannot be generated") + } else { + vi_scores <- varimp(x) + plot_list[["vip"]] <- + visualize(vi_scores, yvar = "Importance", xvar = "Variable", type = "bar", custom = TRUE) + + labs( + title = "Permutation Importance", + x = NULL, + y = ifelse(x$type == "regression", "Importance (R-square decrease)", "Importance (AUC decrease)") + ) + + coord_flip() + + theme(axis.text.y = element_text(hjust = 0)) + } + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = ncol) %>% + (function(x) if (isTRUE(shiny)) x else print(x)) + } + } +} + +#' Predict method for the gbt function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/gbt.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{gbt}} +#' @param pred_data Provide the dataframe to generate predictions (e.g., diamonds). The dataset must contain all columns used in the estimation +#' @param pred_cmd Generate predictions using a command. For example, `pclass = levels(pclass)` would produce predictions for the different levels of factor `pclass`. To add another variable, create a vector of prediction strings, (e.g., c('pclass = levels(pclass)', 'age = seq(0,100,20)') +#' @param dec Number of decimals to show +#' @param envir Environment to extract data from +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- gbt( +#' titanic, "survived", c("pclass", "sex"), +#' early_stopping_rounds = 2, nthread = 1 +#' ) +#' predict(result, pred_cmd = "pclass = levels(pclass)") +#' result <- gbt(diamonds, "price", "carat:color", type = "regression", nthread = 1) +#' predict(result, pred_cmd = "carat = 1:3") +#' predict(result, pred_data = diamonds) %>% head() +#' @seealso \code{\link{gbt}} to generate the result +#' @seealso \code{\link{summary.gbt}} to summarize results +#' +#' @export +predict.gbt <- function(object, pred_data = NULL, pred_cmd = "", + dec = 3, envir = parent.frame(), ...) { + if (is.character(object)) { + return(object) + } + + ## ensure you have a name for the prediction dataset + if (is.data.frame(pred_data)) { + df_name <- deparse(substitute(pred_data)) + } else { + df_name <- pred_data + } + + pfun <- function(model, pred, se, conf_lev) { + ## ensure the factor levels in the prediction data are the + ## same as in the data used for estimation + est_data <- model$model[, -1, drop = FALSE] + for (i in colnames(pred)) { + if (is.factor(est_data[[i]])) { + pred[[i]] <- factor(pred[[i]], levels = levels(est_data[[i]])) + } + } + pred <- onehot(pred[, colnames(est_data), drop = FALSE])[, -1, drop = FALSE] + ## for testing purposes + # pred <- model$model[, -1, drop = FALSE] + pred_val <- try(sshhr(predict(model, pred)), silent = TRUE) + if (!inherits(pred_val, "try-error")) { + pred_val %<>% as.data.frame(stringsAsFactors = FALSE) %>% + select(1) %>% + set_colnames("Prediction") + } + + pred_val + } + + predict_model(object, pfun, "gbt.predict", pred_data, pred_cmd, conf_lev = 0.95, se = FALSE, dec, envir = envir) %>% + set_attr("radiant_pred_data", df_name) +} + +#' Print method for predict.gbt +#' +#' @param x Return value from prediction method +#' @param ... further arguments passed to or from other methods +#' @param n Number of lines of prediction results to print. Use -1 to print all lines +#' +#' @export +print.gbt.predict <- function(x, ..., n = 10) { + print_predict_model(x, ..., n = n, header = "Gradiant Boosted Trees") +} + +#' Cross-validation for Gradient Boosted Trees +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/gbt.html} for an example in Radiant +#' +#' @param object Object of type "gbt" or "ranger" +#' @param K Number of cross validation passes to use (aka nfold) +#' @param repeats Repeated cross validation +#' @param params List of parameters (see XGBoost documentation) +#' @param nrounds Number of trees to create +#' @param early_stopping_rounds Early stopping rule +#' @param nthread Number of parallel threads to use. Defaults to 12 if available +#' @param train An optional xgb.DMatrix object containing the original training data. Not needed when using Radiant's gbt function +#' @param type Model type ("classification" or "regression") +#' @param trace Print progress +#' @param seed Random seed to use as the starting point +#' @param maximize When a custom function is used, xgb.cv requires the user indicate if the function output should be maximized (TRUE) or minimized (FALSE) +#' @param fun Function to use for model evaluation (i.e., auc for classification and RMSE for regression) +#' @param ... Additional arguments to be passed to 'fun' +#' +#' @return A data.frame sorted by the mean of the performance metric +#' +#' @seealso \code{\link{gbt}} to generate an initial model that can be passed to cv.gbt +#' @seealso \code{\link{Rsq}} to calculate an R-squared measure for a regression +#' @seealso \code{\link{RMSE}} to calculate the Root Mean Squared Error for a regression +#' @seealso \code{\link{MAE}} to calculate the Mean Absolute Error for a regression +#' @seealso \code{\link{auc}} to calculate the area under the ROC curve for classification +#' @seealso \code{\link{profit}} to calculate profits for classification at a cost/margin threshold +#' +#' @importFrom shiny getDefaultReactiveDomain withProgress incProgress +#' +#' @examples +#' \dontrun{ +#' result <- gbt(dvd, "buy", c("coupon", "purch", "last")) +#' cv.gbt(result, params = list(max_depth = 1:6)) +#' cv.gbt(result, params = list(max_depth = 1:6), fun = "logloss") +#' cv.gbt( +#' result, +#' params = list(learning_rate = seq(0.1, 1.0, 0.1)), +#' maximize = TRUE, fun = profit, cost = 1, margin = 5 +#' ) +#' result <- gbt(diamonds, "price", c("carat", "color", "clarity"), type = "regression") +#' cv.gbt(result, params = list(max_depth = 1:2, min_child_weight = 1:2)) +#' cv.gbt(result, params = list(learning_rate = seq(0.1, 0.5, 0.1)), fun = Rsq, maximize = TRUE) +#' cv.gbt(result, params = list(learning_rate = seq(0.1, 0.5, 0.1)), fun = MAE, maximize = FALSE) +#' } +#' +#' @export +cv.gbt <- function(object, K = 5, repeats = 1, params = list(), + nrounds = 500, early_stopping_rounds = 10, nthread = 12, + train = NULL, type = "classification", + trace = TRUE, seed = 1234, maximize = NULL, fun, ...) { + if (inherits(object, "gbt")) { + dv <- object$rvar + dataset <- object$model$model + dtx <- onehot(dataset[, -1, drop = FALSE])[, -1, drop = FALSE] + type <- object$type + if (type == "classification") { + objective <- "binary:logistic" + dty <- as.integer(dataset[[dv]] == object$lev) + } else { + objective <- "reg:squarederror" + dty <- dataset[[dv]] + } + train <- xgboost::xgb.DMatrix(data = dtx, label = dty) + params_base <- object$model$params + if (is.empty(params_base[["eval_metric"]])) { + params_base[["eval_metric"]] <- object$extra_args[["eval_metric"]] + } + if (is.empty(params_base[["maximize"]])) { + params_base[["maximize"]] <- object$extra_args[["maximize"]] + } + } else if (!inherits(object, "xgb.Booster")) { + stop("The model object does not seems to be a Gradient Boosted Tree") + } else { + if (!inherits(train, "xgb.DMatrix")) { + train <- eval(object$call[["data"]]) + } + params_base <- object$params + } + if (!inherits(train, "xgb.DMatrix")) { + stop("Could not access data. Please use the 'train' argument to pass along a matrix created using xgboost::xgb.DMatrix") + } + + params_base[c("nrounds", "nthread", "silent")] <- NULL + for (n in names(params)) { + params_base[[n]] <- params[[n]] + } + params <- params_base + if (is.empty(maximize)) { + maximize <- params$maximize + } + + if (missing(fun)) { + if (type == "classification") { + if (length(params$eval_metric) == 0) { + fun <- params$eval_metric <- "auc" + } else if (is.character(params$eval_metric)) { + fun <- params$eval_metric + } else { + fun <- list("custom" = params$eval_metric) + } + } else { + if (length(params$eval_metric) == 0) { + fun <- params$eval_metric <- "rmse" + } else if (is.character(params$eval_metric)) { + fun <- params$eval_metric + } else { + fun <- list("custom" = params$eval_metric) + } + } + } + + if (length(shiny::getDefaultReactiveDomain()) > 0) { + trace <- FALSE + incProgress <- shiny::incProgress + withProgress <- shiny::withProgress + } else { + incProgress <- function(...) {} + withProgress <- function(...) list(...)[["expr"]] + } + + ## setting up a customer evaluation function + if (is.function(fun)) { + if (missing(...)) { + if (type == "classification") { + fun_wrapper <- function(preds, dtrain) { + labels <- xgboost::getinfo(dtrain, "label") + value <- fun(preds, labels, 1) + list(metric = cn, value = value) + } + } else { + fun_wrapper <- function(preds, dtrain) { + labels <- xgboost::getinfo(dtrain, "label") + value <- fun(preds, labels) + list(metric = cn, value = value) + } + } + } else { + if (type == "classification") { + fun_wrapper <- function(preds, dtrain) { + labels <- xgboost::getinfo(dtrain, "label") + value <- fun(preds, labels, 1, ...) + list(metric = cn, value = value) + } + } else { + fun_wrapper <- function(preds, dtrain) { + labels <- xgboost::getinfo(dtrain, "label") + value <- fun(preds, labels, ...) + list(metric = cn, value = value) + } + } + } + cn <- deparse(substitute(fun)) + if (grepl(":{2,3}", cn)) cn <- sub("^.+:{2,3}", "", cn) + params$eval_metric <- cn + } else if (is.list(fun)) { + fun_wrapper <- fun[["custom"]] + params$eval_metric <- "custom" + } else { + fun_wrapper <- params$eval_metric <- fun + } + + tf <- tempfile() + tune_grid <- expand.grid(params) + nitt <- nrow(tune_grid) + withProgress(message = "Running cross-validation (gbt)", value = 0, { + out <- list() + for (i in seq_len(nitt)) { + cv_params <- tune_grid[i, ] + if (!is.empty(cv_params$nrounds)) { + nrounds <- cv_params$nrounds + cv_params$nrounds <- NULL + } + if (trace) { + cat("Working on", paste0(paste(colnames(cv_params), "=", cv_params), collapse = ", "), "\n") + } + for (j in seq_len(repeats)) { + set.seed(seed) + sink(tf) ## avoiding messages from xgboost::xgb.cv + cv_params_tmp <- cv_params + for (nm in c("eval_metric", "maximize", "early_stopping_rounds", "nthread")) { + cv_params_tmp[[nm]] <- NULL + } + model <- try(xgboost::xgb.cv( + params = as.list(cv_params_tmp), + data = train, + nfold = K, + print_every_n = 500, + eval_metric = fun_wrapper, + maximize = maximize, + early_stopping_rounds = early_stopping_rounds, + nrounds = nrounds, + nthread = nthread + )) + sink() + if (inherits(model, "try-error")) { + stop(model) + } + out[[paste0(i, "-", j)]] <- as.data.frame(c( + nrounds = nrounds, best_iteration = model$best_iteration, + model$evaluation_log[model$best_iteration, -1], cv_params + )) + } + incProgress(1 / nitt, detail = paste("\nCompleted run", i, "out of", nitt)) + } + }) + + out <- bind_rows(out) + if (type == "classification") { + out[order(out[[5]], decreasing = TRUE), ] + } else { + out[order(out[[5]], decreasing = FALSE), ] + } +} diff --git a/radiant.model/R/logistic.R b/radiant.model/R/logistic.R new file mode 100644 index 0000000000000000000000000000000000000000..3282f15e4bb36d36d551b0556eb7a62bbe2ed0c1 --- /dev/null +++ b/radiant.model/R/logistic.R @@ -0,0 +1,1080 @@ +#' Logistic regression +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/logistic.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param rvar The response variable in the model +#' @param evar Explanatory variables in the model +#' @param lev The level in the response variable defined as _success_ +#' @param int Interaction term to include in the model +#' @param wts Weights to use in estimation +#' @param check Use "standardize" to see standardized coefficient estimates. Use "stepwise-backward" (or "stepwise-forward", or "stepwise-both") to apply step-wise selection of variables in estimation. Add "robust" for robust estimation of standard errors (HC1) +#' @param form Optional formula to use instead of rvar, evar, and int +#' @param ci_type To use the profile-likelihood (rather than Wald) for confidence intervals use "profile". For datasets with more than 5,000 rows the Wald method will be used, unless "profile" is explicitly set +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param arr Expression to arrange (sort) the data on (e.g., "color, desc(price)") +#' @param rows Rows to select from the specified dataset +#' @param envir Environment to extract data from +#' +#' @return A list with all variables defined in logistic as an object of class logistic +#' +#' @examples +#' logistic(titanic, "survived", c("pclass", "sex"), lev = "Yes") %>% summary() +#' logistic(titanic, "survived", c("pclass", "sex")) %>% str() +#' @seealso \code{\link{summary.logistic}} to summarize the results +#' @seealso \code{\link{plot.logistic}} to plot the results +#' @seealso \code{\link{predict.logistic}} to generate predictions +#' @seealso \code{\link{plot.model.predict}} to plot prediction output +#' +#' @importFrom sandwich vcovHC +#' +#' @export +logistic <- function(dataset, rvar, evar, lev = "", int = "", + wts = "None", check = "", form, ci_type, + data_filter = "", arr = "", rows = NULL, envir = parent.frame()) { + if (!missing(form)) { + form <- as.formula(format(form)) + paste0(format(form), collapse = "") + + vars <- all.vars(form) + rvar <- vars[1] + evar <- vars[-1] + } + + if (rvar %in% evar) { + return("Response variable contained in the set of explanatory variables.\nPlease update model specification." %>% + add_class("logistic")) + } + + vars <- c(rvar, evar) + + if (is.empty(wts, "None")) { + wts <- NULL + } else if (is_string(wts)) { + wtsname <- wts + vars <- c(rvar, evar, wtsname) + } + + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + if (any(evar == ".")) { + dataset <- get_data(dataset, "", filt = data_filter, arr = arr, rows = rows, envir = envir) + evar <- setdiff(colnames(dataset), rvar) + } else { + dataset <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, envir = envir) + } + + if (missing(ci_type)) { + ## Use profiling for smaller datasets + if (nrow(na.omit(dataset)) < 5000) { + ci_type <- "profile" + } else { + ci_type <- "default" + } + } + + if (!is.empty(wts)) { + if (exists("wtsname")) { + wts <- dataset[[wtsname]] + dataset <- select_at(dataset, .vars = base::setdiff(colnames(dataset), wtsname)) + } + if (length(wts) != nrow(dataset)) { + return( + paste0("Length of the weights variable is not equal to the number of rows in the dataset (", format_nr(length(wts), dec = 0), " vs ", format_nr(nrow(dataset), dec = 0), ")") %>% + add_class("logistic") + ) + } + if (!is.integer(wts)) { + if (length(unique(wts)) == 2 && min(wts) < 1) { + check <- union(check, "robust") + } + } + } + + not_vary <- colnames(dataset)[summarise_all(dataset, does_vary) == FALSE] + if (length(not_vary) > 0) { + return(paste0("The following variable(s) show no variation. Please select other variables.\n\n** ", paste0(not_vary, collapse = ", "), " **") %>% + add_class("logistic")) + } + + rv <- dataset[[rvar]] + if (lev == "") { + if (is.factor(rv)) { + lev <- levels(rv)[1] + } else { + lev <- as.character(rv) %>% + as.factor() %>% + levels() %>% + .[1] + } + } + + ## transformation to TRUE/FALSE depending on the selected level (lev) + dataset[[rvar]] <- dataset[[rvar]] == lev + + if (!missing(form)) { + int <- setdiff(attr(terms.formula(form), "term.labels"), evar) + } + + vars <- "" + var_check(evar, colnames(dataset)[-1], int) %>% + { + vars <<- .$vars + evar <<- .$ev + int <<- .$intv + } + + ## add minmax attributes to data + mmx <- minmax(dataset) + + ## scale data + if ("standardize" %in% check) { + dataset <- scale_df(dataset, wts = wts) + } else if ("center" %in% check) { + dataset <- scale_df(dataset, scale = FALSE, wts = wts) + } + + if (missing(form)) { + form_upper <- paste(rvar, "~", paste(vars, collapse = " + ")) %>% as.formula() + } else { + form_upper <- form + rm(form) + } + + form_lower <- paste(rvar, "~ 1") %>% as.formula() + if ("stepwise" %in% check) check <- sub("stepwise", "stepwise-backward", check) + if ("stepwise-backward" %in% check) { + ## use k = 2 for AIC, use k = log(nrow(dataset)) for BIC + model <- sshhr(glm(form_upper, weights = wts, family = binomial(link = "logit"), data = dataset)) %>% + step(k = 2, scope = list(lower = form_lower), direction = "backward") + } else if ("stepwise-forward" %in% check) { + model <- sshhr(glm(form_lower, weights = wts, family = binomial(link = "logit"), data = dataset)) %>% + step(k = 2, scope = list(upper = form_upper), direction = "forward") + } else if ("stepwise-both" %in% check) { + model <- sshhr(glm(form_lower, weights = wts, family = binomial(link = "logit"), data = dataset)) %>% + step(k = 2, scope = list(lower = form_lower, upper = form_upper), direction = "both") + } else { + model <- sshhr(glm(form_upper, weights = wts, family = binomial(link = "logit"), data = dataset)) + } + + ## needed for prediction if standardization or centering is used + if ("standardize" %in% check || "center" %in% check) { + attr(model$model, "radiant_ms") <- attr(dataset, "radiant_ms") + attr(model$model, "radiant_sds") <- attr(dataset, "radiant_sds") + attr(model$model, "radiant_sf") <- attr(dataset, "radiant_sf") + } + + coeff <- tidy(model) %>% + na.omit() %>% + as.data.frame() + colnames(coeff) <- c("label", "coefficient", "std.error", "z.value", "p.value") + hasLevs <- sapply(select(dataset, -1), function(x) is.factor(x) || is.logical(x) || is.character(x)) + if (sum(hasLevs) > 0) { + for (i in names(hasLevs[hasLevs])) { + coeff$label %<>% gsub(paste0("^", i), paste0(i, "|"), .) %>% + gsub(paste0(":", i), paste0(":", i, "|"), .) + } + rm(i) + } + + if ("robust" %in% check) { + vcov <- sandwich::vcovHC(model, type = "HC1") + coeff$std.error <- sqrt(diag(vcov)) + coeff$z.value <- coeff$coefficient / coeff$std.error + coeff$p.value <- 2 * pnorm(abs(coeff$z.value), lower.tail = FALSE) + } + + coeff$sig_star <- sig_stars(coeff$p.value) %>% format(justify = "left") + coeff$OR <- exp(coeff$coefficient) + coeff$`OR%` <- with(coeff, ifelse(OR < 1, -(1 - OR), OR - 1)) + coeff <- coeff[, c("label", "OR", "OR%", "coefficient", "std.error", "z.value", "p.value", "sig_star")] + + ## remove elements no longer needed + rm(dataset, hasLevs, form_lower, form_upper, envir) + + # added for consistency with other model types + type <- "classification" + + as.list(environment()) %>% add_class(c("logistic", "model")) +} + +#' Summary method for the logistic function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/logistic.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{logistic}} +#' @param sum_check Optional output. "vif" to show multicollinearity diagnostics. "confint" to show coefficient confidence interval estimates. "odds" to show odds ratios and confidence interval estimates. +#' @param conf_lev Confidence level to use for coefficient and odds confidence intervals (.95 is the default) +#' @param test_var Variables to evaluate in model comparison (i.e., a competing models Chi-squared test) +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' +#' result <- logistic(titanic, "survived", "pclass", lev = "Yes") +#' result <- logistic(titanic, "survived", "pclass", lev = "Yes") +#' summary(result, test_var = "pclass") +#' res <- logistic(titanic, "survived", c("pclass", "sex"), int = "pclass:sex", lev = "Yes") +#' summary(res, sum_check = c("vif", "confint", "odds")) +#' titanic %>% +#' logistic("survived", c("pclass", "sex", "age"), lev = "Yes") %>% +#' summary("vif") +#' @seealso \code{\link{logistic}} to generate the results +#' @seealso \code{\link{plot.logistic}} to plot the results +#' @seealso \code{\link{predict.logistic}} to generate predictions +#' @seealso \code{\link{plot.model.predict}} to plot prediction output +#' +#' @importFrom car vif linearHypothesis +#' +#' @export +summary.logistic <- function(object, sum_check = "", conf_lev = .95, + test_var = "", dec = 3, ...) { + if (is.character(object)) { + return(object) + } + if (class(object$model)[1] != "glm") { + return(object) + } + + if (any(grepl("stepwise", object$check))) { + step_type <- if ("stepwise-backward" %in% object$check) { + "Backward" + } else if ("stepwise-forward" %in% object$check) { + "Forward" + } else { + "Forward and Backward" + } + cat("----------------------------------------------------\n") + cat(step_type, "stepwise selection of variables\n") + cat("----------------------------------------------------\n") + } + + cat("Logistic regression (GLM)") + cat("\nData :", object$df_name) + if (!is.empty(object$data_filter)) { + cat("\nFilter :", gsub("\\n", "", object$data_filter)) + } + if (!is.empty(object$arr)) { + cat("\nArrange :", gsub("\\n", "", object$arr)) + } + if (!is.empty(object$rows)) { + cat("\nSlice :", gsub("\\n", "", object$rows)) + } + cat("\nResponse variable :", object$rvar) + cat("\nLevel :", object$lev, "in", object$rvar) + cat("\nExplanatory variables:", paste0(object$evar, collapse = ", "), "\n") + if (length(object$wtsname) > 0) { + cat("Weights used :", object$wtsname, "\n") + } else if (length(object$wts) > 0) { + cat("Weights used :", deparse(substitute(object$wts)), "\n") + } + expl_var <- if (length(object$evar) == 1) object$evar else "x" + cat(paste0("Null hyp.: there is no effect of ", expl_var, " on ", object$rvar, "\n")) + cat(paste0("Alt. hyp.: there is an effect of ", expl_var, " on ", object$rvar, "\n")) + if ("standardize" %in% object$check) { + cat("**Standardized odds-ratios and coefficients shown (2 X SD)**\n") + } else if ("center" %in% object$check) { + cat("**Centered odds-ratios and coefficients shown (x - mean(x))**\n") + } + if ("robust" %in% object$check) { + cat("**Robust standard errors used**\n") + } + cat("\n") + + coeff <- object$coeff + coeff$label %<>% format(justify = "left") + p.small <- coeff$p.value < .001 + coeff[, c(2, 4:7)] %<>% format_df(dec) + coeff[["OR%"]] %<>% format_nr(perc = TRUE, dec = dec - 2, na.rm = FALSE) + coeff$p.value[p.small] <- "< .001" + dplyr::rename(coeff, ` ` = "label", ` ` = "sig_star") %>% + (function(x) { + x$OR[1] <- x$`OR%`[1] <- "" + x + }) %>% + print(row.names = FALSE) + cat("\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n") + + logit_fit <- glance(object$model) + + ## pseudo R2 (likelihood ratio) - http://en.wikipedia.org/wiki/Logistic_Model + logit_fit$rnk <- object$model$rank + logit_fit <- logit_fit %>% + mutate( + llnull = null.deviance / -2, + llfull = deviance / -2, + r2 = 1 - llfull / llnull, + r2_adj = 1 - (llfull - (rnk - 1)) / llnull, + auc = auc(object$model$fitted.values, object$model$model[[object$rvar]]) + ) %>% + round(dec) + + if (!is.empty(object$wts, "None") && (length(unique(object$wts)) > 2 || min(object$wts) >= 1)) { + nobs <- sum(object$wts) + logit_fit$BIC <- round(-2 * logit_fit$logLik + ln(nobs) * with(logit_fit, 1 + df.null - df.residual), dec) + } else { + nobs <- logit_fit$nobs + } + + ## chi-squared test of overall model fit (p-value) - http://www.ats.ucla.edu/stat/r/dae/logit.htm + chi_pval <- with(object$model, pchisq(null.deviance - deviance, df.null - df.residual, lower.tail = FALSE)) %>% + (function(x) if (x < .001) "< .001" else round(x, dec)) + + cat(paste0("\nPseudo R-squared:", logit_fit$r2, ", Adjusted Pseudo R-squared:", logit_fit$r2_adj)) + cat(paste0("\nAUC: ", logit_fit$auc, ", Log-likelihood: ", logit_fit$logLik, ", AIC: ", logit_fit$AIC, ", BIC: ", logit_fit$BIC)) + cat(paste0( + "\nChi-squared: ", with(logit_fit, null.deviance - deviance) %>% round(dec), " df(", + with(logit_fit, df.null - df.residual), "), p.value ", chi_pval + ), "\n") + cat("Nr obs:", format_nr(nobs, dec = 0), "\n\n") + + if (anyNA(object$model$coeff)) { + cat("The set of explanatory variables exhibit perfect multicollinearity.\nOne or more variables were dropped from the estimation.\n") + } + + if ("vif" %in% sum_check) { + if (anyNA(object$model$coeff)) { + cat("Multicollinearity diagnostics were not calculated.") + } else { + ## needed to adjust when step-wise regression is used + if (length(attributes(object$model$terms)$term.labels) > 1) { + cat("Variance Inflation Factors\n") + car::vif(object$model) %>% + { + if (is.null(dim(.))) . else .[, "GVIF"] + } %>% ## needed when factors are included + data.frame(VIF = ., Rsq = 1 - 1 / ., stringsAsFactors = FALSE) %>% + .[order(.$VIF, decreasing = TRUE), ] %>% ## not using arrange to keep rownames + round(dec) %>% + { + if (nrow(.) < 8) t(.) else . + } %>% + print() + } else { + cat("Insufficient number of explanatory variables to calculate\nmulticollinearity diagnostics (VIF)\n") + } + } + cat("\n") + } + + if (any(c("confint", "odds") %in% sum_check)) { + if (any(is.na(object$model$coeff))) { + cat("There is perfect multicollineary in the set of explanatory variables.\nOne or more variables were dropped from the estimation.\n") + cat("Confidence intervals were not calculated.\n") + } else { + ci_perc <- ci_label(cl = conf_lev) + + if ("robust" %in% object$check) { + cnfint <- radiant.model::confint_robust + } else if (object$ci_type == "profile") { + cnfint <- confint + } else { + cnfint <- confint.default + } + + ci_tab <- cnfint(object$model, level = conf_lev, vcov = object$vcov) %>% + as.data.frame(stringsAsFactors = FALSE) %>% + set_colnames(c("Low", "High")) %>% + cbind(select_at(object$coeff, "coefficient"), .) + + if ("confint" %in% sum_check) { + ci_tab %T>% + { + .$`+/-` <- (.$High - .$coefficient) + } %>% + format_df(dec) %>% + set_colnames(c("coefficient", ci_perc[1], ci_perc[2], "+/-")) %>% + set_rownames(object$coeff$label) %>% + print() + cat("\n") + } + } + } + + if ("odds" %in% sum_check) { + if (any(is.na(object$model$coeff))) { + cat("Odds ratios were not calculated\n") + } else { + orlab <- if ("standardize" %in% object$check) "std odds ratio" else "odds ratio" + exp(ci_tab[-1, ]) %>% + format_df(dec) %>% + set_colnames(c(orlab, ci_perc[1], ci_perc[2])) %>% + set_rownames(object$coeff$label[-1]) %>% + print() + cat("\n") + } + } + + if (!is.empty(test_var)) { + if (any(grepl("stepwise", object$check))) { + cat("Model comparisons are not conducted when Stepwise has been selected.\n") + } else { + # sub_form <- ". ~ 1" + sub_form <- paste(object$rvar, "~ 1") + + vars <- object$evar + if (!is.empty(object$int) && length(vars) > 1) { + ## updating test_var if needed + test_var <- unique(c(test_var, test_specs(test_var, object$int))) + vars <- c(vars, object$int) + } + + not_selected <- base::setdiff(vars, test_var) + if (length(not_selected) > 0) sub_form <- paste(object$rvar, "~", paste(not_selected, collapse = " + ")) + ## update with logit_sub NOT working when called from radiant - strange + # logit_sub <- update(object$model, sub_form, data = object$model$model) + logit_sub <- sshhr(glm(as.formula(sub_form), weights = object$wts, family = binomial(link = "logit"), data = object$model$model)) + logit_sub_fit <- glance(logit_sub) + logit_sub_test <- anova(logit_sub, object$model, test = "Chi") + + matchCf <- function(clist, vlist) { + matcher <- function(vl, cn) { + if (grepl(":", vl)) { + strsplit(vl, ":") %>% + unlist() %>% + sapply(function(x) gsub("var", x, "((var.*:)|(:var))")) %>% + paste0(collapse = "|") %>% + grepl(cn) %>% + cn[.] + } else { + mf <- grepl(paste0("^", vl, "$"), cn) %>% cn[.] + if (length(mf) == 0) { + mf <- grepl(paste0("^", vl), cn) %>% cn[.] + } + mf + } + } + + cn <- names(clist) + sapply(vlist, matcher, cn) %>% unname() + } + + if ("robust" %in% object$check) { + ## http://stats.stackexchange.com/a/132521/61693 + logit_sub_lh <- car::linearHypothesis( + object$model, + matchCf(object$model$coef, test_var), + vcov = object$vcov + ) + pval <- logit_sub_lh[2, "Pr(>Chisq)"] + df <- logit_sub_lh[2, "Df"] + chi2 <- logit_sub_lh[2, "Chisq"] + } else { + pval <- logit_sub_test[2, "Pr(>Chi)"] + df <- logit_sub_test[2, "Df"] + chi2 <- logit_sub_test[2, "Deviance"] + } + + ## pseudo R2 (likelihood ratio) - http://en.wikipedia.org/wiki/Logistic_Model + logit_sub_fit %<>% mutate(r2 = (null.deviance - deviance) / null.deviance) %>% round(dec) + logit_sub_pval <- if (!is.na(pval) && pval < .001) "< .001" else round(pval, dec) + cat(attr(logit_sub_test, "heading")[2]) + cat("\nPseudo R-squared, Model 1 vs 2:", c(logit_sub_fit$r2, logit_fit$r2)) + cat(paste0("\nChi-squared: ", round(chi2, dec), " df(", df, "), p.value ", logit_sub_pval)) + } + } +} + +#' Plot method for the logistic function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/logistic.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{logistic}} +#' @param plots Plots to produce for the specified GLM model. Use "" to avoid showing any plots (default). "dist" shows histograms (or frequency bar plots) of all variables in the model. "scatter" shows scatter plots (or box plots for factors) for the response variable with each explanatory variable. "coef" provides a coefficient plot and "influence" shows (potentially) influential observations +#' @param conf_lev Confidence level to use for coefficient and odds confidence intervals (.95 is the default) +#' @param intercept Include the intercept in the coefficient plot (TRUE or FALSE). FALSE is the default +#' @param incl Which variables to include in a coefficient plot +#' @param excl Which variables to exclude in a coefficient plot +#' @param incl_int Which interactions to investigate in PDP plots +#' @param nrobs Number of data points to show in scatter plots (-1 for all) +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- logistic(titanic, "survived", c("pclass", "sex"), lev = "Yes") +#' plot(result, plots = "coef") +#' @seealso \code{\link{logistic}} to generate results +#' @seealso \code{\link{plot.logistic}} to plot results +#' @seealso \code{\link{predict.logistic}} to generate predictions +#' @seealso \code{\link{plot.model.predict}} to plot prediction output +#' +#' @importFrom broom augment +#' @importFrom rlang .data +#' +#' @export +plot.logistic <- function(x, plots = "coef", conf_lev = .95, + intercept = FALSE, incl = NULL, excl = NULL, incl_int = NULL, + nrobs = -1, shiny = FALSE, custom = FALSE, ...) { + if (is.character(x) || !inherits(x$model, "glm")) { + return(x) + } + if (is.empty(plots[1])) { + return("Please select a logistic regression plot from the drop-down menu") + } + + if ("(weights)" %in% colnames(x$model$model) && + min(x$model$model[["(weights)"]]) == 0) { + ## broom::augment chokes when a weight variable has 0s + model <- x$model$model + model$.fitted <- predict(x$model, type = "response") + } else { + model <- broom::augment(x$model, type.predict = "response") + } + + ## adjustment in case max > 1 (e.g., values are 1 and 2) + model$.actual <- as_integer(x$rv) %>% + (function(x) x - max(x) + 1) + + rvar <- x$rvar + evar <- intersect(x$evar, colnames(model)) + vars <- c(rvar, evar) + nrCol <- 2 + plot_list <- list() + + ## use orginal data rather than the logical used for estimation + model[[rvar]] <- x$rv + + if ("dist" %in% plots) { + for (i in vars) { + plot_list[[paste("dist_", i)]] <- select_at(model, .vars = i) %>% + visualize(xvar = i, bins = 10, custom = TRUE) + } + } + + if ("coef" %in% plots) { + if (nrow(x$coeff) == 1 && !intercept) { + return("** Model contains only an intercept **") + } + + yl <- { + if (sum(c("standardize", "center") %in% x$check) == 2) { + "Odds-ratio (Standardized & Centered)" + } else if ("standardize" %in% x$check) { + "Odds-ratio (standardized)" + } else if ("center" %in% x$check) { + "Odds-ratio (centered)" + } else { + "Odds-ratio" + } + } + + nrCol <- 1 + if ("robust" %in% x$check) { + cnfint <- radiant.model::confint_robust + } else if (x$ci_type == "profile") { + cnfint <- confint + } else { + cnfint <- confint.default + } + + coef_df <- cnfint(x$model, level = conf_lev, vcov = x$vcov) %>% + exp(.) %>% + data.frame(stringsAsFactors = FALSE) %>% + na.omit() %>% + set_colnames(c("Low", "High")) %>% + cbind(select(x$coeff, 2), .) %>% + set_rownames(x$coeff$label) %>% + (function(x) if (!intercept) x[-1, , drop = FALSE] else x) %>% + mutate(variable = factor(rownames(.), levels = rownames(.))) + + # addressing issues with extremely high upper bounds + coef_df[coef_df$High > 10000, c("Low", "High")] <- NA + coef_df <- na.omit(coef_df) + + if (length(incl) > 0) { + incl <- paste0("^(", paste0(incl, "[|]*", collapse = "|"), ")") + incl <- grepl(incl, coef_df$variable) + if (isTRUE(intercept)) incl[1] <- TRUE + coef_df <- coef_df[incl, ] + } + if (length(excl) > 0) { + excl <- paste0("^(", paste0(excl, "[|]*", collapse = "|"), ")") + if (isTRUE(intercept)) excl[1] <- TRUE + coef_df <- coef_df[!excl, ] + } + coef_df <- droplevels(coef_df) + + plot_list[["coef"]] <- ggplot(coef_df) + + geom_pointrange(aes(x = .data$variable, y = .data$OR, ymin = .data$Low, ymax = .data$High)) + + geom_hline(yintercept = 1, linetype = "dotdash", color = "blue") + + labs(y = yl, x = "") + + ## can't use coord_trans together with coord_flip + ## http://stackoverflow.com/a/26185278/1974918 + scale_x_discrete(limits = rev(coef_df$variable)) + + scale_y_continuous(breaks = c(0, 0.1, 0.2, 0.5, 1, 2, 5, 10), trans = "log") + + coord_flip() + + theme(axis.text.y = element_text(hjust = 0)) + } + + if ("scatter" %in% plots) { + nrobs <- as.integer(nrobs) + if (nrobs > 0 && nrobs < nrow(model)) { + model <- sample_n(model, nrobs, replace = FALSE) + } + for (i in evar) { + if ("factor" %in% class(model[[i]])) { + plot_list[[paste0("scatter_", i)]] <- ggplot(model, aes(x = .data[[i]], fill = .data[[rvar]])) + + geom_bar(position = "fill", alpha = 0.5) + + labs(y = "") + } else { + plot_list[[paste0("scatter_", i)]] <- select_at(model, .vars = c(i, rvar)) %>% + visualize(xvar = rvar, yvar = i, check = "jitter", type = "scatter", custom = TRUE) + } + } + nrCol <- 1 + } + + if ("fit" %in% plots) { + nrCol <- 1 + + if (nrow(model) < 30) { + return("Insufficient observations to generate Model fit plot") + } + + model$.fittedbin <- radiant.data::xtile(model$.fitted, 30) + + min_bin <- min(model$.fittedbin) + max_bin <- max(model$.fittedbin) + + if (prop(model$.actual[model$.fittedbin == min_bin]) < prop(model$.actual[model$.fittedbin == max_bin])) { + model$.fittedbin <- 1 + max_bin - model$.fittedbin + df <- group_by_at(model, .vars = ".fittedbin") %>% + summarise(Probability = mean(.fitted)) + } else { + df <- group_by_at(model, .vars = ".fittedbin") %>% + summarise(Probability = mean(1 - .fitted)) + } + + plot_list[["fit"]] <- + visualize(model, xvar = ".fittedbin", yvar = ".actual", type = "bar", custom = TRUE) + + geom_line(data = df, aes(y = .data$Probability), color = "blue", linewidth = 1) + + ylim(0, 1) + + labs(title = "Actual vs Fitted values (binned)", x = "Predicted probability bins", y = "Probability") + } + + if ("correlations" %in% plots) { + if (length(evar) == 0) { + message("Model contains only an intercept. Correlation plot cannot be generated") + } else { + return(radiant.basics:::plot.correlation(select_at(model, .vars = vars), nrobs = nrobs)) + } + } + + if ("influence" %in% plots) { + nrCol <- 1 + + ## based on http://www.sthda.com/english/articles/36-classification-methods-essentials/148-logistic-regression-assumptions-and-diagnostics-in-r/ + mod <- model %>% + select(.std.resid, .cooksd) %>% + mutate(index = 1:n(), .cooksd.max = .cooksd) %>% + arrange(desc(.cooksd)) %>% + mutate(index.max = 1:n(), .cooksd.max = ifelse(index.max < 4, .cooksd, NA)) %>% + mutate(index.max = ifelse(index.max < 4, index, NA)) %>% + arrange(index) + + mod <- mutate(mod, .std.resid = ifelse(abs(.std.resid) < 1 & is.na(index.max), NA, .std.resid)) + lim <- max(abs(mod$.std.resid), na.rm = TRUE) %>% + (function(x) c(min(-4, -x), max(4, x))) + plot_list[["influence"]] <- ggplot(mod, aes(index, .std.resid)) + + geom_point(aes(size = .cooksd), alpha = 0.5) + + ggrepel::geom_text_repel(aes(label = index.max)) + + geom_hline(yintercept = c(-1, -3, 1, 3), linetype = "longdash", linewidth = 0.25) + + scale_y_continuous(breaks = -4:4, limits = lim) + + labs( + title = "Influential observations", + x = "Observation index", + y = "Standardized residuals", + size = "cooksd" + ) + } + + rem <- c() + if (any(grepl("stepwise", x$check))) { + if (length(incl) > 0 | length(incl_int) > 0) { + if (sum(incl %in% evar) < length(incl)) { + rem <- incl[!incl %in% evar] + } + if (length(incl_int) > 0) { + incl_int_split <- strsplit(incl_int, ":") %>% + unlist() %>% + unique() + if (sum(incl_int_split %in% evar) < length(incl_int_split)) { + rem <- c(rem, incl_int_split[!incl_int_split %in% evar]) %>% unique() + } + } + } + } + + if ("pred_plot" %in% plots) { + ncol <- 2 + if (length(incl) > 0 | length(incl_int) > 0) { + if (length(rem) > 0) { + return(paste("The following variables are not in the model:", paste(rem, collapse = ", "))) + } + plot_list <- pred_plot(x, plot_list, incl, incl_int, ...) + } else { + return("Select one or more variables to generate Prediction plots") + } + } + + if ("pdp" %in% plots) { + nrCol <- 2 + if (length(incl) > 0 | length(incl_int) > 0) { + if (length(rem) > 0) { + return(paste("The following variables are not in the model:", paste(rem, collapse = ", "))) + } + plot_list <- pdp_plot(x, plot_list, incl, incl_int, ...) + } else { + return("Select one or more variables to generate Partial Dependence Plots") + } + } + + if ("vip" %in% plots) { + nrCol <- 1 + if (length(evar) < 2) { + message("Model must contain at least 2 explanatory variables (features). Permutation Importance plot cannot be generated") + } else { + if (any(grepl("stepwise", x$check))) x$evar <- evar + vi_scores <- varimp(x) + plot_list[["vip"]] <- + visualize(vi_scores, yvar = "Importance", xvar = "Variable", type = "bar", custom = TRUE) + + labs( + title = "Permutation Importance", + x = NULL, + y = "Importance (AUC decrease)" + ) + + coord_flip() + + theme(axis.text.y = element_text(hjust = 0)) + } + } + + if ("linearity" %in% plots) { + ## based on http://www.sthda.com/english/articles/36-classification-methods-essentials/148-logistic-regression-assumptions-and-diagnostics-in-r/ + mod <- select_at(model, .vars = c(".fitted", evar)) %>% dplyr::select_if(is.numeric) + predictors <- setdiff(colnames(mod), ".fitted") + mod <- mutate(mod, logit = log(.fitted / (1 - .fitted))) %>% + select(-.fitted) %>% + gather(key = "predictors", value = "predictor.value", -logit) + plot_list[["linearity"]] <- ggplot(mod, aes(logit, predictor.value)) + + geom_point(size = 0.5, alpha = 0.5) + + geom_smooth(method = "loess") + + facet_wrap(~predictors, scales = "free_y") + + labs( + title = "Checking linearity assumption", + y = NULL, + x = NULL + ) + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = nrCol) %>% + (function(x) if (isTRUE(shiny)) x else print(x)) + } + } +} + +#' Predict method for the logistic function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/logistic.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{logistic}} +#' @param pred_data Provide the dataframe to generate predictions (e.g., titanic). The dataset must contain all columns used in the estimation +#' @param pred_cmd Generate predictions using a command. For example, `pclass = levels(pclass)` would produce predictions for the different levels of factor `pclass`. To add another variable, create a vector of prediction strings, (e.g., c('pclass = levels(pclass)', 'age = seq(0,100,20)') +#' @param conf_lev Confidence level used to estimate confidence intervals (.95 is the default) +#' @param se Logical that indicates if prediction standard errors should be calculated (default = FALSE) +#' @param interval Type of interval calculation ("confidence" or "none"). Set to "none" if se is FALSE +#' @param dec Number of decimals to show +#' @param envir Environment to extract data from +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- logistic(titanic, "survived", c("pclass", "sex"), lev = "Yes") +#' predict(result, pred_cmd = "pclass = levels(pclass)") +#' logistic(titanic, "survived", c("pclass", "sex"), lev = "Yes") %>% +#' predict(pred_cmd = "sex = c('male','female')") +#' logistic(titanic, "survived", c("pclass", "sex"), lev = "Yes") %>% +#' predict(pred_data = titanic) +#' @seealso \code{\link{logistic}} to generate the result +#' @seealso \code{\link{summary.logistic}} to summarize results +#' @seealso \code{\link{plot.logistic}} to plot results +#' @seealso \code{\link{plot.model.predict}} to plot prediction output +#' +#' @export +predict.logistic <- function(object, pred_data = NULL, pred_cmd = "", + conf_lev = 0.95, se = TRUE, interval = "confidence", + dec = 3, envir = parent.frame(), ...) { + if (is.character(object)) { + return(object) + } + if (isTRUE(se)) { + if (isTRUE(interval == "none")) { + se <- FALSE + } else if ("center" %in% object$check || "standardize" %in% object$check) { + message("Standard error calculations not supported when coefficients are centered or standardized") + se <- FALSE + interval <- "none" + } + } else { + interval <- "none" + } + + ## ensure you have a name for the prediction dataset + if (is.data.frame(pred_data)) { + df_name <- deparse(substitute(pred_data)) + } else { + df_name <- pred_data + } + + pfun <- function(model, pred, se, conf_lev) { + pred_val <- + try( + sshhr( + if (se) { + predict(model, pred, type = "link", se.fit = TRUE) + } else { + predict(model, pred, type = "response", se.fit = FALSE) + } + ), + silent = TRUE + ) + + if (!inherits(pred_val, "try-error")) { + if (se) { + ## based on https://www.fromthebottomoftheheap.net/2017/05/01/glm-prediction-intervals-i/ + ilink <- family(model)$linkinv + ci_perc <- ci_label(cl = conf_lev) + pred_val <- data.frame( + Prediction = ilink(pred_val[["fit"]]), + ymax = ilink(pred_val[["fit"]] - qnorm(.5 + conf_lev / 2) * pred_val[["se.fit"]]), + ymin = ilink(pred_val[["fit"]] + qnorm(.5 + conf_lev / 2) * pred_val[["se.fit"]]), + stringsAsFactors = FALSE + ) %>% + set_colnames(c("Prediction", ci_perc[1], ci_perc[2])) + } else { + pred_val <- data.frame(pred_val, stringsAsFactors = FALSE) %>% + select(1) %>% + set_colnames("Prediction") + } + } + pred_val + } + + predict_model(object, pfun, "logistic.predict", pred_data, pred_cmd, conf_lev, se, dec, envir = envir) %>% + set_attr("radiant_interval", interval) %>% + set_attr("radiant_pred_data", df_name) +} + +#' Print method for logistic.predict +#' +#' @param x Return value from prediction method +#' @param ... further arguments passed to or from other methods +#' @param n Number of lines of prediction results to print. Use -1 to print all lines +#' +#' @export +print.logistic.predict <- function(x, ..., n = 10) { + print_predict_model(x, ..., n = n, header = "Logistic regression (GLM)") +} + +#' Confidence interval for robust estimators +#' +#' @details Wrapper for confint with robust standard errors. See \url{https://stackoverflow.com/questions/3817182/vcovhc-and-confidence-interval/3820125#3820125} +#' +#' @param object A fitted model object +#' @param level The confidence level required +#' @param dist Distribution to use ("norm" or "t") +#' @param vcov Covariance matrix generated by, e.g., sandwich::vcovHC +#' @param ... Additional argument(s) for methods +#' +#' @importFrom sandwich vcovHC +#' +#' @export +confint_robust <- function(object, level = 0.95, dist = "norm", vcov = NULL, ...) { + fac <- ((1 - level) / 2) %>% + c(., 1 - .) + + cf <- coef(object) + if (dist == "t") { + fac <- qt(fac, df = nrow(object$model) - length(cf)) + } else { + fac <- qnorm(fac) + } + if (is.null(vcov)) { + vcov <- sandwich::vcovHC(object, type = "HC1") + } + ses <- sqrt(diag(vcov)) + cf + ses %o% fac +} + +#' Calculate min and max before standardization +#' +#' @param dataset Data frame +#' @return Data frame min and max attributes +#' +#' @export +minmax <- function(dataset) { + isNum <- sapply(dataset, is.numeric) + if (sum(isNum) == 0) { + return(dataset) + } + cn <- names(isNum)[isNum] + + mn <- summarise_at(dataset, .vars = cn, .funs = ~ min(., na.rm = TRUE)) + mx <- summarise_at(dataset, .vars = cn, .funs = ~ max(., na.rm = TRUE)) + + list(min = mn, max = mx) +} + +#' Write coefficient table for linear and logistic regression +#' +#' @details Write coefficients and importance scores to csv or or return as a data.frame +#' +#' @param object A fitted model object of class regress or logistic +#' @param file A character string naming a file. "" indicates output to the console +#' @param sort Sort table by variable importance +#' @param intercept Include the intercept in the output (TRUE or FALSE). TRUE is the default +#' +#' @examples +#' +#' regress( +#' diamonds, +#' rvar = "price", evar = c("carat", "clarity", "color", "x"), +#' int = c("carat:clarity", "clarity:color", "I(x^2)"), check = "standardize" +#' ) %>% +#' write.coeff(sort = TRUE) %>% +#' format_df(dec = 3) +#' +#' logistic(titanic, "survived", c("pclass", "sex"), lev = "Yes") %>% +#' write.coeff(intercept = FALSE, sort = TRUE) %>% +#' format_df(dec = 2) +#' @importFrom stats model.frame +#' +#' @export +write.coeff <- function(object, file = "", sort = FALSE, intercept = TRUE) { + if (inherits(object, "regress")) { + mod_class <- "regress" + } else if (inherits(object, "logistic")) { + mod_class <- "logistic" + } else if (inherits(object, "mnl")) { + mod_class <- "mnl" + } else { + "Object is not of class logistic, mnl, or regress" %T>% + message %>% + cat("\n\n", file = file) + return(invisible()) + } + + has_int <- sum(nchar(object$int)) > 0 + check <- object$check + + ## calculating the mean and sd for each variable + ## extract formula from http://stackoverflow.com/a/9694281/1974918 + frm <- formula(object$model$terms) + coeff <- object$model$coeff + dataset <- object$model$model + cn <- colnames(dataset) + wts <- object$wts + + if ("center" %in% check) { + ms <- attr(object$model$model, "radiant_ms") + if (!is.null(ms)) { + icn <- intersect(cn, names(ms)) + dataset[icn] <- lapply(icn, function(var) dataset[[var]] + ms[[var]]) + } + } else if ("standardize" %in% check) { + ms <- attr(object$model$model, "radiant_ms") + sds <- attr(object$model$model, "radiant_sds") + if (!is.null(ms) && !is.null(sds)) { + icn <- intersect(cn, names(ms)) + sf <- attr(object$model$model, "radiant_sf") + sf <- ifelse(is.null(sf), 2, sf) + dataset[icn] <- lapply(icn, function(var) dataset[[var]] * sf * sds[[var]] + ms[[var]]) + } + } + + ## create the model.matrix + mm <- model.matrix(frm, model.frame(frm, dataset))[, -1] + + ## removing columns where the corresponding coeff is missing + cn <- intersect(colnames(mm), names(na.omit(coeff))) + mm <- mm[, cn, drop = FALSE] + + ## generate summary statistics + if (length(wts) == 0) { + cms <- colMeans(mm, na.rm = TRUE) + csds <- apply(mm, 2, sd, na.rm = TRUE) + wts_mess <- " " + } else { + cms <- apply(mm, 2, weighted.mean, wts, na.rm = TRUE) + csds <- apply(mm, 2, weighted.sd, wts, na.rm = TRUE) + wts_mess <- " -- estimated with weights -- " + } + + cmx <- apply(mm, 2, max, na.rm = TRUE) + cmn <- apply(mm, 2, min, na.rm = TRUE) + dummy <- apply(mm, 2, function(x) (sum(x == max(x)) + sum(x == min(x))) == length(x)) + + if ("standardize" %in% check) { + mess <- paste0("Standardized coefficients", wts_mess, "shown\n\n") + } else { + mess <- paste0("Non-standardized coefficients", wts_mess, "shown\n\n") + } + cat(mess, file = file) + + object <- object[["coeff"]] + object$dummy <- c(0L, dummy) + object$mean <- c(1L, cms) + object$sd <- c(0L, csds) + object$min <- c(1L, cmn) + object$max <- c(1L, cmx) + + intc <- grepl("(Intercept)", object$label) + + if (mod_class == "logistic") { + object$importance <- pmax(object$OR, 1 / object$OR) + object$OR[intc] <- object$`OR%`[intc] <- 0 + if ("standardize" %in% check) { + if (has_int) { + object$OR_normal <- object$`OR%_normal` <- "-" + } else { + object$OR_normal <- exp(object$coefficient / (sf * object$sd)) + object$OR_normal[object$dummy == 1] <- object$OR[object$dummy == 1] + object$`OR%_normal` <- with(object, ifelse(OR_normal < 1, -(1 - OR_normal), OR_normal - 1)) + object$OR_normal[intc] <- object$`OR%_normal`[intc] <- 0 + } + } + } else if (mod_class == "mnl") { + object$importance <- pmax(object$RRR, 1 / object$RRR) + object$RRR[intc] <- 0 + } else { + object$importance <- abs(object$coefficient) + # if ("standardize" %in% check) { + # if (has_int) { + # object$coeff_normal <- "-" + # } else { + # # need to also adjust for sd(Y) + # object$coeff_normal <- object$coefficient / (sf*object$sd) + # object$coeff_normal[object$dummy == 1] <- object$coefficient[object$dummy == 1] + # object$coeff_normal[intc] <- 0 + # } + # } + } + + object$importance[intc] <- 0 + + if (sort) { + object[-1, ] <- arrange(object[-1, ], desc(.data$importance)) + } + + if (!intercept) { + object <- slice(object, -1) + } ## slice will ensure a tibble / data.frame is returned + + if (!is.empty(file)) { + sshhr(write.table(object, sep = ",", append = TRUE, file = file, row.names = FALSE)) + } else { + object + } +} diff --git a/radiant.model/R/mnl.R b/radiant.model/R/mnl.R new file mode 100644 index 0000000000000000000000000000000000000000..ed5878c61e0872d1aa5800fb2d92cf9957ca9039 --- /dev/null +++ b/radiant.model/R/mnl.R @@ -0,0 +1,701 @@ +#' Multinomial logistic regression +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/mnl.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param rvar The response variable in the model +#' @param evar Explanatory variables in the model +#' @param lev The level in the response variable to use as the baseline +#' @param int Interaction term to include in the model +#' @param wts Weights to use in estimation +#' @param check Use "standardize" to see standardized coefficient estimates. Use "stepwise-backward" (or "stepwise-forward", or "stepwise-both") to apply step-wise selection of variables in estimation. +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param arr Expression to arrange (sort) the data on (e.g., "color, desc(price)") +#' @param rows Rows to select from the specified dataset +#' @param envir Environment to extract data from +#' +#' @return A list with all variables defined in mnl as an object of class mnl +#' +#' @examples +#' result <- mnl( +#' ketchup, +#' rvar = "choice", +#' evar = c("price.heinz28", "price.heinz32", "price.heinz41", "price.hunts32"), +#' lev = "heinz28" +#' ) +#' str(result) +#' +#' @seealso \code{\link{summary.mnl}} to summarize the results +#' @seealso \code{\link{plot.mnl}} to plot the results +#' @seealso \code{\link{predict.mnl}} to generate predictions +#' @seealso \code{\link{plot.model.predict}} to plot prediction output +#' +#' @export +mnl <- function(dataset, rvar, evar, lev = "", int = "", + wts = "None", check = "", data_filter = "", + arr = "", rows = NULL, envir = parent.frame()) { + if (rvar %in% evar) { + return("Response variable contained in the set of explanatory variables.\nPlease update model specification." %>% + add_class("mnl")) + } + + vars <- c(rvar, evar) + + if (is.empty(wts, "None")) { + wts <- NULL + } else if (is_string(wts)) { + wtsname <- wts + vars <- c(rvar, evar, wtsname) + } + + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, envir = envir) + + if (!is.empty(wts)) { + if (exists("wtsname")) { + wts <- dataset[[wtsname]] + dataset <- select_at(dataset, .vars = base::setdiff(colnames(dataset), wtsname)) + } + if (length(wts) != nrow(dataset)) { + return( + paste0("Length of the weights variable is not equal to the number of rows in the dataset (", format_nr(length(wts), dec = 0), " vs ", format_nr(nrow(dataset), dec = 0), ")") %>% + add_class("mnl") + ) + } + } + + not_vary <- colnames(dataset)[summarise_all(dataset, does_vary) == FALSE] + if (length(not_vary) > 0) { + return(paste0("The following variable(s) show no variation. Please select other variables.\n\n** ", paste0(not_vary, collapse = ", "), " **") %>% + add_class("mnl")) + } + + rv <- dataset[[rvar]] + if (lev == "") { + if (is.factor(rv)) { + lev <- levels(rv)[1] + } else { + lev <- as.character(rv) %>% + as.factor() %>% + levels() %>% + .[1] + } + } + + ## re-leveling the + dataset[[rvar]] <- dataset[[rvar]] %>% + as.factor() %>% + relevel(ref = lev) + lev <- levels(dataset[[1]]) + + vars <- "" + var_check(evar, colnames(dataset)[-1], int) %>% + { + vars <<- .$vars + evar <<- .$ev + int <<- .$intv + } + + ## add minmax attributes to data + mmx <- minmax(dataset) + + ## scale data + if ("standardize" %in% check) { + dataset <- scale_df(dataset, wts = wts) + } else if ("center" %in% check) { + dataset <- scale_df(dataset, scale = FALSE, wts = wts) + } + + if ("no_int" %in% check) { + form_upper <- paste(rvar, "~ 0 +", paste(vars, collapse = " + ")) %>% as.formula() + form_lower <- paste(rvar, "~ 0") %>% as.formula() + } else { + form_upper <- paste(rvar, "~ ", paste(vars, collapse = " + ")) %>% as.formula() + form_lower <- paste(rvar, "~ 1") %>% as.formula() + } + + if ("stepwise" %in% check) check <- sub("stepwise", "stepwise-backward", check) + if ("stepwise-backward" %in% check) { + ## use k = 2 for AIC, use k = log(nrow(dataset)) for BIC + mnl_input <- list(formula = form_upper, weights = wts, data = dataset, model = TRUE, trace = FALSE) + model <- do.call(nnet::multinom, mnl_input) %>% + step(k = 2, scope = list(lower = form_lower), direction = "backward") + } else if ("stepwise-forward" %in% check) { + mnl_input <- list(formula = form_lower, weights = wts, data = dataset, model = TRUE, trace = FALSE) + model <- do.call(nnet::multinom, mnl_input) %>% + step(k = 2, scope = list(upper = form_upper), direction = "forward") + } else if ("stepwise-both" %in% check) { + mnl_input <- list(formula = form_lower, weights = wts, data = dataset, model = TRUE, trace = FALSE) + model <- do.call(nnet::multinom, mnl_input) %>% + step(k = 2, scope = list(lower = form_lower, upper = form_upper), direction = "both") + + ## adding full data even if all variables are not significant + } else { + mnl_input <- list(formula = form_upper, weights = wts, data = dataset, model = TRUE, trace = FALSE) + model <- do.call(nnet::multinom, mnl_input) + } + + coeff <- tidy(model) %>% + na.omit() %>% + as.data.frame() + + ## needed for prediction if standardization or centering is used + if ("standardize" %in% check || "center" %in% check) { + attr(model$model, "radiant_ms") <- attr(dataset, "radiant_ms") + attr(model$model, "radiant_sds") <- attr(dataset, "radiant_sds") + attr(model$model, "radiant_sf") <- attr(dataset, "radiant_sf") + } + + colnames(coeff) <- c("level", "label", "coefficient", "std.error", "z.value", "p.value") + hasLevs <- sapply(select(dataset, -1), function(x) is.factor(x) || is.logical(x) || is.character(x)) + if (sum(hasLevs) > 0) { + for (i in names(hasLevs[hasLevs])) { + coeff$label %<>% gsub(paste0("^", i), paste0(i, "|"), .) %>% + gsub(paste0(":", i), paste0(":", i, "|"), .) + } + rm(i) + } + + coeff$sig_star <- sig_stars(coeff$p.value) %>% format(justify = "left") + coeff$RRR <- exp(coeff$coefficient) + coeff <- coeff[, c("level", "label", "RRR", "coefficient", "std.error", "z.value", "p.value", "sig_star")] + + ## adding null.deviance + umod <- update(model, ~1, trace = FALSE) + model$null.deviance <- -2 * logLik(umod) + model$logLik <- logLik(model) + model$nobs <- nrow(model$residuals) + + ## remove elements no longer needed + rm(dataset, hasLevs, form_lower, form_upper, envir) + + as.list(environment()) %>% add_class(c("mnl", "model")) +} + +#' Summary method for the mnl function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/mnl.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{mnl}} +#' @param sum_check Optional output. "confint" to show coefficient confidence interval estimates. "rrr" to show relative risk ratios (RRRs) and confidence interval estimates. +#' @param conf_lev Confidence level to use for coefficient and RRRs confidence intervals (.95 is the default) +#' @param test_var Variables to evaluate in model comparison (i.e., a competing models Chi-squared test) +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- mnl( +#' ketchup, +#' rvar = "choice", +#' evar = c("price.heinz28", "price.heinz32", "price.heinz41", "price.hunts32"), +#' lev = "heinz28" +#' ) +#' summary(result) +#' +#' @seealso \code{\link{mnl}} to generate the results +#' @seealso \code{\link{plot.mnl}} to plot the results +#' @seealso \code{\link{predict.mnl}} to generate predictions +#' @seealso \code{\link{plot.model.predict}} to plot prediction output +#' +#' @importFrom car linearHypothesis +#' +#' @export +summary.mnl <- function(object, sum_check = "", conf_lev = .95, + test_var = "", dec = 3, ...) { + if (is.character(object)) { + return(object) + } + if (class(object$model)[1] != "multinom") { + return(object) + } + + if (any(grepl("stepwise", object$check))) { + step_type <- if ("stepwise-backward" %in% object$check) { + "Backward" + } else if ("stepwise-forward" %in% object$check) { + "Forward" + } else { + "Forward and Backward" + } + cat("----------------------------------------------------\n") + cat(step_type, "stepwise selection of variables\n") + cat("----------------------------------------------------\n") + } + + cat("Multinomial logistic regression (MNL)") + cat("\nData :", object$df_name) + if (!is.empty(object$data_filter)) { + cat("\nFilter :", gsub("\\n", "", object$data_filter)) + } + if (!is.empty(object$arr)) { + cat("\nArrange :", gsub("\\n", "", object$arr)) + } + if (!is.empty(object$rows)) { + cat("\nSlice :", gsub("\\n", "", object$rows)) + } + cat("\nResponse variable :", object$rvar) + cat("\nBase level :", object$lev[1], "in", object$rvar) + cat("\nExplanatory variables:", paste0(object$evar, collapse = ", "), "\n") + if (length(object$wtsname) > 0) { + cat("Weights used :", object$wtsname, "\n") + } + expl_var <- if (length(object$evar) == 1) object$evar else "x" + cat(paste0("Null hyp.: there is no effect of ", expl_var, " on ", object$rvar, "\n")) + cat(paste0("Alt. hyp.: there is an effect of ", expl_var, " on ", object$rvar, "\n")) + if ("standardize" %in% object$check) { + cat("**Standardized RRRs and coefficients shown (2 X SD)**\n") + } else if ("center" %in% object$check) { + cat("**Centered RRRs and coefficients shown (x - mean(x))**\n") + } + if (object$model$convergence != 0) { + cat("\n**Model did NOT converge. Consider standardizing the\nexplanatory variables and/or simplifying your model**\n") + } + + cat("\n") + + coeff <- object$coeff + coeff$label %<>% format(justify = "left") + p.small <- coeff$p.value < .001 + coeff[, 3:7] %<>% format_df(dec) + coeff$p.value[p.small] <- "< .001" + coeff$RRR[grepl("(Intercept)", coeff$label)] <- "" + dplyr::rename(coeff, ` ` = "level", ` ` = "label", ` ` = "sig_star") %>% + print(row.names = FALSE) + cat("\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n") + + mnl_fit <- glance(object$model) + mnl_fit$null.deviance <- object$model$null.deviance + mnl_fit$logLik <- object$model$logLik + mnl_fit$BIC <- round(-2 * mnl_fit$logLik + ln(object$model$nobs) * with(mnl_fit, edf), dec) + + ## pseudo R2 (likelihood ratio) - http://en.wikipedia.org/wiki/Logistic_Model + mnl_fit %<>% mutate(r2 = (null.deviance - deviance) / null.deviance) %>% + round(dec) + if (!is.empty(object$wts, "None") && (length(unique(object$wts)) > 2 || min(object$wts) >= 1)) { + nobs <- sum(object$wts) + mnl_fit$BIC <- round(-2 * mnl_fit$logLik + ln(nobs) * with(mnl_fit, edf), dec) + } else { + nobs <- object$model$nobs + } + + # ## chi-squared test of overall model fit (p-value) - http://www.ats.ucla.edu/stat/r/dae/logit.htm + chi_pval <- with(mnl_fit, pchisq(null.deviance - deviance, edf - 1, lower.tail = FALSE)) + chi_pval %<>% { + if (. < .001) "< .001" else round(., dec) + } + + cat("\nPseudo R-squared:", mnl_fit$r2) + cat(paste0("\nLog-likelihood: ", mnl_fit$logLik, ", AIC: ", mnl_fit$AIC, ", BIC: ", mnl_fit$BIC)) + cat(paste0( + "\nChi-squared: ", with(mnl_fit, null.deviance - deviance) %>% round(dec), " df(", + with(mnl_fit, edf - 1), "), p.value ", chi_pval + ), "\n") + cat("Nr obs:", format_nr(nobs, dec = 0), "\n\n") + + if (anyNA(object$model$coeff)) { + cat("The set of explanatory variables exhibit perfect multicollinearity.\nOne or more variables were dropped from the estimation.\n") + } + + if (any(c("confint", "rrr") %in% sum_check)) { + if (any(is.na(object$model$coeff))) { + cat("There is perfect multicollineary in the set of explanatory variables.\nOne or more variables were dropped from the estimation.\n") + cat("Confidence intervals were not calculated.\n") + } else { + ci_perc <- ci_label(cl = conf_lev) + ci_tab <- confint(object$model, level = conf_lev) + if (length(dim(ci_tab)) > 2) { + ci_tab <- apply(ci_tab, 2, rbind) + } + ci_tab <- as.data.frame(ci_tab, stringsAsFactors = FALSE) %>% + set_colnames(c("Low", "High")) %>% + cbind(select(object$coeff, c(1, 2, 4)), .) + + if ("confint" %in% sum_check) { + ci_tab %T>% + { + .$`+/-` <- (.$High - .$coefficient) + } %>% + format_df(dec) %>% + set_colnames(c(" ", " ", "coefficient", ci_perc[1], ci_perc[2], "+/-")) %>% + print(row.names = FALSE) + cat("\n") + } + } + } + + if ("rrr" %in% sum_check) { + if (any(is.na(object$model$coeff))) { + cat("RRRs were not calculated\n") + } else { + rrrlab <- if ("standardize" %in% object$check) "std RRR" else "RRR" + ci_tab[, -c(1, 2)] <- exp(ci_tab[, -c(1, 2)]) + ci_tab[!grepl("(Intercept)", ci_tab[[2]]), ] %>% + format_df(dec) %>% + set_colnames(c(" ", "", rrrlab, ci_perc[1], ci_perc[2])) %>% + print(row.names = FALSE) + cat("\n") + } + } + + if (!is.empty(test_var)) { + if (any(grepl("stepwise", object$check))) { + cat("Model comparisons are not conducted when Stepwise has been selected.\n") + } else { + vars <- object$evar + if (!is.empty(object$int) && length(vars) > 1) { + ## updating test_var if needed + test_var <- unique(c(test_var, test_specs(test_var, object$int))) + vars <- c(vars, object$int) + } + + no_int <- ifelse("no_int" %in% object$check, "~ 0 +", "~") + not_selected <- base::setdiff(vars, test_var) + if (length(not_selected) > 0) { + sub_form <- paste(object$rvar, no_int, paste(not_selected, collapse = " + ")) %>% as.formula() + } else { + sub_form <- paste(object$rvar, no_int) %>% as.formula() + } + mnl_input <- list(formula = sub_form, weights = object$wts, data = object$model$model, trace = FALSE) + mnl_sub <- do.call(nnet::multinom, mnl_input) + mnl_sub_fit <- glance(mnl_sub) + mnl_sub_fit$null.deviance <- object$model$null.deviance + mnl_sub_test <- anova(mnl_sub, object$model, test = "Chi") + + pval <- mnl_sub_test[2, "Pr(Chi)"] + df <- mnl_sub_test[2, 5] + chi2 <- mnl_sub_test[2, "LR stat."] + + ## pseudo R2 (likelihood ratio) - http://en.wikipedia.org/wiki/Logistic_Model + mnl_sub_fit %<>% mutate(r2 = (null.deviance - deviance) / null.deviance) %>% round(dec) + mnl_sub_pval <- if (!is.na(pval) && pval < .001) "< .001" else round(pval, dec) + cat(paste0(paste0("Model ", 1:2, ": ", object$rvar, " ~ ", mnl_sub_test$Model), collapse = "\n")) + cat("\nPseudo R-squared, Model 1 vs 2:", c(mnl_sub_fit$r2, mnl_fit$r2)) + cat(paste0("\nChi-squared: ", round(chi2, dec), " df(", df, "), p.value ", mnl_sub_pval)) + } + } + + if ("confusion" %in% sum_check) { + cat("Confusion matrix:\n") + predicted <- predict(object$model, type = "class") + actual <- object$model$model[[object$rvar]] + print(table(predicted, actual)) + cat("\nMisclassification error:", format_nr(mean(predicted != actual), perc = TRUE, dec = dec)) + } +} + +#' Plot method for the mnl function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/mnl.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{mnl}} +#' @param plots Plots to produce for the specified MNL model. Use "" to avoid showing any plots (default). "dist" shows histograms (or frequency bar plots) of all variables in the model. "scatter" shows scatter plots (or box plots for factors) for the response variable with each explanatory variable. "coef" provides a coefficient plot +#' @param conf_lev Confidence level to use for coefficient and relative risk ratios (RRRs) intervals (.95 is the default) +#' @param intercept Include the intercept in the coefficient plot (TRUE or FALSE). FALSE is the default +#' @param nrobs Number of data points to show in scatter plots (-1 for all) +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- mnl( +#' ketchup, +#' rvar = "choice", +#' evar = c("price.heinz28", "price.heinz32", "price.heinz41", "price.hunts32"), +#' lev = "heinz28" +#' ) +#' plot(result, plots = "coef") +#' +#' @seealso \code{\link{mnl}} to generate results +#' @seealso \code{\link{predict.mnl}} to generate predictions +#' @seealso \code{\link{plot.model.predict}} to plot prediction output +#' +#' @importFrom rlang .data +#' +#' @export +plot.mnl <- function(x, plots = "coef", conf_lev = .95, + intercept = FALSE, nrobs = -1, + shiny = FALSE, custom = FALSE, ...) { + if (is.character(x) || !inherits(x$model, "multinom")) { + return(x) + } + if (is.empty(plots[1])) { + return("Please select a mnl regression plot from the drop-down menu") + } + + model <- x$model$model + rvar <- x$rvar + evar <- intersect(x$evar, colnames(model)) + vars <- c(rvar, evar) + nrCol <- 2 + plot_list <- list() + + if ("dist" %in% plots) { + for (i in vars) { + plot_list[[paste("dist_", i)]] <- select_at(model, .vars = i) %>% + visualize(xvar = i, bins = 10, custom = TRUE) + } + } + + if ("coef" %in% plots) { + if (length(evar) == 0 && !intercept) { + return("** Model contains only an intercept **") + } + + yl <- { + if (sum(c("standardize", "center") %in% x$check) == 2) { + "RRR (Standardized & Centered)" + } else if ("standardize" %in% x$check) { + "RRR (standardized)" + } else if ("center" %in% x$check) { + "RRR (centered)" + } else { + "RRR" + } + } + + ci_tab <- confint(x$model, level = conf_lev) + if (length(dim(ci_tab)) > 2) { + ci_tab <- apply(ci_tab, 2, rbind) + color <- "level" + } else { + color <- NULL + } + ci_tab <- as.data.frame(ci_tab, stringsAsFactors = FALSE) %>% + na.omit() %>% + set_colnames(c("Low", "High")) %>% + cbind(select(x$coeff, c(1, 2, 4)), .) + + if (!isTRUE(intercept)) { + ci_tab <- ci_tab[!grepl("(Intercept)", ci_tab[[2]]), ] + } + labels <- unique(ci_tab[[2]]) + ci_tab[, -c(1, 2)] <- exp(ci_tab[, -c(1, 2)]) + + nrCol <- 1 + plot_list[["coef"]] <- ggplot(ci_tab) + + geom_pointrange(aes(x = .data$label, y = .data$coefficient, ymin = .data$Low, ymax = .data$High, color = .data[[color]]), position = position_dodge(width = -0.6)) + + geom_hline(yintercept = 1, linetype = "dotdash", color = "blue") + + labs(y = yl, x = "") + + ## can't use coord_trans together with coord_flip + ## http://stackoverflow.com/a/26185278/1974918 + scale_x_discrete(limits = rev(labels)) + + scale_y_continuous(breaks = c(0, 0.1, 0.2, 0.5, 1, 2, 5, 10), trans = "log") + + coord_flip() + + theme(axis.text.y = element_text(hjust = 0)) + } + + if ("correlations" %in% plots) { + if (length(evar) == 0) { + message("Model contains only an intercept. Correlation plot cannot be generated") + } else { + return(radiant.basics:::plot.correlation(select_at(model, .vars = vars), nrobs = nrobs)) + } + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = nrCol) %>% + { + if (shiny) . else print(.) + } + } + } +} + +#' Predict method for the mnl function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/mnl.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{mnl}} +#' @param pred_data Provide the dataframe to generate predictions (e.g., ketchup). The dataset must contain all columns used in the estimation +#' @param pred_cmd Generate predictions using a command. For example, `pclass = levels(pclass)` would produce predictions for the different levels of factor `pclass`. To add another variable, create a vector of prediction strings, (e.g., c('pclass = levels(pclass)', 'age = seq(0,100,20)') +#' @param pred_names Names for the predictions to be stored. If one name is provided, only the first column of predictions is stored. If empty, the levels in the response variable of the mnl model will be used +#' @param dec Number of decimals to show +#' @param envir Environment to extract data from +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- mnl( +#' ketchup, +#' rvar = "choice", +#' evar = c("price.heinz28", "price.heinz32", "price.heinz41", "price.hunts32"), +#' lev = "heinz28" +#' ) +#' predict(result, pred_cmd = "price.heinz28 = seq(3, 5, 0.1)") +#' predict(result, pred_data = slice(ketchup, 1:20)) +#' +#' @seealso \code{\link{mnl}} to generate the result +#' @seealso \code{\link{summary.mnl}} to summarize results +#' +#' @export +predict.mnl <- function(object, pred_data = NULL, pred_cmd = "", + pred_names = "", dec = 3, envir = parent.frame(), + ...) { + if (is.character(object)) { + return(object) + } + + ## ensure you have a name for the prediction dataset + if (is.data.frame(pred_data)) { + df_name <- deparse(substitute(pred_data)) + } else { + df_name <- pred_data + } + + pfun <- function(model, pred, se, conf_lev) { + + ## need to make sure levels in original data and pred are the same + set_levels <- function(name) { + if (!is.null(model$model[[name]]) && is.factor(model$model[[name]])) { + levs <- levels(model$model[[name]]) + levs_pred <- levels(pred[[name]]) + if (is.null(levs_pred) || !all(levs == levs_pred)) { + pred[[name]] <<- factor(pred[[name]], levels = levs) + } + } + } + + fix <- sapply(colnames(pred), set_levels) + pred_val <- try(sshhr(predict(model, pred, type = "probs")), silent = TRUE) + + if (!inherits(pred_val, "try-error")) { + # if (is.numeric(pred_val)) pred_val <- t(pred_val) + # if (is.null(dim(pred_val))) pred_val <- t(pred_val) + if (is.vector(pred_val)) pred_val <- t(pred_val) + pred_val %<>% as.data.frame(stringsAsFactors = FALSE) + if (all(is.empty(pred_names))) pred_names <- colnames(pred_val) + pred_val %<>% select(1:min(ncol(pred_val), length(pred_names))) %>% + set_colnames(pred_names) + } + + pred_val + } + + predict_model(object, pfun, "mnl.predict", pred_data, pred_cmd, dec = dec, envir = envir) %>% + set_attr("radiant_pred_data", df_name) +} + +#' Print method for mnl.predict +#' +#' @param x Return value from prediction method +#' @param ... further arguments passed to or from other methods +#' @param n Number of lines of prediction results to print. Use -1 to print all lines +#' +#' @export +print.mnl.predict <- function(x, ..., n = 10) { + print_predict_model(x, ..., n = n, header = "Multinomial logistic regression (MNL)", lev = attr(x, "radiant_lev")) +} + +#' Plot method for mnl.predict function +#' +#' @param x Return value from predict function predict.mnl +#' @param xvar Variable to display along the X-axis of the plot +#' @param facet_row Create vertically arranged subplots for each level of the selected factor variable +#' @param facet_col Create horizontally arranged subplots for each level of the selected factor variable +#' @param color Adds color to a scatter plot to generate a heat map. For a line plot one line is created for each group and each is assigned a different color +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- mnl( +#' ketchup, +#' rvar = "choice", +#' evar = c("price.heinz28", "price.heinz32", "price.heinz41", "price.hunts32"), +#' lev = "heinz28" +#' ) +#' pred <- predict(result, pred_cmd = "price.heinz28 = seq(3, 5, 0.1)") +#' plot(pred, xvar = "price.heinz28") +#' +#' @seealso \code{\link{predict.mnl}} to generate predictions +#' +#' @importFrom rlang .data +#' +#' @export +plot.mnl.predict <- function(x, xvar = "", facet_row = ".", facet_col = ".", + color = ".class", ...) { + + ## should work with req in regress_ui but doesn't + if (is.empty(xvar)) { + return(invisible()) + } + + if (facet_col != "." && facet_row == facet_col) { + return("The same variable cannot be used for both Facet row and Facet column") + } + + if (is.character(x)) { + return(x) + } + + pvars <- base::setdiff(attr(x, "radiant_vars"), attr(x, "radiant_evar")) + rvar <- attr(x, "radiant_rvar") + x %<>% gather(".class", "Prediction", !!pvars) + + byvar <- c(xvar, color) + if (facet_row != ".") byvar <- unique(c(byvar, facet_row)) + if (facet_col != ".") byvar <- unique(c(byvar, facet_col)) + + tmp <- group_by_at(x, .vars = byvar) %>% + select_at(.vars = c(byvar, "Prediction")) %>% + summarise_all(mean) + p <- ggplot(tmp, aes(x = .data[[xvar]], y = .data$Prediction, color = .data[[color]], group = .data[[color]])) + + geom_line() + + if (facet_row != "." || facet_col != ".") { + facets <- ifelse(facet_row == ".", paste("~", facet_col), paste(facet_row, "~", facet_col)) + facet_fun <- ifelse(facet_row == ".", facet_wrap, facet_grid) + p <- p + facet_fun(as.formula(facets)) + } + + p <- p + guides(color = guide_legend(title = rvar)) + + sshhr(p) +} + +#' Store predicted values generated in the mnl function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/mnl.html} for an example in Radiant +#' +#' @param dataset Dataset to add predictions to +#' @param object Return value from model function +#' @param name Variable name(s) assigned to predicted values. If empty, the levels of the response variable will be used +#' @param ... Additional arguments +#' +#' @examples +#' result <- mnl( +#' ketchup, +#' rvar = "choice", +#' evar = c("price.heinz28", "price.heinz32", "price.heinz41", "price.hunts32"), +#' lev = "heinz28" +#' ) +#' pred <- predict(result, pred_data = ketchup) +#' ketchup <- store(ketchup, pred, name = c("heinz28", "heinz32", "heinz41", "hunts32")) +#' +#' @export +store.mnl.predict <- function(dataset, object, name = NULL, ...) { + + ## extract the names of the variables predicted + pvars <- base::setdiff(attr(object, "radiant_vars"), attr(object, "radiant_evar")) + + ## as.vector removes all attributes from df + # df <- as.vector(object[, pvars]) + df <- object[, pvars, drop = FALSE] %>% mutate(across(everything(), as.vector)) + + if (is.empty(name)) { + name <- pvars + } else { + ## gsub needed because trailing/leading spaces may be added to the variable name + name <- unlist(strsplit(name, "(\\s*,\\s*|\\s*;\\s*|\\s+)")) %>% + gsub("\\s", "", .) + if (length(name) < length(pvars)) { + df <- df[, 1:length(name), drop = FALSE] %>% set_colnames(name) + } + } + + indr <- indexr(dataset, attr(object, "radiant_evar"), "", cmd = attr(object, "radiant_pred_cmd")) + pred <- as.data.frame(matrix(NA, nrow = indr$nr, ncol = ncol(df)), stringsAsFactors = FALSE) + pred[indr$ind, ] <- df + dataset[, name] <- pred + dataset +} diff --git a/radiant.model/R/nb.R b/radiant.model/R/nb.R new file mode 100644 index 0000000000000000000000000000000000000000..24a0c47cfb89042939ba437964c27660572863d8 --- /dev/null +++ b/radiant.model/R/nb.R @@ -0,0 +1,401 @@ +#' Naive Bayes using e1071::naiveBayes +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/nb.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param rvar The response variable in the logit (probit) model +#' @param evar Explanatory variables in the model +#' @param laplace Positive double controlling Laplace smoothing. The default (0) disables Laplace smoothing. +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param arr Expression to arrange (sort) the data on (e.g., "color, desc(price)") +#' @param rows Rows to select from the specified dataset +#' @param envir Environment to extract data from +#' +#' @return A list with all variables defined in nb as an object of class nb +#' +#' @examples +#' nb(titanic, "survived", c("pclass", "sex", "age")) %>% summary() +#' nb(titanic, "survived", c("pclass", "sex", "age")) %>% str() +#' +#' @seealso \code{\link{summary.nb}} to summarize results +#' @seealso \code{\link{plot.nb}} to plot results +#' @seealso \code{\link{predict.nb}} for prediction +#' +#' @importFrom e1071 naiveBayes +#' +#' @export +nb <- function(dataset, rvar, evar, laplace = 0, + data_filter = "", arr = "", rows = NULL, + envir = parent.frame()) { + if (rvar %in% evar) { + return("Response variable contained in the set of explanatory variables.\nPlease update model specification." %>% + add_class("nb")) + } + + df_name <- if (!is_string(dataset)) deparse(substitute(dataset)) else dataset + dataset <- get_data(dataset, c(rvar, evar), filt = data_filter, arr = arr, rows = rows, envir = envir) + + not_vary <- colnames(dataset)[summarise_all(dataset, does_vary) == FALSE] + if (length(not_vary) > 0) { + return(paste0("The following variable(s) show no variation. Please select other variables.\n\n** ", paste0(not_vary, collapse = ", "), " **") %>% + add_class("nb")) + } + + vars <- evar + ## in case : is used + if (length(vars) < (ncol(dataset) - 1)) { + vars <- evar <- colnames(dataset)[-1] + } + + ## make sure the dv is a factor + if (!is.factor(dataset[[1]])) dataset <- as_factor(dataset[[1]]) + lev <- levels(dataset[[1]]) + + ## estimate using e1071 + form <- paste0(rvar, " ~ ", paste0(evar, collapse = "+")) %>% as.formula() + model <- e1071::naiveBayes(dataset[, -1, drop = FALSE], dataset[[1]], laplace = laplace) + + ## nb does not return residuals + model$residuals <- NA + + ## nb doesn't indlude model terms, needed for predict_model + # model$terms <- colnames(dataset) + # attr(model$term, "dataClasses") <- get_class(dataset) + + ## nb model object does not include the data by default + model$model <- dataset + rm(dataset, envir) ## dataset not needed elsewhere + + as.list(environment()) %>% add_class(c("nb", "model")) +} + +#' Summary method for the nb function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/nb.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{nb}} +#' @param dec Decimals +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- nb(titanic, "survived", c("pclass", "sex", "age")) +#' summary(result) +#' +#' @seealso \code{\link{nb}} to generate results +#' @seealso \code{\link{plot.nb}} to plot results +#' @seealso \code{\link{predict.nb}} for prediction +#' +#' @export +summary.nb <- function(object, dec = 3, ...) { + if (is.character(object)) { + return(object) + } + + cat("Naive Bayes Classifier") + cat("\nData :", object$df_name) + if (!is.empty(object$data_filter)) { + cat("\nFilter :", gsub("\\n", "", object$data_filter)) + } + if (!is.empty(object$arr)) { + cat("\nArrange :", gsub("\\n", "", object$arr)) + } + if (!is.empty(object$rows)) { + cat("\nSlice :", gsub("\\n", "", object$rows)) + } + cat("\nResponse variable :", object$rvar) + cat("\nLevels :", paste0(object$lev, collapse = ", "), "in", object$rvar) + cat("\nExplanatory variables:", paste0(object$evar, collapse = ", ")) + cat("\nLaplace :", object$laplace) + cat("\nNr obs :", format_nr(nrow(object$model$model), dec = 0), "\n") + + cat("\nA-priori probabilities:\n") + apriori <- object$model$apriori %>% + { + . / sum(.) + } + names(dimnames(apriori))[1] <- object$rvar + print(round(apriori, 3)) + + cat("\nConditional probabilities (categorical) or means & st.dev (numeric):\n") + for (i in object$model$tables) { + names(dimnames(i))[1] <- object$rvar + if (is.null(dimnames(i)[2][[1]])) dimnames(i)[2][[1]] <- c("mean", "st.dev") + print(round(i, dec)) + cat("\n") + } +} + +#' Plot method for the nb function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/nb.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{nb}} +#' @param plots Plots to produce for the specified model. Use "" to avoid showing any plots. Use "vimp" for variable importance or "correlations" to examine conditional independence +#' @param lev The level(s) in the response variable used as the basis for plots (defaults to "All levels") +#' @param nrobs Number of data points to show in scatter plots (-1 for all) +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- nb(titanic, "survived", c("pclass", "sex")) +#' plot(result) +#' result <- nb(titanic, "pclass", c("sex", "age")) +#' plot(result) +#' +#' @seealso \code{\link{nb}} to generate results +#' @seealso \code{\link{summary.nb}} to summarize results +#' @seealso \code{\link{predict.nb}} for prediction +#' +#' @export +plot.nb <- function(x, plots = "correlations", lev = "All levels", nrobs = 1000, ...) { + if (is.character(x)) { + return(x) + } + if (is.empty(plots[1])) { + return(invisible()) + } + + rvar <- x$model$model[[1]] + + if ("correlations" %in% plots) { + if (lev == "All levels") { + return(sshhr(radiant.basics:::plot.correlation(x$model$model, nrobs = nrobs))) + } else { + return(sshhr(radiant.basics:::plot.correlation(filter(select(x$model$model, -1), rvar == lev), nrobs = nrobs))) + } + } + + evar <- mutate_all(select(x$model$model, -1), as_numeric) + + if (lev != "All levels") { + rvar <- factor( + ifelse(rvar == lev, lev, paste0("not_", lev)), + levels = c(lev, paste0("not_", lev)) + ) + x$lev <- c(lev, paste0("not_", lev)) + } + + k <- length(x$lev) + + if (k == 2) { + ## with two variables one of them would be set to 0 by caret::varImp + ## reporting auc for each variable + vimp <- data.frame(auc = apply(evar, 2, auc, rvar), vars = colnames(evar), stringsAsFactors = FALSE) %>% + arrange_at(.vars = "auc") + vimp$vars <- factor(vimp$vars, levels = vimp$vars) + p <- visualize(vimp, yvar = "auc", xvar = "vars", type = "bar", custom = TRUE) + + labs(x = "", y = "Variable Importance (AUC)") + + coord_flip(ylim = c(0.5, max(vimp$auc))) + + theme(axis.text.y = element_text(hjust = 0)) + } else { + cmb <- combn(x$lev, 2) + vimp <- matrix(NA, ncol(cmb), ncol(evar)) + + for (i in 1:ncol(cmb)) { + ind <- rvar %in% cmb[, i] + vimp[i, ] <- apply(evar[ind, , drop = FALSE], 2, auc, droplevels(rvar[ind])) + } + vimp <- as.data.frame(vimp, stringsAsFactors = FALSE) + colnames(vimp) <- names(evar) + vimp$Predict <- apply(cmb, 2, paste0, collapse = " vs ") + vimp$Predict <- factor(vimp$Predict, levels = unique(rev(vimp$Predict))) + vimp <- gather(vimp, "vars", "auc", !!colnames(evar), factor_key = TRUE) + + p <- visualize(vimp, yvar = "auc", xvar = "Predict", type = "bar", fill = "vars", custom = TRUE) + + guides(fill = guide_legend(title = "")) + + labs(x = "", y = "Variable Importance (AUC)") + + coord_flip(ylim = c(0.5, max(vimp$auc))) + + theme(axis.text.y = element_text(hjust = 0)) + } + + sshhr(p) +} + +#' Predict method for the nb function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/nb.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{nb}} +#' @param pred_data Provide the dataframe to generate predictions (e.g., titanic). The dataset must contain all columns used in the estimation +#' @param pred_cmd Generate predictions using a command. For example, `pclass = levels(pclass)` would produce predictions for the different levels of factor `pclass`. To add another variable, create a vector of prediction strings, (e.g., c('pclass = levels(pclass)', 'age = seq(0,100,20)') +#' @param pred_names Names for the predictions to be stored. If one name is provided, only the first column of predictions is stored. If empty, the level in the response variable of the nb model will be used +#' @param dec Number of decimals to show +#' @param envir Environment to extract data from +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- nb(titanic, "survived", c("pclass", "sex", "age")) +#' predict(result, pred_data = titanic) +#' predict(result, pred_data = titanic, pred_names = c("Yes", "No")) +#' predict(result, pred_cmd = "pclass = levels(pclass)") +#' result <- nb(titanic, "pclass", c("survived", "sex", "age")) +#' predict(result, pred_data = titanic) +#' predict(result, pred_data = titanic, pred_names = c("1st", "2nd", "3rd")) +#' predict(result, pred_data = titanic, pred_names = "") +#' +#' @seealso \code{\link{nb}} to generate the result +#' @seealso \code{\link{summary.nb}} to summarize results +#' +#' @export +predict.nb <- function(object, pred_data = NULL, pred_cmd = "", + pred_names = "", dec = 3, envir = parent.frame(), + ...) { + if (is.character(object)) { + return(object) + } + + ## ensure you have a name for the prediction dataset + if (is.data.frame(pred_data)) { + df_name <- deparse(substitute(pred_data)) + } else { + df_name <- pred_data + } + + pfun <- function(model, pred, se, conf_lev) { + + ## need to make sure levels in original data and pred are the same + ## as predict.naiveBayes relies on this ordering + set_levels <- function(name) { + if (!is.null(model$model[[name]]) && is.factor(model$model[[name]])) { + levs <- levels(model$model[[name]]) + levs_pred <- levels(pred[[name]]) + if (is.null(levs_pred) || !all(levs == levs_pred)) { + pred[[name]] <<- factor(pred[[name]], levels = levs) + } + } + } + + fix <- sapply(colnames(pred), set_levels) + pred_val <- try(sshhr(predict(model, pred, type = "raw")), silent = TRUE) + + if (!inherits(pred_val, "try-error")) { + pred_val %<>% as.data.frame(stringsAsFactors = FALSE) + if (all(is.empty(pred_names))) pred_names <- colnames(pred_val) + pred_val %<>% select(1:min(ncol(pred_val), length(pred_names))) %>% + set_colnames(pred_names) + } + + pred_val + } + + predict_model(object, pfun, "nb.predict", pred_data, pred_cmd, dec = dec, envir = envir) %>% + set_attr("radiant_pred_data", df_name) +} + +#' Print method for predict.nb +#' +#' @param x Return value from prediction method +#' @param ... further arguments passed to or from other methods +#' @param n Number of lines of prediction results to print. Use -1 to print all lines +#' +#' @export +print.nb.predict <- function(x, ..., n = 10) { + print_predict_model(x, ..., n = n, header = "Naive Bayes Classifier", lev = attr(x, "radiant_lev")) +} + +#' Plot method for nb.predict function +#' +#' @param x Return value from predict function predict.nb +#' @param xvar Variable to display along the X-axis of the plot +#' @param facet_row Create vertically arranged subplots for each level of the selected factor variable +#' @param facet_col Create horizontally arranged subplots for each level of the selected factor variable +#' @param color Adds color to a scatter plot to generate a heat map. For a line plot one line is created for each group and each is assigned a different color +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- nb(titanic, "survived", c("pclass", "sex", "age")) +#' pred <- predict( +#' result, +#' pred_cmd = c("pclass = levels(pclass)", "sex = levels(sex)", "age = seq(0, 100, 20)") +#' ) +#' plot(pred, xvar = "age", facet_col = "sex", facet_row = "pclass") +#' pred <- predict(result, pred_data = titanic) +#' plot(pred, xvar = "age", facet_col = "sex") +#' +#' @seealso \code{\link{predict.nb}} to generate predictions +#' +#' @importFrom rlang .data +#' +#' @export +plot.nb.predict <- function(x, xvar = "", facet_row = ".", facet_col = ".", + color = ".class", ...) { + + ## should work with req in regress_ui but doesn't + if (is.empty(xvar)) { + return(invisible()) + } + + if (facet_col != "." && facet_row == facet_col) { + return("The same variable cannot be used for both Facet row and Facet column") + } + + if (is.character(x)) { + return(x) + } + + pvars <- base::setdiff(attr(x, "radiant_vars"), attr(x, "radiant_evar")) + rvar <- attr(x, "radiant_rvar") + x %<>% gather(".class", "Prediction", !!pvars) + + byvar <- c(xvar, color) + if (facet_row != ".") byvar <- unique(c(byvar, facet_row)) + if (facet_col != ".") byvar <- unique(c(byvar, facet_col)) + + tmp <- group_by_at(x, .vars = byvar) %>% + select_at(.vars = c(byvar, "Prediction")) %>% + summarise_all(mean) + p <- ggplot(tmp, aes(x = .data[[xvar]], y = .data$Prediction, color = .data[[color]], group = .data[[color]])) + + geom_line() + + if (facet_row != "." || facet_col != ".") { + facets <- ifelse(facet_row == ".", paste("~", facet_col), paste(facet_row, "~", facet_col)) + facet_fun <- ifelse(facet_row == ".", facet_wrap, facet_grid) + p <- p + facet_fun(as.formula(facets)) + } + + p <- p + guides(color = guide_legend(title = rvar)) + + sshhr(p) +} + +#' Store predicted values generated in the nb function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/nb.html} for an example in Radiant +#' +#' @param dataset Dataset to add predictions to +#' @param object Return value from model function +#' @param name Variable name(s) assigned to predicted values. If empty, the levels of the response variable will be used +#' @param ... Additional arguments +#' +#' @examples +#' result <- nb(titanic, rvar = "survived", evar = c("pclass", "sex", "age")) +#' pred <- predict(result, pred_data = titanic) +#' titanic <- store(titanic, pred, name = c("Yes", "No")) +#' +#' @export +store.nb.predict <- function(dataset, object, name = NULL, ...) { + + ## extract the names of the variables predicted + pvars <- base::setdiff(attr(object, "radiant_vars"), attr(object, "radiant_evar")) + + ## as.vector removes all attributes from df + # df <- as.vector(object[, pvars]) + df <- object[, pvars, drop = FALSE] %>% mutate(across(everything(), as.vector)) + + if (is.empty(name)) { + name <- pvars + } else { + ## gsub needed because trailing/leading spaces may be added to the variable name + name <- unlist(strsplit(name, "(\\s*,\\s*|\\s*;\\s*|\\s+)")) %>% + gsub("\\s", "", .) + if (length(name) < length(pvars)) { + df <- df[, 1:length(name), drop = FALSE] %>% set_colnames(name) + } + } + + indr <- indexr(dataset, attr(object, "radiant_evar"), "", cmd = attr(object, "radiant_pred_cmd")) + pred <- as.data.frame(matrix(NA, nrow = indr$nr, ncol = ncol(df)), stringsAsFactors = FALSE) + pred[indr$ind, ] <- df + + dataset[, name] <- pred + dataset +} \ No newline at end of file diff --git a/radiant.model/R/nn.R b/radiant.model/R/nn.R new file mode 100644 index 0000000000000000000000000000000000000000..b70844064e035f8c5743ab0008ce1442a6acc283 --- /dev/null +++ b/radiant.model/R/nn.R @@ -0,0 +1,718 @@ +#' Neural Networks using nnet +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/nn.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param rvar The response variable in the model +#' @param evar Explanatory variables in the model +#' @param type Model type (i.e., "classification" or "regression") +#' @param lev The level in the response variable defined as _success_ +#' @param size Number of units (nodes) in the hidden layer +#' @param decay Parameter decay +#' @param wts Weights to use in estimation +#' @param seed Random seed to use as the starting point +#' @param check Optional estimation parameters ("standardize" is the default) +#' @param form Optional formula to use instead of rvar and evar +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param arr Expression to arrange (sort) the data on (e.g., "color, desc(price)") +#' @param rows Rows to select from the specified dataset +#' @param envir Environment to extract data from +#' +#' @return A list with all variables defined in nn as an object of class nn +#' +#' @examples +#' nn(titanic, "survived", c("pclass", "sex"), lev = "Yes") %>% summary() +#' nn(titanic, "survived", c("pclass", "sex")) %>% str() +#' nn(diamonds, "price", c("carat", "clarity"), type = "regression") %>% summary() +#' @seealso \code{\link{summary.nn}} to summarize results +#' @seealso \code{\link{plot.nn}} to plot results +#' @seealso \code{\link{predict.nn}} for prediction +#' +#' @importFrom nnet nnet +#' +#' @export +nn <- function(dataset, rvar, evar, + type = "classification", lev = "", + size = 1, decay = .5, wts = "None", + seed = NA, check = "standardize", + form, data_filter = "", arr = "", + rows = NULL, envir = parent.frame()) { + if (!missing(form)) { + form <- as.formula(format(form)) + paste0(format(form), collapse = "") + + vars <- all.vars(form) + rvar <- vars[1] + evar <- vars[-1] + } + + if (rvar %in% evar) { + return("Response variable contained in the set of explanatory variables.\nPlease update model specification." %>% + add_class("nn")) + } else if (is.empty(size) || size < 1) { + return("Size should be larger than or equal to 1." %>% add_class("nn")) + } else if (is.empty(decay) || decay < 0) { + return("Decay should be larger than or equal to 0." %>% add_class("nn")) + } + + vars <- c(rvar, evar) + + if (is.empty(wts, "None")) { + wts <- NULL + } else if (is_string(wts)) { + wtsname <- wts + vars <- c(rvar, evar, wtsname) + } + + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, envir = envir) + + if (!is.empty(wts)) { + if (exists("wtsname")) { + wts <- dataset[[wtsname]] + dataset <- select_at(dataset, .vars = base::setdiff(colnames(dataset), wtsname)) + } + if (length(wts) != nrow(dataset)) { + return( + paste0("Length of the weights variable is not equal to the number of rows in the dataset (", format_nr(length(wts), dec = 0), " vs ", format_nr(nrow(dataset), dec = 0), ")") %>% + add_class("nn") + ) + } + } + + not_vary <- colnames(dataset)[summarise_all(dataset, does_vary) == FALSE] + if (length(not_vary) > 0) { + return(paste0("The following variable(s) show no variation. Please select other variables.\n\n** ", paste0(not_vary, collapse = ", "), " **") %>% + add_class("nn")) + } + + rv <- dataset[[rvar]] + + if (type == "classification") { + linout <- FALSE + entropy <- TRUE + if (lev == "") { + if (is.factor(rv)) { + lev <- levels(rv)[1] + } else { + lev <- as.character(rv) %>% + as.factor() %>% + levels() %>% + .[1] + } + } + + ## transformation to TRUE/FALSE depending on the selected level (lev) + dataset[[rvar]] <- dataset[[rvar]] == lev + } else { + linout <- TRUE + entropy <- FALSE + } + + ## standardize data to limit stability issues ... + # http://stats.stackexchange.com/questions/23235/how-do-i-improve-my-neural-network-stability + if ("standardize" %in% check) { + dataset <- scale_df(dataset, wts = wts) + } + + vars <- evar + ## in case : is used + if (length(vars) < (ncol(dataset) - 1)) { + vars <- evar <- colnames(dataset)[-1] + } + + if (missing(form)) form <- as.formula(paste(rvar, "~ . ")) + + ## use decay http://stats.stackexchange.com/a/70146/61693 + nninput <- list( + formula = form, + rang = .1, size = size, decay = decay, weights = wts, + maxit = 10000, linout = linout, entropy = entropy, + skip = FALSE, trace = FALSE, data = dataset + ) + + ## based on https://stackoverflow.com/a/14324316/1974918 + seed <- gsub("[^0-9]", "", seed) + if (!is.empty(seed)) { + if (exists(".Random.seed")) { + gseed <- .Random.seed + on.exit(.Random.seed <<- gseed) + } + set.seed(seed) + } + + ## need do.call so Garson/Olden plot will work + model <- do.call(nnet::nnet, nninput) + coefnames <- model$coefnames + hasLevs <- sapply(select(dataset, -1), function(x) is.factor(x) || is.logical(x) || is.character(x)) + if (sum(hasLevs) > 0) { + for (i in names(hasLevs[hasLevs])) { + coefnames %<>% gsub(paste0("^", i), paste0(i, "|"), .) %>% + gsub(paste0(":", i), paste0(":", i, "|"), .) + } + rm(i, hasLevs) + } + + ## nn returns residuals as a matrix + model$residuals <- model$residuals[, 1] + + ## nn model object does not include the data by default + model$model <- dataset + rm(dataset, envir) ## dataset not needed elsewhere + + as.list(environment()) %>% add_class(c("nn", "model")) +} + +#' Center or standardize variables in a data frame +#' +#' @param dataset Data frame +#' @param center Center data (TRUE or FALSE) +#' @param scale Scale data (TRUE or FALSE) +#' @param sf Scaling factor (default is 2) +#' @param wts Weights to use (default is NULL for no weights) +#' @param calc Calculate mean and sd or use attributes attached to dat +#' +#' @return Scaled data frame +#' +#' @export +scale_df <- function(dataset, center = TRUE, scale = TRUE, + sf = 2, wts = NULL, calc = TRUE) { + isNum <- sapply(dataset, function(x) is.numeric(x)) + if (length(isNum) == 0 || sum(isNum) == 0) { + return(dataset) + } + cn <- names(isNum)[isNum] + + ## remove set_attr calls when dplyr removes and keep attributes appropriately + descr <- attr(dataset, "description") + if (calc) { + if (length(wts) == 0) { + ms <- summarise_at(dataset, .vars = cn, .funs = ~ mean(., na.rm = TRUE)) %>% + set_attr("description", NULL) + if (scale) { + sds <- summarise_at(dataset, .vars = cn, .funs = ~ sd(., na.rm = TRUE)) %>% + set_attr("description", NULL) + } + } else { + ms <- summarise_at(dataset, .vars = cn, .funs = ~ weighted.mean(., wts, na.rm = TRUE)) %>% + set_attr("description", NULL) + if (scale) { + sds <- summarise_at(dataset, .vars = cn, .funs = ~ weighted.sd(., wts, na.rm = TRUE)) %>% + set_attr("description", NULL) + } + } + } else { + ms <- attr(dataset, "radiant_ms") + sds <- attr(dataset, "radiant_sds") + if (is.null(ms) && is.null(sds)) { + return(dataset) + } + } + if (center && scale) { + icn <- intersect(names(ms), cn) + dataset[icn] <- lapply(icn, function(var) (dataset[[var]] - ms[[var]]) / (sf * sds[[var]])) + dataset %>% + set_attr("radiant_ms", ms) %>% + set_attr("radiant_sds", sds) %>% + set_attr("radiant_sf", sf) %>% + set_attr("description", descr) + } else if (center) { + icn <- intersect(names(ms), cn) + dataset[icn] <- lapply(icn, function(var) dataset[[var]] - ms[[var]]) + dataset %>% + set_attr("radiant_ms", ms) %>% + set_attr("description", descr) + } else if (scale) { + icn <- intersect(names(sds), cn) + dataset[icn] <- lapply(icn, function(var) dataset[[var]] / (sf * sds[[var]])) + set_attr("radiant_sds", sds) %>% + set_attr("radiant_sf", sf) %>% + set_attr("description", descr) + } else { + dataset + } +} + +#' Summary method for the nn function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/nn.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{nn}} +#' @param prn Print list of weights +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- nn(titanic, "survived", "pclass", lev = "Yes") +#' summary(result) +#' @seealso \code{\link{nn}} to generate results +#' @seealso \code{\link{plot.nn}} to plot results +#' @seealso \code{\link{predict.nn}} for prediction +#' +#' @export +summary.nn <- function(object, prn = TRUE, ...) { + if (is.character(object)) { + return(object) + } + cat("Neural Network\n") + if (object$type == "classification") { + cat("Activation function : Logistic (classification)") + } else { + cat("Activation function : Linear (regression)") + } + cat("\nData :", object$df_name) + if (!is.empty(object$data_filter)) { + cat("\nFilter :", gsub("\\n", "", object$data_filter)) + } + if (!is.empty(object$arr)) { + cat("\nArrange :", gsub("\\n", "", object$arr)) + } + if (!is.empty(object$rows)) { + cat("\nSlice :", gsub("\\n", "", object$rows)) + } + cat("\nResponse variable :", object$rvar) + if (object$type == "classification") { + cat("\nLevel :", object$lev, "in", object$rvar) + } + cat("\nExplanatory variables:", paste0(object$evar, collapse = ", "), "\n") + if (length(object$wtsname) > 0) { + cat("Weights used :", object$wtsname, "\n") + } + cat("Network size :", object$size, "\n") + cat("Parameter decay :", object$decay, "\n") + if (!is.empty(object$seed)) { + cat("Seed :", object$seed, "\n") + } + + network <- paste0(object$model$n, collapse = "-") + nweights <- length(object$model$wts) + cat("Network :", network, "with", nweights, "weights\n") + + if (!is.empty(object$wts, "None") && (length(unique(object$wts)) > 2 || min(object$wts) >= 1)) { + cat("Nr obs :", format_nr(sum(object$wts), dec = 0), "\n") + } else { + cat("Nr obs :", format_nr(length(object$rv), dec = 0), "\n") + } + + if (object$model$convergence != 0) { + cat("\n** The model did not converge **") + } else { + if (prn) { + cat("Weights :\n") + oop <- base::options(width = 100) + on.exit(base::options(oop), add = TRUE) + capture.output(summary(object$model))[-1:-2] %>% + gsub("^", " ", .) %>% + paste0(collapse = "\n") %>% + cat("\n") + } + } +} + +#' Variable importance using the vip package and permutation importance +#' +#' @param object Model object created by Radiant +#' @param rvar Label to identify the response or target variable +#' @param lev Reference class for binary classifier (rvar) +#' @param data Data to use for prediction. Will default to the data used to estimate the model +#' @param seed Random seed for reproducibility +#' +#' @importFrom vip vi +#' +#' @export +varimp <- function(object, rvar, lev, data = NULL, seed = 1234) { + if (is.null(data)) data <- object$model$model + + # needed to avoid rescaling during prediction + object$check <- setdiff(object$check, c("center", "standardize")) + + arg_list <- list(object, pred_data = data, se = FALSE) + if (missing(rvar)) rvar <- object$rvar + if (missing(lev) && object$type == "classification") { + if (!is.empty(object$lev)) { + lev <- object$lev + } + if (!is.logical(data[[rvar]])) { + # don't change if already logical + data[[rvar]] <- data[[rvar]] == lev + } + } else if (object$type == "classification") { + data[[rvar]] <- data[[rvar]] == lev + } + + fun <- function(object, arg_list) do.call(predict, arg_list)[["Prediction"]] + if (inherits(object, "rforest")) { + arg_list$OOB <- FALSE # all 0 importance scores when using OOB + if (object$type == "classification") { + fun <- function(object, arg_list) do.call(predict, arg_list)[[object$lev]] + } + } + + pred_fun <- function(object, newdata) { + arg_list$pred_data <- newdata + fun(object, arg_list) + } + + set.seed(seed) + if (object$type == "regression") { + vimp <- vip::vi( + object, + target = rvar, + method = "permute", + metric = "rsq", # "rmse" + pred_wrapper = pred_fun, + train = data + ) + } else { + # required after transition to yardstick by the vip package + data[[rvar]] <- factor(data[[rvar]], levels = c("TRUE", "FALSE")) + vimp <- vip::vi( + object, + target = rvar, + event_level = "first", + method = "permute", + metric = "roc_auc", + pred_wrapper = pred_fun, + train = data + ) + } + + vimp %>% + filter(Importance != 0) %>% + mutate(Variable = factor(Variable, levels = rev(Variable))) +} + +#' Plot permutation importance +#' +#' @param object Model object created by Radiant +#' @param rvar Label to identify the response or target variable +#' @param lev Reference class for binary classifier (rvar) +#' @param data Data to use for prediction. Will default to the data used to estimate the model +#' @param seed Random seed for reproducibility +#' +#' @importFrom vip vi +#' +#' @export +varimp_plot <- function(object, rvar, lev, data = NULL, seed = 1234) { + vi_scores <- varimp(object, rvar, lev, data = data, seed = seed) + visualize(vi_scores, yvar = "Importance", xvar = "Variable", type = "bar", custom = TRUE) + + labs( + title = "Permutation Importance", + x = NULL, + y = ifelse(object$type == "regression", "Importance (R-square decrease)", "Importance (AUC decrease)") + ) + + coord_flip() + + theme(axis.text.y = element_text(hjust = 0)) +} + +#' Plot method for the nn function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/nn.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{nn}} +#' @param plots Plots to produce for the specified Neural Network model. Use "" to avoid showing any plots (default). Options are "olden" or "garson" for importance plots, or "net" to depict the network structure +#' @param size Font size used +#' @param pad_x Padding for explanatory variable labels in the network plot. Default value is 0.9, smaller numbers (e.g., 0.5) increase the amount of padding +#' @param nrobs Number of data points to show in dashboard scatter plots (-1 for all) +#' @param incl Which variables to include in a coefficient plot or PDP plot +#' @param incl_int Which interactions to investigate in PDP plots +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- nn(titanic, "survived", c("pclass", "sex"), lev = "Yes") +#' plot(result, plots = "net") +#' plot(result, plots = "olden") +#' @seealso \code{\link{nn}} to generate results +#' @seealso \code{\link{summary.nn}} to summarize results +#' @seealso \code{\link{predict.nn}} for prediction +#' +#' @importFrom NeuralNetTools plotnet olden garson +#' @importFrom graphics par +#' +#' @export +plot.nn <- function(x, plots = "vip", size = 12, pad_x = 0.9, nrobs = -1, + incl = NULL, incl_int = NULL, + shiny = FALSE, custom = FALSE, ...) { + if (is.character(x) || !inherits(x$model, "nnet")) { + return(x) + } + plot_list <- list() + nrCol <- 1 + + if ("olden" %in% plots || "olsen" %in% plots) { ## legacy for typo + plot_list[["olsen"]] <- NeuralNetTools::olden(x$model, x_lab = x$coefnames, cex_val = 4) + + coord_flip() + + theme_set(theme_gray(base_size = size)) + + theme(legend.position = "none") + + labs(title = paste0("Olden plot of variable importance (size = ", x$size, ", decay = ", x$decay, ")")) + } + + if ("garson" %in% plots) { + plot_list[["garson"]] <- NeuralNetTools::garson(x$model, x_lab = x$coefnames) + + coord_flip() + + theme_set(theme_gray(base_size = size)) + + theme(legend.position = "none") + + labs(title = paste0("Garson plot of variable importance (size = ", x$size, ", decay = ", x$decay, ")")) + } + + if ("vip" %in% plots) { + vi_scores <- varimp(x) + plot_list[["vip"]] <- + visualize(vi_scores, yvar = "Importance", xvar = "Variable", type = "bar", custom = TRUE) + + labs( + title = paste0("Permutation Importance (size = ", x$size, ", decay = ", x$decay, ")"), + x = NULL, + y = ifelse(x$type == "regression", "Importance (R-square decrease)", "Importance (AUC decrease)") + ) + + coord_flip() + + theme(axis.text.y = element_text(hjust = 0)) + } + + if ("net" %in% plots) { + ## don't need as much spacing at the top and bottom + mar <- par(mar = c(0, 4.1, 0, 2.1)) + on.exit(par(mar = mar$mar)) + return(do.call(NeuralNetTools::plotnet, list(mod_in = x$model, x_names = x$coefnames, pad_x = pad_x, cex_val = size / 16))) + } + + if ("pred_plot" %in% plots) { + nrCol <- 2 + if (length(incl) > 0 | length(incl_int) > 0) { + plot_list <- pred_plot(x, plot_list, incl, incl_int, ...) + } else { + return("Select one or more variables to generate Prediction plots") + } + } + + if ("pdp" %in% plots) { + nrCol <- 2 + if (length(incl) > 0 || length(incl_int) > 0) { + plot_list <- pdp_plot(x, plot_list, incl, incl_int, ...) + } else { + return("Select one or more variables to generate Partial Dependence Plots") + } + } + + if (x$type == "regression" && "dashboard" %in% plots) { + plot_list <- plot.regress(x, plots = "dashboard", lines = "line", nrobs = nrobs, custom = TRUE) + nrCol <- 2 + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = nrCol) %>% + (function(x) if (isTRUE(shiny)) x else print(x)) + } + } +} + +#' Predict method for the nn function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/nn.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{nn}} +#' @param pred_data Provide the dataframe to generate predictions (e.g., diamonds). The dataset must contain all columns used in the estimation +#' @param pred_cmd Generate predictions using a command. For example, `pclass = levels(pclass)` would produce predictions for the different levels of factor `pclass`. To add another variable, create a vector of prediction strings, (e.g., c('pclass = levels(pclass)', 'age = seq(0,100,20)') +#' @param dec Number of decimals to show +#' @param envir Environment to extract data from +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- nn(titanic, "survived", c("pclass", "sex"), lev = "Yes") +#' predict(result, pred_cmd = "pclass = levels(pclass)") +#' result <- nn(diamonds, "price", "carat:color", type = "regression") +#' predict(result, pred_cmd = "carat = 1:3") +#' predict(result, pred_data = diamonds) %>% head() +#' @seealso \code{\link{nn}} to generate the result +#' @seealso \code{\link{summary.nn}} to summarize results +#' +#' @export +predict.nn <- function(object, pred_data = NULL, pred_cmd = "", + dec = 3, envir = parent.frame(), ...) { + if (is.character(object)) { + return(object) + } + + ## ensure you have a name for the prediction dataset + if (is.data.frame(pred_data)) { + df_name <- deparse(substitute(pred_data)) + } else { + df_name <- pred_data + } + + pfun <- function(model, pred, se, conf_lev) { + pred_val <- try(sshhr(predict(model, pred)), silent = TRUE) + + if (!inherits(pred_val, "try-error")) { + pred_val %<>% as.data.frame(stringsAsFactors = FALSE) %>% + select(1) %>% + set_colnames("Prediction") + } + + pred_val + } + + predict_model(object, pfun, "nn.predict", pred_data, pred_cmd, conf_lev = 0.95, se = FALSE, dec, envir = envir) %>% + set_attr("radiant_pred_data", df_name) +} + +#' Print method for predict.nn +#' +#' @param x Return value from prediction method +#' @param ... further arguments passed to or from other methods +#' @param n Number of lines of prediction results to print. Use -1 to print all lines +#' +#' @export +print.nn.predict <- function(x, ..., n = 10) { + print_predict_model(x, ..., n = n, header = "Neural Network") +} + +#' Cross-validation for a Neural Network +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/nn.html} for an example in Radiant +#' +#' @param object Object of type "nn" or "nnet" +#' @param K Number of cross validation passes to use +#' @param repeats Repeated cross validation +#' @param size Number of units (nodes) in the hidden layer +#' @param decay Parameter decay +#' @param seed Random seed to use as the starting point +#' @param trace Print progress +#' @param fun Function to use for model evaluation (i.e., auc for classification and RMSE for regression) +#' @param ... Additional arguments to be passed to 'fun' +#' +#' @return A data.frame sorted by the mean of the performance metric +#' +#' @seealso \code{\link{nn}} to generate an initial model that can be passed to cv.nn +#' @seealso \code{\link{Rsq}} to calculate an R-squared measure for a regression +#' @seealso \code{\link{RMSE}} to calculate the Root Mean Squared Error for a regression +#' @seealso \code{\link{MAE}} to calculate the Mean Absolute Error for a regression +#' @seealso \code{\link{auc}} to calculate the area under the ROC curve for classification +#' @seealso \code{\link{profit}} to calculate profits for classification at a cost/margin threshold +#' +#' @importFrom nnet nnet.formula +#' @importFrom shiny getDefaultReactiveDomain withProgress incProgress +#' +#' @examples +#' \dontrun{ +#' result <- nn(dvd, "buy", c("coupon", "purch", "last")) +#' cv.nn(result, decay = seq(0, 1, .5), size = 1:2) +#' cv.nn(result, decay = seq(0, 1, .5), size = 1:2, fun = profit, cost = 1, margin = 5) +#' result <- nn(diamonds, "price", c("carat", "color", "clarity"), type = "regression") +#' cv.nn(result, decay = seq(0, 1, .5), size = 1:2) +#' cv.nn(result, decay = seq(0, 1, .5), size = 1:2, fun = Rsq) +#' } +#' +#' @export +cv.nn <- function(object, K = 5, repeats = 1, decay = seq(0, 1, .2), size = 1:5, + seed = 1234, trace = TRUE, fun, ...) { + if (inherits(object, "nn")) { + ms <- attr(object$model$model, "radiant_ms")[[object$rvar]] + sds <- attr(object$model$model, "radiant_sds")[[object$rvar]] + if (length(sds) == 0) { + sds <- sf <- 1 + } else { + sf <- attr(object$model$model, "radiant_sf") + sf <- ifelse(length(sf) == 0, 2, sf) + } + object <- object$model + } else { + ms <- 0 + sds <- 1 + sf <- 1 + } + + if (inherits(object, "nnet")) { + dv <- as.character(object$call$formula[[2]]) + m <- eval(object$call[["data"]]) + weights <- eval(object$call[["weights"]]) + if (is.numeric(m[[dv]])) { + type <- "regression" + } else { + type <- "classification" + if (is.factor(m[[dv]])) { + lev <- levels(m[[dv]])[1] + } else if (is.logical(m[[dv]])) { + lev <- TRUE + } else { + stop("The level to use for classification is not clear. Use a factor of logical as the response variable") + } + } + } else { + stop("The model object does not seems to be a neural network") + } + + set.seed(seed) + tune_grid <- expand.grid(decay = decay, size = size) + out <- data.frame(mean = NA, std = NA, min = NA, max = NA, decay = tune_grid[["decay"]], size = tune_grid[["size"]]) + + if (missing(fun)) { + if (type == "classification") { + fun <- radiant.model::auc + cn <- "AUC (mean)" + } else { + fun <- radiant.model::RMSE + cn <- "RMSE (mean)" + } + } else { + cn <- glue("{deparse(substitute(fun))} (mean)") + } + + if (length(shiny::getDefaultReactiveDomain()) > 0) { + trace <- FALSE + incProgress <- shiny::incProgress + withProgress <- shiny::withProgress + } else { + incProgress <- function(...) {} + withProgress <- function(...) list(...)[["expr"]] + } + + nitt <- nrow(tune_grid) + withProgress(message = "Running cross-validation (nn)", value = 0, { + for (i in seq_len(nitt)) { + perf <- double(K * repeats) + object$call[["decay"]] <- tune_grid[i, "decay"] + object$call[["size"]] <- tune_grid[i, "size"] + if (trace) cat("Working on size", tune_grid[i, "size"], "decay", tune_grid[i, "decay"], "\n") + for (j in seq_len(repeats)) { + rand <- sample(K, nrow(m), replace = TRUE) + for (k in seq_len(K)) { + object$call[["data"]] <- quote(m[rand != k, , drop = FALSE]) + if (length(weights) > 0) { + object$call[["weights"]] <- weights[rand != k] + } + pred <- predict(eval(object$call), newdata = m[rand == k, , drop = FALSE])[, 1] + if (type == "classification") { + if (missing(...)) { + perf[k + (j - 1) * K] <- fun(pred, unlist(m[rand == k, dv]), lev) + } else { + perf[k + (j - 1) * K] <- fun(pred, unlist(m[rand == k, dv]), lev, ...) + } + } else { + pred <- pred * sf * sds + ms + rvar <- unlist(m[rand == k, dv]) * sf * sds + ms + if (missing(...)) { + perf[k + (j - 1) * K] <- fun(pred, rvar) + } else { + perf[k + (j - 1) * K] <- fun(pred, rvar, ...) + } + } + } + } + out[i, 1:4] <- c(mean(perf), sd(perf), min(perf), max(perf)) + incProgress(1 / nitt, detail = paste("\nCompleted run", i, "out of", nitt)) + } + }) + + if (type == "classification") { + out <- arrange(out, desc(mean)) + } else { + out <- arrange(out, mean) + } + ## show evaluation metric in column name + colnames(out)[1] <- cn + out +} diff --git a/radiant.model/R/radiant.R b/radiant.model/R/radiant.R new file mode 100644 index 0000000000000000000000000000000000000000..a401aab894123878a26a66f053e7602bc00c7fa7 --- /dev/null +++ b/radiant.model/R/radiant.R @@ -0,0 +1,104 @@ +#' Launch radiant.model in the default browser +#' +#' @description Launch radiant.model in the default web browser +#' @details See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +#' +#' @param state Path to state file to load +#' @param ... additional arguments to pass to shiny::runApp (e.g, port = 8080) +#' +#' @importFrom radiant.data launch +#' +#' @examples +#' \dontrun{ +#' radiant.model() +#' } +#' @export +radiant.model <- function(state, ...) radiant.data::launch(package = "radiant.model", run = "browser", state, ...) + +#' Launch radiant.model in an Rstudio window +#' +#' @details See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +#' +#' @param state Path to state file to load +#' @param ... additional arguments to pass to shiny::runApp (e.g, port = 8080) +#' +#' @importFrom radiant.data launch +#' +#' @examples +#' \dontrun{ +#' radiant.model_window() +#' } +#' @export +radiant.model_window <- function(state, ...) radiant.data::launch(package = "radiant.model", run = "window", state, ...) + +#' Launch radiant.model in the Rstudio viewer +#' +#' @details See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +#' +#' @param state Path to state file to load +#' @param ... additional arguments to pass to shiny::runApp (e.g, port = 8080) +#' +#' @importFrom radiant.data launch +#' +#' @examples +#' \dontrun{ +#' radiant.model_viewer() +#' } +#' @export +radiant.model_viewer <- function(state, ...) radiant.data::launch(package = "radiant.model", run = "viewer", state, ...) + +#' Method to evaluate sensitivity of an analysis +#' +#' @param object Object of relevant class for which to evaluate sensitivity +#' @param ... Additional arguments +#' +#' @seealso \code{\link{sensitivity.dtree}} to plot results +#' +#' @export +sensitivity <- function(object, ...) UseMethod("sensitivity", object) + +#' Method to render DiagrammeR plots +#' +#' @param object DiagrammeR plot +#' @param shiny Check if function is called from a shiny application +#' @param ... Additional arguments +#' +#' @importFrom DiagrammeR renderDiagrammeR +#' @importFrom shiny getDefaultReactiveDomain +#' +#' @export +render.DiagrammeR <- function(object, shiny = shiny::getDefaultReactiveDomain(), ...) { + ## hack for rmarkdown from Report > Rmd and Report > R + if (!is.null(shiny) && !getOption("radiant.rmarkdown", FALSE)) { + DiagrammeR::renderDiagrammeR(object) + } else { + object + } +} + +#' One hot encoding of data.frames +#' @param dataset Dataset to endcode +#' @param all Extract all factor levels (e.g., for tree-based models) +#' @param df Return a data.frame (tibble) +#' +#' @examples +#' head(onehot(diamonds, df = TRUE)) +#' head(onehot(diamonds, all = TRUE, df = TRUE)) +#' @importFrom stats contrasts +#' +#' @export +onehot <- function(dataset, all = FALSE, df = FALSE) { + if (all) { + mm <- model.matrix(~ 0 + ., + data = dataset, + contrasts.arg = lapply( + dataset[, vapply(dataset, is.factor, logical(1))], + contrasts, + contrasts = FALSE + ) + ) + } else { + mm <- model.matrix(~., model.frame(~., dataset)) + } + if (df) as.data.frame(mm, stringsAsFactors = FALSE) else mm +} diff --git a/radiant.model/R/regress.R b/radiant.model/R/regress.R new file mode 100644 index 0000000000000000000000000000000000000000..26b8ba74bfabff9ab79a7f8b76409de28d6fc09e --- /dev/null +++ b/radiant.model/R/regress.R @@ -0,0 +1,1662 @@ +#' Linear regression using OLS +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/regress.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param rvar The response variable in the regression +#' @param evar Explanatory variables in the regression +#' @param int Interaction terms to include in the model +#' @param check Use "standardize" to see standardized coefficient estimates. Use "stepwise-backward" (or "stepwise-forward", or "stepwise-both") to apply step-wise selection of variables in estimation. Add "robust" for robust estimation of standard errors (HC1) +#' @param form Optional formula to use instead of rvar, evar, and int +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param arr Expression to arrange (sort) the data on (e.g., "color, desc(price)") +#' @param rows Rows to select from the specified dataset +#' @param envir Environment to extract data from +#' +#' @return A list of all variables used in the regress function as an object of class regress +#' +#' @examples +#' regress(diamonds, "price", c("carat", "clarity"), check = "standardize") %>% summary() +#' regress(diamonds, "price", c("carat", "clarity")) %>% str() +#' +#' @seealso \code{\link{summary.regress}} to summarize results +#' @seealso \code{\link{plot.regress}} to plot results +#' @seealso \code{\link{predict.regress}} to generate predictions +#' +#' @importFrom sandwich vcovHC +#' +#' @export +regress <- function(dataset, rvar, evar, int = "", check = "", + form, data_filter = "", arr = "", rows = NULL, envir = parent.frame()) { + if (!missing(form)) { + form <- as.formula(format(form)) + vars <- all.vars(form) + rvar <- vars[1] + evar <- vars[-1] + } + + if (rvar %in% evar) { + return("Response variable contained in the set of explanatory variables.\nPlease update model specification." %>% + add_class("regress")) + } + + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + if (any(evar == ".")) { + dataset <- get_data(dataset, "", filt = data_filter, arr = arr, rows = rows, envir = envir) + evar <- setdiff(colnames(dataset), rvar) + } else { + dataset <- get_data(dataset, c(rvar, evar), filt = data_filter, arr = arr, rows = rows, envir = envir) + } + + not_vary <- colnames(dataset)[summarise_all(dataset, does_vary) == FALSE] + if (length(not_vary) > 0) { + return(paste0("The following variable(s) show no variation. Please select other variables.\n\n** ", paste0(not_vary, collapse = ", "), " **") %>% + add_class("regress")) + } + + if (!missing(form)) { + int <- setdiff(attr(terms.formula(form), "term.labels"), evar) + } + + vars <- "" + var_check(evar, colnames(dataset)[-1], int) %>% + { + vars <<- .$vars + evar <<- .$ev + int <<- .$intv + } + + ## add minmax attributes to data + mmx <- minmax(dataset) + + ## scale data + isNum <- sapply(dataset, is.numeric) + if (sum(isNum) > 0) { + if ("standardize" %in% check) { + dataset <- scale_df(dataset) + } else if ("center" %in% check) { + dataset <- scale_df(dataset, scale = FALSE) + } + } + + if (missing(form)) { + form_upper <- paste(rvar, "~", paste(vars, collapse = " + ")) %>% as.formula() + } else { + form_upper <- form + rm(form) + } + form_lower <- paste(rvar, "~ 1") %>% as.formula() + if ("stepwise" %in% check) check <- sub("stepwise", "stepwise-backward", check) + if ("stepwise-backward" %in% check) { + ## use k = 2 for AIC, use k = log(nrow(dataset)) for BIC + model <- lm(form_upper, data = dataset) %>% + step(k = 2, scope = list(lower = form_lower), direction = "backward") + } else if ("stepwise-forward" %in% check) { + model <- lm(form_lower, data = dataset) %>% + step(k = 2, scope = list(upper = form_upper), direction = "forward") + } else if ("stepwise-both" %in% check) { + model <- lm(form_lower, data = dataset) %>% + step(k = 2, scope = list(lower = form_lower, upper = form_upper), direction = "both") + } else { + model <- lm(form_upper, data = dataset) + } + + ## needed for prediction if standardization or centering is used + if ("standardize" %in% check || "center" %in% check) { + attr(model$model, "radiant_ms") <- attr(dataset, "radiant_ms") + attr(model$model, "radiant_sds") <- attr(dataset, "radiant_sds") + attr(model$model, "radiant_sf") <- attr(dataset, "radiant_sf") + } + + coeff <- tidy(model) %>% + na.omit() %>% + as.data.frame() + colnames(coeff) <- c(" ", "coefficient", "std.error", "t.value", "p.value") + + if ("robust" %in% check) { + vcov <- sandwich::vcovHC(model, type = "HC1") + coeff$std.error <- sqrt(diag(vcov)) + coeff$t.value <- coeff$coefficient / coeff$std.error + coeff$p.value <- 2 * pt(abs(coeff$t.value), df = nrow(dataset) - nrow(coeff), lower.tail = FALSE) + } + + coeff$sig_star <- sig_stars(coeff$p.value) %>% format(justify = "left") + colnames(coeff) <- c("label", "coefficient", "std.error", "t.value", "p.value", "sig_star") + hasLevs <- sapply(select(dataset, -1), function(x) is.factor(x) || is.logical(x) || is.character(x)) + if (sum(hasLevs) > 0) { + for (i in names(hasLevs[hasLevs])) { + coeff$label %<>% gsub(paste0("^", i), paste0(i, "|"), .) %>% + gsub(paste0(":", i), paste0(":", i, "|"), .) + } + rm(i) + } + + ## remove elements no longer needed + rm(dataset, hasLevs, form_lower, form_upper, isNum, envir) + + # added for consistency with other model types + type <- "regression" + + as.list(environment()) %>% add_class(c("regress", "model")) +} + +#' Summary method for the regress function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/regress.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{regress}} +#' @param sum_check Optional output. "rsme" to show the root mean squared error and the standard deviation of the residuals. "sumsquares" to show the sum of squares table. "vif" to show multicollinearity diagnostics. "confint" to show coefficient confidence interval estimates. +#' @param conf_lev Confidence level used to estimate confidence intervals (.95 is the default) +#' @param test_var Variables to evaluate in model comparison (i.e., a competing models F-test) +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- regress(diamonds, "price", c("carat", "clarity")) +#' summary(result, sum_check = c("rmse", "sumsquares", "vif", "confint"), test_var = "clarity") +#' result <- regress(ideal, "y", c("x1", "x2")) +#' summary(result, test_var = "x2") +#' ideal %>% +#' regress("y", "x1:x3") %>% +#' summary() +#' +#' @seealso \code{\link{regress}} to generate the results +#' @seealso \code{\link{plot.regress}} to plot results +#' @seealso \code{\link{predict.regress}} to generate predictions +#' +#' @importFrom car vif linearHypothesis +#' +#' @export +summary.regress <- function(object, sum_check = "", conf_lev = .95, + test_var = "", dec = 3, ...) { + if (is.character(object)) { + return(object) + } + if (class(object$model)[1] != "lm") { + return(object) + } + + if (any(grepl("stepwise", object$check))) { + step_type <- if ("stepwise-backward" %in% object$check) { + "Backward" + } else if ("stepwise-forward" %in% object$check) { + "Forward" + } else { + "Forward and Backward" + } + cat("----------------------------------------------------\n") + cat(step_type, "stepwise selection of variables\n") + cat("----------------------------------------------------\n") + } + + cat("Linear regression (OLS)\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + if (!is.empty(object$arr)) { + cat("Arrange :", gsub("\\n", "", object$arr), "\n") + } + if (!is.empty(object$rows)) { + cat("Slice :", gsub("\\n", "", object$rows), "\n") + } + cat("Response variable :", object$rvar, "\n") + cat("Explanatory variables:", paste0(object$evar, collapse = ", "), "\n") + expl_var <- if (length(object$evar) == 1) object$evar else "x" + cat(paste0("Null hyp.: the effect of ", expl_var, " on ", object$rvar, " is zero\n")) + cat(paste0("Alt. hyp.: the effect of ", expl_var, " on ", object$rvar, " is not zero\n")) + if ("standardize" %in% object$check) { + cat("**Standardized coefficients shown (2 X SD)**\n") + } else if ("center" %in% object$check) { + cat("**Centered coefficients shown (x - mean(x))**\n") + } + if ("robust" %in% object$check) { + cat("**Robust standard errors used**\n") + } + + coeff <- object$coeff + coeff$label %<>% format(justify = "left") + cat("\n") + if (all(object$coeff$p.value == "NaN")) { + coeff[, 2] %<>% (function(x) sprintf(paste0("%.", dec, "f"), x)) + print(coeff[, 1:2], row.names = FALSE) + cat("\nInsufficient variation in explanatory variable(s) to report additional statistics") + return() + } else { + p.small <- coeff$p.value < .001 + coeff[, 2:5] %<>% format_df(dec) + coeff$p.value[p.small] <- "< .001" + print(dplyr::rename(coeff, ` ` = "label", ` ` = "sig_star"), row.names = FALSE) + } + + if (nrow(object$model$model) <= (length(object$evar) + 1)) { + return("\nInsufficient observations to estimate model") + } + + reg_fit <- glance(object$model) %>% round(dec) + cat("\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n\n") + cat("R-squared:", paste0(reg_fit$r.squared, ", "), "Adjusted R-squared:", reg_fit$adj.r.squared, "\n") + + ## if stepwise returns only an intercept + if (nrow(coeff) == 1) { + return("\nModel contains only an intercept. No additional output shown") + } + + if (reg_fit["p.value"] < .001) reg_fit["p.value"] <- "< .001" + cat("F-statistic:", reg_fit$statistic, paste0("df(", reg_fit$df, ",", reg_fit$df.residual, "), p.value"), reg_fit$p.value) + cat("\nNr obs:", format_nr(reg_fit$nobs, dec = 0), "\n\n") + + if (anyNA(object$model$coeff)) { + cat("The set of explanatory variables exhibit perfect multicollinearity.\nOne or more variables were dropped from the estimation.\n") + } + + if ("rmse" %in% sum_check) { + mean(object$model$residuals^2, na.rm = TRUE) %>% + sqrt(.) %>% + round(dec) %>% + cat("Prediction error (RMSE): ", ., "\n") + cat("Residual st.dev (RSD): ", reg_fit$sigma, "\n\n") + } + + if ("sumsquares" %in% sum_check) { + atab <- anova(object$model) + nr_rows <- dim(atab)[1] + df_reg <- sum(atab$Df[-nr_rows]) + df_err <- sum(atab$Df[nr_rows]) + df_tot <- df_reg + df_err + ss_reg <- sum(atab$`Sum Sq`[-nr_rows]) + ss_err <- sum(atab$`Sum Sq`[nr_rows]) + ss_tot <- ss_reg + ss_err + ss_tab <- data.frame(matrix(nrow = 3, ncol = 2), stringsAsFactors = FALSE) + rownames(ss_tab) <- c("Regression", "Error", "Total") + colnames(ss_tab) <- c("df", "SS") + ss_tab$df <- c(df_reg, df_err, df_tot) %>% format_nr(dec = 0) + ss_tab$SS <- c(ss_reg, ss_err, ss_tot) %>% format_nr(dec = dec) + cat("Sum of squares:\n") + format(ss_tab, scientific = FALSE) %>% print() + cat("\n") + } + + if ("vif" %in% sum_check) { + if (anyNA(object$model$coeff)) { + cat("Multicollinearity diagnostics were not calculated.") + } else { + ## needed to adjust when step-wise regression is used + if (length(attributes(object$model$terms)$term.labels) > 1) { + cat("Variance Inflation Factors\n") + car::vif(object$model) %>% + { + if (is.null(dim(.))) . else .[, "GVIF"] + } %>% ## needed when factors are included + data.frame("VIF" = ., "Rsq" = 1 - 1 / ., stringsAsFactors = FALSE) %>% + round(dec) %>% + .[order(.$VIF, decreasing = T), ] %>% + { + if (nrow(.) < 8) t(.) else . + } %>% + print() + } else { + cat("Insufficient number of explanatory variables to calculate\nmulticollinearity diagnostics (VIF)\n") + } + } + cat("\n") + } + + if ("confint" %in% sum_check) { + if (anyNA(object$model$coeff)) { + cat("Confidence intervals were not calculated.\n") + } else { + ci_perc <- ci_label(cl = conf_lev) + + if ("robust" %in% object$check) { + cnfint <- radiant.model::confint_robust + } else { + cnfint <- confint + } + + cnfint(object$model, level = conf_lev, dist = "t") %>% + as.data.frame(stringsAsFactors = FALSE) %>% + set_colnames(c("Low", "High")) %>% + mutate(`+/-` = (High - Low) / 2) %>% + mutate_all(~ sprintf(paste0("%.", dec, "f"), .)) %>% + cbind(coeff[[2]], .) %>% + set_rownames(object$coeff$label) %>% + set_colnames(c("coefficient", ci_perc[1], ci_perc[2], "+/-")) %T>% + print() + cat("\n") + } + } + + if (!is.empty(test_var)) { + if (any(grepl("stepwise", object$check))) { + cat("Model comparisons are not conducted when Stepwise has been selected.\n") + } else { + sub_form <- paste(object$rvar, "~ 1") + + vars <- object$evar + if (!is.empty(object$int) && length(vars) > 1) { + ## updating test_var if needed + test_var <- unique(c(test_var, test_specs(test_var, object$int))) + vars <- c(vars, object$int) + } + + not_selected <- base::setdiff(vars, test_var) + if (length(not_selected) > 0) sub_form <- paste(". ~", paste(not_selected, collapse = " + ")) + sub_mod <- update(object$model, sub_form, data = object$model$model) %>% + anova(object$model, test = "F") + + if (sub_mod[, "Pr(>F)"][2] %>% is.na()) { + return(cat("")) + } + + matchCf <- function(clist, vlist) { + matcher <- function(vl, cn) { + if (grepl(":", vl)) { + strsplit(vl, ":") %>% + unlist() %>% + sapply(function(x) gsub("var", x, "((var.*:)|(:var))")) %>% + paste0(collapse = "|") %>% + grepl(cn) %>% + cn[.] + } else { + mf <- grepl(paste0("^", vl, "$"), cn) %>% cn[.] + if (length(mf) == 0) { + mf <- grepl(paste0("^", vl), cn) %>% cn[.] + } + mf + } + } + + cn <- names(clist) + sapply(vlist, matcher, cn) %>% unname() + } + + test_heading <- attr(sub_mod, "heading")[2] + + if ("robust" %in% object$check) { + ## http://stats.stackexchange.com/a/132521/61693 + sub_mod <- car::linearHypothesis( + object$model, + matchCf(object$model$coef, test_var), + vcov = object$vcov + ) + } + + p.value <- sub_mod[, "Pr(>F)"][2] %>% + (function(x) if (x < .001) "< .001" else round(x, dec)) + + cat(test_heading) + object$model$model[, 1] %>% + (function(x) sum((x - mean(x))^2)) %>% + (function(x) 1 - (sub_mod$RSS / x)) %>% + round(dec) %>% + cat("\nR-squared, Model 1 vs 2:", .) + cat("\nF-statistic:", sub_mod$F[2] %>% round(dec), paste0("df(", sub_mod$Res.Df[1] - sub_mod$Res.Df[2], ",", sub_mod$Res.Df[2], "), p.value ", p.value)) + } + } +} + +#' Prediction Plots +#' +#' @details Faster, but less robust, alternative for PDP plots. Variable +#' values not included in the prediction are set to either the mean or +#' the most common value (level) +#' +#' @param x Return value from a model +#' @param plot_list List used to store plots +#' @param incl Which variables to include in prediction plots +#' @param incl_int Which interactions to investigate in prediction plots +#' @param fix Set the desired limited on yhat or have it calculated automatically. +#' Set to FALSE to have y-axis limits set by ggplot2 for each plot +#' @param hline Add a horizontal line at the average of the target variable. When set to FALSE +#' no line is added. When set to a specific number, the horizontal line will be added at that value +#' @param nr Number of values to use to generate predictions for a numeric explanatory variable +#' @param minq Quantile to use for the minimum value for simulation of numeric variables +#' @param maxq Quantile to use for the maximum value for simulation of numeric variables +#' +#' @importFrom radiant.data visualize +#' @importFrom rlang .data +#' @importFrom tidyselect where +#' +#' @export +pred_plot <- function(x, plot_list = list(), incl, incl_int, fix = TRUE, hline = TRUE, nr = 20, minq = 0.025, maxq = 0.975) { + min_max <- c(Inf, -Inf) + minx <- function(x) quantile(x, p = minq) + maxx <- function(x) quantile(x, p = maxq) + + calc_ylim <- function(lab, lst, min_max) { + if (isTRUE(fix)) { + vals <- lst[[lab]] + c(min(min_max[1], min(vals)), max(min_max[2], max(vals))) + } else if (length(fix) == 2) { + fix + } else { + FALSE + } + } + + # needed to avoid rescaling during prediction + x$check <- setdiff(x$check, c("center", "standardize")) + + mod_dat <- x$model$model # [, -1, drop = FALSE] + pvar <- "Prediction" + set_pred_name <- function(pred) { + if (!pvar %in% colnames(pred)) { + pname <- colnames(pred)[ncol(mod_dat)] + colnames(pred)[colnames(pred) == pname] <- pvar + pred <- select(pred, 1:Prediction) + } + return(pred) + } + + for (pn in incl) { + df <- mod_dat[, pn, drop = FALSE] + is_num <- sapply(df, is.numeric) + if (is.numeric(df[[pn]])) { + num_range <- df[[pn]] %>% + (function(x) seq(minx(x), maxx(x), length.out = nr)) %>% + paste0(collapse = ", ") + pred <- predict(x, pred_cmd = glue("{pn} = c({num_range})"), se = FALSE) %>% + set_pred_name() + } else if (is.logical(df[[pn]])) { + pred <- predict(x, pred_cmd = glue("{pn} = c(FALSE, TRUE)"), se = FALSE) %>% + set_pred_name() + pred[[pn]] <- factor(pred[[pn]], levels = c(FALSE, TRUE)) + } else { + pred <- predict(x, pred_cmd = glue("{pn} = levels({pn})"), se = FALSE) %>% + set_pred_name() + } + plot_list[[pn]] <- visualize(pred, xvar = pn, yvar = pvar, type = "line", custom = TRUE) + labs(y = NULL) + min_max <- calc_ylim(pvar, pred, min_max) + } + + for (pn_lab in incl_int) { + iint <- strsplit(pn_lab, ":")[[1]] + df <- mod_dat[, iint, drop = FALSE] + is_num <- sapply(df, is.numeric) + if (sum(is_num) == 2) { + # 2 numeric variables + cn <- colnames(df) + num_range1 <- df[[cn[1]]] %>% + (function(x) seq(minx(x), maxx(x), length.out = nr)) %>% + paste0(collapse = ", ") + num_range2 <- df[[cn[2]]] %>% + (function(x) seq(minx(x), maxx(x), length.out = nr)) %>% + paste0(collapse = ", ") + pred <- predict(x, pred_cmd = glue("{cn[1]} = c({num_range1}), {cn[2]} = c({num_range2})"), se = FALSE) %>% set_pred_name() + plot_list[[paste0(pn_lab, "_tile")]] <- ggplot(pred, aes(x = .data[[cn[1]]], y = .data[[cn[2]]], fill = .data[[pvar]])) + + geom_tile() + } else if (sum(is_num) == 0) { + # 2 categorical variables + cn <- colnames(df) + is_lgcl <- sapply(df, is.logical) + if (sum(is_lgcl) == 2) { + pred <- predict(x, pred_cmd = glue("{cn[1]} = c(FALSE, TRUE), {cn[2]} = c(FALSE, TRUE)"), se = FALSE) %>% set_pred_name() + } else if (sum(is_lgcl) == 1) { + if (is_lgcl[1]) { + pred <- predict(x, pred_cmd = glue("{cn[2]} = levels({cn[1]}), {cn[2]} = c(FALSE, TRUE)"), se = FALSE) %>% set_pred_name() + } else { + pred <- predict(x, pred_cmd = glue("{cn[1]} = levels({cn[1]}), {cn[2]} = c(FALSE, TRUE)"), se = FALSE) %>% set_pred_name() + } + } else { + pred <- predict(x, pred_cmd = glue("{cn[1]} = levels({cn[1]}), {cn[2]} = levels({cn[2]})"), se = FALSE) %>% set_pred_name() + } + + pred <- pred %>% mutate(across(where(is.logical), function(x) factor(x, levels = c(FALSE, TRUE)))) + plot_list[[pn_lab]] <- visualize( + pred, + xvar = cn[1], yvar = pvar, type = "line", color = cn[2], custom = TRUE + ) + labs(y = NULL) + min_max <- calc_ylim(pvar, pred, min_max) + } else if (sum(is_num) == 1) { + # 1 categorical and one numeric variable + cn <- colnames(df) + cn_fct <- cn[!is_num] + cn_num <- cn[is_num] + num_range <- df[[cn_num[1]]] %>% + (function(x) seq(minx(x), maxx(x), length.out = 20)) %>% + paste0(collapse = ", ") + + if (is.logical(df[[cn_fct]])) { + pred <- predict(x, pred_cmd = glue("{cn_num[1]} = c({num_range}), {cn_fct} = c(FALSE, TRUE)"), se = FALSE) %>% + set_pred_name() + pred[[cn_fct]] <- factor(pred[[cn_fct]], levels = c(FALSE, TRUE)) + } else { + pred <- predict(x, pred_cmd = glue("{cn_num[1]} = c({num_range}), {cn_fct} = levels({cn_fct})"), se = FALSE) %>% set_pred_name() + } + + plot_list[[pn_lab]] <- plot(pred, xvar = cn_num[1], yvar = pvar, color = cn_fct, custom = TRUE) + labs(y = NULL) + min_max <- calc_ylim(pvar, pred, min_max) + } + } + + if (length(min_max) > 1) { + for (pn_lab in intersect(c(incl, incl_int), names(plot_list))) { + plot_list[[pn_lab]] <- plot_list[[pn_lab]] + ylim(min_max[1], min_max[2]) + } + } + + if (isTRUE(hline)) { + y <- mod_dat[[1]] + if (is.factor(y)) { + lev <- ifelse(is.empty(x$lev), levels(y)[1], x$lev) + y <- y == lev + } + hline <- mean(y) + } + if (is.numeric(hline)) { + for (pn_lab in intersect(c(incl, incl_int), names(plot_list))) { + plot_list[[pn_lab]] <- plot_list[[pn_lab]] + + geom_hline(yintercept = hline, lty = 2, linewidth = 0.25) + } + } + + return(plot_list) +} + +#' Create Partial Dependence Plots +#' +#' @param x Return value from a model +#' @param plot_list List used to store plots +#' @param incl Which variables to include in PDP plots +#' @param incl_int Which interactions to investigate in PDP plots +#' @param fix Set the desired limited on yhat or have it calculated automatically. +#' Set to FALSE to have y-axis limits set by ggplot2 for each plot +#' @param hline Add a horizontal line at the average of the target variable. When set to FALSE +#' no line is added. When set to a specific number, the horizontal line will be added at that value +#' @param nr Number of values to use to generate predictions for a numeric explanatory variable +#' @param minq Quantile to use for the minimum value for simulation of numeric variables +#' @param maxq Quantile to use for the maximum value for simulation of numeric variables +#' +#' @importFrom radiant.data visualize +#' @importFrom pdp partial +#' @importFrom ggplot2 autoplot +#' @importFrom tidyselect where +#' +#' @export +pdp_plot <- function(x, plot_list = list(), incl, incl_int, fix = TRUE, hline = TRUE, nr = 20, minq = 0.025, maxq = 0.975) { + pdp_list <- list() + min_max <- c(Inf, -Inf) + minx <- function(x) quantile(x, p = minq) + maxx <- function(x) quantile(x, p = maxq) + probs <- seq(minq, maxq, length.out = nr) + + calc_ylim <- function(lab, lst, min_max) { + if (isTRUE(fix)) { + vals <- lst[[lab]] + c(min(min_max[1], min(vals)), max(min_max[2], max(vals))) + } else if (length(fix) == 2) { + fix + } else { + FALSE + } + } + + mod_dat <- x$model$model + pvar <- "Prediction" + set_pred_name <- function(pred) { + if (!pvar %in% colnames(pred)) { + pname <- colnames(pred)[ncol(mod_dat)] + colnames(pred)[colnames(pred) == pname] <- pvar + pred <- select(pred, 1:Prediction) + } + return(pred) + } + + if (length(incl_int) > 0) { + incl_int <- strsplit(incl_int, ":") + } + incl <- c(incl, incl_int) + for (pn in incl) { + df <- select(x$model$model, {{ pn }}) + pn_lab <- paste0(pn, collapse = ":") + if (length(pn) < 2 & is.logical(df[[pn_lab]])) { + pdp_list[[pn_lab]] <- pdp::partial( + x$model, + pred.var = pn, + plot = FALSE, + prob = x$type == "classification", + train = x$model$model + ) + min_max <- calc_ylim("yhat", pdp_list[[pn_lab]], min_max) + } else if (length(pn) < 2 || sum(sapply(df, is.numeric)) < 2) { + pdp_list[[pn_lab]] <- pdp::partial( + x$model, + pred.var = pn, + plot = FALSE, + quantiles = TRUE, + probs = probs, + prob = x$type == "classification", + train = x$model$model + ) + min_max <- calc_ylim("yhat", pdp_list[[pn_lab]], min_max) + } else { + # issues with autoplot of interactions between two numeric variables + pdp_list[[pn_lab]] <- df %>% mutate(fake_pred = 0) + } + } + + for (pn_lab in names(pdp_list)) { + df <- pdp_list[[pn_lab]] + is_num <- sapply(df, is.numeric) + if (ncol(df) == 2) { + if (is.logical(df[[1]])) { + cn_fct <- colnames(df)[1] + df[[cn_fct]] <- factor(df[[cn_fct]], levels = c(FALSE, TRUE)) + plot_list[[pn_lab]] <- visualize(df, xvar = cn_fct, yvar = "yhat", type = "line", custom = TRUE) + + labs(y = NULL) + } else { + plot_list[[pn_lab]] <- autoplot(pdp_list[[pn_lab]]) + + labs(y = NULL) + } + } else if (sum(is_num) == 3) { + # 2 numeric variables + cn <- colnames(df) + num_range1 <- df[[cn[1]]] %>% + (function(x) seq(minx(x), maxx(x), length.out = nr)) %>% + paste0(collapse = ", ") + num_range2 <- df[[cn[2]]] %>% + (function(x) seq(minx(x), maxx(x), length.out = nr)) %>% + paste0(collapse = ", ") + pred <- predict(x, pred_cmd = glue("{cn[1]} = c({num_range1}), {cn[2]} = c({num_range2})"), se = FALSE) %>% + set_pred_name() + plot_list[[paste0(pn_lab, "_tile")]] <- ggplot(pred, aes(x = .data[[cn[1]]], y = .data[[cn[2]]], fill = .data[[pvar]])) + + geom_tile() + # giving weird results "blotchy" graphs with lots of empty space + # plot_list[[paste0(pn_lab, "_tile")]] <- autoplot(pdp_list[[pn_lab]]) + } else if (sum(is_num) == 1) { + # 2 categorical variables + cn <- colnames(df) + df <- df %>% mutate(across(where(is.logical), function(x) factor(x, levels = c(FALSE, TRUE)))) + plot_list[[pn_lab]] <- visualize( + df, + xvar = cn[1], yvar = cn[3], type = "line", color = cn[2], custom = TRUE + ) + labs(y = NULL) + } else if (sum(is_num) == 2) { + # 1 categorical and one numeric variable + cn <- colnames(df) + cn_fct <- cn[!is_num] + cn_num <- cn[is_num] + plot_list[[pn_lab]] <- visualize( + df, + xvar = cn_num[1], yvar = cn[3], type = "line", color = cn_fct, custom = TRUE + ) + labs(y = NULL) + } + } + + to_augment <- names(plot_list) %>% (function(x) x[!grepl("_tile$", x)]) + + if (length(min_max) > 1) { + for (pn_lab in to_augment) { + plot_list[[pn_lab]] <- plot_list[[pn_lab]] + ylim(min_max[1], min_max[2]) + } + } + + if (isTRUE(hline)) { + y <- mod_dat[[1]] + if (is.factor(y)) { + lev <- ifelse(is.empty(x$lev), levels(y)[1], x$lev) + y <- y == lev + } + hline <- mean(y) + } + if (is.numeric(hline)) { + for (pn_lab in to_augment) { + plot_list[[pn_lab]] <- plot_list[[pn_lab]] + + geom_hline(yintercept = hline, lty = 2, linewidth = 0.25) + } + } + + return(plot_list) +} + +#' Plot method for the regress function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/regress.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{regress}} +#' @param plots Regression plots to produce for the specified regression model. Enter "" to avoid showing any plots (default). "dist" to shows histograms (or frequency bar plots) of all variables in the model. "correlations" for a visual representation of the correlation matrix selected variables. "scatter" to show scatter plots (or box plots for factors) for the response variable with each explanatory variable. "dashboard" for a series of six plots that can be used to evaluate model fit visually. "resid_pred" to plot the explanatory variables against the model residuals. "coef" for a coefficient plot with adjustable confidence intervals and "influence" to show (potentially) influential observations +#' @param lines Optional lines to include in the select plot. "line" to include a line through a scatter plot. "loess" to include a polynomial regression fit line. To include both use c("line", "loess") +#' @param conf_lev Confidence level used to estimate confidence intervals (.95 is the default) +#' @param intercept Include the intercept in the coefficient plot (TRUE, FALSE). FALSE is the default +#' @param incl Which variables to include in a coefficient plot or PDP plot +#' @param excl Which variables to exclude in a coefficient plot +#' @param incl_int Which interactions to investigate in PDP plots +#' @param nrobs Number of data points to show in scatter plots (-1 for all) +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- regress(diamonds, "price", c("carat", "clarity")) +#' plot(result, plots = "coef", conf_lev = .99, intercept = TRUE) +#' \dontrun{ +#' plot(result, plots = "dist") +#' plot(result, plots = "scatter", lines = c("line", "loess")) +#' plot(result, plots = "resid_pred", lines = "line") +#' plot(result, plots = "dashboard", lines = c("line", "loess")) +#' } +#' @seealso \code{\link{regress}} to generate the results +#' @seealso \code{\link{summary.regress}} to summarize results +#' @seealso \code{\link{predict.regress}} to generate predictions +#' +#' @importFrom dplyr sample_n +#' @importFrom ggrepel geom_text_repel +#' @importFrom broom augment +#' @importFrom rlang .data +#' +#' @export +plot.regress <- function(x, plots = "", lines = "", + conf_lev = .95, intercept = FALSE, + incl = NULL, excl = NULL, + incl_int = NULL, nrobs = -1, + shiny = FALSE, custom = FALSE, ...) { + if (is.character(x)) { + return(x) + } + + ## checking x size + if (inherits(x$model, "lm")) { + model <- broom::augment(x$model) + } else if (inherits(x, "nn") || inherits(x, "rforest") || inherits(x, "gbt") || inherits(x, "crtree")) { + model <- x$model$model + model$pred <- predict(x, x$model$model)$Prediction + model <- lm(formula(paste0(x$rvar, " ~ ", "pred")), data = model) %>% + broom::augment() + } else { + return(x) + } + + rvar <- x$rvar + evar <- intersect(x$evar, colnames(model)) + vars <- c(rvar, evar) + + flines <- sub("loess", "", lines) %>% sub("line", "", .) + # not clear why this was needed in the first place + # nlines <- sub("jitter", "", lines) + + if (any(plots %in% c("dashboard", "scatter", "resid_pred")) && !is.empty(nrobs)) { + nrobs <- as.integer(nrobs) + if (nrobs > 0 && nrobs < nrow(model)) { + model <- sample_n(model, nrobs, replace = FALSE) + } + } + + nrCol <- 2 + plot_list <- list() + if ("dashboard" %in% plots) { + plot_list[["dash1"]] <- + visualize(model, xvar = ".fitted", yvar = rvar, type = "scatter", custom = TRUE) + + labs(title = "Actual vs Fitted values", x = "Fitted", y = "Actual") + + plot_list[["dash2"]] <- + visualize(model, xvar = ".fitted", yvar = ".resid", type = "scatter", custom = TRUE) + + labs(title = "Residuals vs Fitted", x = "Fitted values", y = "Residuals") + + plot_list[["dash3"]] <- ggplot(model, aes(y = .resid, x = seq_along(.resid))) + + geom_line() + + labs(title = "Residuals vs Row order", x = "Row order", y = "Residuals") + + plot_list[["dash4"]] <- ggplot(model, aes(sample = .data$.std.resid)) + + stat_qq(alpha = 0.5) + + labs(title = "Normal Q-Q", x = "Theoretical quantiles", y = "Standardized residuals") + + plot_list[["dash5"]] <- + visualize(model, xvar = ".resid", custom = TRUE) + + labs(title = "Histogram of residuals", x = "Residuals") + + plot_list[["dash6"]] <- ggplot(model, aes(x = .data$.resid)) + + geom_density(alpha = 0.3, fill = "green") + + stat_function(fun = dnorm, args = list(mean = mean(model$.resid), sd = sd(model$.resid)), color = "blue") + + labs(title = "Residuals vs Normal density", x = "Residuals", y = "") + + theme(axis.text.y = element_blank()) + + if ("loess" %in% lines) { + for (i in paste0("dash", 1:3)) plot_list[[i]] <- plot_list[[i]] + sshhr(geom_smooth(method = "loess", size = .75, linetype = "dotdash")) + } + + if ("line" %in% lines) { + for (i in paste0("dash", c(1, 4))) { + plot_list[[i]] <- plot_list[[i]] + geom_abline(linetype = "dotdash") + } + for (i in paste0("dash", 2:3)) { + plot_list[[i]] <- plot_list[[i]] + sshhr(geom_smooth(method = "lm", se = FALSE, size = .75, linetype = "dotdash", color = "black")) + } + } + } + + if ("dist" %in% plots) { + for (i in vars) { + plot_list[[paste0("dist", i)]] <- select_at(model, .vars = i) %>% + visualize(xvar = i, bins = 10, custom = TRUE) + } + } + + if ("scatter" %in% plots) { + for (i in evar) { + if ("factor" %in% class(model[, i])) { + plot_list[[paste0("scatter", i)]] <- select_at(model, .vars = c(i, rvar)) %>% + visualize(xvar = i, yvar = rvar, type = "scatter", check = flines, alpha = 0.2, custom = TRUE) + } else { + plot_list[[paste0("scatter", i)]] <- select_at(model, .vars = c(i, rvar)) %>% + visualize(xvar = i, yvar = rvar, type = "scatter", check = lines, custom = TRUE) + } + } + } + + if ("resid_pred" %in% plots) { + for (i in evar) { + if ("factor" %in% class(model[, i])) { + plot_list[[paste0("resid_", i)]] <- select_at(model, .vars = c(i, ".resid")) %>% + visualize(xvar = i, yvar = ".resid", type = "scatter", check = flines, alpha = 0.2, custom = TRUE) + + labs(y = "residuals") + } else { + plot_list[[paste0("resid_", i)]] <- select_at(model, .vars = c(i, ".resid")) %>% + visualize(xvar = i, yvar = ".resid", type = "scatter", check = lines, custom = TRUE) + + labs(y = "residuals") + } + } + } + + if ("coef" %in% plots) { + nrCol <- 1 + + if (nrow(x$coeff) == 1 && !intercept) { + return("** Model contains only an intercept **") + } + + yl <- if ("standardize" %in% x$check) "Coefficient (standardized)" else "Coefficient" + + if ("robust" %in% x$check) { + cnfint <- radiant.model::confint_robust + } else { + cnfint <- confint + } + + coef_df <- cnfint(x$model, level = conf_lev, dist = "t") %>% + data.frame(stringsAsFactors = FALSE) %>% + na.omit() %>% + set_colnames(c("Low", "High")) %>% + cbind(select(x$coeff, 2), .) %>% + set_rownames(x$coeff$label) %>% + { + if (!intercept) .[-1, ] else . + } %>% + mutate(variable = factor(rownames(.), levels = rownames(.))) + + if (length(incl) > 0) { + incl <- paste0("^(", paste0(incl, "[|]*", collapse = "|"), ")") + incl <- grepl(incl, coef_df$variable) + if (isTRUE(intercept)) incl[1] <- TRUE + coef_df <- coef_df[incl, ] + } + if (length(excl) > 0) { + excl <- paste0("^(", paste0(excl, "[|]*", collapse = "|"), ")") + if (isTRUE(intercept)) excl[1] <- FALSE + coef_df <- coef_df[!excl, ] + } + coef_df <- droplevels(coef_df) + + plot_list[["coef"]] <- ggplot(coef_df) + + geom_pointrange(aes( + x = .data$variable, y = .data$coefficient, + ymin = .data$Low, ymax = .data$High + )) + + geom_hline(yintercept = 0, linetype = "dotdash", color = "blue") + + labs(y = yl, x = "") + + scale_x_discrete(limits = rev(coef_df$variable)) + + coord_flip() + + theme(axis.text.y = element_text(hjust = 0)) + } + + if ("correlations" %in% plots) { + if (length(evar) == 0) { + message("Model contains only an intercept. Correlation plot cannot be generated") + } else { + return(radiant.basics:::plot.correlation(x$model$model, nrobs = nrobs)) + } + } + + if ("influence" %in% plots) { + nrCol <- 1 + + ## based on http://www.sthda.com/english/articles/36-classification-methods-essentials/148-logistic-regression-assumptions-and-diagnostics-in-r/ + mod <- model %>% + select(.std.resid, .cooksd) %>% + mutate(index = 1:n(), .cooksd.max = .cooksd) %>% + arrange(desc(.cooksd)) %>% + mutate(index.max = 1:n(), .cooksd.max = ifelse(index.max < 4, .cooksd, NA)) %>% + mutate(index.max = ifelse(index.max < 4, index, NA)) %>% + arrange(index) + + mod <- mutate(mod, .std.resid = ifelse(abs(.std.resid) < 1 & is.na(index.max), NA, .std.resid)) + lim <- max(abs(mod$.std.resid), na.rm = TRUE) %>% + (function(x) c(min(-4, -x), max(4, x))) + plot_list[["influence"]] <- ggplot(mod, aes(index, .std.resid)) + + geom_point(aes(size = .cooksd), alpha = 0.5) + + ggrepel::geom_text_repel(aes(label = index.max)) + + geom_hline(yintercept = c(-1, -3, 1, 3), linetype = "longdash", linewidth = 0.25) + + scale_y_continuous(breaks = -4:4, limits = lim) + + labs( + title = "Influential observations", + x = "Observation index", + y = "Standardized residuals", + size = "cooksd" + ) + } + + rem <- c() + if (any(grepl("stepwise", x$check))) { + if (length(incl) > 0 | length(incl_int) > 0) { + if (sum(incl %in% evar) < length(incl)) { + rem <- incl[!incl %in% evar] + } + if (length(incl_int) > 0) { + incl_int_split <- strsplit(incl_int, ":") %>% + unlist() %>% + unique() + if (sum(incl_int_split %in% evar) < length(incl_int_split)) { + rem <- c(rem, incl_int_split[!incl_int_split %in% evar]) %>% unique() + } + } + } + } + + if ("pred_plot" %in% plots) { + nrCol <- 2 + if (length(incl) > 0 | length(incl_int) > 0) { + if (length(rem) > 0) { + return(paste("The following variables are not in the model:", paste(rem, collapse = ", "))) + } + plot_list <- pred_plot(x, plot_list, incl, incl_int, ...) + } else { + return("Select one or more variables to generate Prediction plots") + } + } + + if ("pdp" %in% plots) { + nrCol <- 2 + if (length(incl) > 0 | length(incl_int) > 0) { + if (length(rem) > 0) { + return(paste("The following variables are not in the model:", paste(rem, collapse = ", "))) + } + plot_list <- pdp_plot(x, plot_list, incl, incl_int, ...) + } else { + return("Select one or more variables to generate Partial Dependence Plots") + } + } + + if ("vip" %in% plots) { + nrCol <- 1 + if (length(evar) < 2) { + message("Model must contain at least 2 explanatory variables (features). Permutation Importance plot cannot be generated") + } else { + if (any(grepl("stepwise", x$check))) x$evar <- evar + vi_scores <- varimp(x) + plot_list[["vip"]] <- + visualize(vi_scores, yvar = "Importance", xvar = "Variable", type = "bar", custom = TRUE) + + labs( + title = "Permutation Importance", + x = NULL, + y = "Importance (R-square decrease)" + ) + + coord_flip() + + theme(axis.text.y = element_text(hjust = 0)) + } + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = nrCol) %>% + (function(x) if (isTRUE(shiny)) x else print(x)) + } + } +} + +#' Predict method for the regress function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/regress.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{regress}} +#' @param pred_data Provide the dataframe to generate predictions (e.g., diamonds). The dataset must contain all columns used in the estimation +#' @param pred_cmd Command used to generate data for prediction +#' @param conf_lev Confidence level used to estimate confidence intervals (.95 is the default) +#' @param se Logical that indicates if prediction standard errors should be calculated (default = FALSE) +#' @param interval Type of interval calculation ("confidence" or "prediction"). Set to "none" if se is FALSE +#' @param dec Number of decimals to show +#' @param envir Environment to extract data from +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- regress(diamonds, "price", c("carat", "clarity")) +#' predict(result, pred_cmd = "carat = 1:10") +#' predict(result, pred_cmd = "clarity = levels(clarity)") +#' result <- regress(diamonds, "price", c("carat", "clarity"), int = "carat:clarity") +#' predict(result, pred_data = diamonds) %>% head() +#' +#' @seealso \code{\link{regress}} to generate the result +#' @seealso \code{\link{summary.regress}} to summarize results +#' @seealso \code{\link{plot.regress}} to plot results +#' +#' @export +predict.regress <- function(object, pred_data = NULL, pred_cmd = "", conf_lev = 0.95, + se = TRUE, interval = "confidence", dec = 3, + envir = parent.frame(), ...) { + if (is.character(object)) { + return(object) + } + if (isTRUE(se)) { + if (isTRUE(interval == "none")) { + se <- FALSE + } else if ("center" %in% object$check || "standardize" %in% object$check) { + message("Standard error calculations not supported when coefficients are centered or standardized") + se <- FALSE + interval <- "none" + } + } else { + interval <- "none" + } + + if (is.data.frame(pred_data)) { + df_name <- deparse(substitute(pred_data)) + } else { + df_name <- pred_data + } + + pfun <- function(model, pred, se, conf_lev) { + pred_val <- + try( + sshhr( + predict( + model, pred, + interval = ifelse(se, interval, "none"), + level = conf_lev + ) + ), + silent = TRUE + ) + + if (!inherits(pred_val, "try-error")) { + if (se) { + pred_val %<>% data.frame(stringsAsFactors = FALSE) %>% mutate(diff = .[, 3] - .[, 1]) + ci_perc <- ci_label(cl = conf_lev) + colnames(pred_val) <- c("Prediction", ci_perc[1], ci_perc[2], "+/-") + } else { + pred_val %<>% data.frame(stringsAsFactors = FALSE) %>% select(1) + colnames(pred_val) <- "Prediction" + } + } + + pred_val + } + + predict_model(object, pfun, "regress.predict", pred_data, pred_cmd, conf_lev, se, dec, envir = envir) %>% + set_attr("radiant_interval", interval) %>% + set_attr("radiant_pred_data", df_name) +} + +#' Predict method for model functions +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/regress.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{regress}} +#' @param pfun Function to use for prediction +#' @param mclass Model class to attach +#' @param pred_data Dataset to use for prediction +#' @param pred_cmd Command used to generate data for prediction (e.g., 'carat = 1:10') +#' @param conf_lev Confidence level used to estimate confidence intervals (.95 is the default) +#' @param se Logical that indicates if prediction standard errors should be calculated (default = FALSE) +#' @param dec Number of decimals to show +#' @param envir Environment to extract data from +#' @param ... further arguments passed to or from other methods +#' +#' @importFrom radiant.data set_attr +#' +#' @export +predict_model <- function(object, pfun, mclass, pred_data = NULL, pred_cmd = "", + conf_lev = 0.95, se = FALSE, dec = 3, envir = parent.frame(), + ...) { + if (is.character(object)) { + return(object) + } + if (is.empty(pred_data) && is.empty(pred_cmd)) { + return("Please select data and/or specify a command to generate predictions.\nFor example, carat = seq(.5, 1.5, .1) would produce predictions for values\n of carat starting at .5, increasing to 1.5 in increments of .1. Make sure\nto press return after you finish entering the command.\n\nAlternatively, specify a dataset to generate predictions. You could create\nthis in a spread sheet and use the paste feature in Data > Manage to bring\nit into Radiant") + } + + pred_type <- "cmd" + vars <- object$evar + if (!is.empty(pred_cmd) && is.empty(pred_data)) { + dat <- object$model$model + if ("center" %in% object$check) { + ms <- attr(object$model$model, "radiant_ms") + if (!is.null(ms)) { + dat[names(ms)] <- lapply(names(ms), function(var) (dat[[var]] + ms[[var]])) + } + } else if ("standardize" %in% object$check) { + ms <- attr(object$model$model, "radiant_ms") + sds <- attr(object$model$model, "radiant_sds") + if (!is.null(ms) && !is.null(sds)) { + sf <- attr(object$model$model, "radiant_sf") + sf <- ifelse(is.null(sf), 2, sf) + dat[names(ms)] <- lapply(names(ms), function(var) (dat[[var]] * sf * sds[[var]] + ms[[var]])) + } + } + + pred_cmd %<>% paste0(., collapse = ";") %>% + gsub("\"", "\'", .) %>% + gsub(";\\s*$", "", .) %>% + gsub(";", ",", .) + + pred <- try(eval(parse(text = paste0("with(dat, expand.grid(", pred_cmd, "))"))), silent = TRUE) + if (inherits(pred, "try-error")) { + return(paste0("The command entered did not generate valid data for prediction. The\nerror message was:\n\n", attr(pred, "condition")$message, "\n\nPlease try again. Examples are shown in the help file.")) + } + + vars <- vars[vars %in% colnames(dat)] + dat <- select_at(dat, .vars = vars) + + if (!is.null(object$model$term)) { + dat_classes <- attr(object$model$term, "dataClasses")[-1] + } else { + dat_classes <- get_class(dat) + } + + ## weights and interaction terms mess-up data manipulation below so remove from + dat_classes <- dat_classes[!grepl("(^\\(weights\\)$)|(^I\\(.+\\^[0-9]+\\)$)", names(dat_classes))] + + isFct <- dat_classes == "factor" + isOther <- dat_classes %in% c("date", "other") + isChar <- dat_classes %in% c("character") + isLog <- dat_classes == "logical" + isNum <- dat_classes %in% c("numeric", "integer", "ts", "period") + + # based on http://stackoverflow.com/questions/19982938/how-to-find-the-most-frequent-values-across-several-columns-containing-factors + max_freq <- function(x) names(which.max(table(x))) + max_ffreq <- function(x) as.factor(max_freq(x)) + max_lfreq <- function(x) ifelse(mean(x) > .5, TRUE, FALSE) + + plug_data <- data.frame(init___ = 1, stringsAsFactors = FALSE) + if (sum(isNum) > 0) { + plug_data %<>% bind_cols(., summarise_at(dat, .vars = vars[isNum], .funs = mean, na.rm = TRUE)) + } + if (sum(isFct) > 0) { + plug_data %<>% bind_cols(., summarise_at(dat, .vars = vars[isFct], .funs = max_ffreq)) + } + if (sum(isChar) > 0) { + plug_data %<>% bind_cols(., summarise_at(dat, .vars = vars[isChar], .funs = max_freq)) + } + if (sum(isOther) > 0) { + plug_data %<>% bind_cols(., summarise_at(dat, .vars = vars[isOther], .funs = max_freq) %>% mutate_all(as.Date, origin = "1970-1-1")) + } + if (sum(isLog) > 0) { + plug_data %<>% bind_cols(., summarise_at(dat, .vars = vars[isLog], .funs = max_lfreq)) + } + + isPDO <- colnames(plug_data)[get_class(plug_data) %in% c("date", "other")] + isPDO <- dplyr::intersect(isPDO, colnames(pred)) + if (length(isPDO) > 0) { + pred %<>% mutate_at(.vars = isPDO, as.Date, origin = "1970-1-1") + } + + if ((sum(isNum) + sum(isFct) + sum(isLog) + sum(isChar) + sum(isOther)) < length(vars)) { + return("The model includes data-types that cannot be used for\nprediction at this point\n") + } else { + pred_names <- names(pred) + if (sum(pred_names %in% names(plug_data)) < length(pred_names)) { + vars_in <- pred_names %in% names(plug_data) + return(paste0("The command entered contains variable names that are not in the model\nVariables in the model: ", paste0(vars, collapse = ", "), "\nVariables not available in prediction data: ", paste0(pred_names[!vars_in], collapse = ", "))) + } else { + plug_data[names(pred)] <- list(NULL) + pred <- cbind(select(plug_data, -1), pred) + } + } + } else { + ## generate predictions for all observations in the dataset + pred <- get_data(pred_data, filt = "", rows = NULL, na.rm = FALSE, envir = envir) + pred_names <- colnames(pred) + vars_in <- vars %in% pred_names + ## keep all variables in the prediction data for the "customized" prediction + if (!sum(vars_in) == length(vars)) { + return(paste0("All variables in the model must also be in the prediction data\nVariables in the model: ", paste0(vars, collapse = ", "), "\nVariables not available in prediction data: ", paste0(vars[!vars_in], collapse = ", "))) + } + + if (!is.empty(pred_cmd)) { + pred_cmd %<>% paste0(., collapse = ";") %>% + gsub("\"", "\'", .) %>% + gsub("\\s+", " ", .) %>% + gsub("<-", "=", .) + + cmd_vars <- strsplit(pred_cmd, ";\\s*")[[1]] %>% + strsplit(., "=") %>% + sapply("[", 1) %>% + gsub("(^\\s+|\\s+$)", "", .) + + cmd_vars_in <- cmd_vars %in% vars + if (sum(cmd_vars_in) < length(cmd_vars)) { + return(paste0("The command entered contains variable names that are not in the model\nVariables in the model: ", paste0(vars, collapse = ", "), "\nVariables not available in prediction data: ", paste0(cmd_vars[!cmd_vars_in], collapse = ", "))) + } + + dots <- rlang::parse_exprs(pred_cmd) %>% + set_names(cmd_vars) + + ## any variables of type date? + isPDO <- colnames(pred)[get_class(pred) %in% c("date", "other")] + + pred <- try(mutate(pred, !!!dots), silent = TRUE) + if (inherits(pred, "try-error")) { + return(paste0("The command entered did not generate valid data for prediction. The\nerror message was:\n\n", attr(pred, "condition")$message, "\n\nPlease try again. Examples are shown in the help file.")) + } + + if (length(isPDO) > 0) { + pred %<>% mutate_at(.vars = isPDO, as.Date, origin = "1970-1-1") + } + + pred_type <- "datacmd" + } else { + pred_type <- "data" + } + + ## only keep the variables used in the model + pred <- select_at(pred, .vars = vars) %>% na.omit() + } + + if ("crtree" %in% class(object)) { + ## also need to update data in crtree because + ## logicals would get < 0.5 and >= 0.5 otherwise + pred <- mutate_if(pred, is.logical, as.factor) + } + + ## scale predictors if needed + if ("center" %in% object$check || "standardize" %in% object$check) { + attr(pred, "radiant_ms") <- attr(object$model$model, "radiant_ms") + if ("standardize" %in% object$check) { + scale <- TRUE + attr(pred, "radiant_sds") <- attr(object$model$model, "radiant_sds") + attr(pred, "radiant_sf") <- attr(object$model$model, "radiant_sf") + } else { + scale <- FALSE + } + pred_val <- scale_df(pred, center = TRUE, scale = scale, calc = FALSE) %>% + pfun(object$model, ., se = se, conf_lev = conf_lev, ...) + } else { + ## generate predictions using the supplied function (pfun) + pred_val <- pfun(object$model, pred, se = se, conf_lev = conf_lev, ...) + } + + if (!inherits(pred_val, "try-error")) { + ## scale rvar for regression models + if ("center" %in% object$check) { + ms <- attr(object$model$model, "radiant_ms")[[object$rvar]] + if (!is.null(ms)) { + pred_val[["Prediction"]] <- pred_val[["Prediction"]] + ms + } + } else if ("standardize" %in% object$check) { + ms <- attr(object$model$model, "radiant_ms")[[object$rvar]] + sds <- attr(object$model$model, "radiant_sds")[[object$rvar]] + if (!is.null(ms) && !is.null(sds)) { + sf <- attr(object$model$model, "radiant_sf") + sf <- ifelse(is.null(sf), 2, sf) + pred_val[["Prediction"]] <- pred_val[["Prediction"]] * sf * sds + ms + } + } + + pred <- data.frame(pred, pred_val, check.names = FALSE, stringsAsFactors = FALSE) + vars <- colnames(pred) + + if (any(grepl("stepwise", object$check))) { + ## show only the selected variables when printing predictions + object$evar <- attr(terms(object$model), "variables") %>% + as.character() %>% + .[-c(1, 2)] + vars <- c(object$evar, colnames(pred_val)) + } + + extra_args <- list(...) + pred <- set_attr(pred, "radiant_df_name", object$df_name) %>% + set_attr("radiant_data_filter", object$data_filter) %>% + set_attr("radiant_arr", object$arr) %>% + set_attr("radiant_rows", object$rows) %>% + set_attr("radiant_rvar", object$rvar) %>% + set_attr("radiant_lev", object$lev) %>% + set_attr("radiant_evar", object$evar) %>% + set_attr("radiant_wtsname", object$wtsname) %>% + set_attr("radiant_vars", vars) %>% + set_attr("radiant_dec", dec) %>% + set_attr("radiant_pred_type", pred_type) %>% + set_attr("radiant_pred_cmd", pred_cmd) %>% + set_attr("radiant_extra_args", extra_args) + + return(add_class(pred, c(mclass, "model.predict"))) + } else { + return(paste0("There was an error trying to generate predictions. The error\nmessage was:\n\n", attr(pred_val, "condition")$message, "\n\nPlease try again. Examples are shown in the help file.")) + } +} + +#' Print method for the model prediction +#' +#' @param x Return value from prediction method +#' @param ... further arguments passed to or from other methods +#' @param n Number of lines of prediction results to print. Use -1 to print all lines +#' @param header Header line +#' +#' @export +print_predict_model <- function(x, ..., n = 10, header = "") { + class(x) <- "data.frame" + data_filter <- attr(x, "radiant_data_filter") + arr <- attr(x, "radiant_arr") + rows <- attr(x, "radiant_rows") + vars <- attr(x, "radiant_vars") + pred_type <- attr(x, "radiant_pred_type") + pred_data <- attr(x, "radiant_pred_data") + + pred_cmd <- gsub("\\s*([\\=\\+\\*-])\\s*", " \\1 ", attr(x, "radiant_pred_cmd")) %>% + gsub("(\\s*[;,]\\s*)", "\\1 ", .) %>% + gsub("\\s+=\\s+=\\s+", " == ", .) + + cat(header) + cat("\nData :", attr(x, "radiant_df_name"), "\n") + if (!is.empty(data_filter)) { + cat("Filter :", gsub("\\n", "", data_filter), "\n") + } + if (!is.empty(arr)) { + cat("Arrange :", gsub("\\n", "", arr), "\n") + } + if (!is.empty(rows)) { + cat("Slice :", gsub("\\n", "", rows), "\n") + } + cat("Response variable :", attr(x, "radiant_rvar"), "\n") + if (!is.empty(attr(x, "radiant_lev"))) { + cat("Level(s) :", paste0(attr(x, "radiant_lev"), collapse = ", "), "in", attr(x, "radiant_rvar"), "\n") + } + cat("Explanatory variables:", paste0(attr(x, "radiant_evar"), collapse = ", "), "\n") + if (!is.empty(attr(x, "radiant_wtsname"))) { + cat("Weights used :", attr(x, "radiant_wtsname"), "\n") + } + + if (!is.empty(attr(x, "radiant_interval"), "none")) { + cat("Interval :", attr(x, "radiant_interval"), "\n") + } + + if (pred_type == "cmd") { + cat("Prediction command :", pred_cmd, "\n") + } else if (pred_type == "datacmd") { + cat("Prediction dataset :", pred_data, "\n") + cat("Customize command :", pred_cmd, "\n") + } else { + cat("Prediction dataset :", pred_data, "\n") + } + + extra_args <- attr(x, "radiant_extra_args") + if (!is.empty(extra_args)) { + extra_args <- deparse(extra_args) %>% + sub("list\\(", "", .) %>% + sub("\\)$", "", .) + cat("Additional arguments :", extra_args, "\n") + } + + if (n == -1) { + cat("\n") + format_df(x, attr(x, "radiant_dec")) %>% + print(row.names = FALSE) + } else { + if (nrow(x) > n) { + cat("Rows shown :", n, "of", format_nr(nrow(x), dec = 0), "\n") + } + cat("\n") + head(x, n) %>% + format_df(attr(x, "radiant_dec")) %>% + print(row.names = FALSE) + } +} + +#' Print method for predict.regress +#' +#' @param x Return value from prediction method +#' @param ... further arguments passed to or from other methods +#' @param n Number of lines of prediction results to print. Use -1 to print all lines +#' +#' @export +print.regress.predict <- function(x, ..., n = 10) { + print_predict_model(x, ..., n = n, header = "Linear regression (OLS)") +} + +#' Plot method for model.predict functions +#' +#' @param x Return value from predict functions (e.g., predict.regress) +#' @param xvar Variable to display along the X-axis of the plot +#' @param facet_row Create vertically arranged subplots for each level of the selected factor variable +#' @param facet_col Create horizontally arranged subplots for each level of the selected factor variable +#' @param color Adds color to a scatter plot to generate a heat map. For a line plot one line is created for each group and each is assigned a different color +#' @param conf_lev Confidence level to use for prediction intervals (.95 is the default) +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' regress(diamonds, "price", c("carat", "clarity")) %>% +#' predict(pred_cmd = "carat = 1:10") %>% +#' plot(xvar = "carat") +#' logistic(titanic, "survived", c("pclass", "sex", "age"), lev = "Yes") %>% +#' predict(pred_cmd = c("pclass = levels(pclass)", "sex = levels(sex)", "age = 0:100")) %>% +#' plot(xvar = "age", color = "sex", facet_col = "pclass") +#' +#' @seealso \code{\link{predict.regress}} to generate predictions +#' @seealso \code{\link{predict.logistic}} to generate predictions +#' +#' @importFrom rlang .data +#' +#' @export +plot.model.predict <- function(x, xvar = "", facet_row = ".", + facet_col = ".", color = "none", + conf_lev = .95, ...) { + if (is.character(x)) { + return(x) + } + ## should work with req in regress_ui but doesn't + if (is.empty(xvar)) { + return(invisible()) + } + if (facet_col != "." && facet_row == facet_col) { + return("The same variable cannot be used for both Facet row and Facet column") + } + + cn <- colnames(x) + pvars <- "Prediction" + cnpred <- which(cn == pvars) + if (length(cnpred) == 0) { + return(invisible()) + } + if (length(cn) > cnpred) { + pvars <- c(pvars, "ymin", "ymax") + cn[cnpred + 1] <- pvars[2] + cn[cnpred + 2] <- pvars[3] + colnames(x) <- cn + } + + byvar <- NULL + if (color != "none") byvar <- color + if (facet_row != ".") { + byvar <- if (is.null(byvar)) facet_row else unique(c(byvar, facet_row)) + } + + if (facet_col != ".") { + byvar <- if (is.null(byvar)) facet_col else unique(c(byvar, facet_col)) + } + + tbv <- if (is.null(byvar)) xvar else c(xvar, byvar) + + if (any(!tbv %in% colnames(x))) { + return("Some specified plotting variables are not in the model.\nPress the Estimate button to update results.") + } + + tmp <- x %>% + select_at(.vars = c(tbv, pvars)) %>% + group_by_at(.vars = tbv) %>% + summarise_all(mean) + + if (color == "none") { + p <- ggplot(tmp, aes(x = .data[[xvar]], y = .data$Prediction)) + } else { + p <- ggplot(tmp, aes(x = .data[[xvar]], y = .data$Prediction, color = .data[[color]], group = .data[[color]])) + } + + if (length(pvars) >= 3) { + if (is.factor(tmp[[xvar]]) || length(unique(tmp[[xvar]])) < 11) { + p <- p + geom_pointrange(aes(ymin = .data$ymin, ymax = .data$ymax), size = .3) + } else { + p <- p + geom_ribbon(aes(ymin = .data$ymin, ymax = .data$ymax), fill = "grey70", color = NA, alpha = 0.5) + } + } + + ## needed now that geom_smooth no longer accepts ymin and ymax as arguments + ## can't see line properly using geom_ribbon + if (color == "none") { + p <- p + geom_line(aes(group = 1)) + } else { + p <- p + geom_line() + } + + if (facet_row != "." || facet_col != ".") { + facets <- ifelse(facet_row == ".", paste("~", facet_col), paste(facet_row, "~", facet_col)) + facet_fun <- ifelse(facet_row == ".", facet_wrap, facet_grid) + p <- p + facet_fun(as.formula(facets)) + } + + sshhr(p) +} + +#' Store predicted values generated in model functions +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/regress.html} for an example in Radiant +#' +#' @param dataset Dataset to add predictions to +#' @param object Return value from model function +#' @param name Variable name(s) assigned to predicted values +#' @param ... Additional arguments +#' +#' @examples +#' regress(diamonds, rvar = "price", evar = c("carat", "cut")) %>% +#' predict(pred_data = diamonds) %>% +#' store(diamonds, ., name = c("pred", "pred_low", "pred_high")) %>% +#' head() +#' +#' @export +store.model.predict <- function(dataset, object, name = "prediction", ...) { + if (is.empty(name)) name <- "prediction" + + ## gsub needed because trailing/leading spaces may be added to the variable name + ind <- which(colnames(object) == "Prediction") + + ## if se was calculated + if (length(name) == 1) { + name <- unlist(strsplit(name, "(\\s*,\\s*|\\s*;\\s*|\\s+)")) %>% + gsub("\\s", "", .) + } + if (length(name) > 1) { + name <- name[1:min(3, length(name))] + ind_mult <- ind:(ind + length(name[-1])) + df <- object[, ind_mult, drop = FALSE] + } else { + df <- object[, "Prediction", drop = FALSE] + } + + vars <- colnames(object)[seq_len(ind - 1)] + indr <- indexr(dataset, vars = vars, filt = "", rows = NULL, cmd = attr(object, "radiant_pred_cmd")) + pred <- as.data.frame(matrix(NA, nrow = indr$nr, ncol = ncol(df)), stringsAsFactors = FALSE) + # pred[indr$ind, ] <- as.vector(df) ## as.vector removes all attributes from df + pred[indr$ind, ] <- df %>% mutate(across(everything(), as.vector)) + + dataset[, name] <- pred + dataset +} + +#' Store residuals from a model +#' +#' @details The store method for objects of class "model". Adds model residuals to the dataset while handling missing values and filters. See \url{https://radiant-rstats.github.io/docs/model/regress.html} for an example in Radiant +#' +#' @param dataset Dataset to append residuals to +#' @param object Return value from a model function +#' @param name Variable name(s) assigned to model residuals +#' @param ... Additional arguments +#' +#' @examples +#' regress(diamonds, rvar = "price", evar = c("carat", "cut"), data_filter = "price > 1000") %>% +#' store(diamonds, ., name = "resid") %>% +#' head() +#' +#' @export +store.model <- function(dataset, object, name = "residuals", ...) { + indr <- indexr(dataset, vars = c(object$rvar, object$evar), filt = object$data_filter, arr = object$arr, rows = object$rows) + name <- unlist(strsplit(name, "(\\s*,\\s*|\\s*;\\s*|\\s+)")) %>% + gsub("\\s", "", .) + nr_res <- length(name) + res <- matrix(rep(NA, indr$nr * nr_res), ncol = nr_res) %>% + set_colnames(name) %>% + as.data.frame(stringsAsFactors = FALSE) + residuals <- object$model$residuals + if (is.vector(residuals)) { + res[indr$ind, name] <- residuals + } else { + res[indr$ind, name] <- residuals[, 1:nr_res] + } + dataset[, name] <- res + dataset +} + +#' Check if main effects for all interaction effects are included in the model +#' +#' @details If ':' is used to select a range evar is updated. See \url{https://radiant-rstats.github.io/docs/model/regress.html} for an example in Radiant +#' +#' @param ev List of explanatory variables provided to \code{\link{regress}} or \code{\link{logistic}} +#' @param cn Column names for all explanatory variables in the dataset +#' @param intv Interaction terms specified +#' +#' @return \code{vars} is a vector of right-hand side variables, possibly with interactions, \code{iv} is the list of explanatory variables, and \code{intv} are interaction terms +#' +#' @examples +#' var_check("a:d", c("a", "b", "c", "d")) +#' var_check(c("a", "b"), c("a", "b"), "a:c") +#' var_check(c("a", "b"), c("a", "b"), "a:c") +#' var_check(c("a", "b"), c("a", "b"), c("a:c", "I(b^2)")) +#' +#' @export +var_check <- function(ev, cn, intv = c()) { + ## if : is used to select a range of variables evar is updated + vars <- ev + if (length(vars) < length(cn)) vars <- ev <- cn + if (!is.empty(intv)) { + if (all(unlist(strsplit(intv[!grepl("\\^", intv)], ":")) %in% vars)) { + vars <- c(vars, intv) + } else { + cat("Interaction terms contain variables not selected as main effects.\nRemoving interactions from the estimation\n") + intv <- intv[grepl("\\^", intv)] + } + } + list(vars = vars, ev = ev, intv = intv) +} + +#' Add interaction terms to list of test variables if needed +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/regress.html} for an example in Radiant +#' +#' @param tv List of variables to use for testing for regress or logistic +#' @param int Interaction terms specified +#' +#' @return A vector of variables names to test +#' +#' @examples +#' test_specs("a", "a:b") +#' test_specs("a", c("a:b", "b:c")) +#' test_specs("a", c("a:b", "b:c", "I(c^2)")) +#' test_specs(c("a", "b", "c"), c("a:b", "b:c", "I(c^2)")) +#' +#' @export +test_specs <- function(tv, int) { + int <- int[!grepl("\\^", int)] + if (any(unlist(strsplit(int, ":")) %in% tv)) { + cat("Interaction terms contain variables specified for testing.\nRelevant interaction terms are included in the requested test.\n\n") + unique(int[unlist(sapply(tv, grep, int))]) + } else { + tv + } +} diff --git a/radiant.model/R/rforest.R b/radiant.model/R/rforest.R new file mode 100644 index 0000000000000000000000000000000000000000..343454d1b83dc8640a464d6f5ccefef83e12066a --- /dev/null +++ b/radiant.model/R/rforest.R @@ -0,0 +1,692 @@ +#' Random Forest using Ranger +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/rforest.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param rvar The response variable in the model +#' @param evar Explanatory variables in the model +#' @param type Model type (i.e., "classification" or "regression") +#' @param lev Level to use as the first column in prediction output +#' @param mtry Number of variables to possibly split at in each node. Default is the (rounded down) square root of the number variables +#' @param num.trees Number of trees to create +#' @param min.node.size Minimal node size +#' @param sample.fraction Fraction of observations to sample. Default is 1 for sampling with replacement and 0.632 for sampling without replacement +#' @param replace Sample with (TRUE) or without (FALSE) replacement. If replace is NULL it will be reset to TRUE if the sample.fraction is equal to 1 and will be set to FALSE otherwise +#' @param num.threads Number of parallel threads to use. Defaults to 12 if available +#' @param wts Case weights to use in estimation +#' @param seed Random seed to use as the starting point +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param rows Rows to select from the specified dataset +#' @param arr Expression to arrange (sort) the data on (e.g., "color, desc(price)") +#' @param envir Environment to extract data from +#' @param ... Further arguments to pass to ranger +#' +#' @return A list with all variables defined in rforest as an object of class rforest +#' +#' @examples +#' rforest(titanic, "survived", c("pclass", "sex"), lev = "Yes") %>% summary() +#' rforest(titanic, "survived", c("pclass", "sex")) %>% str() +#' rforest(titanic, "survived", c("pclass", "sex"), max.depth = 1) +#' rforest(diamonds, "price", c("carat", "clarity"), type = "regression") %>% summary() +#' +#' @seealso \code{\link{summary.rforest}} to summarize results +#' @seealso \code{\link{plot.rforest}} to plot results +#' @seealso \code{\link{predict.rforest}} for prediction +#' +#' @importFrom ranger ranger +#' @importFrom lubridate is.Date +#' +#' @export +rforest <- function(dataset, rvar, evar, type = "classification", lev = "", + mtry = NULL, num.trees = 100, min.node.size = 1, + sample.fraction = 1, replace = NULL, + num.threads = 12, wts = "None", seed = NA, + data_filter = "", arr = "", rows = NULL, envir = parent.frame(), ...) { + if (rvar %in% evar) { + return("Response variable contained in the set of explanatory variables.\nPlease update model specification." %>% + add_class("rforest")) + } + + vars <- c(rvar, evar) + + if (is.empty(wts, "None")) { + wts <- NULL + } else if (is_string(wts)) { + wtsname <- wts + vars <- c(rvar, evar, wtsname) + } + + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, envir = envir) %>% + mutate_if(is.Date, as.numeric) + + if (!is.empty(wts)) { + if (exists("wtsname")) { + wts <- dataset[[wtsname]] + dataset <- select_at(dataset, .vars = base::setdiff(colnames(dataset), wtsname)) + } + if (length(wts) != nrow(dataset)) { + return( + paste0("Length of the weights variable is not equal to the number of rows in the dataset (", format_nr(length(wts), dec = 0), " vs ", format_nr(nrow(dataset), dec = 0), ")") %>% + add_class("rforest") + ) + } + } + + not_vary <- colnames(dataset)[summarise_all(dataset, does_vary) == FALSE] + if (length(not_vary) > 0) { + return(paste0("The following variable(s) show no variation. Please select other variables.\n\n** ", paste0(not_vary, collapse = ", "), " **") %>% + add_class("rforest")) + } + + rv <- dataset[[rvar]] + + if (type == "classification") { + if (lev == "") { + if (is.factor(rv)) { + lev <- levels(rv)[1] + } else { + lev <- as.character(rv) %>% + as.factor() %>% + levels() %>% + .[1] + } + } + if (lev != levels(rv)[1]) { + dataset[[rvar]] <- relevel(dataset[[rvar]], lev) + } + probability <- TRUE + } else { + probability <- FALSE + } + + vars <- evar + ## in case : is used + if (length(vars) < (ncol(dataset) - 1)) { + vars <- evar <- colnames(dataset)[-1] + } + + if (is.empty(replace)) { + replace <- ifelse(sample.fraction < 1, FALSE, TRUE) + } + + ## use decay http://stats.stackexchange.com/a/70146/61693 + rforest_input <- list( + formula = as.formula(paste(rvar, "~ . ")), + mtry = mtry, + num.trees = num.trees, + min.node.size = min.node.size, + probability = probability, + importance = "permutation", + sample.fraction = sample.fraction, + replace = replace, + num.threads = num.threads, + case.weights = wts, + data = dataset, + ... + ) + extra_args <- list(...) + + ## based on https://stackoverflow.com/a/14324316/1974918 + seed <- gsub("[^0-9]", "", seed) + if (!is.empty(seed)) { + if (exists(".Random.seed")) { + gseed <- .Random.seed + on.exit(.Random.seed <<- gseed) + } + set.seed(seed) + } + + model <- do.call(ranger::ranger, rforest_input) + + ## rforest doesn't return residuals + if (type == "regression") { + model$residuals <- dataset[[rvar]] - model$predictions + } else { + model$residuals <- NULL + } + + ## rforest model object does not include the data by default + model$model <- dataset + + rm(dataset, envir, rforest_input) ## dataset not needed elsewhere + + ## needed to work with prediction functions + check <- "" + + as.list(environment()) %>% add_class(c("rforest", "model")) +} + +#' Summary method for the rforest function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/rforest.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{rforest}} +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- rforest(titanic, "survived", "pclass", lev = "Yes") +#' summary(result) +#' +#' @seealso \code{\link{rforest}} to generate results +#' @seealso \code{\link{plot.rforest}} to plot results +#' @seealso \code{\link{predict.rforest}} for prediction +#' +#' @export +summary.rforest <- function(object, ...) { + if (is.character(object)) { + return(object) + } + cat("Random Forest (Ranger)\n") + if (object$type == "classification") { + cat("Type : Classification") + } else { + cat("Type : Regression") + } + cat("\nData :", object$df_name) + if (!is.empty(object$data_filter)) { + cat("\nFilter :", gsub("\\n", "", object$data_filter)) + } + if (!is.empty(object$arr)) { + cat("\nArrange :", gsub("\\n", "", object$arr)) + } + if (!is.empty(object$rows)) { + cat("\nSlice :", gsub("\\n", "", object$rows)) + } + cat("\nResponse variable :", object$rvar) + if (object$type == "classification") { + cat("\nLevel :", object$lev, "in", object$rvar) + } + cat("\nExplanatory variables:", paste0(object$evar, collapse = ", "), "\n") + if (length(object$wtsname) > 0) { + cat("Weights used :", object$wtsname, "\n") + } + cat("Mtry :", object$mtry, "\n") + cat("Number of trees :", object$num.trees, "\n") + cat("Min node size :", object$min.node.size, "\n") + cat("Sample fraction :", object$sample.fraction, "\n") + cat("Number of threads :", object$num.threads, "\n") + if (length(object$extra_args)) { + extra_args <- deparse(object$extra_args) %>% + sub("list\\(", "", .) %>% + sub("\\)$", "", .) + cat("Additional arguments :", extra_args, "\n") + } + if (!is.empty(object$wts, "None") && (length(unique(object$wts)) > 2 || min(object$wts) >= 1)) { + cat("Nr obs :", format_nr(sum(object$wts), dec = 0), "\n") + } else { + cat("Nr obs :", format_nr(length(object$rv), dec = 0), "\n") + } + if (object$type != "classification") { + cat("R-squared :", format_nr(object$model$r.square, dec = 3), "\n") + } + OOB <- ifelse(object$type == "classification", object$model$prediction.error, sqrt(object$model$prediction.error)) + cat("OOB prediction error :", format_nr(OOB, dec = 3), "\n") +} + +#' Plot method for the rforest function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/rforest.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{rforest}} +#' @param plots Plots to produce for the specified Random Forest model. Use "" to avoid showing any plots (default). Options are ... +#' @param nrobs Number of data points to show in dashboard scatter plots (-1 for all) +#' @param incl Which variables to include in PDP or Prediction plots +#' @param incl_int Which interactions to investigate in PDP or Prediction plots +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. +#' This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples +#' and \url{https://ggplot2.tidyverse.org} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- rforest(titanic, "survived", c("pclass", "sex"), lev = "Yes") +#' +#' @seealso \code{\link{rforest}} to generate results +#' @seealso \code{\link{summary.rforest}} to summarize results +#' @seealso \code{\link{predict.rforest}} for prediction +#' +#' @importFrom pdp partial +#' +#' @export +plot.rforest <- function(x, plots = "", nrobs = Inf, + incl = NULL, incl_int = NULL, + shiny = FALSE, custom = FALSE, ...) { + if (is.character(x) || !inherits(x$model, "ranger")) { + return(x) + } + plot_list <- list() + nrCol <- 1 + + if (x$type == "regression" && "dashboard" %in% plots) { + plot_list <- plot.regress(x, plots = "dashboard", lines = "line", nrobs = nrobs, custom = TRUE) + nrCol <- 2 + } + + if ("pred_plot" %in% plots) { + nrCol <- 2 + if (length(incl) > 0 | length(incl_int) > 0) { + plot_list <- pred_plot(x, plot_list, incl, incl_int, ...) + } else { + return("Select one or more variables to generate Prediction plots") + } + } + + if ("pdp" %in% plots) { + nrCol <- 2 + if (length(incl) > 0 || length(incl_int) > 0) { + plot_list <- pdp_plot(x, plot_list, incl, incl_int, ...) + } else { + return("Select one or more variables to generate Partial Dependence Plots") + } + } + + if ("vimp" %in% plots) { + nrCol <- 1 + vip <- x$model$variable.importance + if (x$type == "regression") vip <- vip / max(vip) + vimp <- data.frame( + vip = vip, + vars = names(vip), + stringsAsFactors = FALSE + ) %>% + arrange(vip) %>% + mutate(vars = factor(vars, levels = vars)) + plot_list[["vimp"]] <- visualize(vimp, yvar = "vip", xvar = "vars", type = "bar", custom = TRUE) + + guides(fill = guide_legend(title = "")) + + labs(x = "", y = "Variable Importance (permutation)") + + coord_flip() + + theme(axis.text.y = element_text(hjust = 0)) + } + + if ("vip" %in% plots) { + nrCol <- 1 + if (length(x$evar) < 2) { + message("Model must contain at least 2 explanatory variables (features). Permutation Importance plot cannot be generated") + } else { + vi_scores <- varimp(x) + plot_list[["vip"]] <- + visualize(vi_scores, yvar = "Importance", xvar = "Variable", type = "bar", custom = TRUE) + + labs( + title = "Permutation Importance", + x = NULL, + y = ifelse(x$type == "regression", "Importance (R-square decrease)", "Importance (AUC decrease)") + ) + + coord_flip() + + theme(axis.text.y = element_text(hjust = 0)) + } + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = nrCol) %>% + (function(x) if (isTRUE(shiny)) x else print(x)) + } + } +} + +#' Predict method for the rforest function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/rforest.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{rforest}} +#' @param pred_data Provide the dataframe to generate predictions (e.g., diamonds). The dataset must contain all columns used in the estimation +#' @param pred_cmd Generate predictions using a command. For example, `pclass = levels(pclass)` would produce predictions for the different +#' levels of factor `pclass`. To add another variable, create a vector of prediction strings, (e.g., c('pclass = levels(pclass)', 'age = seq(0,100,20)') +#' @param pred_names Names for the predictions to be stored. If one name is provided, only the first column of predictions is stored. If empty, the levels +#' in the response variable of the rforest model will be used +#' @param OOB Use Out-Of-Bag predictions (TRUE or FALSE). Relevant when evaluating predictions for the training sample. If set to NULL, datasets will be compared +#' to determine if OOB predictions should be used +#' @param dec Number of decimals to show +#' @param envir Environment to extract data from +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- rforest(titanic, "survived", c("pclass", "sex"), lev = "Yes") +#' predict(result, pred_cmd = "pclass = levels(pclass)") +#' result <- rforest(diamonds, "price", "carat:color", type = "regression") +#' predict(result, pred_cmd = "carat = 1:3") +#' predict(result, pred_data = diamonds) %>% head() +#' +#' @seealso \code{\link{rforest}} to generate the result +#' @seealso \code{\link{summary.rforest}} to summarize results +#' +#' @export +predict.rforest <- function(object, pred_data = NULL, pred_cmd = "", + pred_names = "", OOB = NULL, dec = 3, + envir = parent.frame(), ...) { + if (is.character(object)) { + return(object) + } + + ## ensure you have a name for the prediction dataset + if (is.data.frame(pred_data)) { + df_name <- deparse(substitute(pred_data)) + } else { + df_name <- pred_data + } + + pfun <- function(model, pred, se, conf_lev, OOB = OOB) { + pred <- mutate_if(pred, is.Date, as.numeric) + if (is.empty(OOB)) { + if (isTRUE(all.equal(select(model$model, -1), pred))) { + message("Using OOB predictions after comparing the training and prediction data") + OOB <- TRUE + } + } + + if (isTRUE(OOB)) { + pred_val <- list(predictions = model$predictions) + message("Using OOB predictions") + } else { + pred_val <- try(sshhr(predict(model, pred)), silent = TRUE) + } + + if (!inherits(pred_val, "try-error")) { + pred_val <- as.data.frame(pred_val$predictions, stringsAsFactors = FALSE) + if (nrow(pred_val) != nrow(pred)) { + pred_val <- list() %>% add_class("try-error") + attr(pred_val, "condition") <- list(message = "Attempt to use OOB predictions failed. This could be because\na filter was set but the random forest model has not yet been\nre-estimated.") + } else { + if (ncol(pred_val) == 1) { + pred_names <- "Prediction" + } else if (is.empty(pred_names)) { + pred_names <- colnames(pred_val) + } + pred_val <- select(pred_val, 1:min(ncol(pred_val), length(pred_names))) %>% + set_colnames(pred_names) + } + } + + pred_val + } + + predict_model(object, pfun, "rforest.predict", pred_data, pred_cmd, conf_lev = 0.95, se = FALSE, dec, envir = envir, OOB = OOB) %>% + set_attr("radiant_pred_data", df_name) +} + +#' Print method for predict.rforest +#' +#' @param x Return value from prediction method +#' @param ... further arguments passed to or from other methods +#' @param n Number of lines of prediction results to print. Use -1 to print all lines +#' +#' @export +print.rforest.predict <- function(x, ..., n = 10) { + print_predict_model(x, ..., n = n, header = "Random Forest") +} + +#' Plot method for rforest.predict function +#' +#' @param x Return value from predict function predict.rforest +#' @param xvar Variable to display along the X-axis of the plot +#' @param facet_row Create vertically arranged subplots for each level of the selected factor variable +#' @param facet_col Create horizontally arranged subplots for each level of the selected factor variable +#' @param color Adds color to a scatter plot to generate a heat map. For a line plot one line is created for each group and each is assigned a different color +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- mnl( +#' ketchup, +#' rvar = "choice", +#' evar = c("price.heinz28", "price.heinz32", "price.heinz41", "price.hunts32"), +#' lev = "heinz28" +#' ) +#' pred <- predict(result, pred_cmd = "price.heinz28 = seq(3, 5, 0.1)") +#' plot(pred, xvar = "price.heinz28") +#' +#' @seealso \code{\link{predict.mnl}} to generate predictions +#' @importFrom rlang .data +#' +#' @export +plot.rforest.predict <- function(x, xvar = "", facet_row = ".", facet_col = ".", + color = "none", ...) { + if (color != ".class") { + return(plot.model.predict( + x, + xvar = xvar, facet_row = facet_row, facet_col = facet_col, + color = color, ... + )) + } + + ## should work with req in regress_ui but doesn't + if (is.empty(xvar)) { + return(invisible()) + } + if (is.character(x)) { + return(x) + } + if (facet_col != "." && facet_row == facet_col) { + return("The same variable cannot be used for both Facet row and Facet column") + } + + pvars <- base::setdiff(attr(x, "radiant_vars"), attr(x, "radiant_evar")) + rvar <- attr(x, "radiant_rvar") + x %<>% gather(".class", "Prediction", !!pvars) + + byvar <- c(xvar, color) + if (facet_row != ".") byvar <- unique(c(byvar, facet_row)) + if (facet_col != ".") byvar <- unique(c(byvar, facet_col)) + + tmp <- group_by_at(x, .vars = byvar) %>% + select_at(.vars = c(byvar, "Prediction")) %>% + summarise_all(mean) + p <- ggplot(tmp, aes(x = .data[[xvar]], y = .data$Prediction, color = .data[[color]], group = .data[[color]])) + + geom_line() + + if (facet_row != "." || facet_col != ".") { + facets <- ifelse(facet_row == ".", paste("~", facet_col), paste(facet_row, "~", facet_col)) + facet_fun <- ifelse(facet_row == ".", facet_wrap, facet_grid) + p <- p + facet_fun(as.formula(facets)) + } + + p <- p + guides(color = guide_legend(title = rvar)) + + sshhr(p) +} + +#' Store predicted values generated in the rforest function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/rforest.html} for an example in Radiant +#' +#' @param dataset Dataset to add predictions to +#' @param object Return value from model function +#' @param name Variable name(s) assigned to predicted values. If empty, the levels of the response variable will be used +#' @param ... Additional arguments +#' +#' @examples +#' result <- rforest( +#' ketchup, +#' rvar = "choice", +#' evar = c("price.heinz28", "price.heinz32", "price.heinz41", "price.hunts32"), +#' lev = "heinz28" +#' ) +#' pred <- predict(result, pred_data = ketchup) +#' ketchup <- store(ketchup, pred, name = c("heinz28", "heinz32", "heinz41", "hunts32")) +#' +#' @export +store.rforest.predict <- function(dataset, object, name = NULL, ...) { + ## extract the names of the variables predicted + pvars <- base::setdiff(attr(object, "radiant_vars"), attr(object, "radiant_evar")) + + ## as.vector removes all attributes from df + # df <- as.vector(object[, pvars, drop = FALSE]) + df <- object[, pvars, drop = FALSE] %>% mutate(across(everything(), as.vector)) + + if (is.empty(name)) { + name <- pvars + } else { + ## gsub needed because trailing/leading spaces may be added to the variable name + name <- unlist(strsplit(name, "(\\s*,\\s*|\\s*;\\s*|\\s+)")) %>% + gsub("\\s", "", .) + if (length(name) < length(pvars)) { + df <- df[, 1:length(name), drop = FALSE] %>% set_colnames(name) + } + } + + indr <- indexr(dataset, attr(object, "radiant_evar"), "", cmd = attr(object, "radiant_pred_cmd")) + pred <- as.data.frame(matrix(NA, nrow = indr$nr, ncol = ncol(df)), stringsAsFactors = FALSE) + pred[indr$ind, ] <- df + dataset[, name] <- pred + dataset +} + +#' Cross-validation for a Random Forest +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/rforest.html} for an example in Radiant +#' +#' @param object Object of type "rforest" or "ranger" +#' @param K Number of cross validation passes to use +#' @param repeats Repeated cross validation +#' @param mtry Number of variables to possibly split at in each node. Default is the (rounded down) square root of the number variables +#' @param num.trees Number of trees to create +#' @param min.node.size Minimal node size +#' @param sample.fraction Fraction of observations to sample. Default is 1 for sampling with replacement and 0.632 for sampling without replacement +#' @param seed Random seed to use as the starting point +#' @param trace Print progress +#' @param fun Function to use for model evaluation (i.e., auc for classification and RMSE for regression) +#' @param ... Additional arguments to be passed to 'fun' +#' +#' @return A data.frame sorted by the mean of the performance metric +#' +#' @seealso \code{\link{rforest}} to generate an initial model that can be passed to cv.rforest +#' @seealso \code{\link{Rsq}} to calculate an R-squared measure for a regression +#' @seealso \code{\link{RMSE}} to calculate the Root Mean Squared Error for a regression +#' @seealso \code{\link{MAE}} to calculate the Mean Absolute Error for a regression +#' @seealso \code{\link{auc}} to calculate the area under the ROC curve for classification +#' @seealso \code{\link{profit}} to calculate profits for classification at a cost/margin threshold +#' +#' @importFrom shiny getDefaultReactiveDomain withProgress incProgress +#' +#' @examples +#' \dontrun{ +#' result <- rforest(dvd, "buy", c("coupon", "purch", "last")) +#' cv.rforest( +#' result, +#' mtry = 1:3, min.node.size = seq(1, 10, 5), +#' num.trees = c(100, 200), sample.fraction = 0.632 +#' ) +#' result <- rforest(titanic, "survived", c("pclass", "sex"), max.depth = 1) +#' cv.rforest(result, mtry = 1:3, min.node.size = seq(1, 10, 5)) +#' cv.rforest(result, mtry = 1:3, num.trees = c(100, 200), fun = profit, cost = 1, margin = 5) +#' result <- rforest(diamonds, "price", c("carat", "color", "clarity"), type = "regression") +#' cv.rforest(result, mtry = 1:3, min.node.size = 1) +#' cv.rforest(result, mtry = 1:3, min.node.size = 1, fun = Rsq) +#' } +#' +#' @export +cv.rforest <- function(object, K = 5, repeats = 1, mtry = 1:5, num.trees = NULL, min.node.size = 1, sample.fraction = NA, + trace = TRUE, seed = 1234, fun, ...) { + if (inherits(object, "rforest")) object <- object$model + if (inherits(object, "ranger")) { + dv <- as.character(object$call$formula[[2]]) + m <- eval(object$call[["data"]]) + mtry <- mtry[mtry < ncol(m)] + weights <- eval(object$call[["case.weights"]]) + if (is.numeric(m[[dv]])) { + type <- "regression" + } else { + type <- "classification" + if (is.factor(m[[dv]])) { + lev <- levels(m[[dv]])[1] + } else if (is.logical(m[[dv]])) { + lev <- TRUE + } else { + stop("The level to use for classification is not clear. Use a factor of logical as the response variable") + } + } + } else { + stop("The model object does not seems to be a random forest") + } + + if (is.empty(num.trees)) { + num.trees <- object$call[["num.trees"]] + } + if (is.empty(sample.fraction)) { + sample.fraction <- object$call[["sample.fraction"]] + sample.fraction <- ifelse(is.null(sample.fraction), 1, sample.fraction) + } else { + object$call[["replace"]] <- FALSE + } + + set.seed(seed) + tune_grid <- expand.grid(mtry = mtry, min.node.size = min.node.size, num.trees = num.trees, sample.fraction = sample.fraction) + out <- data.frame( + mean = NA, std = NA, min = NA, max = NA, + mtry = tune_grid[["mtry"]], min.node.size = tune_grid[["min.node.size"]], + num.trees = tune_grid[["num.trees"]], sample.fraction = tune_grid[["sample.fraction"]] + ) + + if (missing(fun)) { + if (type == "classification") { + fun <- radiant.model::auc + cn <- "AUC (mean)" + } else { + fun <- radiant.model::RMSE + cn <- "RMSE (mean)" + } + } else { + cn <- glue("{deparse(substitute(fun))} (mean)") + } + + if (length(shiny::getDefaultReactiveDomain()) > 0) { + trace <- FALSE + incProgress <- shiny::incProgress + withProgress <- shiny::withProgress + } else { + incProgress <- function(...) {} + withProgress <- function(...) list(...)[["expr"]] + } + + nitt <- nrow(tune_grid) + withProgress(message = "Running cross-validation (rforest)", value = 0, { + for (i in seq_len(nitt)) { + perf <- double(K * repeats) + object$call[["mtry"]] <- tune_grid[i, "mtry"] + object$call[["min.node.size"]] <- tune_grid[i, "min.node.size"] + object$call[["num.trees"]] <- tune_grid[i, "num.trees"] + object$call[["sample.fraction"]] <- tune_grid[i, "sample.fraction"] + if (trace) { + cat("Working on mtry", tune_grid[i, "mtry"], "num.trees", tune_grid[i, "num.trees"], "\n") + } + for (j in seq_len(repeats)) { + rand <- sample(K, nrow(m), replace = TRUE) + for (k in seq_len(K)) { + object$call[["data"]] <- quote(m[rand != k, , drop = FALSE]) + if (length(weights) > 0) { + object$call[["case.weights"]] <- weights[rand != k] + } + if (type == "classification") { + pred <- predict(eval(object$call), m[rand == k, , drop = FALSE])$prediction[, 1] + if (missing(...)) { + perf[k + (j - 1) * K] <- fun(pred, unlist(m[rand == k, dv]), lev) + } else { + perf[k + (j - 1) * K] <- fun(pred, unlist(m[rand == k, dv]), lev, ...) + } + } else { + pred <- predict(eval(object$call), m[rand == k, , drop = FALSE])$prediction + rvar <- unlist(m[rand == k, dv]) + if (missing(...)) { + perf[k + (j - 1) * K] <- fun(pred, rvar) + } else { + perf[k + (j - 1) * K] <- fun(pred, rvar, ...) + } + } + } + } + out[i, 1:4] <- c(mean(perf), sd(perf), min(perf), max(perf)) + incProgress(1 / nitt, detail = paste("\nCompleted run", i, "out of", nitt)) + } + }) + + if (type == "classification") { + out <- arrange(out, desc(mean)) + } else { + out <- arrange(out, mean) + } + ## show evaluation metric in column name + colnames(out)[1] <- cn + out +} diff --git a/radiant.model/R/simulater.R b/radiant.model/R/simulater.R new file mode 100644 index 0000000000000000000000000000000000000000..1c6038d4bd4483992c3dc263d981e8bc5daa83b2 --- /dev/null +++ b/radiant.model/R/simulater.R @@ -0,0 +1,1150 @@ +#' Convenience function used in "simulater" +#' @param x Character vector to be converted to integer +#' @param dataset Data list +# +#' @return An integer vector +#' +#' @export +.as_int <- function(x, dataset = list()) { + if (is.character(x)) x <- strsplit(x, "/") %>% unlist() + asInt <- function(x) ifelse(length(x) > 1, as.integer(as.integer(x[1]) / as.integer(x[2])), as.integer(x)) + ret <- sshhr(asInt(x)) + if (is.na(ret)) { + if (x %in% names(dataset)) { + dataset[[x]] + } else if (is.na(x)) { + x + } else { + ret <- try(eval(parse(text = paste0("with(dataset, ", x, ")"))), silent = TRUE) + if (inherits(ret, "try-error")) { + cat(glue('"{x}" not (yet) defined when called. Note that simulation\nvariables of type "Constant" are always evaluated first\n\n\n')) + NA + } else { + ret + } + } + } else { + ret + } +} + +#' Convenience function used in "simulater" +#' +#' @param x Character vector to be converted to an numeric value +#' @param dataset Data list +# +#' @return An numeric vector +#' +#' @export +.as_num <- function(x, dataset = list()) { + if (is.character(x)) x <- strsplit(x, "/") %>% unlist() + asNum <- function(x) ifelse(length(x) > 1, as.numeric(x[1]) / as.numeric(x[2]), as.numeric(x)) + ret <- sshhr(asNum(x)) + if (is.na(ret)) { + if (x %in% names(dataset)) { + dataset[[x]] + } else if (is.na(x)) { + x + } else { + ret <- try(eval(parse(text = paste0("with(dataset, ", x, ")"))), silent = TRUE) + if (inherits(ret, "try-error")) { + cat(glue('"{x}" not (yet) defined when called. Note that simulation\nvariables of type "Constant" are always evaluated first\n\n\n')) + NA + } else { + ret + } + } + } else { + ret + } +} + +#' Simulate data for decision analysis +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/simulater.html} for an example in Radiant +#' +#' @param const A character vector listing the constants to include in the analysis (e.g., c("cost = 3", "size = 4")) +#' @param lnorm A character vector listing the log-normally distributed random variables to include in the analysis (e.g., "demand 2000 1000" where the first number is the log-mean and the second is the log-standard deviation) +#' @param norm A character vector listing the normally distributed random variables to include in the analysis (e.g., "demand 2000 1000" where the first number is the mean and the second is the standard deviation) +#' @param unif A character vector listing the uniformly distributed random variables to include in the analysis (e.g., "demand 0 1" where the first number is the minimum value and the second is the maximum value) +#' @param discrete A character vector listing the random variables with a discrete distribution to include in the analysis (e.g., "price 5 8 .3 .7" where the first set of numbers are the values and the second set the probabilities +#' @param binom A character vector listing the random variables with a binomial distribution to include in the analysis (e.g., "crash 100 .01") where the first number is the number of trials and the second is the probability of success) +#' @param pois A character vector listing the random variables with a poisson distribution to include in the analysis (e.g., "demand 10") where the number is the lambda value (i.e., the average number of events or the event rate) +#' @param sequ A character vector listing the start and end for a sequence to include in the analysis (e.g., "trend 1 100 1"). The number of 'steps' is determined by the number of simulations +#' @param grid A character vector listing the start, end, and step for a set of sequences to include in the analysis (e.g., "trend 1 100 1"). The number of rows in the expanded will over ride the number of simulations +#' @param data Dataset to be used in the calculations +#' @param form A character vector with the formula to evaluate (e.g., "profit = demand * (price - cost)") +#' @param funcs A named list of user defined functions to apply to variables generated as part of the simulation +#' @param seed Optional seed used in simulation +#' @param nexact Logical to indicate if normally distributed random variables should be simulated to the exact specified values +#' @param ncorr A string of correlations used for normally distributed random variables. The number of values should be equal to one or to the number of combinations of variables simulated +#' @param name Deprecated argument +#' @param nr Number of simulations +#' @param dataset Data list from previous simulation. Used by repeater function +#' @param envir Environment to extract data from +#' +#' @importFrom dplyr near +#' +#' @return A data.frame with the simulated data +#' +#' @examples +#' simulater( +#' const = "cost 3", +#' norm = "demand 2000 1000", +#' discrete = "price 5 8 .3 .7", +#' form = "profit = demand * (price - cost)", +#' seed = 1234 +#' ) %>% str() +#' +#' @seealso \code{\link{summary.simulater}} to summarize results +#' @seealso \code{\link{plot.simulater}} to plot results +#' +#' @export +simulater <- function(const = "", lnorm = "", norm = "", unif = "", discrete = "", + binom = "", pois = "", sequ = "", grid = "", data = NULL, + form = "", funcs = "", seed = NULL, nexact = FALSE, ncorr = NULL, + name = "", nr = 1000, dataset = NULL, envir = parent.frame()) { + if (!is.empty(seed)) set.seed(as.numeric(seed)) + if (is.null(dataset)) { + dataset <- list() + } else { + ## needed because number may be NA and missing if grid used in Simulate + nr <- attr(dataset, "radiant_sim_call")$nr + data <- attr(dataset, "radiant_sim_call")$data + } + + ## needed to be exported functions + if (!exists(".as_num") || !exists(".as_int")) { + .as_num <- radiant.model::.as_num + .as_int <- radiant.model::.as_int + } + + grid <- sim_cleaner(grid) + if (grid != "" && length(dataset) == 0) { + s <- grid %>% sim_splitter() + for (i in seq_along(s)) { + si <- s[[i]] + if (is.empty(si[4])) si[4] <- 1 + dataset[[si[1]]] <- seq(.as_num(si[2], dataset), .as_num(si[3], dataset), .as_num(si[4], dataset)) + } + dataset <- as.list(expand.grid(dataset) %>% as.data.frame(stringsAsFactors = FALSE)) + nr <- length(dataset[[1]]) + } + + if (is.empty(nr)) { + mess <- c("error", paste0("Please specify the number of simulations in '# sims'")) + return(add_class(mess, "simulater")) + } + + ## fetching data if needed + if (!is.empty(data, "none") && is_string(data)) { + if (exists(data, envir = envir)) { + data <- get_data(data, envir = envir) + } else { + stop(paste0("Data set ", data, " cannot be found", call. = FALSE)) + } + } + + ## adding data to dataset list + if (is.data.frame(data)) { + for (i in colnames(data)) { + dataset[[i]] <- data[[i]] + } + } + + ## parsing constant + const <- sim_cleaner(const) + if (const != "") { + s <- const %>% sim_splitter() + for (i in seq_along(s)) { + si <- s[[i]] + dataset[[si[1]]] <- .as_num(si[2], dataset) + } + } + + ## parsing uniform + unif <- sim_cleaner(unif) + if (unif != "") { + s <- unif %>% sim_splitter() + for (i in seq_along(s)) { + si <- s[[i]] + dataset[[si[1]]] <- runif(nr, .as_num(si[2], dataset), .as_num(si[3], dataset)) + } + } + + ## parsing log normal + lnorm <- sim_cleaner(lnorm) + if (lnorm != "") { + s <- lnorm %>% sim_splitter() + for (i in seq_along(s)) { + si <- s[[i]] + sdev <- .as_num(si[3], dataset) + if (is.na(sdev) || !sdev > 0) { + mess <- c("error", paste0("All log-normal variables should have a standard deviation larger than 0.\nPlease review the input carefully")) + return(add_class(mess, "simulater")) + } + dataset[[si[1]]] <- rlnorm(nr, .as_num(si[2], dataset), sdev) + } + } + + ## parsing normal + norm <- sim_cleaner(norm) + if (norm != "") { + s <- norm %>% sim_splitter() + means <- sds <- nms <- c() + for (i in seq_along(s)) { + si <- s[[i]] + sdev <- .as_num(si[3], dataset) + if (is.na(sdev) || !sdev > 0) { + mess <- c("error", paste0("All normal variables should have a standard deviation larger than 0.\nPlease review the input carefully")) + return(add_class(mess, "simulater")) + } + if (is.empty(ncorr) || length(s) == 1) { + if (nexact) { + dataset[[si[1]]] <- scale(rnorm(nr, 0, 1)) * sdev + .as_num(si[2], dataset) + } else { + dataset[[si[1]]] <- rnorm(nr, .as_num(si[2], dataset), sdev) + } + } else { + nms <- c(nms, si[1]) + means <- c(means, .as_num(si[2], dataset)) + sds <- c(sds, sdev) + } + } + if (!is.empty(ncorr) && length(nms) > 1) { + ncorr <- gsub(",", " ", ncorr) %>% + strsplit("\\s+") %>% + unlist() %>% + .as_num(dataset) + ncorr_nms <- combn(nms, 2) %>% apply(2, paste, collapse = "-") + if (length(ncorr) == 1 && length(ncorr_nms) > 2) { + ncorr <- rep(ncorr, length(ncorr_nms)) + } + if (length(ncorr) != length(ncorr_nms)) { + mess <- c("error", paste0("The number of correlations specified is not equal to\nthe number of pairs of variables to be simulated.\nPlease review the input carefully")) + return(add_class(mess, "simulater")) + } + names(ncorr) <- ncorr_nms + df <- try(sim_cor(nr, ncorr, means, sds, exact = nexact), silent = TRUE) + if (inherits(df, "try-error")) { + mess <- c("error", paste0("Data with the specified correlation structure could not be generated.\nPlease review the input and try again")) + return(add_class(mess, "simulater")) + } + + colnames(df) <- nms + for (i in nms) { + dataset[[i]] <- df[[i]] + } + } + } + + ## parsing binomial + binom <- sim_cleaner(binom) + if (binom != "") { + s <- binom %>% sim_splitter() + for (i in 1:length(s)) { + si <- s[[i]] + dataset[[si[1]]] <- rbinom(nr, .as_int(si[2], dataset), .as_num(si[3], dataset)) + } + } + + ## parsing poisson + pois <- sim_cleaner(pois) + if (pois != "") { + s <- pois %>% sim_splitter() + for (i in seq_along(s)) { + si <- s[[i]] + dataset[[si[1]]] <- rpois(nr, .as_num(si[2], dataset)) + } + } + + ## parsing sequence + sequ <- sim_cleaner(sequ) + if (sequ != "") { + s <- sequ %>% sim_splitter() + for (i in 1:length(s)) { + si <- s[[i]] + dataset[[si[1]]] <- seq(.as_num(si[2], dataset), .as_num(si[3], dataset), length.out = .as_num(nr, dataset)) + } + } + + ## parsing discrete + discrete <- sim_cleaner(discrete) + if (discrete != "") { + s <- discrete %>% sim_splitter() + for (i in seq_along(s)) { + si <- s[[i]] + dpar <- si[-1] %>% + gsub(",", " ", .) %>% + strsplit("\\s+") %>% + unlist() %>% + strsplit("/") + asNum <- function(x) ifelse(length(x) > 1, .as_num(x[1], dataset) / .as_num(x[2], dataset), .as_num(x, dataset)) + dpar <- sshhr(try(sapply(dpar, asNum) %>% matrix(ncol = 2), silent = TRUE)) + if (inherits(dpar, "try-error") || any(is.na(dpar))) { + mess <- c("error", paste0("Input for discrete variable # ", i, " contains an error. Please review the input carefully")) + return(add_class(mess, "simulater")) + } else if (!near(sum(dpar[, 2]), 1)) { + mess <- c("error", glue("Probabilities for discrete variable # {i} do not sum to 1 ({sum(dpar[, 2])})")) + return(add_class(mess, "simulater")) + } + + dataset[[si[1]]] <- sample(dpar[, 1], nr, replace = TRUE, prob = dpar[, 2]) + } + } + + ## convert named list of functions to a string to evaluate + if (is.list(funcs)) { + funcs <- sapply( + names(funcs), + function(f) { + paste0(f, " = ", paste0(deparse(funcs[[f]], control = getOption("dctrl"), width.cutoff = 500L), collapse = "\n")) + } + ) %>% paste0(collapse = ";") + } + if (!is.expression(funcs)) { + pfuncs <- parse(text = funcs, keep.source = TRUE) + } else { + pfuncs <- funcs + } + + if (!is.empty(form)) { + form <- form %>% + gsub("[ ]{2,}", " ", .) %>% + gsub("<-", "=", .) + + form_no_comments <- remove_comments(form) + out <- try(do.call(within, list(dataset, c(pfuncs, parse(text = form_no_comments)))), silent = TRUE) + if (!inherits(out, "try-error")) { + dataset <- out + } else { + mess <- c( + "error", paste0("Formula was not successfully evaluated:\n\n", form) %>% + paste0(collapse = "\n"), "\n\nMessage: ", attr(out, "condition")$message + ) + return(add_class(mess, "simulater")) + } + } + + ## removing data from dataset list + if (is.data.frame(data)) { + dataset[colnames(data)] <- NULL + } + + ## remove functions + ind <- radiant.data::get_class(dataset) == "function" + dataset[ind] <- NULL + + ## convert list to a data.frame + dataset <- as.data.frame(dataset, stringsAsFactors = FALSE) %>% na.omit() + + ## capturing the function call for use in repeat + sc <- formals() + smc <- lapply(match.call()[-1], eval, envir = envir) + smc$envir <- NULL + sc[names(smc)] <- smc + sc$nr <- nr + sc$ncorr <- ncorr + sc$nexact <- nexact + sc$funcs <- pfuncs + + if (is.empty(sc$data, "none")) { + attr(dataset, "sim_data_name") <- NULL + } else if (is_string(sc$data)) { + attr(dataset, "sim_data_name") <- sc$data + sc$data <- data + } else { + attr(dataset, "sim_data_name") <- deparse(substitute(data)) + } + + attr(dataset, "radiant_sim_call") <- sc + + if (nrow(dataset) == 0) { + mess <- c("error", paste0("The simulated data set has 0 rows")) + return(add_class(mess, "simulater")) + } + + form <- gsub("*", "\\*", form, fixed = TRUE) %>% + gsub("^\\s*?\\#+[^\\#]", "##### # ", .) %>% + gsub("[;\n]\\s*?\\#+[^\\#]", "; ##### # ", .) %>% + gsub(";\\s*", "\n\n", .) + + mess <- paste0("\n### Simulated data\n\nFormulas:\n\n", form, "\n\nDate: ", lubridate::now()) + + add_class(set_attr(dataset, "description", mess), "simulater") +} + +#' Summary method for the simulater function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/simulater.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{simulater}} +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' simdat <- simulater(norm = "demand 2000 1000", seed = 1234) +#' summary(simdat) +#' +#' @seealso \code{\link{simulater}} to generate the results +#' @seealso \code{\link{plot.simulater}} to plot results +#' +#' @export +summary.simulater <- function(object, dec = 4, ...) { + if (is.character(object)) { + if (length(object) == 2 && object[1] == "error") { + return(cat(object[2])) + } + stop("To generate summary statistics please provide a simulated dataset as input", call. = FALSE) + } + + sc <- attr(object, "radiant_sim_call") + clean <- function(x) { + paste0(x, collapse = ";") %>% + gsub(";", "; ", .) %>% + gsub("\\n", "", .) %>% + paste0(., "\n") + } + + cat("Simulation\n") + cat("Simulations:", format_nr(nrow(object), dec = 0), "\n") + cat("Random seed:", sc$seed, "\n") + if (is.empty(sc$name)) { + cat("Sim data :", deparse(substitute(object)), "\n") + } else { + cat("Sim data :", sc$name, "\n") + } + if (!is.empty(sc$binom)) cat("Binomial :", clean(sc$binom)) + if (!is.empty(sc$discrete)) cat("Discrete :", clean(sc$discrete)) + if (!is.empty(sc$lnorm)) cat("Log normal :", clean(sc$lnorm)) + if (!is.empty(sc$norm)) cat("Normal :", clean(ifelse(sc$nexact, paste0(sc$norm, "(exact)"), sc$norm))) + if (!is.empty(sc$unif)) cat("Uniform :", clean(sc$unif)) + if (!is.empty(sc$pois)) cat("Poisson :", clean(sc$pois)) + if (!is.empty(sc$const)) cat("Constant :", clean(sc$const)) + if (is.data.frame(sc$data)) cat("Data :", attr(object, "sim_data_name"), "\n") + if (!is.empty(sc$grid)) cat("Grid search:", clean(sc$grid)) + if (!is.empty(sc$sequ)) cat("Sequence :", clean(sc$sequ)) + + funcs <- attr(object, "radiant_funcs") + if (!is.empty(funcs)) { + funcs <- parse(text = funcs) + lfuncs <- list() + for (i in seq_len(length(funcs))) { + tmp <- strsplit(as.character(funcs[i]), "(\\s*=|\\s*<-)")[[1]][1] + lfuncs[[tmp]] <- as.symbol(tmp) + } + cat("Functions :", paste0(names(lfuncs), collapse = ", "), "\n") + } + + if (!is.empty(sc$form)) { + cat(paste0("Formulas :\n\t", paste0(sc$form, collapse = ";") %>% gsub(";", "\n", .) %>% gsub("\n", "\n\t", .), "\n")) + } + cat("\n") + + if (!is.empty(sc$ncorr) && is.numeric(sc$ncorr)) { + cat("Correlations:\n") + print(sc$ncorr) + cat("\n") + } + + sim_summary(object, dec = ifelse(is.empty(dec), 4, round(dec, 0))) +} + +#' Plot method for the simulater function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/model/simulater} for an example in Radiant +#' +#' @param x Return value from \code{\link{simulater}} +#' @param bins Number of bins used for histograms (1 - 50) +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' simdat <- simulater( +#' const = "cost 3", +#' norm = "demand 2000 1000", +#' discrete = "price 5 8 .3 .7", +#' form = "profit = demand * (price - cost)", +#' seed = 1234 +#' ) +#' plot(simdat, bins = 25) +#' +#' @seealso \code{\link{simulater}} to generate the result +#' @seealso \code{\link{summary.simulater}} to summarize results +#' +#' @export +plot.simulater <- function(x, bins = 20, shiny = FALSE, custom = FALSE, ...) { + if (is.character(x)) { + return(invisible()) + } + if (nrow(x) == 0) { + return(invisible()) + } + plot_list <- list() + for (i in colnames(x)) { + dat <- select_at(x, .vars = i) + if (!does_vary(x[[i]])) next + plot_list[[i]] <- select_at(x, .vars = i) %>% + visualize(xvar = i, bins = bins, custom = TRUE) + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = min(length(plot_list), 2)) %>% + (function(x) if (shiny) x else print(x)) + } + } +} + +#' Repeated simulation +#' +#' @param dataset Return value from the simulater function +#' @param nr Number times to repeat the simulation +#' @param vars Variables to use in repeated simulation +#' @param grid Character vector of expressions to use in grid search for constants +#' @param sum_vars (Numeric) variables to summaries +#' @param byvar Variable(s) to group data by before summarizing +#' @param fun Functions to use for summarizing +#' @param form A character vector with the formula to apply to the summarized data +#' @param seed Seed for the repeated simulation +#' @param name Deprecated argument +#' @param envir Environment to extract data from +#' +#' @importFrom shiny getDefaultReactiveDomain +#' +#' @examples +#' simdat <- simulater( +#' const = c("var_cost 5", "fixed_cost 1000"), +#' norm = "E 0 100;", +#' discrete = "price 6 8 .3 .7;", +#' form = c( +#' "demand = 1000 - 50*price + E", +#' "profit = demand*(price-var_cost) - fixed_cost", +#' "profit_small = profit < 100" +#' ), +#' seed = 1234 +#' ) +#' +#' repdat <- repeater( +#' simdat, +#' nr = 12, +#' vars = c("E", "price"), +#' sum_vars = "profit", +#' byvar = ".sim", +#' form = "profit_365 = profit_sum < 36500", +#' seed = 1234, +#' ) +#' +#' head(repdat) +#' summary(repdat) +#' plot(repdat) +#' +#' @seealso \code{\link{summary.repeater}} to summarize results from repeated simulation +#' @seealso \code{\link{plot.repeater}} to plot results from repeated simulation +#' +#' @export +repeater <- function(dataset, nr = 12, vars = "", grid = "", sum_vars = "", + byvar = ".sim", fun = "sum", form = "", seed = NULL, + name = "", envir = parent.frame()) { + if (byvar %in% c(".sim", "sim")) grid <- "" + if (is.empty(nr)) { + if (is.empty(grid)) { + mess <- c("error", paste0("Please specify the number of repetitions in '# reps'")) + return(add_class(mess, "repeater")) + } else { + nr <- 1 + } + } + + ## needed to be exported functions + if (!exists(".as_num") || !exists(".as_int")) { + .as_num <- radiant.model::.as_num + .as_int <- radiant.model::.as_int + } + + if (is_string(dataset)) { + sim_df_name <- dataset + dataset <- get_data(dataset, envir = envir) + } else { + sim_df_name <- deparse(substitute(dataset)) + } + if (!is.empty(seed)) set.seed(as.numeric(seed)) + + if (identical(vars, "") && identical(grid, "")) { + mess <- c("error", paste0("Select variables to re-simulate and/or a specify a constant\nto change using 'Grid search' when Group by is set to Repeat")) + return(add_class(mess, "repeater")) + } + + if (identical(vars, "")) vars <- character(0) + + grid_list <- list() + if (!identical(grid, "")) { + grid <- sim_cleaner(grid) + if (grid != "") { + s <- grid %>% sim_splitter() + for (i in seq_along(s)) { + si <- s[[i]] + if (is.empty(s[[i]][4])) s[[i]][4] <- 1 + grid_list[[si[1]]] <- seq(.as_num(si[2], dataset), .as_num(si[3], dataset), .as_num(si[4], dataset)) + } + } + ## expanding list of variables but removing "" + vars <- c(vars, names(grid_list)) %>% unique() + } + + ## from http://stackoverflow.com/a/7664655/1974918 + ## keep those list elements that, e.g., q is in + nr_sim <- nrow(dataset) + sc <- attr(dataset, "radiant_sim_call") + + if (is.data.frame(sc$data)) { + data <- sc$data + } else { + data <- NULL + } + + ## reset dataset to list with vectors of the correct length + dataset <- as.list(dataset) + if ("const" %in% names(sc)) { + s <- sc$const + if (length(s) < 2) { + s <- strsplit(gsub("\n", "", s), ";\\s*")[[1]] %>% strsplit("\\s+") + } else { + s <- strsplit(s, "\\s+") + } + for (const in seq_len(length(s))) { + nm <- s[[const]][1] + dataset[[nm]] <- dataset[[nm]][1] + } + } + + ## needed if inputs are provided as vectors + sc[1:(which(names(sc) == "seed") - 1)] %<>% lapply(paste, collapse = ";") + + sc$name <- sc$seed <- "" ## cleaning up the sim call + + ## using \\b based on https://stackoverflow.com/a/34074458/1974918 + sc_keep <- grep(paste(paste0("\\b", vars, "\\b"), collapse = "|"), sc, value = TRUE) + sc_keep["funcs"] <- sc$funcs + + ## ensure that only the selected variables of a specific type are resimulated + ## e.g., if A, B, and C are normal and A should be re-sim'd, don't also re-sim B and C + for (i in names(sc_keep)) { + if (i %in% c("form", "funcs")) next + sc_check <- sim_cleaner(sc_keep[[i]]) %>% + sim_splitter(";") + if (length(sc_check) < 2) { + next + } else { + sc_keep[[i]] <- grep(paste(paste0("\\b", vars, "\\b"), collapse = "|"), sc_check, value = TRUE) %>% + paste0(collapse = ";\n") + } + } + + ## needed in case there is no 'form' in simulate + sc[1:(which(names(sc) == "seed") - 1)] <- "" + sc[names(sc_keep)] <- sc_keep + sc$dataset <- dataset + + if (!is.empty(sc$data, "none") && is_string(sc$data)) { + if (exists(sc$data, envir = envir)) { + sc$data <- get(sc$data, envir = envir) + } else { + stop(paste0("Data set ", sc$data, " cannot be found", call. = FALSE)) + } + } + + summarize_sim <- function(object) { + if (is.empty(fun) || any(fun == "none")) { + object <- select_at(object, .vars = c(".rep", ".sim", sum_vars)) + } else { + cn <- unlist(sapply(fun, function(f) paste0(sum_vars, "_", f), simplify = FALSE)) + first <- function(x, ...) dplyr::first(x) + last <- function(x, ...) dplyr::last(x) + object <- group_by_at(object, byvar) %>% + summarise_at(.vars = sum_vars, .funs = fun, na.rm = TRUE) %>% + set_colnames(c(byvar, cn)) + } + object + } + + rep_sim <- function(rep_nr, nr, sfun = function(x) x) { + bind_cols( + data.frame(.rep = rep(rep_nr, nr_sim), .sim = 1:nr_sim, stringsAsFactors = FALSE), + do.call(simulater, sc) + ) %>% + na.omit() %>% + sfun() %T>% + (function(x) incProgress(rep_nr / nr, detail = paste("\nCompleted run", rep_nr, "out of", nr))) + } + + rep_grid_sim <- function(gval, rep_nr, nr, sfun = function(x) x) { + gvars <- names(gval) + ## removing form and funcs ... + sc_grid <- grep(paste(gvars, collapse = "|"), sc_keep, value = TRUE) %>% + (function(x) x[which(!names(x) %in% c("form", "funcs"))]) %>% + gsub("[ ]{2,}", " ", .) + + for (i in 1:length(gvars)) { + sc_grid %<>% sub(paste0("[;\n]", gvars[i], " [.0-9]+"), paste0("\n", gvars[i], " ", gval[gvars[i]]), .) %>% + sub(paste0("^", gvars[i], " [.0-9]+"), paste0(gvars[i], " ", gval[gvars[i]]), .) + } + + sc[names(sc_grid)] <- sc_grid + bind_cols( + data.frame(.rep = rep(paste(gval, collapse = "|"), nr_sim), .sim = 1:nr_sim, stringsAsFactors = FALSE), + do.call(simulater, sc) + ) %>% + na.omit() %>% + sfun() %>% + { + incProgress(rep_nr / nr, detail = paste("\nCompleted run", rep_nr, "out of", nr)) + . + } + } + + if (length(shiny::getDefaultReactiveDomain()) > 0) { + trace <- FALSE + incProgress <- shiny::incProgress + withProgress <- shiny::withProgress + } else { + incProgress <- function(...) {} + withProgress <- function(...) list(...)[["expr"]] + } + + withProgress(message = "Running repeated simulation", value = 0, { + if (length(grid_list) == 0) { + if (byvar == ".sim") { + ret <- bind_rows(lapply(1:nr, rep_sim, nr)) %>% + summarize_sim() %>% + add_class("repeater") + } else { + ret <- bind_rows(lapply(1:nr, function(x) rep_sim(x, nr, summarize_sim))) %>% + add_class("repeater") + } + } else { + grid <- expand.grid(grid_list) + nr <- nrow(grid) + if (byvar == ".sim") { + ret <- bind_rows(lapply(1:nr, function(x) rep_grid_sim(grid[x, , drop = FALSE], x, nr))) %>% + summarize_sim() %>% + add_class("repeater") + } else { + ret <- bind_rows(lapply(1:nr, function(x) rep_grid_sim(grid[x, , drop = FALSE], x, nr, summarize_sim))) %>% + add_class("repeater") + } + } + }) + + if (is.data.frame(data)) { + ret <- as.list(ret) + for (i in colnames(data)) { + ret[[i]] <- data[[i]] + } + sim_data_name <- attr(dataset, "sim_data_name") + } else { + sim_data_name <- NULL + } + + if (!is.empty(form)) { + form <- form %>% + gsub("[ ]{2,}", " ", .) %>% + gsub("<-", "=", .) + + form_no_comments <- remove_comments(form) + out <- try(do.call(within, list(ret, parse(text = form_no_comments))), silent = TRUE) + if (!inherits(out, "try-error")) { + ret <- out + } else { + mess <- c("error", paste0("Formula was not successfully evaluated:\n\n", form) %>% unlist() %>% paste0(collapse = "\n"), "\n\nMessage: ", attr(out, "condition")$message, "\n\nNote that repeated simulation formulas can only be applied to\n(summarized) 'Output variables'") + if (!is.empty(fun)) { + cn <- unlist(sapply(fun, function(f) paste0(sum_vars, "_", f), simplify = FALSE)) + mess[2] <- paste0(mess[2], "\n\nAvailable (summarized) output variables:\n* ", paste0(cn, collapse = "\n* ")) + } + return(add_class(mess, "repeater")) + } + } + + ## removing data from dataset list + if (is.data.frame(data)) { + ret[colnames(data)] <- NULL + } + + ## tbl_df remove attributes so use as.data.frame for now + ret <- as.data.frame(ret, stringsAsFactors = FALSE) + + ## capturing the function call for use in summary and plot + rc <- formals() + rmc <- lapply(match.call()[-1], eval, envir = envir) + rmc$envir <- NULL + rc[names(rmc)] <- rmc + + rc$sc <- sc[base::setdiff(names(sc), "dat")] + attr(ret, "radiant_rep_call") <- rc + attr(ret, "sim_df_name") <- sim_df_name + attr(ret, "sim_data_name") <- sim_data_name + + mess <- paste0( + "\n### Repeated simulation data\n\nFormula:\n\n", + gsub("*", "\\*", sc$form, fixed = TRUE) %>% + gsub("[;\n]\\s*?\\#+[^\\#]", "; ##### # ", .) %>% + gsub(";", "\n\n", .), + "\n\nDate: ", + lubridate::now() + ) + + add_class(set_attr(ret, "description", mess), "repeater") +} + +#' Summarize repeated simulation +#' +#' @param object Return value from \code{\link{repeater}} +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{repeater}} to run a repeated simulation +#' @seealso \code{\link{plot.repeater}} to plot results from repeated simulation +#' +#' @export +summary.repeater <- function(object, dec = 4, ...) { + if (is.character(object)) { + if (length(object) == 2 && object[1] == "error") { + return(cat(object[2])) + } + stop("To generate summary statistics please provide a simulated dataset as input", call. = FALSE) + } + + ## getting the repeater call + rc <- attr(object, "radiant_rep_call") + + clean <- function(x) { + paste0(x, collapse = ";") %>% + gsub(";", "; ", .) %>% + gsub("\\n", "", .) %>% + paste0(., "\n") + } + + ## show results + cat("Repeated simulation\n") + cat("Simulations :", ifelse(is.empty(rc$sc$nr), "", format_nr(rc$sc$nr, dec = 0)), "\n") + cat("Repetitions :", format_nr(ifelse(is.empty(rc$nr), nrow(object), rc$nr), dec = 0), "\n") + if (!is.empty(rc$vars)) { + cat("Re-simulated :", paste0(rc$vars, collapse = ", "), "\n") + } + cat("Group by :", ifelse(rc$byvar == ".rep", "Repeat", "Simulation"), "\n") + cat("Function :", rc$fun, "\n") + cat("Random seed :", rc$seed, "\n") + if (is.data.frame(rc$sim)) { + rc$sim <- attr(rc$sim, "radiant_sim_call")$name + } + cat("Simulated data:", attr(object, "sim_df_name"), "\n") + attr(object, "sim_data_name") %>% + { + if (!is.empty(.)) cat("Data :", ., "\n") + } + if (is.empty(rc$name)) { + cat("Repeat data :", deparse(substitute(object)), "\n") + } else { + cat("Repeat data :", rc$name, "\n") + } + + if (isTRUE(rc$byvar == "rep") && !is.empty(rc$grid)) { + cat("Grid search. :", clean(rc$grid)) + } + + if (!is.empty(rc$form)) { + rc$form %<>% sim_cleaner() + paste0( + "Formulas :\n\t", + paste0(rc$form, collapse = ";") %>% + gsub(";", "\n", .) %>% + gsub("\n", "\n\t", .), + "\n" + ) %>% cat() + } + cat("\n") + + sim_summary(select(object, -1), fun = rc$fun, dec = ifelse(is.na(dec), 4, dec)) +} + +#' Plot repeated simulation +#' +#' @param x Return value from \code{\link{repeater}} +#' @param bins Number of bins used for histograms (1 - 50) +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{repeater}} to run a repeated simulation +#' @seealso \code{\link{summary.repeater}} to summarize results from repeated simulation +#' +#' @export +plot.repeater <- function(x, bins = 20, shiny = FALSE, custom = FALSE, ...) { + if (is.character(x)) { + return(invisible()) + } + if (nrow(x) == 0) { + return(invisible()) + } + + ## getting the repeater call + rc <- attr(x, "radiant_rep_call") + plot_list <- list() + for (i in colnames(x)[-1]) { + dat <- select_at(x, .vars = i) + if (!does_vary(x[[i]])) next + + plot_list[[i]] <- select_at(x, .vars = i) %>% + visualize(xvar = i, bins = bins, custom = TRUE) + + if (i %in% rc$sum_vars && !is.empty(rc$fun, "none")) { + plot_list[[i]] <- plot_list[[i]] + labs(x = paste0(rc$fun, " of ", i)) + } + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = min(length(plot_list), 2)) %>% + (function(x) if (shiny) x else print(x)) + } + } +} + +#' Print simulation summary +#' +#' @param dataset Simulated data +#' @param dc Variable classes +#' @param fun Summary function to apply +#' @param dec Number of decimals to show +#' +#' @seealso \code{\link{simulater}} to run a simulation +#' @seealso \code{\link{repeater}} to run a repeated simulation +#' +#' @examples +#' simulater( +#' const = "cost 3", +#' norm = "demand 2000 1000", +#' discrete = "price 5 8 .3 .7", +#' form = c("profit = demand * (price - cost)", "profit5K = profit > 5000"), +#' seed = 1234 +#' ) %>% sim_summary() +#' +#' @export +sim_summary <- function(dataset, dc = get_class(dataset), fun = "", dec = 4) { + isFct <- "factor" == dc + isNum <- dc %in% c("numeric", "integer", "Duration") + isChar <- "character" == dc + isLogic <- "logical" == dc + + dec <- ifelse(is.na(dec), 4, as.integer(dec)) + + if (sum(isNum) > 0) { + isConst <- !sapply(dataset, does_vary) & isNum + if (sum(isConst) > 0) { + cn <- names(dc)[isConst] + cat("Constants:\n") + select(dataset, which(isConst)) %>% + na.omit() %>% + .[1, ] %>% + as.data.frame(stringsAsFactors = FALSE) %>% + round(dec) %>% + mutate_all(~ formatC(., big.mark = ",", digits = dec, format = "f")) %>% + set_rownames("") %>% + set_colnames(cn) %>% + print() + cat("\n") + } + + isRnd <- isNum & !isConst + if (sum(isRnd) > 0) { + cn <- names(dc)[isRnd] + cat("Variables:\n") + select(dataset, which(isNum & !isConst)) %>% + gather("variable", "values", !!cn) %>% + group_by_at(.vars = "variable") %>% + summarise_all( + list( + n_obs = n_obs, mean = mean, sd = sd, min = min, + p25 = p25, median = median, p75 = p75, max = max + ), + na.rm = TRUE + ) %>% + mutate(variable = format(variable, justify = "left")) %>% + data.frame(check.names = FALSE, stringsAsFactors = FALSE) %>% + format_df(dec = dec, mark = ",") %>% + rename(` ` = "variable") %>% + print(row.names = FALSE) + cat("\n") + } + } + + if (sum(isLogic) > 0) { + cat("Logicals:\n") + select(dataset, which(isLogic)) %>% + summarise_all(list(sum, mean), na.rm = TRUE) %>% + round(dec) %>% + matrix(ncol = 2) %>% + as.data.frame(stringsAsFactors = FALSE) %>% + set_colnames(c("TRUE (nr) ", "TRUE (prop)")) %>% + set_rownames(names(dataset)[isLogic]) %>% + format(big.mark = ",", scientific = FALSE) %>% + print() + cat("\n") + } + + if (sum(isFct) > 0 || sum(isChar) > 0) { + cat("Factors:\n") + df <- select(dataset, which(isFct | isChar)) %>% + mutate(across(where(is.character), as_factor)) %>% + as.data.frame() + + tab <- summary(df) + pt <- lapply(df, function(x) prop.table(table(x))) + for (i in seq_len(ncol(tab))) { + tab[, i] <- paste0(tab[, i], "(", 100 * round(pt[[i]], dec), "%)") + } + tab[tab == "NA(100%)"] <- "" + print(tab) + cat("\n") + } +} + +#' Clean input command string +#' +#' @param x Input string +#' +#' @return Cleaned string +#' +#' @export +sim_cleaner <- function(x) { + gsub("[ ]{2,}", " ", paste(x, collapse = ";")) %>% + gsub("[ ]*[\n;]+[ ]*", ";", .) %>% + gsub("[;]{2,}", ";", .) %>% + gsub(";$", "", .) %>% + gsub("^;", "", .) +} + +#' Remove comments from formula before it is evaluated +#' +#' @param x Input string +#' +#' @return Cleaned string +#' +#' @export +remove_comments <- function(x) { + gsub("[ ]*\\#{1,}[^\n;]*[\n]", "\n", x) %>% + gsub("[ ]*\\#{1,}[^\n;]*[;]", ";", .) %>% + gsub("^[ ]*;{1,}", "", .) %>% + gsub(";{2,}", ";", .) %>% + gsub("^[ ]*\n{1,}", "", .) %>% + gsub("\n{2,}", "\n", .) %>% + gsub("^[ ]{1,}", "", .) +} + +#' Split input command string +#' +#' @param x Input string +#' @param symbol Symbol used to split the command string +#' +#' @return Split input command string +#' +#' @export +sim_splitter <- function(x, symbol = " ") { + strsplit(x, "(;\\s*|\n)") %>% + extract2(1) %>% + # from https://stackoverflow.com/a/16644618/1974918 + gsub("\\s+(?=[^(\\)]*\\))", "", ., perl = TRUE) %>% + strsplit(symbol) +} + +#' Find maximum value of a vector +#' +#' @details Find the value of y at the maximum value of x +#' @param x Variable to find the maximum for +#' @param y Variable to find the value for at the maximum of var +#' +#' @return Value of val at the maximum of var +#' +#' @examples +#' find_max(1:10, 21:30) +#' +#' @export +find_max <- function(x, y) { + if (missing(y)) { + stop("Error in find_max (2 inputs required)\nSpecify the variable to evaluate at the maximum of the first input") + } + y[which.max(x)] +} + +#' Find minimum value of a vector +#' +#' @details Find the value of y at the minimum value of x +#' @param x Variable to find the minimum for +#' @param y Variable to find the value for at the maximum of var +#' +#' @return Value of val at the minimum of var +#' +#' @examples +#' find_min(1:10, 21:30) +#' +#' @export +find_min <- function(x, y) { + if (missing(y)) { + stop("Error in find_min (2 inputs required)\nSpecify the variable to evaluate at the minimum of the first input") + } + y[which.min(x)] +} + +#' Standard deviation of weighted sum of variables +#' +#' @param ... A matched number of weights and stocks +#' +#' @return A vector of standard deviation estimates +#' +#' @export +sdw <- function(...) { + dl <- list(...) + nr <- length(dl) / 2 + w <- data.frame(dl[1:nr], stringsAsFactors = FALSE) + d <- data.frame(dl[(nr + 1):length(dl)], stringsAsFactors = FALSE) + apply(w, 1, function(w) sd(rowSums(sweep(d, 2, w, "*")))) +} + +#' Simulate correlated normally distributed data +#' +#' @param n The number of values to simulate (i.e., the number of rows in the simulated data) +#' @param rho A vector of correlations to apply to the columns of the simulated data. The number of values should be equal to one or to the number of combinations of variables to be simulated +#' @param means A vector of means. The number of values should be equal to the number of variables to simulate +#' @param sds A vector of standard deviations. The number of values should be equal to the number of variables to simulate +#' @param exact A logical that indicates if the inputs should be interpreted as population of sample characteristics +#' +#' @return A data.frame with the simulated data +#' +#' @examples +#' sim <- sim_cor(100, .74, c(0, 10), c(1, 5), exact = TRUE) +#' cor(sim) +#' sim_summary(sim) +#' +#' @export +sim_cor <- function(n, rho, means, sds, exact = FALSE) { + nrx <- length(means) + C <- matrix(1, nrow = nrx, ncol = nrx) + C[lower.tri(C)] <- C[upper.tri(C)] <- rho + + X <- matrix(rnorm(n * nrx, 0, 1), ncol = nrx) + + if (exact) { + X <- psych::principal(X, nfactors = nrx, scores = TRUE)$scores + } + + X <- X %*% chol(C) + + X <- sweep(X, 2, sds, "*") + X <- sweep(X, 2, means, "+") + as.data.frame(X, stringsAsFactors = FALSE) +} diff --git a/radiant.model/R/svm.R b/radiant.model/R/svm.R new file mode 100644 index 0000000000000000000000000000000000000000..b4b3d851b309e9e29fa587c3b9beaa177794fd64 --- /dev/null +++ b/radiant.model/R/svm.R @@ -0,0 +1,122 @@ +#' Support Vector Machine using e1071 +#' +#' @export +svm <- function(dataset, rvar, evar, + type = "classification", lev = "", + kernel = "radial", cost = 1, gamma = "auto", + degree = 3, coef0 = 0, nu = 0.5, epsilon = 0.1, + probability = FALSE, wts = "None", seed = 1234, + check = NULL, form, data_filter = "", arr = "", rows = NULL, + envir = parent.frame()) { + + ## ---- 公式入口 ---------------------------------------------------------- + if (!missing(form)) { + form <- as.formula(format(form)) + vars <- all.vars(form) + rvar <- vars[1] + evar <- vars[-1] + } + + ## ---- 基础检查 ---------------------------------------------------------- + if (rvar %in% evar) + return("Response variable contained in explanatory variables" %>% add_class("svm")) + + vars <- c(rvar, evar) + if (is.empty(wts, "None")) { + wts <- NULL + } else { + vars <- c(vars, wts) + } + + ## ---- 数据提取 ---------------------------------------------------------- + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, envir = envir) + + if (!is.empty(wts)) { + wts_vec <- dataset[[wts]] + dataset <- select_at(dataset, setdiff(colnames(dataset), wts)) + } else { + wts_vec <- NULL + } + + rv <- dataset[[rvar]] + if (type == "classification") { + if (lev == "") lev <- levels(as.factor(rv))[1] + dataset[[rvar]] <- factor(dataset[[rvar]] == lev, levels = c(TRUE, FALSE)) + } + + ## ---- 标准化（占位） ---------------------------------------------------- + if ("standardize" %in% check) dataset <- scale_df(dataset, wts = wts_vec) + + ## ---- 构造公式 ---------------------------------------------------------- + if (missing(form)) form <- as.formula(paste(rvar, "~ .")) + + ## ---- 设定种子 ---------------------------------------------------------- + seed <- gsub("[^0-9]", "", seed) + if (!is.empty(seed)) set.seed(as.integer(seed)) + + ## ---- 调 e1071::svm ----------------------------------------------------- + svm_call <- list( + formula = form, + data = dataset, + type = ifelse(type == "classification", "C-classification", "eps-regression"), + kernel = kernel, + cost = cost, + gamma = if (gamma == "auto") 1 / ncol(select(dataset, -rvar)) else as.numeric(gamma), + degree = degree, + coef0 = coef0, + nu = nu, + epsilon = epsilon, + probability = probability, + weights = wts_vec, + fitted = TRUE + ) + model <- do.call(e1071::svm, svm_call) + + ## ---- 打包返回 ---------------------------------------------------------- + out <- as.list(environment()) + out$model <- model + out$df_name <- df_name + out$type <- type + out$lev <- if (type == "classification") lev else NULL + out$check <- check + add_class(out, c("svm", "model")) +} + +#' Summary method +#' @export +summary.svm <- function(object, ...) { + if (is.character(object)) return(object) + cat("Support Vector Machine\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) cat("Filter :", object$data_filter, "\n") + cat("Response :", object$rvar, "\n") + if (object$type == "classification") cat("Level :", object$lev, "\n") + cat("Variables :", paste(object$evar, collapse = ", "), "\n") + cat("Kernel :", object$model$kernel, "\n") + cat("Cost (C) :", object$model$cost, "\n") + if (object$model$kernel != "linear") cat("Gamma :", object$model$gamma, "\n") + cat("Support vectors :", length(object$model$SV), "\n") + invisible(object) +} + +#' Predict method +#' @export +predict.svm <- function(object, pred_data = NULL, pred_cmd = "", + dec = 3, envir = parent.frame(), ...) { + if (is.character(object)) return(object) + + pfun <- function(model, newdata, ...) { + predict(model, newdata, probability = object$model$probability)[, 1] + } + + predict_model(object, pfun, "svm.predict", + pred_data, pred_cmd, + dec = dec, envir = envir) +} + +#' Print predictions +#' @export +print.svm.predict <- function(x, ..., n = 10) { + print_predict_model(x, ..., n = n, header = "SVM") +} \ No newline at end of file diff --git a/radiant.model/README.md b/radiant.model/README.md new file mode 100644 index 0000000000000000000000000000000000000000..3718c4c81004dd6d99669544df614317cf3924b0 --- /dev/null +++ b/radiant.model/README.md @@ -0,0 +1,188 @@ +# Radiant - Business analytics using R and Shiny + + + +[![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/radiant.model)](https://CRAN.R-project.org/package=radiant.model) + + +Radiant is an open-source platform-independent browser-based interface for business analytics in [R](https://www.r-project.org/). The application is based on the [Shiny](https://shiny.posit.co/) package and can be run locally or on a server. Radiant was developed by Vincent Nijs. Please use the issue tracker on GitHub to suggest enhancements or report problems: https://github.com/radiant-rstats/radiant.model/issues. For other questions and comments please use radiant@rady.ucsd.edu. + +## Key features + +- Explore: Quickly and easily summarize, visualize, and analyze your data +- Cross-platform: It runs in a browser on Windows, Mac, and Linux +- Reproducible: Recreate results and share work with others as a state file or an [Rmarkdown](https://rmarkdown.rstudio.com/) report +- Programming: Integrate Radiant's analysis functions with your own R-code +- Context: Data and examples focus on business applications + + + + +#### Playlists + +There are two youtube playlists with video tutorials. The first provides a general introduction to key features in Radiant. The second covers topics relevant in a course on business analytics (i.e., Probability, Decision Analysis, Hypothesis Testing, Linear Regression, and Simulation). + +* Introduction to Radiant +* Radiant Tutorial Series + +#### Explore + +Radiant is interactive. Results update immediately when inputs are changed (i.e., no separate dialog boxes) and/or when a button is pressed (e.g., `Estimate` in _Model > Estimate > Logistic regression (GLM)_). This facilitates rapid exploration and understanding of the data. + +#### Cross-platform + +Radiant works on Windows, Mac, or Linux. It can run without an Internet connection and no data will leave your computer. You can also run the app as a web application on a server. + +#### Reproducible + +To conduct high-quality analysis, simply saving output is not enough. You need the ability to reproduce results for the same data and/or when new data become available. Moreover, others may want to review your analysis and results. Save and load the state of the application to continue your work at a later time or on another computer. Share state files with others and create reproducible reports using [Rmarkdown](https://rmarkdown.rstudio.com/). See also the section on `Saving and loading state` below + +If you are using Radiant on a server you can even share the URL (include the SSUID) with others so they can see what you are working on. Thanks for this feature go to [Joe Cheng](https://github.com/jcheng5). + +#### Programming + +Although Radiant's web-interface can handle quite a few data and analysis tasks, you may prefer to write your own R-code. Radiant provides a bridge to programming in R(studio) by exporting the functions used for analysis (i.e., you can conduct your analysis using the Radiant web-interface or by calling Radiant's functions directly from R-code). For more information about programming with Radiant see the [programming](https://radiant-rstats.github.io/docs/programming.html) page on the documentation site. + +#### Context + +Radiant focuses on business data and decisions. It offers tools, examples, and documentation relevant for that context, effectively reducing the business analytics learning curve. + +## How to install Radiant + +- Required: [R](https://cran.r-project.org/) version 4.0.0 or later +- Required: [Rstudio](https://posit.co/download/rstudio-server/) + +In Rstudio you can start and update Radiant through the `Addins` menu at the top of the screen. To install the latest version of Radiant for Windows or Mac, with complete documentation for off-line access, open R(studio) and copy-and-paste the command below: + +```r +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org")) +install.packages("radiant") +``` + +Once all packages are installed, select `Start radiant` from the `Addins` menu in Rstudio or use the command below to launch the app: + +```r +radiant::radiant() +``` + +To launch Radiant in Rstudio's viewer pane use the command below: + +```r +radiant::radiant_viewer() +``` + +To launch Radiant in an Rstudio Window use the command below: + +```r +radiant::radiant_window() +``` + +To easily update Radiant and the required packages, install the `radiant.update` package using: + +```r +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org")) +install.packages("remotes") +remotes::install_github("radiant-rstats/radiant.update", upgrade = "never") +``` + +Then select `Update radiant` from the `Addins` menu in Rstudio or use the command below: + +```r +radiant.update::radiant.update() +``` + +See the [installing radiant](https://radiant-rstats.github.io/docs/install.html) page additional for details. + +**Optional:** You can also create a launcher on your Desktop to start Radiant by typing `radiant::launcher()` in the R(studio) console and pressing return. A file called `radiant.bat` (windows) or `radiant.command` (mac) will be created that you can double-click to start Radiant in your default browser. The `launcher` command will also create a file called `update_radiant.bat` (windows) or `update_radiant.command` (mac) that you can double-click to update Radiant to the latest release. + +When Radiant starts you will see data on diamond prices. To close the application click the icon in the navigation bar and then click `Stop`. The Radiant process will stop and the browser window will close (Chrome) or gray-out. + +## Documentation + +Documentation and tutorials are available at and in the Radiant web interface (the icons on each page and the icon in the navigation bar). + +Individual Radiant packages also each have their own [pkgdown](https://github.com/r-lib/pkgdown) sites: + +* http://radiant-rstats.github.io/radiant +* http://radiant-rstats.github.io/radiant.data +* http://radiant-rstats.github.io/radiant.design +* http://radiant-rstats.github.io/radiant.basics +* http://radiant-rstats.github.io/radiant.model +* http://radiant-rstats.github.io/radiant.multivariate + +Want some help getting started? Watch the tutorials on the [documentation site](https://radiant-rstats.github.io/docs/tutorials.html). + + +## Reporting issues + +Please use the GitHub issue tracker at github.com/radiant-rstats/radiant/issues if you have any problems using Radiant. + +## Try Radiant online + +Not ready to install Radiant on your computer? Try it online at the link below: + +https://vnijs.shinyapps.io/radiant + +Do **not** upload sensitive data to this public server. The size of data upload has been restricted to 10MB for security reasons. + +## Running Radiant on shinyapps.io + +To run your own instance of Radiant on shinyapps.io first install Radiant and its dependencies. Then clone the radiant repo and ensure you have the latest version of the Radiant packages installed by running `radiant/inst/app/for.shinyapps.io.R`. Finally, open `radiant/inst/app/ui.R` and [deploy](https://shiny.posit.co/articles/shinyapps.html) the application. + +## Running Radiant on shiny-server + +You can also host Radiant using [shiny-server](https://posit.co/download/shiny-server/). First, install radiant on the server using the command below: + +```r +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org")) +install.packages("radiant") +``` + +Then clone the radiant repo and point shiny-server to the `inst/app/` directory. As a courtesy, please let me know if you intend to use Radiant on a server. + +When running Radiant on a server, by default, file uploads are limited to 10MB and R-code in _Report > Rmd_ and _Report > R_ will not be evaluated for security reasons. If you have `sudo` access to the server and have appropriate security in place you can change these settings by adding the following lines to `.Rprofile` for the `shiny` user on the server. + +```bash +options(radiant.maxRequestSize = -1) ## no file size limit +options(radiant.report = TRUE) +``` + +## Running Radiant in the cloud (e.g., AWS) + +To run radiant in the cloud you can use the customized Docker container. See https://github.com/radiant-rstats/docker for details + +## Saving and loading state + +To save your analyses save the state of the app to a file by clicking on the icon in the navbar and then on `Save radiant state file` (see also the _Data > Manage_ tab). You can open this state file at a later time or on another computer to continue where you left off. You can also share the file with others that may want to replicate your analyses. As an example, load the state file [`radiant-example.state.rda`](https://radiant-rstats.github.io/docs/examples/radiant-example.state.rda) by clicking on the icon in the navbar and then on `Load radiant state file`. Go to _Data > View_ and _Data > Visualize_ to see some of the settings from the previous "state" of the app. There is also a report in _Report > Rmd_ that was created using the Radiant interface. The html file `radiant-example.nb.html` contains the output. + +A related feature in Radiant is that state is maintained if you accidentally navigate to another web page, close (and reopen) the browser, and/or hit refresh. Use `Refresh` in the menu in the navigation bar to return to a clean/new state. + +Loading and saving state also works with Rstudio. If you start Radiant from Rstudio and use > `Stop` to stop the app, lists called `r_data`, `r_info`, and `r_state` will be put into Rstudio's global workspace. If you start radiant again using `radiant::radiant()` it will use these lists to restore state. Also, if you load a state file directly into Rstudio it will be used when you start Radiant to recreate a previous state. + +**Technical note**: Loading state works as follows in Radiant: When an input is initialized in a Shiny app you set a default value in the call to, for example, numericInput. In Radiant, when a state file has been loaded and an input is initialized it looks to see if there is a value for an input of that name in a list called `r_state`. If there is, this value is used. The `r_state` list is created when saving state using `reactiveValuesToList(input)`. An example of a call to `numericInput` is given below where the `state_init` function from `radiant.R` is used to check if a value from `r_state` can be used. + +```r +numericInput("sm_comp_value", "Comparison value:", state_init("sm_comp_value", 0)) +``` + +## Source code + +The source code for the radiant application is available on GitHub at . `radiant.data`, offers tools to load, save, view, visualize, summarize, combine, and transform data. `radiant.design` builds on `radiant.data` and adds tools for experimental design, sampling, and sample size calculation. `radiant.basics` covers the basics of statistical analysis (e.g., comparing means and proportions, cross-tabs, correlation, etc.) and includes a probability calculator. `radiant.model` covers model estimation (e.g., logistic regression and neural networks), model evaluation (e.g., gains chart, profit curve, confusion matrix, etc.), and decision tools (e.g., decision analysis and simulation). Finally, `radiant.multivariate` includes tools to generate brand maps and conduct cluster, factor, and conjoint analysis. + +These tools are used in the _Business Analytics_, _Quantitative Analysis_, _Research for Marketing Decisions_, _Applied Market Research_, _Consumer Behavior_, _Experiments in Firms_, _Pricing_, _Pricing Analytics_, and _Customer Analytics_ classes at the Rady School of Management (UCSD). + +## Credits + +Radiant would not be possible without [R](https://cran.r-project.org/) and [Shiny](https://shiny.posit.co/). I would like to thank [Joe Cheng](https://github.com/jcheng5), [Winston Chang](https://github.com/wch), and [Yihui Xie](https://github.com/yihui) for answering questions, providing suggestions, and creating amazing tools for the R community. Other key components used in Radiant are ggplot2, dplyr, tidyr, magrittr, broom, shinyAce, shinyFiles, rmarkdown, and DT. For an overview of other packages that Radiant relies on please see the about page. + + +## License + + +Radiant is licensed under the AGPLv3. As a summary, the AGPLv3 license requires, attribution, including copyright and license information in copies of the software, stating changes if the code is modified, and disclosure of all source code. Details are in the COPYING file. + +The documentation, images, and videos for the `radiant.data` package are licensed under the creative commons attribution and share-alike license CC-BY-SA. All other documentation and videos on this site, as well as the help files for `radiant.design`, `radiant.basics`, `radiant.model`, and `radiant.multivariate`, are licensed under the creative commons attribution, non-commercial, share-alike license CC-NC-SA. + +If you are interested in using any of the radiant packages please email me at radiant@rady.ucsd.edu + +© Vincent Nijs (2024) Creative Commons License \ No newline at end of file diff --git a/radiant.model/_pkgdown.yml b/radiant.model/_pkgdown.yml new file mode 100644 index 0000000000000000000000000000000000000000..517e5bc4edfa30f3915ddd2d40550a46ec9a2e3c --- /dev/null +++ b/radiant.model/_pkgdown.yml @@ -0,0 +1,232 @@ +url: https://radiant-rstats.github.io/radiant.model + +template: + params: + docsearch: + api_key: 279f8fe71a37f83093f51a606ddc3f50 + index_name: radiant_model + +navbar: + title: "radiant.model" + left: + - icon: fa-home fa-lg + href: index.html + - text: "Reference" + href: reference/index.html + - text: "Articles" + href: articles/index.html + - text: "Changelog" + href: news/index.html + - text: "Other Packages" + menu: + - text: "radiant" + href: https://radiant-rstats.github.io/radiant/ + - text: "radiant.data" + href: https://radiant-rstats.github.io/radiant.data/ + - text: "radiant.design" + href: https://radiant-rstats.github.io/radiant.design/ + - text: "radiant.basics" + href: https://radiant-rstats.github.io/radiant.basics/ + - text: "radiant.model" + href: https://radiant-rstats.github.io/radiant.model/ + - text: "radiant.multivariate" + href: https://radiant-rstats.github.io/radiant.multivariate/ + - text: "docker" + href: https://github.com/radiant-rstats/docker + right: + - icon: fa-twitter fa-lg + href: https://twitter.com/vrnijs + - icon: fa-github fa-lg + href: https://github.com/radiant-rstats + +reference: +- title: Model > Linear regression (OLS) + desc: Estimate linear regression models + contents: + - regress + - summary.regress + - predict.regress + - print.regress.predict + - plot.regress +- title: Model > Logistic regression + desc: Estimate logistic regression models + contents: + - logistic + - summary.logistic + - predict.logistic + - print.logistic.predict + - plot.logistic + - confint_robust +- title: Model > Multinomial logistic regression + desc: Estimate multinomial logistic regression models + contents: + - mnl + - summary.mnl + - predict.mnl + - print.mnl.predict + - plot.mnl.predict + - store.mnl.predict + - plot.mnl +- title: Model > Neural network + desc: Estimate neural network models + contents: + - nn + - summary.nn + - predict.nn + - print.nn.predict + - plot.nn + - cv.nn +- title: Model > Naive Bayes + desc: Estimate naive Bayes models + contents: + - nb + - summary.nb + - predict.nb + - print.nb.predict + - plot.nb.predict + - store.nb.predict + - plot.nb +- title: Model > Classification and regression trees + desc: Estimate classification and regression trees + contents: + - crtree + - summary.crtree + - predict.crtree + - print.crtree.predict + - plot.crtree + - cv.crtree +- title: Model > Random Forest + desc: Estimate a random forest of classification or regression trees + contents: + - rforest + - summary.rforest + - predict.rforest + - print.rforest.predict + - plot.rforest.predict + - store.rforest.predict + - plot.rforest + - cv.rforest +- title: Model > Gradient Boosted Trees + desc: Estimate a gradient boosted trees for regression of classification + contents: + - gbt + - summary.gbt + - predict.gbt + - print.gbt.predict + - plot.gbt + - cv.gbt +- title: Model > Evaluate regression + desc: Evaluate regression models + contents: + - evalreg + - summary.evalreg + - plot.evalreg + - MAE + - RMSE + - Rsq + - profit +- title: Model > Evaluate classification + desc: Evaluate binary classification models + contents: + - evalbin + - summary.evalbin + - plot.evalbin + - confusion + - summary.confusion + - plot.confusion + - auc + - rig + - uplift + - summary.uplift + - plot.uplift +- title: Model > Collaborative filtering + desc: Esitmate collaborative filtering models + contents: + - crs + - summary.crs + - plot.crs +- title: Model > Decision analysis + desc: Create and evaluate decision trees + contents: + - dtree + - summary.dtree + - plot.dtree + - sensitivity + - sensitivity.dtree + - dtree_parser +- title: Model > Simulate + desc: Create simulation models + contents: + - simulater + - summary.simulater + - plot.simulater + - repeater + - summary.repeater + - plot.repeater + - sim_summary + - sdw + - sim_cleaner + - sim_splitter + - sim_cor + - find_max + - find_min +- title: General modeling functions + desc: General modeling functions + contents: + - plot.model.predict + - scale_df + - minmax + - onehot + - predict_model + - print_predict_model + - store.model + - store.model.predict + - render.DiagrammeR + - test_specs + - var_check + - write.coeff + - pdp_plot + - pred_plot + - varimp + - varimp_plot +- title: Starting radiant.model + desc: Functions used to start radiant shiny apps + contents: + - radiant.model + - radiant.model_viewer + - radiant.model_window +- title: Data sets + desc: Data sets bundled with radiant.model + contents: + - catalog + - dvd + - direct_marketing + - houseprices + - ideal + - kaggle_uplift + - ketchup + - movie_contract + - ratings +- title: Deprecated + desc: Deprecated + contents: + - ann + - store.crs +articles: +- title: Model Menu + desc: > + These vignettes provide an introduction to the Model menu in radiant + contents: + - pkgdown/regress + - pkgdown/logistic + - pkgdown/mnl + - pkgdown/nn + - pkgdown/nb + - pkgdown/crtree + - pkgdown/rforest + - pkgdown/gbt + - pkgdown/evalreg + - pkgdown/evalbin + - pkgdown/crs + - pkgdown/dtree + - pkgdown/simulater diff --git a/radiant.model/build/build.R b/radiant.model/build/build.R new file mode 100644 index 0000000000000000000000000000000000000000..f0028bf1d19e95930b663bd33a8137a600b2a5e4 --- /dev/null +++ b/radiant.model/build/build.R @@ -0,0 +1,90 @@ +setwd(rstudioapi::getActiveProject()) +curr <- getwd() +pkg <- basename(curr) + +## building package for mac and windows +rv <- R.Version() +rv <- paste(rv$major, substr(rv$minor, 1, 1), sep = ".") + +rvprompt <- readline(prompt = paste0("Running for R version: ", rv, ". Is that what you wanted y/n: ")) +if (grepl("[nN]", rvprompt)) stop("Change R-version") + +dirsrc <- "../minicran/src/contrib" + +if (rv < "3.4") { + dirmac <- fs::path("../minicran/bin/macosx/mavericks/contrib", rv) +} else if (rv > "3.6") { + dirmac <- c( + fs::path("../minicran/bin/macosx/big-sur-arm64/contrib", rv), + fs::path("../minicran/bin/macosx/contrib", rv) + ) +} else { + dirmac <- fs::path("../minicran/bin/macosx/el-capitan/contrib", rv) +} + +dirwin <- fs::path("../minicran/bin/windows/contrib", rv) + +if (!fs::file_exists(dirsrc)) fs::dir_create(dirsrc, recursive = TRUE) +for (d in dirmac) { + if (!fs::file_exists(d)) fs::dir_create(d, recursive = TRUE) +} +if (!fs::file_exists(dirwin)) fs::dir_create(dirwin, recursive = TRUE) + +# delete older version of radiant +rem_old <- function(pkg) { + unlink(paste0(dirsrc, "/", pkg, "*")) + for (d in dirmac) { + unlink(paste0(d, "/", pkg, "*")) + } + unlink(paste0(dirwin, "/", pkg, "*")) +} + +sapply(pkg, rem_old) + +## avoid 'loaded namespace' stuff when building for mac +system(paste0(Sys.which("R"), " -e \"setwd('", getwd(), "'); app <- '", pkg, "'; source('build/build_mac.R')\"")) + +win <- readline(prompt = "Did you build on Windows? y/n: ") +if (grepl("[yY]", win)) { + + fl <- list.files(pattern = "*.zip", path = "~/Dropbox/r-packages/", full.names = TRUE) + for (f in fl) { + print(f) + file.copy(f, "~/gh/") + } + + ## move packages to radiant_miniCRAN. must package in Windows first + # path <- normalizePath("../") + pth <- fs::path_abs("../") + + sapply(list.files(pth, pattern = "*.tar.gz", full.names = TRUE), file.copy, dirsrc) + unlink("../*.tar.gz") + for (d in dirmac) { + sapply(list.files(pth, pattern = "*.tgz", full.names = TRUE), file.copy, d) + } + unlink("../*.tgz") + sapply(list.files(pth, pattern = "*.zip", full.names = TRUE), file.copy, dirwin) + unlink("../*.zip") + + tools::write_PACKAGES(dirwin, type = "win.binary") + for (d in dirmac) { + tools::write_PACKAGES(d, type = "mac.binary") + } + tools::write_PACKAGES(dirsrc, type = "source") + + # commit to repo + setwd("../minicran") + system("git add --all .") + mess <- paste0(pkg, " package update: ", format(Sys.Date(), format = "%m-%d-%Y")) + system(paste0("git commit -m '", mess, "'")) + system("git push") +} + +setwd(curr) + +pkgs <- c("radiant", "radiant.data", "radiant.design", "radiant.basics", "radiant.model", "radiant.multivariate") +sapply(pkgs, remove.packages) + +radiant.update::radiant.update() +# install.packages("radiant.update") + diff --git a/radiant.model/build/build_mac.R b/radiant.model/build/build_mac.R new file mode 100644 index 0000000000000000000000000000000000000000..1452bac080e154c24c6cd9acb6eef6c09a76c6ae --- /dev/null +++ b/radiant.model/build/build_mac.R @@ -0,0 +1,6 @@ +## build for mac +app <- basename(getwd()) +curr <- setwd("../") +f <- devtools::build(app) +system(paste0("R CMD INSTALL --build ", f)) +setwd(curr) diff --git a/radiant.model/build/build_win.R b/radiant.model/build/build_win.R new file mode 100644 index 0000000000000000000000000000000000000000..e6861ceb5e94157a4ed21359a4d3339b9f1de8fb --- /dev/null +++ b/radiant.model/build/build_win.R @@ -0,0 +1,26 @@ +## build for windows +rv <- R.Version() +rv <- paste(rv$major, substr(rv$minor, 1, 1), sep = ".") + +rvprompt <- readline(prompt = paste0("Running for R version: ", rv, ". Is that what you wanted y/n: ")) +if (grepl("[nN]", rvprompt)) + stop("Change R-version using Rstudio > Tools > Global Options > Rversion") + +## build for windows +setwd(rstudioapi::getActiveProject()) +f <- devtools::build(binary = TRUE) +devtools::install(upgrade = "never") + +fl <- list.files(pattern = "*.zip", path = "../", full.names = TRUE) + +for (f in fl) { + print(glue::glue("Copying: {f}")) + file.copy(f, "C:/Users/vnijs/Dropbox/r-packages/", overwrite = TRUE) + unlink(f) +} + +#options(repos = c(RSM = "https://radiant-rstats.github.io/minicran")) +#install.packages("radiant.data", type = "binary") +# remove.packages(c("radiant.data", "radiant.model")) +#install.packages("radiant.update") +# radiant.update::radiant.update() diff --git a/radiant.model/build/remove_screenshots.R b/radiant.model/build/remove_screenshots.R new file mode 100644 index 0000000000000000000000000000000000000000..532da15b03b26c31342e48c08c64e47d59532d19 --- /dev/null +++ b/radiant.model/build/remove_screenshots.R @@ -0,0 +1,30 @@ +## based on https://gist.github.com/mages/1544009 +cdir <- setwd("./inst/app/tools/help") + +## remove all local png files +list.files("./figures/", pattern = "*.png") +unlink("figures/*.png") +check <- list.files("./figures/", pattern = "*.png") +stopifnot(length(check) == 0) +cat("--", file = "figures/place_holder.txt") + +fn <- list.files(pattern = "\\.(md|Rmd)$") +for (f in fn) { + org <- readLines(f, warn = FALSE) + changed <- gsub("figures_model/", "https://radiant-rstats.github.io/docs/model/figures_model/", org) + cat(changed, file = f, sep = "\n") +} + +setwd(cdir) + +## get package checked +# devtools::check_win_devel() + +## submit package to CRAN +devtools::submit_cran() + +## use the git-tab to manually revert all changes to docs and +## restore all images + +## remove after reverting the changes from the code above +unlink("inst/app/tools/help/figures/place_holder.txt") diff --git a/radiant.model/data/catalog.rda b/radiant.model/data/catalog.rda new file mode 100644 index 0000000000000000000000000000000000000000..de4d76a82dcec4b2b6617c5a8dbf6bb7f02a42f9 Binary files /dev/null and b/radiant.model/data/catalog.rda differ diff --git a/radiant.model/data/direct_marketing.rda b/radiant.model/data/direct_marketing.rda new file mode 100644 index 0000000000000000000000000000000000000000..04e5b50c71b19b58a493e5ab51469bbf8828b3b9 Binary files /dev/null and b/radiant.model/data/direct_marketing.rda differ diff --git a/radiant.model/data/dvd.rda b/radiant.model/data/dvd.rda new file mode 100644 index 0000000000000000000000000000000000000000..b8731391a37def6f5b823264710a26ed93b5a996 Binary files /dev/null and b/radiant.model/data/dvd.rda differ diff --git a/radiant.model/data/houseprices.rda b/radiant.model/data/houseprices.rda new file mode 100644 index 0000000000000000000000000000000000000000..f8c4afe400572458e7c4e7978058e3d222a03f1f Binary files /dev/null and b/radiant.model/data/houseprices.rda differ diff --git a/radiant.model/data/ideal.rda b/radiant.model/data/ideal.rda new file mode 100644 index 0000000000000000000000000000000000000000..f3ea47f9878d4691b9afdf63ac7e66401a4e83a2 Binary files /dev/null and b/radiant.model/data/ideal.rda differ diff --git a/radiant.model/data/kaggle_uplift.rda b/radiant.model/data/kaggle_uplift.rda new file mode 100644 index 0000000000000000000000000000000000000000..353130290e9103cd2d3b1664cda9c1fa9c00dacc Binary files /dev/null and b/radiant.model/data/kaggle_uplift.rda differ diff --git a/radiant.model/data/ketchup.rda b/radiant.model/data/ketchup.rda new file mode 100644 index 0000000000000000000000000000000000000000..353b3f69f875efef8ee0374e2b669abf1be51814 Binary files /dev/null and b/radiant.model/data/ketchup.rda differ diff --git a/radiant.model/data/movie_contract.rda b/radiant.model/data/movie_contract.rda new file mode 100644 index 0000000000000000000000000000000000000000..9d5a32ea1c063dfefff967a6e886ea1524ff1089 Binary files /dev/null and b/radiant.model/data/movie_contract.rda differ diff --git a/radiant.model/data/ratings.rda b/radiant.model/data/ratings.rda new file mode 100644 index 0000000000000000000000000000000000000000..c6ad6bc4498af64ff87c24dfdc409b4b08d56765 Binary files /dev/null and b/radiant.model/data/ratings.rda differ diff --git a/radiant.model/inst/app/global.R b/radiant.model/inst/app/global.R new file mode 100644 index 0000000000000000000000000000000000000000..28672b85313722de0ff269cf0f7ab9df97e308e5 --- /dev/null +++ b/radiant.model/inst/app/global.R @@ -0,0 +1,31 @@ +library(shiny.i18n) +# file with translations +i18n <- Translator$new(translation_csvs_path = "../translations") + +# change this to zh +i18n$set_translation_language("zh") + +## sourcing from radiant.data +options(radiant.path.data = system.file(package = "radiant.data")) +source(file.path(getOption("radiant.path.data"), "app/global.R"), encoding = getOption("radiant.encoding", default = "UTF-8"), local = TRUE) + +ifelse(grepl("radiant.model", getwd()) && file.exists("../../inst"), "..", system.file(package = "radiant.model")) %>% + options(radiant.path.model = .) + +## setting path for figures in help files +addResourcePath("figures_model", "tools/help/figures/") + +## setting path for www resources +addResourcePath("www_model", file.path(getOption("radiant.path.model"), "app/www/")) + +## loading urls and ui +source("init.R", encoding = getOption("radiant.encoding", "UTF-8"), local = TRUE) +options(radiant.url.patterns = make_url_patterns()) + +if (!"package:radiant.model" %in% search() && + isTRUE(getOption("radiant.development")) && + getOption("radiant.path.model") == "..") { + options(radiant.from.package = FALSE) +} else { + options(radiant.from.package = TRUE) +} diff --git a/radiant.model/inst/app/help.R b/radiant.model/inst/app/help.R new file mode 100644 index 0000000000000000000000000000000000000000..0c4668be8bbc91fa36bf45a93b95f2f66cb7581c --- /dev/null +++ b/radiant.model/inst/app/help.R @@ -0,0 +1,33 @@ +help_model <- c( + "Linear regression (OLS)" = "regress.Rmd", + "Logistic regression (GLM)" = "logistic.Rmd", + "Multinomial logistic regression (MNL)" = "mnl.Rmd", + "Naive Bayes" = "nb.md", + "Neural Network" = "nn.md", + "Classification and regression trees" = "crtree.md", + "Random Forest" = "rf.md", + "Gradient Boosted Trees" = "gbt.md", + "Evaluate regression" = "evalreg.md", + "Evaluate classification" = "evalbin.md", + "Collaborative filtering" = "crs.md", + "Decision analysis" = "dtree.Rmd", + "Simulate" = "simulater.md" +) +output$help_model <- reactive(append_help("help_model", file.path(getOption("radiant.path.model"), "app/tools/help/"), Rmd = TRUE)) +observeEvent(input$help_model_all, { + help_switch(input$help_model_all, "help_model") +}) +observeEvent(input$help_model_none, { + help_switch(input$help_model_none, "help_model", help_on = FALSE) +}) + +help_model_panel <- tagList( + wellPanel( + HTML(""), + checkboxGroupInput( + "help_model", NULL, help_model, + selected = state_group("help_model"), inline = TRUE + ) + ) +) diff --git a/radiant.model/inst/app/init.R b/radiant.model/inst/app/init.R new file mode 100644 index 0000000000000000000000000000000000000000..a979f6cf02c54619d0efcebede6c6bbcb9353bba --- /dev/null +++ b/radiant.model/inst/app/init.R @@ -0,0 +1,101 @@ +import_fs("radiant.model", libs = "nnet", incl = "nnet.formula") + +## urls for menu +r_url_list <- getOption("radiant.url.list") +r_url_list[["Linear regression (OLS)"]] <- + list("tabs_regress" = list( + "Summary" = "model/regress/", + "Predict" = "model/regress/predict/", + "Plot" = "model/regress/plot/" + )) +r_url_list[["Logistic regression (GLM)"]] <- + list("tabs_logistic" = list( + "Summary" = "model/logistic/", + "Predict" = "model/logistic/predict/", + "Plot" = "model/logistic/plot/" + )) +r_url_list[["Multinomial logistic regression (MNL)"]] <- + list("tabs_mnl" = list( + "Summary" = "model/mnl/", + "Predict" = "model/mnl/predict/", + "Plot" = "model/mnl/plot/" + )) +r_url_list[["Naive Bayes"]] <- + list("tabs_nb" = list( + "Summary" = "model/nb/", + "Predict" = "model/nb/predict/", + "Plot" = "model/nb/plot/" + )) +r_url_list[["Neural Network"]] <- + list("tabs_nn" = list( + "Summary" = "model/nn/", + "Predict" = "model/nn/predict/", + "Plot" = "model/nn/plot/" + )) +r_url_list[["Classification and regression trees"]] <- + list("tabs_crtree" = list( + "Summary" = "model/crtree/", + "Predict" = "model/crtree/predict/", + "Plot" = "model/crtree/plot/" + )) +r_url_list[["Random Forest"]] <- + list("tabs_rf" = list( + "Summary" = "model/rf/", + "Predict" = "model/rf/predict/", + "Plot" = "model/rf/plot/" + )) +r_url_list[["Gradient Boosted Trees"]] <- + list("tabs_gbt" = list( + "Summary" = "model/gbtf/", + "Predict" = "model/gbt/predict/", + "Plot" = "model/gbt/plot/" + )) +r_url_list[["Evaluate regression"]] <- + list("tabs_evalreg" = list("Summary" = "model/evalreg/")) +r_url_list[["Evaluate classification"]] <- + list("tabs_evalbin" = list("Evaluate" = "model/evalbin/", "Confusion" = "model/evalbin/confusion/")) +r_url_list[["Collaborative Filtering"]] <- + list("tabs_crs" = list("Summary" = "model/crs/", "Plot" = "model/crs/plot/")) +r_url_list[["Decision analysis"]] <- + list("tabs_dtree" = list( + "Model" = "model/dtree/", "Plot" = "model/dtree/plot/", + "Sensitivity" = "model/dtree/sensitivity" + )) +r_url_list[["Simulate"]] <- + list("tabs_simulate" = list("Simulate" = "model/simulate/", "Repeat" = "model/simulate/repeat/")) +options(radiant.url.list = r_url_list) +rm(r_url_list) + +## model menu +options( + radiant.model_ui = + tagList( + navbarMenu( + i18n$t("Model"), + tags$head( + tags$link(rel = "stylesheet", type = "text/css", href = "www_model/style.css"), + tags$script(src = "www_model/js/store.js") + ), + i18n$t("Estimate"), + tabPanel(i18n$t("Linear regression (OLS)"), uiOutput("regress")), + tabPanel(i18n$t("Logistic regression (GLM)"), uiOutput("logistic")), + tabPanel(i18n$t("Cox Proportional Hazards Regression"),uiOutput("coxp")), + tabPanel(i18n$t("Multinomial logistic regression (MNL)"), uiOutput("mnl")), + tabPanel(i18n$t("Naive Bayes"), uiOutput("nb")), + tabPanel(i18n$t("Neural Network"), uiOutput("nn")), + tabPanel(i18n$t("Support Vector Machine (SVM)"),uiOutput("svm")), + "----", i18n$t("Trees"), + tabPanel(i18n$t("Classification and regression trees"), uiOutput("crtree")), + tabPanel(i18n$t("Random Forest"), uiOutput("rf")), + tabPanel(i18n$t("Gradient Boosted Trees"), uiOutput("gbt")), + "----", i18n$t("Evaluate"), + tabPanel(i18n$t("Evaluate regression"), uiOutput("evalreg")), + tabPanel(i18n$t("Evaluate classification"), uiOutput("evalbin")), + "----", i18n$t("Recommend"), + tabPanel(i18n$t("Collaborative Filtering"), uiOutput("crs")), + "----", i18n$t("Decide"), + tabPanel(i18n$t("Decision analysis"), uiOutput("dtree")), + tabPanel(i18n$t("Simulate"), uiOutput("simulater")) + ) + ) +) diff --git a/radiant.model/inst/app/radiant.R b/radiant.model/inst/app/radiant.R new file mode 100644 index 0000000000000000000000000000000000000000..9f5f4c5f2f6c0b877f42e771f8d9e95343caa11f --- /dev/null +++ b/radiant.model/inst/app/radiant.R @@ -0,0 +1,37 @@ +predict_plot_controls <- function(type, vars_color = NULL, init_color = "none") { + inp <- input[[paste0(type, "_evar")]] + req(available(inp)) + vars <- varnames() %>% .[. %in% inp] + + xvar <- paste0(type, "_xvar") + frow <- paste0(type, "_facet_row") + fcol <- paste0(type, "_facet_col") + col <- paste0(type, "_color") + vars_facet <- c("None" = ".", vars) + if (is.null(vars_color)) { + vars_color <- c("None" = "none", vars) + } + + tagList( + selectizeInput( + xvar, "X-variable:", choices = vars, + selected = state_single(xvar, vars), + multiple = FALSE + ), + selectizeInput( + frow, "Facet row:", vars_facet, + selected = state_single(frow, vars_facet, "."), + multiple = FALSE + ), + selectizeInput( + fcol, "Facet column:", vars_facet, + selected = state_single(fcol, vars_facet, "."), + multiple = FALSE + ), + selectizeInput( + col, "Color:", vars_color, + selected = state_single(col, vars_color, init_color), + multiple = FALSE + ) + ) +} diff --git a/radiant.model/inst/app/server.R b/radiant.model/inst/app/server.R new file mode 100644 index 0000000000000000000000000000000000000000..f7320cab53cef6fc9e2aaada97aba9e197f87bd4 --- /dev/null +++ b/radiant.model/inst/app/server.R @@ -0,0 +1,57 @@ +if (isTRUE(getOption("radiant.from.package"))) { + library(radiant.model) +} + +shinyServer(function(input, output, session) { + + ## source shared functions + source(file.path(getOption("radiant.path.data"), "app/init.R"), encoding = getOption("radiant.encoding"), local = TRUE) + source(file.path(getOption("radiant.path.data"), "app/radiant.R"), encoding = getOption("radiant.encoding"), local = TRUE) + source("help.R", encoding = getOption("radiant.encoding"), local = TRUE) + source("radiant.R", encoding = getOption("radiant.encoding"), local = TRUE) + + ## help ui + output$help_model_ui <- renderUI({ + sidebarLayout( + sidebarPanel( + help_data_panel, + help_model_panel, + uiOutput("help_text"), + width = 3 + ), + mainPanel( + HTML(paste0("

    Select help files to show and search

    ")), + htmlOutput("help_data"), + htmlOutput("help_model") + ) + ) + }) + + ## packages to use for example data + options(radiant.example.data = c("radiant.data", "radiant.model")) + + ## source data & app tools from radiant.data + for (file in list.files( + c( + file.path(getOption("radiant.path.data"), "app/tools/app"), + file.path(getOption("radiant.path.data"), "app/tools/data") + ), + pattern = "\\.(r|R)$", full.names = TRUE + )) + source(file, encoding = getOption("radiant.encoding"), local = TRUE) + + ## 'sourcing' package functions in the server.R environment for development + if (!isTRUE(getOption("radiant.from.package"))) { + for (file in list.files("../../R", pattern = "\\.(r|R)$", full.names = TRUE)) { + source(file, encoding = getOption("radiant.encoding"), local = TRUE) + } + cat("\nGetting radiant.model from source ...\n") + } + + ## source analysis tools for model menu + for (file in list.files(c("tools/analysis"), pattern = "\\.(r|R)$", full.names = TRUE)) + source(file, encoding = getOption("radiant.encoding"), local = TRUE) + + ## save state on refresh or browser close + saveStateOnRefresh(session) +}) diff --git a/radiant.model/inst/app/tools/analysis/cox_ui.R b/radiant.model/inst/app/tools/analysis/cox_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..a2cfdfd729a66476da8f90b69e7408b88247c19a --- /dev/null +++ b/radiant.model/inst/app/tools/analysis/cox_ui.R @@ -0,0 +1,585 @@ +## ========== coxp_ui.R 去错版 ========== + +## 1. 常量 ----------------------------------------------------------------- +coxp_show_interactions <- setNames(c("", 2, 3), + c(i18n$t("None"), i18n$t("2-way"), i18n$t("3-way"))) + +coxp_predict <- setNames(c("none", "data", "cmd", "datacmd"), + c(i18n$t("None"), i18n$t("Data"), i18n$t("Command"), i18n$t("Data & Command"))) + +coxp_check <- setNames(c("robust"), c(i18n$t("Robust"))) + +coxp_sum_check <- setNames(c("rmse", "confint"), + c(i18n$t("RMSE"), i18n$t("Confidence intervals"))) + +coxp_lines <- setNames(c("line", "loess", "jitter"), + c(i18n$t("Line"), i18n$t("Loess"), i18n$t("Jitter"))) + +coxp_plots <- setNames( + c("none", "dist", "correlations", "scatter", "vip", "pred_plot", "pdp", "dashboard", "resid_pred", "coef", "influence"), + c(i18n$t("None"), i18n$t("Distribution"), i18n$t("Correlations"), + i18n$t("Scatter"), i18n$t("Permutation Importance"), i18n$t("Prediction plots"), + i18n$t("Partial Dependence"), i18n$t("Dashboard"), i18n$t("Residual vs explanatory"), + i18n$t("Coefficient plot"), i18n$t("Influential observations")) +) + +## 2. 参数收集 ------------------------------------------------------------- +## 不再取 formals，全部用空列表占位 +coxp_args <- list() +coxp_sum_args <- list() +coxp_plot_args <- list() +coxp_pred_args <- list() +coxp_pred_plot_args <- list() + +## 输入收集 reactive +coxp_inputs <- reactive({ + args <- list() + args$data_filter <- if (input$show_filter) input$data_filter else "" + args$arr <- if (input$show_filter) input$data_arrange else "" + args$rows <- if (input$show_filter) input$data_rows else "" + args$dataset <- input$dataset + ## 其余参数手动映射 + for (i in r_drop(names(args))) { + args[[i]] <- input[[paste0("coxp_", i)]] + } + args +}) + +coxp_sum_inputs <- reactive({ + args <- coxp_sum_args + for (i in names(args)) args[[i]] <- input[[paste0("coxp_", i)]] + args +}) + +coxp_plot_inputs <- reactive({ list() }) + +coxp_pred_inputs <- reactive({ + args <- coxp_pred_args + for (i in names(args)) args[[i]] <- input[[paste0("coxp_", i)]] + args$pred_cmd <- "" + args$pred_data <- "" + if (input$coxp_predict == "cmd") { + args$pred_cmd <- gsub("\\s{2,}", " ", input$coxp_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% gsub("\"", "\'", .) + } else if (input$coxp_predict == "data") { + args$pred_data <- input$coxp_pred_data + } else if (input$coxp_predict == "datacmd") { + args$pred_cmd <- gsub("\\s{2,}", " ", input$coxp_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% gsub("\"", "\'", .) + args$pred_data <- input$coxp_pred_data + } + args +}) + +coxp_pred_plot_inputs <- reactive({ list() }) + +## 3. 变量选择 UI ---------------------------------------------------------- +output$ui_coxp_time <- renderUI({ + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- varnames()[isNum] + selectInput("coxp_time", i18n$t("Time variable:"), vars, + selected = state_single("coxp_time", vars)) +}) + +output$ui_coxp_status <- renderUI({ + vars <- varnames() + selectInput("coxp_status", i18n$t("Status variable:"), vars, + selected = state_single("coxp_status", vars)) +}) + +output$ui_coxp_evar <- renderUI({ + req(available(input$coxp_time), available(input$coxp_status)) + vars <- setdiff(varnames(), c(input$coxp_time, input$coxp_status)) + selectInput("coxp_evar", i18n$t("Explanatory variables:"), vars, + selected = state_multiple("coxp_evar", vars), + multiple = TRUE, size = min(10, length(vars)), selectize = FALSE) +}) + +## 4. 交互 / 包含 / 测试变量 ---------------------------------------------- +output$ui_coxp_incl <- renderUI({ + req(available(input$coxp_evar)) + vars <- input$coxp_evar + if (input[["coxp_plots"]] == "coef") { + vars_init <- vars + } else { + vars_init <- c() + } + selectInput( + "coxp_incl", i18n$t("Explanatory variables to include:"), choices = vars, + selected = state_multiple("coxp_incl", vars, vars_init), + multiple = TRUE, size = min(10, length(vars)), selectize = FALSE + ) +}) + +output$ui_coxp_incl_int <- renderUI({ + req(available(input$coxp_evar)) + choices <- character(0) + vars <- input$coxp_evar + if (length(vars) > 1) { + choices <- iterms(vars, 2) + } else { + updateSelectInput(session, "coxp_incl_int", choices = choices, selected = choices) + return() + } + selectInput( + "coxp_incl_int", + label = i18n$t("2-way interactions to explore:"), + choices = choices, + selected = state_multiple("coxp_incl_int", choices), + multiple = TRUE, + size = min(8, length(choices)), + selectize = FALSE + ) +}) + +output$ui_coxp_test_var <- renderUI({ + req(available(input$coxp_evar)) + vars <- input$coxp_evar + if (!is.null(input$coxp_int)) vars <- c(vars, input$coxp_int) + selectizeInput("coxp_test_var", i18n$t("Variables to test:"), + choices = vars, + selected = state_multiple("coxp_test_var", vars), + multiple = TRUE, + options = list(placeholder = i18n$t("None"), plugins = list("remove_button"))) +}) + +## 5. 交互选择 ------------------------------------------------------------ +output$ui_coxp_show_interactions <- renderUI({ + vars <- input$coxp_evar + isNum <- .get_class() %in% c("integer", "numeric", "ts") + if (any(vars %in% varnames()[isNum])) { + choices <- coxp_show_interactions[1:3] + } else { + choices <- coxp_show_interactions[1:max(min(3, length(input$coxp_evar)), 1)] + } + radioButtons("coxp_show_interactions", i18n$t("Interactions:"), + choices = choices, selected = state_init("coxp_show_interactions"), + inline = TRUE) +}) + +output$ui_coxp_int <- renderUI({ + choices <- character(0) + if (is.empty(input$coxp_show_interactions)) return() + vars <- input$coxp_evar + if (not_available(vars)) return() + isNum <- intersect(vars, varnames()[.get_class() %in% c("integer", "numeric", "ts")]) + if (length(isNum) > 0) choices <- qterms(isNum, input$coxp_show_interactions) + if (length(vars) > 1) choices <- c(choices, iterms(vars, input$coxp_show_interactions)) + if (length(choices) == 0) return() + selectInput("coxp_int", label = NULL, choices = choices, + selected = state_init("coxp_int"), + multiple = TRUE, size = min(8, length(choices)), selectize = FALSE) +}) + +## 6. 预测 / 绘图 / 刷新按钮 ---------------------------------------------- +observeEvent(input$dataset, { + updateSelectInput(session, "coxp_predict", selected = "none") + updateSelectInput(session, "coxp_plots", selected = "none") +}) + +output$ui_coxp_predict_plot <- renderUI({ predict_plot_controls("coxp") }) +output$ui_coxp_nrobs <- renderUI({ + nrobs <- nrow(.get_data()) + choices <- c("1,000" = 1000, "5,000" = 5000, "10,000" = 10000, "All" = -1) %>% .[. < nrobs] + selectInput("coxp_nrobs", i18n$t("Number of data points plotted:"), + choices = choices, selected = state_single("coxp_nrobs", choices, 1000)) +}) + +output$ui_coxp_store_res_name <- renderUI({ + req(input$dataset) + textInput("coxp_store_res_name", i18n$t("Store residuals:"), "", placeholder = i18n$t("Provide variable name")) +}) + +run_refresh(coxp_args, "coxp", tabs = "tabs_coxp", label = i18n$t("Estimate model"), relabel = i18n$t("Re-estimate model")) + +## 7. 主 UI ---------------------------------------------------------------- +output$ui_coxp <- renderUI({ + req(input$dataset) + tagList( + conditionalPanel( + condition = "input.tabs_coxp == 'Summary'", + wellPanel( + actionButton("coxp_run", i18n$t("Estimate model"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ) + ), + wellPanel( + conditionalPanel( + condition = "input.tabs_coxp == 'Summary'", + uiOutput("ui_coxp_time"), + uiOutput("ui_coxp_status"), + uiOutput("ui_coxp_evar"), + conditionalPanel( + condition = "input.coxp_evar != null", + uiOutput("ui_coxp_show_interactions"), + conditionalPanel( + condition = "input.coxp_show_interactions != ''", + uiOutput("ui_coxp_int") + ), + uiOutput("ui_coxp_test_var"), + checkboxGroupInput("coxp_check", NULL, coxp_check, + selected = state_group("coxp_check"), inline = TRUE), + checkboxGroupInput("coxp_sum_check", NULL, coxp_sum_check, + selected = state_group("coxp_sum_check"), inline = TRUE) + ) + ), + conditionalPanel( + condition = "input.tabs_coxp == 'Predict'", + selectInput("coxp_predict", i18n$t("Prediction input type:"), coxp_predict, + selected = state_single("coxp_predict", coxp_predict, "none")), + conditionalPanel( + "input.coxp_predict == 'data' | input.coxp_predict == 'datacmd'", + selectizeInput("coxp_pred_data", i18n$t("Prediction data:"), + choices = c("None" = "", r_info[["datasetlist"]]), + selected = state_single("coxp_pred_data", c("None" = "", r_info[["datasetlist"]]))) + ), + conditionalPanel( + "input.coxp_predict == 'cmd' | input.coxp_predict == 'datacmd'", + returnTextAreaInput("coxp_pred_cmd", i18n$t("Prediction command:"), + value = state_init("coxp_pred_cmd", ""), rows = 3, + placeholder = i18n$t("Type a formula to set values for model variables (e.g., age = 60; sex = 'Male') and press return")) + ), + conditionalPanel( + condition = "input.coxp_predict != 'none'", + checkboxInput("coxp_pred_plot", i18n$t("Plot predictions"), state_init("coxp_pred_plot", FALSE)), + conditionalPanel( + "input.coxp_pred_plot == true", + uiOutput("ui_coxp_predict_plot") + ) + ), + conditionalPanel( + "input.coxp_predict == 'data' | input.coxp_predict == 'datacmd'", + tags$table( + tags$td(textInput("coxp_store_pred_name", i18n$t("Store predictions:"), state_init("coxp_store_pred_name", "pred_coxp"))), + tags$td(actionButton("coxp_store_pred", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ) + ), + conditionalPanel( + condition = "input.tabs_coxp == 'Plot'", + selectInput("coxp_plots", i18n$t("Plots:"), choices = coxp_plots, + selected = state_single("coxp_plots", coxp_plots)), + conditionalPanel( + condition = "input.coxp_plots == 'coef' | input.coxp_plots == 'pdp' | input$coxp_plots == 'pred_plot'", + uiOutput("ui_coxp_incl"), + conditionalPanel( + condition = "input.coxp_plots == 'coef'", + checkboxInput("coxp_intercept", i18n$t("Include intercept"), state_init("coxp_intercept", FALSE)) + ), + conditionalPanel( + condition = "input.coxp_plots == 'pdp' | input.coxp_plots == 'pred_plot'", + uiOutput("ui_coxp_incl_int") + ) + ), + conditionalPanel( + condition = "input.coxp_plots %in% c('correlations','scatter','dashboard','resid_pred')", + uiOutput("ui_coxp_nrobs"), + conditionalPanel( + condition = "input.coxp_plots != 'correlations'", + checkboxGroupInput("coxp_lines", NULL, coxp_lines, + selected = state_group("coxp_lines"), inline = TRUE) + ) + ) + ), + conditionalPanel( + condition = "(input.tabs_coxp == 'Summary' && input$coxp_sum_check != undefined && input$coxp_sum_check.indexOf('confint') >= 0) || + (input.tabs_coxp == 'Predict' && input$coxp_predict != 'none') || + (input.tabs_coxp == 'Plot' && input$coxp_plots == 'coef')", + sliderInput("coxp_conf_lev", i18n$t("Confidence level:"), + min = 0.80, max = 0.99, value = state_init("coxp_conf_lev", .95), step = 0.01) + ), + conditionalPanel( + condition = "input.tabs_coxp == 'Summary'", + tags$table( + tags$td(uiOutput("ui_coxp_store_res_name")), + tags$td(actionButton("coxp_store_res", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ) + ), + help_and_report( + modal_title = i18n$t("Cox Proportional Hazards Regression"), + fun_name = "coxp", + help_file = inclMD(file.path(getOption("radiant.path.model"), "app/tools/help/cox.md")) + ) + ) +}) + +## 8. 绘图尺寸 ------------------------------------------------------------ +coxp_plot <- reactive({ + if (coxp_available() != "available") return() + if (is.empty(input$coxp_plots, "none")) return() + plot_width <- 650 + plot_height <- 500 + nr_vars <- length(input$coxp_evar) + 1 + + if (input$coxp_plots == "dist") { + plot_height <- (plot_height / 2) * ceiling(nr_vars / 2) + } else if (input$coxp_plots == "dashboard") { + plot_height <- 1.5 * plot_height + } else if (input$coxp_plots == "correlations") { + plot_height <- 150 * nr_vars + plot_width <- 150 * nr_vars + } else if (input$coxp_plots == "coef") { + incl <- paste0("^(", paste0(input$coxp_incl, "[|]*", collapse = "|"), ")") + nr_coeff <- sum(grepl(incl, .coxp()$coeff$label)) + plot_height <- 300 + 20 * nr_coeff + } else if (input$coxp_plots %in% c("scatter", "resid_pred")) { + plot_height <- (plot_height / 2) * ceiling((nr_vars - 1) / 2) + } else if (input$coxp_plots == "vip") { + plot_height <- max(500, 30 * nr_vars) + } else if (input$coxp_plots %in% c("pdp", "pred_plot")) { + nr_vars <- length(input$coxp_incl) + length(input$coxp_incl_int) + plot_height <- max(250, ceiling(nr_vars / 2) * 250) + if (length(input$coxp_incl_int) > 0) { + plot_width <- plot_width + min(2, length(input$coxp_incl_int)) * 90 + } + } + list(plot_width = plot_width, plot_height = plot_height) +}) + +coxp_plot_width <- function() coxp_plot() %>% (function(x) if (is.list(x)) x$plot_width else 650) +coxp_plot_height <- function() coxp_plot() %>% (function(x) if (is.list(x)) x$plot_height else 500) +coxp_pred_plot_height <- function() if (input$coxp_pred_plot) 500 else 1 + +## 9. 输出注册 ------------------------------------------------------------- +output$coxp <- renderUI({ + register_print_output("summary_coxp", ".summary_coxp") + register_print_output("predict_coxp", ".predict_print_coxp") + register_plot_output("predict_plot_coxp", ".predict_plot_coxp", height_fun = "coxp_pred_plot_height") + register_plot_output("plot_coxp", ".plot_coxp", height_fun = "coxp_plot_height", width_fun = "coxp_plot_width") + + coxp_output_panels <- tabsetPanel( + id = "tabs_coxp", + tabPanel(i18n$t("Summary"), value = "Summary", + download_link("dl_coxp_coef"), br(), + verbatimTextOutput("summary_coxp")), + tabPanel(i18n$t("Predict"), value = "Predict", + conditionalPanel("input.coxp_pred_plot == true", + download_link("dlp_coxp_pred"), + plotOutput("predict_plot_coxp", width = "100%", height = "100%")), + download_link("dl_coxp_pred"), br(), + verbatimTextOutput("predict_coxp")), + tabPanel(i18n$t("Plot"), value = "Plot", + download_link("dlp_coxp"), + plotOutput("plot_coxp", width = "100%", height = "100%")) + ) + + stat_tab_panel( + menu = i18n$t("Model > Estimate"), + tool = i18n$t("Cox Proportional Hazards Regression"), + tool_ui = "ui_coxp", + output_panels = coxp_output_panels + ) +}) + +## 10. 可用性检查 ---------------------------------------------------------- +coxp_available <- eventReactive(input$coxp_run, { + if (not_available(input$coxp_time)) { + i18n$t("This analysis requires a time variable of type integer/numeric.") %>% suggest_data("lung") + } else if (not_available(input$coxp_status)) { + i18n$t("Please select a status (event) variable.") %>% suggest_data("lung") + } else if (not_available(input$coxp_evar)) { + i18n$t("Please select one or more explanatory variables.") %>% suggest_data("lung") + } else { + "available" + } +}) + +## 11. 模型估计 ------------------------------------------------------------ +.coxp <- eventReactive(input$coxp_run, { + ci <- coxp_inputs() + ci$envir <- r_data + withProgress(message = i18n$t("Estimating Cox model"), value = 1, + do.call(coxph, ci)) +}) + +## 12. summary / predict / plot -------------------------------------------- +.summary_coxp <- reactive({ + if (not_pressed(input$coxp_run)) return(i18n$t("** Press the Estimate button to estimate the model **")) + if (coxp_available() != "available") return(coxp_available()) + summary(.coxp()$model) # 直接调 survival 的 summary +}) + +.predict_coxp <- reactive({ + if (not_pressed(input$coxp_run)) return(i18n$t("** Press the Estimate button to estimate the model **")) + if (coxp_available() != "available") return(coxp_available()) + if (is.empty(input$coxp_predict, "none")) return(i18n$t("** Select prediction input **")) + if ((input$coxp_predict == "data" || input$coxp_predict == "datacmd") && is.empty(input$coxp_pred_data)) + return(i18n$t("** Select data for prediction **")) + if (input$coxp_predict == "cmd" && is.empty(input$coxp_pred_cmd)) + return(i18n$t("** Enter prediction commands **")) + + withProgress(message = i18n$t("Generating predictions"), value = 1, { + pi <- coxp_pred_inputs() + pi$object <- .coxp() + pi$envir <- r_data + do.call(predict, pi) + }) +}) + +.predict_print_coxp <- reactive({ + .predict_coxp() %>% { if (is.character(.)) cat(., "\n") else print(.) } +}) + +.predict_plot_coxp <- reactive({ + req(pressed(input$coxp_run), input$coxp_pred_plot, available(input$coxp_xvar), !is.empty(input$coxp_predict, "none")) + withProgress(message = i18n$t("Generating prediction plot"), value = 1, + do.call(plot, c(list(x = .predict_coxp()), coxp_pred_plot_inputs()))) +}) + +.plot_coxp <- reactive({ + if (not_pressed(input$coxp_run)) return(i18n$t("** Press the Estimate button to estimate the model **")) + if (is.empty(input$coxp_plots, "none")) return(i18n$t("Please select a plot from the drop-down menu")) + if (coxp_available() != "available") return(coxp_available()) + if (!input$coxp_plots %in% c("coef", "dist", "influence", "vip", "pdp", "pred_plot")) req(input$coxp_nrobs) + check_for_pdp_pred_plots("coxp") + withProgress(message = i18n$t("Generating plots"), value = 1, { + if (input$coxp_plots == "correlations") { + capture_plot(do.call(plot, c(list(x = .coxp()), coxp_plot_inputs()))) + } else { + do.call(plot, c(list(x = .coxp()), coxp_plot_inputs(), shiny = TRUE)) + } + }) +}) + +## 13. 报告 / 下载 / 存储 ------------------------------------------------- +coxp_report <- function() { + if (is.empty(input$coxp_evar)) return(invisible()) + outputs <- c("summary") + inp_out <- list(list(prn = TRUE), "") + figs <- FALSE + if (!is.empty(input$coxp_plots, "none")) { + inp <- check_plot_inputs(coxp_plot_inputs()) + inp_out[[2]] <- clean_args(inp, list()) # coxp_plot_args 已空 + inp_out[[2]]$custom <- FALSE + outputs <- c(outputs, "plot") + figs <- TRUE + } + if (!is.empty(input$coxp_store_res_name)) { + fixed <- fix_names(input$coxp_store_res_name) + updateTextInput(session, "coxp_store_res_name", value = fixed) + xcmd <- paste0(input$dataset, " <- store(", input$dataset, ", result, name = \"", fixed, "\")\n") + } else { + xcmd <- "" + } + if (!is.empty(input$coxp_predict, "none") && + (!is.empty(input$coxp_pred_data) || !is.empty(input$coxp_pred_cmd))) { + pred_args <- clean_args(coxp_pred_inputs(), list()) + if (!is.empty(pred_args$pred_cmd)) pred_args$pred_cmd <- strsplit(pred_args$pred_cmd, ";\\s*")[[1]] else pred_args$pred_cmd <- NULL + if (!is.empty(pred_args$pred_data)) pred_args$pred_data <- as.symbol(pred_args$pred_data) else pred_args$pred_data <- NULL + inp_out[[2 + figs]] <- pred_args + outputs <- c(outputs, "pred <- predict") + xcmd <- paste0(xcmd, "print(pred, n = 10)") + if (input$coxp_predict %in% c("data", "datacmd")) { + fixed <- unlist(strsplit(input$coxp_store_pred_name, "(\\s*,\\s*|\\s*;\\s*)")) %>% + fix_names() %>% deparse(., control = getOption("dctrl"), width.cutoff = 500L) + xcmd <- paste0(xcmd, "\n", input$coxp_pred_data, " <- store(", input$coxp_pred_data, ", pred, name = ", fixed, ")") + } + if (input$coxp_pred_plot && !is.empty(input$coxp_xvar)) { + inp_out[[3 + figs]] <- clean_args(coxp_pred_plot_inputs(), list()) + inp_out[[3 + figs]]$result <- "pred" + outputs <- c(outputs, "plot") + figs <- TRUE + } + } + update_report( + inp_main = clean_args(coxp_inputs(), coxp_args), + fun_name = "coxp", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = coxp_plot_width(), + fig.height = coxp_plot_height(), + xcmd = xcmd + ) +} + +observeEvent(input$coxp_store_res, { + req(pressed(input$coxp_run)) + robj <- .coxp() + if (!is.list(robj)) return() + fixed <- fix_names(input$coxp_store_res_name) + updateTextInput(session, "coxp_store_res_name", value = fixed) + withProgress(message = i18n$t("Storing residuals"), value = 1, + r_data[[input$dataset]] <- store(r_data[[input$dataset]], robj, name = fixed)) +}) + +observeEvent(input$coxp_store_pred, { + req(!is.empty(input$coxp_pred_data), pressed(input$coxp_run)) + pred <- .predict_coxp() + if (is.null(pred)) return() + fixed <- fix_names(input$coxp_store_pred_name) + updateTextInput(session, "coxp_store_pred_name", value = fixed) + withProgress(message = i18n$t("Storing predictions"), value = 1, + r_data[[input$coxp_pred_data]] <- store(r_data[[input$coxp_pred_data]], pred, name = fixed)) +}) + +## 14. 下载 ---------------------------------------------------------------- +dl_coxp_coef <- function(path) { + if (pressed(input$coxp_run)) { + write.coeff(.coxp(), file = path) + } else { + cat(i18n$t("No output available. Press the Estimate button to generate results"), file = path) + } +} + +download_handler( + id = "dl_coxp_coef", + fun = dl_coxp_coef, + fn = function() paste0(input$dataset, "_coxp_coef"), + type = "csv", + caption = i18n$t("Save Cox coefficients") +) + +dl_coxp_pred <- function(path) { + if (pressed(input$coxp_run)) { + write.csv(.predict_coxp(), file = path, row.names = FALSE) + } else { + cat(i18n$t("No output available. Press the Estimate button to generate results"), file = path) + } +} + +download_handler( + id = "dl_coxp_pred", + fun = dl_coxp_pred, + fn = function() paste0(input$dataset, "_coxp_pred"), + type = "csv", + caption = i18n$t("Save Cox predictions") +) + +download_handler( + id = "dlp_coxp_pred", + fun = download_handler_plot, + fn = paste0(input$dataset, "_coxp_pred"), + type = "png", + caption = i18n$t("Save Cox prediction plot"), + plot = .predict_plot_coxp, + width = plot_width, + height = coxp_pred_plot_height +) + +download_handler( + id = "dlp_coxp", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_", input$coxp_plots, "_coxp"), + type = "png", + caption = i18n$t("Save Cox plot"), + plot = .plot_coxp, + width = coxp_plot_width, + height = coxp_plot_height +) + +## 15. 报告 / 截图 --------------------------------------------------------- +observeEvent(input$coxp_report, { + r_info[["latest_screenshot"]] <- NULL + coxp_report() +}) + +observeEvent(input$coxp_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_coxp_screenshot") +}) + +observeEvent(input$modal_coxp_screenshot, { + coxp_report() + removeModal() +}) \ No newline at end of file diff --git a/radiant.model/inst/app/tools/analysis/crs_ui.R b/radiant.model/inst/app/tools/analysis/crs_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..fa74d26a22a570f5b4e525dd4c1dfdcdfe751eb5 --- /dev/null +++ b/radiant.model/inst/app/tools/analysis/crs_ui.R @@ -0,0 +1,321 @@ +# list of function arguments +crs_args <- as.list(formals(crs)) + +crs_inputs <- reactive({ + # loop needed because reactive values don't allow single bracket indexing + crs_args$data_filter <- if (input$show_filter) input$data_filter else "" + crs_args$arr <- if (input$show_filter) input$data_arrange else "" + crs_args$rows <- if (input$show_filter) input$data_rows else "" + crs_args$dataset <- input$dataset + for (i in r_drop(names(crs_args))) { + crs_args[[i]] <- input[[paste0("crs_", i)]] + } + crs_args +}) + +############################################################### +# Evaluate model evalbin +############################################################### +output$ui_crs_id <- renderUI({ + vars <- c("None" = "", varnames()) + selectInput( + inputId = "crs_id", label = i18n$t("User id:"), choices = vars, + selected = state_single("crs_id", vars), multiple = FALSE + ) +}) + +output$ui_crs_prod <- renderUI({ + req(available(input$crs_id)) + vars <- varnames() + vars <- vars[-which(vars %in% input$crs_id)] + + selectInput( + inputId = "crs_prod", label = i18n$t("Product id:"), choices = vars, + selected = state_single("crs_prod", vars), multiple = FALSE + ) +}) + +output$ui_crs_pred <- renderUI({ + req(input$crs_prod) + if (available(input$crs_prod)) { + levs <- .get_data()[[input$crs_prod]] %>% + as.factor() %>% + levels() + } else { + levs <- c() + } + + selectInput( + "crs_pred", i18n$t("Choose products to recommend:"), + choices = levs, + selected = state_init("crs_pred", levs), + multiple = TRUE, + size = min(3, length(levs)), + selectize = FALSE + ) +}) + +output$ui_crs_rate <- renderUI({ + req(input$crs_prod) + vars <- varnames() + vars <- vars[-which(c(input$crs_id, input$crs_prod) %in% vars)] + + selectInput( + inputId = "crs_rate", label = i18n$t("Ratings variable:"), choices = vars, + selected = state_single("crs_rate", vars), multiple = FALSE + ) +}) + +output$ui_crs_store_pred_name <- renderUI({ + req(input$dataset) + textInput("crs_store_pred_name", NULL, "", placeholder = i18n$t("Provide data name")) +}) + +## add a spinning refresh icon if the model needs to be (re)estimated +run_refresh(crs_args, "crs", init = "pred", tabs = "tabs_crs", label = i18n$t("Estimate model"), relabel = i18n$t("Re-estimate model")) + +output$ui_crs <- renderUI({ + req(input$dataset) + tagList( + conditionalPanel( + "input.tabs_crs == 'Summary'", + wellPanel( + actionButton("crs_run", i18n$t("Estimate model"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ) + ), + conditionalPanel( + "input.tabs_crs == 'Summary'", + wellPanel( + uiOutput("ui_crs_id"), + uiOutput("ui_crs_prod"), + uiOutput("ui_crs_pred"), + uiOutput("ui_crs_rate"), + HTML(i18n$t("")), + tags$table( + tags$td(uiOutput("ui_crs_store_pred_name")), + tags$td(actionButton("crs_store_pred", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top_mini") + ) + ) + ), + help_and_report( + modal_title = i18n$t("Collaborative Filtering"), + fun_name = "crs", + help_file = inclMD(file.path(getOption("radiant.path.model"), "app/tools/help/crs.md")) + ) + ) +}) + +crs_plot <- eventReactive(input$crs_run, { + if (length(input$crs_pred) == 0) { + plot_height <- 500 + plot_width <- 650 + } else { + plot_height <- ceiling(length(input$crs_pred) / 3) * 220 + plot_width <- min(4, length(input$crs_pred)) * 220 + } + list(plot_width = plot_width, plot_height = plot_height) +}) + +crs_plot_width <- function() { + crs_plot() %>% + { + if (is.list(.)) .$plot_width else 650 + } +} + +crs_plot_height <- function() { + crs_plot() %>% + { + if (is.list(.)) .$plot_height else 500 + } +} + +# output is called from the main radiant ui.R +output$crs <- renderUI({ + register_print_output("summary_crs", ".summary_crs") + register_plot_output( + "plot_crs", ".plot_crs", + width_fun = "crs_plot_width", + height_fun = "crs_plot_height" + ) + + # one output with components stacked + crs_output_panels <- tabsetPanel( + id = "tabs_crs", + tabPanel( + title = i18n$t("Summary"), + value ="Summary", + download_link("dl_crs_recommendations"), br(), + verbatimTextOutput("summary_crs") + ), + tabPanel( + title = i18n$t("Plot"), + value ="Plot", + download_link("dlp_crs"), + plotOutput("plot_crs", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Model > Recommend"), + tool = i18n$t("Collaborative Filtering"), + tool_ui = "ui_crs", + output_panels = crs_output_panels + ) +}) + +.crs <- eventReactive(input$crs_run, { + if (is.empty(input$crs_id)) { + i18n$t("This analysis requires a user id, a product id, and product ratings.\nIf these variables are not available please select another dataset.\n\n") %>% + suggest_data("ratings") + } else if (!input$show_filter || (is.empty(input$data_filter) && is.empty(input$data_rows))) { + i18n$t("A data filter or slice must be set to generate recommendations using\ncollaborative filtering. Add a filter or slice in the Data > View tab.\nNote that the users in the training sample should not overlap\nwith the users in the test sample.") %>% + add_class("crs") + } else if (!is.empty(r_info[["filter_error"]])) { + i18n$t("An invalid filter has been set for this dataset. Please\nadjust the filter in the Data > View tab and try again") %>% + add_class("crs") + } else if (length(input$crs_pred) < 1) { + i18n$t("Please select one or more products to generate recommendations") %>% + add_class("crs") + } else { + withProgress(message = i18n$t("Estimating model"), value = 1, { + crsi <- crs_inputs() + crsi$envir <- r_data + do.call(crs, crsi) + }) + } +}) + +.summary_crs <- reactive({ + if (not_pressed(input$crs_run)) { + i18n$t("** Press the Estimate button to generate recommendations **") + } else if (is.empty(input$crs_id)) { + i18n$t("This analysis requires a user id, a product id, and product ratings.\nIf these variables are not available please select another dataset.\n\n") %>% + suggest_data("ratings") + } else { + summary(.crs()) + } +}) + +.plot_crs <- reactive({ + if (not_pressed(input$crs_run)) { + return(i18n$t("** Press the Estimate button to generate recommendations **")) + } + isolate({ + if (is.empty(input$crs_id)) { + return(invisible()) + } + withProgress(message = i18n$t("Generating plots"), value = 1, { + plot(.crs()) + }) + }) +}) + +## Add reporting option +crs_report <- function() { + crs <- .crs() + if (is.character(crs)) { + return(invisible()) + } else if (!any(is.na(crs$act))) { + outputs <- c("summary", "plot") + figs <- TRUE + } else { + outputs <- "summary" + figs <- FALSE + } + if (nrow(crs$recommendations) > 36) { + inp_out <- list(list(n = 36), "") + } else { + inp_out <- list("", "") + } + if (!is.empty(input$crs_store_pred_name)) { + fixed <- fix_names(input$crs_store_pred_name) + updateTextInput(session, "crs_store_pred_name", value = fixed) + xcmd <- paste0(fixed, " <- result$recommendations\nregister(\"", fixed, "\")") + } else { + xcmd <- "" + } + + update_report( + inp_main = clean_args(crs_inputs(), crs_args), + fun_name = "crs", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = crs_plot_width(), + fig.height = crs_plot_height(), + xcmd = xcmd + ) +} + +## Store results +observeEvent(input$crs_store_pred, { + req(input$crs_store_pred_name) + pred <- .crs() + if (!is.data.frame(pred$recommendations)) { + return(i18n$t("No data selected to generate recommendations")) + } + fixed <- fix_names(input$crs_store_pred_name) + updateTextInput(session, "crs_store_pred_name", value = fixed) + r_data[[fixed]] <- pred$recommendations + register(fixed) + + ## See https://shiny.posit.co//reference/shiny/latest/modalDialog.html + showModal( + modalDialog( + title = i18n$t("Data Stored"), + span( + i18n$t( + "Dataset '{fixed}' was successfully added to the datasets dropdown. Add code to Report > Rmd or Report > R to (re)create the dataset by clicking the report icon on the bottom left of your screen.", + fixed = fixed + ) + ), + footer = modalButton(i18n$t("OK")), + size = "s", + easyClose = TRUE + ) + ) +}) + +dl_crs_recommendations <- function(path) { + pred <- .crs() + if (!is.data.frame(pred$recommendations)) { + write.csv(i18n$t("No recommendations available"), file = path, row.names = FALSE) + } else { + write.csv(pred$recommendations, file = path, row.names = FALSE) + } +} + +download_handler( + id = "dl_crs_recommendations", + fun = dl_crs_recommendations, + fn = function() paste0(input$dataset, "_recommendations"), + type = "csv", + caption = i18n$t("Save collaborative filtering recommendations") +) + +download_handler( + id = "dlp_crs", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_recommendations"), + type = "png", + caption = i18n$t("Save collaborative filtering plot"), + plot = .plot_crs, + width = crs_plot_width, + height = crs_plot_height +) + +observeEvent(input$crs_report, { + r_info[["latest_screenshot"]] <- NULL + crs_report() +}) + +observeEvent(input$crs_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_crs_screenshot") +}) + +observeEvent(input$modal_crs_screenshot, { + crs_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.model/inst/app/tools/analysis/crtree_ui.R b/radiant.model/inst/app/tools/analysis/crtree_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..1d5d265118fc5e3099926840ebfa2c55eedb8279 --- /dev/null +++ b/radiant.model/inst/app/tools/analysis/crtree_ui.R @@ -0,0 +1,818 @@ +ctree_plot_values <- c("none", "prune", "tree", "vip", "pred_plot", "pdp", "dashboard") +ctree_plot_labels <- c( + i18n$t("None"), + i18n$t("Prune"), + i18n$t("Tree"), + i18n$t("Permutation Importance"), + i18n$t("Prediction plots"), + i18n$t("Partial Dependence"), + i18n$t("Dashboard") +) +ctree_plots <- setNames(ctree_plot_values, ctree_plot_labels) + +## list of function arguments +crtree_args <- as.list(formals(crtree)) + +## list of function inputs selected by user +crtree_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + crtree_args$data_filter <- if (input$show_filter) input$data_filter else "" + crtree_args$arr <- if (input$show_filter) input$data_arrange else "" + crtree_args$rows <- if (input$show_filter) input$data_rows else "" + crtree_args$dataset <- input$dataset + for (i in r_drop(names(crtree_args))) { + crtree_args[[i]] <- input[[paste0("crtree_", i)]] + } + crtree_args +}) + +crtree_pred_args <- as.list(if (exists("predict.crtree")) { + formals(predict.crtree) +} else { + formals(radiant.model:::predict.crtree) +}) + +# list of function inputs selected by user +crtree_pred_inputs <- reactive({ + # loop needed because reactive values don't allow single bracket indexing + for (i in names(crtree_pred_args)) { + crtree_pred_args[[i]] <- input[[paste0("crtree_", i)]] + } + + crtree_pred_args$pred_cmd <- crtree_pred_args$pred_data <- "" + if (input$crtree_predict == "cmd") { + crtree_pred_args$pred_cmd <- gsub("\\s{2,}", " ", input$crtree_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% + gsub("\"", "\'", .) + } else if (input$crtree_predict == "data") { + crtree_pred_args$pred_data <- input$crtree_pred_data + } else if (input$crtree_predict == "datacmd") { + crtree_pred_args$pred_cmd <- gsub("\\s{2,}", " ", input$crtree_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% + gsub("\"", "\'", .) + crtree_pred_args$pred_data <- input$crtree_pred_data + } + crtree_pred_args +}) + +crtree_plot_args <- as.list(if (exists("plot.crtree")) { + formals(plot.crtree) +} else { + formals(radiant.model:::plot.crtree) +}) + +## list of function inputs selected by user +crtree_plot_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(crtree_plot_args)) { + crtree_plot_args[[i]] <- input[[paste0("crtree_", i)]] + } + crtree_plot_args +}) + +crtree_pred_plot_args <- as.list(if (exists("plot.model.predict")) { + formals(plot.model.predict) +} else { + formals(radiant.model:::plot.model.predict) +}) + +# list of function inputs selected by user +crtree_pred_plot_inputs <- reactive({ + # loop needed because reactive values don't allow single bracket indexing + for (i in names(crtree_pred_plot_args)) { + crtree_pred_plot_args[[i]] <- input[[paste0("crtree_", i)]] + } + crtree_pred_plot_args +}) + +output$ui_crtree_rvar <- renderUI({ + req(input$crtree_type) + + withProgress(message = i18n$t("Acquiring variable information"), value = 1, { + if (input$crtree_type == "classification") { + vars <- two_level_vars() + } else { + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- varnames()[isNum] + } + }) + selectInput( + inputId = "crtree_rvar", label = i18n$t("Response variable:"), choices = vars, + selected = state_single("crtree_rvar", vars), multiple = FALSE + ) +}) + +output$ui_crtree_lev <- renderUI({ + req(input$crtree_type == "classification") + req(available(input$crtree_rvar)) + levs <- .get_data()[[input$crtree_rvar]] %>% + as.factor() %>% + levels() + + selectInput( + inputId = "crtree_lev", label = i18n$t("Choose level:"), + choices = levs, selected = state_init("crtree_lev") + ) +}) + +output$ui_crtree_evar <- renderUI({ + req(available(input$crtree_rvar)) + vars <- varnames() + if (length(vars) > 0) { + vars <- vars[-which(vars == input$crtree_rvar)] + } + + init <- if (input$crtree_type == "classification") input$logit_evar else input$reg_evar + selectInput( + inputId = "crtree_evar", label = i18n$t("Explanatory variables:"), choices = vars, + selected = state_multiple("crtree_evar", vars, init), + multiple = TRUE, size = min(10, length(vars)), selectize = FALSE + ) +}) + +output_incl <- function(model) { + output[[glue("ui_{model}_incl")]] <- renderUI({ + req(available(input[[glue("{model}_evar")]])) + vars <- input[[glue("{model}_evar")]] + id <- glue("{model}_incl") + selectInput( + inputId = id, label = i18n$t("Explanatory variables to include:"), choices = vars, + selected = state_multiple(id, vars, c()), + multiple = TRUE, size = min(10, length(vars)), selectize = FALSE + ) + }) +} + +output_incl_int <- function(model) { + output[[glue("ui_{model}_incl_int")]] <- renderUI({ + req(available(input[[glue("{model}_evar")]])) + choices <- character(0) + vars <- input[[glue("{model}_evar")]] + id <- glue("{model}_incl_int") + ## list of interaction terms to show + if (length(vars) > 1) { + choices <- c(choices, iterms(vars, 2)) + } else { + updateSelectInput(session, glue("{model}_incl_int"), choices = choices, selected = choices) + return() + } + selectInput( + inputId = id, + label = i18n$t("2-way interactions to explore:"), + choices = choices, + selected = state_multiple(id, choices), + multiple = TRUE, + size = min(8, length(choices)), + selectize = FALSE + ) + }) +} + +# function calls generate UI elements +output_incl("crtree") +output_incl_int("crtree") + +output$ui_crtree_wts <- renderUI({ + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- varnames()[isNum] + if (length(vars) > 0 && any(vars %in% input$crtree_evar)) { + vars <- base::setdiff(vars, input$crtree_evar) + names(vars) <- varnames() %>% + (function(x) x[match(vars, x)]) %>% + names() + } + vars <- c("None", vars) + + selectInput( + inputId = "crtree_wts", label = i18n$t("Weights:"), choices = vars, + selected = state_single("crtree_wts", vars), + multiple = FALSE + ) +}) + +## reset prediction settings when the dataset changes +observeEvent(input$dataset, { + updateSelectInput(session = session, inputId = "crtree_predict", selected = "none") + updateSelectInput(session = session, inputId = "crtree_plots", selected = "none") +}) + +observeEvent(input$crtree_cost, { + if (!is.empty(input$crtree_cost)) { + updateNumericInput(session = session, inputId = "crtree_prior", value = NA) + } +}) + +output$ui_crtree_predict_plot <- renderUI({ + predict_plot_controls("crtree") +}) + +output$ui_crtree_width <- renderUI({ + init <- ifelse(is.empty(input$get_screen_width), 900, (input$get_screen_width - 400)) + init <- init - init %% 100 + numericInput( + "crtree_width", + label = i18n$t("Width:"), + value = state_init("crtree_width", init), + step = 100, min = 600, max = 3000 + ) +}) + +output$ui_crtree_store_res_name <- renderUI({ + req(input$dataset) + textInput("crtree_store_res_name", i18n$t("Store residuals:"), "", placeholder = i18n$t("Provide variable name")) +}) + +output$ui_crtree_nrobs <- renderUI({ + nrobs <- nrow(.get_data()) + choices <- c("1,000" = 1000, "5,000" = 5000, "10,000" = 10000, "All" = -1) %>% + .[. < nrobs] + selectInput( + "crtree_nrobs", i18n$t("Number of data points plotted:"), + choices = choices, + selected = state_single("crtree_nrobs", choices, 1000) + ) +}) + +## add a spinning refresh icon if the model needs to be (re)estimated +run_refresh(crtree_args, "crtree", tabs = "tabs_crtree", label = i18n$t("Estimate model"), relabel = i18n$t("Re-estimate model")) + +output$ui_crtree <- renderUI({ + req(input$dataset) + tagList( + conditionalPanel( + condition = "input.tabs_crtree == 'Summary'", + wellPanel( + actionButton("crtree_run", i18n$t("Estimate model"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ) + ), + wellPanel( + conditionalPanel( + condition = "input.tabs_crtree == 'Summary'", + radioButtons( + "crtree_type", + label = NULL, c(i18n$t("classification"), i18n$t("regression")), + selected = state_init("crtree_type", "classification"), + inline = TRUE + ), + uiOutput("ui_crtree_rvar"), + uiOutput("ui_crtree_lev"), + uiOutput("ui_crtree_evar"), + # uiOutput("ui_crtree_wts"), + conditionalPanel( + condition = "input.crtree_type == 'classification'", + tags$table( + tags$td(numericInput( + "crtree_prior", + label = i18n$t("Prior:"), + value = state_init("crtree_prior", .5, na.rm = FALSE), + min = 0, max = 1, step = 0.1, + width = "116px" + )), + tags$td(numericInput( + "crtree_minsplit", + label = i18n$t("Min obs.:"), + value = state_init("crtree_minsplit", 2) + )) + ), + tags$table( + tags$td(numericInput( + "crtree_cost", + label = i18n$t("Cost:"), + value = state_init("crtree_cost", NA) + )), + tags$td(numericInput( + "crtree_margin", + label = i18n$t("Margin:"), + value = state_init("crtree_margin", NA) + )) + ) + ), + tags$table( + tags$td(numericInput( + "crtree_cp", + label = i18n$t("Complexity:"), min = 0, + max = 1, step = 0.001, + value = state_init("crtree_cp", 0.001), width = "116px" + )), + tags$td(numericInput( + "crtree_nodes", + label = i18n$t("Max. nodes:"), min = 2, + value = state_init("crtree_nodes", NA), width = "100%" + )) + ), + tags$table( + tags$td(numericInput( + "crtree_pcp", + label = i18n$t("Prune compl.:"), min = 0, step = 0.001, + value = state_init("crtree_pcp", NA), width = "116px" + )), + # tags$td(numericInput( + # "crtree_K", label = "K-folds:", + # value = state_init("crtree_K", 10), width = "116px" + # )), + tags$td(numericInput( + "crtree_seed", + label = i18n$t("Seed:"), + value = state_init("crtree_seed", 1234), width = "100%" + )) + ), + conditionalPanel( + condition = "input.tabs_crtree == 'Summary'", + tags$table( + tags$td(uiOutput("ui_crtree_store_res_name")), + tags$td(actionButton("crtree_store_res", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ) + ), + conditionalPanel( + condition = "input.tabs_crtree == 'Predict'", + selectInput( + "crtree_predict", + label = i18n$t("Prediction input type:"), reg_predict, + selected = state_single("crtree_predict", reg_predict, "none") + ), + conditionalPanel( + "input.crtree_predict == 'data' | input.crtree_predict == 'datacmd'", + selectizeInput( + inputId = "crtree_pred_data", label = i18n$t("Prediction data:"), + choices = c("None" = "", r_info[["datasetlist"]]), + selected = state_single("crtree_pred_data", c("None" = "", r_info[["datasetlist"]])), + multiple = FALSE + ) + ), + conditionalPanel( + "input.crtree_predict == 'cmd' | input.crtree_predict == 'datacmd'", + returnTextAreaInput( + "crtree_pred_cmd", i18n$t("Prediction command:"), + value = state_init("crtree_pred_cmd", ""), + rows = 3, + placeholder = i18n$t("Type a formula to set values for model variables (e.g., carat = 1; cut = 'Ideal') and press return") + ) + ), + conditionalPanel( + condition = "input.crtree_predict != 'none'", + checkboxInput("crtree_pred_plot", i18n$t("Plot predictions"), state_init("crtree_pred_plot", FALSE)), + conditionalPanel( + "input.crtree_pred_plot == true", + uiOutput("ui_crtree_predict_plot") + ) + ), + ## only show if full data is used for prediction + conditionalPanel( + "input.crtree_predict == 'data' | input.crtree_predict == 'datacmd'", + tags$table( + tags$td(textInput("crtree_store_pred_name", i18n$t("Store predictions:"), state_init("crtree_store_pred_name", "pred_crtree"))), + tags$td(actionButton("crtree_store_pred", i18n$t("Store"), icon("plus", verify_fa = FALSE)), class = "top") + ) + ) + ), + conditionalPanel( + condition = "input.tabs_crtree == 'Plot'", + selectInput( + "crtree_plots", i18n$t("Plots:"), + choices = ctree_plots, + selected = state_single("crtree_plots", ctree_plots, "none") + ), + conditionalPanel( + condition = "input.crtree_plots == 'dashboard'", + uiOutput("ui_crtree_nrobs") + ), + conditionalPanel( + condition = "input.crtree_plots == 'pdp' | input.crtree_plots == 'pred_plot'", + uiOutput("ui_crtree_incl"), + uiOutput("ui_crtree_incl_int") + ), + conditionalPanel( + condition = "input.crtree_plots == 'tree'", + tags$table( + tags$td( + selectInput( + "crtree_orient", + label = i18n$t("Plot direction:"), + choices = { + vals <- c("LR", "TD", "RL", "BT") + names(vals) <- c( + i18n$t("Left-right"), + i18n$t("Top-down"), + i18n$t("Right-left"), + i18n$t("Bottom-Top") + ) + vals + }, + state_init("crtree_orient", "LR"), width = "116px" + ), + style = "padding-top:16.5px;" + ), + tags$td(uiOutput("ui_crtree_width"), width = "100%") + ) + ) + ) + ), + help_and_report( + modal_title = i18n$t("Classification and regression trees"), + fun_name = "crtree", + help_file = inclMD(file.path(getOption("radiant.path.model"), "app/tools/help/crtree.md")) + ) + ) +}) + +crtree_plot <- reactive({ + if (crtree_available() != "available") { + return() + } + if (is.empty(input$crtree_plots, "none")) { + return() + } + res <- .crtree() + nr_vars <- length(res$evar) + + plot_height <- 500 + plot_width <- 650 + if ("dashboard" %in% input$crtree_plots) { + plot_height <- 750 + } else if (input$crtree_plots %in% c("pdp", "pred_plot")) { + nr_vars <- length(input$crtree_incl) + length(input$crtree_incl_int) + plot_height <- max(250, ceiling(nr_vars / 2) * 250) + if (length(input$crtree_incl_int) > 0) { + plot_width <- plot_width + min(2, length(input$crtree_incl_int)) * 90 + } + } else if ("vip" %in% input$crtree_plots) { + plot_height <- max(500, nr_vars * 30) + } + + list(plot_width = plot_width, plot_height = plot_height) +}) + +crtree_plot_width <- function() { + crtree_plot() %>% + (function(x) if (is.list(x)) x$plot_width else 650) +} + +crtree_plot_height <- function() { + crtree_plot() %>% + (function(x) if (is.list(x)) x$plot_height else 500) +} + +crtree_pred_plot_height <- function() { + if (input$crtree_pred_plot) 500 else 0 +} + +output$diagrammer_crtree <- renderUI({ + DiagrammeR::DiagrammeROutput( + "crtree_plot", + width = input$crtree_width, + height = "100%" + ) +}) + +## output is called from the main radiant ui.R +output$crtree <- renderUI({ + register_print_output("summary_crtree", ".summary_crtree") + register_print_output("predict_crtree", ".predict_print_crtree") + register_plot_output("predict_plot_crtree", ".predict_plot_crtree") + register_plot_output( + "plot_crtree", ".plot_crtree", + height_fun = "crtree_plot_height", + width_fun = "crtree_plot_width" + ) + + ## two separate tabs + crtree_output_panels <- tabsetPanel( + id = "tabs_crtree", + tabPanel(title = i18n$t("Summary"), value ="Summary",verbatimTextOutput("summary_crtree")), + tabPanel( + title = i18n$t("Predict"), + value ="Predict", + conditionalPanel( + "input.crtree_pred_plot == true", + download_link("dlp_crtree_pred"), + plotOutput("predict_plot_crtree", width = "100%", height = "100%") + ), + download_link("dl_crtree_pred"), br(), + verbatimTextOutput("predict_crtree") + ), + tabPanel( + title = i18n$t("Plot"), + value ="Plot", + conditionalPanel( + "input.crtree_plots == 'tree'", + HTML(""), + uiOutput("diagrammer_crtree") + ), + conditionalPanel( + "input.crtree_plots != 'tree'", + download_link("dlp_crtree"), + plotOutput("plot_crtree", width = "100%", height = "100%") + ) + ) + ) + stat_tab_panel( + menu = i18n$t("Model > Estimate"), + tool = i18n$t("Classification and regression trees"), + tool_ui = "ui_crtree", + output_panels = crtree_output_panels + ) +}) + +output$crtree_plot <- DiagrammeR::renderDiagrammeR({ + cr <- .crtree() + if (is.null(cr)) { + invisible() + } else { + withProgress( + message = i18n$t("Generating tree diagramm"), value = 1, + plot(cr, plots = "tree", orient = input$crtree_orient, width = paste0(input$crtree_width, "px")) + ) + } +}) + +crtree_available <- reactive({ + if (not_available(input$crtree_rvar)) { + return(i18n$t("This analysis requires a response variable with two levels and one\nor more explanatory variables. If these variables are not available\nplease select another dataset.\n\n") %>% suggest_data("titanic")) + } else if (not_available(input$crtree_evar)) { + return(i18n$t("Please select one or more explanatory variables.") %>% suggest_data("titanic")) + } else { + "available" + } +}) + +.crtree <- eventReactive(input$crtree_run, { + req(input$crtree_evar) + withProgress(message = i18n$t("Estimating model"), value = 1, { + crti <- crtree_inputs() + crti$envir <- r_data + do.call(crtree, crti) + }) +}) + +.summary_crtree <- reactive({ + if (not_pressed(input$crtree_run)) { + i18n$t("** Press the Estimate button to estimate the model **") + } else if (crtree_available() != "available") { + crtree_available() + } else { + summary(.crtree()) + } +}) + +.predict_crtree <- reactive({ + if (not_pressed(input$crtree_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } + if (crtree_available() != "available") { + return(crtree_available()) + } + if (is.empty(input$crtree_predict, "none")) { + return(i18n$t("** Select prediction input **")) + } + + if ((input$crtree_predict == "data" || input$crtree_predict == "datacmd") && + is.empty(input$crtree_pred_data)) { + i18n$t("** Select data for prediction **") + } else if (input$crtree_predict == "cmd" && is.empty(input$crtree_pred_cmd)) { + i18n$t("** Enter prediction commands **") + } else { + withProgress(message = i18n$t("Generating predictions"), value = 1, { + cri <- crtree_pred_inputs() + cri$object <- .crtree() + cri$envir <- r_data + do.call(predict, cri) + }) + } +}) + +.predict_print_crtree <- reactive({ + pc <- .predict_crtree() + if (is.character(pc)) cat(pc, "\n") else print(pc) +}) + +.predict_plot_crtree <- reactive({ + req( + pressed(input$crtree_run), input$crtree_pred_plot, + available(input$crtree_xvar), + !is.empty(input$crtree_predict, "none") + ) + + withProgress(message = i18n$t("Generating prediction plot"), value = 1, { + do.call(plot, c(list(x = .predict_crtree()), crtree_pred_plot_inputs())) + }) +}) + +.plot_crtree <- reactive({ + if (not_pressed(input$crtree_run)) { + i18n$t("** Press the Estimate button to estimate the model **") + } else if (crtree_available() != "available") { + crtree_available() + } else if (is.empty(input$crtree_plots)) { + return(i18n$t("Please select a plot type from the drop-down menu")) + } + ret <- .crtree() + pinp <- crtree_plot_inputs() + pinp$shiny <- TRUE + if (input$crtree_plots == "dashboard") { + req(input$crtree_nrobs) + } + check_for_pdp_pred_plots("crtree") + if (length(ret) == 0 || is.character(ret)) { + i18n$t("No model results to plot. Specify a model and press the Estimate button") + } else { + withProgress(message = i18n$t("Generating plots"), value = 1, { + do.call(plot, c(list(x = ret), pinp)) + }) + } +}) + +observeEvent(input$crtree_store_res, { + req(pressed(input$crtree_run)) + robj <- .crtree() + if (!is.list(robj)) { + return() + } + fixed <- fix_names(input$crtree_store_res_name) + updateTextInput(session, "crtree_store_res_name", value = fixed) + withProgress( + message = i18n$t("Storing residuals"), value = 1, + r_data[[input$dataset]] <- store(r_data[[input$dataset]], robj, name = fixed) + ) +}) + +observeEvent(input$crtree_store_pred, { + req(!is.empty(input$crtree_pred_data), pressed(input$crtree_run)) + pred <- .predict_crtree() + if (is.null(pred)) { + return() + } + fixed <- fix_names(input$crtree_store_pred_name) + updateTextInput(session, "crtree_store_pred_name", value = fixed) + withProgress( + message = i18n$t("Storing predictions"), value = 1, + r_data[[input$crtree_pred_data]] <- store( + r_data[[input$crtree_pred_data]], pred, + name = fixed + ) + ) +}) + +crtree_report <- function() { + if (is.empty(input$crtree_evar)) { + return(invisible()) + } + + outputs <- c("summary") + inp_out <- list(list(prn = TRUE), "") + figs <- FALSE + + if (!is.empty(input$crtree_store_res_name)) { + fixed <- fix_names(input$crtree_store_res_name) + updateTextInput(session, "crtree_store_res_name", value = fixed) + xcmd <- paste0(input$dataset, " <- store(", input$dataset, ", result, name = \"", fixed, "\")\n") + } else { + xcmd <- "" + } + + if (!is.empty(input$crtree_predict, "none") && + (!is.empty(input$crtree_pred_data) || !is.empty(input$crtree_pred_cmd))) { + pred_args <- clean_args(crtree_pred_inputs(), crtree_pred_args[-1]) + + if (!is.empty(pred_args$pred_cmd)) { + pred_args$pred_cmd <- strsplit(pred_args$pred_cmd, ";")[[1]] + } else { + pred_args$pred_cmd <- NULL + } + + if (!is.empty(pred_args$pred_data)) { + pred_args$pred_data <- as.symbol(pred_args$pred_data) + } else { + pred_args$pred_data <- NULL + } + + inp_out[[2 + figs]] <- pred_args + outputs <- c(outputs, "pred <- predict") + xcmd <- paste0(xcmd, "print(pred, n = 10)") + if (input$crtree_predict %in% c("data", "datacmd")) { + fixed <- fix_names(input$crtree_store_pred_name) + updateTextInput(session, "crtree_store_pred_name", value = fixed) + xcmd <- paste0( + xcmd, "\n", input$crtree_pred_data, " <- store(", + input$crtree_pred_data, ", pred, name = \"", fixed, "\")" + ) + } + + if (input$crtree_pred_plot && !is.empty(input$crtree_xvar)) { + inp_out[[3 + figs]] <- clean_args(crtree_pred_plot_inputs(), crtree_pred_plot_args[-1]) + inp_out[[3 + figs]]$result <- "pred" + outputs <- c(outputs, "plot") + figs <- TRUE + } + } + + if (input$crtree_plots != "none") { + width <- ifelse(is.empty(input$crtree_width), "\"900px\"", paste0("\"", input$crtree_width, "px\"")) + orient <- ifelse(is.empty(input$crtree_orient), "\"TD\"", paste0("\"", input$crtree_orient, "\"")) + if (input$crtree_plots == "tree") { + xcmd <- paste0(xcmd, "\n# plot(result, plots = \"prune\", custom = FALSE)") + xcmd <- paste0(xcmd, "\nplot(result, orient = ", orient, ", width = ", width, ") %>% render()") + } else if (input$crtree_plots == "prune") { + figs <- TRUE + xcmd <- paste0(xcmd, "\nplot(result, plots = \"prune\", custom = FALSE)") + xcmd <- paste0(xcmd, "\n# plot(result, orient = ", orient, ", width = ", width, ") %>% render()") + } else if (input$crtree_plots == "vip") { + figs <- TRUE + xcmd <- paste0(xcmd, "\nplot(result, plots = \"vip\", custom = FALSE)") + xcmd <- paste0(xcmd, "\n# plot(result, orient = ", orient, ", width = ", width, ") %>% render()") + } else if (input$crtree_plots %in% c("pdp", "pred_plot")) { + figs <- TRUE + incl <- "" + dctrl <- getOption("dctrl") + if (length(input$crtree_incl) > 0) { + cmd <- deparse(input$crtree_incl, control = dctrl, width.cutoff = 500L) + incl <- glue(", incl = {cmd}") + } + if (length(input$crtree_incl_int) > 0) { + cmd <- deparse(input$crtree_incl_int, control = dctrl, width.cutoff = 500L) + incl <- glue("{incl}, incl_int = {cmd}") + } + xcmd <- paste0(xcmd, "\nplot(result, plots = \"", input$crtree_plots, "\"", incl, ", custom = FALSE)") + xcmd <- paste0(xcmd, "\n# plot(result, orient = ", orient, ", width = ", width, ") %>% render()") + } + } + + crtree_inp <- crtree_inputs() + if (input$crtree_type == "regression") { + crtree_inp$prior <- crtree_inp$cost <- crtree_inp$margin <- crtree_inp$lev <- NULL + } + + update_report( + inp_main = clean_args(crtree_inp, crtree_args), + fun_name = "crtree", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = crtree_plot_width(), + fig.height = crtree_plot_height(), + xcmd = xcmd + ) +} + +dl_crtree_pred <- function(path) { + if (pressed(input$crtree_run)) { + .predict_crtree() %>% write.csv(file = path, row.names = FALSE) + } else { + cat(i18n$t("No output available. Press the Estimate button to generate results"), file = path) + } +} + +download_handler( + id = "dl_crtree_pred", + fun = dl_crtree_pred, + fn = function() paste0(input$dataset, "_crtree_pred"), + type = "csv", + caption = i18n$t("Save crtree predictions") +) + +download_handler( + id = "dlp_crtree_pred", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_crtree_pred"), + type = "png", + caption = i18n$t("Save decision tree prediction plot"), + plot = .predict_plot_crtree, + width = plot_width, + height = crtree_pred_plot_height +) + +download_handler( + id = "dlp_crtree", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_crtree"), + type = "png", + caption = i18n$t("Save decision tree plot"), + plot = .plot_crtree, + width = crtree_plot_width, + height = crtree_plot_height +) + +observeEvent(input$crtree_report, { + r_info[["latest_screenshot"]] <- NULL + crtree_report() +}) + +observeEvent(input$crtree_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_crtree_screenshot") +}) + +observeEvent(input$modal_crtree_screenshot, { + crtree_report() + removeModal() ## remove shiny modal after save +}) + +observeEvent(input$crtree_screenshot2, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_crtree_screenshot2") +}) + +observeEvent(input$modal_crtree_screenshot2, { + crtree_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.model/inst/app/tools/analysis/dtree_ui.R b/radiant.model/inst/app/tools/analysis/dtree_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..d3b1498d18a8a802b6566a74669abc805a45fd10 --- /dev/null +++ b/radiant.model/inst/app/tools/analysis/dtree_ui.R @@ -0,0 +1,689 @@ +####################################### +## Create decision tree +####################################### +dtree_example <- "name: Sign contract +variables: + legal fees: 5000 +type: decision +Sign with Movie Company: + cost: legal fees + type: chance + Small Box Office: + p: 0.3 + payoff: 200000 + Medium Box Office: + p: 0.6 + payoff: 1000000 + Large Box Office: + p: 0.1 + payoff: 3000000 +Sign with TV Network: + payoff: 900000" + +dtree_max_min <- { + vals <- c("max", "min") + names(vals) <- c( + i18n$t("Max"), + i18n$t("Min") + ) + vals +} + +output$ui_dtree_list <- renderUI({ + dtree_list <- r_info[["dtree_list"]] + req(dtree_list) + selectInput( + inputId = "dtree_list", label = NULL, + choices = dtree_list, selected = state_init("dtree_list", dtree_list[1]), + multiple = FALSE, selectize = FALSE, width = "110px" + ) +}) + +output$ui_dtree_name <- renderUI({ + dtree_name <- input$dtree_list[1] + if (length(dtree_name) == 0) dtree_name <- dtree_name() + if (is.empty(dtree_name)) dtree_name <- "dtree" + textInput("dtree_name", NULL, dtree_name, width = "100px") +}) + +output$ui_dtree_remove <- renderUI({ + req(length(r_info[["dtree_list"]]) > 1) + actionButton("dtree_remove", i18n$t("Remove"), icon = icon("trash", verify_fa = FALSE), class = "btn-danger") +}) + +dtreeIsNum <- function(x) { + if (!grepl("[A-Za-z]+", x)) { + x <- try(eval(parse(text = x), envir = r_data), silent = TRUE) + if (inherits(x, "try-error")) { + FALSE + } else { + if (sshhr(is.na(as.numeric(x)))) FALSE else TRUE + } + } else { + FALSE + } +} + +output$ui_dtree_sense_name <- renderUI({ + dte <- dtree_run() + mess <- HTML(i18n$t("No variables are available for sensitivity analysis. If the input file does contain a variables section, press the Calculate button to show the list of available variables.")) + if (!inherits(dte, "list")) { + return(mess) + } + vars <- dte$yl$variables + if (is.empty(vars)) { + return(mess) + } + vars <- vars[!is.na(sshhr(sapply(vars, dtreeIsNum)))] + if (length(vars) == 0) { + return(mess) + } + vars[names(vars)] <- names(vars) + + selectInput( + "dtree_sense_name", + label = i18n$t("Sensitivity to changes in:"), + choices = vars, multiple = FALSE, + selected = state_single("dtree_sense_name", vars) + ) +}) + +output$ui_dtree_sense_decision <- renderUI({ + dte <- dtree_run() + if (inherits(dte, "list") && !is.null(dte[["jl"]])) { + ## all decisions in the tree + decs <- + dte$jl$Get(function(x) if (length(x$parent$decision) > 0) x$payoff) %>% + na.omit() %>% + names() + } else { + decs <- "" + } + + selectizeInput( + "dtree_sense_decision", + label = i18n$t("Decisions to evaluate:"), + choices = decs, multiple = TRUE, + selected = state_multiple("dtree_sense_decision", decs, decs), + options = list( + placeholder = i18n$t("Select decisions to evaluate"), + plugins = list("remove_button") + ) + ) +}) + +output$ui_dtree_sense <- renderUI({ + req(input$dtree_sense_name) + req(input$dtree_sense_decision) + tagList( + HTML(i18n$t("")), + with(tags, table( + td(numericInput("dtree_sense_min", i18n$t("Min:"), value = state_init("dtree_sense_min"))), + td(numericInput("dtree_sense_max", i18n$t("Max:"), value = state_init("dtree_sense_max"))), + td(numericInput("dtree_sense_step", i18n$t("Step:"), value = state_init("dtree_sense_step"))) + )), + textinput_maker(id = "sense", lab = i18n$t("Add variable"), rows = 3, pre = "dtree_") + ) +}) + +observeEvent(input$dtree_sense_add, { + var_updater( + input$dtree_sense_add, "dtree_sense", + input$dtree_sense_name, c(input$dtree_sense_min, input$dtree_sense_max, input$dtree_sense_step), + fix = FALSE + ) +}) + +observeEvent(input$dtree_sense_del, { + var_remover("dtree_sense") +}) + +output$dtree <- renderUI({ + tabsetPanel( + id = "tabs_dtree", + tabPanel( + i18n$t("Model"), + with( + tags, + table( + td(help_modal(i18n$t("Decision analysis"), "dtree_help1", help_file = inclRmd(file.path(getOption("radiant.path.model"), "app/tools/help/dtree.Rmd")))), + td(HTML("  ")), + td(HTML(i18n$t(""))), + td(HTML(i18n$t(""))), + td(HTML("  ")), + td( + radioButtons( + inputId = "dtree_opt", label = NULL, + dtree_max_min, selected = state_init("dtree_opt", "max"), inline = TRUE + ), + style = "padding-top:10px;" + ), + td(actionButton("dtree_run", i18n$t("Calculate tree"), icon = icon("play", verify_fa = FALSE), class = "btn-success"), class = "top_mini"), + td(uiOutput("ui_dtree_name"), class = "top_mini"), + td(uiOutput("ui_dtree_list"), class = "top_mini"), + td(uiOutput("ui_dtree_remove"), class = "top_mini"), + td(file_upload_button( + "dtree_load_yaml", + label = NULL, accept = ".yaml", + buttonLabel = i18n$t("Load input"), title = i18n$t("Load decision tree input file (.yaml)"), + class = "btn-primary" + ), class = "top_mini"), + td(download_button("dtree_save_yaml", i18n$t("Save input"), class = "btn-primary"), class = "top_mini"), + td(download_button("dtree_save", i18n$t("Save output")), class = "top_mini") + ) + ), + shinyAce::aceEditor( + "dtree_edit", + mode = "yaml", + theme = getOption("radiant.ace_theme", default = "tomorrow"), + wordWrap = TRUE, + debounce = -1, + height = "auto", + value = state_init("dtree_edit", dtree_example) %>% gsub("\t", " ", .), + placeholder = i18n$t("Provide structured input for a decision tree. Then click the 'Calculate tree' button to generate results. Click the ? icon on the top left of your screen for help and examples"), + vimKeyBinding = getOption("radiant.ace_vim.keys", default = FALSE), + hotkeys = list(hotkey = list(win = "CTRL-ENTER|SHIFT-ENTER", mac = "CMD-ENTER|SHIFT-ENTER")), + tabSize = 4, + showInvisibles = TRUE, + useSoftTabs = TRUE, + autoComplete = "live", + setBehavioursEnabled = FALSE + ), + verbatimTextOutput("dtree_print") + ), + tabPanel( + i18n$t("Plot"), + HTML(i18n$t("")), + with(tags, table( + td(help_modal(i18n$t("Decision analysis"), "dtree_help2", help_file = inclRmd(file.path(getOption("radiant.path.model"), "app/tools/help/dtree.Rmd"))), style = "padding-top:30px;"), + td(HTML("  ")), + td(HTML(i18n$t("")), style = "padding-top:30px;"), + td(HTML(i18n$t("")), style = "padding-top:30px;"), + td(HTML("   ")), + td( + radioButtons( + inputId = "dtree_final", label = i18n$t("Plot decision tree:"), + choices = setNames(c(FALSE, TRUE), c(i18n$t("Initial"), i18n$t("Final"))), + selected = state_init("dtree_final", FALSE), inline = TRUE + ), + class = "top_small" + ), + td(HTML("   ")), + td( + radioButtons( + inputId = "dtree_orient", label = i18n$t("Plot direction:"), + choices = setNames(c("LR", "TD"), c(i18n$t("Left-right"), i18n$t("Top-down"))), + inline = TRUE + ), + class = "top_small" + ), + td(actionButton("dtree_run_plot", i18n$t("Calculate tree"), icon = icon("play", verify_fa = FALSE), class = "btn-success"), class = "top"), + td(numericInput( + "dtree_dec", i18n$t("Decimals"), + value = state_init("dtree_dec", 2), + min = 0, max = 10, width = "70px" + )), + td(textInput("dtree_symbol", i18n$t("Symbol"), state_init("dtree_symbol", "$"), width = "70px")) + )), + DiagrammeR::DiagrammeROutput( + "dtree_plot", + width = isolate(ifelse(length(input$get_screen_width) == 0, "1600px", paste0(input$get_screen_width - 80, "px"))), + height = "100%" + ) + ), + tabPanel( + i18n$t("Sensitivity"), + sidebarLayout( + sidebarPanel( + conditionalPanel( + condition = "input.dtree_sense_name == null", + wellPanel( + actionButton("dtree_run_sense", i18n$t("Calculate tree"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ) + ), + conditionalPanel( + condition = "input.dtree_sense_name != null", + wellPanel( + actionButton("dtree_run_sensitivity", i18n$t("Evaluate sensitivity"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ) + ), + wellPanel( + ## vary one 'variable' value through some range + ## select a payoff or only the final payoff? + uiOutput("ui_dtree_sense_decision"), + uiOutput("ui_dtree_sense_name"), + uiOutput("ui_dtree_sense") + ), + help_and_report( + modal_title = i18n$t("Decision analysis"), fun_name = "dtree", + help_file = inclRmd(file.path(getOption("radiant.path.model"), "app/tools/help/dtree.Rmd")) + ) + ), + mainPanel( + download_link("dlp_dtree_sensitivity"), + plotOutput("plot_dtree_sensitivity") + ) + ) + ) + ) +}) + +tree_types <- c("name:", "variables:", "type:", "cost:", "payoff:", "p:") +## Create auto complete list +observe({ + req(input$dtree_name, input$dtree_edit) + comps <- list( + `tree-input` = c("name:", "variables:", "type: decision", "type: chance", "cost: 0", "payoff: 0", "p: 0.5") + ) + + trees <- r_info[["dtree_list"]] + if (length(trees) < 2) { + trees <- input$dtree_name + } else { + comps[["dtree_list"]] <- paste0("dtree('", trees, "')") + } + + ## update active tree when session is stopped + session$onSessionEnded(function() { + isolate({ + r_data[[input$dtree_name]] <- input$dtree_edit + }) + }) + + for (tree in trees) { + rows <- strsplit(input$dtree_edit, "\n")[[1]] + comps[[tree]] <- gsub("\\s*([^#]+:).*", "\\1", rows) %>% + gsub("^\\s+", "", .) %>% + unique() %>% + .[!. %in% tree_types] %>% + gsub(":$", "", .) %>% + .[!grepl("^#", .)] + } + + ## only using 'static' auto-completion (i.e., not local ('text') or R-language ('rlang')) + shinyAce::updateAceEditor( + session, "dtree_edit", + autoCompleters = "static", + autoCompleteList = comps + ) +}) + +vals_dtree <- reactiveValues(dtree_edit_hotkey = 0) + +observe({ + input$dtree_edit_hotkey + input$dtree_run_plot + input$dtree_run_sense + if (!is.null(input$dtree_run)) isolate(vals_dtree$dtree_edit_hotkey %<>% add(1)) +}) + +dtree_name <- function() { + isolate({ + dtree_name <- input$dtree_name + if (is.empty(dtree_name)) { + dtree_name <- stringr::str_match(input$dtree_edit, "^\\s*name:\\s*(.*)\\n")[2] + if (is.na(dtree_name)) { + dtree_name <- "dtree" + } + } + fix_names(dtree_name) + }) +} + +dtree_run <- eventReactive(vals_dtree$dtree_edit_hotkey > 1, { + req(vals_dtree$dtree_edit_hotkey != 1) + validate( + need(!is.empty(input$dtree_edit), i18n$t("No decision tree input available")) + ) + + ## update settings and get data.tree name + dtree_name <- dtree_namer() + + ## ensure correct spacing + yl <- gsub(":([^ $])", ": \\1", input$dtree_edit) %>% + gsub(":[ ]{2,}", ": ", .) %>% + gsub(":[ ]+\\n", ":\n", .) %>% + gsub("\\n[ ]*\\n", "\n", .) %>% + gsub(":\\s*([-]{0,1})(\\.[0-9]+\\s*\\n)", ": \\10\\2", ., perl = TRUE) %>% + gsub("(\\n[ ]+)([0-9]+)", "\\1_\\2", .) + + shinyAce::updateAceEditor(session, "dtree_edit", value = yl) + + if (input$dtree_edit != "") { + withProgress(message = i18n$t("Creating decision tree"), value = 1, { + dtree(yl, opt = input$dtree_opt, envir = r_data) + }) + } +}) + +output$dtree_print <- renderPrint({ + dtree_run() %>% + (function(x) if (is.null(x)) cat(i18n$t("** Click the calculate button to generate results **")) else summary(x, input = FALSE, output = TRUE)) +}) + +dtree_plot_args <- as.list(if (exists("plot.dtree")) { + formals(plot.dtree) +} else { + formals(radiant.model:::plot.dtree) +}) + +## list of function inputs selected by user +dtree_plot_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(dtree_plot_args)) { + dtree_plot_args[[i]] <- input[[paste0("dtree_", i)]] + } + dtree_plot_args +}) + +output$dtree_plot <- DiagrammeR::renderDiagrammeR({ + req(input$dtree_final) + dt <- dtree_run() + if (is.null(dt)) { + invisible() + } else { + pinp <- dtree_plot_inputs() + do.call(plot, c(list(x = dt), pinp)) + } +}) + +## Evaluate tree sensitivity +.plot_dtree_sensitivity <- eventReactive(input$dtree_run_sensitivity, { + if (is.empty(input$dtree_sense_decision)) { + i18n$t("At least one decision should be selected for evaluation") + } else if (is.empty(input$dtree_sense)) { + i18n$t("No variables were specified for evaluation.\nClick the + icon to add variables for sensitivity evaluation") + } else { + withProgress( + message = i18n$t("Conducting sensitivity analysis"), value = 1, + sensitivity(dtree_run(), gsub("\n+", "", input$dtree_sense), input$dtree_sense_decision, envir = r_data, shiny = TRUE) + ) + } +}) + +dtree_sense_width <- reactive({ + 650 +}) + +dtree_sense_height <- eventReactive(input$dtree_run_sensitivity, { + if (is.empty(input$dtree_sense, "")) { + 650 + } else { + strsplit(input$dtree_sense, ";\\s*") %>% + unlist() %>% + unique() %>% + length() * 400 + } +}) + +output$plot_dtree_sensitivity <- renderPlot( + { + req(input$dtree_run_sensitivity, cancelOutput = TRUE) + req(input$dtree_sense_name, cancelOutput = TRUE) + isolate({ + .plot_dtree_sensitivity() %>% + { + if (is.character(.)) { + plot( + x = 1, type = "n", main = paste0("\n\n\n\n\n\n\n\n", .), + axes = FALSE, xlab = "", ylab = "" + ) + } else { + withProgress(message = i18n$t("Making plot"), value = 1, print(.)) + } + } + }) + }, + width = dtree_sense_width, + height = dtree_sense_height, + res = 96 +) + +observeEvent(input$dtree_load_yaml, { + ## loading yaml file from disk + if (getOption("radiant.shinyFiles", FALSE)) { + path <- shinyFiles::parseFilePaths(sf_volumes, input$dtree_load_yaml) + if (inherits(path, "try-error") || is.empty(path$datapath)) { + return() + } else { + path <- path$datapath + } + inFile <- data.frame( + name = basename(path), + datapath = path, + stringsAsFactors = FALSE + ) + } else { + inFile <- input$dtree_load_yaml + } + + yaml_file <- paste0(readLines(inFile$datapath), collapse = "\n") + + ## remove characters that may cause problems in shinyAce + yaml_file <- stringi::stri_trans_general(yaml_file, "latin-ascii") %>% + gsub("\r", "\n", .) + + dtree_name <- sub(paste0(".", tools::file_ext(inFile$name)), "", inFile$name) %>% + fix_names() + r_data[[dtree_name]] <- yaml_file + if (!bindingIsActive(as.symbol(dtree_name), env = r_data)) { + shiny::makeReactiveBinding(dtree_name, env = r_data) + } + if (is.empty(input$dtree_list)) { + r_info[["dtree_list"]] <- dtree_name + } else { + r_data[[input$dtree_list]] <- input$dtree_edit + r_info[["dtree_list"]] <- c(dtree_name, r_info[["dtree_list"]]) %>% unique() + } + updateSelectInput(session = session, inputId = "dtree_list", selected = dtree_name, choices = r_info[["dtree_list"]]) +}) + +observeEvent(input$dtree_list, { + dtree_name <- fix_names(input$dtree_name) + if (is.empty(dtree_name)) dtree_name <- dtree_name() + r_data[[dtree_name]] <- input$dtree_edit + + yl <- r_data[[input$dtree_list[1]]] + if (is.list(yl)) { + yl <- yaml::as.yaml(yl, indent = 4) + } + + shinyAce::updateAceEditor(session, "dtree_edit", value = gsub("\t", " ", yl)) +}) + +observeEvent(input$dtree_edit, { + if (!is.empty(input$dtree_edit)) r_state$dtree_edit <<- input$dtree_edit +}) + +dtree_namer <- reactive({ + dtree_name_org <- input$dtree_name + + if (is.empty(dtree_name_org)) { + dtree_name <- input$dtree_list[1] + if (is.empty(dtree_name)) { + dtree_name <- dtree_name() + } else { + dtree_name <- fix_names(dtree_name) + } + } else { + dtree_name <- fix_names(dtree_name_org) + } + + r_data[[dtree_name]] <- input$dtree_edit + r_info[["dtree_list"]] <- c(dtree_name, setdiff(r_info[["dtree_list"]], dtree_name_org)) %>% unique() + if (!bindingIsActive(as.symbol(dtree_name), env = r_data)) { + shiny::makeReactiveBinding(dtree_name, env = r_data) + } + updateSelectInput(session = session, inputId = "dtree_list", selected = dtree_name, choices = r_info[["dtree_list"]]) + dtree_name +}) + +## remove yaml input +observeEvent(input$dtree_remove, { + dtree_name <- input$dtree_list[1] + r_info[["dtree_list"]] <- base::setdiff(r_info[["dtree_list"]], dtree_name) + r_data[[dtree_name]] <- NULL +}) + +dtree_report <- function() { + isolate({ + outputs <- c("summary") + inp_out <- list(list(input = TRUE, output = FALSE), "") + figs <- FALSE + if (!is.empty(input$dtree_sense) && !is_not(input$dtree_sense_decision)) { + vars <- strsplit(input$dtree_sense, ";\\s*")[[1]] %>% gsub("\n+", "", .) + inp_out[[2]] <- list( + vars = vars, + decs = input$dtree_sense_decision, + custom = FALSE + ) + outputs <- c(outputs, "sensitivity") + figs <- TRUE + } + + ## update settings and get data.tree name + dtree_name <- dtree_namer() + xcmd <- clean_args(dtree_plot_inputs(), dtree_plot_args[-1]) %>% + deparse(control = getOption("dctrl"), width.cutoff = 500L) %>% + { + if (. == "list()") { + "plot(result) %>% render()" + } else { + paste0(sub("list(", "plot(result, ", ., fixed = TRUE), " %>% render()") + } + } %>% + gsub("[\"\']TRUE[\'\"]", "TRUE", .) + + inp <- list(yl = dtree_name) + if (input$dtree_opt == "min") inp$opt <- "min" + + ret <- update_report( + inp_main = inp, + fun_name = "dtree", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = dtree_sense_width(), + fig.height = dtree_sense_height(), + xcmd = xcmd + ) + + ret + }) +} + +dl_dtree_save <- function(path) { + capture.output(dtree(input$dtree_edit, envir = r_data) %>% + summary(input = FALSE, output = TRUE)) %>% + cat(file = path, sep = "\n") +} + +download_handler( + id = "dtree_save", + label = i18n$t("Save output"), + fun = dl_dtree_save, + fn = function() { + ifelse( + is.empty(input$dtree_name), + "dtree", + paste0(input$dtree_name, "_dtree_output") + ) + }, + type = "txt", + caption = i18n$t("Save decision tree output"), + btn = "button", +) + +dl_dtree_save_yaml <- function(path) { + cat(paste0(input$dtree_edit, "\n"), file = path) +} + +download_handler( + id = "dtree_save_yaml", + label = i18n$t("Save input"), + fun = dl_dtree_save_yaml, + fn = function() { + ifelse( + is.empty(input$dtree_name), + "dtree", + paste0(input$dtree_name, "_dtree_input") + ) + }, + type = "yaml", + caption = i18n$t("Save decision tree input"), + btn = "button", + class = "btn-primary" +) + +download_handler( + id = "dlp_dtree_sensitivity", + fun = download_handler_plot, + fn = function() { + ifelse( + is.empty(input$dtree_name), + "dtree_sensitivity", + paste0(input$dtree_name, "_dtree_sensitivity") + ) + }, + type = "png", + caption = i18n$t("Save decision tree sensitivity plot"), + plot = .plot_dtree_sensitivity, + width = dtree_sense_width, + height = dtree_sense_height +) + +observeEvent(input$dtree_report, { + r_info[["latest_screenshot"]] <- NULL + dtree_report() +}) + +observeEvent(input$dtree_report1, { + r_info[["latest_screenshot"]] <- NULL + dtree_report() +}) + +observeEvent(input$dtree_report2, { + r_info[["latest_screenshot"]] <- NULL + dtree_report() +}) + +observeEvent(input$dtree_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_dtree_screenshot") +}) + +observeEvent(input$dtree_screenshot1, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_dtree_screenshot1") +}) + +observeEvent(input$dtree_screenshot2, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_dtree_screenshot2") +}) + +observeEvent(input$dtree_screenshot3, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_dtree_screenshot3") +}) + +observeEvent(input$modal_dtree_screenshot, { + dtree_report() + removeModal() +}) + +observeEvent(input$modal_dtree_screenshot1, { + dtree_report() + removeModal() +}) + +observeEvent(input$modal_dtree_screenshot2, { + dtree_report() + removeModal() +}) + +observeEvent(input$modal_dtree_screenshot3, { + dtree_report() + removeModal() +}) diff --git a/radiant.model/inst/app/tools/analysis/evalbin_ui.R b/radiant.model/inst/app/tools/analysis/evalbin_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..6f06f33e7d06e7a807d5225df58759c843f1a7cc --- /dev/null +++ b/radiant.model/inst/app/tools/analysis/evalbin_ui.R @@ -0,0 +1,700 @@ +ebin_plots <- { + vals <- c("lift", "gains", "profit", "expected_profit", "rome") + names(vals) <- c( + i18n$t("Lift"), + i18n$t("Gains"), + i18n$t("Profit"), + i18n$t("Expected profit"), + i18n$t("ROME") + ) + vals +} +ebin_train <- { + vals <- c("All", "Training", "Test", "Both") + names(vals) <- c( + i18n$t("All"), + i18n$t("Training"), + i18n$t("Test"), + i18n$t("Both") + ) + vals +} +uplift_plots <- { + vals <- c("inc_uplift", "uplift", "inc_profit") + names(vals) <- c( + i18n$t("Incremental uplift"), + i18n$t("Uplift"), + i18n$t("Incremental profit") + ) + vals +} + +# list of function arguments +ebin_args <- as.list(formals(evalbin)) + +ebin_inputs <- reactive({ + # loop needed because reactive values don't allow single bracket indexing + ebin_args$data_filter <- if (input$show_filter) input$data_filter else "" + ebin_args$arr <- if (input$show_filter) input$data_arrange else "" + ebin_args$rows <- if (input$show_filter) input$data_rows else "" + ebin_args$dataset <- input$dataset + for (i in r_drop(names(ebin_args))) { + ebin_args[[i]] <- input[[paste0("ebin_", i)]] + } + ebin_args +}) + +# list of function arguments +uplift_args <- as.list(formals(uplift)) + +uplift_inputs <- reactive({ + # loop needed because reactive values don't allow single bracket indexing + uplift_args$data_filter <- if (input$show_filter) input$data_filter else "" + uplift_args$arr <- if (input$show_filter) input$data_arrange else "" + uplift_args$rows <- if (input$show_filter) input$data_rows else "" + uplift_args$dataset <- input$dataset + for (i in r_drop(names(uplift_args))) { + uplift_args[[i]] <- input[[paste0("uplift_", i)]] + if (is.empty(uplift_args[[i]])) { + uplift_args[[i]] <- input[[paste0("ebin_", i)]] + } + } + uplift_args +}) + +############################################################### +# Evaluate model evalbin +############################################################### +output$ui_ebin_rvar <- renderUI({ + withProgress(message = i18n$t("Acquiring variable information"), value = 1, { + # vars <- two_level_vars() + vars <- groupable_vars() + }) + selectInput( + inputId = "ebin_rvar", label = i18n$t("Response variable:"), choices = vars, + selected = state_single("ebin_rvar", vars), multiple = FALSE + ) +}) + +output$ui_ebin_lev <- renderUI({ + req(available(input$ebin_rvar)) + rvar <- .get_data()[[input$ebin_rvar]] + levs <- unique(rvar) + if (length(levs) > 50) { + HTML(i18n$t("")) + } else { + selectInput( + inputId = "ebin_lev", label = i18n$t("Choose level:"), + choices = levs, + selected = state_init("ebin_lev") + ) + } +}) + +output$ui_ebin_tvar <- renderUI({ + withProgress(message = i18n$t("Acquiring variable information"), value = 1, { + vars <- setdiff(two_level_vars(), input$ebin_rvar) + }) + selectInput( + inputId = "ebin_tvar", label = i18n$t("Treatment variable:"), choices = vars, + selected = state_single("ebin_tvar", vars), multiple = FALSE + ) +}) + +output$ui_ebin_tlev <- renderUI({ + req(available(input$ebin_tvar)) + tvar <- .get_data()[[input$ebin_tvar]] + levs <- unique(tvar) + if (length(levs) > 50) { + HTML(i18n$t("")) + } else { + selectInput( + inputId = "ebin_tlev", label = i18n$t("Choose level:"), + choices = levs, + selected = state_init("ebin_tlev") + ) + } +}) + +output$ui_ebin_pred <- renderUI({ + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- varnames()[isNum] + selectInput( + inputId = "ebin_pred", label = i18n$t("Select stored predictions:"), choices = vars, + selected = state_multiple("ebin_pred", vars, isolate(input$ebin_pred)), + multiple = TRUE, size = min(4, length(vars)), selectize = FALSE + ) +}) + +output$ui_ebin_train <- renderUI({ + selectInput( + "ebin_train", + label = i18n$t("Show results for:"), ebin_train, + selected = state_single("ebin_train", ebin_train, "All") + ) +}) + +output$ui_uplift_name <- renderUI({ + req(input$dataset) + textInput("uplift_name", i18n$t("Store uplift table as:"), "", placeholder = i18n$t("Provide a table name")) +}) + +## add a spinning refresh icon if the model needs to be (re)estimated +run_refresh(ebin_args, "ebin", init = "pred", label = i18n$t("Evaluate models"), relabel = i18n$t("Re-evaluate models")) + +output$ui_evalbin <- renderUI({ + req(input$dataset) + tagList( + wellPanel( + actionButton("ebin_run", i18n$t("Evaluate models"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ), + wellPanel( + uiOutput("ui_ebin_rvar"), + uiOutput("ui_ebin_lev"), + conditionalPanel( + "input.tabs_evalbin == 'Uplift'", + uiOutput("ui_ebin_tvar"), + uiOutput("ui_ebin_tlev") + ), + uiOutput("ui_ebin_pred"), + conditionalPanel( + "input.tabs_evalbin != 'Confusion'", + numericInput( + "ebin_qnt", + label = i18n$t("# quantiles:"), + value = state_init("ebin_qnt", 10), min = 2 + ) + ), + tags$table( + tags$td(numericInput( + "ebin_cost", + label = i18n$t("Cost:"), + value = state_init("ebin_cost", 1) + )), + tags$td(numericInput( + "ebin_margin", + label = i18n$t("Margin:"), + value = state_init("ebin_margin", 2) + )), + tags$td(numericInput( + "ebin_scale", + label = i18n$t("Scale:"), + value = state_init("ebin_scale", 1) # , width = "80px" + )) + ), + uiOutput("ui_ebin_train"), + conditionalPanel( + "input.tabs_evalbin == 'Evaluate'", + checkboxInput("ebin_show_tab", i18n$t("Show model performance table"), state_init("ebin_show_tab", FALSE)), + checkboxGroupInput( + "ebin_plots", i18n$t("Plots:"), ebin_plots, + selected = state_group("ebin_plots", "gains"), + inline = TRUE + ) + ), + conditionalPanel( + "input.tabs_evalbin == 'Uplift'", + checkboxInput("uplift_show_tab", i18n$t("Show uplift table"), state_init("uplift_show_tab", FALSE)), + checkboxGroupInput( + "uplift_plots", i18n$t("Plots:"), uplift_plots, + selected = state_group("uplift_plots", "inc_uplift"), + inline = TRUE + ) + ), + conditionalPanel( + "input.tabs_evalbin == 'Confusion'", + tags$table( + tags$td( + checkboxInput("ebin_show_plots", i18n$t("Show plots"), state_init("ebin_show_plots", FALSE)) + ), + tags$td( + HTML("   ") + ), + tags$td( + conditionalPanel( + "input.ebin_show_plots == true", + checkboxInput("ebin_scale_y", i18n$t("Scale free"), state_init("ebin_scale_y", TRUE)) + ) + ) + ) + ) + ), + conditionalPanel( + "input.tabs_evalbin == 'Evaluate'", + help_and_report( + modal_title = i18n$t("Evaluate classification"), + fun_name = "evalbin", + help_file = inclMD(file.path(getOption("radiant.path.model"), "app/tools/help/evalbin.md")) + ) + ), + conditionalPanel( + "input.tabs_evalbin == 'Confusion'", + help_and_report( + modal_title = i18n$t("Confusion matrix"), + fun_name = "confusion", + help_file = inclMD(file.path(getOption("radiant.path.model"), "app/tools/help/evalbin.md")) + ) + ), + conditionalPanel( + "input.tabs_evalbin == 'Uplift'", + wellPanel( + tags$table( + tags$td(uiOutput("ui_uplift_name")), + tags$td(actionButton("uplift_store", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ), + help_and_report( + modal_title = i18n$t("Evaluate uplift"), + fun_name = "uplift", + help_file = inclMD(file.path(getOption("radiant.path.model"), "app/tools/help/evalbin.md")) + ) + ) + ) +}) + +ebin_plot_width <- function() 700 +ebin_plot_height <- function() { + if (is.empty(input$ebin_plots)) 200 else length(input$ebin_plots) * 500 +} + +confusion_plot_width <- function() 650 +confusion_plot_height <- function() 800 + +uplift_plot_width <- function() 700 +uplift_plot_height <- function() { + if (is.empty(input$uplift_plots)) 200 else length(input$uplift_plots) * 500 +} + +# output is called from the main radiant ui.R +output$evalbin <- renderUI({ + register_print_output("summary_evalbin", ".summary_evalbin") + register_plot_output( + "plot_evalbin", ".plot_evalbin", + width_fun = "ebin_plot_width", + height_fun = "ebin_plot_height" + ) + register_print_output("summary_confusion", ".summary_confusion") + register_plot_output( + "plot_confusion", ".plot_confusion", + width_fun = "confusion_plot_width", + height_fun = "confusion_plot_height" + ) + # register_print_output("summary_performance", ".summary_performance") + + register_print_output("summary_uplift", ".summary_uplift") + register_plot_output( + "plot_uplift", ".plot_uplift", + width_fun = "uplift_plot_width", + height_fun = "uplift_plot_height" + ) + + # one output with components stacked + ebin_output_panels <- tabsetPanel( + id = "tabs_evalbin", + tabPanel( + i18n$t("Evaluate"), + download_link("dl_ebin_tab"), br(), + verbatimTextOutput("summary_evalbin"), + download_link("dlp_evalbin"), + plotOutput("plot_evalbin", height = "100%") + ), + tabPanel( + i18n$t("Confusion"), + download_link("dl_confusion_tab"), br(), + verbatimTextOutput("summary_confusion"), + conditionalPanel( + condition = "input.ebin_show_plots == true", + download_link("dlp_confusion"), + plotOutput("plot_confusion", height = "100%") + ) + ), + tabPanel( + i18n$t("Uplift"), + download_link("dl_uplift_tab"), br(), + verbatimTextOutput("summary_uplift"), + download_link("dlp_uplift"), + plotOutput("plot_uplift", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Model > Evaluate"), + tool = i18n$t("Evaluate classification"), + tool_ui = "ui_evalbin", + output_panels = ebin_output_panels + ) +}) + +.evalbin <- eventReactive(input$ebin_run, { + if (!is.empty(r_info[["filter_error"]])) { + i18n$t("An invalid filter has been set for this dataset. Please\nadjust the filter in the Data > View tab and try again") %>% + add_class("evalbin") + } else { + withProgress(message = i18n$t("Evaluating models"), value = 1, { + ebi <- ebin_inputs() + ebi$envir <- r_data + do.call(evalbin, ebi) + }) + } +}) + +.summary_evalbin <- reactive({ + if (not_pressed(input$ebin_run)) { + return(i18n$t("** Press the Evaluate button to evaluate models **")) + } + if (not_available(input$ebin_rvar) || not_available(input$ebin_pred) || + is.empty(input$ebin_lev)) { + return(i18n$t("This analysis requires a response variable of type factor and one or more\npredictors of type numeric. If these variable types are not available please\nselect another dataset.\n\n" %>% suggest_data("titanic"))) + } + summary(.evalbin(), prn = input$ebin_show_tab) +}) + +.plot_evalbin <- reactive({ + if (not_pressed(input$ebin_run)) { + return(i18n$t("** Press the Evaluate button to evaluate models **")) + } + isolate({ + if (not_available(input$ebin_rvar) || not_available(input$ebin_pred) || + is.empty(input$ebin_lev)) { + return(i18n$t("This analysis requires a response variable of type factor and one or more\npredictors of type numeric. If these variable types are not available please\nselect another dataset.\n\n") %>% + suggest_data("titanic")) + } else if (!input$ebin_train %in% c("", "All") && (!input$show_filter || (input$show_filter && is.empty(input$data_filter) && is.empty(input$data_rows)))) { + return(i18n$t("**\nFilter or Slice required. To set a filter or slice go to\nData > View and click the filter checkbox\n**")) + } + }) + plot(.evalbin(), plots = input$ebin_plots, shiny = TRUE) +}) + +.confusion <- eventReactive(input$ebin_run, { + if (not_available(input$ebin_rvar) || not_available(input$ebin_pred) || + is.empty(input$ebin_lev)) { + return(i18n$t("This analysis requires a response variable of type factor and one or more\npredictors of type numeric. If these variable types are not available please\nselect another dataset.\n\n") %>% + suggest_data("titanic")) + } + if (!input$ebin_train %in% c("", "All") && (!input$show_filter || (input$show_filter && is.empty(input$data_filter) && is.empty(input$data_rows)))) { + return(i18n$t("**\nFilter or Slice required. To set a filter or slice go to\nData > View and click the filter checkbox\n**")) + } + withProgress(message = i18n$t("Evaluating models"), value = 1, { + ebi <- ebin_inputs() + ebi$envir <- r_data + do.call(confusion, ebi) + }) +}) + +.summary_confusion <- reactive({ + if (not_pressed(input$ebin_run)) { + return(i18n$t("** Press the Evaluate button to evaluate models **")) + } + isolate({ + if (not_available(input$ebin_rvar) || not_available(input$ebin_pred) || + is.empty(input$ebin_lev)) { + return(i18n$t("This analysis requires a response variable of type factor and one or more\npredictors of type numeric. If these variable types are not available please\nselect another dataset.\n\n") %>% suggest_data("titanic")) + } + }) + summary(.confusion()) +}) + +.plot_confusion <- reactive({ + if (not_pressed(input$ebin_run)) { + return(invisible()) + } + isolate({ + if (not_available(input$ebin_rvar) || not_available(input$ebin_pred)) { + return(" ") + } + req(input$ebin_train, !is_not(input$ebin_scale_y)) + }) + plot(.confusion(), scale_y = input$ebin_scale_y) +}) + +.uplift <- eventReactive(input$ebin_run, { + if (not_available(input$ebin_rvar) || not_available(input$ebin_tvar) || not_available(input$ebin_pred) || + is.empty(input$ebin_lev) || is.empty(input$ebin_tlev)) { + return(i18n$t("This analysis requires a response variable of type factor, a treatment variable, and one or more\npredictors of type numeric. If these variable types are not available please\nselect another dataset.\n\n") %>% + suggest_data("kaggle_uplift")) + } + if (!input$ebin_train %in% c("", "All") && (!input$show_filter || (input$show_filter && is.empty(input$data_filter) && is.empty(input$data_rows)))) { + return(i18n$t("**\nFilter or Slice required. To set a filter or slice go to\nData > View and click the filter checkbox\n**")) + } + + withProgress(message = i18n$t("Evaluating uplift"), value = 1, { + uli <- uplift_inputs() + uli$envir <- r_data + do.call(uplift, uli) + }) +}) + +.summary_uplift <- reactive({ + if (not_pressed(input$ebin_run)) { + return(i18n$t("** Press the Evaluate button to evaluate models **")) + } + if (not_available(input$ebin_rvar) || not_available(input$ebin_tvar) || not_available(input$ebin_pred) || + is.empty(input$ebin_lev) || is.empty(input$ebin_tlev)) { + return(i18n$t("This analysis requires a response variable of type factor, a treatment variable, and one or more\npredictors of type numeric. If these variable types are not available please\nselect another dataset.\n\n") %>% + suggest_data("kaggle_uplift")) + } + summary(.uplift(), prn = input$uplift_show_tab) +}) + +.plot_uplift <- reactive({ + if (not_pressed(input$ebin_run)) { + return(i18n$t("** Press the Evaluate button to evaluate models **")) + } + isolate({ + if (not_available(input$ebin_rvar) || not_available(input$ebin_pred) || + is.empty(input$ebin_lev)) { + return(i18n$t("This analysis requires a response variable of type factor and one or more\npredictors of type numeric. If these variable types are not available please\nselect another dataset.\n\n") %>% + suggest_data("kaggle_uplift")) + } else if (!input$ebin_train %in% c("", "All") && (!input$show_filter || (input$show_filter && is.empty(input$data_filter) && is.empty(input$data_rows)))) { + return(i18n$t("**\nFilter or Slice required. To set a filter or slice go to\nData > View and click the filter checkbox\n**")) + } + }) + plot(.uplift(), plots = input$uplift_plots, shiny = TRUE) +}) + +evalbin_report <- function() { + if (is.empty(input$ebin_rvar) || is.empty(input$ebin_pred)) { + return(invisible()) + } + + outputs <- c("summary") + inp_out <- list(list(prn = input$ebin_show_tab), "") + figs <- FALSE + if (length(input$ebin_plots) > 0) { + inp_out[[2]] <- list(plots = input$ebin_plots, custom = FALSE) + outputs <- c("summary", "plot") + figs <- TRUE + } + update_report( + inp_main = clean_args(ebin_inputs(), ebin_args), + fun_name = "evalbin", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = ebin_plot_width(), + fig.height = ebin_plot_height() + ) +} + +confusion_report <- function() { + if (is.empty(input$ebin_rvar) || is.empty(input$ebin_pred)) { + return(invisible()) + } + + inp_out <- list("", "") + outputs <- "summary" + figs <- FALSE + + if (isTRUE(input$ebin_show_plots)) { + if (!input$ebin_scale_y) { + inp_out[[2]] <- list(scale_y = input$ebin_scale_y, custom = FALSE) + } else { + inp_out[[2]] <- list(custom = FALSE) + } + outputs <- c("summary", "plot") + figs <- TRUE + } + + # qnt might be set in the Evaluate tab but is not needed to calculate + # the confusion matrix + ebi <- ebin_inputs() + ebi$qnt <- NULL + + update_report( + inp_main = clean_args(ebi, ebin_args), + fun_name = "confusion", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = confusion_plot_width(), + fig.height = 1.5 * confusion_plot_height() + ) +} + +observeEvent(input$uplift_store, { + req(input$uplift_name) + dat <- .uplift() + if (is.null(dat)) { + return() + } + dataset <- fix_names(input$uplift_name) + if (input$uplift_name != dataset) { + updateTextInput(session, inputId = "expl_name", value = dataset) + } + # rows <- input$explore_rows_all + # dat$tab <- dat$tab %>% + # (function(x) if (is.null(rows)) x else x[rows, , drop = FALSE]) %>% + # (function(x) if (is.empty(input$expl_tab_slice)) x else slice_data(x, input$expl_tab_slice)) + r_data[[dataset]] <- dat$dataset + register(dataset) + updateSelectInput(session, "dataset", selected = input$dataset) + + ## See https://shiny.posit.co//reference/shiny/latest/modalDialog.html + showModal( + modalDialog( + title = i18n$t("Uplift Table Stored"), + span( + i18n$t(paste0("The uplift table '", dataset, "' was successfully added to the + datasets dropdown. Add code to Report > Rmd or + Report > R to (re)create the results by clicking + the report icon on the bottom left of your screen.") + )), + footer = modalButton(i18n$t("OK")), + size = "m", + easyClose = TRUE + ) + ) +}) + +uplift_report <- function() { + if (is.empty(input$ebin_rvar) || is.empty(input$ebin_pred)) { + return(invisible()) + } + + outputs <- c("summary") + inp_out <- list(list(prn = input$uplift_show_tab), "") + figs <- FALSE + if (length(input$uplift_plots) > 0) { + inp_out[[2]] <- list(plots = input$uplift_plots, custom = FALSE) + outputs <- c("summary", "plot") + figs <- TRUE + } + + if (!is.empty(input$uplift_name)) { + dataset <- fix_names(input$uplift_name) + if (input$uplift_name != dataset) { + updateTextInput(session, inputId = "uplift_name", value = dataset) + } + xcmd <- paste0(dataset, " <- result$dataset\nregister(\"", dataset, "\")") + } else { + xcmd <- "" + } + + update_report( + inp_main = clean_args(uplift_inputs(), uplift_args), + fun_name = "uplift", + inp_out = inp_out, + outputs = outputs, + xcmd = xcmd, + figs = figs, + fig.width = uplift_plot_width(), + fig.height = uplift_plot_height() + ) +} + +dl_ebin_tab <- function(path) { + dat <- .evalbin()$dataset + if (!is.empty(dat)) write.csv(dat, file = path, row.names = FALSE) +} + +download_handler( + id = "dl_ebin_tab", + fun = dl_ebin_tab, + fn = function() paste0(input$dataset, "_evalbin"), + type = "csv", + caption = i18n$t("Save model evaluations") +) + +dl_confusion_tab <- function(path) { + dat <- .confusion()$dataset + if (!is.empty(dat)) write.csv(dat, file = path, row.names = FALSE) +} + +download_handler( + id = "dl_confusion_tab", + fun = dl_confusion_tab, + fn = function() paste0(input$dataset, "_confusion"), + type = "csv", + caption = i18n$t("Save model performance metrics") +) + +dl_uplift_tab <- function(path) { + dat <- .uplift()$dataset + if (!is.empty(dat)) write.csv(dat, file = path, row.names = FALSE) +} + +download_handler( + id = "dl_uplift_tab", + fun = dl_uplift_tab, + fn = function() paste0(input$dataset, "_uplift"), + type = "csv", + caption = i18n$t("Save uplift evaluations") +) + +download_handler( + id = "dlp_evalbin", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_evalbin"), + type = "png", + caption = i18n$t("Save model evaluation plot"), + plot = .plot_evalbin, + width = ebin_plot_width, + height = ebin_plot_height +) + +download_handler( + id = "dlp_confusion", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_confusion"), + type = "png", + caption = i18n$t("Save confusion plots"), + plot = .plot_confusion, + width = confusion_plot_width, + height = confusion_plot_height +) + +download_handler( + id = "dlp_uplift", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_uplift"), + type = "png", + caption = i18n$t("Save uplift plots"), + plot = .plot_uplift, + width = uplift_plot_width, + height = uplift_plot_height +) + +observeEvent(input$confusion_report, { + r_info[["latest_screenshot"]] <- NULL + confusion_report() +}) + +observeEvent(input$confusion_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_confusion_screenshot") +}) + +observeEvent(input$modal_confusion_screenshot, { + confusion_report() + removeModal() ## remove shiny modal after save +}) + +observeEvent(input$evalbin_report, { + r_info[["latest_screenshot"]] <- NULL + evalbin_report() +}) + +observeEvent(input$evalbin_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_evalbin_screenshot") +}) + +observeEvent(input$modal_evalbin_screenshot, { + evalbin_report() + removeModal() ## remove shiny modal after save +}) + +observeEvent(input$uplift_report, { + r_info[["latest_screenshot"]] <- NULL + uplift_report() +}) + +observeEvent(input$uplift_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_uplift_screenshot") +}) + +observeEvent(input$modal_uplift_screenshot, { + uplift_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.model/inst/app/tools/analysis/evalreg_ui.R b/radiant.model/inst/app/tools/analysis/evalreg_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..0856b7b171063d938cf7f4a2df6201c335d11234 --- /dev/null +++ b/radiant.model/inst/app/tools/analysis/evalreg_ui.R @@ -0,0 +1,198 @@ +ereg_train <- c("All", "Training", "Test", "Both") +names(ereg_train) <- c( + i18n$t("All"), + i18n$t("Training"), + i18n$t("Test"), + i18n$t("Both") +) +## list of function arguments +ereg_args <- as.list(formals(evalreg)) + +ereg_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + ereg_args$data_filter <- if (input$show_filter) input$data_filter else "" + ereg_args$rows <- if (input$show_filter) input$data_rows else "" + ereg_args$dataset <- input$dataset + for (i in r_drop(names(ereg_args))) { + ereg_args[[i]] <- input[[paste0("ereg_", i)]] + } + ereg_args +}) + +############################################################### +# Evaluate model evalreg +############################################################### +output$ui_ereg_rvar <- renderUI({ + withProgress(message = i18n$t("Acquiring variable information"), value = 1, { + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- varnames()[isNum] + }) + selectInput( + inputId = "ereg_rvar", label = i18n$t("Response variable:"), choices = vars, + selected = state_single("ereg_rvar", vars), multiple = FALSE + ) +}) + +output$ui_ereg_pred <- renderUI({ + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- varnames()[isNum] + + req(available(input$ereg_rvar)) + ## don't use setdiff, removes names + if (length(vars) > 0 && input$ereg_rvar %in% vars) { + vars <- vars[-which(vars == input$ereg_rvar)] + } + + selectInput( + inputId = "ereg_pred", label = i18n$t("Select stored predictions:"), choices = vars, + selected = state_multiple("ereg_pred", vars, isolate(input$ereg_pred)), + multiple = TRUE, size = min(4, length(vars)), selectize = FALSE + ) +}) + +output$ui_ereg_train <- renderUI({ + selectInput( + "ereg_train", + label = i18n$t("Show results for:"), ereg_train, + selected = state_single("ereg_train", ereg_train, "All") + ) +}) + +## add a spinning refresh icon if the model needs to be (re)estimated +run_refresh(ereg_args, "ereg", init = "pred", label = i18n$t("Evaluate models"), relabel = i18n$t("Re-evaluate models")) + +output$ui_evalreg <- renderUI({ + req(input$dataset) + tagList( + wellPanel( + actionButton("ereg_run", i18n$t("Evaluate models"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ), + wellPanel( + uiOutput("ui_ereg_rvar"), + uiOutput("ui_ereg_pred"), + uiOutput("ui_ereg_train"), + checkboxInput("ereg_show_plots", i18n$t("Show plots"), state_init("ereg_show_plots", FALSE)) + ), + help_and_report( + modal_title = i18n$t("Evaluate regressions"), + fun_name = "evalreg", + help_file = inclMD(file.path(getOption("radiant.path.model"), "app/tools/help/evalreg.md")) + ) + ) +}) + +ereg_plot_width <- function() 650 +ereg_plot_height <- function() 650 + +## output is called from the main radiant ui.R +output$evalreg <- renderUI({ + register_print_output("summary_evalreg", ".summary_evalreg") + register_plot_output( + "plot_evalreg", ".plot_evalreg", + width_fun = "ereg_plot_width", + height_fun = "ereg_plot_height" + ) + + ## one output with components stacked + ereg_output_panels <- tagList( + download_link("dl_ereg_tab"), br(), + verbatimTextOutput("summary_evalreg"), + conditionalPanel( + condition = "input.ereg_show_plots == true", + download_link("dlp_evalreg"), + plotOutput("plot_evalreg", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Model > Evaluate"), + tool = i18n$t("Evaluate Regression"), + tool_ui = "ui_evalreg", + output_panels = ereg_output_panels + ) +}) + +.evalreg <- eventReactive(input$ereg_run, { + eri <- ereg_inputs() + eri$envir <- r_data + do.call(evalreg, eri) +}) + +.summary_evalreg <- reactive({ + if (not_pressed(input$ereg_run)) { + return(i18n$t("** Press the Evaluate button to evaluate models **")) + } + if (not_available(input$ereg_rvar) || not_available(input$ereg_pred)) { + return(i18n$t("This analysis requires a numeric response variable and one or more\nnumeric predictors. If these variable types are not available please\nselect another dataset.\n\n" %>% suggest_data("diamonds"))) + } + summary(.evalreg()) +}) + +.plot_evalreg <- eventReactive(input$ereg_run, { + req(input$ereg_train) + plot(.evalreg()) +}) + +evalreg_report <- function() { + if (is.empty(input$ereg_pred)) { + return(invisible()) + } + + inp_out <- list("", "") + outputs <- "summary" + figs <- FALSE + if (isTRUE(input$ereg_show_plots)) { + inp_out[[2]] <- list(custom = FALSE) + outputs <- c("summary", "plot") + figs <- TRUE + } + + update_report( + inp_main = clean_args(ereg_inputs(), ereg_args), + fun_name = "evalreg", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = ereg_plot_width(), + fig.height = ereg_plot_height() + ) +} + +dl_ereg_tab <- function(path) { + .evalreg() %>% + (function(x) if (!is.empty(x$dat)) write.csv(x$dat, file = path, row.names = FALSE)) +} + +download_handler( + id = "dl_ereg_tab", + fun = dl_ereg_tab, + fn = function() paste0(input$dataset, "_evalreg"), + type = "csv", + caption = i18n$t("Save model evaluations") +) + +download_handler( + id = "dlp_evalreg", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_evalreg"), + type = "png", + caption = i18n$t("Save model evaluation plot"), + plot = .plot_evalreg, + width = ereg_plot_width, + height = ereg_plot_height +) + +observeEvent(input$evalreg_report, { + r_info[["latest_screenshot"]] <- NULL + evalreg_report() +}) + +observeEvent(input$evalreg_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_evalreg_screenshot") +}) + +observeEvent(input$modal_evalreg_screenshot, { + evalreg_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.model/inst/app/tools/analysis/gbt_ui.R b/radiant.model/inst/app/tools/analysis/gbt_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..a45bbe9c2b59f04c3e8f61cc9c6c52d518c6b821 --- /dev/null +++ b/radiant.model/inst/app/tools/analysis/gbt_ui.R @@ -0,0 +1,755 @@ +gbt_plots <- c("none", "vip", "pred_plot", "pdp", "dashboard") +names(gbt_plots) <- c( + i18n$t("None"), + i18n$t("Permutation Importance"), + i18n$t("Prediction plots"), + i18n$t("Partial Dependence"), + i18n$t("Dashboard") +) +## list of function arguments +gbt_args <- as.list(formals(gbt)) + +## list of function inputs selected by user +gbt_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + gbt_args$data_filter <- if (input$show_filter) input$data_filter else "" + gbt_args$arr <- if (input$show_filter) input$data_arrange else "" + gbt_args$rows <- if (input$show_filter) input$data_rows else "" + gbt_args$dataset <- input$dataset + for (i in r_drop(names(gbt_args))) { + gbt_args[[i]] <- input[[paste0("gbt_", i)]] + } + gbt_args +}) + +gbt_plot_args <- as.list(if (exists("plot.gbt")) { + formals(plot.gbt) +} else { + formals(radiant.model:::plot.gbt) +}) + +## list of function inputs selected by user +gbt_plot_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(gbt_plot_args)) { + gbt_plot_args[[i]] <- input[[paste0("gbt_", i)]] + } + gbt_plot_args +}) + +gbt_pred_args <- as.list(if (exists("predict.gbt")) { + formals(predict.gbt) +} else { + formals(radiant.model:::predict.gbt) +}) + +# list of function inputs selected by user +gbt_pred_inputs <- reactive({ + # loop needed because reactive values don't allow single bracket indexing + for (i in names(gbt_pred_args)) { + gbt_pred_args[[i]] <- input[[paste0("gbt_", i)]] + } + + gbt_pred_args$pred_cmd <- gbt_pred_args$pred_data <- "" + if (input$gbt_predict == "cmd") { + gbt_pred_args$pred_cmd <- gsub("\\s{2,}", " ", input$gbt_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% + gsub("\"", "\'", .) + } else if (input$gbt_predict == "data") { + gbt_pred_args$pred_data <- input$gbt_pred_data + } else if (input$gbt_predict == "datacmd") { + gbt_pred_args$pred_cmd <- gsub("\\s{2,}", " ", input$gbt_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% + gsub("\"", "\'", .) + gbt_pred_args$pred_data <- input$gbt_pred_data + } + gbt_pred_args +}) + +gbt_pred_plot_args <- as.list(if (exists("plot.model.predict")) { + formals(plot.model.predict) +} else { + formals(radiant.model:::plot.model.predict) +}) + +# list of function inputs selected by user +gbt_pred_plot_inputs <- reactive({ + # loop needed because reactive values don't allow single bracket indexing + for (i in names(gbt_pred_plot_args)) { + gbt_pred_plot_args[[i]] <- input[[paste0("gbt_", i)]] + } + gbt_pred_plot_args +}) + +output$ui_gbt_rvar <- renderUI({ + req(input$gbt_type) + + withProgress(message = i18n$t("Acquiring variable information"), value = 1, { + if (input$gbt_type == "classification") { + vars <- two_level_vars() + } else { + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- varnames()[isNum] + } + }) + + init <- if (input$gbt_type == "classification") { + if (is.empty(input$logit_rvar)) isolate(input$gbt_rvar) else input$logit_rvar + } else { + if (is.empty(input$reg_rvar)) isolate(input$gbt_rvar) else input$reg_rvar + } + + selectInput( + inputId = "gbt_rvar", + label = i18n$t("Response variable:"), + choices = vars, + selected = state_single("gbt_rvar", vars, init), + multiple = FALSE + ) +}) + +output$ui_gbt_lev <- renderUI({ + req(input$gbt_type == "classification") + req(available(input$gbt_rvar)) + levs <- .get_data()[[input$gbt_rvar]] %>% + as_factor() %>% + levels() + + init <- if (is.empty(input$logit_lev)) isolate(input$gbt_lev) else input$logit_lev + selectInput( + inputId = "gbt_lev", label = i18n$t("Choose first level:"), + choices = levs, + selected = state_init("gbt_lev", init) + ) +}) + +output$ui_gbt_evar <- renderUI({ + if (not_available(input$gbt_rvar)) { + return() + } + vars <- varnames() + if (length(vars) > 0) { + vars <- vars[-which(vars == input$gbt_rvar)] + } + + init <- if (input$gbt_type == "classification") { + # input$logit_evar + if (is.empty(input$logit_evar)) isolate(input$gbt_evar) else input$logit_evar + } else { + # input$reg_evar + if (is.empty(input$reg_evar)) isolate(input$gbt_evar) else input$reg_evar + } + + selectInput( + inputId = "gbt_evar", + label = i18n$t("Explanatory variables:"), + choices = vars, + selected = state_multiple("gbt_evar", vars, init), + multiple = TRUE, + size = min(10, length(vars)), + selectize = FALSE + ) +}) + +# function calls generate UI elements +output_incl("gbt") +output_incl_int("gbt") + +output$ui_gbt_wts <- renderUI({ + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- varnames()[isNum] + if (length(vars) > 0 && any(vars %in% input$gbt_evar)) { + vars <- base::setdiff(vars, input$gbt_evar) + names(vars) <- varnames() %>% + (function(x) x[match(vars, x)]) %>% + names() + } + vars <- c("None", vars) + + selectInput( + inputId = "gbt_wts", label = i18n$t("Weights:"), choices = vars, + selected = state_single("gbt_wts", vars), + multiple = FALSE + ) +}) + +output$ui_gbt_store_pred_name <- renderUI({ + init <- state_init("gbt_store_pred_name", "pred_gbt") + textInput( + "gbt_store_pred_name", + i18n$t("Store predictions:"), + init + ) +}) + +# output$ui_gbt_store_res_name <- renderUI({ +# req(input$dataset) +# textInput("gbt_store_res_name", "Store residuals:", "", placeholder = "Provide variable name") +# }) + +## reset prediction and plot settings when the dataset changes +observeEvent(input$dataset, { + updateSelectInput(session = session, inputId = "gbt_predict", selected = "none") + updateSelectInput(session = session, inputId = "gbt_plots", selected = "none") +}) + +## reset prediction settings when the model type changes +observeEvent(input$gbt_type, { + updateSelectInput(session = session, inputId = "gbt_predict", selected = "none") + updateSelectInput(session = session, inputId = "gbt_plots", selected = "none") +}) + +output$ui_gbt_predict_plot <- renderUI({ + predict_plot_controls("gbt") +}) + +output$ui_gbt_plots <- renderUI({ + req(input$gbt_type) + if (input$gbt_type != "regression") { + gbt_plots <- head(gbt_plots, -1) + } + selectInput( + "gbt_plots", i18n$t("Plots:"), + choices = gbt_plots, + selected = state_single("gbt_plots", gbt_plots) + ) +}) + +output$ui_gbt_nrobs <- renderUI({ + nrobs <- nrow(.get_data()) + choices <- c("1,000" = 1000, "5,000" = 5000, "10,000" = 10000, "All" = -1) %>% + .[. < nrobs] + selectInput( + "gbt_nrobs", i18n$t("Number of data points plotted:"), + choices = choices, + selected = state_single("gbt_nrobs", choices, 1000) + ) +}) + +## add a spinning refresh icon if the model needs to be (re)estimated +run_refresh(gbt_args, "gbt", tabs = "tabs_gbt", label = i18n$t("Estimate model"), relabel = i18n$t("Re-estimate model")) + +output$ui_gbt <- renderUI({ + req(input$dataset) + tagList( + conditionalPanel( + condition = "input.tabs_gbt == 'Summary'", + wellPanel( + actionButton("gbt_run", i18n$t("Estimate model"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ) + ), + wellPanel( + conditionalPanel( + condition = "input.tabs_gbt == 'Summary'", + radioButtons( + "gbt_type", + label = NULL, c(i18n$t("classification"), i18n$t("regression")), + selected = state_init("gbt_type", "classification"), + inline = TRUE + ), + uiOutput("ui_gbt_rvar"), + uiOutput("ui_gbt_lev"), + uiOutput("ui_gbt_evar"), + uiOutput("ui_gbt_wts"), + with(tags, table( + tr( + td(numericInput( + "gbt_max_depth", + label = i18n$t("Max depth:"), min = 1, max = 20, + value = state_init("gbt_max_depth", 6) + ), width = "50%"), + td(numericInput( + "gbt_learning_rate", + label = i18n$t("Learning rate:"), min = 0, max = 1, step = 0.1, + value = state_init("gbt_learning_rate", 0.3) + ), width = "50%") + ), + width = "100%" + )), + with(tags, table( + tr( + td(numericInput( + "gbt_min_split_loss", + label = i18n$t("Min split loss:"), min = 0.00001, max = 1000, + step = 0.01, value = state_init("gbt_min_split_loss", 0) + ), width = "50%"), + td(numericInput( + "gbt_min_child_weight", + label = i18n$t("Min child weight:"), min = 1, max = 100, + step = 1, value = state_init("gbt_min_child_weight", 1) + ), width = "50%") + ), + width = "100%" + )), + with(tags, table( + tr( + td(numericInput( + "gbt_subsample", + label = i18n$t("Sub-sample:"), min = 0.1, max = 1, + value = state_init("gbt_subsample", 1) + ), width = "50%"), + td(numericInput( + "gbt_nrounds", + label = i18n$t("# rounds:"), + value = state_init("gbt_nrounds", 100) + ), width = "50%") + ), + width = "100%" + )), + with(tags, table( + tr( + td(numericInput( + "gbt_early_stopping_rounds", + label = i18n$t("Early stopping:"), min = 1, max = 10, + step = 1, value = state_init("gbt_early_stopping_rounds", 3) + ), width = "50%"), + td(numericInput( + "gbt_seed", + label = i18n$t("Seed:"), + value = state_init("gbt_seed", 1234) + ), width = "50%") + ), + width = "100%" + )) + ), + conditionalPanel( + condition = "input.tabs_gbt == 'Predict'", + selectInput( + "gbt_predict", + label = i18n$t("Prediction input type:"), reg_predict, + selected = state_single("gbt_predict", reg_predict, "none") + ), + conditionalPanel( + "input.gbt_predict == 'data' | input.gbt_predict == 'datacmd'", + selectizeInput( + inputId = "gbt_pred_data", label = i18n$t("Prediction data:"), + choices = c("None" = "", r_info[["datasetlist"]]), + selected = state_single("gbt_pred_data", c("None" = "", r_info[["datasetlist"]])), + multiple = FALSE + ) + ), + conditionalPanel( + "input.gbt_predict == 'cmd' | input.gbt_predict == 'datacmd'", + returnTextAreaInput( + "gbt_pred_cmd", i18n$t("Prediction command:"), + value = state_init("gbt_pred_cmd", ""), + rows = 3, + placeholder = i18n$t("Type a formula to set values for model variables (e.g., carat = 1; cut = 'Ideal') and press return") + ) + ), + conditionalPanel( + condition = "input.gbt_predict != 'none'", + checkboxInput("gbt_pred_plot", i18n$t("Plot predictions"), state_init("gbt_pred_plot", FALSE)), + conditionalPanel( + "input.gbt_pred_plot == true", + uiOutput("ui_gbt_predict_plot") + ) + ), + ## only show if full data is used for prediction + conditionalPanel( + "input.gbt_predict == 'data' | input.gbt_predict == 'datacmd'", + tags$table( + tags$td(uiOutput("ui_gbt_store_pred_name")), + tags$td(actionButton("gbt_store_pred", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ) + ), + conditionalPanel( + condition = "input.tabs_gbt == 'Plot'", + uiOutput("ui_gbt_plots"), + conditionalPanel( + condition = "input.gbt_plots == 'dashboard'", + uiOutput("ui_gbt_nrobs") + ), + conditionalPanel( + condition = "input.gbt_plots == 'pdp' | input.gbt_plots == 'pred_plot'", + uiOutput("ui_gbt_incl"), + uiOutput("ui_gbt_incl_int") + ) + ), + # conditionalPanel( + # condition = "input.tabs_gbt == 'Summary'", + # tags$table( + # tags$td(uiOutput("ui_gbt_store_res_name")), + # tags$td(actionButton("gbt_store_res", "Store", icon = icon("plus", verify_fa = FALSE)), class = "top") + # ) + # ) + ), + help_and_report( + modal_title = i18n$t("Gradient Boosted Trees"), + fun_name = "gbt", + help_file = inclMD(file.path(getOption("radiant.path.model"), "app/tools/help/gbt.md")) + ) + ) +}) + +gbt_plot <- reactive({ + # req(input$gbt_plots) + if (gbt_available() != "available") { + return() + } + if (is.empty(input$gbt_plots, "none")) { + return() + } + res <- .gbt() + if (is.character(res)) { + return() + } + nr_vars <- length(res$evar) + plot_height <- 500 + plot_width <- 650 + if ("dashboard" %in% input$gbt_plots) { + plot_height <- 750 + } else if (input$gbt_plots %in% c("pdp", "pred_plot")) { + nr_vars <- length(input$gbt_incl) + length(input$gbt_incl_int) + plot_height <- max(250, ceiling(nr_vars / 2) * 250) + if (length(input$gbt_incl_int) > 0) { + plot_width <- plot_width + min(2, length(input$gbt_incl_int)) * 90 + } + } else if ("vimp" %in% input$rf_plots) { + plot_height <- max(500, nr_vars * 35) + } else if ("vip" %in% input$rf_plots) { + plot_height <- max(500, nr_vars * 35) + } + + list(plot_width = plot_width, plot_height = plot_height) +}) + +gbt_plot_width <- function() { + gbt_plot() %>% + (function(x) if (is.list(x)) x$plot_width else 650) +} + +gbt_plot_height <- function() { + gbt_plot() %>% + (function(x) if (is.list(x)) x$plot_height else 500) +} + +gbt_pred_plot_height <- function() { + if (input$gbt_pred_plot) 500 else 1 +} + +## output is called from the main radiant ui.R +output$gbt <- renderUI({ + register_print_output("summary_gbt", ".summary_gbt") + register_print_output("predict_gbt", ".predict_print_gbt") + register_plot_output( + "predict_plot_gbt", ".predict_plot_gbt", + height_fun = "gbt_pred_plot_height" + ) + register_plot_output( + "plot_gbt", ".plot_gbt", + height_fun = "gbt_plot_height", + width_fun = "gbt_plot_width" + ) + + ## three separate tabs + gbt_output_panels <- tabsetPanel( + id = "tabs_gbt", + tabPanel( + i18n$t("Summary"), value = "Summary", + verbatimTextOutput("summary_gbt") + ), + tabPanel( + i18n$t("Predict"), value = "Predict", + conditionalPanel( + "input.gbt_pred_plot == true", + download_link("dlp_gbt_pred"), + plotOutput("predict_plot_gbt", width = "100%", height = "100%") + ), + download_link("dl_gbt_pred"), br(), + verbatimTextOutput("predict_gbt") + ), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_gbt"), + plotOutput("plot_gbt", width = "100%", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Model > Trees"), + tool = i18n$t("Gradient Boosted Trees"), + tool_ui = "ui_gbt", + output_panels = gbt_output_panels + ) +}) + +gbt_available <- reactive({ + req(input$gbt_type) + if (not_available(input$gbt_rvar)) { + if (input$gbt_type == "classification") { + i18n$t("This analysis requires a response variable with two levels and one\nor more explanatory variables. If these variables are not available\nplease select another dataset.\n\n") %>% + suggest_data("titanic") + } else { + i18n$t("This analysis requires a response variable of type integer\nor numeric and one or more explanatory variables.\nIf these variables are not available please select another dataset.\n\n") %>% + suggest_data("diamonds") + } + } else if (not_available(input$gbt_evar)) { + if (input$gbt_type == "classification") { + i18n$t("Please select one or more explanatory variables.") %>% + suggest_data("titanic") + } else { + i18n$t("Please select one or more explanatory variables.") %>% + suggest_data("diamonds") + } + } else { + "available" + } +}) + +.gbt <- eventReactive(input$gbt_run, { + gbti <- gbt_inputs() + gbti$envir <- r_data + if (is.empty(gbti$max_depth)) gbti$max_depth <- 6 + if (is.empty(gbti$learning_rate)) gbti$learning_rate <- 0.3 + if (is.empty(gbti$min_split_loss)) gbti$min_split_loss <- 0.01 + if (is.empty(gbti$min_child_weight)) gbti$min_child_weight <- 1 + if (is.empty(gbti$subsample)) gbti$subsample <- 1 + if (is.empty(gbti$nrounds)) gbti$nrounds <- 100 + if (is.empty(gbti$early_stopping_rounds)) gbti["early_stopping_rounds"] <- list(NULL) + + withProgress( + message = i18n$t("Estimating model"), value = 1, + do.call(gbt, gbti) + ) +}) + +.summary_gbt <- reactive({ + if (not_pressed(input$gbt_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } + if (gbt_available() != "available") { + return(gbt_available()) + } + summary(.gbt()) +}) + +.predict_gbt <- reactive({ + if (not_pressed(input$gbt_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } + if (gbt_available() != "available") { + return(gbt_available()) + } + if (is.empty(input$gbt_predict, "none")) { + return(i18n$t("** Select prediction input **")) + } + + if ((input$gbt_predict == "data" || input$gbt_predict == "datacmd") && is.empty(input$gbt_pred_data)) { + return(i18n$t("** Select data for prediction **")) + } + if (input$gbt_predict == "cmd" && is.empty(input$gbt_pred_cmd)) { + return(i18n$t("** Enter prediction commands **")) + } + + withProgress(message = i18n$t("Generating predictions"), value = 1, { + gbti <- gbt_pred_inputs() + gbti$object <- .gbt() + gbti$envir <- r_data + do.call(predict, gbti) + }) +}) + +.predict_print_gbt <- reactive({ + .predict_gbt() %>% + (function(x) if (is.character(x)) cat(x, "\n") else print(x)) +}) + +.predict_plot_gbt <- reactive({ + req( + pressed(input$gbt_run), input$gbt_pred_plot, + available(input$gbt_xvar), + !is.empty(input$gbt_predict, "none") + ) + + withProgress(message = i18n$t("Generating prediction plot"), value = 1, { + do.call(plot, c(list(x = .predict_gbt()), gbt_pred_plot_inputs())) + }) +}) + +.plot_gbt <- reactive({ + if (not_pressed(input$gbt_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } else if (gbt_available() != "available") { + return(gbt_available()) + } else if (is.empty(input$gbt_plots, "none")) { + return(i18n$t("Please select a gradient boosted trees plot from the drop-down menu")) + } + # pinp <- list(plots = input$gbt_plots, shiny = TRUE) + # if (input$gbt_plots == "dashboard") { + # req(input$gbt_nrobs) + # pinp <- c(pinp, nrobs = as_integer(input$gbt_nrobs)) + # } else if (input$gbt_plots == "pdp") { + # pinp <- c(pinp) + # } + pinp <- gbt_plot_inputs() + pinp$shiny <- TRUE + if (input$gbt_plots == "dashboard") { + req(input$gbt_nrobs) + } + check_for_pdp_pred_plots("gbt") + withProgress(message = i18n$t("Generating plots"), value = 1, { + do.call(plot, c(list(x = .gbt()), pinp)) + }) +}) + +# observeEvent(input$gbt_store_res, { +# req(pressed(input$gbt_run)) +# robj <- .gbt() +# if (!is.list(robj)) return() +# fixed <- fix_names(input$gbt_store_res_name) +# updateTextInput(session, "gbt_store_res_name", value = fixed) +# withProgress( +# message = "Storing residuals", value = 1, +# r_data[[input$dataset]] <- store(r_data[[input$dataset]], robj, name = fixed) +# ) +# }) + +observeEvent(input$gbt_store_pred, { + req(!is.empty(input$gbt_pred_data), pressed(input$gbt_run)) + pred <- .predict_gbt() + if (is.null(pred)) { + return() + } + fixed <- fix_names(input$gbt_store_pred_name) + updateTextInput(session, "gbt_store_pred_name", value = fixed) + withProgress( + message = i18n$t("Storing predictions"), value = 1, + r_data[[input$gbt_pred_data]] <- store( + r_data[[input$gbt_pred_data]], pred, + name = fixed + ) + ) +}) + +gbt_report <- function() { + if (is.empty(input$gbt_rvar)) { + return(invisible()) + } + + outputs <- c("summary") + inp_out <- list(list(prn = TRUE), "") + figs <- FALSE + + if (!is.empty(input$gbt_plots, "none")) { + inp <- check_plot_inputs(gbt_plot_inputs()) + inp_out[[2]] <- clean_args(inp, gbt_plot_args[-1]) + inp_out[[2]]$custom <- FALSE + outputs <- c(outputs, "plot") + figs <- TRUE + } + + if (!is.empty(input$gbt_store_res_name)) { + fixed <- fix_names(input$gbt_store_res_name) + updateTextInput(session, "gbt_store_res_name", value = fixed) + xcmd <- paste0(input$dataset, " <- store(", input$dataset, ", result, name = \"", fixed, "\")\n") + } else { + xcmd <- "" + } + + if (!is.empty(input$gbt_predict, "none") && + (!is.empty(input$gbt_pred_data) || !is.empty(input$gbt_pred_cmd))) { + pred_args <- clean_args(gbt_pred_inputs(), gbt_pred_args[-1]) + + if (!is.empty(pred_args$pred_cmd)) { + pred_args$pred_cmd <- strsplit(pred_args$pred_cmd, ";\\s*")[[1]] + } else { + pred_args$pred_cmd <- NULL + } + + if (!is.empty(pred_args$pred_data)) { + pred_args$pred_data <- as.symbol(pred_args$pred_data) + } else { + pred_args$pred_data <- NULL + } + + inp_out[[2 + figs]] <- pred_args + outputs <- c(outputs, "pred <- predict") + xcmd <- paste0(xcmd, "print(pred, n = 10)") + if (input$gbt_predict %in% c("data", "datacmd")) { + fixed <- fix_names(input$gbt_store_pred_name) + updateTextInput(session, "gbt_store_pred_name", value = fixed) + xcmd <- paste0( + xcmd, "\n", input$gbt_pred_data, " <- store(", + input$gbt_pred_data, ", pred, name = \"", fixed, "\")" + ) + } + + if (input$gbt_pred_plot && !is.empty(input$gbt_xvar)) { + inp_out[[3 + figs]] <- clean_args(gbt_pred_plot_inputs(), gbt_pred_plot_args[-1]) + inp_out[[3 + figs]]$result <- "pred" + outputs <- c(outputs, "plot") + figs <- TRUE + } + } + + gbt_inp <- gbt_inputs() + if (input$gbt_type == "regression") { + gbt_inp$lev <- NULL + } + + update_report( + inp_main = clean_args(gbt_inp, gbt_args), + fun_name = "gbt", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = gbt_plot_width(), + fig.height = gbt_plot_height(), + xcmd = xcmd + ) +} + +dl_gbt_pred <- function(path) { + if (pressed(input$gbt_run)) { + write.csv(.predict_gbt(), file = path, row.names = FALSE) + } else { + cat(i18n$t("No output available. Press the Estimate button to generate results", file = path)) + } +} + +download_handler( + id = "dl_gbt_pred", + fun = dl_gbt_pred, + fn = function() paste0(input$dataset, "_gbt_pred"), + type = "csv", + caption = i18n$t("Save predictions") +) + +download_handler( + id = "dlp_gbt_pred", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_gbt_pred"), + type = "png", + caption = i18n$t("Save gradient boosted trees prediction plot"), + plot = .predict_plot_gbt, + width = plot_width, + height = gbt_pred_plot_height +) + +download_handler( + id = "dlp_gbt", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_gbt"), + type = "png", + caption = i18n$t("Save gradient boosted trees plot"), + plot = .plot_gbt, + width = gbt_plot_width, + height = gbt_plot_height +) + +observeEvent(input$gbt_report, { + r_info[["latest_screenshot"]] <- NULL + gbt_report() +}) + +observeEvent(input$gbt_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_gbt_screenshot") +}) + +observeEvent(input$modal_gbt_screenshot, { + gbt_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.model/inst/app/tools/analysis/logistic_ui.R b/radiant.model/inst/app/tools/analysis/logistic_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..6657e75f3e9216ec5b76a0615ac08b03d45da6b6 --- /dev/null +++ b/radiant.model/inst/app/tools/analysis/logistic_ui.R @@ -0,0 +1,878 @@ +logit_show_interactions <- c("none", "2-way", "3-way") +names(logit_show_interactions) <- c( + i18n$t("None"), + i18n$t("2-way"), + i18n$t("3-way") +) + +logit_predict <- c("none", "data", "cmd", "datacmd") +names(logit_predict) <- c( + i18n$t("None"), + i18n$t("Data"), + i18n$t("Command"), + i18n$t("Data & Command") +) + +logit_check <- c("standardize", "center", "stepwise-backward", "robust") +names(logit_check) <- c( + i18n$t("Standardize"), + i18n$t("Center"), + i18n$t("Stepwise"), + i18n$t("Robust") +) + +logit_sum_check <- c("vif", "confint", "odds") +names(logit_sum_check) <- c( + i18n$t("VIF"), + i18n$t("Confidence intervals"), + i18n$t("Odds") +) + +logit_plots <- c("none", "dist", "correlations", "scatter", "vip", "pred_plot", "pdp", "fit", "coef", "influence") +names(logit_plots) <- c( + i18n$t("None"), + i18n$t("Distribution"), + i18n$t("Correlations"), + i18n$t("Scatter"), + i18n$t("Permutation Importance"), + i18n$t("Prediction plots"), + i18n$t("Partial Dependence"), + i18n$t("Model fit"), + i18n$t("Coefficient (OR) plot"), + i18n$t("Influential observations") +) + + +## list of function arguments +logit_args <- as.list(formals(logistic)) + +## list of function inputs selected by user +logit_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + logit_args$data_filter <- if (input$show_filter) input$data_filter else "" + logit_args$arr <- if (input$show_filter) input$data_arrange else "" + logit_args$rows <- if (input$show_filter) input$data_rows else "" + logit_args$dataset <- input$dataset + for (i in r_drop(names(logit_args))) { + logit_args[[i]] <- input[[paste0("logit_", i)]] + } + logit_args +}) + +logit_sum_args <- as.list(if (exists("summary.logistic")) { + formals(summary.logistic) +} else { + formals(radiant.model:::summary.logistic) +}) + +## list of function inputs selected by user +logit_sum_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(logit_sum_args)) { + logit_sum_args[[i]] <- input[[paste0("logit_", i)]] + } + logit_sum_args +}) + +logit_plot_args <- as.list(if (exists("plot.logistic")) { + formals(plot.logistic) +} else { + formals(radiant.model:::plot.logistic) +}) + +## list of function inputs selected by user +logit_plot_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(logit_plot_args)) { + logit_plot_args[[i]] <- input[[paste0("logit_", i)]] + } + + # cat(paste0(names(logit_plot_args), " ", logit_plot_args, collapse = ", "), file = stderr(), "\n") + logit_plot_args +}) + +logit_pred_args <- as.list(if (exists("predict.logistic")) { + formals(predict.logistic) +} else { + formals(radiant.model:::predict.logistic) +}) + +# list of function inputs selected by user +logit_pred_inputs <- reactive({ + # loop needed because reactive values don't allow single bracket indexing + for (i in names(logit_pred_args)) { + logit_pred_args[[i]] <- input[[paste0("logit_", i)]] + } + + logit_pred_args$pred_cmd <- logit_pred_args$pred_data <- "" + if (input$logit_predict == "cmd") { + logit_pred_args$pred_cmd <- gsub("\\s{2,}", " ", input$logit_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% + gsub("\"", "\'", .) + } else if (input$logit_predict == "data") { + logit_pred_args$pred_data <- input$logit_pred_data + } else if (input$logit_predict == "datacmd") { + logit_pred_args$pred_cmd <- gsub("\\s{2,}", " ", input$logit_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% + gsub("\"", "\'", .) + logit_pred_args$pred_data <- input$logit_pred_data + } + + ## setting value for prediction interval type + logit_pred_args$interval <- "confidence" + + logit_pred_args +}) + +logit_pred_plot_args <- as.list(if (exists("plot.model.predict")) { + formals(plot.model.predict) +} else { + formals(radiant.model:::plot.model.predict) +}) + + +# list of function inputs selected by user +logit_pred_plot_inputs <- reactive({ + # loop needed because reactive values don't allow single bracket indexing + for (i in names(logit_pred_plot_args)) { + logit_pred_plot_args[[i]] <- input[[paste0("logit_", i)]] + } + logit_pred_plot_args +}) + +output$ui_logit_rvar <- renderUI({ + withProgress(message = i18n$t("Acquiring variable information"), value = 1, { + vars <- two_level_vars() + }) + selectInput( + inputId = "logit_rvar", label = i18n$t("Response variable:"), choices = vars, + selected = state_single("logit_rvar", vars), multiple = FALSE + ) +}) + +output$ui_logit_lev <- renderUI({ + req(available(input$logit_rvar)) + levs <- .get_data()[[input$logit_rvar]] %>% + as.factor() %>% + levels() + selectInput( + inputId = "logit_lev", label = i18n$t("Choose level:"), + choices = levs, selected = state_init("logit_lev") + ) +}) + +output$ui_logit_evar <- renderUI({ + req(available(input$logit_rvar)) + vars <- varnames() + if (length(vars) > 0 && input$logit_rvar %in% vars) { + vars <- vars[-which(vars == input$logit_rvar)] + } + + selectInput( + inputId = "logit_evar", label = i18n$t("Explanatory variables:"), choices = vars, + selected = state_multiple("logit_evar", vars, isolate(input$logit_evar)), + multiple = TRUE, size = min(10, length(vars)), selectize = FALSE + ) +}) + +output$ui_logit_incl <- renderUI({ + req(available(input$logit_evar)) + vars <- input$logit_evar + if (input[["logit_plots"]] == "coef") { + vars_init <- vars + } else { + vars_init <- c() + } + selectInput( + inputId = "logit_incl", label = i18n$t("Explanatory variables to include:"), choices = vars, + selected = state_multiple("logit_incl", vars, vars_init), + multiple = TRUE, size = min(10, length(vars)), selectize = FALSE + ) +}) + +output$ui_logit_incl_int <- renderUI({ + req(available(input$logit_evar)) + choices <- character(0) + vars <- input$logit_evar + ## list of interaction terms to show + if (length(vars) > 1) { + choices <- c(choices, iterms(vars, 2)) + } else { + updateSelectInput(session, "logit_incl_int", choices = choices, selected = choices) + return() + } + selectInput( + "logit_incl_int", + label = i18n$t("2-way interactions to explore:"), + choices = choices, + selected = state_multiple("logit_incl_int", choices), + multiple = TRUE, + size = min(8, length(choices)), + selectize = FALSE + ) +}) + +output$ui_logit_wts <- renderUI({ + req(available(input$logit_rvar), available(input$logit_evar)) + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- varnames()[isNum] + if (length(vars) > 0 && any(vars %in% input$logit_evar)) { + vars <- base::setdiff(vars, input$logit_evar) + names(vars) <- varnames() %>% + { + .[match(vars, .)] + } %>% + names() + } + vars <- c("None", vars) + + selectInput( + inputId = "logit_wts", label = i18n$t("Weights:"), choices = vars, + selected = state_single("logit_wts", vars), + multiple = FALSE + ) +}) + +output$ui_logit_test_var <- renderUI({ + req(available(input$logit_evar)) + vars <- input$logit_evar + if (!is.null(input$logit_int)) vars <- c(vars, input$logit_int) + selectizeInput( + inputId = "logit_test_var", label = i18n$t("Variables to test:"), + choices = vars, + selected = state_multiple("logit_test_var", vars, isolate(input$logit_test_var)), + multiple = TRUE, + options = list(placeholder = i18n$t("None"), plugins = list("remove_button")) + ) +}) + +## not clear why this is needed because state_multiple should handle this +observeEvent(is.null(input$logit_test_var), { + if ("logit_test_var" %in% names(input)) r_state$logit_test_var <<- NULL +}) + +output$ui_logit_show_interactions <- renderUI({ + # choices <- logit_show_interactions[1:max(min(3, length(input$logit_evar)), 1)] + vars <- input$logit_evar + isNum <- .get_class() %in% c("integer", "numeric", "ts") + if (any(vars %in% varnames()[isNum])) { + choices <- logit_show_interactions[1:3] + } else { + choices <- logit_show_interactions[1:max(min(3, length(input$logit_evar)), 1)] + } + radioButtons( + inputId = "logit_show_interactions", label = i18n$t("Interactions:"), + choices = choices, selected = state_init("logit_show_interactions"), + inline = TRUE + ) +}) + +output$ui_logit_show_interactions <- renderUI({ + vars <- input$logit_evar + isNum <- .get_class() %in% c("integer", "numeric", "ts") + if (any(vars %in% varnames()[isNum])) { + choices <- logit_show_interactions[1:3] + } else { + choices <- logit_show_interactions[1:max(min(3, length(input$logit_evar)), 1)] + } + radioButtons( + inputId = "logit_show_interactions", label = i18n$t("Interactions:"), + choices = choices, selected = state_init("logit_show_interactions"), + inline = TRUE + ) +}) + +output$ui_logit_int <- renderUI({ + choices <- character(0) + if (isolate("logit_show_interactions" %in% names(input)) && + is.empty(input$logit_show_interactions)) { + } else if (is.empty(input$logit_show_interactions)) { + return() + } else { + vars <- input$logit_evar + if (not_available(vars)) { + return() + } else { + ## quadratic and qubic terms + isNum <- .get_class() %in% c("integer", "numeric", "ts") + isNum <- intersect(vars, varnames()[isNum]) + if (length(isNum) > 0) { + choices <- qterms(isNum, input$logit_show_interactions) + } + ## list of interaction terms to show + if (length(vars) > 1) { + choices <- c(choices, iterms(vars, input$logit_show_interactions)) + } + if (length(choices) == 0) { + return() + } + } + } + + selectInput( + "logit_int", + label = NULL, + choices = choices, + selected = state_init("logit_int"), + multiple = TRUE, + size = min(8, length(choices)), + selectize = FALSE + ) +}) + +## reset prediction and plot settings when the dataset changes +observeEvent(input$dataset, { + updateSelectInput(session = session, inputId = "logit_predict", selected = "none") + updateSelectInput(session = session, inputId = "logit_plots", selected = "none") +}) + +output$ui_logit_predict_plot <- renderUI({ + predict_plot_controls("logit") +}) + +output$ui_logit_nrobs <- renderUI({ + nrobs <- nrow(.get_data()) + choices <- c(1000, 5000, 10000, -1) + names(choices) <- c(i18n$t("1,000"), i18n$t("5,000"), i18n$t("10,000"), i18n$t("All")) + choices <- choices[choices <= nrobs] + selectInput( + "logit_nrobs", i18n$t("Number of data points plotted:"), + choices = choices, + selected = state_single("logit_nrobs", choices, 1000) + ) +}) + +output$ui_logit_store_res_name <- renderUI({ + req(input$dataset) + textInput("logit_store_res_name", i18n$t("Store residuals:"), "", placeholder = i18n$t("Provide variable name")) +}) + +## add a spinning refresh icon if the model needs to be (re)estimated +run_refresh(logit_args, "logit", tabs = "tabs_logistic", label = i18n$t("Estimate model"), relabel = i18n$t("Re-estimate model")) + +output$ui_logistic <- renderUI({ + req(input$dataset) + tagList( + conditionalPanel( + condition = "input.tabs_logistic == 'Summary'", + wellPanel( + actionButton("logit_run", i18n$t("Estimate model"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ) + ), + wellPanel( + conditionalPanel( + condition = "input.tabs_logistic == 'Summary'", + uiOutput("ui_logit_rvar"), + uiOutput("ui_logit_lev"), + uiOutput("ui_logit_evar"), + uiOutput("ui_logit_wts"), + conditionalPanel( + condition = "input.logit_evar != null", + uiOutput("ui_logit_show_interactions"), + conditionalPanel( + condition = "input.logit_show_interactions != ''", + uiOutput("ui_logit_int") + ), + uiOutput("ui_logit_test_var"), + checkboxGroupInput( + "logit_check", NULL, logit_check, + selected = state_group("logit_check"), inline = TRUE + ), + checkboxGroupInput( + "logit_sum_check", NULL, logit_sum_check, + selected = state_group("logit_sum_check", ""), inline = TRUE + ) + ) + ), + conditionalPanel( + condition = "input.tabs_logistic == 'Predict'", + selectInput( + "logit_predict", + label = i18n$t("Prediction input type:"), logit_predict, + selected = state_single("logit_predict", logit_predict, "none") + ), + conditionalPanel( + "input.logit_predict == 'data' | input.logit_predict == 'datacmd'", + selectizeInput( + inputId = "logit_pred_data", label = i18n$t("Prediction data:"), + choices = c("None" = "", r_info[["datasetlist"]]), + selected = state_single("logit_pred_data", c("None" = "", r_info[["datasetlist"]])), + multiple = FALSE + ) + ), + conditionalPanel( + "input.logit_predict == 'cmd' | input.logit_predict == 'datacmd'", + returnTextAreaInput( + "logit_pred_cmd", i18n$t("Prediction command:"), + value = state_init("logit_pred_cmd", ""), + rows = 3, + placeholder = i18n$t("Type a formula to set values for model variables (e.g., class = '1st'; gender = 'male') and press return") + ) + ), + conditionalPanel( + condition = "input.logit_predict != 'none'", + checkboxInput("logit_pred_plot", i18n$t("Plot predictions"), state_init("logit_pred_plot", FALSE)), + conditionalPanel( + "input.logit_pred_plot == true", + uiOutput("ui_logit_predict_plot") + ) + ), + ## only show if full data is used for prediction + conditionalPanel( + "input.logit_predict == 'data' | input.logit_predict == 'datacmd'", + tags$table( + tags$td(textInput("logit_store_pred_name", i18n$t("Store predictions:"), state_init("logit_store_pred_name", "pred_logit"))), + tags$td(actionButton("logit_store_pred", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ) + ), + conditionalPanel( + condition = "input.tabs_logistic == 'Plot'", + selectInput( + "logit_plots", i18n$t("Plots:"), + choices = logit_plots, + selected = state_single("logit_plots", logit_plots) + ), + conditionalPanel( + condition = "input.logit_plots == 'coef' | input.logit_plots == 'pdp' | input.logit_plots == 'pred_plot'", + uiOutput("ui_logit_incl"), + conditionalPanel( + condition = "input.logit_plots == 'coef'", + checkboxInput("logit_intercept", i18n$t("Include intercept"), state_init("logit_intercept", FALSE)) + ), + conditionalPanel( + condition = "input.logit_plots == 'pdp' | input.logit_plots == 'pred_plot'", + uiOutput("ui_logit_incl_int") + ) + ), + # conditionalPanel( + # condition = "input.logit_plots == 'coef'", + # uiOutput("ui_logit_incl"), + # checkboxInput("logit_intercept", "Include intercept", state_init("logit_intercept", FALSE)) + # ), + conditionalPanel( + condition = "input.logit_plots == 'correlations' | + input.logit_plots == 'scatter'", + uiOutput("ui_logit_nrobs") + ) + ), + # Using && to check that input.logit_sum_check is not null (must be &&) + conditionalPanel( + condition = "(input.tabs_logistic == 'Summary' && input.logit_sum_check != undefined && (input.logit_sum_check.indexOf('confint') >= 0 || input.logit_sum_check.indexOf('odds') >= 0)) || + (input.tabs_logistic == 'Predict' && input.logit_predict != 'none') || + (input.tabs_logistic == 'Plot' && input.logit_plots == 'coef')", + sliderInput( + "logit_conf_lev", i18n$t("Confidence level:"), + min = 0.80, + max = 0.99, value = state_init("logit_conf_lev", .95), + step = 0.01 + ) + ), + conditionalPanel( + condition = "input.tabs_logistic == 'Summary'", + tags$table( + # tags$td(textInput("logit_store_res_name", "Store residuals:", state_init("logit_store_res_name", "residuals_logit"))), + tags$td(uiOutput("ui_logit_store_res_name")), + tags$td(actionButton("logit_store_res", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ) + ), + help_and_report( + modal_title = i18n$t("Logistic regression (GLM)"), fun_name = "logistic", + help_file = inclRmd(file.path(getOption("radiant.path.model"), "app/tools/help/logistic.Rmd")) + ) + ) +}) + +logit_plot <- reactive({ + if (logit_available() != "available") { + return() + } + if (is.empty(input$logit_plots, "none")) { + return() + } + + plot_height <- 500 + plot_width <- 650 + nr_vars <- length(input$logit_evar) + 1 + + if (input$logit_plots == "dist") { + plot_height <- (plot_height / 2) * ceiling(nr_vars / 2) + } else if (input$logit_plots == "fit") { + plot_width <- 1.5 * plot_width + } else if (input$logit_plots == "correlations") { + plot_height <- 150 * nr_vars + plot_width <- 150 * nr_vars + } else if (input$logit_plots == "scatter") { + plot_height <- 300 * nr_vars + } else if (input$logit_plots == "coef") { + incl <- paste0("^(", paste0(input$logit_incl, "[|]*", collapse = "|"), ")") + nr_coeff <- sum(grepl(incl, .logistic()$coeff$label)) + plot_height <- 300 + 20 * nr_coeff + } else if (input$logit_plots == "vip") { + plot_height <- max(500, 30 * nr_vars) + } else if (input$logit_plots %in% c("pdp", "pred_plot")) { + nr_vars <- length(input$logit_incl) + length(input$logit_incl_int) + plot_height <- max(250, ceiling(nr_vars / 2) * 250) + if (length(input$logit_incl_int) > 0) { + plot_width <- plot_width + min(2, length(input$logit_incl_int)) * 90 + } + } + list(plot_width = plot_width, plot_height = plot_height) +}) + +logit_plot_width <- function() { + logit_plot() %>% + (function(x) if (is.list(x)) x$plot_width else 650) +} + +logit_plot_height <- function() { + logit_plot() %>% + (function(x) if (is.list(x)) x$plot_height else 650) +} + +logit_pred_plot_height <- function() { + if (input$logit_pred_plot) 500 else 1 +} + +## output is called from the main radiant ui.R +output$logistic <- renderUI({ + register_print_output("summary_logistic", ".summary_logistic") + register_print_output("predict_logistic", ".predict_print_logistic") + register_plot_output( + "predict_plot_logistic", ".predict_plot_logistic", + height_fun = "logit_pred_plot_height" + ) + register_plot_output( + "plot_logistic", ".plot_logistic", + height_fun = "logit_plot_height", + width_fun = "logit_plot_width" + ) + + ## two separate tabs + logit_output_panels <- tabsetPanel( + id = "tabs_logistic", + tabPanel( + i18n$t("Summary"), value = "Summary", + download_link("dl_logit_coef"), br(), + verbatimTextOutput("summary_logistic") + ), + tabPanel( + i18n$t("Predict"), value = "Predict", + conditionalPanel( + "input.logit_pred_plot == true", + download_link("dlp_logit_pred"), + plotOutput("predict_plot_logistic", width = "100%", height = "100%") + ), + download_link("dl_logit_pred"), br(), + verbatimTextOutput("predict_logistic") + ), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_logistic"), + plotOutput("plot_logistic", width = "100%", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Model > Estimate"), + tool = i18n$t("Logistic regression (GLM)"), + tool_ui = "ui_logistic", + output_panels = logit_output_panels + ) +}) + +logit_available <- reactive({ + if (not_available(input$logit_rvar)) { + i18n$t("This analysis requires a response variable with two levels and one\nor more explanatory variables. If these variables are not available\nplease select another dataset.\n\n") %>% + suggest_data("titanic") + } else if (not_available(input$logit_evar)) { + i18n$t("Please select one or more explanatory variables.\n\n") %>% + suggest_data("titanic") + } else { + "available" + } +}) + +.logistic <- eventReactive(input$logit_run, { + req(input$logit_lev) + req(input$logit_wts == "None" || available(input$logit_wts)) + withProgress(message = i18n$t("Estimating model"), value = 1, { + lgi <- logit_inputs() + lgi$envir <- r_data + do.call(logistic, lgi) + }) +}) + +.summary_logistic <- reactive({ + if (not_pressed(input$logit_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } + if (logit_available() != "available") { + return(logit_available()) + } + do.call(summary, c(list(object = .logistic()), logit_sum_inputs())) +}) + +.predict_logistic <- reactive({ + if (not_pressed(input$logit_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } + if (logit_available() != "available") { + return(logit_available()) + } + if (is.empty(input$logit_predict, "none")) { + return(i18n$t("** Select prediction input **")) + } + if ((input$logit_predict == "data" || input$logit_predict == "datacmd") && is.empty(input$logit_pred_data)) { + return(i18n$t("** Select data for prediction **")) + } + if (input$logit_predict == "cmd" && is.empty(input$logit_pred_cmd)) { + return(i18n$t("** Enter prediction commands **")) + } + + withProgress(message = i18n$t("Generating predictions"), value = 1, { + lgi <- logit_pred_inputs() + lgi$object <- .logistic() + lgi$envir <- r_data + do.call(predict, lgi) + }) +}) + +.predict_print_logistic <- reactive({ + .predict_logistic() %>% + { + if (is.character(.)) cat(., "\n") else print(.) + } +}) + +.predict_plot_logistic <- reactive({ + req( + pressed(input$logit_run), input$logit_pred_plot, + available(input$logit_xvar), + !is.empty(input$logit_predict, "none") + ) + + withProgress(message = i18n$t("Generating prediction plot"), value = 1, { + do.call(plot, c(list(x = .predict_logistic()), logit_pred_plot_inputs())) + }) +}) + +# pred_pdp_ +# logit_available <- reactive({ +# if (not_available(input$logit_rvar)) { +# "This analysis requires a response variable with two levels and one\nor more explanatory variables. If these variables are not available\nplease select another dataset.\n\n" %>% +# suggest_data("titanic") +# } else if (not_available(input$logit_evar)) { +# "Please select one or more explanatory variables.\n\n" %>% +# suggest_data("titanic") +# } else { +# "available" +# } +# }) + + +check_for_pdp_pred_plots <- function(mod_type) { + if (input[[glue("{mod_type}_plots")]] %in% c("pdp", "pred_plot")) { + req(sum(input[[glue("{mod_type}_incl")]] %in% input[[glue("{mod_type}_evar")]]) == length(input[[glue("{mod_type}_incl")]])) + if (length(input[[glue("{mod_type}_incl_int")]]) > 0) { + incl_int <- unique(unlist(strsplit(input[[glue("{mod_type}_incl_int")]], ":"))) + req(sum(incl_int %in% input[[glue("{mod_type}_evar")]]) == length(incl_int)) + } + } +} + +.plot_logistic <- reactive({ + if (not_pressed(input$logit_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } else if (is.empty(input$logit_plots, "none")) { + return(i18n$t("Please select a logistic regression plot from the drop-down menu")) + } else if (logit_available() != "available") { + return(logit_available()) + } + + if (input$logit_plots %in% c("correlations", "scatter")) req(input$logit_nrobs) + check_for_pdp_pred_plots("logit") + + if (input$logit_plots == "correlations") { + capture_plot(do.call(plot, c(list(x = .logistic()), logit_plot_inputs()))) + } else { + withProgress(message = i18n$t("Generating plots"), value = 1, { + do.call(plot, c(list(x = .logistic()), logit_plot_inputs(), shiny = TRUE)) + }) + } +}) + +logistic_report <- function() { + outputs <- c("summary") + inp_out <- list("", "") + inp_out[[1]] <- clean_args(logit_sum_inputs(), logit_sum_args[-1]) + figs <- FALSE + if (!is.empty(input$logit_plots, "none")) { + inp <- check_plot_inputs(logit_plot_inputs()) + inp_out[[2]] <- clean_args(inp, logit_plot_args[-1]) + inp_out[[2]]$custom <- FALSE + outputs <- c(outputs, "plot") + figs <- TRUE + } + + if (!is.empty(input$logit_store_res_name)) { + fixed <- fix_names(input$logit_store_res_name) + updateTextInput(session, "logit_store_res_name", value = fixed) + xcmd <- paste0(input$dataset, " <- store(", input$dataset, ", result, name = \"", fixed, "\")\n") + } else { + xcmd <- "" + } + + if (!is.empty(input$logit_predict, "none") && + (!is.empty(input$logit_pred_data) || !is.empty(input$logit_pred_cmd))) { + pred_args <- clean_args(logit_pred_inputs(), logit_pred_args[-1]) + + if (!is.empty(pred_args$pred_cmd)) { + pred_args$pred_cmd <- strsplit(pred_args$pred_cmd, ";\\s*")[[1]] + } else { + pred_args$pred_cmd <- NULL + } + + if (!is.empty(pred_args$pred_data)) { + pred_args$pred_data <- as.symbol(pred_args$pred_data) + } else { + pred_args$pred_data <- NULL + } + + inp_out[[2 + figs]] <- pred_args + outputs <- c(outputs, "pred <- predict") + + xcmd <- paste0(xcmd, "print(pred, n = 10)") + if (input$logit_predict %in% c("data", "datacmd")) { + fixed <- unlist(strsplit(input$logit_store_pred_name, "(\\s*,\\s*|\\s*;\\s*)")) %>% + fix_names() %>% + deparse(., control = getOption("dctrl"), width.cutoff = 500L) + xcmd <- paste0( + xcmd, "\n", input$logit_pred_data, " <- store(", + input$logit_pred_data, ", pred, name = ", fixed, ")" + ) + } + # xcmd <- paste0(xcmd, "\n# write.csv(pred, file = \"~/logit_predictions.csv\", row.names = FALSE)") + + if (input$logit_pred_plot && !is.empty(input$logit_xvar)) { + inp_out[[3 + figs]] <- clean_args(logit_pred_plot_inputs(), logit_pred_plot_args[-1]) + inp_out[[3 + figs]]$result <- "pred" + outputs <- c(outputs, "plot") + figs <- TRUE + } + } + + update_report( + inp_main = clean_args(logit_inputs(), logit_args), + fun_name = "logistic", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = logit_plot_width(), + fig.height = logit_plot_height(), + xcmd = xcmd + ) +} + +observeEvent(input$logit_store_res, { + req(pressed(input$logit_run)) + robj <- .logistic() + if (!is.list(robj)) { + return() + } + fixed <- fix_names(input$logit_store_res_name) + updateTextInput(session, "logit_store_res_name", value = fixed) + withProgress( + message = i18n$t("Storing residuals"), value = 1, + r_data[[input$dataset]] <- store(r_data[[input$dataset]], robj, name = fixed) + ) +}) + +observeEvent(input$logit_store_pred, { + req(!is.empty(input$logit_pred_data), pressed(input$logit_run)) + pred <- .predict_logistic() + if (is.null(pred)) { + return() + } + fixed <- unlist(strsplit(input$logit_store_pred_name, "(\\s*,\\s*|\\s*;\\s*)")) %>% + fix_names() %>% + paste0(collapse = ", ") + updateTextInput(session, "logit_store_pred_name", value = fixed) + withProgress( + message = i18n$t("Storing predictions"), value = 1, + r_data[[input$logit_pred_data]] <- store( + r_data[[input$logit_pred_data]], pred, + name = fixed + ) + ) +}) + +dl_logit_coef <- function(path) { + if (pressed(input$logit_run)) { + write.coeff(.logistic(), file = path) + } else { + cat(i18n$t("No output available. Press the Estimate button to generate results"), file = path) + } +} + +download_handler( + id = "dl_logit_coef", + fun = dl_logit_coef, + fn = function() paste0(input$dataset, "_logit_coef"), + type = "csv", + caption = i18n$t("Save coefficients") +) + +dl_logit_pred <- function(path) { + if (pressed(input$logit_run)) { + write.csv(.predict_logistic(), file = path, row.names = FALSE) + } else { + cat(i18n$t("No output available. Press the Estimate button to generate results"), file = path) + } +} + +download_handler( + id = "dl_logit_pred", + fun = dl_logit_pred, + fn = function() paste0(input$dataset, "_logit_pred"), + type = "csv", + caption = i18n$t("Save predictions") +) + +download_handler( + id = "dlp_logit_pred", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_logit_pred"), + type = "png", + caption = i18n$t("Save logistic prediction plot"), + plot = .predict_plot_logistic, + width = plot_width, + height = logit_pred_plot_height +) + +download_handler( + id = "dlp_logistic", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_", input$logit_plots, "_logit"), + type = "png", + caption = i18n$t("Save logistic plot"), + plot = .plot_logistic, + width = logit_plot_width, + height = logit_plot_height +) + +observeEvent(input$logistic_report, { + r_info[["latest_screenshot"]] <- NULL + logistic_report() +}) + +observeEvent(input$logistic_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_logistic_screenshot") +}) + +observeEvent(input$modal_logistic_screenshot, { + logistic_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.model/inst/app/tools/analysis/mnl_ui.R b/radiant.model/inst/app/tools/analysis/mnl_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..c839e41088d9841e971cdd33a6cdc4c5f36adc09 --- /dev/null +++ b/radiant.model/inst/app/tools/analysis/mnl_ui.R @@ -0,0 +1,811 @@ +mnl_show_interactions <- c("", 2, 3) +names(mnl_show_interactions) <- c( + i18n$t("None"), + i18n$t("2-way"), + i18n$t("3-way") +) + +mnl_predict <- c("none", "data", "cmd", "datacmd") +names(mnl_predict) <- c( + i18n$t("None"), + i18n$t("Data"), + i18n$t("Command"), + i18n$t("Data & Command") +) + +mnl_check <- c("no_int", "standardize", "center", "stepwise-backward") +names(mnl_check) <- c( + i18n$t("Drop intercept"), + i18n$t("Standardize"), + i18n$t("Center"), + i18n$t("Stepwise") +) + +mnl_sum_check <- c("confint", "rrr", "confusion") +names(mnl_sum_check) <- c( + i18n$t("Confidence intervals"), + i18n$t("RRRs"), + i18n$t("Confusion") +) + +mnl_plots <- c("none", "dist", "correlations", "coef") +names(mnl_plots) <- c( + i18n$t("None"), + i18n$t("Distribution"), + i18n$t("Correlations"), + i18n$t("Coefficient (RRR) plot") +) + + +## list of function arguments +mnl_args <- as.list(formals(mnl)) + +## list of function inputs selected by user +mnl_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + mnl_args$data_filter <- if (input$show_filter) input$data_filter else "" + mnl_args$arr <- if (input$show_filter) input$data_arrange else "" + mnl_args$rows <- if (input$show_filter) input$data_rows else "" + mnl_args$dataset <- input$dataset + for (i in r_drop(names(mnl_args))) { + mnl_args[[i]] <- input[[paste0("mnl_", i)]] + } + mnl_args +}) + +mnl_sum_args <- as.list(if (exists("summary.mnl")) { + formals(summary.mnl) +} else { + formals(radiant.model:::summary.mnl) +}) + +## list of function inputs selected by user +mnl_sum_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(mnl_sum_args)) { + mnl_sum_args[[i]] <- input[[paste0("mnl_", i)]] + } + mnl_sum_args +}) + +mnl_plot_args <- as.list(if (exists("plot.mnl")) { + formals(plot.mnl) +} else { + formals(radiant.model:::plot.mnl) +}) + +## list of function inputs selected by user +mnl_plot_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(mnl_plot_args)) { + mnl_plot_args[[i]] <- input[[paste0("mnl_", i)]] + } + + # cat(paste0(names(mnl_plot_args), " ", mnl_plot_args, collapse = ", "), file = stderr(), "\n") + mnl_plot_args +}) + +mnl_pred_args <- as.list(if (exists("predict.mnl")) { + formals(predict.mnl) +} else { + formals(radiant.model:::predict.mnl) +}) + +# list of function inputs selected by user +mnl_pred_inputs <- reactive({ + # loop needed because reactive values don't allow single bracket indexing + for (i in names(mnl_pred_args)) { + mnl_pred_args[[i]] <- input[[paste0("mnl_", i)]] + } + + mnl_pred_args$pred_cmd <- mnl_pred_args$pred_data <- "" + if (input$mnl_predict == "cmd") { + mnl_pred_args$pred_cmd <- gsub("\\s{2,}", " ", input$mnl_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% + gsub("\"", "\'", .) + } else if (input$mnl_predict == "data") { + mnl_pred_args$pred_data <- input$mnl_pred_data + } else if (input$mnl_predict == "datacmd") { + mnl_pred_args$pred_cmd <- gsub("\\s{2,}", " ", input$mnl_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% + gsub("\"", "\'", .) + mnl_pred_args$pred_data <- input$mnl_pred_data + } + + mnl_pred_args +}) + +mnl_pred_plot_args <- as.list(if (exists("plot.model.predict")) { + formals(plot.model.predict) +} else { + formals(radiant.model:::plot.model.predict) +}) + + +# list of function inputs selected by user +mnl_pred_plot_inputs <- reactive({ + # loop needed because reactive values don't allow single bracket indexing + for (i in names(mnl_pred_plot_args)) { + mnl_pred_plot_args[[i]] <- input[[paste0("mnl_", i)]] + } + mnl_pred_plot_args +}) + +output$ui_mnl_rvar <- renderUI({ + withProgress(message = i18n$t("Acquiring variable information"), value = 1, { + vars <- groupable_vars() + }) + init <- isolate(input$mnl_rvar) + selectInput( + inputId = "mnl_rvar", label = i18n$t("Response variable:"), choices = vars, + selected = state_single("mnl_rvar", vars, init), multiple = FALSE + ) +}) + +output$ui_mnl_lev <- renderUI({ + req(available(input$mnl_rvar)) + rvar <- .get_data()[[input$mnl_rvar]] + levs <- unique(rvar) + if (length(levs) > 50) { + HTML(i18n$t("")) + } else { + selectInput( + inputId = "mnl_lev", label = i18n$t("Choose base level:"), + choices = levs, selected = state_init("mnl_lev") + ) + } +}) + +output$ui_mnl_evar <- renderUI({ + req(available(input$mnl_rvar)) + vars <- varnames() + if (length(vars) > 0 && input$mnl_rvar %in% vars) { + vars <- vars[-which(vars == input$mnl_rvar)] + } + + selectInput( + inputId = "mnl_evar", label = i18n$t("Explanatory variables:"), choices = vars, + selected = state_multiple("mnl_evar", vars, isolate(input$mnl_evar)), + multiple = TRUE, size = min(10, length(vars)), selectize = FALSE + ) +}) + +output$ui_mnl_wts <- renderUI({ + req(available(input$mnl_rvar), available(input$mnl_evar)) + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- varnames()[isNum] + if (length(vars) > 0 && any(vars %in% input$mnl_evar)) { + vars <- base::setdiff(vars, input$mnl_evar) + names(vars) <- varnames() %>% + (function(x) x[match(vars, x)]) %>% + names() + } + vars <- c("None", vars) + + selectInput( + inputId = "mnl_wts", label = i18n$t("Weights:"), choices = vars, + selected = state_single("mnl_wts", vars), + multiple = FALSE + ) +}) + +output$ui_mnl_test_var <- renderUI({ + req(available(input$mnl_evar)) + vars <- input$mnl_evar + if (!is.null(input$mnl_int)) vars <- c(vars, input$mnl_int) + selectizeInput( + inputId = "mnl_test_var", label = i18n$t("Variables to test:"), + choices = vars, + selected = state_multiple("mnl_test_var", vars, isolate(input$mnl_test_var)), + multiple = TRUE, + options = list(placeholder = i18n$t("None"), plugins = list("remove_button")) + ) +}) + +## not clear why this is needed because state_multiple should handle this +observeEvent(is.null(input$mnl_test_var), { + if ("mnl_test_var" %in% names(input)) r_state$mnl_test_var <<- NULL +}) + +output$ui_mnl_show_interactions <- renderUI({ + # choices <- mnl_show_interactions[1:max(min(3, length(input$mnl_evar)), 1)] + vars <- input$mnl_evar + isNum <- .get_class() %in% c("integer", "numeric", "ts") + if (any(vars %in% varnames()[isNum])) { + choices <- mnl_show_interactions[1:3] + } else { + choices <- mnl_show_interactions[1:max(min(3, length(input$mnl_evar)), 1)] + } + radioButtons( + inputId = "mnl_show_interactions", label = i18n$t("Interactions:"), + choices = choices, selected = state_init("mnl_show_interactions"), + inline = TRUE + ) +}) + +output$ui_mnl_show_interactions <- renderUI({ + vars <- input$mnl_evar + isNum <- .get_class() %in% c("integer", "numeric", "ts") + if (any(vars %in% varnames()[isNum])) { + choices <- mnl_show_interactions[1:3] + } else { + choices <- mnl_show_interactions[1:max(min(3, length(input$mnl_evar)), 1)] + } + radioButtons( + inputId = "mnl_show_interactions", label = i18n$t("Interactions:"), + choices = choices, selected = state_init("mnl_show_interactions"), + inline = TRUE + ) +}) + +output$ui_mnl_int <- renderUI({ + choices <- character(0) + if (isolate("mnl_show_interactions" %in% names(input)) && + is.empty(input$mnl_show_interactions)) { + } else if (is.empty(input$mnl_show_interactions)) { + return() + } else { + vars <- input$mnl_evar + if (not_available(vars)) { + return() + } else { + ## quadratic and qubic terms + isNum <- .get_class() %in% c("integer", "numeric", "ts") + isNum <- intersect(vars, varnames()[isNum]) + if (length(isNum) > 0) { + choices <- qterms(isNum, input$mnl_show_interactions) + } + ## list of interaction terms to show + if (length(vars) > 1) { + choices <- c(choices, iterms(vars, input$mnl_show_interactions)) + } + if (length(choices) == 0) { + return() + } + } + } + + selectInput( + "mnl_int", + label = NULL, + choices = choices, + selected = state_init("mnl_int"), + multiple = TRUE, + size = min(8, length(choices)), + selectize = FALSE + ) +}) + +## reset prediction and plot settings when the dataset changes +observeEvent(input$dataset, { + updateSelectInput(session = session, inputId = "mnl_predict", selected = "none") + updateSelectInput(session = session, inputId = "mnl_plots", selected = "none") +}) + +output$ui_mnl_store_pred_name <- renderUI({ + req(input$mnl_rvar) + levs <- .get_data()[[input$mnl_rvar]] %>% + as.factor() %>% + levels() %>% + fix_names() %>% + paste(collapse = ", ") + textInput( + "mnl_store_pred_name", + i18n$t("Store predictions:"), + state_init("mnl_store_pred_name", levs) + ) +}) + +output$ui_mnl_predict_plot <- renderUI({ + req(input$mnl_rvar) + var_colors <- ".class" %>% set_names(input$mnl_rvar) + predict_plot_controls("mnl", vars_color = var_colors, init_color = ".class") +}) + +output$ui_mnl_nrobs <- renderUI({ + nrobs <- nrow(.get_data()) + choices <- c("1,000" = 1000, "5,000" = 5000, "10,000" = 10000, "All" = -1) %>% + .[. < nrobs] + selectInput( + "mnl_nrobs", i18n$t("Number of data points plotted:"), + choices = choices, + selected = state_single("mnl_nrobs", choices, 1000) + ) +}) + +output$ui_mnl_store_res_name <- renderUI({ + req(input$dataset) + textInput("mnl_store_res_name", i18n$t("Store residuals:"), "", placeholder = i18n$t("Provide variable name")) +}) + +## add a spinning refresh icon if the model needs to be (re)estimated +run_refresh(reg_args, "mnl", tabs = "tabs_mnl", label = i18n$t("Estimate model"), relabel = i18n$t("Re-estimate model")) + +output$ui_mnl <- renderUI({ + req(input$dataset) + tagList( + conditionalPanel( + condition = "input.tabs_mnl == 'Summary'", + wellPanel( + actionButton("mnl_run", i18n$t("Estimate model"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ) + ), + wellPanel( + conditionalPanel( + condition = "input.tabs_mnl == 'Summary'", + uiOutput("ui_mnl_rvar"), + uiOutput("ui_mnl_lev"), + uiOutput("ui_mnl_evar"), + uiOutput("ui_mnl_wts"), + conditionalPanel( + condition = "input.mnl_evar != null", + uiOutput("ui_mnl_show_interactions"), + conditionalPanel( + condition = "input.mnl_show_interactions != ''", + uiOutput("ui_mnl_int") + ), + uiOutput("ui_mnl_test_var"), + checkboxGroupInput( + "mnl_check", NULL, mnl_check, + selected = state_group("mnl_check"), inline = TRUE + ), + checkboxGroupInput( + "mnl_sum_check", NULL, mnl_sum_check, + selected = state_group("mnl_sum_check", ""), inline = TRUE + ) + ) + ), + conditionalPanel( + condition = "input.tabs_mnl == 'Predict'", + selectInput( + "mnl_predict", + label = i18n$t("Prediction input type:"), mnl_predict, + selected = state_single("mnl_predict", mnl_predict, "none") + ), + conditionalPanel( + "input.mnl_predict == 'data' | input.mnl_predict == 'datacmd'", + selectizeInput( + inputId = "mnl_pred_data", label = i18n$t("Prediction data:"), + choices = c("None" = "", r_info[["datasetlist"]]), + selected = state_single("mnl_pred_data", c("None" = "", r_info[["datasetlist"]])), + multiple = FALSE + ) + ), + conditionalPanel( + "input.mnl_predict == 'cmd' | input.mnl_predict == 'datacmd'", + returnTextAreaInput( + "mnl_pred_cmd", i18n$t("Prediction command:"), + value = state_init("mnl_pred_cmd", ""), + rows = 3, + placeholder = i18n$t("Type a formula to set values for model variables (e.g., class = '1st'; gender = 'male') and press return") + ) + ), + conditionalPanel( + condition = "input.mnl_predict != 'none'", + checkboxInput("mnl_pred_plot", i18n$t("Plot predictions"), state_init("mnl_pred_plot", FALSE)), + conditionalPanel( + "input.mnl_pred_plot == true", + uiOutput("ui_mnl_predict_plot") + ) + ), + ## only show if full data is used for prediction + conditionalPanel( + "input.mnl_predict == 'data' | input.mnl_predict == 'datacmd'", + tags$table( + tags$td(uiOutput("ui_mnl_store_pred_name")), + tags$td(actionButton("mnl_store_pred", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ) + ), + conditionalPanel( + condition = "input.tabs_mnl == 'Plot'", + selectInput( + "mnl_plots", i18n$t("Plots:"), + choices = mnl_plots, + selected = state_single("mnl_plots", mnl_plots) + ), + conditionalPanel( + condition = "input.mnl_plots == 'coef'", + checkboxInput("mnl_intercept", i18n$t("Include intercept"), state_init("mnl_intercept", FALSE)) + ), + conditionalPanel( + condition = "input.mnl_plots == 'correlations' | + input.mnl_plots == 'scatter'", + uiOutput("ui_mnl_nrobs") + ) + ), + # Using && to check that input.mnl_sum_check is not null (must be &&) + conditionalPanel( + condition = "(input.tabs_mnl == 'Summary' && input.mnl_sum_check != undefined && (input.mnl_sum_check.indexOf('confint') >= 0 || input.mnl_sum_check.indexOf('rrr') >= 0)) || + (input.tabs_mnl == 'Plot' && input.mnl_plots == 'coef')", + sliderInput( + "mnl_conf_lev", i18n$t("Confidence level:"), + min = 0.80, + max = 0.99, value = state_init("mnl_conf_lev", .95), + step = 0.01 + ) + ), + conditionalPanel( + condition = "input.tabs_mnl == 'Summary'", + tags$table( + # tags$td(textInput("mnl_store_res_name", "Store residuals:", state_init("mnl_store_res_name", "residuals_logit"))), + tags$td(uiOutput("ui_mnl_store_res_name")), + tags$td(actionButton("mnl_store_res", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ) + ), + help_and_report( + modal_title = i18n$t("Multinomial logistic regression (MNL)"), fun_name = "mnl", + help_file = inclRmd(file.path(getOption("radiant.path.model"), "app/tools/help/mnl.Rmd")) + ) + ) +}) + +mnl_plot <- reactive({ + if (mnl_available() != "available") { + return() + } + if (is.empty(input$mnl_plots, "none")) { + return() + } + + plot_height <- 500 + plot_width <- 650 + nrVars <- length(input$mnl_evar) + 1 + + if (input$mnl_plots == "dist") plot_height <- (plot_height / 2) * ceiling(nrVars / 2) + if (input$mnl_plots == "fit") plot_width <- 1.5 * plot_width + if (input$mnl_plots == "correlations") { + plot_height <- 150 * nrVars + plot_width <- 150 * nrVars + } + if (input$mnl_plots == "scatter") plot_height <- 300 * nrVars + if (input$mnl_plots == "coef") { + nr_coeff <- broom::tidy(.mnl()$model) %>% nrow() + plot_height <- 300 + 10 * nr_coeff + } + + list(plot_width = plot_width, plot_height = plot_height) +}) + +mnl_plot_width <- function() { + mnl_plot() %>% + (function(x) if (is.list(x)) x$plot_width else 650) +} + +mnl_plot_height <- function() { + mnl_plot() %>% + (function(x) if (is.list(x)) x$plot_height else 500) +} + +mnl_pred_plot_height <- function() { + if (input$mnl_pred_plot) 500 else 1 +} + +## output is called from the main radiant ui.R +output$mnl <- renderUI({ + register_print_output("summary_mnl", ".summary_mnl") + register_print_output("predict_mnl", ".predict_print_mnl") + register_plot_output( + "predict_plot_mnl", ".predict_plot_mnl", + height_fun = "mnl_pred_plot_height" + ) + register_plot_output( + "plot_mnl", ".plot_mnl", + height_fun = "mnl_plot_height", + width_fun = "mnl_plot_width" + ) + + ## two separate tabs + mnl_output_panels <- tabsetPanel( + id = "tabs_mnl", + tabPanel( + i18n$t("Summary"), value = "Summary", + download_link("dl_mnl_coef"), br(), + verbatimTextOutput("summary_mnl") + ), + tabPanel( + i18n$t("Predict"), value = "Predict", + conditionalPanel( + "input.mnl_pred_plot == true", + download_link("dlp_mnl_pred"), + plotOutput("predict_plot_mnl", width = "100%", height = "100%") + ), + download_link("dl_mnl_pred"), br(), + verbatimTextOutput("predict_mnl") + ), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_mnl"), + plotOutput("plot_mnl", width = "100%", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Model > Estimate"), + tool = i18n$t("Multinomial logistic regression (MNL)"), + tool_ui = "ui_mnl", + output_panels = mnl_output_panels + ) +}) + +mnl_available <- reactive({ + if (not_available(input$mnl_rvar)) { + i18n$t("This analysis requires a response variable with two or more levels and one\nor more explanatory variables. If these variables are not available\nplease select another dataset.") %>% + suggest_data("titanic") + } else if (not_available(input$mnl_evar)) { + i18n$t("Please select one or more explanatory variables.") %>% + suggest_data("titanic") + } else { + "available" + } +}) + +.mnl <- eventReactive(input$mnl_run, { + req(input$mnl_lev) + req(input$mnl_wts == "None" || available(input$mnl_wts)) + withProgress(message = i18n$t("Estimating model"), value = 1, { + lgi <- mnl_inputs() + lgi$envir <- r_data + do.call(mnl, lgi) + }) +}) + +.summary_mnl <- reactive({ + if (not_pressed(input$mnl_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } + if (mnl_available() != "available") { + return(mnl_available()) + } + do.call(summary, c(list(object = .mnl()), mnl_sum_inputs())) +}) + +.predict_mnl <- reactive({ + if (not_pressed(input$mnl_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } + if (mnl_available() != "available") { + return(mnl_available()) + } + if (is.empty(input$mnl_predict, "none")) { + return(i18n$t("** Select prediction input **")) + } + if ((input$mnl_predict == "data" || input$mnl_predict == "datacmd") && is.empty(input$mnl_pred_data)) { + return(i18n$t("** Select data for prediction **")) + } + if (input$mnl_predict == "cmd" && is.empty(input$mnl_pred_cmd)) { + return(i18n$t("** Enter prediction commands **")) + } + + withProgress(message = i18n$t("Generating predictions"), value = 1, { + lgi <- mnl_pred_inputs() + lgi$object <- .mnl() + lgi$envir <- r_data + do.call(predict, lgi) + }) +}) + +.predict_print_mnl <- reactive({ + .predict_mnl() %>% + (function(x) if (is.character(x)) cat(x, "\n") else print(x)) +}) + +.predict_plot_mnl <- reactive({ + req( + pressed(input$mnl_run), input$mnl_pred_plot, + available(input$mnl_xvar), + !is.empty(input$mnl_predict, "none") + ) + + withProgress(message = i18n$t("Generating prediction plot"), value = 1, { + do.call(plot, c(list(x = .predict_mnl()), mnl_pred_plot_inputs())) + }) +}) + +.plot_mnl <- reactive({ + if (not_pressed(input$mnl_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } else if (is.empty(input$mnl_plots, "none")) { + return(i18n$t("Please select a mnl regression plot from the drop-down menu")) + } else if (mnl_available() != "available") { + return(mnl_available()) + } + + if (input$mnl_plots %in% c("correlations", "scatter")) req(input$mnl_nrobs) + if (input$mnl_plots == "correlations") { + capture_plot(do.call(plot, c(list(x = .mnl()), mnl_plot_inputs()))) + } else { + withProgress(message = i18n$t("Generating plots"), value = 1, { + do.call(plot, c(list(x = .mnl()), mnl_plot_inputs(), shiny = TRUE)) + }) + } +}) + +mnl_report <- function() { + outputs <- c("summary") + inp_out <- list("", "") + inp_out[[1]] <- clean_args(mnl_sum_inputs(), mnl_sum_args[-1]) + figs <- FALSE + if (!is.empty(input$mnl_plots, "none")) { + inp <- check_plot_inputs(mnl_plot_inputs()) + inp_out[[2]] <- clean_args(inp, mnl_plot_args[-1]) + inp_out[[2]]$custom <- FALSE + outputs <- c(outputs, "plot") + figs <- TRUE + } + + if (!is.empty(input$mnl_store_res_name)) { + name <- input$mnl_store_res_name + if (!is.empty(name)) { + name <- unlist(strsplit(name, "(\\s*,\\s*|\\s*;\\s*)")) %>% + fix_names() %T>% + updateTextInput(session, "mnl_store_res_name", value = .) %>% + deparse(control = getOption("dctrl"), width.cutoff = 500L) + } + xcmd <- paste0( + input$dataset, " <- store(", + input$dataset, ", result, name = ", name, ")\n" + ) + } else { + xcmd <- "" + } + + if (!is.empty(input$mnl_predict, "none") && + (!is.empty(input$mnl_pred_data) || !is.empty(input$mnl_pred_cmd))) { + pred_args <- clean_args(mnl_pred_inputs(), mnl_pred_args[-1]) + + if (!is.empty(pred_args$pred_cmd)) { + pred_args$pred_cmd <- strsplit(pred_args$pred_cmd, ";\\s*")[[1]] + } else { + pred_args$pred_cmd <- NULL + } + + if (!is.empty(pred_args$pred_data)) { + pred_args$pred_data <- as.symbol(pred_args$pred_data) + } else { + pred_args$pred_data <- NULL + } + + inp_out[[2 + figs]] <- pred_args + outputs <- c(outputs, "pred <- predict") + + xcmd <- paste0(xcmd, "print(pred, n = 10)") + if (input$mnl_predict %in% c("data", "datacmd")) { + name <- input$mnl_store_pred_name + if (!is.empty(name)) { + name <- unlist(strsplit(input$mnl_store_pred_name, "(\\s*,\\s*|\\s*;\\s*)")) %>% + fix_names() %>% + deparse(., control = getOption("dctrl"), width.cutoff = 500L) + } + xcmd <- paste0( + xcmd, "\n", input$mnl_pred_data, " <- store(", + input$mnl_pred_data, ", pred, name = ", name, ")" + ) + } + + # xcmd <- paste0(xcmd, "\n# write.csv(pred, file = \"~/mnl_predictions.csv\", row.names = FALSE)") + + if (input$mnl_pred_plot && !is.empty(input$mnl_xvar)) { + inp_out[[3 + figs]] <- clean_args(mnl_pred_plot_inputs(), mnl_pred_plot_args[-1]) + inp_out[[3 + figs]]$result <- "pred" + outputs <- c(outputs, "plot") + figs <- TRUE + } + } + + update_report( + inp_main = clean_args(mnl_inputs(), mnl_args), + fun_name = "mnl", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = mnl_plot_width(), + fig.height = mnl_plot_height(), + xcmd = xcmd + ) +} + +observeEvent(input$mnl_store_res, { + req(pressed(input$mnl_run)) + robj <- .mnl() + if (!is.list(robj)) { + return() + } + fixed <- unlist(strsplit(input$mnl_store_res_name, "(\\s*,\\s*|\\s*;\\s*)")) %>% + fix_names() %>% + paste0(collapse = ", ") + updateTextInput(session, "mnl_store_res_name", value = fixed) + withProgress( + message = i18n$t("Storing residuals"), value = 1, + r_data[[input$dataset]] <- store(r_data[[input$dataset]], robj, name = fixed) + ) +}) + +observeEvent(input$mnl_store_pred, { + req(!is.empty(input$mnl_pred_data), pressed(input$mnl_run)) + pred <- .predict_mnl() + if (is.null(pred)) { + return() + } + fixed <- unlist(strsplit(input$mnl_store_pred_name, "(\\s*,\\s*|\\s*;\\s*)")) %>% + fix_names() %>% + paste0(collapse = ", ") + updateTextInput(session, "mnl_store_pred_name", value = fixed) + withProgress( + message = i18n$t("Storing predictions"), value = 1, + r_data[[input$mnl_pred_data]] <- store( + r_data[[input$mnl_pred_data]], pred, + name = fixed + ) + ) +}) + +dl_mnl_coef <- function(path) { + if (pressed(input$mnl_run)) { + write.coeff(.mnl(), file = path) + } else { + cat(i18n$t("No output available. Press the Estimate button to generate results"), file = path) + } +} + +download_handler( + id = "dl_mnl_coef", + fun = dl_mnl_coef, + fn = function() paste0(input$dataset, "_mnl_coef"), + type = "csv", + caption = i18n$t("Save coefficients") +) + +dl_mnl_pred <- function(path) { + if (pressed(input$mnl_run)) { + write.csv(.predict_mnl(), file = path, row.names = FALSE) + } else { + cat(i18n$t("No output available. Press the Estimate button to generate results"), file = path) + } +} + +download_handler( + id = "dl_mnl_pred", + fun = dl_mnl_pred, + fn = function() paste0(input$dataset, "_mnl_pred"), + type = "csv", + caption = i18n$t("Save predictions") +) + +download_handler( + id = "dlp_mnl_pred", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_mnl_pred"), + type = "png", + caption = i18n$t("Save mnl prediction plot"), + plot = .predict_plot_mnl, + width = plot_width, + height = mnl_pred_plot_height +) + +download_handler( + id = "dlp_mnl", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_", input$mnl_plots, "_logit"), + type = "png", + caption = i18n$t("Save mnl plot"), + plot = .plot_logistic, + width = mnl_plot_width, + height = mnl_plot_height +) + +observeEvent(input$mnl_report, { + r_info[["latest_screenshot"]] <- NULL + mnl_report() +}) + +observeEvent(input$mnl_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_mnl_screenshot") +}) + +observeEvent(input$modal_mnl_screenshot, { + mnl_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.model/inst/app/tools/analysis/naivebayes_ui.R b/radiant.model/inst/app/tools/analysis/naivebayes_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..d1f33e462bd3238dfbd5cee80f90cb9e6d9706e6 --- /dev/null +++ b/radiant.model/inst/app/tools/analysis/naivebayes_ui.R @@ -0,0 +1,566 @@ +nb_plots <- c("none", "vimp", "correlations") +names(nb_plots) <- c( + i18n$t("None"), + i18n$t("Variable importance"), + i18n$t("Correlations") +) + +## list of function arguments +nb_args <- as.list(formals(nb)) + +## list of function inputs selected by user +nb_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + nb_args$data_filter <- if (input$show_filter) input$data_filter else "" + nb_args$arr <- if (input$show_filter) input$data_arrange else "" + nb_args$rows <- if (input$show_filter) input$data_rows else "" + nb_args$dataset <- input$dataset + for (i in r_drop(names(nb_args))) { + nb_args[[i]] <- input[[paste0("nb_", i)]] + } + nb_args +}) + +nb_plot_args <- as.list(if (exists("plot.nb")) { + formals(plot.nb) +} else { + formals(radiant.model:::plot.nb) +}) + +## list of function inputs selected by user +nb_plot_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(nb_plot_args)) { + nb_plot_args[[i]] <- input[[paste0("nb_", i)]] + } + nb_plot_args +}) + +nb_pred_args <- as.list(if (exists("predict.nb")) { + formals(predict.nb) +} else { + formals(radiant.model:::predict.nb) +}) + +## list of function inputs selected by user +nb_pred_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(nb_pred_args)) { + nb_pred_args[[i]] <- input[[paste0("nb_", i)]] + } + + nb_pred_args$pred_cmd <- nb_pred_args$pred_data <- "" + if (input$nb_predict == "cmd") { + nb_pred_args$pred_cmd <- gsub("\\s{2,}", " ", input$nb_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% + gsub("\"", "\'", .) + } else if (input$nb_predict == "data") { + nb_pred_args$pred_data <- input$nb_pred_data + } else if (input$nb_predict == "datacmd") { + nb_pred_args$pred_cmd <- gsub("\\s{2,}", " ", input$nb_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% + gsub("\"", "\'", .) + nb_pred_args$pred_data <- input$nb_pred_data + } + nb_pred_args +}) + +nb_pred_plot_args <- as.list(if (exists("plot.model.predict")) { + formals(plot.model.predict) +} else { + formals(radiant.model:::plot.model.predict) +}) + +## list of function inputs selected by user +nb_pred_plot_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(nb_pred_plot_args)) { + nb_pred_plot_args[[i]] <- input[[paste0("nb_", i)]] + } + nb_pred_plot_args +}) + +output$ui_nb_rvar <- renderUI({ + withProgress(message = i18n$t("Acquiring variable information"), value = 1, { + isFct <- "factor" == .get_class() + vars <- varnames()[isFct] + }) + + init <- if (is.empty(input$logit_rvar)) isolate(input$nb_rvar) else input$logit_rvar + selectInput( + inputId = "nb_rvar", label = i18n$t("Response variable:"), choices = vars, + selected = state_single("nb_rvar", vars, init), multiple = FALSE + ) +}) + +output$ui_nb_lev <- renderUI({ + req(available(input$nb_rvar)) + levs <- .get_data()[[input$nb_rvar]] %>% + as.factor() %>% + levels() %>% + c(i18n$t("All levels"), .) + + selectInput( + inputId = "nb_lev", label = i18n$t("Choose level:"), + choices = levs, selected = state_init("nb_lev", "") + ) +}) + +output$ui_nb_evar <- renderUI({ + req(available(input$nb_rvar)) + notVar <- .get_class() != "date" + vars <- varnames()[notVar] + if (length(vars) > 0 && input$nb_rvar %in% vars) { + vars <- vars[-which(vars == input$nb_rvar)] + } + + ## initialize to variables selected for logistic regression + init <- if (is.empty(input$logit_evar)) isolate(input$nb_evar) else input$logit_evar + selectInput( + inputId = "nb_evar", label = i18n$t("Explanatory variables:"), + choices = vars, + selected = state_multiple("nb_evar", vars, init), + multiple = TRUE, size = min(10, length(vars)), + selectize = FALSE + ) +}) + +## reset prediction settings when the dataset changes +observeEvent(input$dataset, { + updateSelectInput(session = session, inputId = "nb_predict", selected = "none") + updateSelectInput(session = session, inputId = "nb_plots", selected = "none") +}) + +output$ui_nb_store_pred_name <- renderUI({ + req(input$nb_rvar) + levs <- .get_data()[[input$nb_rvar]] %>% + as.factor() %>% + levels() %>% + fix_names() %>% + paste(collapse = ", ") + textInput( + "nb_store_pred_name", + i18n$t("Store predictions:"), + state_init("nb_store_pred_name", levs) + ) +}) + +output$ui_nb_predict_plot <- renderUI({ + req(input$nb_rvar) + var_colors <- ".class" %>% set_names(input$nb_rvar) + predict_plot_controls("nb", vars_color = var_colors, init_color = ".class") +}) + +## add a spinning refresh icon if the model needs to be (re)estimated +run_refresh(nb_args, "nb", tabs = "tabs_nb", label = i18n$t("Estimate model"), relabel = i18n$t("Re-estimate model")) + +output$ui_nb <- renderUI({ + req(input$dataset) + tagList( + conditionalPanel( + condition = "input.tabs_nb == 'Summary'", + wellPanel( + actionButton("nb_run", i18n$t("Estimate model"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ) + ), + wellPanel( + conditionalPanel( + condition = "input.tabs_nb == 'Summary'", + uiOutput("ui_nb_rvar"), + uiOutput("ui_nb_evar"), + numericInput("nb_laplace", label = i18n$t("Laplace:"), min = 0, value = state_init("nb_laplace", 0)) + ), + conditionalPanel( + condition = "input.tabs_nb == 'Predict'", + selectInput( + "nb_predict", + label = i18n$t("Prediction input type:"), reg_predict, + selected = state_single("nb_predict", reg_predict, "none") + ), + conditionalPanel( + "input.nb_predict == 'data' | input.nb_predict == 'datacmd'", + selectizeInput( + inputId = "nb_pred_data", label = i18n$t("Prediction data:"), + choices = c("None" = "", r_info[["datasetlist"]]), + selected = state_single("nb_pred_data", c("None" = "", r_info[["datasetlist"]])), + multiple = FALSE + ) + ), + conditionalPanel( + "input.nb_predict == 'cmd' | input.nb_predict == 'datacmd'", + returnTextAreaInput( + "nb_pred_cmd", i18n$t("Prediction command:"), + value = state_init("nb_pred_cmd", ""), + rows = 3, + placeholder = i18n$t("Type a formula to set values for model variables (e.g., carat = 1; cut = 'Ideal') and press return") + ) + ), + conditionalPanel( + condition = "input.nb_predict != 'none'", + checkboxInput("nb_pred_plot", i18n$t("Plot predictions"), state_init("nb_pred_plot", FALSE)), + conditionalPanel( + "input.nb_pred_plot == true", + uiOutput("ui_nb_predict_plot") + ) + ), + ## only show if full data is used for prediction + conditionalPanel( + "input.nb_predict == 'data' | input.nb_predict == 'datacmd'", + tags$table( + tags$td(uiOutput("ui_nb_store_pred_name")), + tags$td(actionButton("nb_store_pred", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ) + ), + conditionalPanel( + condition = "input.tabs_nb == 'Plot'", + selectInput( + "nb_plots", i18n$t("Plots:"), + choices = nb_plots, + selected = state_single("nb_plots", nb_plots) + ), + conditionalPanel( + condition = "input.nb_plots != 'none'", + uiOutput("ui_nb_lev") + ) + ) + ), + help_and_report( + modal_title = i18n$t("Naive Bayes"), + fun_name = "nb", + help_file = inclMD(file.path(getOption("radiant.path.model"), "app/tools/help/nb.md")) + ) + ) +}) + +nb_plot <- reactive({ + if (nb_available() != "available") { + return() + } + if (is.empty(input$nb_plots, "none")) { + return() + } + req(input$nb_lev) + + nb_res <- .nb() + if (is.character(nb_res)) { + return() + } + + n_vars <- length(nb_res$vars) + if (input$nb_plots == "correlations") { + plot_height <- 150 * n_vars + plot_width <- 150 * n_vars + } else { + if (input$nb_lev == i18n$t("All levels")) { + n_lev <- length(nb_res$lev) - 1 + } else { + n_lev <- 2 + } + plot_height <- 300 + 20 * n_vars * n_lev + plot_width <- 650 + } + list(plot_width = plot_width, plot_height = plot_height) +}) + +nb_plot_width <- function() { + nb_plot() %>% + { + if (is.list(.)) .$plot_width else 650 + } +} + +nb_plot_height <- function() { + nb_plot() %>% + { + if (is.list(.)) .$plot_height else 500 + } +} + +nb_pred_plot_height <- function() { + if (input$nb_pred_plot) 500 else 1 +} + +## output is called from the main radiant ui.R +output$nb <- renderUI({ + register_print_output("summary_nb", ".summary_nb") + register_print_output("predict_nb", ".predict_print_nb") + register_plot_output( + "predict_plot_nb", ".predict_plot_nb", + height_fun = "nb_pred_plot_height" + ) + register_plot_output( + "plot_nb", ".plot_nb", + height_fun = "nb_plot_height", + width_fun = "nb_plot_width" + ) + + ## two separate tabs + nb_output_panels <- tabsetPanel( + id = "tabs_nb", + tabPanel(i18n$t("Summary"), value = "Summary", verbatimTextOutput("summary_nb")), + tabPanel( + i18n$t("Predict"), value = "Predict", + conditionalPanel( + "input.nb_pred_plot == true", + download_link("dlp_nb_pred"), + plotOutput("predict_plot_nb", width = "100%", height = "100%") + ), + download_link("dl_nb_pred"), br(), + verbatimTextOutput("predict_nb") + ), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_nb"), + plotOutput("plot_nb", width = "100%", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Model > Estimate"), + tool = i18n$t("Naive Bayes"), + tool_ui = "ui_nb", + output_panels = nb_output_panels + ) +}) + +nb_available <- reactive({ + if (not_available(input$nb_rvar)) { + return(i18n$t("This analysis requires a response variable with two levels and one\nor more explanatory variables. If these variables are not available\nplease select another dataset.") %>% suggest_data("titanic")) + } else if (not_available(input$nb_evar)) { + return(i18n$t("Please select one or more explanatory variables.") %>% suggest_data("titanic")) + } else { + "available" + } +}) + +.nb <- eventReactive(input$nb_run, { + withProgress(message = i18n$t("Estimating model"), value = 1, { + nbi <- nb_inputs() + nbi$envir <- r_data + do.call(nb, nbi) + }) +}) + +.summary_nb <- reactive({ + if (not_pressed(input$nb_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } + if (nb_available() != "available") { + return(nb_available()) + } + summary(.nb()) +}) + +.predict_nb <- reactive({ + if (nb_available() != "available") { + return(nb_available()) + } + if (not_pressed(input$nb_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } + if (is.empty(input$nb_predict, "none")) { + return(i18n$t("** Select prediction input **")) + } + + if ((input$nb_predict == "data" || input$nb_predict == "datacmd") && is.empty(input$nb_pred_data)) { + return(i18n$t("** Select data for prediction **")) + } + if (input$nb_predict == "cmd" && is.empty(input$nb_pred_cmd)) { + return(i18n$t("** Enter prediction commands **")) + } + + withProgress(message = i18n$t("Generating predictions"), value = 1, { + nbi <- nb_pred_inputs() + nbi$object <- .nb() + nbi$envir <- r_data + do.call(predict, nbi) + }) +}) + +.predict_print_nb <- reactive({ + .predict_nb() %>% + { + if (is.character(.)) cat(., "\n") else print(.) + } +}) + +.predict_plot_nb <- reactive({ + req( + pressed(input$nb_run), input$nb_pred_plot, + available(input$nb_xvar), + !is.empty(input$nb_predict, "none") + ) + + ## needs more testing ... + # if (nb_available() != "available") return(nb_available()) + # # req(input$nb_pred_plot, available(input$nb_xvar)) + # if (not_pressed(input$nb_run)) return(invisible()) + # if (is.empty(input$nb_predict, "none")) return(invisible()) + # if ((input$nb_predict == "data" || input$nb_predict == "datacmd") && is.empty(input$nb_pred_data)) { + # return(invisible()) + # } + # if (input$nb_predict == "cmd" && is.empty(input$nb_pred_cmd)) { + # return(invisible()) + # } + + withProgress(message = i18n$t("Generating prediction plot"), value = 1, { + do.call(plot, c(list(x = .predict_nb()), nb_pred_plot_inputs())) + }) +}) + +.plot_nb <- reactive({ + if (not_pressed(input$nb_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } else if (is.empty(input$nb_plots, "none")) { + return(i18n$t("Please select a naive Bayes plot from the drop-down menu")) + } else if (nb_available() != "available") { + return(nb_available()) + } + req(input$nb_lev) + if (input$nb_plots == "correlations") { + capture_plot(do.call(plot, c(list(x = .nb()), nb_plot_inputs()))) + } else { + withProgress(message = i18n$t("Generating plots"), value = 1, { + do.call(plot, c(list(x = .nb()), nb_plot_inputs(), shiny = TRUE)) + }) + } +}) + +observeEvent(input$nb_store_pred, { + req(!is.empty(input$nb_pred_data), pressed(input$nb_run)) + pred <- .predict_nb() + if (is.null(pred)) { + return() + } + fixed <- unlist(strsplit(input$nb_store_pred_name, "(\\s*,\\s*|\\s*;\\s*)")) %>% + fix_names() %>% + paste0(collapse = ", ") + updateTextInput(session, "nb_store_pred_name", value = fixed) + withProgress( + message = i18n$t("Storing predictions"), value = 1, + r_data[[input$nb_pred_data]] <- store( + r_data[[input$nb_pred_data]], pred, + name = fixed + ) + ) +}) + +nb_report <- function() { + if (is.empty(input$nb_evar)) { + return(invisible()) + } + outputs <- c("summary") + inp_out <- list("", "") + figs <- FALSE + if (!is.empty(input$nb_plots, "none")) { + inp <- check_plot_inputs(nb_plot_inputs()) + inp_out[[2]] <- clean_args(inp, nb_plot_args[-1]) + outputs <- c(outputs, "plot") + figs <- TRUE + } + xcmd <- "" + if (!is.empty(input$nb_predict, "none") && + (!is.empty(input$nb_pred_data) || !is.empty(input$nb_pred_cmd))) { + pred_args <- clean_args(nb_pred_inputs(), nb_pred_args[-1]) + + if (!is.empty(pred_args$pred_cmd)) { + pred_args$pred_cmd <- strsplit(pred_args$pred_cmd, ";\\s*")[[1]] + } else { + pred_args$pred_cmd <- NULL + } + + if (!is.empty(pred_args$pred_data)) { + pred_args$pred_data <- as.symbol(pred_args$pred_data) + } else { + pred_args$pred_data <- NULL + } + + inp_out[[2 + figs]] <- pred_args + outputs <- c(outputs, "pred <- predict") + xcmd <- paste0("print(pred, n = 10)") + if (input$nb_predict %in% c("data", "datacmd")) { + name <- input$nb_store_pred_name + if (!is.empty(name)) { + name <- unlist(strsplit(input$nb_store_pred_name, "(\\s*,\\s*|\\s*;\\s*)")) %>% + fix_names() %>% + deparse(., control = getOption("dctrl"), width.cutoff = 500L) + } + xcmd <- paste0( + xcmd, "\n", input$nb_pred_data, " <- store(", + input$nb_pred_data, ", pred, name = ", name, ")" + ) + } + + if (input$nb_pred_plot && !is.empty(input$nb_xvar)) { + inp_out[[3 + figs]] <- clean_args(nb_pred_plot_inputs(), nb_pred_plot_args[-1]) + inp_out[[3 + figs]]$result <- "pred" + outputs <- c(outputs, "plot") + figs <- TRUE + } + } + + update_report( + inp_main = clean_args(nb_inputs(), nb_args), + fun_name = "nb", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = nb_plot_width(), + fig.height = nb_plot_height(), + xcmd = xcmd + ) +} + +dl_nb_pred <- function(path) { + if (pressed(input$nb_run)) { + write.csv(.predict_nb(), file = path, row.names = FALSE) + } else { + cat(i18n$t("No output available. Press the Estimate button to generate results"), file = path) + } +} + +download_handler( + id = "dl_nb_pred", + fun = dl_nb_pred, + fn = function() paste0(input$dataset, "_nb_pred"), + type = "csv", + caption = i18n$t("Save predictions") +) + +download_handler( + id = "dlp_nb_pred", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_nb_pred"), + type = "png", + caption = i18n$t("Save naive Bayes prediction plot"), + plot = .predict_plot_nb, + width = plot_width, + height = nb_pred_plot_height +) + +download_handler( + id = "dlp_nb", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_nb"), + type = "png", + caption = i18n$t("Save naive Bayes plot"), + plot = .plot_nb, + width = nb_plot_width, + height = nb_plot_height +) + +observeEvent(input$nb_report, { + r_info[["latest_screenshot"]] <- NULL + nb_report() +}) + +observeEvent(input$nb_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_nb_screenshot") +}) + +observeEvent(input$modal_nb_screenshot, { + nb_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.model/inst/app/tools/analysis/nn_ui.R b/radiant.model/inst/app/tools/analysis/nn_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..42290fe4704907574ab0c040f2a50879ad493c0c --- /dev/null +++ b/radiant.model/inst/app/tools/analysis/nn_ui.R @@ -0,0 +1,729 @@ +nn_plots <- c( + "none", "net", "vip", "pred_plot", "pdp", "olden", "garson", "dashboard" +) +names(nn_plots) <- c( + i18n$t("None"), + i18n$t("Network"), + i18n$t("Permutation Importance"), + i18n$t("Prediction plots"), + i18n$t("Partial Dependence"), + i18n$t("Olden"), + i18n$t("Garson"), + i18n$t("Dashboard") +) + +## list of function arguments +nn_args <- as.list(formals(nn)) + +## list of function inputs selected by user +nn_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + nn_args$data_filter <- if (input$show_filter) input$data_filter else "" + nn_args$arr <- if (input$show_filter) input$data_arrange else "" + nn_args$rows <- if (input$show_filter) input$data_rows else "" + nn_args$dataset <- input$dataset + for (i in r_drop(names(nn_args))) { + nn_args[[i]] <- input[[paste0("nn_", i)]] + } + nn_args +}) + +nn_pred_args <- as.list(if (exists("predict.nn")) { + formals(predict.nn) +} else { + formals(radiant.model:::predict.nn) +}) + +# list of function inputs selected by user +nn_pred_inputs <- reactive({ + # loop needed because reactive values don't allow single bracket indexing + for (i in names(nn_pred_args)) { + nn_pred_args[[i]] <- input[[paste0("nn_", i)]] + } + + nn_pred_args$pred_cmd <- nn_pred_args$pred_data <- "" + if (input$nn_predict == "cmd") { + nn_pred_args$pred_cmd <- gsub("\\s{2,}", " ", input$nn_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% + gsub("\"", "\'", .) + } else if (input$nn_predict == "data") { + nn_pred_args$pred_data <- input$nn_pred_data + } else if (input$nn_predict == "datacmd") { + nn_pred_args$pred_cmd <- gsub("\\s{2,}", " ", input$nn_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% + gsub("\"", "\'", .) + nn_pred_args$pred_data <- input$nn_pred_data + } + nn_pred_args +}) + +nn_plot_args <- as.list(if (exists("plot.nn")) { + formals(plot.nn) +} else { + formals(radiant.model:::plot.nn) +}) + +## list of function inputs selected by user +nn_plot_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(nn_plot_args)) { + nn_plot_args[[i]] <- input[[paste0("nn_", i)]] + } + nn_plot_args +}) + +nn_pred_plot_args <- as.list(if (exists("plot.model.predict")) { + formals(plot.model.predict) +} else { + formals(radiant.model:::plot.model.predict) +}) + +# list of function inputs selected by user +nn_pred_plot_inputs <- reactive({ + # loop needed because reactive values don't allow single bracket indexing + for (i in names(nn_pred_plot_args)) { + nn_pred_plot_args[[i]] <- input[[paste0("nn_", i)]] + } + nn_pred_plot_args +}) + +output$ui_nn_rvar <- renderUI({ + req(input$nn_type) + + withProgress(message = i18n$t("Acquiring variable information"), value = 1, { + if (input$nn_type == "classification") { + vars <- two_level_vars() + } else { + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- varnames()[isNum] + } + }) + + init <- if (input$nn_type == "classification") { + if (is.empty(input$logit_rvar)) isolate(input$nn_rvar) else input$logit_rvar + } else { + if (is.empty(input$reg_rvar)) isolate(input$nn_rvar) else input$reg_rvar + } + + selectInput( + inputId = "nn_rvar", + label = i18n$t("Response variable:"), + choices = vars, + selected = state_single("nn_rvar", vars, init), + multiple = FALSE + ) +}) + +output$ui_nn_lev <- renderUI({ + req(input$nn_type == "classification") + req(available(input$nn_rvar)) + levs <- .get_data()[[input$nn_rvar]] %>% + as_factor() %>% + levels() + + init <- if (is.empty(input$logit_lev)) isolate(input$nn_lev) else input$logit_lev + selectInput( + inputId = "nn_lev", label = i18n$t("Choose level:"), + choices = levs, + selected = state_init("nn_lev", init) + ) +}) + +output$ui_nn_evar <- renderUI({ + if (not_available(input$nn_rvar)) { + return() + } + vars <- varnames() + if (length(vars) > 0) { + vars <- vars[-which(vars == input$nn_rvar)] + } + + init <- if (input$nn_type == "classification") { + # input$logit_evar + if (is.empty(input$logit_evar)) isolate(input$nn_evar) else input$logit_evar + } else { + # input$reg_evar + if (is.empty(input$reg_evar)) isolate(input$nn_evar) else input$reg_evar + } + + selectInput( + inputId = "nn_evar", + label = i18n$t("Explanatory variables:"), + choices = vars, + selected = state_multiple("nn_evar", vars, init), + multiple = TRUE, + size = min(10, length(vars)), + selectize = FALSE + ) +}) + +# function calls generate UI elements +output_incl("nn") +output_incl_int("nn") + +output$ui_nn_wts <- renderUI({ + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- varnames()[isNum] + if (length(vars) > 0 && any(vars %in% input$nn_evar)) { + vars <- base::setdiff(vars, input$nn_evar) + names(vars) <- varnames() %>% + { + .[match(vars, .)] + } %>% + names() + } + vars <- c("None", vars) + + selectInput( + inputId = "nn_wts", label = i18n$t("Weights:"), choices = vars, + selected = state_single("nn_wts", vars), + multiple = FALSE + ) +}) + +output$ui_nn_store_pred_name <- renderUI({ + init <- state_init("nn_store_pred_name", "pred_nn") %>% + sub("\\d{1,}$", "", .) %>% + paste0(., ifelse(is.empty(input$nn_size), "", input$nn_size)) + textInput( + "nn_store_pred_name", + i18n$t("Store predictions:"), + init + ) +}) + +output$ui_nn_store_res_name <- renderUI({ + req(input$dataset) + textInput("nn_store_res_name", i18n$t("Store residuals:"), "", placeholder = i18n$t("Provide variable name")) +}) + +## reset prediction and plot settings when the dataset changes +observeEvent(input$dataset, { + updateSelectInput(session = session, inputId = "nn_predict", selected = "none") + updateSelectInput(session = session, inputId = "nn_plots", selected = "none") +}) + +## reset prediction settings when the model type changes +observeEvent(input$nn_type, { + updateSelectInput(session = session, inputId = "nn_predict", selected = "none") + updateSelectInput(session = session, inputId = "nn_plots", selected = "none") +}) + +output$ui_nn_predict_plot <- renderUI({ + predict_plot_controls("nn") +}) + +output$ui_nn_plots <- renderUI({ + req(input$nn_type) + if (input$nn_type != "regression") { + nn_plots <- head(nn_plots, -1) + } + selectInput( + "nn_plots", i18n$t("Plots:"), + choices = nn_plots, + selected = state_single("nn_plots", nn_plots) + ) +}) + +output$ui_nn_nrobs <- renderUI({ + nrobs <- nrow(.get_data()) + choices <- c("1,000" = 1000, "5,000" = 5000, "10,000" = 10000, "All" = -1) %>% + .[. < nrobs] + selectInput( + "nn_nrobs", i18n$t("Number of data points plotted:"), + choices = choices, + selected = state_single("nn_nrobs", choices, 1000) + ) +}) + +## add a spinning refresh icon if the model needs to be (re)estimated +run_refresh(nn_args, "nn", tabs = "tabs_nn", label = i18n$t("Estimate model"), relabel = i18n$t("Re-estimate model")) + +output$ui_nn <- renderUI({ + req(input$dataset) + tagList( + conditionalPanel( + condition = "input.tabs_nn == 'Summary'", + wellPanel( + actionButton("nn_run", i18n$t("Estimate model"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ) + ), + wellPanel( + conditionalPanel( + condition = "input.tabs_nn == 'Summary'", + radioButtons( + "nn_type", + label = NULL, + choices = c("classification", "regression") %>% + { names(.) <- c(i18n$t("Classification"), i18n$t("Regression")); . }, + inline = TRUE + ), + uiOutput("ui_nn_rvar"), + uiOutput("ui_nn_lev"), + uiOutput("ui_nn_evar"), + uiOutput("ui_nn_wts"), + tags$table( + tags$td(numericInput( + "nn_size", + label = i18n$t("Size:"), min = 1, max = 20, + value = state_init("nn_size", 1), width = "77px" + )), + tags$td(numericInput( + "nn_decay", + label = i18n$t("Decay:"), min = 0, max = 1, + step = .1, value = state_init("nn_decay", .5), width = "77px" + )), + tags$td(numericInput( + "nn_seed", + label = i18n$t("Seed:"), + value = state_init("nn_seed", 1234), width = "77px" + )), + width = "100%" + ) + ), + conditionalPanel( + condition = "input.tabs_nn == 'Predict'", + selectInput( + "nn_predict", + label = i18n$t("Prediction input type:"), reg_predict, + selected = state_single("nn_predict", reg_predict, "none") + ), + conditionalPanel( + "input.nn_predict == 'data' | input.nn_predict == 'datacmd'", + selectizeInput( + inputId = "nn_pred_data", label = i18n$t("Prediction data:"), + choices = c("None" = "", r_info[["datasetlist"]]), + selected = state_single("nn_pred_data", c("None" = "", r_info[["datasetlist"]])), + multiple = FALSE + ) + ), + conditionalPanel( + "input.nn_predict == 'cmd' | input.nn_predict == 'datacmd'", + returnTextAreaInput( + "nn_pred_cmd", i18n$t("Prediction command:"), + value = state_init("nn_pred_cmd", ""), + rows = 3, + placeholder = i18n$t("Type a formula to set values for model variables (e.g., carat = 1; cut = 'Ideal') and press return") + ) + ), + conditionalPanel( + condition = "input.nn_predict != 'none'", + checkboxInput("nn_pred_plot", i18n$t("Plot predictions"), state_init("nn_pred_plot", FALSE)), + conditionalPanel( + "input.nn_pred_plot == true", + uiOutput("ui_nn_predict_plot") + ) + ), + ## only show if full data is used for prediction + conditionalPanel( + "input.nn_predict == 'data' | input.nn_predict == 'datacmd'", + tags$table( + tags$td(uiOutput("ui_nn_store_pred_name")), + tags$td(actionButton("nn_store_pred", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ) + ), + conditionalPanel( + condition = "input.tabs_nn == 'Plot'", + uiOutput("ui_nn_plots"), + conditionalPanel( + condition = "input.nn_plots == 'pdp' | input.nn_plots == 'pred_plot'", + uiOutput("ui_nn_incl"), + uiOutput("ui_nn_incl_int") + ), + conditionalPanel( + condition = "input.nn_plots == 'dashboard'", + uiOutput("ui_nn_nrobs") + ) + ), + conditionalPanel( + condition = "input.tabs_nn == 'Summary'", + tags$table( + tags$td(uiOutput("ui_nn_store_res_name")), + tags$td(actionButton("nn_store_res", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ) + ), + help_and_report( + modal_title = i18n$t("Neural Network"), + fun_name = "nn", + help_file = inclMD(file.path(getOption("radiant.path.model"), "app/tools/help/nn.md")) + ) + ) +}) + +nn_plot <- reactive({ + if (nn_available() != "available") { + return() + } + if (is.empty(input$nn_plots, "none")) { + return() + } + res <- .nn() + if (is.character(res)) { + return() + } + plot_width <- 650 + if ("dashboard" %in% input$nn_plots) { + plot_height <- 750 + } else if (input$nn_plots %in% c("pdp", "pred_plot")) { + nr_vars <- length(input$nn_incl) + length(input$nn_incl_int) + plot_height <- max(250, ceiling(nr_vars / 2) * 250) + if (length(input$nn_incl_int) > 0) { + plot_width <- plot_width + min(2, length(input$nn_incl_int)) * 90 + } + } else { + mlt <- if ("net" %in% input$nn_plots) 45 else 30 + plot_height <- max(500, length(res$model$coefnames) * mlt) + } + + list(plot_width = plot_width, plot_height = plot_height) +}) + +nn_plot_width <- function() { + nn_plot() %>% + (function(x) if (is.list(x)) x$plot_width else 650) +} + +nn_plot_height <- function() { + nn_plot() %>% + (function(x) if (is.list(x)) x$plot_height else 500) +} + +nn_pred_plot_height <- function() { + if (input$nn_pred_plot) 500 else 1 +} + +## output is called from the main radiant ui.R +output$nn <- renderUI({ + register_print_output("summary_nn", ".summary_nn") + register_print_output("predict_nn", ".predict_print_nn") + register_plot_output( + "predict_plot_nn", ".predict_plot_nn", + height_fun = "nn_pred_plot_height" + ) + register_plot_output( + "plot_nn", ".plot_nn", + height_fun = "nn_plot_height", + width_fun = "nn_plot_width" + ) + + ## three separate tabs + nn_output_panels <- tabsetPanel( + id = "tabs_nn", + tabPanel( + i18n$t("Summary"), value = "Summary", + verbatimTextOutput("summary_nn") + ), + tabPanel( + i18n$t("Predict"), value = "Predict", + conditionalPanel( + "input.nn_pred_plot == true", + download_link("dlp_nn_pred"), + plotOutput("predict_plot_nn", width = "100%", height = "100%") + ), + download_link("dl_nn_pred"), br(), + verbatimTextOutput("predict_nn") + ), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_nn"), + plotOutput("plot_nn", width = "100%", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Model > Estimate"), + tool = i18n$t("Neural Network"), + tool_ui = "ui_nn", + output_panels = nn_output_panels + ) +}) + +nn_available <- reactive({ + req(input$nn_type) + if (not_available(input$nn_rvar)) { + if (input$nn_type == "classification") { + i18n$t("This analysis requires a response variable with two levels and one\nor more explanatory variables. If these variables are not available\nplease select another dataset.\n\n") %>% + suggest_data("titanic") + } else { + i18n$t("This analysis requires a response variable of type integer\nor numeric and one or more explanatory variables.\nIf these variables are not available please select another dataset.\n\n") %>% + suggest_data("diamonds") + } + } else if (not_available(input$nn_evar)) { + if (input$nn_type == "classification") { + i18n$t("Please select one or more explanatory variables.") %>% + suggest_data("titanic") + } else { + i18n$t("Please select one or more explanatory variables.") %>% + suggest_data("diamonds") + } + } else { + "available" + } +}) + +.nn <- eventReactive(input$nn_run, { + nni <- nn_inputs() + nni$envir <- r_data + withProgress( + message = i18n$t("Estimating model"), value = 1, + do.call(nn, nni) + ) +}) + +.summary_nn <- reactive({ + if (not_pressed(input$nn_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } + if (nn_available() != "available") { + return(nn_available()) + } + summary(.nn()) +}) + +.predict_nn <- reactive({ + if (not_pressed(input$nn_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } + if (nn_available() != "available") { + return(nn_available()) + } + if (is.empty(input$nn_predict, "none")) { + return(i18n$t("** Select prediction input **")) + } + + if ((input$nn_predict == "data" || input$nn_predict == "datacmd") && is.empty(input$nn_pred_data)) { + return(i18n$t("** Select data for prediction **")) + } + if (input$nn_predict == "cmd" && is.empty(input$nn_pred_cmd)) { + return(i18n$t("** Enter prediction commands **")) + } + + withProgress(message = i18n$t("Generating predictions"), value = 1, { + nni <- nn_pred_inputs() + nni$object <- .nn() + nni$envir <- r_data + do.call(predict, nni) + }) +}) + +.predict_print_nn <- reactive({ + .predict_nn() %>% + { + if (is.character(.)) cat(., "\n") else print(.) + } +}) + +.predict_plot_nn <- reactive({ + req( + pressed(input$nn_run), input$nn_pred_plot, + available(input$nn_xvar), + !is.empty(input$nn_predict, "none") + ) + + # if (not_pressed(input$nn_run)) return(invisible()) + # if (nn_available() != "available") return(nn_available()) + # req(input$nn_pred_plot, available(input$nn_xvar)) + # if (is.empty(input$nn_predict, "none")) return(invisible()) + # if ((input$nn_predict == "data" || input$nn_predict == "datacmd") && is.empty(input$nn_pred_data)) { + # return(invisible()) + # } + # if (input$nn_predict == "cmd" && is.empty(input$nn_pred_cmd)) { + # return(invisible()) + # } + + withProgress(message = i18n$t("Generating prediction plot"), value = 1, { + do.call(plot, c(list(x = .predict_nn()), nn_pred_plot_inputs())) + }) +}) + +.plot_nn <- reactive({ + if (not_pressed(input$nn_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } else if (nn_available() != "available") { + return(nn_available()) + } + req(input$nn_size) + if (is.empty(input$nn_plots, "none")) { + return(i18n$t("Please select a neural network plot from the drop-down menu")) + } + pinp <- nn_plot_inputs() + pinp$shiny <- TRUE + pinp$size <- NULL + if (input$nn_plots == "dashboard") { + req(input$nn_nrobs) + } + + if (input$nn_plots == "net") { + .nn() %>% + (function(x) if (is.character(x)) invisible() else capture_plot(do.call(plot, c(list(x = x), pinp)))) + } else { + withProgress(message = i18n$t("Generating plots"), value = 1, { + do.call(plot, c(list(x = .nn()), pinp)) + }) + } +}) + +observeEvent(input$nn_store_res, { + req(pressed(input$nn_run)) + robj <- .nn() + if (!is.list(robj)) { + return() + } + fixed <- fix_names(input$nn_store_res_name) + updateTextInput(session, "nn_store_res_name", value = fixed) + withProgress( + message = i18n$t("Storing residuals"), value = 1, + r_data[[input$dataset]] <- store(r_data[[input$dataset]], robj, name = fixed) + ) +}) + +observeEvent(input$nn_store_pred, { + req(!is.empty(input$nn_pred_data), pressed(input$nn_run)) + pred <- .predict_nn() + if (is.null(pred)) { + return() + } + fixed <- fix_names(input$nn_store_pred_name) + updateTextInput(session, "nn_store_pred_name", value = fixed) + withProgress( + message = i18n$t("Storing predictions"), value = 1, + r_data[[input$nn_pred_data]] <- store( + r_data[[input$nn_pred_data]], pred, + name = fixed + ) + ) +}) + +nn_report <- function() { + if (is.empty(input$nn_evar)) { + return(invisible()) + } + + outputs <- c("summary") + inp_out <- list(list(prn = TRUE), "") + figs <- FALSE + + if (!is.empty(input$nn_plots, "none")) { + inp <- check_plot_inputs(nn_plot_inputs()) + inp$size <- NULL + inp_out[[2]] <- clean_args(inp, nn_plot_args[-1]) + inp_out[[2]]$custom <- FALSE + outputs <- c(outputs, "plot") + figs <- TRUE + } + + if (!is.empty(input$nn_store_res_name)) { + fixed <- fix_names(input$nn_store_res_name) + updateTextInput(session, "nn_store_res_name", value = fixed) + xcmd <- paste0(input$dataset, " <- store(", input$dataset, ", result, name = \"", fixed, "\")\n") + } else { + xcmd <- "" + } + + if (!is.empty(input$nn_predict, "none") && + (!is.empty(input$nn_pred_data) || !is.empty(input$nn_pred_cmd))) { + pred_args <- clean_args(nn_pred_inputs(), nn_pred_args[-1]) + + if (!is.empty(pred_args$pred_cmd)) { + pred_args$pred_cmd <- strsplit(pred_args$pred_cmd, ";\\s*")[[1]] + } else { + pred_args$pred_cmd <- NULL + } + + if (!is.empty(pred_args$pred_data)) { + pred_args$pred_data <- as.symbol(pred_args$pred_data) + } else { + pred_args$pred_data <- NULL + } + + inp_out[[2 + figs]] <- pred_args + outputs <- c(outputs, "pred <- predict") + xcmd <- paste0(xcmd, "print(pred, n = 10)") + if (input$nn_predict %in% c("data", "datacmd")) { + fixed <- fix_names(input$nn_store_pred_name) + updateTextInput(session, "nn_store_pred_name", value = fixed) + xcmd <- paste0( + xcmd, "\n", input$nn_pred_data, " <- store(", + input$nn_pred_data, ", pred, name = \"", fixed, "\")" + ) + } + + if (input$nn_pred_plot && !is.empty(input$nn_xvar)) { + inp_out[[3 + figs]] <- clean_args(nn_pred_plot_inputs(), nn_pred_plot_args[-1]) + inp_out[[3 + figs]]$result <- "pred" + outputs <- c(outputs, "plot") + figs <- TRUE + } + } + + nn_inp <- nn_inputs() + if (input$nn_type == "regression") { + nn_inp$lev <- NULL + } + + update_report( + inp_main = clean_args(nn_inp, nn_args), + fun_name = "nn", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = nn_plot_width(), + fig.height = nn_plot_height(), + xcmd = xcmd + ) +} + +dl_nn_pred <- function(path) { + if (pressed(input$nn_run)) { + write.csv(.predict_nn(), file = path, row.names = FALSE) + } else { + cat(i18n$t("No output available. Press the Estimate button to generate results"), file = path) + } +} + +download_handler( + id = "dl_nn_pred", + fun = dl_nn_pred, + fn = function() paste0(input$dataset, "_nn_pred"), + type = "csv", + caption = i18n$t("Save predictions") +) + +download_handler( + id = "dlp_nn_pred", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_nn_pred"), + type = "png", + caption = i18n$t("Save neural network prediction plot"), + plot = .predict_plot_nn, + width = plot_width, + height = nn_pred_plot_height +) + +download_handler( + id = "dlp_nn", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_nn"), + type = "png", + caption = i18n$t("Save neural network plot"), + plot = .plot_nn, + width = nn_plot_width, + height = nn_plot_height +) + +observeEvent(input$nn_report, { + r_info[["latest_screenshot"]] <- NULL + nn_report() +}) + +observeEvent(input$nn_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_nn_screenshot") +}) + +observeEvent(input$modal_nn_screenshot, { + nn_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.model/inst/app/tools/analysis/regress_ui.R b/radiant.model/inst/app/tools/analysis/regress_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..db21171672bd173d04647bb44cd551f2b18df5b7 --- /dev/null +++ b/radiant.model/inst/app/tools/analysis/regress_ui.R @@ -0,0 +1,809 @@ +reg_show_interactions <- setNames( + c("", 2, 3), + c(i18n$t("None"), i18n$t("2-way"), i18n$t("3-way")) +) + +reg_predict <- setNames( + c("none", "data", "cmd", "datacmd"), + c(i18n$t("None"), i18n$t("Data"), i18n$t("Command"), i18n$t("Data & Command")) +) + +reg_check <- setNames( + c("standardize", "center", "stepwise-backward", "robust"), + c(i18n$t("Standardize"), i18n$t("Center"), i18n$t("Stepwise"), i18n$t("Robust")) +) + +reg_sum_check <- setNames( + c("rmse", "sumsquares", "vif", "confint"), + c(i18n$t("RMSE"), i18n$t("Sum of squares"), i18n$t("VIF"), i18n$t("Confidence intervals")) +) + +reg_lines <- setNames( + c("line", "loess", "jitter"), + c(i18n$t("Line"), i18n$t("Loess"), i18n$t("Jitter")) +) + +reg_plots <- setNames( + c("none", "dist", "correlations", "scatter", "vip", "pred_plot", "pdp", "dashboard", "resid_pred", "coef", "influence"), + c( + i18n$t("None"), i18n$t("Distribution"), i18n$t("Correlations"), + i18n$t("Scatter"), i18n$t("Permutation Importance"), i18n$t("Prediction plots"), + i18n$t("Partial Dependence"), i18n$t("Dashboard"), i18n$t("Residual vs explanatory"), + i18n$t("Coefficient plot"), i18n$t("Influential observations") + ) +) + +reg_args <- as.list(formals(regress)) + +## list of function inputs selected by user +reg_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + reg_args$data_filter <- if (input$show_filter) input$data_filter else "" + reg_args$arr <- if (input$show_filter) input$data_arrange else "" + reg_args$rows <- if (input$show_filter) input$data_rows else "" + reg_args$dataset <- input$dataset + for (i in r_drop(names(reg_args))) { + reg_args[[i]] <- input[[paste0("reg_", i)]] + } + reg_args +}) + +reg_sum_args <- as.list(if (exists("summary.regress")) { + formals(summary.regress) +} else { + formals(radiant.model:::summary.regress) +}) + +## list of function inputs selected by user +reg_sum_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(reg_sum_args)) { + reg_sum_args[[i]] <- input[[paste0("reg_", i)]] + } + reg_sum_args +}) + +reg_plot_args <- as.list(if (exists("plot.regress")) { + formals(plot.regress) +} else { + formals(radiant.model:::plot.regress) +}) + +## list of function inputs selected by user +reg_plot_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(reg_plot_args)) { + reg_plot_args[[i]] <- input[[paste0("reg_", i)]] + } + reg_plot_args +}) + +reg_pred_args <- as.list(if (exists("predict.regress")) { + formals(predict.regress) +} else { + formals(radiant.model:::predict.regress) +}) + +## list of function inputs selected by user +reg_pred_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(reg_pred_args)) { + reg_pred_args[[i]] <- input[[paste0("reg_", i)]] + } + + reg_pred_args$pred_cmd <- reg_pred_args$pred_data <- "" + if (input$reg_predict == "cmd") { + reg_pred_args$pred_cmd <- gsub("\\s{2,}", " ", input$reg_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% + gsub("\"", "\'", .) + } else if (input$reg_predict == "data") { + reg_pred_args$pred_data <- input$reg_pred_data + } else if (input$reg_predict == "datacmd") { + reg_pred_args$pred_cmd <- gsub("\\s{2,}", " ", input$reg_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% + gsub("\"", "\'", .) + reg_pred_args$pred_data <- input$reg_pred_data + } + + ## setting value for prediction interval type + reg_pred_args$interval <- "confidence" + + reg_pred_args +}) + +reg_pred_plot_args <- as.list(if (exists("plot.model.predict")) { + formals(plot.model.predict) +} else { + formals(radiant.model:::plot.model.predict) +}) + +## list of function inputs selected by user +reg_pred_plot_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(reg_pred_plot_args)) { + reg_pred_plot_args[[i]] <- input[[paste0("reg_", i)]] + } + reg_pred_plot_args +}) + +output$ui_reg_rvar <- renderUI({ + withProgress(message = i18n$t("Acquiring variable information"), value = 1, { + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- varnames()[isNum] + }) + selectInput( + inputId = "reg_rvar", label = i18n$t("Response variable:"), choices = vars, + selected = state_single("reg_rvar", vars), multiple = FALSE + ) +}) + +output$ui_reg_evar <- renderUI({ + req(available(input$reg_rvar)) + vars <- varnames() + ## don't use setdiff, removes names + if (length(vars) > 0 && input$reg_rvar %in% vars) { + vars <- vars[-which(vars == input$reg_rvar)] + } + + selectInput( + inputId = "reg_evar", label = i18n$t("Explanatory variables:"), choices = vars, + selected = state_multiple("reg_evar", vars, isolate(input$reg_evar)), + multiple = TRUE, size = min(10, length(vars)), selectize = FALSE + ) +}) + +output$ui_reg_incl <- renderUI({ + req(available(input$reg_evar)) + vars <- input$reg_evar + if (input[["reg_plots"]] == "coef") { + vars_init <- vars + } else { + vars_init <- c() + } + selectInput( + inputId = "reg_incl", label = i18n$t("Explanatory variables to include:"), choices = vars, + selected = state_multiple("reg_incl", vars, vars_init), + multiple = TRUE, size = min(10, length(vars)), selectize = FALSE + ) +}) + +output$ui_reg_incl_int <- renderUI({ + req(available(input$reg_evar)) + choices <- character(0) + vars <- input$reg_evar + ## list of interaction terms to show + if (length(vars) > 1) { + choices <- c(choices, iterms(vars, 2)) + } else { + updateSelectInput(session, "reg_incl_int", choices = choices, selected = choices) + return() + } + selectInput( + "reg_incl_int", + label = i18n$t("2-way interactions to explore:"), + choices = choices, + selected = state_multiple("reg_incl_int", choices), + multiple = TRUE, + size = min(8, length(choices)), + selectize = FALSE + ) +}) + +output$ui_reg_test_var <- renderUI({ + req(available(input$reg_evar)) + vars <- input$reg_evar + if (!is.null(input$reg_int)) vars <- c(vars, input$reg_int) + selectizeInput( + inputId = "reg_test_var", label = i18n$t("Variables to test:"), + choices = vars, + selected = state_multiple("reg_test_var", vars, isolate(input$reg_test_var)), + multiple = TRUE, + options = list(placeholder = i18n$t("None"), plugins = list("remove_button")) + ) +}) + +## not clear why this is needed because state_multiple should handle this +observeEvent(is.null(input$reg_test_var), { + if ("reg_test_var" %in% names(input)) r_state$reg_test_var <<- NULL +}) + +output$ui_reg_show_interactions <- renderUI({ + vars <- input$reg_evar + isNum <- .get_class() %in% c("integer", "numeric", "ts") + if (any(vars %in% varnames()[isNum])) { + choices <- reg_show_interactions[1:3] + } else { + choices <- reg_show_interactions[1:max(min(3, length(input$reg_evar)), 1)] + } + radioButtons( + inputId = "reg_show_interactions", label = i18n$t("Interactions:"), + choices = choices, selected = state_init("reg_show_interactions"), + inline = TRUE + ) +}) + +output$ui_reg_int <- renderUI({ + choices <- character(0) + if (isolate("reg_show_interactions" %in% names(input)) && + is.empty(input$reg_show_interactions)) { + } else if (is.empty(input$reg_show_interactions)) { + return() + } else { + vars <- input$reg_evar + if (not_available(vars)) { + return() + } else { + ## quadratic and qubic terms + isNum <- .get_class() %in% c("integer", "numeric", "ts") + isNum <- intersect(vars, varnames()[isNum]) + if (length(isNum) > 0) { + choices <- qterms(isNum, input$reg_show_interactions) + } + ## list of interaction terms to show + if (length(vars) > 1) { + choices <- c(choices, iterms(vars, input$reg_show_interactions)) + } + if (length(choices) == 0) { + return() + } + } + } + + selectInput( + "reg_int", + label = NULL, + choices = choices, + selected = state_init("reg_int"), + multiple = TRUE, + size = min(8, length(choices)), + selectize = FALSE + ) +}) + +## reset prediction and plot settings when the dataset changes +observeEvent(input$dataset, { + updateSelectInput(session = session, inputId = "reg_predict", selected = "none") + updateSelectInput(session = session, inputId = "reg_plots", selected = "none") +}) + +output$ui_reg_predict_plot <- renderUI({ + predict_plot_controls("reg") +}) + +output$ui_reg_nrobs <- renderUI({ + nrobs <- nrow(.get_data()) + choices <- c("1,000" = 1000, "5,000" = 5000, "10,000" = 10000, "All" = -1) %>% + .[. < nrobs] + selectInput( + "reg_nrobs", i18n$t("Number of data points plotted:"), + choices = choices, + selected = state_single("reg_nrobs", choices, 1000) + ) +}) + +output$ui_reg_store_res_name <- renderUI({ + req(input$dataset) + textInput("reg_store_res_name", i18n$t("Store residuals:"), "", placeholder = i18n$t("Provide variable name")) +}) + +## add a spinning refresh icon if the model needs to be (re)estimated +run_refresh(reg_args, "reg", tabs = "tabs_regress", label = i18n$t("Estimate model"), relabel = i18n$t("Re-estimate model")) + +## data ui and tabs +output$ui_regress <- renderUI({ + req(input$dataset) + tagList( + conditionalPanel( + condition = "input.tabs_regress == 'Summary'", + wellPanel( + actionButton("reg_run", i18n$t("Estimate model"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ) + ), + wellPanel( + conditionalPanel( + condition = "input.tabs_regress == 'Summary'", + uiOutput("ui_reg_rvar"), + uiOutput("ui_reg_evar"), + conditionalPanel( + condition = "input.reg_evar != null", + uiOutput("ui_reg_show_interactions"), + conditionalPanel( + condition = "input.reg_show_interactions != ''", + uiOutput("ui_reg_int") + ), + uiOutput("ui_reg_test_var"), + checkboxGroupInput( + "reg_check", NULL, reg_check, + selected = state_group("reg_check"), inline = TRUE + ), + checkboxGroupInput( + "reg_sum_check", NULL, reg_sum_check, + selected = state_group("reg_sum_check"), inline = TRUE + ) + ) + ), + conditionalPanel( + condition = "input.tabs_regress == 'Predict'", + selectInput( + "reg_predict", + label = i18n$t("Prediction input type:"), reg_predict, + selected = state_single("reg_predict", reg_predict, "none") + ), + conditionalPanel( + "input.reg_predict == 'data' | input.reg_predict == 'datacmd'", + selectizeInput( + inputId = "reg_pred_data", label = i18n$t("Prediction data:"), + choices = c("None" = "", r_info[["datasetlist"]]), + selected = state_single("reg_pred_data", c("None" = "", r_info[["datasetlist"]])), + multiple = FALSE + ) + ), + conditionalPanel( + "input.reg_predict == 'cmd' | input.reg_predict == 'datacmd'", + returnTextAreaInput( + "reg_pred_cmd", i18n$t("Prediction command:"), + value = state_init("reg_pred_cmd", ""), + rows = 3, + placeholder = i18n$t("Type a formula to set values for model variables (e.g., carat = 1; cut = 'Ideal') and press return") + ) + ), + conditionalPanel( + condition = "input.reg_predict != 'none'", + checkboxInput("reg_pred_plot", i18n$t("Plot predictions"), state_init("reg_pred_plot", FALSE)), + conditionalPanel( + "input.reg_pred_plot == true", + uiOutput("ui_reg_predict_plot") + ) + ), + ## only show if full data is used for prediction + conditionalPanel( + "input.reg_predict == 'data' | input.reg_predict == 'datacmd'", + tags$table( + tags$td(textInput("reg_store_pred_name", i18n$t("Store predictions:"), state_init("reg_store_pred_name", "pred_reg"))), + tags$td(actionButton("reg_store_pred", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ) + ), + conditionalPanel( + condition = "input.tabs_regress == 'Plot'", + selectInput( + "reg_plots", i18n$t("Plots:"), + choices = reg_plots, + selected = state_single("reg_plots", reg_plots) + ), + conditionalPanel( + condition = "input.reg_plots == 'coef' | input.reg_plots == 'pdp' | input.reg_plots == 'pred_plot'", + uiOutput("ui_reg_incl"), + conditionalPanel( + condition = "input.reg_plots == 'coef'", + checkboxInput("reg_intercept", i18n$t("Include intercept"), state_init("reg_intercept", FALSE)) + ), + conditionalPanel( + condition = "input.reg_plots == 'pdp' | input.reg_plots == 'pred_plot'", + uiOutput("ui_reg_incl_int") + ) + ), + conditionalPanel( + condition = "input.reg_plots == 'correlations' | + input.reg_plots == 'scatter' | + input.reg_plots == 'dashboard' | + input.reg_plots == 'resid_pred'", + uiOutput("ui_reg_nrobs"), + conditionalPanel( + condition = "input.reg_plots != 'correlations'", + checkboxGroupInput( + "reg_lines", NULL, reg_lines, + selected = state_group("reg_lines"), inline = TRUE + ) + ) + ) + ), + conditionalPanel( + condition = "(input.tabs_regress == 'Summary' && input.reg_sum_check != undefined && input.reg_sum_check.indexOf('confint') >= 0) || + (input.tabs_regress == 'Predict' && input.reg_predict != 'none') || + (input.tabs_regress == 'Plot' && input.reg_plots == 'coef')", + sliderInput( + "reg_conf_lev", i18n$t("Confidence level:"), + min = 0.80, + max = 0.99, value = state_init("reg_conf_lev", .95), + step = 0.01 + ) + ), + conditionalPanel( + condition = "input.tabs_regress == 'Summary'", + tags$table( + tags$td(uiOutput("ui_reg_store_res_name")), + tags$td(actionButton("reg_store_res", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ) + ), + help_and_report( + modal_title = i18n$t("Linear regression (OLS)"), fun_name = "regress", + help_file = inclRmd(file.path(getOption("radiant.path.model"), "app/tools/help/regress.Rmd")) + ) + ) +}) + +reg_plot <- reactive({ + if (reg_available() != "available") { + return() + } + if (is.empty(input$reg_plots, "none")) { + return() + } + + # specifying plot heights + plot_height <- 500 + plot_width <- 650 + nr_vars <- length(input$reg_evar) + 1 + + if (input$reg_plots == "dist") { + plot_height <- (plot_height / 2) * ceiling(nr_vars / 2) + } else if (input$reg_plots == "dashboard") { + plot_height <- 1.5 * plot_height + } else if (input$reg_plots == "correlations") { + plot_height <- 150 * nr_vars + plot_width <- 150 * nr_vars + } else if (input$reg_plots == "coef") { + incl <- paste0("^(", paste0(input$reg_incl, "[|]*", collapse = "|"), ")") + nr_coeff <- sum(grepl(incl, .regress()$coeff$label)) + plot_height <- 300 + 20 * nr_coeff + } else if (input$reg_plots %in% c("scatter", "resid_pred")) { + plot_height <- (plot_height / 2) * ceiling((nr_vars - 1) / 2) + } else if (input$reg_plots == "vip") { + plot_height <- max(500, 30 * nr_vars) + } else if (input$reg_plots %in% c("pdp", "pred_plot")) { + nr_vars <- length(input$reg_incl) + length(input$reg_incl_int) + plot_height <- max(250, ceiling(nr_vars / 2) * 250) + if (length(input$reg_incl_int) > 0) { + plot_width <- plot_width + min(2, length(input$reg_incl_int)) * 90 + } + } + + list(plot_width = plot_width, plot_height = plot_height) +}) + +reg_plot_width <- function() { + reg_plot() %>% + (function(x) if (is.list(x)) x$plot_width else 650) +} + +reg_plot_height <- function() { + reg_plot() %>% + (function(x) if (is.list(x)) x$plot_height else 500) +} + +reg_pred_plot_height <- function() { + if (input$reg_pred_plot) 500 else 1 +} + +# output is called from the main radiant ui.R +output$regress <- renderUI({ + register_print_output("summary_regress", ".summary_regress") + register_print_output("predict_regress", ".predict_print_regress") + register_plot_output( + "predict_plot_regress", ".predict_plot_regress", + height_fun = "reg_pred_plot_height" + ) + register_plot_output( + "plot_regress", ".plot_regress", + height_fun = "reg_plot_height", + width_fun = "reg_plot_width" + ) + + ## two separate tabs + reg_output_panels <- tabsetPanel( + id = "tabs_regress", + tabPanel( + i18n$t("Summary"), value = "Summary", + download_link("dl_reg_coef"), br(), + verbatimTextOutput("summary_regress") + ), + tabPanel( + i18n$t("Predict"), value = "Predict", + conditionalPanel( + "input.reg_pred_plot == true", + download_link("dlp_reg_pred"), + plotOutput("predict_plot_regress", width = "100%", height = "100%") + ), + download_link("dl_reg_pred"), br(), + verbatimTextOutput("predict_regress") + ), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_regress"), + plotOutput("plot_regress", width = "100%", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Model > Estimate"), + tool = i18n$t("Linear regression (OLS)"), + tool_ui = "ui_regress", + output_panels = reg_output_panels + ) +}) + +reg_available <- eventReactive(input$reg_run, { + if (not_available(input$reg_rvar)) { + i18n$t("This analysis requires a response variable of type integer\nor numeric and one or more explanatory variables.\nIf these variables are not available please select another dataset.") %>% + suggest_data("diamonds") + } else if (not_available(input$reg_evar)) { + i18n$t("Please select one or more explanatory variables. Then press the Estimate\nbutton to estimate the model.") %>% + suggest_data("diamonds") + } else { + "available" + } +}) + +.regress <- eventReactive(input$reg_run, { + regi <- reg_inputs() + regi$envir <- r_data + withProgress(message = i18n$t("Estimating model"), value = 1, { + do.call(regress, regi) + }) +}) + +.summary_regress <- reactive({ + if (not_pressed(input$reg_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } + if (reg_available() != "available") { + return(reg_available()) + } + do.call(summary, c(list(object = .regress()), reg_sum_inputs())) +}) + +.predict_regress <- reactive({ + if (not_pressed(input$reg_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } + if (reg_available() != "available") { + return(reg_available()) + } + if (is.empty(input$reg_predict, "none")) { + return(i18n$t("** Select prediction input **")) + } + if ((input$reg_predict == "data" || input$reg_predict == "datacmd") && is.empty(input$reg_pred_data)) { + return(i18n$t("** Select data for prediction **")) + } + if (input$reg_predict == "cmd" && is.empty(input$reg_pred_cmd)) { + return(i18n$t("** Enter prediction commands **")) + } + + withProgress(message = i18n$t("Generating predictions"), value = 1, { + rpi <- reg_pred_inputs() + rpi$object <- .regress() + rpi$envir <- r_data + do.call(predict, rpi) + }) +}) + +.predict_print_regress <- reactive({ + .predict_regress() %>% + (function(x) if (is.character(x)) cat(x, "\n") else print(x)) +}) + +.predict_plot_regress <- reactive({ + req( + pressed(input$reg_run), input$reg_pred_plot, + available(input$reg_xvar), + !is.empty(input$reg_predict, "none") + ) + + withProgress(message = i18n$t("Generating prediction plot"), value = 1, { + do.call(plot, c(list(x = .predict_regress()), reg_pred_plot_inputs())) + }) +}) + +.plot_regress <- reactive({ + if (not_pressed(input$reg_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } else if (is.empty(input$reg_plots, "none")) { + return(i18n$t("Please select a regression plot from the drop-down menu")) + } else if (reg_available() != "available") { + return(reg_available()) + } + if (!input$reg_plots %in% c("coef", "dist", "influence", "vip", "pdp", "pred_plot")) req(input$reg_nrobs) + check_for_pdp_pred_plots("reg") + withProgress(message = i18n$t("Generating plots"), value = 1, { + if (input$reg_plots == "correlations") { + capture_plot(do.call(plot, c(list(x = .regress()), reg_plot_inputs()))) + } else { + do.call(plot, c(list(x = .regress()), reg_plot_inputs(), shiny = TRUE)) + } + }) +}) + +check_plot_inputs <- function(inp) { + if (inp$plots %in% c("correlations", "scatter", "dashboard", "resid_pred")) { + inp$nrobs <- as_integer(inp$nrobs) + } else { + inp$nrobs <- NULL + } + + if (sum(inp$plots %in% c("coef", "pdp", "pred_plot")) == 0) { + inp$incl <- NULL + inp$incl_int <- NULL + } + + if (inp$plots == "coef") { + inp$incl_int <- NULL + } + + inp +} + +regress_report <- function() { + if (is.empty(input$reg_evar)) { + return(invisible()) + } + outputs <- c("summary") + inp_out <- list("", "") + inp_out[[1]] <- clean_args(reg_sum_inputs(), reg_sum_args[-1]) + figs <- FALSE + if (!is.empty(input$reg_plots, "none")) { + inp <- check_plot_inputs(reg_plot_inputs()) + inp_out[[2]] <- clean_args(inp, reg_plot_args[-1]) + inp_out[[2]]$custom <- FALSE + outputs <- c(outputs, "plot") + figs <- TRUE + } + + if (!is.empty(input$reg_store_res_name)) { + fixed <- fix_names(input$reg_store_res_name) + updateTextInput(session, "reg_store_res_name", value = fixed) + xcmd <- paste0(input$dataset, " <- store(", input$dataset, ", result, name = \"", fixed, "\")\n") + } else { + xcmd <- "" + } + + if (!is.empty(input$reg_predict, "none") && + (!is.empty(input$reg_pred_data) || !is.empty(input$reg_pred_cmd))) { + pred_args <- clean_args(reg_pred_inputs(), reg_pred_args[-1]) + + if (!is.empty(pred_args$pred_cmd)) { + pred_args$pred_cmd <- strsplit(pred_args$pred_cmd, ";\\s*")[[1]] + } else { + pred_args$pred_cmd <- NULL + } + if (!is.empty(pred_args$pred_data)) { + pred_args$pred_data <- as.symbol(pred_args$pred_data) + } else { + pred_args$pred_data <- NULL + } + + inp_out[[2 + figs]] <- pred_args + outputs <- c(outputs, "pred <- predict") + xcmd <- paste0(xcmd, "print(pred, n = 10)") + if (input$reg_predict %in% c("data", "datacmd")) { + fixed <- unlist(strsplit(input$reg_store_pred_name, "(\\s*,\\s*|\\s*;\\s*)")) %>% + fix_names() %>% + deparse(., control = getOption("dctrl"), width.cutoff = 500L) + xcmd <- paste0( + xcmd, "\n", input$reg_pred_data, " <- store(", + input$reg_pred_data, ", pred, name = ", fixed, ")" + ) + } + + if (input$reg_pred_plot && !is.empty(input$reg_xvar)) { + inp_out[[3 + figs]] <- clean_args(reg_pred_plot_inputs(), reg_pred_plot_args[-1]) + inp_out[[3 + figs]]$result <- "pred" + outputs <- c(outputs, "plot") + figs <- TRUE + } + } + + update_report( + inp_main = clean_args(reg_inputs(), reg_args), + fun_name = "regress", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = reg_plot_width(), + fig.height = reg_plot_height(), + xcmd = xcmd + ) +} + +observeEvent(input$reg_store_res, { + req(pressed(input$reg_run)) + robj <- .regress() + if (!is.list(robj)) { + return() + } + fixed <- fix_names(input$reg_store_res_name) + updateTextInput(session, "reg_store_res_name", value = fixed) + withProgress( + message = i18n$t("Storing residuals"), value = 1, + r_data[[input$dataset]] <- store(r_data[[input$dataset]], robj, name = fixed) + ) +}) + +observeEvent(input$reg_store_pred, { + req(!is.empty(input$reg_pred_data), pressed(input$reg_run)) + pred <- .predict_regress() + if (is.null(pred)) { + return() + } + fixed <- unlist(strsplit(input$reg_store_pred_name, "(\\s*,\\s*|\\s*;\\s*)")) %>% + fix_names() %>% + paste0(collapse = ", ") + updateTextInput(session, "reg_store_pred_name", value = fixed) + withProgress( + message = i18n$t("storing predictions"), value = 1, + r_data[[input$reg_pred_data]] <- store( + r_data[[input$reg_pred_data]], pred, + name = fixed + ) + ) +}) + +dl_reg_coef <- function(path) { + if (pressed(input$reg_run)) { + write.coeff(.regress(), file = path) + } else { + cat(i18n$t("No output available. Press the Estimate button to generate results"), file = path) + } +} + +download_handler( + id = "dl_reg_coef", + fun = dl_reg_coef, + fn = function() paste0(input$dataset, "_reg_coef"), + type = "csv", + caption = i18n$t("Save coefficients") +) + +dl_reg_pred <- function(path) { + if (pressed(input$reg_run)) { + write.csv(.predict_regress(), file = path, row.names = FALSE) + } else { + cat(i18n$t("No output available. Press the Estimate button to generate results"), file = path) + } +} + +download_handler( + id = "dl_reg_pred", + fun = dl_reg_pred, + fn = function() paste0(input$dataset, "_reg_pred"), + type = "csv", + caption = i18n$t("Save regression predictions") +) + +download_handler( + id = "dlp_reg_pred", + fun = download_handler_plot, + fn = paste0(input$dataset, "_reg_pred"), + type = "png", + caption = i18n$t("Save regression prediction plot"), + plot = .predict_plot_regress, + width = plot_width, + height = reg_pred_plot_height +) + +download_handler( + id = "dlp_regress", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_", input$reg_plots, "_regress"), + type = "png", + caption = i18n$t("Save regression plot"), + plot = .plot_regress, + width = reg_plot_width, + height = reg_plot_height +) + +observeEvent(input$regress_report, { + r_info[["latest_screenshot"]] <- NULL + regress_report() +}) + +observeEvent(input$regress_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_regress_screenshot") +}) + +observeEvent(input$modal_regress_screenshot, { + regress_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.model/inst/app/tools/analysis/rforest_ui.R b/radiant.model/inst/app/tools/analysis/rforest_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..60bed1f9404583f239a9d5329eae98a3cfab8ea7 --- /dev/null +++ b/radiant.model/inst/app/tools/analysis/rforest_ui.R @@ -0,0 +1,754 @@ +rf_plots <- c("none", "vip", "pred_plot", "pdp", "dashboard") +names(rf_plots) <- c( + i18n$t("None"), + i18n$t("Permutation Importance"), + i18n$t("Prediction plots"), + i18n$t("Partial Dependence"), + i18n$t("Dashboard") +) + + +## list of function arguments +rf_args <- as.list(formals(rforest)) + +## list of function inputs selected by user +rf_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + rf_args$data_filter <- if (input$show_filter) input$data_filter else "" + rf_args$arr <- if (input$show_filter) input$data_arrange else "" + rf_args$rows <- if (input$show_filter) input$data_rows else "" + rf_args$dataset <- input$dataset + for (i in r_drop(names(rf_args))) { + rf_args[[i]] <- input[[paste0("rf_", i)]] + } + rf_args +}) + +rf_pred_args <- as.list(if (exists("predict.rforest")) { + formals(predict.rforest) +} else { + formals(radiant.model:::predict.rforest) +}) + +# list of function inputs selected by user +rf_pred_inputs <- reactive({ + # loop needed because reactive values don't allow single bracket indexing + for (i in names(rf_pred_args)) { + rf_pred_args[[i]] <- input[[paste0("rf_", i)]] + } + + rf_pred_args$pred_cmd <- rf_pred_args$pred_data <- "" + if (input$rf_predict == "cmd") { + rf_pred_args$pred_cmd <- gsub("\\s{2,}", " ", input$rf_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% + gsub("\"", "\'", .) + } else if (input$rf_predict == "data") { + rf_pred_args$pred_data <- input$rf_pred_data + } else if (input$rf_predict == "datacmd") { + rf_pred_args$pred_cmd <- gsub("\\s{2,}", " ", input$rf_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% + gsub("\"", "\'", .) + rf_pred_args$pred_data <- input$rf_pred_data + } + rf_pred_args +}) + +rf_plot_args <- as.list(if (exists("plot.rforest")) { + formals(plot.rforest) +} else { + formals(radiant.model:::plot.rforest) +}) + +## list of function inputs selected by user +rf_plot_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(rf_plot_args)) { + rf_plot_args[[i]] <- input[[paste0("rf_", i)]] + } + rf_plot_args +}) + +rf_pred_plot_args <- as.list(if (exists("plot.model.predict")) { + formals(plot.model.predict) +} else { + formals(radiant.model:::plot.model.predict) +}) + +# list of function inputs selected by user +rf_pred_plot_inputs <- reactive({ + # loop needed because reactive values don't allow single bracket indexing + for (i in names(rf_pred_plot_args)) { + rf_pred_plot_args[[i]] <- input[[paste0("rf_", i)]] + } + rf_pred_plot_args +}) + +output$ui_rf_rvar <- renderUI({ + req(input$rf_type) + + withProgress(message = i18n$t("Acquiring variable information"), value = 1, { + if (input$rf_type == "classification") { + isFct <- .get_class() %in% c("factor") + # vars <- two_level_vars() + vars <- varnames()[isFct] + } else { + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- varnames()[isNum] + } + }) + + init <- if (input$rf_type == "classification") { + if (is.empty(input$logit_rvar)) isolate(input$rf_rvar) else input$logit_rvar + } else { + if (is.empty(input$reg_rvar)) isolate(input$rf_rvar) else input$reg_rvar + } + + selectInput( + inputId = "rf_rvar", + label = i18n$t("Response variable:"), + choices = vars, + selected = state_single("rf_rvar", vars, init), + multiple = FALSE + ) +}) + +output$ui_rf_lev <- renderUI({ + req(input$rf_type == "classification") + req(available(input$rf_rvar)) + levs <- .get_data()[[input$rf_rvar]] %>% + as_factor() %>% + levels() + + init <- if (is.empty(input$logit_lev)) isolate(input$rf_lev) else input$logit_lev + selectInput( + inputId = "rf_lev", label = i18n$t("Choose first level:"), + choices = levs, + selected = state_init("rf_lev", init) + ) +}) + +output$ui_rf_evar <- renderUI({ + if (not_available(input$rf_rvar)) { + return() + } + vars <- varnames() + if (length(vars) > 0) { + vars <- vars[-which(vars == input$rf_rvar)] + } + + init <- if (input$rf_type == "classification") { + if (is.empty(input$logit_evar)) isolate(input$rf_evar) else input$logit_evar + } else { + if (is.empty(input$reg_evar)) isolate(input$rf_evar) else input$reg_evar + } + + selectInput( + inputId = "rf_evar", + label = i18n$t("Explanatory variables:"), + choices = vars, + selected = state_multiple("rf_evar", vars, init), + multiple = TRUE, + size = min(10, length(vars)), + selectize = FALSE + ) +}) + +# function calls generate UI elements +output_incl("rf") +output_incl_int("rf") + +output$ui_rf_wts <- renderUI({ + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- varnames()[isNum] + if (length(vars) > 0 && any(vars %in% input$rf_evar)) { + vars <- base::setdiff(vars, input$rf_evar) + names(vars) <- varnames() %>% + { + .[match(vars, .)] + } %>% + names() + } + vars <- c("None", vars) + + selectInput( + inputId = "rf_wts", label = i18n$t("Weights:"), choices = vars, + selected = state_single("rf_wts", vars), + multiple = FALSE + ) +}) + +output$ui_rf_store_pred_name <- renderUI({ + init <- state_init("rf_store_pred_name", "pred_rf") + textInput( + "rf_store_pred_name", + i18n$t("Store predictions:"), + init + ) +}) + +# output$ui_rf_store_res_name <- renderUI({ +# req(input$dataset) +# textInput("rf_store_res_name", "Store residuals:", "", placeholder = "Provide variable name") +# }) + +## reset prediction and plot settings when the dataset changes +observeEvent(input$dataset, { + updateSelectInput(session = session, inputId = "rf_predict", selected = "none") + updateSelectInput(session = session, inputId = "rf_plots", selected = "none") +}) + +## reset prediction settings when the model type changes +observeEvent(input$rf_type, { + updateSelectInput(session = session, inputId = "rf_predict", selected = "none") + updateSelectInput(session = session, inputId = "rf_plots", selected = "none") +}) + +output$ui_rf_predict_plot <- renderUI({ + req(input$rf_rvar, input$rf_type) + if (input$rf_type == "classification") { + var_colors <- ".class" %>% set_names(input$rf_rvar) + predict_plot_controls("rf", vars_color = var_colors, init_color = ".class") + } else { + predict_plot_controls("rf") + } +}) + +output$ui_rf_plots <- renderUI({ + req(input$rf_type) + if (input$rf_type != "regression") { + rf_plots <- head(rf_plots, -1) + } + selectInput( + "rf_plots", i18n$t("Plots:"), + choices = rf_plots, + selected = state_single("rf_plots", rf_plots) + ) +}) + +output$ui_rf_nrobs <- renderUI({ + nrobs <- nrow(.get_data()) + choices <- c("1,000" = 1000, "5,000" = 5000, "10,000" = 10000, "All" = -1) %>% + .[. < nrobs] + selectInput( + "rf_nrobs", i18n$t("Number of data points plotted:"), + choices = choices, + selected = state_single("rf_nrobs", choices, 1000) + ) +}) + +## add a spinning refresh icon if the model needs to be (re)estimated +run_refresh(rf_args, "rf", tabs = "tabs_rf", label = i18n$t("Estimate model"), relabel = i18n$t("Re-estimate model")) + +output$ui_rf <- renderUI({ + req(input$dataset) + tagList( + conditionalPanel( + condition = "input.tabs_rf == 'Summary'", + wellPanel( + actionButton("rf_run", "Estimate model", width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ) + ), + wellPanel( + conditionalPanel( + condition = "input.tabs_rf == 'Summary'", + radioButtons( + "rf_type", + label = NULL, + choices = c("classification", "regression") %>% + setNames(c(i18n$t("Classification"), i18n$t("Regression"))), + selected = state_init("rf_type", "classification"), + inline = TRUE + ), + uiOutput("ui_rf_rvar"), + uiOutput("ui_rf_lev"), + uiOutput("ui_rf_evar"), + uiOutput("ui_rf_wts"), + with(tags, table( + tr( + td(numericInput( + "rf_mtry", + label = i18n$t("mtry:"), min = 1, max = 20, + value = state_init("rf_mtry", 1) + ), width = "50%"), + td(numericInput( + "rf_num.trees", + label = i18n$t("# trees:"), min = 1, max = 1000, + value = state_init("rf_num.trees", 100) + ), width = "50%") + ), + width = "100%" + )), + with(tags, table( + tr( + td(numericInput( + "rf_min.node.size", + label = i18n$t("Min node size:"), min = 1, max = 100, + step = 1, value = state_init("rf_min.node.size", 1) + ), width = "50%"), + td(numericInput( + "rf_sample.fraction", + label = i18n$t("Sample fraction:"), + min = 0, max = 1, step = 0.1, + value = state_init("rf_sample.fraction", 1) + ), width = "50%") + ), + width = "100%" + )), + numericInput("rf_seed", label = i18n$t("Seed:"), value = state_init("rf_seed", 1234)) + ), + conditionalPanel( + condition = "input.tabs_rf == 'Predict'", + selectInput( + "rf_predict", + label = i18n$t("Prediction input type:"), reg_predict, + selected = state_single("rf_predict", reg_predict, "none") + ), + conditionalPanel( + "input.rf_predict == 'data' | input.rf_predict == 'datacmd'", + selectizeInput( + inputId = "rf_pred_data", label = i18n$t("Prediction data:"), + choices = c("None" = "", r_info[["datasetlist"]]), + selected = state_single("rf_pred_data", c("None" = "", r_info[["datasetlist"]])), + multiple = FALSE + ) + ), + conditionalPanel( + "input.rf_predict == 'cmd' | input.rf_predict == 'datacmd'", + returnTextAreaInput( + "rf_pred_cmd", i18n$t("Prediction command:"), + value = state_init("rf_pred_cmd", ""), + rows = 3, + placeholder = "Type a formula to set values for model variables (e.g., carat = 1; cut = 'Ideal') and press return" + ) + ), + conditionalPanel( + condition = "input.rf_predict != 'none'", + checkboxInput("rf_pred_plot", i18n$t("Plot predictions"), state_init("rf_pred_plot", FALSE)), + conditionalPanel( + "input.rf_pred_plot == true", + uiOutput("ui_rf_predict_plot") + ) + ), + ## only show if full data is used for prediction + conditionalPanel( + "input.rf_predict == 'data' | input.rf_predict == 'datacmd'", + tags$table( + tags$td(uiOutput("ui_rf_store_pred_name")), + tags$td(actionButton("rf_store_pred", "Store", icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ) + ), + conditionalPanel( + condition = "input.tabs_rf == 'Plot'", + uiOutput("ui_rf_plots"), + conditionalPanel( + condition = "input.rf_plots == 'dashboard'", + uiOutput("ui_rf_nrobs") + ), + conditionalPanel( + condition = "input.rf_plots == 'pdp' | input.rf_plots == 'pred_plot'", + uiOutput("ui_rf_incl"), + uiOutput("ui_rf_incl_int") + ) + # conditionalPanel( + # condition = "input.rf_plots == 'pdp'", + # checkboxInput("rf_qtiles", "Show quintiles", state_init("rf_qtiles", FALSE)) + # ) + ), + # conditionalPanel( + # condition = "input.tabs_rf == 'Summary'", + # tags$table( + # tags$td(uiOutput("ui_rf_store_res_name")), + # tags$td(actionButton("rf_store_res", "Store", icon = icon("plus", verify_fa = FALSE)), class = "top") + # ) + # ) + ), + help_and_report( + modal_title = i18n$t("Random Forest"), + fun_name = "rf", + help_file = inclMD(file.path(getOption("radiant.path.model"), "app/tools/help/rforest.md")) + ) + ) +}) + +rf_plot <- reactive({ + if (rf_available() != "available") { + return() + } + if (is.empty(input$rf_plots, "none")) { + return() + } + res <- .rf() + if (is.character(res)) { + return() + } + nr_vars <- length(res$evar) + plot_height <- 500 + plot_width <- 650 + if ("dashboard" %in% input$rf_plots) { + plot_height <- 750 + } else if (input$rf_plots %in% c("pdp", "pred_plot")) { + nr_vars <- length(input$rf_incl) + length(input$rf_incl_int) + plot_height <- max(250, ceiling(nr_vars / 2) * 250) + if (length(input$rf_incl_int) > 0) { + plot_width <- plot_width + min(2, length(input$rf_incl_int)) * 90 + } + } else if ("vimp" %in% input$rf_plots) { + plot_height <- max(500, nr_vars * 35) + } else if ("vip" %in% input$rf_plots) { + plot_height <- max(500, nr_vars * 35) + } + + list(plot_width = plot_width, plot_height = plot_height) +}) + +rf_plot_width <- function() { + rf_plot() %>% + (function(x) if (is.list(x)) x$plot_width else 650) +} + +rf_plot_height <- function() { + rf_plot() %>% + (function(x) if (is.list(x)) x$plot_height else 500) +} + +rf_pred_plot_height <- function() { + if (input$rf_pred_plot) 500 else 1 +} + +## output is called from the main radiant ui.R +output$rf <- renderUI({ + register_print_output("summary_rf", ".summary_rf") + register_print_output("predict_rf", ".predict_print_rf") + register_plot_output( + "predict_plot_rf", ".predict_plot_rf", + height_fun = "rf_pred_plot_height" + ) + register_plot_output( + "plot_rf", ".plot_rf", + height_fun = "rf_plot_height", + width_fun = "rf_plot_width" + ) + + ## three separate tabs + rf_output_panels <- tabsetPanel( + id = "tabs_rf", + tabPanel( + i18n$t("Summary"), value = "Summary", + verbatimTextOutput("summary_rf") + ), + tabPanel( + i18n$t("Predict"), value = "Predict", + conditionalPanel( + "input.rf_pred_plot == true", + download_link("dlp_rf_pred"), + plotOutput("predict_plot_rf", width = "100%", height = "100%") + ), + download_link("dl_rf_pred"), br(), + verbatimTextOutput("predict_rf") + ), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_rf"), + plotOutput("plot_rf", width = "100%", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Model > Estimate"), + tool = i18n$t("Random Forest"), + tool_ui = "ui_rf", + output_panels = rf_output_panels + ) +}) + +rf_available <- reactive({ + req(input$rf_type) + if (not_available(input$rf_rvar)) { + if (input$rf_type == "classification") { + i18n$t("This analysis requires a response variable with two levels and one\nor more explanatory variables. If these variables are not available\nplease select another dataset.") %>% + suggest_data("titanic") + } else { + i18n$t("This analysis requires a response variable of type integer\nor numeric and one or more explanatory variables.\nIf these variables are not available please select another dataset.") %>% + suggest_data("diamonds") + } + } else if (not_available(input$rf_evar)) { + if (input$rf_type == "classification") { + i18n$t("Please select one or more explanatory variables.") %>% + suggest_data("titanic") + } else { + i18n$t("Please select one or more explanatory variables.") %>% + suggest_data("diamonds") + } + } else { + "available" + } +}) + +.rf <- eventReactive(input$rf_run, { + rfi <- rf_inputs() + rfi$envir <- r_data + + if (is.empty(rfi$mtry)) rfi$mtry <- 1 + nr_evar <- length(rfi$evar) + if (rfi$mtry > nr_evar) { + rfi$mtry <- nr_evar + updateNumericInput(session, "rf_mtry", value = nr_evar) + } else if (rfi$mtry < 0) { + rfi$mtry <- 1 + updateNumericInput(session, "rf_mtry", value = 1) + } + + if (is.empty(rfi$num.trees)) rfi$num.trees <- 100 + if (is.empty(rfi$min.node.size)) rfi$min.node.size <- 1 + if (is.empty(rfi$sample.fraction)) rfi$sample.fraction <- 1 + + withProgress( + message = i18n$t("Estimating random forest"), value = 1, + do.call(rforest, rfi) + ) +}) + +.summary_rf <- reactive({ + if (not_pressed(input$rf_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } + if (rf_available() != "available") { + return(rf_available()) + } + summary(.rf()) +}) + +.predict_rf <- reactive({ + if (not_pressed(input$rf_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } + if (rf_available() != "available") { + return(rf_available()) + } + if (is.empty(input$rf_predict, "none")) { + return(i18n$t("** Select prediction input **")) + } else if ((input$rf_predict == "data" || input$rf_predict == "datacmd") && is.empty(input$rf_pred_data)) { + return(i18n$t("** Select data for prediction **")) + } else if (input$rf_predict == "cmd" && is.empty(input$rf_pred_cmd)) { + return(i18n$t("** Enter prediction commands **")) + } + + withProgress(message = i18n$t("Generating predictions"), value = 1, { + rfi <- rf_pred_inputs() + rfi$object <- .rf() + rfi$envir <- r_data + rfi$OOB <- input$dataset == input$rf_pred_data && + (input$rf_predict == "data" || (input$rf_predict == "datacmd" && is.empty(input$rf_pred_cmd))) && + ((is.empty(input$data_filter) && is.empty(input$data_rows)) || input$show_filter == FALSE) && + pressed(input$rf_run) + do.call(predict, rfi) + }) +}) + +.predict_print_rf <- reactive({ + .predict_rf() %>% + (function(x) if (is.character(x)) cat(x, "\n") else print(x)) +}) + +.predict_plot_rf <- reactive({ + req( + pressed(input$rf_run), input$rf_pred_plot, + available(input$rf_xvar), + !is.empty(input$rf_predict, "none") + ) + + withProgress(message = i18n$t("Generating prediction plot"), value = 1, { + do.call(plot, c(list(x = .predict_rf()), rf_pred_plot_inputs())) + }) +}) + +.plot_rf <- reactive({ + if (not_pressed(input$rf_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } + if (rf_available() != "available") { + return(rf_available()) + } + if (is.empty(input$rf_plots, "none")) { + return(i18n$t("Please select a random forest plot from the drop-down menu")) + } + pinp <- rf_plot_inputs() + pinp$shiny <- TRUE + if (input$rf_plots == "dashboard") { + req(input$rf_nrobs) + } + check_for_pdp_pred_plots("rf") + withProgress(message = i18n$t("Generating plots"), value = 1, { + do.call(plot, c(list(x = .rf()), pinp)) + }) +}) + +# observeEvent(input$rf_store_res, { +# req(pressed(input$rf_run)) +# robj <- .rf() +# if (!is.list(robj)) return() +# fixed <- fix_names(input$rf_store_res_name) +# updateTextInput(session, "rf_store_res_name", value = fixed) +# withProgress( +# message = "Storing residuals", value = 1, +# r_data[[input$dataset]] <- store(r_data[[input$dataset]], robj, name = fixed) +# ) +# }) + +observeEvent(input$rf_store_pred, { + req(!is.empty(input$rf_pred_data), pressed(input$rf_run)) + pred <- .predict_rf() + if (is.null(pred)) { + return() + } + fixed <- unlist(strsplit(input$rf_store_pred_name, "(\\s*,\\s*|\\s*;\\s*)")) %>% + fix_names() %>% + paste0(collapse = ", ") + updateTextInput(session, "rf_store_pred_name", value = fixed) + withProgress( + message = i18n$t("Storing predictions"), value = 1, + r_data[[input$rf_pred_data]] <- store( + r_data[[input$rf_pred_data]], pred, + name = fixed + ) + ) +}) + +rf_report <- function() { + if (is.empty(input$rf_rvar)) { + return(invisible()) + } + + outputs <- c("summary") + inp_out <- list("", "") + figs <- FALSE + + if (!is.empty(input$rf_plots, "none")) { + inp <- check_plot_inputs(rf_plot_inputs()) + inp_out[[2]] <- clean_args(inp, rf_plot_args[-1]) + inp_out[[2]]$custom <- FALSE + outputs <- c(outputs, "plot") + figs <- TRUE + } + + # if (!is.empty(input$rf_store_res_name)) { + # fixed <- fix_names(input$rf_store_res_name) + # updateTextInput(session, "rf_store_res_name", value = fixed) + # xcmd <- paste0(input$dataset, " <- store(", input$dataset, ", result, name = \"", fixed, "\")\n") + # } else { + # xcmd <- "" + # } + xcmd <- "" + + if (!is.empty(input$rf_predict, "none") && + (!is.empty(input$rf_pred_data) || !is.empty(input$rf_pred_cmd))) { + pred_args <- clean_args(rf_pred_inputs(), rf_pred_args[-1]) + + if (!is.empty(pred_args$pred_cmd)) { + pred_args$pred_cmd <- strsplit(pred_args$pred_cmd, ";\\s*")[[1]] + } else { + pred_args$pred_cmd <- NULL + } + + if (is.empty(pred_args$pred_cmd) && !is.empty(pred_args$pred_data)) { + pred_args$OOB <- input$dataset == pred_args$pred_data && + ((is.empty(input$data_filter) && is.empty(input$data_rows)) || input$show_filter == FALSE) && + pressed(input$rf_run) + } + + if (!is.empty(pred_args$pred_data)) { + pred_args$pred_data <- as.symbol(pred_args$pred_data) + } else { + pred_args$pred_data <- NULL + } + + inp_out[[2 + figs]] <- pred_args + outputs <- c(outputs, "pred <- predict") + xcmd <- paste0(xcmd, "print(pred, n = 10)") + if (input$rf_predict %in% c("data", "datacmd")) { + fixed <- fix_names(input$rf_store_pred_name) + updateTextInput(session, "rf_store_pred_name", value = fixed) + xcmd <- paste0( + xcmd, "\n", input$rf_pred_data, " <- store(", + input$rf_pred_data, ", pred, name = \"", fixed, "\")" + ) + } + + if (input$rf_pred_plot && !is.empty(input$rf_xvar)) { + inp_out[[3 + figs]] <- clean_args(rf_pred_plot_inputs(), rf_pred_plot_args[-1]) + inp_out[[3 + figs]]$result <- "pred" + outputs <- c(outputs, "plot") + figs <- TRUE + } + } + + rfi <- rf_inputs() + if (input$rf_type == "regression") { + rfi$lev <- NULL + } + + update_report( + inp_main = clean_args(rfi, rf_args), + fun_name = "rforest", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = rf_plot_width(), + fig.height = rf_plot_height(), + xcmd = xcmd + ) +} + +dl_rf_pred <- function(path) { + if (pressed(input$rf_run)) { + write.csv(.predict_rf(), file = path, row.names = FALSE) + } else { + cat(i18n$t("No output available. Press the Estimate button to generate results"), file = path) + } +} + +download_handler( + id = "dl_rf_pred", + fun = dl_rf_pred, + fn = function() paste0(input$dataset, "_rf_pred"), + type = "csv", + caption = i18n$t("Save predictions") +) + +download_handler( + id = "dlp_rf_pred", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_rf_pred"), + type = "png", + caption = i18n$t("Save random forest prediction plot"), + plot = .predict_plot_rf, + width = plot_width, + height = rf_pred_plot_height +) + +download_handler( + id = "dlp_rf", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_rf"), + type = "png", + caption = i18n$t("Save random forest plot"), + plot = .plot_rf, + width = rf_plot_width, + height = rf_plot_height +) + +observeEvent(input$rf_report, { + r_info[["latest_screenshot"]] <- NULL + rf_report() +}) + +observeEvent(input$rf_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_rf_screenshot") +}) + +observeEvent(input$modal_rf_screenshot, { + rf_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.model/inst/app/tools/analysis/simulater_ui.R b/radiant.model/inst/app/tools/analysis/simulater_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..5f0696e75c2cde27331571616ee7e955c72c4e4f --- /dev/null +++ b/radiant.model/inst/app/tools/analysis/simulater_ui.R @@ -0,0 +1,1159 @@ +####################################### +## Simulate data +####################################### + +#### Try putting all input$sim_... and input$rep_... into a list +#### so you can have multiple simulations in the state file and +#### can restore them in the GUI +#### This should be similar to the dtree setup +#### +#### Also checkout https://github.com/daattali/advanced-shiny/tree/master/update-input0 + +sim_types <- list( + `Probability distributions` = setNames( + c("binom", "discrete", "lnorm", "norm", "pois", "unif"), + c( + i18n$t("Binomial"), + i18n$t("Discrete"), + i18n$t("Log normal"), + i18n$t("Normal"), + i18n$t("Poisson"), + i18n$t("Uniform") + ) + ), + `Deterministic` = setNames( + c("const", "data", "grid", "sequ"), + c( + i18n$t("Constant"), + i18n$t("Data"), + i18n$t("Grid search"), + i18n$t("Sequence") + ) + ) +) + + +sim_types_vec <- c(sim_types[[1]], sim_types[[2]]) + +sim_args <- as.list(formals(simulater)) + +## list of function inputs selected by user +sim_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(sim_args)) { + sim_args[[i]] <- input[[paste0("sim_", i)]] + } + + for (i in sim_types_vec) { + if (!i %in% input$sim_types) sim_args[[i]] <- "" + } + + if (!isTRUE(input$sim_add_functions)) { + sim_args[["funcs"]] <- "" + } + + sim_args +}) + +rep_args <- as.list(formals(repeater)) + +## list of function inputs selected by user +rep_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + rep_args$dataset <- input$sim_name + for (i in r_drop(names(rep_args))) { + rep_args[[i]] <- input[[paste0("rep_", i)]] + } + + if (is.empty(input$rep_fun)) rep_args$fun <- "none" + + rep_args +}) + +rep_sum_args <- as.list(if (exists("summary.repeater")) { + formals(summary.repeater) +} else { + formals(radiant.model:::summary.repeater) +}) + +## list of function inputs selected by user +rep_sum_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(rep_sum_args)) { + rep_sum_args[[i]] <- input[[paste0("rep_", i)]] + } + rep_sum_args +}) + +rep_plot_args <- as.list(if (exists("plot.repeater")) { + formals(plot.repeater) +} else { + formals(radiant.model:::plot.repeater) +}) + +## list of function inputs selected by user +rep_plot_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(rep_plot_args)) { + rep_plot_args[[i]] <- input[[paste0("rep_", i)]] + } + rep_plot_args +}) + +textinput_maker <- function(id = "const", lab = i18n$t("Constant"), rows = 3, pre = "sim_", + placeholder = i18n$t("Provide values in the input boxes above and then press the + symbol"), + allow_tab = TRUE) { + if (allow_tab) { + onkeydown <- "" + } else { + onkeydown <- "if(event.keyCode===9){var v=this.value,s=this.selectionStart,e=this.selectionEnd;this.value=v.substring(0, s)+'\t'+v.substring(e);this.selectionStart=this.selectionEnd=s+1;return false;}" + } + + ## avoid all sorts of 'helpful' behavior from your browser + ## based on https://stackoverflow.com/a/35514029/1974918 + id <- paste0(pre, id) + tags$textarea( + state_init(id), + id = id, + type = "text", + rows = rows, + placeholder = placeholder, + autocomplete = "off", + autocorrect = "off", + autocapitalize = "off", + spellcheck = "false", + class = "form-control", + onkeydown = onkeydown + ) +} + +output$ui_sim_types <- renderUI({ + selectizeInput( + "sim_types", + label = i18n$t("Select types:"), + choices = sim_types, multiple = TRUE, + selected = state_multiple("sim_types", sim_types_vec), + options = list(placeholder = i18n$t("Select types"), plugins = list("remove_button")) + ) +}) + +output$ui_sim_data <- renderUI({ + choices <- c("None" = "none", r_info[["datasetlist"]]) + selectizeInput( + inputId = "sim_data", label = i18n$t("Input data for calculations:"), + choices = choices, + selected = state_single("sim_data", choices, isolate(input$sim_data)), + multiple = FALSE + ) +}) + +sim_vars <- reactive({ + input$sim_run + if (is.empty(input$sim_name)) { + character(0) + } else { + if (is.null(r_data[[input$sim_name]])) { + character(0) + } else { + colnames(r_data[[input$sim_name]]) + } + } +}) + +output$ui_rep_vars <- renderUI({ + vars <- sim_vars() + req(vars) + form <- input$sim_form %>% sim_cleaner() + + if (!is.empty(form)) { + s <- gsub(" ", "", form) %>% sim_splitter("=") + svars <- c() + for (i in 1:length(s)) { + if (grepl("^\\s*#", s[[i]][1])) next + if (grepl("\\s*<-\\s*function\\s*\\(", s[[i]][1])) next + if (grepl(s[[i]][1], s[[i]][2])) next + svars <- c(svars, s[[i]][1]) + } + if (length(svars) > 0) vars <- base::setdiff(vars, svars) + } + + selectizeInput( + "rep_vars", + label = i18n$t("Variables to re-simulate:"), + choices = vars, multiple = TRUE, + selected = state_multiple("rep_vars", vars, isolate(input$rep_vars)), + options = list(placeholder = i18n$t("Select variables"), plugins = list("remove_button")) + ) +}) + +output$ui_rep_sum_vars <- renderUI({ + vars <- sim_vars() + req(!is.empty(vars)) + selectizeInput( + "rep_sum_vars", + label = i18n$t("Output variables:"), + choices = vars, multiple = TRUE, + selected = state_multiple("rep_sum_vars", vars, isolate(input$rep_sum_vars)), + options = list( + placeholder = i18n$t("Select variables"), + plugins = list("remove_button", "drag_drop") + ) + ) +}) + +output$ui_rep_grid_vars <- renderUI({ + const <- input$sim_const %>% sim_cleaner() + if (const != "") { + s <- const %>% sim_splitter() + vars <- c() + for (i in 1:length(s)) { + vars <- c(vars, s[[i]][1]) + } + } + req(!is.empty(vars)) + selectizeInput( + "rep_grid_vars", + label = i18n$t("Name:"), + choices = vars, multiple = FALSE, + selected = state_single("rep_grid_vars", vars) + ) +}) + +output$ui_rep_byvar <- renderUI({ + vars <- setNames( + c(".sim", ".rep"), + c(i18n$t("Simulation"), i18n$t("Repeat")) + ) + selectizeInput( + "rep_byvar", + label = i18n$t("Group by:"), choices = vars, + selected = state_single("rep_byvar", vars), multiple = FALSE, + options = list(placeholder = i18n$t("Select group-by variable")) + ) +}) + +output$ui_rep_fun <- renderUI({ + choices <- setNames( + c( + "sum", "mean", "median", + "min", "max", "sd", "var", + "sdprop", "varprop", + "p01", "p025", "p05", "p10", + "p25", "p75", "p90", "p95", + "p975", "p99", + "first", "last" + ), + c( + i18n$t("sum"), i18n$t("mean"), i18n$t("median"), + i18n$t("min"), i18n$t("max"), i18n$t("sd"), i18n$t("var"), + i18n$t("sdprop"), i18n$t("varprop"), + i18n$t("p01"), i18n$t("p025"), i18n$t("p05"), i18n$t("p10"), + i18n$t("p25"), i18n$t("p75"), i18n$t("p90"), i18n$t("p95"), + i18n$t("p975"), i18n$t("p99"), + i18n$t("first"), i18n$t("last") + ) + ) + selectizeInput( + inputId = "rep_fun", label = i18n$t("Apply function:"), + choices = choices, + selected = state_multiple("rep_fun", choices, isolate(input$rep_fun)), + multiple = TRUE, + options = list(placeholder = i18n$t("None"), plugins = list("remove_button")) + ) +}) + +var_updater <- function(variable, var_str, var_name, var_inputs, fix = TRUE) { + if (is.null(variable) || variable == 0) { + return() + } + if (is.empty(var_inputs[1]) || any(is.na(var_inputs[-1]))) { + showModal( + modalDialog( + title = i18n$t("Inputs required"), + span("Please provide all required inputs"), + footer = modalButton("OK"), + size = "s", + easyClose = TRUE + ) + ) + } else { + if (fix) { + var_name <- fix_names(var_name) + } + inp <- paste(c(var_name, var_inputs), collapse = " ") + if (is.empty(input[[var_str]])) { + val <- paste0(inp, ";") + } else { + val <- paste0(input[[var_str]], "\n", inp, ";") + } + + updateTextInput(session = session, var_str, value = val) + } +} + +var_remover <- function(variable) { + input[[variable]] %>% + strsplit("\n") %>% + unlist() %>% + head(., -1) %>% + paste0(collapse = "\n") %>% + updateTextInput(session = session, variable, value = .) +} + +observeEvent(input$sim_binom_add, { + var_updater( + input$sim_binom_add, "sim_binom", + input$sim_binom_name, c(input$sim_binom_n, input$sim_binom_p) + ) +}) + +observeEvent(input$sim_discrete_add, { + v <- input$sim_discrete_val + p <- input$sim_discrete_prob + + v <- gsub(",", " ", v) %>% + strsplit("\\s+") %>% + unlist() + p <- gsub(",", " ", p) %>% + strsplit("\\s+") %>% + unlist() + + lp <- length(p) + lv <- length(v) + if (lv != lp && lv %% lp == 0) p <- rep(p, lv / lp) + + var_updater( + input$sim_discrete_add, "sim_discrete", + input$sim_discrete_name, paste0(c(v, p), collapse = " ") + ) +}) + +observeEvent(input$sim_lnorm_add, { + var_updater(input$sim_lnorm_add, "sim_lnorm", input$sim_lnorm_name, c(input$sim_lnorm_mean, input$sim_lnorm_sd)) +}) + +observeEvent(input$sim_norm_add, { + var_updater(input$sim_norm_add, "sim_norm", input$sim_norm_name, c(input$sim_norm_mean, input$sim_norm_sd)) +}) + +observeEvent(input$sim_pois_add, { + var_updater(input$sim_pois_add, "sim_pois", input$sim_pois_name, input$sim_pois_lambda) +}) + +observeEvent(input$sim_unif_add, { + var_updater(input$sim_unif_add, "sim_unif", input$sim_unif_name, c(input$sim_unif_min, input$sim_unif_max)) +}) + +observeEvent(input$sim_const_add, { + var_updater(input$sim_const_add, "sim_const", input$sim_const_name, input$sim_const_nr) +}) + +observeEvent(input$sim_sequ_add, { + var_updater(input$sim_sequ_add, "sim_sequ", input$sim_sequ_name, c(input$sim_sequ_min, input$sim_sequ_max)) +}) + +observeEvent(input$rep_grid_add, { + var_updater( + input$rep_grid_add, "rep_grid", + input$rep_grid_name, c(input$rep_grid_min, input$rep_grid_max, input$rep_grid_step) + ) + updateNumericInput(session = session, "rep_nr", value = NA) +}) + +observeEvent(input$sim_grid_add, { + var_updater( + input$sim_grid_add, "sim_grid", + input$sim_grid_name, c(input$sim_grid_min, input$sim_grid_max, input$sim_grid_step) + ) +}) + +observeEvent(c(input$sim_grid, input$sim_types), { + if ("grid" %in% input$sim_types && !is.empty(input$sim_grid)) { + updateNumericInput(session = session, "sim_nr", value = NA) + } else { + val <- ifelse(is.empty(r_state$sim_nr), 1000, r_state$sim_nr) + updateNumericInput(session = session, "sim_nr", value = val) + } +}) + +observeEvent(c(input$rep_grid, input$rep_byvar), { + if (isTRUE(input$rep_byvar %in% c(".rep", "rep")) && !is.empty(input$rep_grid)) { + updateNumericInput(session = session, "rep_nr", value = NA) + } else { + val <- ifelse(is.empty(r_state$rep_nr), 12, r_state$rep_nr) + updateNumericInput(session = session, "rep_nr", value = val) + } +}) + +observeEvent(input$sim_binom_del, { + var_remover("sim_binom") +}) + +observeEvent(input$sim_discrete_del, { + var_remover("sim_discrete") +}) + +observeEvent(input$sim_norm_del, { + var_remover("sim_norm") +}) + +observeEvent(input$sim_lnorm_del, { + var_remover("sim_lnorm") +}) + +observeEvent(input$sim_pois_del, { + var_remover("sim_pois") +}) + +observeEvent(input$sim_unif_del, { + var_remover("sim_unif") +}) +observeEvent(input$sim_const_del, { + var_remover("sim_const") +}) + +observeEvent(input$rep_grid_del, { + var_remover("rep_grid") +}) + +observeEvent(input$sim_sequ_del, { + var_remover("sim_sequ") +}) + +observeEvent(input$sim_grid_del, { + var_remover("sim_grid") +}) + +## add a spinning refresh icon if the simulation needs to be (re)run +run_refresh(sim_args, "sim", init = "types", label = i18n$t("Run simulation"), relabel = i18n$t("Re-run simulation"), data = FALSE) + +## add a spinning refresh icon if the repeated simulation needs to be (re)run +run_refresh(rep_args, "rep", init = "sum_vars", label = i18n$t("Repeat simulation"), data = FALSE) + +output$ui_simulater <- renderUI({ + tagList( + conditionalPanel( + condition = "input.tabs_simulate == 'Simulate'", + wellPanel( + actionButton("sim_run", i18n$t("Run simulation"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ), + wellPanel( + uiOutput("ui_sim_types") + ), + conditionalPanel( + "input.sim_types && input.sim_types.indexOf('binom') >= 0", + wellPanel( + HTML( + paste0( + "" + ) + ), + with(tags, table( + td(textInput("sim_binom_name", i18n$t("Name:"), value = state_init("sim_binom_name", ""))), + td(numericInput("sim_binom_n", i18n$t("n:"), value = state_init("sim_binom_n"), min = 1)), + td(numericInput("sim_binom_p", i18n$t("p:"), value = state_init("sim_binom_p"), min = 0)) + )), + textinput_maker("binom", i18n$t("Binomial")) + ) + ), + conditionalPanel( + "input.sim_types && input.sim_types.indexOf('const') >= 0", + wellPanel( + HTML(paste0( + "" + )), + with(tags, table( + td(textInput("sim_const_name", i18n$t("Name:"), value = state_init("sim_const_name", ""))), + td(numericInput("sim_const_nr", i18n$t("Value:"), value = state_init("sim_const_nr"))) + )), + textinput_maker("const", i18n$t("Constant")) + ) + ), + conditionalPanel( + "input.sim_types && input.sim_types.indexOf('discrete') >= 0", + wellPanel( + HTML(paste0( + "" + )), + with(tags, table( + td(textInput("sim_discrete_name", i18n$t("Name:"), value = state_init("sim_discrete_name", ""))), + td(textInput("sim_discrete_val", i18n$t("Values:"), value = state_init("sim_discrete_val"))), + td(textInput("sim_discrete_prob", i18n$t("Prob.:"), value = state_init("sim_discrete_prob"))) + )), + textinput_maker("discrete", i18n$t("Discrete")) + ) + ), + conditionalPanel( + "input.sim_types && input.sim_types.indexOf('lnorm') >= 0", + wellPanel( + HTML(paste0( + "" + )), + with(tags, table( + td(textInput("sim_lnorm_name", i18n$t("Name:"), value = state_init("sim_lnorm_name", ""))), + td(numericInput("sim_lnorm_mean", i18n$t("Mean:"), value = state_init("sim_lnorm_mean"))), + td(numericInput("sim_lnorm_sd", i18n$t("St.dev.:"), value = state_init("sim_lnorm_sd"), min = 1)) + )), + textinput_maker("lnorm", i18n$t("Log normal")) + ) + ), + conditionalPanel( + "input.sim_types && input.sim_types.indexOf('norm') >= 0", + wellPanel( + HTML(paste0( + "" + )), + with(tags, table( + td(textInput("sim_norm_name", i18n$t("Name:"), value = state_init("sim_norm_name", ""))), + td(numericInput("sim_norm_mean", i18n$t("Mean:"), value = state_init("sim_norm_mean"))), + td(numericInput("sim_norm_sd", i18n$t("St.dev.:"), value = state_init("sim_norm_sd"), min = 0)) + )), + textinput_maker("norm", i18n$t("Normal")), + checkboxInput("sim_nexact", i18n$t("Use exact specifications"), state_init("sim_nexact", FALSE)), + textInput("sim_ncorr", i18n$t("Correlations:"), value = state_init("sim_ncorr")) + ) + ), + conditionalPanel( + "input.sim_types && input.sim_types.indexOf('pois') >= 0", + wellPanel( + HTML(paste0( + "" + )), + with(tags, table( + td(textInput("sim_pois_name", i18n$t("Name:"), value = state_init("sim_pois_name", ""))), + td(numericInput("sim_pois_lambda", i18n$t("Lambda:"), value = state_init("sim_pois_lambda"))) + )), + textinput_maker("pois", i18n$t("Poisson")) + ) + ), + conditionalPanel( + "input.sim_types && input.sim_types.indexOf('unif') >= 0", + wellPanel( + HTML(paste0( + "" + )), + with(tags, table( + td(textInput("sim_unif_name", i18n$t("Name:"), value = state_init("sim_unif_name", ""))), + td(numericInput("sim_unif_min", i18n$t("Min:"), value = state_init("sim_unif_min"))), + td(numericInput("sim_unif_max", i18n$t("Max:"), value = state_init("sim_unif_max"))) + )), + textinput_maker("unif", i18n$t("Uniform")) + ) + ), + conditionalPanel( + "input.sim_types && input.sim_types.indexOf('sequ') >= 0", + wellPanel( + HTML(paste0( + "" + )), + with(tags, table( + td(textInput("sim_sequ_name", i18n$t("Name:"), value = state_init("sim_sequ_name", ""))), + td(numericInput("sim_sequ_min", i18n$t("Min:"), value = state_init("sim_sequ_min"))), + td(numericInput("sim_sequ_max", i18n$t("Max:"), value = state_init("sim_sequ_max"))) + )), + textinput_maker("sequ", i18n$t("Sequence")) + ) + ), + conditionalPanel( + "input.sim_types && input.sim_types.indexOf('grid') >= 0", + wellPanel( + HTML( + paste0( + "" + ) + ), + with(tags, table( + td(textInput("sim_grid_name", i18n$t("Name:"), value = state_init("sim_grid_name", ""))), + td(numericInput("sim_grid_min", i18n$t("Min:"), value = state_init("sim_grid_min"))), + td(numericInput("sim_grid_max", i18n$t("Max:"), value = state_init("sim_grid_max"))), + td(numericInput("sim_grid_step", i18n$t("Step:"), value = state_init("sim_grid_step"))) + )), + textinput_maker("grid") + ) + ), + conditionalPanel( + "input.sim_types && input.sim_types.indexOf('data') >= 0", + wellPanel( + uiOutput("ui_sim_data") + ) + ), + wellPanel( + with(tags, table( + td(numericInput( + "sim_seed", i18n$t("Set random seed:"), + value = state_init("sim_seed", 1234), + )), + td(numericInput( + "sim_nr", i18n$t("# sims:"), + min = 1, max = 10^6, + value = state_init("sim_nr", 1000), + width = "95px" + )) + )), + with(tags, table( + td(textInput("sim_name", i18n$t("Simulated data:"), state_init("sim_name", "simdat"))), + td(numericInput("sim_dec", label = i18n$t("Decimals:"), value = state_init("sim_dec", 4), min = 0, width = "95px")) + )), + with(tags, table( + td(checkboxInput("sim_add_functions", i18n$t("Add functions"), state_init("sim_add_functions", FALSE))), + td(HTML("   ")), + td(checkboxInput("sim_show_plots", i18n$t("Show plots"), state_init("sim_show_plots", FALSE))) + )) + ), + help_and_report( + modal_title = i18n$t("Simulate"), fun_name = "simulater", + help_file = inclMD(file.path(getOption("radiant.path.model"), "app/tools/help/simulater.md")) + ) + ), + conditionalPanel( + condition = "input.tabs_simulate == 'Repeat'", + wellPanel( + actionButton("rep_run", i18n$t("Repeat simulation"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ), + wellPanel( + uiOutput("ui_rep_vars"), + uiOutput("ui_rep_sum_vars") + ), + wellPanel( + uiOutput("ui_rep_byvar"), + conditionalPanel( + condition = "input.rep_byvar == '.rep'", + HTML(paste0( + "" + )), + with(tags, table( + td(textInput("rep_grid_name", i18n$t("Name:"), value = state_init("rep_grid_name", ""))), + td(numericInput("rep_grid_min", i18n$t("Min:"), value = state_init("rep_grid_min"))), + td(numericInput("rep_grid_max", i18n$t("Max:"), value = state_init("rep_grid_max"))), + td(numericInput("rep_grid_step", i18n$t("Step:"), value = state_init("rep_grid_step"))) + )), + textinput_maker("grid", "", pre = "rep_") + ), + uiOutput("ui_rep_fun") + ), + wellPanel( + with(tags, table( + td(numericInput( + "rep_seed", i18n$t("Set random seed:"), + value = state_init("rep_seed", 1234) + )), + td(numericInput( + "rep_nr", i18n$t("# reps:"), + min = 1, max = 10^6, + value = state_init("rep_nr", 12), + width = "95px" + )) + )), + with(tags, table( + td(textInput("rep_name", i18n$t("Repeat data:"), state_init("rep_name", "repdat"))), + td(numericInput("rep_dec", label = i18n$t("Decimals:"), value = state_init("rep_dec", 4), min = 0, max = 10, width = "95px")) + )), + with(tags, table( + # td(checkboxInput("rep_add_functions", "Add functions", state_init("rep_add_functions", FALSE))), + # td(HTML("   ")), + td(checkboxInput("rep_show_plots", i18n$t("Show plots"), state_init("rep_show_plots", FALSE))) + )) + ), + help_and_report( + modal_title = i18n$t("Repeat simulation"), fun_name = "repeater", + help_file = inclMD(file.path(getOption("radiant.path.model"), "app/tools/help/simulater.md")) + ) + ) + ) +}) + +## output is called from the main radiant ui.R +output$simulater <- renderUI({ + register_print_output("summary_simulate", ".summary_simulate") + register_plot_output( + "plot_simulate", ".plot_simulate", + width_fun = "sim_plot_width", + height_fun = "sim_plot_height" + ) + + register_print_output("summary_repeat", ".summary_repeat") + register_plot_output( + "plot_repeat", ".plot_repeat", + width_fun = "rep_plot_width", + height_fun = "rep_plot_height" + ) + + ## mulitple tabs with components stacked + sim_output_panels <- tabsetPanel( + id = "tabs_simulate", + tabPanel( + i18n$t("Simulate"), value = "Simulate", + HTML(i18n$t("")), + shinyAce::aceEditor( + "sim_form", + mode = "r", + theme = getOption("radiant.ace_theme", default = "tomorrow"), + wordWrap = TRUE, + debounce = -1, + height = "120px", + value = state_init("sim_form", "") %>% fix_smart(), + placeholder = i18n$t("Use formulas to perform calculations on simulated variables\n(e.g., demand = 5 * price). Press the Run simulation button\nto run the simulation. Click the ? icon on the bottom left\nof your screen for help and examples"), + vimKeyBinding = getOption("radiant.ace_vim.keys", default = FALSE), + tabSize = getOption("radiant.ace_tabSize", 2), + useSoftTabs = getOption("radiant.ace_useSoftTabs", TRUE), + showInvisibles = getOption("radiant.ace_showInvisibles", FALSE), + autoScrollEditorIntoView = TRUE, + minLines = 7, + maxLines = 20 + ), + conditionalPanel( + "input.sim_add_functions == true", + HTML(i18n$t("
    ")), + shinyAce::aceEditor( + "sim_funcs", + mode = "r", + theme = getOption("radiant.ace_theme", default = "tomorrow"), + wordWrap = TRUE, + debounce = -1, + height = "120px", + value = state_init("sim_funcs", "") %>% fix_smart(), + placeholder = i18n$t("Create your own R functions (e.g., add = function(x, y) {x + y}).\nCall these functions from the 'formula' input and press the Run\nsimulation button to run the simulation. Click the ? icon on the\nbottom left of your screen for help and examples"), + vimKeyBinding = getOption("radiant.ace_vim.keys", default = FALSE), + tabSize = getOption("radiant.ace_tabSize", 2), + useSoftTabs = getOption("radiant.ace_useSoftTabs", TRUE), + showInvisibles = getOption("radiant.ace_showInvisibles", FALSE), + autoScrollEditorIntoView = TRUE, + minLines = 7, + maxLines = 20, + autoComplete = "live", + autoCompleters = c("static", "text"), + autoCompleteList = isolate(radiant_sim_auto()) + ) + ), + HTML(i18n$t("
    ")), + verbatimTextOutput("summary_simulate"), + conditionalPanel( + condition = "input.sim_show_plots == true", + HTML(i18n$t("
    ")), + download_link("dlp_simulate"), + plotOutput("plot_simulate", height = "100%") + ) + ), + tabPanel( + i18n$t("Repeat"), value = "Repeat", + HTML(i18n$t("")), + shinyAce::aceEditor( + "rep_form", + mode = "r", + theme = getOption("radiant.ace_theme", default = "tomorrow"), + wordWrap = TRUE, + debounce = -1, + height = "120px", + value = state_init("rep_form", "") %>% fix_smart(), + placeholder = i18n$t("Press the Repeat simulation button to repeat the simulation specified in the\nSimulate tab. Use formulas to perform additional calculations on the repeated\nsimulation data. Click the ? icon on the bottom left of your screen for help\nand examples"), + vimKeyBinding = getOption("radiant.ace_vim.keys", default = FALSE), + tabSize = getOption("radiant.ace_tabSize", 2), + useSoftTabs = getOption("radiant.ace_useSoftTabs", TRUE), + showInvisibles = getOption("radiant.ace_showInvisibles", FALSE), + autoScrollEditorIntoView = TRUE, + minLines = 7, + maxLines = 20 + ), + conditionalPanel( + "input.rep_add_functions == true", + HTML(i18n$t("
    ")), + shinyAce::aceEditor( + "rep_funcs", + mode = "r", + theme = getOption("radiant.ace_theme", default = "tomorrow"), + wordWrap = TRUE, + debounce = -1, + height = "120px", + value = state_init("rep_funcs", "") %>% fix_smart(), + placeholder = i18n$t("Create your own R functions (e.g., add = function(x, y) {x + y}).\nCall these functions from the 'formula' input and press the Run\nsimulation button to run the simulation. Click the ? icon on the\nbottom left of your screen for help and examples"), + vimKeyBinding = getOption("radiant.ace_vim.keys", default = FALSE), + tabSize = getOption("radiant.ace_tabSize", 2), + useSoftTabs = getOption("radiant.ace_useSoftTabs", TRUE), + showInvisibles = getOption("radiant.ace_showInvisibles", FALSE), + autoScrollEditorIntoView = TRUE, + minLines = 7, + maxLines = 20 + ) + ), + HTML(i18n$t("
    ")), + verbatimTextOutput("summary_repeat"), + conditionalPanel( + condition = "input.rep_show_plots == true", + HTML(i18n$t("
    ")), + download_link("dlp_repeat"), + plotOutput("plot_repeat", height = "100%") + ) + ) + ) + + stat_tab_panel( + menu = i18n$t("Model > Decide"), + tool = i18n$t("Simulate"), + data = NULL, + tool_ui = "ui_simulater", + output_panels = sim_output_panels + ) +}) + +## creating autocomplete list for simuate - function editor +radiant_sim_auto <- reactive({ + pkgs <- c("stats", "base", "radiant.data") %>% + sapply(function(x) grep("^[A-Za-z]", getNamespaceExports(x), value = TRUE)) %>% + set_names(., paste0("{", names(.), "}")) + + inp <- clean_args(sim_inputs(), sim_args) %>% lapply(report_cleaner) + nms <- base::intersect(c(sim_types_vec, "form"), names(inp)) + auto_nms <- list() + + for (i in nms) { + auto_nms[[paste0("{sim ", i, "}")]] <- strsplit(inp[[i]], ";\\s*")[[1]] %>% + strsplit(., "(\\s+|=)") %>% + base::Filter(length, .) %>% + sapply(., `[[`, 1) + } + + c(pkgs, auto_nms) +}) + +## auto completion for r-functions and defined variables +observe({ + req(isTRUE(input$sim_add_functions)) + shinyAce::updateAceEditor( + session, "sim_funcs", + autoCompleters = c("static", "text"), + autoCompleteList = radiant_sim_auto() + ) +}) + +.simulater <- eventReactive(input$sim_run, { + validate( + need( + !is.empty(input$sim_types) || !is.empty(input$sim_form), + i18n$t("No formulas or simulated variables specified") + ) + ) + fixed <- fix_names(input$sim_name) + updateTextInput(session, "sim_name", value = fixed) + withProgress(message = i18n$t("Running simulation"), value = 0.5, { + inp <- sim_inputs() + inp$name <- fixed + inp$envir <- r_data + sim <- do.call(simulater, inp) + if (is.data.frame(sim)) { + r_data[[fixed]] <- sim + register(fixed) + } + sim + }) +}) + +.summary_simulate <- eventReactive( + { + c(input$sim_run, input$sim_dec) + }, + { + if (not_pressed(input$sim_run)) { + i18n$t("** Press the Run simulation button to simulate data **") + } else { + summary(.simulater(), dec = input$sim_dec) + } + } +) + +sim_plot_width <- function() 650 +sim_plot_height <- function() { + sim <- .simulater() + if (is.character(sim)) { + 300 + } else { + if (dim(sim)[1] == 0) { + 300 + } else { + ceiling(sum(sapply(sim, does_vary)) / 2) * 300 + } + } +} + +.plot_simulate <- eventReactive(input$sim_run, { + req(input$sim_show_plots) + withProgress(message = i18n$t("Generating simulation plots"), value = 1, { + .simulater() %>% + { + if (is.empty(.)) invisible() else plot(., shiny = TRUE) + } + }) +}) + +.repeater <- eventReactive(input$rep_run, { + fixed <- fix_names(input$rep_name) + updateTextInput(session, "rep_name", value = fixed) + + withProgress(message = i18n$t("Repeated simulation"), value = 0.5, { + inp <- rep_inputs() + inp$name <- fixed + inp$envir <- r_data + rep <- do.call(repeater, inp) + if (is.data.frame(rep)) { + r_data[[fixed]] <- rep + register(fixed) + } + rep + }) +}) + +.summary_repeat <- eventReactive( + { + c(input$rep_run, input$rep_dec) + }, + { + if (not_pressed(input$rep_run)) { + i18n$t("** Press the Repeat simulation button **") + } else if (length(input$rep_sum_vars) == 0) { + i18n$t("Select at least one Output variable") + } else if (input$rep_byvar == ".sim" && is.empty(input$rep_nr)) { + i18n$t("Please specify the number of repetitions in '# reps'") + } else { + summary(.repeater(), dec = input$rep_dec) + } + } +) + +rep_plot_width <- function() 650 +rep_plot_height <- function() { + if (length(input$rep_sum_vars) == 0) { + return(300) + } + rp <- .repeater() + if (is.character(rp)) { + 300 + } else { + if (dim(rp)[1] == 0) { + 300 + } else { + ceiling(sum(sapply(select(rp, -1), does_vary)) / 2) * 300 + } + } +} + +.plot_repeat <- eventReactive(input$rep_run, { + req(input$rep_show_plots) + req(length(input$rep_sum_vars) > 0) + if (input$rep_byvar == ".sim" && is.empty(input$rep_nr)) { + return(invisible()) + } # else if (input$rep_byvar == "rep" && is.empty(input$rep_grid)) { + # return(invisible()) + # } + object <- .repeater() + if (is.null(object)) { + return(invisible()) + } + withProgress(message = i18n$t("Generating repeated simulation plots"), value = 1, { + inp <- rep_plot_inputs() + inp$shiny <- TRUE + inp$x <- object + do.call(plot, inp) + }) +}) + +report_cleaner <- function(x) { + x %>% + gsub("\n", ";", .) %>% + gsub("[;]{2,}", ";", .) +} + +simulater_report <- function() { + sim_dec <- input$sim_dec %>% ifelse(is.empty(.), 3, .) + outputs <- "summary" + inp_out <- list(list(dec = sim_dec), "") + figs <- FALSE + + if (isTRUE(input$sim_show_plots)) { + outputs <- c("summary", "plot") + inp_out[[2]] <- list(custom = FALSE) + figs <- TRUE + } + + ## report cleaner turns seed and nr into strings + inp <- clean_args(sim_inputs(), sim_args) %>% lapply(report_cleaner) + sim_name <- fix_names(input$sim_name) + updateTextInput(session, "sim_name", value = sim_name) + + if (!is.empty(inp$seed)) inp$seed <- as_numeric(inp$seed) + if (!is.empty(inp$nr)) inp$nr <- as_numeric(inp$nr) + if (!"norm" %in% names(inp)) { + inp$ncorr <- inp$nexact <- NULL + } else { + if (is.empty(inp$ncorr)) inp$ncorr <- NULL + if (!is.empty(inp$nexact)) inp$nexact <- as.logical(inp$nexact) + } + for (i in c(sim_types_vec, "form")) { + if (i %in% names(inp)) { + inp[[i]] <- strsplit(inp[[i]], ";\\s*")[[1]] + } + } + if (length(inp[["form"]]) == 1 && grepl("^#", inp[["form"]])) { + inp[["form"]] <- NULL + } + if (is.empty(inp$data)) { + inp$data <- NULL + } else { + inp$data <- as.symbol(inp$data) + } + + pre_cmd <- paste0(sim_name, " <- ") + if (!is.empty(input$sim_funcs)) { + ## dealing with user defined functions in simulate tab + pre_cmd <- gsub(" ", " ", input$sim_funcs) %>% + gsub("\t", " ", .) %>% + paste0("\n\n", pre_cmd) + funcs <- parse(text = input$sim_funcs) + lfuncs <- list() + for (i in seq_len(length(funcs))) { + tmp <- strsplit(as.character(funcs[i]), "(\\s*=|\\s*<-)")[[1]][1] + lfuncs[[tmp]] <- as.symbol(tmp) + } + if (length(lfuncs) == 0) { + pre_cmd <- paste0(sim_name, " <- ") + inp$funcs <- NULL + } else { + inp$funcs <- lfuncs + } + } + inp$name <- NULL + update_report( + inp_main = inp, + fun_name = "simulater", + inp_out = inp_out, + pre_cmd = pre_cmd, + xcmd = paste0("register(\"", sim_name, "\")"), + outputs = outputs, + inp = sim_name, + figs = figs, + fig.width = sim_plot_width(), + fig.height = sim_plot_height() + ) +} + +observeEvent(input$repeater_report, { + rep_dec <- input$rep_dec %>% ifelse(is.empty(.), 3, .) + outputs <- "summary" + inp_out <- list(list(dec = rep_dec), "") + figs <- FALSE + + if (isTRUE(input$rep_show_plots)) { + outputs <- c("summary", "plot") + inp_out[[2]] <- list(custom = FALSE) + figs <- TRUE + } + + ## report cleaner turns seed and nr into strings + inp <- clean_args(rep_inputs(), rep_args) %>% lapply(report_cleaner) + rep_name <- fix_names(input$rep_name) + updateTextInput(session, "rep_name", value = rep_name) + inp$dataset <- fix_names(input$sim_name) + updateTextInput(session, "sim_name", value = inp$dataset) + + if (!is.empty(inp$seed)) inp$seed <- as_numeric(inp$seed) + if (!is.empty(inp$nr)) inp$nr <- as_numeric(inp$nr) + if (input$rep_byvar == ".sim") inp$grid <- NULL + + if (!is.empty(inp[["form"]])) { + inp[["form"]] <- strsplit(inp[["form"]], ";\\s*")[[1]] + if (length(inp[["form"]]) == 1 && grepl("^#", inp[["form"]])) { + inp[["form"]] <- NULL + } + } + if (!is.empty(inp[["grid"]])) { + inp[["grid"]] <- strsplit(inp[["grid"]], ";\\s*")[[1]] + } + inp$name <- NULL + update_report( + inp_main = inp, + fun_name = "repeater", + inp_out = inp_out, + pre_cmd = paste0(rep_name, " <- "), + xcmd = paste0("register(\"", rep_name, "\")"), + outputs = outputs, + inp = rep_name, + figs = figs, + fig.width = rep_plot_width(), + fig.height = rep_plot_height() + ) +}) + +download_handler( + id = "dlp_simulate", + fun = download_handler_plot, + fn = function() paste0(input$sim_name, "_sim"), + type = "png", + caption = i18n$t("Save simulation plots"), + plot = .plot_simulate, + width = sim_plot_width, + height = sim_plot_height +) + +download_handler( + id = "dlp_repeat", + fun = download_handler_plot, + fn = function() paste0(input$rep_name, "_rep"), + type = "png", + caption = i18n$t("Save repeated simulation plots"), + plot = .plot_repeat, + width = rep_plot_width, + height = rep_plot_height +) + +observeEvent(input$simulater_report, { + r_info[["latest_screenshot"]] <- NULL + simulater_report() +}) + +observeEvent(input$simulater_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_simulater_screenshot") +}) + +observeEvent(input$modal_simulater_screenshot, { + simulater_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.model/inst/app/tools/analysis/svm_ui.R b/radiant.model/inst/app/tools/analysis/svm_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..8bb64e71e7991432e52863c361a8d996946d5e9f --- /dev/null +++ b/radiant.model/inst/app/tools/analysis/svm_ui.R @@ -0,0 +1,687 @@ +## ========== svm_ui.R ========== + +## 1. plot 列表 ---------------------------------------------------------- +svm_plots <- c( + "none", "dist", "correlations", "scatter", "vip", "pred_plot", "pdp", "dashboard", "residuals", "coef", "influence" +) +names(svm_plots) <- c( + i18n$t("None"), + i18n$t("Distribution"), + i18n$t("Correlations"), + i18n$t("Scatter"), + i18n$t("Permutation Importance"), + i18n$t("Prediction plots"), + i18n$t("Partial Dependence"), + i18n$t("Dashboard"), + i18n$t("Residuals vs fitted"), + i18n$t("Coefficient plot"), + i18n$t("Influential observations") +) + +## 2. 函数缺省参数 ------------------------------------------------------- +svm_args <- as.list(formals(svm)) +## 3. 用户输入收集 ------------------------------------------------------- +svm_inputs <- reactive({ + svm_args$data_filter <- if (input$show_filter) input$data_filter else "" + svm_args$arr <- if (input$show_filter) input$data_arrange else "" + svm_args$rows <- if (input$show_filter) input$data_rows else "" + svm_args$dataset <- input$dataset + for (i in r_drop(names(svm_args))) { + svm_args[[i]] <- input[[paste0("svm_", i)]] + } + svm_args +}) + +## 4. predict 参数 ------------------------------------------------------- +svm_pred_args <- as.list(if (exists("predict.svm")) { + formals(predict.svm) +} else { + formals(e1071:::predict.svm) +}) + +svm_pred_inputs <- reactive({ + for (i in names(svm_pred_args)) { + svm_pred_args[[i]] <- input[[paste0("svm_", i)]] + } + + svm_pred_args$pred_cmd <- svm_pred_args$pred_data <- "" + if (input$svm_predict == "cmd") { + svm_pred_args$pred_cmd <- gsub("\\s{2,}", " ", input$svm_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% + gsub("\"", "\'", .) + } else if (input$svm_predict == "data") { + svm_pred_args$pred_data <- input$svm_pred_data + } else if (input$svm_predict == "datacmd") { + svm_pred_args$pred_cmd <- gsub("\\s{2,}", " ", input$svm_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% + gsub("\"", "\'", .) + svm_pred_args$pred_data <- input$svm_pred_data + } + svm_pred_args +}) + +## 5. plot 参数 --------------------------------------------------------- +svm_plot_args <- as.list(if (exists("plot.svm")) { + formals(plot.svm) +} else { + formals(e1071:::plot.svm) +}) + +svm_plot_inputs <- reactive({ + for (i in names(svm_plot_args)) { + svm_plot_args[[i]] <- input[[paste0("svm_", i)]] + } + svm_plot_args +}) + +## 6. pred-plot 参数 ---------------------------------------------------- +svm_pred_plot_args <- as.list(if (exists("plot.model.predict")) { + formals(plot.model.predict) +} else { + formals(radiant.model:::plot.model.predict) +}) + +svm_pred_plot_inputs <- reactive({ + for (i in names(svm_pred_plot_args)) { + svm_pred_plot_args[[i]] <- input[[paste0("svm_", i)]] + } + svm_pred_plot_args +}) + +## 7. 响应变量 ---------------------------------------------------------- +output$ui_svm_rvar <- renderUI({ + withProgress(message = i18n$t("Acquiring variable information"), value = 1, { + if (input$svm_type == "classification") { + vars <- two_level_vars() + } else { + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- varnames()[isNum] + } + }) + + init <- if (input$svm_type == "classification") { + if (is.empty(input$logit_rvar)) isolate(input$svm_rvar) else input$logit_rvar + } else { + if (is.empty(input$reg_rvar)) isolate(input$svm_rvar) else input$reg_rvar + } + + selectInput( + inputId = "svm_rvar", + label = i18n$t("Response variable:"), + choices = vars, + selected = state_single("svm_rvar", vars, init), + multiple = FALSE + ) +}) + +## 8. 分类时选正类 ------------------------------------------------------ +output$ui_svm_lev <- renderUI({ + req(input$svm_type == "classification") + req(available(input$svm_rvar)) + levs <- .get_data()[[input$svm_rvar]] %>% as_factor() %>% levels() + + init <- if (is.empty(input$logit_lev)) isolate(input$svm_lev) else input$logit_lev + selectInput( + inputId = "svm_lev", label = i18n$t("Choose level:"), + choices = levs, + selected = state_init("svm_lev", init) + ) +}) + +## 9. 解释变量 ---------------------------------------------------------- +output$ui_svm_evar <- renderUI({ + if (not_available(input$svm_rvar)) return() + vars <- varnames() + if (length(vars) > 0) vars <- vars[-which(vars == input$svm_rvar)] + + init <- if (input$svm_type == "classification") { + if (is.empty(input$logit_evar)) isolate(input$svm_evar) else input$logit_evar + } else { + if (is.empty(input$reg_evar)) isolate(input$svm_evar) else input$reg_evar + } + + selectInput( + inputId = "svm_evar", + label = i18n$t("Explanatory variables:"), + choices = vars, + selected = state_multiple("svm_evar", vars, init), + multiple = TRUE, + size = min(10, length(vars)), + selectize = FALSE + ) +}) + +## 10. 权重变量 --------------------------------------------------------- +output$ui_svm_wts <- renderUI({ + isNum <- .get_class() %in% c("integer", "numeric", "ts") + vars <- varnames()[isNum] + if (length(vars) > 0 && any(vars %in% input$svm_evar)) { + vars <- base::setdiff(vars, input$svm_evar) + names(vars) <- varnames() %>% { .[match(vars, .)] } %>% names() + } + vars <- c("None", vars) + + selectInput( + inputId = "svm_wts", label = i18n$t("Weights:"), choices = vars, + selected = state_single("svm_wts", vars), + multiple = FALSE + ) +}) + +## 11. 存储预测/残差名 -------------------------------------------------- +output$ui_svm_store_pred_name <- renderUI({ + init <- state_init("svm_store_pred_name", "pred_svm") %>% + sub("\\d{1,}$", "", .) %>% + paste0(., ifelse(is.empty(input$svm_cost), "", input$svm_cost)) + textInput( + "svm_store_pred_name", + i18n$t("Store predictions:"), + init + ) +}) + +output$ui_svm_store_res_name <- renderUI({ + req(input$dataset) + textInput("svm_store_res_name", i18n$t("Store residuals:"), "", placeholder = i18n$t("Provide variable name")) +}) + +## 12. 预测与绘图重置 --------------------------------------------------- +observeEvent(input$dataset, { + updateSelectInput(session, "svm_predict", selected = "none") + updateSelectInput(session, "svm_plots", selected = "none") +}) +observeEvent(input$svm_type, { + updateSelectInput(session, "svm_predict", selected = "none") + updateSelectInput(session, "svm_plots", selected = "none") +}) + +## 13. 预测控制 ---------------------------------------------------------- +output$ui_svm_predict_plot <- renderUI({ + predict_plot_controls("svm") +}) + +## 14. 绘图数量 ---------------------------------------------------------- +output$ui_svm_plots <- renderUI({ + req(input$svm_type) + if (input$svm_type != "regression") { + svm_plots <- head(svm_plots, -1) # 去掉 regression 专用图 + } + selectInput( + "svm_plots", i18n$t("Plots:"), + choices = svm_plots, + selected = state_single("svm_plots", svm_plots) + ) +}) + +## 15. 绘图点数 ---------------------------------------------------------- +output$ui_svm_nrobs <- renderUI({ + nrobs <- nrow(.get_data()) + choices <- c("1,000" = 1000, "5,000" = 5000, "10,000" = 10000, "All" = -1) %>% .[. < nrobs] + selectInput( + "svm_nrobs", i18n$t("Number of data points plotted:"), + choices = choices, + selected = state_single("svm_nrobs", choices, 1000) + ) +}) + +## 16. 刷新按钮 ---------------------------------------------------------- +run_refresh(svm_args, "svm", tabs = "tabs_svm", + label = i18n$t("Estimate model"), + relabel = i18n$t("Re-estimate model")) + +## 17. 主 UI 组装 -------------------------------------------------------- +output$ui_svm <- renderUI({ + req(input$dataset) + tagList( + conditionalPanel( + condition = "input.tabs_svm == 'Summary'", + wellPanel( + actionButton("svm_run", i18n$t("Estimate model"), width = "100%", + icon = icon("play", verify_fa = FALSE), class = "btn-success") + ) + ), + wellPanel( + conditionalPanel( + condition = "input.tabs_svm == 'Summary'", + radioButtons( + "svm_type", + label = NULL, + choices = c("classification", "regression") %>% { + names(.) <- c(i18n$t("Classification"), i18n$t("Regression")); . + }, + inline = TRUE + ), + uiOutput("ui_svm_rvar"), + uiOutput("ui_svm_lev"), + uiOutput("ui_svm_evar"), + uiOutput("ui_svm_wts"), + selectInput( + "svm_kernel", + label = i18n$t("Kernel:"), + choices = c("linear", "polynomial", "radial", "sigmoid") %>% { + names(.) <- c(i18n$t("Linear"), i18n$t("Polynomial"), + i18n$t("Radial"), i18n$t("Sigmoid")); . + }, + selected = state_init("svm_kernel", "radial") + ), + fluidRow( + column(6, + numericInput( + "svm_cost", + label = i18n$t("Cost (C):"), + min = 0.01, max = 100, + value = state_init("svm_cost", 1), + step = 0.01, width = "100%" + ) + ), + column(6, + conditionalPanel( + "input.svm_kernel != 'linear'", + numericInput( + "svm_gamma", + label = i18n$t("Gamma:"), + min = 0.001, max = 10, + value = state_init("svm_gamma", "auto"), + step = 0.001, width = "100%" + ) + ) + ) + ), + fluidRow( + column(6, + conditionalPanel( + "input.svm_kernel %in% c('polynomial', 'sigmoid')", + numericInput( + "svm_coef0", + label = i18n$t("Coef0:"), + min = 0, max = 100, + value = state_init("svm_coef0", 0), + width = "100%" + ) + ) + ), + column(6, + conditionalPanel( + "input.svm_type == 'regression'", + numericInput( + "svm_epsilon", + label = i18n$t("Epsilon (tube):"), + min = 0.001, max = 1, + value = state_init("svm_epsilon", 0.1), + step = 0.001, width = "100%" + ) + ) + ) + ), + numericInput( + "svm_seed", + label = i18n$t("Seed:"), + value = state_init("svm_seed", 12345), + width = "90px" + ), + conditionalPanel( + "input.svm_type == 'classification'", + checkboxInput( + "svm_probability", + label = i18n$t("Estimate class probabilities"), + value = state_init("svm_probability", FALSE) + ) + ), + ), + conditionalPanel( + condition = "input.tabs_svm == 'Predict'", + selectInput( + "svm_predict", + label = i18n$t("Prediction input type:"), + choices = reg_predict, + selected = state_single("svm_predict", reg_predict, "none") + ), + conditionalPanel( + "input.svm_predict == 'data' | input.svm_predict == 'datacmd'", + selectizeInput( + inputId = "svm_pred_data", label = i18n$t("Prediction data:"), + choices = c("None" = "", r_info[["datasetlist"]]), + selected = state_single("svm_pred_data", c("None" = "", r_info[["datasetlist"]])), + multiple = FALSE + ) + ), + conditionalPanel( + "input.svm_predict == 'cmd' | input.svm_predict == 'datacmd'", + returnTextAreaInput( + "svm_pred_cmd", i18n$t("Prediction command:"), + value = state_init("svm_pred_cmd", ""), + rows = 3, + placeholder = i18n$t("Type a formula to set values for model variables (e.g., carat = 1; cut = 'Ideal') and press return") + ) + ), + conditionalPanel( + condition = "input.svm_predict != 'none'", + checkboxInput("svm_pred_plot", i18n$t("Plot predictions"), state_init("svm_pred_plot", FALSE)), + conditionalPanel( + "input.svm_pred_plot == true", + uiOutput("ui_svm_predict_plot") + ) + ), + conditionalPanel( + "input.svm_predict == 'data' | input.svm_predict == 'datacmd'", + tags$table( + tags$td(uiOutput("ui_svm_store_pred_name")), + tags$td(actionButton("svm_store_pred", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ) + ), + conditionalPanel( + condition = "input.tabs_svm == 'Plot'", + uiOutput("ui_svm_plots"), + conditionalPanel( + condition = "input.svm_plots == 'pdp' | input.svm_plots == 'pred_plot'", + uiOutput("ui_svm_incl"), + uiOutput("ui_svm_incl_int") + ), + conditionalPanel( + condition = "input.svm_plots == 'dashboard'", + uiOutput("ui_svm_nrobs") + ) + ), + conditionalPanel( + condition = "input.tabs_svm == 'Summary'", + tags$table( + tags$td(uiOutput("ui_svm_store_res_name")), + tags$td(actionButton("svm_store_res", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ) + ), + help_and_report( + modal_title = i18n$t("Support Vector Machine (SVM)"), + fun_name = "svm", + help_file = inclMD(file.path(getOption("radiant.path.model"), "app/tools/help/svm.md")) + ) + ) +}) + +## 18. 绘图尺寸动态计算 ------------------------------------------------- +svm_plot <- reactive({ + if (svm_available() != "available") return() + if (is.empty(input$svm_plots, "none")) return() + + plot_width <- 650 + if (input$svm_plots == "dashboard") { + plot_height <- 750 + } else if (input$svm_plots %in% c("pdp", "pred_plot")) { + nr_vars <- length(input$svm_incl) + length(input$svm_incl_int) + plot_height <- max(250, ceiling(nr_vars / 2) * 250) + if (length(input$svm_incl_int) > 0) { + plot_width <- plot_width + min(2, length(input$svm_incl_int)) * 90 + } + } else { + plot_height <- 500 + } + list(plot_width = plot_width, plot_height = plot_height) +}) + +svm_plot_width <- function() svm_plot() %>% (function(x) if (is.list(x)) x$plot_width else 650) +svm_plot_height <- function() svm_plot() %>% (function(x) if (is.list(x)) x$plot_height else 500) +svm_pred_plot_height <- function() if (input$svm_pred_plot) 500 else 1 + +## 19. 输出注册 ---------------------------------------------------------- +output$svm <- renderUI({ + register_print_output("summary_svm", ".summary_svm") + register_print_output("predict_svm", ".predict_print_svm") + register_plot_output("predict_plot_svm", ".predict_plot_svm", + height_fun = "svm_pred_plot_height") + register_plot_output("plot_svm", ".plot_svm", + height_fun = "svm_plot_height", + width_fun = "svm_plot_width") + + svm_output_panels <- tabsetPanel( + id = "tabs_svm", + tabPanel(i18n$t("Summary"), value = "Summary", + download_link("dl_svm_coef"), br(), + verbatimTextOutput("summary_svm")), + tabPanel(i18n$t("Predict"), value = "Predict", + conditionalPanel( + "input.svm_pred_plot == true", + download_link("dlp_svm_pred"), + plotOutput("predict_plot_svm", width = "100%", height = "100%") + ), + download_link("dl_svm_pred"), br(), + verbatimTextOutput("predict_svm")), + tabPanel(i18n$t("Plot"), value = "Plot", + download_link("dlp_svm"), + plotOutput("plot_svm", width = "100%", height = "100%")) + ) + + stat_tab_panel( + menu = i18n$t("Model > Estimate"), + tool = i18n$t("Support Vector Machine (SVM)"), + tool_ui = "ui_svm", + output_panels = svm_output_panels + ) +}) + +## 20. 可用性检查 ------------------------------------------------------- +svm_available <- reactive({ + req(input$svm_type) + if (not_available(input$svm_rvar)) { + if (input$svm_type == "classification") { + i18n$t("This analysis requires a response variable with two levels and one\nor more explanatory variables. If these variables are not available\nplease select another dataset.\n\n") %>% + suggest_data("titanic") + } else { + i18n$t("This analysis requires a response variable of type integer\nor numeric and one or more explanatory variables.\nIf these variables are not available please select another dataset.\n\n") %>% + suggest_data("diamonds") + } + } else if (not_available(input$svm_evar)) { + if (input$svm_type == "classification") { + i18n$t("Please select one or more explanatory variables.") %>% suggest_data("titanic") + } else { + i18n$t("Please select one or more explanatory variables.") %>% suggest_data("diamonds") + } + } else { + "available" + } +}) + +## 21. 模型估计 ---------------------------------------------------------- +.svm <- eventReactive(input$svm_run, { + svmi <- svm_inputs() + svmi$envir <- r_data + withProgress(message = i18n$t("Estimating SVM"), value = 1, + do.call(svm, svmi)) +}) + +## 22. summary ------------------------------------------------------------ +.summary_svm <- reactive({ + if (not_pressed(input$svm_run)) return(i18n$t("** Press the Estimate button to estimate the model **")) + if (svm_available() != "available") return(svm_available()) + summary(.svm()) +}) + +## 23. predict ------------------------------------------------------------ +.predict_svm <- reactive({ + if (not_pressed(input$svm_run)) return(i18n$t("** Press the Estimate button to estimate the model **")) + if (svm_available() != "available") return(svm_available()) + if (is.empty(input$svm_predict, "none")) return(i18n$t("** Select prediction input **")) + if ((input$svm_predict == "data" || input$svm_predict == "datacmd") && is.empty(input$svm_pred_data)) + return(i18n$t("** Select data for prediction **")) + if (input$svm_predict == "cmd" && is.empty(input$svm_pred_cmd)) + return(i18n$t("** Enter prediction commands **")) + + withProgress(message = i18n$t("Generating predictions"), value = 1, { + spi <- svm_pred_inputs() + spi$object <- .svm() + spi$envir <- r_data + do.call(predict, spi) + }) +}) + +.predict_print_svm <- reactive({ + .predict_svm() %>% { if (is.character(.)) cat(., "\n") else print(.) } +}) + +## 24. pred-plot ---------------------------------------------------------- +.predict_plot_svm <- reactive({ + req(pressed(input$svm_run), input$svm_pred_plot, available(input$svm_xvar), + !is.empty(input$svm_predict, "none")) + withProgress(message = i18n$t("Generating prediction plot"), value = 1, + do.call(plot, c(list(x = .predict_svm()), svm_pred_plot_inputs()))) +}) + +## 25. plot -------------------------------------------------------------- +.plot_svm <- reactive({ + if (not_pressed(input$svm_run)) return(i18n$t("** Press the Estimate button to estimate the model **")) + if (svm_available() != "available") return(svm_available()) + if (is.empty(input$svm_plots, "none")) return(i18n$t("Please select an SVM plot from the drop-down menu")) + pinp <- svm_plot_inputs() + pinp$shiny <- TRUE + if (input$svm_plots == "dashboard") req(input$svm_nrobs) + + withProgress(message = i18n$t("Generating plots"), value = 1, + do.call(plot, c(list(x = .svm()), pinp))) +}) + +## 26. 存储 -------------------------------------------------------------- +observeEvent(input$svm_store_res, { + req(pressed(input$svm_run)) + robj <- .svm() + if (!is.list(robj)) return() + fixed <- fix_names(input$svm_store_res_name) + updateTextInput(session, "svm_store_res_name", value = fixed) + withProgress(message = i18n$t("Storing residuals"), value = 1, + r_data[[input$dataset]] <- store(r_data[[input$dataset]], robj, name = fixed)) +}) + +observeEvent(input$svm_store_pred, { + req(!is.empty(input$svm_pred_data), pressed(input$svm_run)) + pred <- .predict_svm() + if (is.null(pred)) return() + fixed <- fix_names(input$svm_store_pred_name) + updateTextInput(session, "svm_store_pred_name", value = fixed) + withProgress(message = i18n$t("Storing predictions"), value = 1, + r_data[[input$svm_pred_data]] <- store(r_data[[input$svm_pred_data]], pred, name = fixed)) +}) + +## 27. report ------------------------------------------------------------ +svm_report <- function() { + if (is.empty(input$svm_evar)) return(invisible()) + + outputs <- c("summary") + inp_out <- list(list(prn = TRUE), "") + figs <- FALSE + + if (!is.empty(input$svm_plots, "none")) { + inp <- check_plot_inputs(svm_plot_inputs()) + inp_out[[2]] <- clean_args(inp, svm_plot_args[-1]) + inp_out[[2]]$custom <- FALSE + outputs <- c(outputs, "plot") + figs <- TRUE + } + + if (!is.empty(input$svm_store_res_name)) { + fixed <- fix_names(input$svm_store_res_name) + updateTextInput(session, "svm_store_res_name", value = fixed) + xcmd <- paste0(input$dataset, " <- store(", input$dataset, ", result, name = \"", fixed, "\")\n") + } else { + xcmd <- "" + } + + if (!is.empty(input$svm_predict, "none") && + (!is.empty(input$svm_pred_data) || !is.empty(input$svm_pred_cmd))) { + pred_args <- clean_args(svm_pred_inputs(), svm_pred_args[-1]) + + if (!is.empty(pred_args$pred_cmd)) + pred_args$pred_cmd <- strsplit(pred_args$pred_cmd, ";\\s*")[[1]] + else + pred_args$pred_cmd <- NULL + + if (!is.empty(pred_args$pred_data)) + pred_args$pred_data <- as.symbol(pred_args$pred_data) + else + pred_args$pred_data <- NULL + + inp_out[[2 + figs]] <- pred_args + outputs <- c(outputs, "pred <- predict") + xcmd <- paste0(xcmd, "print(pred, n = 10)") + if (input$svm_predict %in% c("data", "datacmd")) { + fixed <- fix_names(input$svm_store_pred_name) + updateTextInput(session, "svm_store_pred_name", value = fixed) + xcmd <- paste0(xcmd, "\n", input$svm_pred_data, " <- store(", + input$svm_pred_data, ", pred, name = \"", fixed, "\")") + } + + if (input$svm_pred_plot && !is.empty(input$svm_xvar)) { + inp_out[[3 + figs]] <- clean_args(svm_pred_plot_inputs(), svm_pred_plot_args[-1]) + inp_out[[3 + figs]]$result <- "pred" + outputs <- c(outputs, "plot") + figs <- TRUE + } + } + + svm_inp <- svm_inputs() + if (input$svm_type == "regression") svm_inp$lev <- NULL + + update_report( + inp_main = clean_args(svm_inp, svm_args), + fun_name = "svm", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = svm_plot_width(), + fig.height= svm_plot_height(), + xcmd = xcmd + ) +} + +## 28. 下载 -------------------------------------------------------------- +dl_svm_pred <- function(path) { + if (pressed(input$svm_run)) { + write.csv(.predict_svm(), file = path, row.names = FALSE) + } else { + cat(i18n$t("No output available. Press the Estimate button to generate results"), file = path) + } +} + +download_handler( + id = "dl_svm_pred", + fun = dl_svm_pred, + fn = function() paste0(input$dataset, "_svm_pred"), + type = "csv", + caption = i18n$t("Save SVM predictions") +) + +download_handler( + id = "dlp_svm_pred", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_svm_pred"), + type = "png", + caption = i18n$t("Save SVM prediction plot"), + plot = .predict_plot_svm, + width = plot_width, + height = svm_pred_plot_height +) + +download_handler( + id = "dlp_svm", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_svm"), + type = "png", + caption = i18n$t("Save SVM plot"), + plot = .plot_svm, + width = svm_plot_width, + height = svm_plot_height +) + +## 29. report / screenshot 监听 ----------------------------------------- +observeEvent(input$svm_report, { + r_info[["latest_screenshot"]] <- NULL + svm_report() +}) + +observeEvent(input$svm_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_svm_screenshot") +}) + +observeEvent(input$modal_svm_screenshot, { + svm_report() + removeModal() +}) \ No newline at end of file diff --git a/radiant.model/inst/app/tools/help/anova.Rmd b/radiant.model/inst/app/tools/help/anova.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..b7566fef305b4e659cadfdc06b721bcfaa8852dc --- /dev/null +++ b/radiant.model/inst/app/tools/help/anova.Rmd @@ -0,0 +1,139 @@ +> 方差分析 + +## 数据 + + +```r +head(warpbreaks) +``` + +``` +## breaks wool tension +## 1 26 A L +## 2 30 A L +## 3 54 A L +## 4 25 A L +## 5 70 A L +## 6 52 A L +``` + +两种简单的方差分析运行方法： + + +```r +tens.aov <- aov(breaks ~ tension, data = warpbreaks) +print(tens.aov) +``` + +``` +## Call: +## aov(formula = breaks ~ tension, data = warpbreaks) +## +## Terms: +## tension Residuals +## Sum of Squares 2034.259 7198.556 +## Deg. of Freedom 2 51 +## +## Residual standard error: 11.88058 +## Estimated effects may be unbalanced +``` + +```r +summary(tens.aov) +``` + +``` +## Df Sum Sq Mean Sq F value Pr(>F) +## tension 2 2034 1017.1 7.206 0.00175 ** +## Residuals 51 7199 141.1 +## --- +## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +``` + +或者， + + +```r +tens.lm <- lm(breaks ~ tension, data = warpbreaks) +anova (tens.lm) +``` + +``` +## Analysis of Variance Table +## +## Response: breaks +## Df Sum Sq Mean Sq F value Pr(>F) +## tension 2 2034.3 1017.13 7.2061 0.001753 ** +## Residuals 51 7198.6 141.15 +## --- +## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +``` + +和常规线性模型一样，检验因子之间的交互作用也很简单： + + +```r +summary(aov(breaks~wool*tension, warpbreaks)) +``` + +``` +## Df Sum Sq Mean Sq F value Pr(>F) +## wool 1 451 450.7 3.765 0.058213 . +## tension 2 2034 1017.1 8.498 0.000693 *** +## wool:tension 2 1003 501.4 4.189 0.021044 * +## Residuals 48 5745 119.7 +## --- +## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +``` + +可视化此类交互作用的最简单方法是使用一个虽不美观但实用的交互作用图： + + +```r +# with(warpbreaks,interaction.plot(tension,wool,breaks)) +``` + +（它需要 3 个参数：第一个是 x 轴的因子，然后是不同线条的追踪因子，最后是响应变量）。当然，你也可以用条形图（比如用 ggplot 让它更美观）。 + +在方差分析中，你还可以选择协方差分析（ANCOVA）—— 使用协变量来吸收方差，或者检验变量 X1 是否在 X2 的基础上还有额外效应，就像在回归中纳入控制变量 / 固定效应一样，所以 R 代码非常相似。如果要将 tension 作为协变量（在这个数据集里没什么意义，不过只是举个例子）： + + +```r +summary(aov(breaks ~ tension + wool, warpbreaks)) +``` + +``` +## Df Sum Sq Mean Sq F value Pr(>F) +## tension 2 2034 1017.1 7.537 0.00138 ** +## wool 1 451 450.7 3.339 0.07361 . +## Residuals 50 6748 135.0 +## --- +## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +``` + +关键是协变量必须在代码中列在前面，因为显然 R 是逐步读取方差分析项的。 + +另外两个主要内容是线性对比和重复测量分析…… 遗憾的是，我对这些主题记得不多，也没有现成的代码 :-/ 但怡丹和敏都很擅长统计和 R，她们可能能帮上忙！ + +哦，另外一种（更简单的）检验组间真实差异所在的方法（如果你发现因子整体有显著效应）是使用 Tukey HSD 检验： + + +```r +TukeyHSD(tens.aov) +``` + +``` +## Tukey multiple comparisons of means +## 95% family-wise confidence level +## +## Fit: aov(formula = breaks ~ tension, data = warpbreaks) +## +## $tension +## diff lwr upr p adj +## M-L -10.000000 -19.55982 -0.4401756 0.0384598 +## H-L -14.722222 -24.28205 -5.1623978 0.0014315 +## H-M -4.722222 -14.28205 4.8376022 0.4630831 +``` + +这会输出因子中所有组间的 pairwise 比较结果。 + diff --git a/radiant.model/inst/app/tools/help/anova.md b/radiant.model/inst/app/tools/help/anova.md new file mode 100644 index 0000000000000000000000000000000000000000..b7566fef305b4e659cadfdc06b721bcfaa8852dc --- /dev/null +++ b/radiant.model/inst/app/tools/help/anova.md @@ -0,0 +1,139 @@ +> 方差分析 + +## 数据 + + +```r +head(warpbreaks) +``` + +``` +## breaks wool tension +## 1 26 A L +## 2 30 A L +## 3 54 A L +## 4 25 A L +## 5 70 A L +## 6 52 A L +``` + +两种简单的方差分析运行方法： + + +```r +tens.aov <- aov(breaks ~ tension, data = warpbreaks) +print(tens.aov) +``` + +``` +## Call: +## aov(formula = breaks ~ tension, data = warpbreaks) +## +## Terms: +## tension Residuals +## Sum of Squares 2034.259 7198.556 +## Deg. of Freedom 2 51 +## +## Residual standard error: 11.88058 +## Estimated effects may be unbalanced +``` + +```r +summary(tens.aov) +``` + +``` +## Df Sum Sq Mean Sq F value Pr(>F) +## tension 2 2034 1017.1 7.206 0.00175 ** +## Residuals 51 7199 141.1 +## --- +## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +``` + +或者， + + +```r +tens.lm <- lm(breaks ~ tension, data = warpbreaks) +anova (tens.lm) +``` + +``` +## Analysis of Variance Table +## +## Response: breaks +## Df Sum Sq Mean Sq F value Pr(>F) +## tension 2 2034.3 1017.13 7.2061 0.001753 ** +## Residuals 51 7198.6 141.15 +## --- +## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +``` + +和常规线性模型一样，检验因子之间的交互作用也很简单： + + +```r +summary(aov(breaks~wool*tension, warpbreaks)) +``` + +``` +## Df Sum Sq Mean Sq F value Pr(>F) +## wool 1 451 450.7 3.765 0.058213 . +## tension 2 2034 1017.1 8.498 0.000693 *** +## wool:tension 2 1003 501.4 4.189 0.021044 * +## Residuals 48 5745 119.7 +## --- +## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +``` + +可视化此类交互作用的最简单方法是使用一个虽不美观但实用的交互作用图： + + +```r +# with(warpbreaks,interaction.plot(tension,wool,breaks)) +``` + +（它需要 3 个参数：第一个是 x 轴的因子，然后是不同线条的追踪因子，最后是响应变量）。当然，你也可以用条形图（比如用 ggplot 让它更美观）。 + +在方差分析中，你还可以选择协方差分析（ANCOVA）—— 使用协变量来吸收方差，或者检验变量 X1 是否在 X2 的基础上还有额外效应，就像在回归中纳入控制变量 / 固定效应一样，所以 R 代码非常相似。如果要将 tension 作为协变量（在这个数据集里没什么意义，不过只是举个例子）： + + +```r +summary(aov(breaks ~ tension + wool, warpbreaks)) +``` + +``` +## Df Sum Sq Mean Sq F value Pr(>F) +## tension 2 2034 1017.1 7.537 0.00138 ** +## wool 1 451 450.7 3.339 0.07361 . +## Residuals 50 6748 135.0 +## --- +## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +``` + +关键是协变量必须在代码中列在前面，因为显然 R 是逐步读取方差分析项的。 + +另外两个主要内容是线性对比和重复测量分析…… 遗憾的是，我对这些主题记得不多，也没有现成的代码 :-/ 但怡丹和敏都很擅长统计和 R，她们可能能帮上忙！ + +哦，另外一种（更简单的）检验组间真实差异所在的方法（如果你发现因子整体有显著效应）是使用 Tukey HSD 检验： + + +```r +TukeyHSD(tens.aov) +``` + +``` +## Tukey multiple comparisons of means +## 95% family-wise confidence level +## +## Fit: aov(formula = breaks ~ tension, data = warpbreaks) +## +## $tension +## diff lwr upr p adj +## M-L -10.000000 -19.55982 -0.4401756 0.0384598 +## H-L -14.722222 -24.28205 -5.1623978 0.0014315 +## H-M -4.722222 -14.28205 4.8376022 0.4630831 +``` + +这会输出因子中所有组间的 pairwise 比较结果。 + diff --git a/radiant.model/inst/app/tools/help/cox.md b/radiant.model/inst/app/tools/help/cox.md new file mode 100644 index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 diff --git a/radiant.model/inst/app/tools/help/crs.md b/radiant.model/inst/app/tools/help/crs.md new file mode 100644 index 0000000000000000000000000000000000000000..00c2f408423d6fcc7679b926af27d4f551448c5a --- /dev/null +++ b/radiant.model/inst/app/tools/help/crs.md @@ -0,0 +1,15 @@ +> 使用协同过滤预测产品评分 + +要使用协同过滤生成推荐，需选择用户 ID、产品 ID、一个或多个要为其生成推荐的产品以及产品评分。如需生成推荐，请点击`Estimate`按钮或按`CTRL-enter`（在 Mac 上为`CMD-enter`）。 + +

    + +### Report > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*Report > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令对其进行自定义（例如，`plot(result) + labs(caption = "基于……的数据")`）。详情请参见_*数据 > 可视化*_。 + +### R 函数 + +有关 Radiant 中用于协同过滤的相关 R 函数概述，请参见*模型 > 协同过滤* 。 diff --git a/radiant.model/inst/app/tools/help/crtree.md b/radiant.model/inst/app/tools/help/crtree.md new file mode 100644 index 0000000000000000000000000000000000000000..c3a52fec7fa24d2cfce92b60150ca01e6aae2d1f --- /dev/null +++ b/radiant.model/inst/app/tools/help/crtree.md @@ -0,0 +1,17 @@ +> 估计分类树或回归树 + +要创建树模型，首先选择类型（即分类或回归）、响应变量以及一个或多个解释变量。点击`Estimate model`按钮或按`CTRL-enter`（在 Mac 上为`CMD-enter`）生成结果。 + +### Report > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*Report > Rmd*添加代码以（重新）创建分析。 + +如果已创建 “剪枝（Prune）” 图或 “重要性（Importance）” 图，可使用`ggplot2`命令对其进行自定义（例如，`plot(result, plots = "prune", custom = TRUE) + labs(x = "# 节点数")`）。详情请参见*数据 > 可视化*。 + +目前无法直接为`Tree`图添加标题或说明文字。 + +### R 函数 + +有关 Radiant 中用于估计分类树和回归树的相关 R 函数概述，请参见*模型 > 分类与回归树*。 + +`crtree`工具中使用的来自`rpart`包的核心函数是`rpart`。 diff --git a/radiant.model/inst/app/tools/help/dtree.Rmd b/radiant.model/inst/app/tools/help/dtree.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..12c21b43e5fe9e41ba862902c588dc6b59790697 --- /dev/null +++ b/radiant.model/inst/app/tools/help/dtree.Rmd @@ -0,0 +1,232 @@ +> 创建并评估用于决策分析的决策树 + +要创建并评估决策树，请先（1）在输入编辑器中输入树的结构，或（2）从文件加载树结构。首次导航到 “模型> 决策 > 决策分析” 标签页时，你会看到一个示例树结构。该结构基于 data.tree 库开发者 Christoph Glur 的一个示例，该库的地址为https://github.com/gluc/data.tree。 + +要输入新结构，请先为树提供一个名称，并在 “Calculate” 按钮旁的输入框中输入标签。在下面的示例中，决策树的名称输入为：`name: Sign contract`。下一步是指定第一个节点的**类型**，选项为`type: decision`（决策型）或`type: chance`（机会型）。注意，我们暂时跳过`variables`部分，稍后再回到这部分内容。 + +在提供的示例中，第一个节点是**决策节点**。决策者必须决定 “与电影公司签约（Sign with Movie Company）” 还是 “与电视网签约（Sign with TV Network）”。第一个选项指向一个带有概率和收益的**机会**节点，第二个选项有固定收益。 + +> **注意：** 定义树结构时，缩进至关重要。如示例所示，使用制表符（tabs）创建分支。分支名称**必须**后跟一个冒号（`:`），且关于分支的信息**必须**使用制表符缩进。 + +在为决策 “与电影公司签约（Sign with Movie Company）” 提供名称后，下一行**必须**使用制表符缩进。在示例中，下一行开始描述机会节点（`type: chance`）。示例中有 3 种可能性：（1）“票房惨淡（Small Box Office）”、（2）“票房中等（Medium Box Office）” 和（3）“票房大卖（Large Box Office）”，每种情况都有相应的概率和收益。这些是树的一个分支的终点，通常称为 “终端节点（terminal nodes）” 或 “叶节点（leaves）”。所有终点都必须有`payoff`（收益）值。 + +> **注意：** 机会节点的概率之和应等于 1，且所有概率必须在 0 到 1 之间。 + +决策也可以分配`cost`（成本）。例如，如果我们决定与电影公司签约，可能需要支付 5000 美元的法律支持费用。假设与电视网的合同更简单，不需要法律协助。请注意，`costs`（成本）的使用是可选的。在示例中，我们也可以从每个可能的票房收益中减去 5000 美元。 + +如果树中的某些值相关或重复，使用`variables`（变量）部分会很有用。在这里，你可以为值分配标签、输入公式，甚至引用其他（子）树。注意，公式应仅引用`variables`部分中的条目，不能包含任何 R 命令。在 “签约（Sign contract）” 示例中，只创建了一个变量（即`legal fees`（法律费用））。“敏感性（Sensitivity）” 标签页要求树结构中包含`variables`部分。下面是 “签约” 示例的改编版本，它使用了更多变量和一个公式。 + + +```yaml +name: Sign contract +variables: + legal fees: 5000 + P(small): 0.3 + P(medium): 0.6 + P(large): 1 - P(small) - P(medium) +type: decision +Sign with Movie Company: + cost: legal fees + type: chance + Small Box Office: + p: P(small) + payoff: 200000 + Medium Box Office: + p: P(medium) + payoff: 1000000 + Large Box Office: + p: P(large) + payoff: 3000000 +Sign with TV Network: + payoff: 900000 +``` + +要引用另一个（子）树，请在`variables`部分使用`dtree`函数和（子）树的名称。例如，假设你想将一个评估周二定价决策的树（“tuesday_tree”）包含到评估周一定价决策的树中。`variables`部分的开头可能如下所示： + +```yaml +variables: + tuesday_emv: dtree("tuesday_tree") +``` + +然后，在周一的树中，你需要周二定价决策的 EMV 时，就可以引用`tuesday_emv`。 + +## 决策树输入规则 + +1. 始终以树名称开头（例如，`name: My tree`） +2. 第二行应开始`variables`部分或节点定义（即`type: chance`或`type: decision`） +3. 所有行都必须包含冒号（`:`）。对于节点名称，冒号位于行尾；对于其他所有行，冒号用于赋值，具体来说，它可以分配名称（例如`name: My tree`）、节点类型（例如`type: decision`）、变量（例如`legal fees: 5000`）或数值（例如`payoff: 100`、`p: 0.1`、`cost: 10`） +4. 节点类型后下一行必须是节点名称（例如`Cancel orders:`） +5. 节点名称中仅使用字母和空格（即不使用符号） +6. 节点名称后的行**必须**缩进 +7. 终点（或终端节点、叶节点）必须有收益（例如`payoff: 100`） +8. 如果与机会节点关联，终端节点必须有概率（例如`p: 0.4`）和收益 + +在编辑器中指定树结构后，点击 “Calculate” 按钮，可在屏幕右侧看到文本格式的 “初始（Initial）” 和 “最终（Final）” 决策树（见下方截图）。初始树仅显示指定的树结构，以及节点类型、概率、成本和收益。最终树显示通过 “倒推（folding-back）” 树确定的最优决策策略。在这种情况下，最优决策是 “与电影公司签约（Sign with Movie Company）”，因为该决策具有更高的**预期货币价值（EMV）**。 + +

    + +要查看决策树的可视化表示，请打开 “绘图（Plot）” 标签页。如果已在 “模型（Model）” 标签页中点击 “Calculate” 按钮，你将看到 “初始（Initial）” 决策树的图形（见下方截图）。决策节点显示为绿色，机会节点显示为橙色。如果树的外观与预期不符，请返回 “模型” 标签页编辑树结构。 + +

    + +“最终（Final）” 图形显示通过 “倒推” 树确定的最优决策。最优决策是 “与电影公司签约”，因为该决策具有更高的**预期货币价值**。请注意，每个决策节点的最优决策通过连接到节点的较粗线条显示。 + +

    + +“与电视网签约” 的 EMV 为 900,000 美元。如果忽略成本，“与电影公司签约” 的预期收益为： + +$$ + 0.3 \times 200,000 + 0.6 \times 1,000,000 + 0.1 \times 3000,000 = 960,000 +$$ + +但由于我们需支付 5,000 美元的法律费用，与电影公司签约的 EMV 为 960,000 - 5,000 = 955,000 美元。将光标悬停在屏幕上显示的机会节点上，可看到显示计算过程的 “提示框（tooltip）”。为突出显示已指定 “成本（cost）”，图中的机会节点有虚线外框。 + +在 “签约” 示例中，显然 “与电影公司签约” 是首选方案。但是，假设该方案的法律费用为 10,000 美元或 30,000 美元，我们还会选择相同的方案吗？这就是 “敏感性（Sensitivity）” 标签页的用处。在这里，我们可以评估如果法律费用变化，决策（如 “与电影公司签约” 和 “与电视网签约”）会如何变化。输入 0 作为 “最小值（Min）”、80000 作为 “最大值（Max value）”、10000 作为 “步长（Step）”，然后点击图标。点击 “评估敏感性（Evaluate sensitivity）” 后，将显示一个图形，说明各决策的收益如何变化。注意，当法律费用高于 60,000 美元时，“与电视网签约” 产生最高的 EMV。 + +

    + +## 视频教程 + +将以下完整命令复制粘贴到 RStudio 控制台（即左下角窗口），按回车即可获取 Radiant 教程系列中决策树模块使用的所有材料： + +
    usethis::use_course("https://www.dropbox.com/sh/bit4p1ffbkb2dgh/AACm1RVy2BxBDiVbjoLiN5_Ea?dl=1")
    + +决策分析入门（一） + +- 本视频带你逐步了解手动构建和求解基本决策树的必要步骤 +- 主题列表： + - 机会节点与决策节点 + - 树的倒推（即从最右侧节点开始，向左逐步倒推到最左侧节点） + +使用 Radiant 构建决策树（二） + +- 本视频演示如何在 Radiant 中构建基本决策树 +- 主题列表： + - 重命名树文件 + - 构建树（遵循决策树输入规则） + - 解释结果（初始树与最终树） + - 保存决策树输入.yaml 文件 + +如何将决策树结果写入报告（三） + +- 本视频演示如何在 Radiant 中构建基本决策树并将生成的 R 代码添加到报告中 +- 主题列表： + - 构建决策树并在决策树中定义变量 + - 向报告添加多个树 + - 演示一些有用的键盘快捷键 + - 保存 Radiant 状态文件和报告 + +决策树的敏感性分析（四） + +- 本视频展示在 Radiant 中对决策树进行敏感性分析的两种方法 +- 主题列表： + - 快速回顾将决策树结果写入报告 + - 方法一：手动更新值 + - 方法二：使用 “variables” + +如何调试决策树输入（五） + +- 本视频演示如果收到错误消息，如何调试决策树输入 +- 主题列表： + - 缺少冒号 + - 缩进问题 + - 概率之和不等于 1 + - 值缺失 + +含不完全信息的决策树（六） + +- 本视频展示当可用信息不完全时，如何确定决策树中使用的适当（条件）概率 +- 主题列表： + - 不完全信息 + - 测试 + - 条件概率 + +求解含不完全信息的决策树（七） + +- 本视频展示当可用信息不完全时，如何使用 Radiant 构建和求解决策树 +- 主题列表： + - 指定变量 + - 构建含不完全信息的树 + - 检查树 + - 解释决策树结果 + +在 Radiant 中构建含子树的决策树（八） + +- 本视频展示如何在 Radiant 中构建含子树的决策树 +- 主题列表： + - 创建引用子树的主树 + - 指定在变量部分引用主树的子树 + +完整的 “Radiant 教程系列” 见以下链接： + +https://www.youtube.com/playlist?list=PLNhtaetb48EdKRIY7MewCyvb_1x7dV3xw + +## 按钮 + +在 “模型（Model）” 标签页中： + +* 要查看本帮助文件，点击图标 +* 要在 “报告> Rmd” 标签页中生成关于决策树的报告，点击图标或按键盘上的`ALT-enter` +* 选择最大化（`Max`）或最小化（`Min`）收益。注意，收益可以为负数 +* 点击 “Calculate” 按钮或按`CTRL-enter`（Mac 上为`CMD-enter`）生成或更新结果 +* 在 “Calculate” 按钮旁的文本输入框中指定决策树的名称。点击 “Calculate” 按钮将保存你的设置。如果有多个树结构可用，还会出现一个下拉菜单，你可以选择要使用的结构，以及一个 “Remove” 按钮来删除树结构 +* 要将编辑器窗口中输入的树结构保存到磁盘，按 “Save input” 按钮 +* 要将初始树和最终树的文本表示保存到文件，点击 “Save output” 按钮 +* 要从 yaml 格式的文件加载树结构，点击 “Choose File” 按钮 + +在 “绘图（Plot）” 标签页中： + +- 要查看本帮助文件，点击图标 +- 要在 “报告> Rmd” 标签页中生成关于决策树的报告，点击图标或按键盘上的`ALT-enter` +- 显示 “初始（Initial）” 或 “最终（Final）” 决策树 +- 点击 “Calculate” 按钮或按`CTRL-enter`（Mac 上为`CMD-enter`）生成或更新结果 +- 输入绘图中显示的小数位数（默认收益为 2 位，概率为 4 位） +- 提供用于收益的符号（例如 $ 或 RMB） +- 点击浏览器右上角的下载图标，将初始或最终绘图下载为 png 文件 + +目前无法直接为 “决策树（Decision Tree）” 图添加标题或说明文字。 + +在 “敏感性（Sensitivity）” 标签页中： + +* 要查看本帮助文件，点击图标 +* 要在 “报告> Rmd” 标签页中生成关于决策树的报告，点击图标或按键盘上的`ALT-enter` +* 选择一个或多个 “要评估的决策（Decisions to evaluate）” +* 在 “对以下变化的敏感性（Sensitivity to changes in）” 中选择变量。这些变量必须在 “模型” 标签页的决策树结构的`variables`部分中定义 +* 为所选变量输入最小值、最大值和步长，然后点击图标 +* 点击 “评估敏感性（Evaluate sensitivity）” 或按`CTRL-enter`（Mac 上为`CMD-enter`）生成结果和绘图 +* 点击浏览器右上角的下载图标，将绘图下载为 png 文件 + +如果已创建敏感性绘图，可使用`ggplot2`命令对其进行自定义（见下方示例）。详情请参见*数据 > 可视化*。 + +```r +sensitivity( + result, + vars = "legal fees 0 100000 1000;", + decs = c("Sign with Movie Company", "Sign with TV Network"), + custom = TRUE +) + labs(caption = "Based on example created by ...") +``` + +## 决策树编辑器 + +实用的键盘快捷键： + +* 注释当前行或所选行（Windows：Ctrl-/ Mac：Cmd-/） +* 折叠所有行（Windows：Alt-0 Mac：Alt-Cmd-0） +* 展开所有行（Windows：Shift-Alt-0 Mac：Shift-Alt-Cmd-0） +* 搜索（Windows：Ctrl-f Mac：Cmd-f） +* 搜索并替换（Windows：Ctrl-f-f Mac：Cmd-f-f） +* 撤销编辑（Windows：Ctrl-z Mac：Cmd-z） +* 重做编辑（Windows：Shift-Ctrl-z Mac：Shift-Cmd-z） + +你也可以使用行号旁的小三角形折叠 / 展开行。 + +更多快捷键见： + +https://github.com/ajaxorg/ace/wiki/Default-Keyboard-Shortcuts + +### R 函数 + +有关 Radiant 中用于决策分析的相关 R 函数概述，请参见*模型 > 决策分析*。 + +`dtree`工具中使用的来自`data.tree`包的核心元素是`as.Node`函数以及`Get`和`Do`方法。 diff --git a/radiant.model/inst/app/tools/help/dtree.md b/radiant.model/inst/app/tools/help/dtree.md new file mode 100644 index 0000000000000000000000000000000000000000..12c21b43e5fe9e41ba862902c588dc6b59790697 --- /dev/null +++ b/radiant.model/inst/app/tools/help/dtree.md @@ -0,0 +1,232 @@ +> 创建并评估用于决策分析的决策树 + +要创建并评估决策树，请先（1）在输入编辑器中输入树的结构，或（2）从文件加载树结构。首次导航到 “模型> 决策 > 决策分析” 标签页时，你会看到一个示例树结构。该结构基于 data.tree 库开发者 Christoph Glur 的一个示例，该库的地址为https://github.com/gluc/data.tree。 + +要输入新结构，请先为树提供一个名称，并在 “Calculate” 按钮旁的输入框中输入标签。在下面的示例中，决策树的名称输入为：`name: Sign contract`。下一步是指定第一个节点的**类型**，选项为`type: decision`（决策型）或`type: chance`（机会型）。注意，我们暂时跳过`variables`部分，稍后再回到这部分内容。 + +在提供的示例中，第一个节点是**决策节点**。决策者必须决定 “与电影公司签约（Sign with Movie Company）” 还是 “与电视网签约（Sign with TV Network）”。第一个选项指向一个带有概率和收益的**机会**节点，第二个选项有固定收益。 + +> **注意：** 定义树结构时，缩进至关重要。如示例所示，使用制表符（tabs）创建分支。分支名称**必须**后跟一个冒号（`:`），且关于分支的信息**必须**使用制表符缩进。 + +在为决策 “与电影公司签约（Sign with Movie Company）” 提供名称后，下一行**必须**使用制表符缩进。在示例中，下一行开始描述机会节点（`type: chance`）。示例中有 3 种可能性：（1）“票房惨淡（Small Box Office）”、（2）“票房中等（Medium Box Office）” 和（3）“票房大卖（Large Box Office）”，每种情况都有相应的概率和收益。这些是树的一个分支的终点，通常称为 “终端节点（terminal nodes）” 或 “叶节点（leaves）”。所有终点都必须有`payoff`（收益）值。 + +> **注意：** 机会节点的概率之和应等于 1，且所有概率必须在 0 到 1 之间。 + +决策也可以分配`cost`（成本）。例如，如果我们决定与电影公司签约，可能需要支付 5000 美元的法律支持费用。假设与电视网的合同更简单，不需要法律协助。请注意，`costs`（成本）的使用是可选的。在示例中，我们也可以从每个可能的票房收益中减去 5000 美元。 + +如果树中的某些值相关或重复，使用`variables`（变量）部分会很有用。在这里，你可以为值分配标签、输入公式，甚至引用其他（子）树。注意，公式应仅引用`variables`部分中的条目，不能包含任何 R 命令。在 “签约（Sign contract）” 示例中，只创建了一个变量（即`legal fees`（法律费用））。“敏感性（Sensitivity）” 标签页要求树结构中包含`variables`部分。下面是 “签约” 示例的改编版本，它使用了更多变量和一个公式。 + + +```yaml +name: Sign contract +variables: + legal fees: 5000 + P(small): 0.3 + P(medium): 0.6 + P(large): 1 - P(small) - P(medium) +type: decision +Sign with Movie Company: + cost: legal fees + type: chance + Small Box Office: + p: P(small) + payoff: 200000 + Medium Box Office: + p: P(medium) + payoff: 1000000 + Large Box Office: + p: P(large) + payoff: 3000000 +Sign with TV Network: + payoff: 900000 +``` + +要引用另一个（子）树，请在`variables`部分使用`dtree`函数和（子）树的名称。例如，假设你想将一个评估周二定价决策的树（“tuesday_tree”）包含到评估周一定价决策的树中。`variables`部分的开头可能如下所示： + +```yaml +variables: + tuesday_emv: dtree("tuesday_tree") +``` + +然后，在周一的树中，你需要周二定价决策的 EMV 时，就可以引用`tuesday_emv`。 + +## 决策树输入规则 + +1. 始终以树名称开头（例如，`name: My tree`） +2. 第二行应开始`variables`部分或节点定义（即`type: chance`或`type: decision`） +3. 所有行都必须包含冒号（`:`）。对于节点名称，冒号位于行尾；对于其他所有行，冒号用于赋值，具体来说，它可以分配名称（例如`name: My tree`）、节点类型（例如`type: decision`）、变量（例如`legal fees: 5000`）或数值（例如`payoff: 100`、`p: 0.1`、`cost: 10`） +4. 节点类型后下一行必须是节点名称（例如`Cancel orders:`） +5. 节点名称中仅使用字母和空格（即不使用符号） +6. 节点名称后的行**必须**缩进 +7. 终点（或终端节点、叶节点）必须有收益（例如`payoff: 100`） +8. 如果与机会节点关联，终端节点必须有概率（例如`p: 0.4`）和收益 + +在编辑器中指定树结构后，点击 “Calculate” 按钮，可在屏幕右侧看到文本格式的 “初始（Initial）” 和 “最终（Final）” 决策树（见下方截图）。初始树仅显示指定的树结构，以及节点类型、概率、成本和收益。最终树显示通过 “倒推（folding-back）” 树确定的最优决策策略。在这种情况下，最优决策是 “与电影公司签约（Sign with Movie Company）”，因为该决策具有更高的**预期货币价值（EMV）**。 + +

    + +要查看决策树的可视化表示，请打开 “绘图（Plot）” 标签页。如果已在 “模型（Model）” 标签页中点击 “Calculate” 按钮，你将看到 “初始（Initial）” 决策树的图形（见下方截图）。决策节点显示为绿色，机会节点显示为橙色。如果树的外观与预期不符，请返回 “模型” 标签页编辑树结构。 + +

    + +“最终（Final）” 图形显示通过 “倒推” 树确定的最优决策。最优决策是 “与电影公司签约”，因为该决策具有更高的**预期货币价值**。请注意，每个决策节点的最优决策通过连接到节点的较粗线条显示。 + +

    + +“与电视网签约” 的 EMV 为 900,000 美元。如果忽略成本，“与电影公司签约” 的预期收益为： + +$$ + 0.3 \times 200,000 + 0.6 \times 1,000,000 + 0.1 \times 3000,000 = 960,000 +$$ + +但由于我们需支付 5,000 美元的法律费用，与电影公司签约的 EMV 为 960,000 - 5,000 = 955,000 美元。将光标悬停在屏幕上显示的机会节点上，可看到显示计算过程的 “提示框（tooltip）”。为突出显示已指定 “成本（cost）”，图中的机会节点有虚线外框。 + +在 “签约” 示例中，显然 “与电影公司签约” 是首选方案。但是，假设该方案的法律费用为 10,000 美元或 30,000 美元，我们还会选择相同的方案吗？这就是 “敏感性（Sensitivity）” 标签页的用处。在这里，我们可以评估如果法律费用变化，决策（如 “与电影公司签约” 和 “与电视网签约”）会如何变化。输入 0 作为 “最小值（Min）”、80000 作为 “最大值（Max value）”、10000 作为 “步长（Step）”，然后点击图标。点击 “评估敏感性（Evaluate sensitivity）” 后，将显示一个图形，说明各决策的收益如何变化。注意，当法律费用高于 60,000 美元时，“与电视网签约” 产生最高的 EMV。 + +

    + +## 视频教程 + +将以下完整命令复制粘贴到 RStudio 控制台（即左下角窗口），按回车即可获取 Radiant 教程系列中决策树模块使用的所有材料： + +
    usethis::use_course("https://www.dropbox.com/sh/bit4p1ffbkb2dgh/AACm1RVy2BxBDiVbjoLiN5_Ea?dl=1")
    + +决策分析入门（一） + +- 本视频带你逐步了解手动构建和求解基本决策树的必要步骤 +- 主题列表： + - 机会节点与决策节点 + - 树的倒推（即从最右侧节点开始，向左逐步倒推到最左侧节点） + +使用 Radiant 构建决策树（二） + +- 本视频演示如何在 Radiant 中构建基本决策树 +- 主题列表： + - 重命名树文件 + - 构建树（遵循决策树输入规则） + - 解释结果（初始树与最终树） + - 保存决策树输入.yaml 文件 + +如何将决策树结果写入报告（三） + +- 本视频演示如何在 Radiant 中构建基本决策树并将生成的 R 代码添加到报告中 +- 主题列表： + - 构建决策树并在决策树中定义变量 + - 向报告添加多个树 + - 演示一些有用的键盘快捷键 + - 保存 Radiant 状态文件和报告 + +决策树的敏感性分析（四） + +- 本视频展示在 Radiant 中对决策树进行敏感性分析的两种方法 +- 主题列表： + - 快速回顾将决策树结果写入报告 + - 方法一：手动更新值 + - 方法二：使用 “variables” + +如何调试决策树输入（五） + +- 本视频演示如果收到错误消息，如何调试决策树输入 +- 主题列表： + - 缺少冒号 + - 缩进问题 + - 概率之和不等于 1 + - 值缺失 + +含不完全信息的决策树（六） + +- 本视频展示当可用信息不完全时，如何确定决策树中使用的适当（条件）概率 +- 主题列表： + - 不完全信息 + - 测试 + - 条件概率 + +求解含不完全信息的决策树（七） + +- 本视频展示当可用信息不完全时，如何使用 Radiant 构建和求解决策树 +- 主题列表： + - 指定变量 + - 构建含不完全信息的树 + - 检查树 + - 解释决策树结果 + +在 Radiant 中构建含子树的决策树（八） + +- 本视频展示如何在 Radiant 中构建含子树的决策树 +- 主题列表： + - 创建引用子树的主树 + - 指定在变量部分引用主树的子树 + +完整的 “Radiant 教程系列” 见以下链接： + +https://www.youtube.com/playlist?list=PLNhtaetb48EdKRIY7MewCyvb_1x7dV3xw + +## 按钮 + +在 “模型（Model）” 标签页中： + +* 要查看本帮助文件，点击图标 +* 要在 “报告> Rmd” 标签页中生成关于决策树的报告，点击图标或按键盘上的`ALT-enter` +* 选择最大化（`Max`）或最小化（`Min`）收益。注意，收益可以为负数 +* 点击 “Calculate” 按钮或按`CTRL-enter`（Mac 上为`CMD-enter`）生成或更新结果 +* 在 “Calculate” 按钮旁的文本输入框中指定决策树的名称。点击 “Calculate” 按钮将保存你的设置。如果有多个树结构可用，还会出现一个下拉菜单，你可以选择要使用的结构，以及一个 “Remove” 按钮来删除树结构 +* 要将编辑器窗口中输入的树结构保存到磁盘，按 “Save input” 按钮 +* 要将初始树和最终树的文本表示保存到文件，点击 “Save output” 按钮 +* 要从 yaml 格式的文件加载树结构，点击 “Choose File” 按钮 + +在 “绘图（Plot）” 标签页中： + +- 要查看本帮助文件，点击图标 +- 要在 “报告> Rmd” 标签页中生成关于决策树的报告，点击图标或按键盘上的`ALT-enter` +- 显示 “初始（Initial）” 或 “最终（Final）” 决策树 +- 点击 “Calculate” 按钮或按`CTRL-enter`（Mac 上为`CMD-enter`）生成或更新结果 +- 输入绘图中显示的小数位数（默认收益为 2 位，概率为 4 位） +- 提供用于收益的符号（例如 $ 或 RMB） +- 点击浏览器右上角的下载图标，将初始或最终绘图下载为 png 文件 + +目前无法直接为 “决策树（Decision Tree）” 图添加标题或说明文字。 + +在 “敏感性（Sensitivity）” 标签页中： + +* 要查看本帮助文件，点击图标 +* 要在 “报告> Rmd” 标签页中生成关于决策树的报告，点击图标或按键盘上的`ALT-enter` +* 选择一个或多个 “要评估的决策（Decisions to evaluate）” +* 在 “对以下变化的敏感性（Sensitivity to changes in）” 中选择变量。这些变量必须在 “模型” 标签页的决策树结构的`variables`部分中定义 +* 为所选变量输入最小值、最大值和步长，然后点击图标 +* 点击 “评估敏感性（Evaluate sensitivity）” 或按`CTRL-enter`（Mac 上为`CMD-enter`）生成结果和绘图 +* 点击浏览器右上角的下载图标，将绘图下载为 png 文件 + +如果已创建敏感性绘图，可使用`ggplot2`命令对其进行自定义（见下方示例）。详情请参见*数据 > 可视化*。 + +```r +sensitivity( + result, + vars = "legal fees 0 100000 1000;", + decs = c("Sign with Movie Company", "Sign with TV Network"), + custom = TRUE +) + labs(caption = "Based on example created by ...") +``` + +## 决策树编辑器 + +实用的键盘快捷键： + +* 注释当前行或所选行（Windows：Ctrl-/ Mac：Cmd-/） +* 折叠所有行（Windows：Alt-0 Mac：Alt-Cmd-0） +* 展开所有行（Windows：Shift-Alt-0 Mac：Shift-Alt-Cmd-0） +* 搜索（Windows：Ctrl-f Mac：Cmd-f） +* 搜索并替换（Windows：Ctrl-f-f Mac：Cmd-f-f） +* 撤销编辑（Windows：Ctrl-z Mac：Cmd-z） +* 重做编辑（Windows：Shift-Ctrl-z Mac：Shift-Cmd-z） + +你也可以使用行号旁的小三角形折叠 / 展开行。 + +更多快捷键见： + +https://github.com/ajaxorg/ace/wiki/Default-Keyboard-Shortcuts + +### R 函数 + +有关 Radiant 中用于决策分析的相关 R 函数概述，请参见*模型 > 决策分析*。 + +`dtree`工具中使用的来自`data.tree`包的核心元素是`as.Node`函数以及`Get`和`Do`方法。 diff --git a/radiant.model/inst/app/tools/help/evalbin.md b/radiant.model/inst/app/tools/help/evalbin.md new file mode 100644 index 0000000000000000000000000000000000000000..4282557da750397cdf4eeebf76a0dee40a131908 --- /dev/null +++ b/radiant.model/inst/app/tools/help/evalbin.md @@ -0,0 +1,112 @@ +> 评估（二元）分类模型的性能 + +#### 响应变量（Response variable） + +选择关注的结果变量或响应变量。该变量应为二元变量，可以是因子（factor）或仅有两个值的整数（即 0 和 1）。 + +#### 选择水平（Choose level） + +响应变量中被视为 “成功事件” 的水平。例如，购买行为或购买者对应 “是（yes）”。 + +#### 预测变量（Predictor） + +选择一个或多个可用于预测响应变量中所选水平的变量。可以是普通变量、RFM 指数，或模型的预测值（例如，通过 “模型> 逻辑回归（GLM）” 估计的逻辑回归模型，或通过 “模型 > 神经网络” 估计的神经网络模型的预测值）。 + +#### 分位数数量（# quantiles） + +要创建的分箱数量。 + +#### 边际利润与成本（Margin & Cost） + +若要使用 “利润（Profit）” 和 “营销支出回报率（ROME）” 图表，请输入每笔销售的 “边际利润（Margin）” 和估计的每次接触成本（Cost）（例如，邮寄成本或电子邮件 / 短信的机会成本）。例如，若一笔销售的边际利润为 10 美元（不含接触成本），接触成本为 1 美元，则在 “边际利润（Margin）” 和 “成本（Cost）” 输入框中分别输入 10 和 1。 + +#### 结果显示范围（Show results for） + +如果启用了筛选器（例如，在 “数据> 查看” 标签页中设置），可选择为 “全部（All）” 数据、“训练（Training）” 数据、“测试（Test）” 数据，或 “训练和测试（Both）” 数据生成结果。若未启用筛选器，计算将应用于所有数据。 + +#### 图表（Plots） + +生成提升图（Lift）、增益图（Gains）、利润图（Profit）和 / 或营销支出回报率图（ROME）。 + +### Report > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*Report > Rmd*添加代码以（重新）创建分析。 + +如果在 “图表（Plots）” 标签页中创建了一组四个图表，可使用`patchwork`在图表组上方添加标题并设置两列布局，如下所示： + +```r +plot(result, plots = c("lift", "gains", "profit", "rome"), custom = TRUE) %>% + wrap_plots(plot_list, ncol = 2) + plot_annotation(title = "Model evaluation") +``` + +单个图表可使用`ggplot2`命令自定义（见下方示例）。详情请参见*数据 > 可视化*。 + +```r +plot(result, plots = "lift", custom = TRUE) + + labs(caption = "Based on data from ...") +``` + +#### 混淆矩阵 + +通过 “预测变量（Predictor）” 选择的预测概率首先会使用 “边际利润（Margin）” 和 “成本（Cost）” 中输入的值转换为类别（例如，阳性或阴性结果）。当预测响应概率超过 “成本 / 边际利润（Cost / Margin）” 时，接触该客户是有利可图的。例如，若盈亏平衡响应率为 0.1，而预测响应概率为 0.25，则该客户将被标记为 “阳性（Positive）”。反之，若预测概率未超过盈亏平衡响应率，则客户将被标记为 “阴性（Negative）”。 + +将每个预测转换为类别标签（即阳性或阴性）后，会将结果与响应变量的实际值进行比较。生成的表格中为每个预测变量显示以下关键指标。 + + 标签（Label） | 描述（Description） +------------------------ | ------------------------------------------------------------------ + TP（真阳性，True Positive） | 阳性预测与数据中阳性结果一致的案例数量 + FP（假阳性，False Positive） | 阳性预测但数据中结果为阴性的案例数量 + TN（真阴性，True Negative） | 阴性预测与数据中阴性结果一致的案例数量 + FN（假阴性，False Negative） | 阴性预测但数据中结果为阳性的案例数量 + total（总计） | 总案例数量（即 TP + FP + TN + FN） + TPR（真阳性率，True Positive Rate） | 数据中阳性结果被正确预测为阳性的比例（即 TP / (TP + FN)），也称为敏感性（sensitivity）或召回率（recall） + TNR（真阴性率，True Negative Rate） | 数据中阴性结果被正确预测为阴性的比例（即 TN / (TN + FP)），也称为特异性（specificity） + precision（精确率） | 阳性预测中实际为阳性结果的比例（即 TP / (TP + FP)） + F-score（F 分数） | 精确率（precision）与真阳性率（TPR，敏感性）的调和平均数 + accuracy（准确率） | 所有结果中被正确预测为阳性或阴性的比例（即 (TP + TN) /total） + kappa（Kappa 系数） | 对准确率指标的校正，消除纯随机情况下产生正确预测的概率影响 + profit（利润） | 针对所有预测概率高于盈亏平衡响应率的客户进行营销所获得的总利润 + index（指数） | 所选预测变量的相对盈利能力指数（最大值为 1） + ROME（营销支出回报率） | 针对所有预测概率高于盈亏平衡响应率的客户进行营销所实现的营销支出回报率 + contact（接触比例） | 需接触的客户比例，即 (TP + FP) /total + AUC（曲线下面积） | ROC 曲线下面积（AUC），ROC 即受试者工作特征（Receiver Operating Characteristic） + +### Report > Rmd (confusion) + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*Report > Rmd*添加代码以（重新）创建分析。 + +默认情况下仅绘制`kappa`、`index`、`ROME`和`AUC`。可通过 “报告> Rmd” 自定义绘制结果。例如，要更改绘图，可使用： + +```r +plot(result, vars = c("precision", "profit", "AUC")) +``` + +图表可使用`ggplot2`命令进一步自定义（见下方示例）。详情请参见*数据 > 可视化*。 + +```r +plot(result, vars = c("precision", "profit", "AUC")) + + labs(caption = "Based on data from ...") +``` + +#### 下载选项（Download options） + +要将表格下载为 csv 文件，点击屏幕右上角的下载按钮。要将图表下载为 png 文件，点击屏幕中右侧的下载图标。 + +## 示例 + +下方的提升图和增益图几乎没有显示过拟合迹象，表明针对约 65% 的客户进行营销可实现利润最大化。 + +

    + + + +上面截图中使用的预测值来自对`dvd`数据集的逻辑回归。该数据集可通过 “数据> 管理” 标签页获取（即从 “加载数据类型（Load data of type）” 下拉菜单中选择 “示例（Examples）”，然后点击 “加载（Load）”）。模型通过 “模型 > 逻辑回归（GLM）” 估计。下方显示的预测值在 “预测（Predict）” 标签页中生成。 + +

    + +### R 函数（R-functions） + +有关 Radiant 中用于评估（二元）分类模型的相关 R 函数概述，请参见*模型 > 分类模型评估* 。 \ No newline at end of file diff --git a/radiant.model/inst/app/tools/help/evalreg.md b/radiant.model/inst/app/tools/help/evalreg.md new file mode 100644 index 0000000000000000000000000000000000000000..96e32a6a3ff875e20014e51f90f588be8001c2ca --- /dev/null +++ b/radiant.model/inst/app/tools/help/evalreg.md @@ -0,0 +1,46 @@ +> 评估回归模型性能 + +要将表格下载为 csv 文件，点击屏幕右侧的顶部下载按钮。要将图表下载为 png 文件，点击屏幕右侧的下方下载图标。 + +#### 响应变量（Response variable） + +关注的数值型结果变量或响应变量。 + +#### 预测变量（Predictor） + +选择一个或多个可用于预测响应变量值的变量。可以是普通变量或模型的预测值（例如，通过 “模型> 线性回归（OLS）” 估计的回归模型，或通过 “模型 > 神经网络” 估计的神经网络模型的预测值）。 + +#### 结果显示范围（Show results for） + +如果启用了筛选器（例如，在 “数据> 查看” 标签页中设置），可生成 “全部（All）” 数据、“训练（Training）” 数据、“测试（Test）” 数据或 “训练和测试（Both）” 数据的结果。若未启用筛选器，计算将应用于所有数据。 + +## 示例 + +预测值来自对`diamonds`数据集的线性回归和隐藏层含两个节点的神经网络。在估计之前，对`price`和`carat`变量进行了对数转换。该数据集可通过 “数据> 管理” 标签页获取（即从 “加载数据类型（Load data of type）” 下拉菜单中选择 “示例（Examples）”，然后点击 “加载（Load）”）。下方显示的预测值在 “预测（Predict）” 标签页中生成。 + +

    + +测试统计量显示神经网络（NN）有微小但稳定的优势。 + +

    + +### Report > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*Report> Rmd*添加代码以（重新）创建分析。 + +默认情况下会绘制`R平方（Rsq）`、`均方根误差（RSME）`和`平均绝对误差（MAE）`。可通过 “报告> Rmd” 自定义绘制结果。例如，要更改绘图，可使用： + +```r +plot(result, vars = "Rsq") +``` + +图表可使用`ggplot2`命令进一步自定义（见下方示例）。详情请参见*数据 > 可视化*。 + +```r +plot(result, vars = "Rsq") + + labs(caption = "Based on data from ...") +``` + +### R 函数（R-functions） + +有关 Radiant 中用于评估回归模型的相关 R 函数概述，请参见*模型 > 回归模型评估* 。 \ No newline at end of file diff --git a/radiant.model/inst/app/tools/help/figures/cf_summary.png b/radiant.model/inst/app/tools/help/figures/cf_summary.png new file mode 100644 index 0000000000000000000000000000000000000000..78fa4de761f7f1212192076baa56a5b59f0f7600 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/cf_summary.png differ diff --git a/radiant.model/inst/app/tools/help/figures/dtree_model.png b/radiant.model/inst/app/tools/help/figures/dtree_model.png new file mode 100644 index 0000000000000000000000000000000000000000..16e972c2b87bc3e3ba0178a8b5947879f091645c Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/dtree_model.png differ diff --git a/radiant.model/inst/app/tools/help/figures/dtree_plot_final.png b/radiant.model/inst/app/tools/help/figures/dtree_plot_final.png new file mode 100644 index 0000000000000000000000000000000000000000..d5325c0434e4fdf3a6526f1fee9bf60337265f98 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/dtree_plot_final.png differ diff --git a/radiant.model/inst/app/tools/help/figures/dtree_plot_initial.png b/radiant.model/inst/app/tools/help/figures/dtree_plot_initial.png new file mode 100644 index 0000000000000000000000000000000000000000..d959aad271b89b62e0a7c23f49cfb94dd2c20e9b Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/dtree_plot_initial.png differ diff --git a/radiant.model/inst/app/tools/help/figures/dtree_sensitivity.png b/radiant.model/inst/app/tools/help/figures/dtree_sensitivity.png new file mode 100644 index 0000000000000000000000000000000000000000..e92fe641ad8dea2e7778da1ac1d8ab58f4a660dc Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/dtree_sensitivity.png differ diff --git a/radiant.model/inst/app/tools/help/figures/evalbin_confusion.png b/radiant.model/inst/app/tools/help/figures/evalbin_confusion.png new file mode 100644 index 0000000000000000000000000000000000000000..835c25bb53a3ea050e65add9752cf7938af40149 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/evalbin_confusion.png differ diff --git a/radiant.model/inst/app/tools/help/figures/evalbin_lift_gains.png b/radiant.model/inst/app/tools/help/figures/evalbin_lift_gains.png new file mode 100644 index 0000000000000000000000000000000000000000..3507bc7a9ace9d5953cda61f1e7c4d9a2dd3747a Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/evalbin_lift_gains.png differ diff --git a/radiant.model/inst/app/tools/help/figures/evalbin_logistic.png b/radiant.model/inst/app/tools/help/figures/evalbin_logistic.png new file mode 100644 index 0000000000000000000000000000000000000000..6d6d7fab9b215b88a962fe8dfac68440ff4b9fc9 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/evalbin_logistic.png differ diff --git a/radiant.model/inst/app/tools/help/figures/evalreg_nn.png b/radiant.model/inst/app/tools/help/figures/evalreg_nn.png new file mode 100644 index 0000000000000000000000000000000000000000..1015a2ac644af9e7ca702fa9d2bb4981f8809867 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/evalreg_nn.png differ diff --git a/radiant.model/inst/app/tools/help/figures/evalreg_summary_plot.png b/radiant.model/inst/app/tools/help/figures/evalreg_summary_plot.png new file mode 100644 index 0000000000000000000000000000000000000000..fb40bdea6b14828092e848b05b95fde9d089c6bc Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/evalreg_summary_plot.png differ diff --git a/radiant.model/inst/app/tools/help/figures/logistic_dvd-full.png b/radiant.model/inst/app/tools/help/figures/logistic_dvd-full.png new file mode 100644 index 0000000000000000000000000000000000000000..df333c4a0cac99752fcf270b440ecadf308f4cef Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/logistic_dvd-full.png differ diff --git a/radiant.model/inst/app/tools/help/figures/logistic_dvd.png b/radiant.model/inst/app/tools/help/figures/logistic_dvd.png new file mode 100644 index 0000000000000000000000000000000000000000..41441419f6ba7a8d47aa7634448c33d3e0a7f122 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/logistic_dvd.png differ diff --git a/radiant.model/inst/app/tools/help/figures/logistic_plot.png b/radiant.model/inst/app/tools/help/figures/logistic_plot.png new file mode 100644 index 0000000000000000000000000000000000000000..d6c67b19f3d465149dc6f03f91aa44ecdf6aa98e Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/logistic_plot.png differ diff --git a/radiant.model/inst/app/tools/help/figures/logistic_predict.png b/radiant.model/inst/app/tools/help/figures/logistic_predict.png new file mode 100644 index 0000000000000000000000000000000000000000..cb6e5ac1da3a842abbfabe2854916587fe32714b Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/logistic_predict.png differ diff --git a/radiant.model/inst/app/tools/help/figures/logistic_predict_data.png b/radiant.model/inst/app/tools/help/figures/logistic_predict_data.png new file mode 100644 index 0000000000000000000000000000000000000000..d73ac9987a46f28e7d9998cd5c30764fbb4ca0bb Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/logistic_predict_data.png differ diff --git a/radiant.model/inst/app/tools/help/figures/logistic_summary.png b/radiant.model/inst/app/tools/help/figures/logistic_summary.png new file mode 100644 index 0000000000000000000000000000000000000000..ea7fc375fa2feb9419f3ee6940cea8a88ca128d4 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/logistic_summary.png differ diff --git a/radiant.model/inst/app/tools/help/figures/mnl_choice_shares.png b/radiant.model/inst/app/tools/help/figures/mnl_choice_shares.png new file mode 100644 index 0000000000000000000000000000000000000000..9ba3951944c7410a6f678e32feca50f91ea4175f Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/mnl_choice_shares.png differ diff --git a/radiant.model/inst/app/tools/help/figures/mnl_plot.png b/radiant.model/inst/app/tools/help/figures/mnl_plot.png new file mode 100644 index 0000000000000000000000000000000000000000..faf3d6d16887a63fd5460d27f916e9f946551e04 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/mnl_plot.png differ diff --git a/radiant.model/inst/app/tools/help/figures/mnl_predict.png b/radiant.model/inst/app/tools/help/figures/mnl_predict.png new file mode 100644 index 0000000000000000000000000000000000000000..638ca2c4512ba75e4825f2a2038b57c6b793df5f Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/mnl_predict.png differ diff --git a/radiant.model/inst/app/tools/help/figures/mnl_summary.png b/radiant.model/inst/app/tools/help/figures/mnl_summary.png new file mode 100644 index 0000000000000000000000000000000000000000..3c5278abc555e84cec93d93448229dfd09843d63 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/mnl_summary.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_catalog_F_critical.png b/radiant.model/inst/app/tools/help/figures/regress_catalog_F_critical.png new file mode 100644 index 0000000000000000000000000000000000000000..9d91a0bb4819248d4942f2322075490e98f8a28b Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_catalog_F_critical.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_catalog_F_test.png b/radiant.model/inst/app/tools/help/figures/regress_catalog_F_test.png new file mode 100644 index 0000000000000000000000000000000000000000..da7553858ce84ea8244ef927c7e76dc3d9ead0b1 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_catalog_F_test.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_catalog_prob_calc.png b/radiant.model/inst/app/tools/help/figures/regress_catalog_prob_calc.png new file mode 100644 index 0000000000000000000000000000000000000000..e61df18aaa2037d36d33dffe73c3720f15aa9b66 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_catalog_prob_calc.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_catalog_summary.png b/radiant.model/inst/app/tools/help/figures/regress_catalog_summary.png new file mode 100644 index 0000000000000000000000000000000000000000..6ca4e130d60273a95d628c43fbeb3925ee54db6e Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_catalog_summary.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_diamonds_corr.png b/radiant.model/inst/app/tools/help/figures/regress_diamonds_corr.png new file mode 100644 index 0000000000000000000000000000000000000000..a982b0a007ffc0c6fc11144f465da3bfd11dd368 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_diamonds_corr.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_diamonds_dashboard.png b/radiant.model/inst/app/tools/help/figures/regress_diamonds_dashboard.png new file mode 100644 index 0000000000000000000000000000000000000000..b9d70bcd37740b233e9188390b5d0cb2cd1444a1 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_diamonds_dashboard.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_diamonds_hist.png b/radiant.model/inst/app/tools/help/figures/regress_diamonds_hist.png new file mode 100644 index 0000000000000000000000000000000000000000..d775bd0a49b5034b05b78e8abeb28126f77ec747 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_diamonds_hist.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_diamonds_res_vs_pred.png b/radiant.model/inst/app/tools/help/figures/regress_diamonds_res_vs_pred.png new file mode 100644 index 0000000000000000000000000000000000000000..b825fe36235c5a4f3c7989c71b546c633ffeebbc Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_diamonds_res_vs_pred.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_diamonds_scatter.png b/radiant.model/inst/app/tools/help/figures/regress_diamonds_scatter.png new file mode 100644 index 0000000000000000000000000000000000000000..116f2438be877c67bea8ac1983999efcf96c7dc8 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_diamonds_scatter.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_ideal_corr.png b/radiant.model/inst/app/tools/help/figures/regress_ideal_corr.png new file mode 100644 index 0000000000000000000000000000000000000000..573e23c5b7265b433ef86edf3f8139f5e3695550 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_ideal_corr.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_ideal_dashboard.png b/radiant.model/inst/app/tools/help/figures/regress_ideal_dashboard.png new file mode 100644 index 0000000000000000000000000000000000000000..5c99c431a26452612cb3322d0e9d915d23c83e3a Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_ideal_dashboard.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_ideal_hist.png b/radiant.model/inst/app/tools/help/figures/regress_ideal_hist.png new file mode 100644 index 0000000000000000000000000000000000000000..183a8c74bb2df5d18cfa2e464a2f6706cf351e21 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_ideal_hist.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_ideal_res_vs_pred.png b/radiant.model/inst/app/tools/help/figures/regress_ideal_res_vs_pred.png new file mode 100644 index 0000000000000000000000000000000000000000..b11227e41cb539a8263d76802c20059cb4c59860 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_ideal_res_vs_pred.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_ideal_scatter.png b/radiant.model/inst/app/tools/help/figures/regress_ideal_scatter.png new file mode 100644 index 0000000000000000000000000000000000000000..dd4f26c934eafa0ce0bb9af161fdb16ad1bea8b7 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_ideal_scatter.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_ideal_summary.png b/radiant.model/inst/app/tools/help/figures/regress_ideal_summary.png new file mode 100644 index 0000000000000000000000000000000000000000..354ebbd376e41357e88e7ba0e235a20a971d94e5 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_ideal_summary.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_corr.png b/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_corr.png new file mode 100644 index 0000000000000000000000000000000000000000..e21cb7fb06d8aa72cc3ec8bf9c74a59cbde33b5a Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_corr.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_dashboard.png b/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_dashboard.png new file mode 100644 index 0000000000000000000000000000000000000000..2dd4b390006a42d5e46f42a1c397f76e9d1922f5 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_dashboard.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_hist.png b/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_hist.png new file mode 100644 index 0000000000000000000000000000000000000000..d739b7a1e0a30c47f1fb6e9cf688340d679ee2d6 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_hist.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_res_vs_pred.png b/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_res_vs_pred.png new file mode 100644 index 0000000000000000000000000000000000000000..fd271509889d875113c27035a86bb6e6520bd695 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_res_vs_pred.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_scatter.png b/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_scatter.png new file mode 100644 index 0000000000000000000000000000000000000000..dde019272aa8883afc4f6aab3160cc4e9d28ce20 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_scatter.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_summary.png b/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_summary.png new file mode 100644 index 0000000000000000000000000000000000000000..15dc5bcc32a9e7825165c8caba52f8ba81040cb8 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_summary.png differ diff --git a/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_viz_scatter.png b/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_viz_scatter.png new file mode 100644 index 0000000000000000000000000000000000000000..2c10b0e377600924c89fd804b41b7da12effa269 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/regress_log_diamonds_viz_scatter.png differ diff --git a/radiant.model/inst/app/tools/help/figures/simulater_repeat.png b/radiant.model/inst/app/tools/help/figures/simulater_repeat.png new file mode 100644 index 0000000000000000000000000000000000000000..d07290e600b1407dd7b916fc0473544adffa6b13 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/simulater_repeat.png differ diff --git a/radiant.model/inst/app/tools/help/figures/simulater_repeat_plot.png b/radiant.model/inst/app/tools/help/figures/simulater_repeat_plot.png new file mode 100644 index 0000000000000000000000000000000000000000..a664e3a4da4cb39297c938b7e1255c8c8023d691 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/simulater_repeat_plot.png differ diff --git a/radiant.model/inst/app/tools/help/figures/simulater_sim.png b/radiant.model/inst/app/tools/help/figures/simulater_sim.png new file mode 100644 index 0000000000000000000000000000000000000000..8aa101f44bf271a6067c21b7d37c7a87e74f22e5 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/simulater_sim.png differ diff --git a/radiant.model/inst/app/tools/help/figures/simulater_sim_plot.png b/radiant.model/inst/app/tools/help/figures/simulater_sim_plot.png new file mode 100644 index 0000000000000000000000000000000000000000..dca8e6dbb9d0c1084fba525143b0f63a8fa4faf1 Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/simulater_sim_plot.png differ diff --git a/radiant.model/inst/app/tools/help/figures/simulater_view.png b/radiant.model/inst/app/tools/help/figures/simulater_view.png new file mode 100644 index 0000000000000000000000000000000000000000..b15cd59ebdb2ea32c0e21ace6acc939eddb8949f Binary files /dev/null and b/radiant.model/inst/app/tools/help/figures/simulater_view.png differ diff --git a/radiant.model/inst/app/tools/help/gbt.md b/radiant.model/inst/app/tools/help/gbt.md new file mode 100644 index 0000000000000000000000000000000000000000..197ea3ed200b53c50901765bd601b5df2e938474 --- /dev/null +++ b/radiant.model/inst/app/tools/help/gbt.md @@ -0,0 +1,20 @@ +> 估计梯度提升树 + +要估计梯度提升树模型，请选择类型（即分类或回归）、响应变量以及一个或多个解释变量。点击`Estimate`按钮或按`CTRL-enter`（在 Mac 上为`CMD-enter`）生成结果。 + +可通过调整 Radiant 中可用的参数输入对模型进行 “调优”。除这些参数外，其他参数可在 “报告 > Rmd” 中调整。确定所有这些超参数最优值的最佳方法是使用交叉验证。在 Radiant 中，你可以使用`cv.gbt`函数实现此目的。更多信息请参见文档。 + +有关可用于 XGBoost 的参数设置的更多信息，请参见以下链接： + +* https://xgboost.readthedocs.io/en/latest/parameter.html +* https://xgboost.readthedocs.io/en/latest/tutorials/param_tuning.html + +### Report > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*Report> Rmd*添加代码以（重新）创建分析。 + +### R 函数 + +有关 Radiant 中用于估计神经网络模型的相关 R 函数概述，请参见*模型 > 神经网络*。 + +`gbt`工具中使用的来自`xgboost`包的核心函数是`xgboost`。 diff --git a/radiant.model/inst/app/tools/help/logistic.Rmd b/radiant.model/inst/app/tools/help/logistic.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..86f3fa5b98376223cfda0ff420038d6558e64203 --- /dev/null +++ b/radiant.model/inst/app/tools/help/logistic.Rmd @@ -0,0 +1,119 @@ +> 估计用于分类的逻辑回归 + +### 功能说明 + +要估计逻辑回归模型，我们需要一个二元响应变量和一个或多个解释变量。我们还需要指定响应变量中被视为 “成功事件” 的水平（即 “选择水平（Choose level:）” 下拉菜单）。在示例数据集`titanic`中，变量`survived`的成功水平为`Yes`（存活）。 + +要获取该数据集，请前往 “数据> 管理”，从 “加载数据类型（Load data of type）” 下拉菜单中选择`examples`，然后点击 “加载（Load）” 按钮，接着选择`titanic`数据集。 + +在 “摘要（Summary）” 标签页中，我们可以通过在 “待检验变量（Variables to test）” 下拉菜单中选择变量，来检验两个或多个变量是否共同对模型拟合有显著贡献。此功能对于检验因子（factor）类型变量的整体影响是否具有统计显著性非常有用。 + +需要重新估计的额外输出： + +* 标准化（Standardize）：如果解释变量的测量尺度不同，优势比（Odds-ratios）可能难以比较。通过在估计前对解释变量进行标准化，我们可以看出哪些变量的影响更大。Radiant 中对逻辑回归数据的标准化方法是将所有解释变量X替换为(X−mean(X))/(2×sd(X))。详见Gelman 2008的讨论。 +* 中心化（Center）：将所有解释变量X替换为X−mean(X)。这在解释交互效应时可能有用。 +* 逐步回归（Stepwise）：一种数据挖掘方法，用于选择拟合效果最佳的模型。使用时需谨慎！ +* 稳健标准误（Robust standard errors）：选择 “稳健（robust）” 后，系数估计值与普通逻辑回归相同，但标准误会进行调整。当估计中指定概率权重时，默认使用此调整。 + +无需重新估计的额外输出： + +- VIF：方差膨胀因子（Variance Inflation Factors）和 R 平方（Rsq），这些是解释变量间多重共线性的度量指标。 +- 置信区间（Confidence intervals）：系数的置信区间。 +- 优势比（Odds）：带置信区间的优势比。 + +### 示例 1：泰坦尼克号生存情况 + +我们以描述泰坦尼克号乘客生存状态的数据集为例。泰坦尼克号乘客数据的主要来源是《泰坦尼克号百科全书》。原始来源之一是 Eaton & Haas（1994）的《Titanic: Triumph and Tragedy》（Patrick Stephens Ltd 出版），其中包含由多位研究者编制并经 Michael A. Findlay 编辑的乘客名单。假设我们想研究哪些因素与泰坦尼克号沉没时的生存概率密切相关。我们重点关注数据中的四个变量： + +- `survived`：因子变量，水平为`Yes`（存活）和`No`（未存活） +- `pclass`：乘客等级（1st、2nd、3rd），作为社会经济地位（SES）的替代指标（1st≈上层；2nd≈中层；3rd≈下层） +- `sex`：性别（female 女性、male 男性） +- `age`：年龄（岁） + +选择`survived`作为响应变量，并在 “选择水平（Choose level）” 中选择`Yes`。选择`pclass`、`sex`和`age`作为解释变量。在下方截图中，我们看到每个系数都具有统计显著性（p 值 <0.05），且模型具有一定的预测能力（卡方统计量 < 0.05）。遗憾的是，逻辑回归模型的系数难以直接解释。“OR” 列提供了估计的优势比。我们发现，与一等舱乘客相比，二等舱和三等舱乘客的生存优势显著更低；男性的生存优势也低于女性。虽然年龄的影响在统计上显著，但每增加 1 岁，生存优势的变化并不强烈（另见标准化系数）。 + +对于每个解释变量，可针对优势比提出以下原假设和备择假设： + +* H0：解释变量 x 相关的优势比等于 1 +* Ha：解释变量 x 相关的优势比不等于 1 + +逻辑回归的优势比可解释如下： + +- 在模型中其他变量保持不变的情况下，与一等舱乘客相比，二等舱乘客的生存优势低 72%。 +- 在模型中其他变量保持不变的情况下，与一等舱乘客相比，三等舱乘客的生存优势低 89.8%。 +- 在模型中其他变量保持不变的情况下，与女性乘客相比，男性乘客的生存优势低 91.7%。 +- 在模型中其他变量保持不变的情况下，乘客年龄每增加 1 岁，生存优势下降 3.4%。 + +

    + +除了 “摘要” 标签页中的数值输出外，我们还可以可视化评估生存状态（`survival`）与等级（`class`）、性别（`sex`）和年龄（`age`）之间的关系（见 “绘图（Plot）” 标签页）。在下方截图中，我们看到带有置信区间的系数（更准确地说是优势比）图。性别和等级相对于年龄的重要性明显突出。注意：在 “摘要” 标签页中勾选标准化系数（`standardize`），看看结论是否会改变。 + +

    + +概率通常比逻辑回归模型的系数或优势比更便于解释。我们可以使用 “预测（Predict）” 标签页来预测解释变量取不同值时的概率（这是逻辑回归模型的常见用途）。首先，通过 “预测输入类型（Prediction input type）” 下拉菜单选择预测输入类型，可选择现有数据集（“Data”）或指定命令（“Command”）生成预测输入。如果选择输入命令，必须在 “预测命令（Prediction command）” 框中至少指定一个变量和一个值才能获得预测结果。如果未为模型中的每个变量指定值，则会使用均值或最频繁的水平。只能基于模型中使用的变量预测结果（例如，要预测 90 岁乘客的生存概率，`age`必须是所选解释变量之一）。 + +要查看生存概率如何随乘客等级变化，请在 “预测” 标签页的 “预测输入类型” 下拉菜单中选择 “Command”，在 “预测命令” 框中输入`pclass = levels(pclass)`，然后按回车。 + +

    + +上图显示，与一等舱乘客相比，二等舱和三等舱乘客的生存概率大幅下降。对于平均年龄（样本中约 30 岁）的男性，生存概率接近 50%；而对于 30 岁、男性、三等舱乘客，这一概率接近 9%。 + +```r + age sex pclass pred + 29.881 male 1st 0.499 + 29.881 male 2nd 0.217 + 29.881 male 3rd 0.092 +``` + +要查看性别的影响，在 “预测命令” 框中输入`sex = levels(sex)`并按回车。对于平均年龄的三等舱女性，生存概率约为 50%；而具有相同年龄和等级特征的男性，生存概率接近 9%。 + +```r + age pclass sex pred + 29.881 3rd female 0.551 + 29.881 3rd male 0.092 +``` + +要查看年龄的影响，在 “预测命令” 框中输入`age = seq(0, 100, 20)`并按回车。对于三等舱的男婴，生存概率约为 22%；对于 60 岁的三等舱男性，这一概率降至约 3.5%；对于船上年龄最大的男性，模型预测的生存概率接近 1%。 + +```r + pclass sex age pred + 3rd male 0 0.220 + 3rd male 20 0.124 + 3rd male 40 0.067 + 3rd male 60 0.035 + 3rd male 80 0.018 + 3rd male 100 0.009 +``` + +要更全面地了解性别、年龄和乘客等级对生存概率的影响，可在 “预测” 标签页的 “预测输入” 下拉菜单中选择 “Data”，并从 “预测数据（Prediction data）” 下拉菜单中选择`titanic`，生成完整的概率表。表格形式的大量数据难以直观解释，但下图清晰展示了生存概率如何随`age`、`gender`和`pclass`变化： + +

    + +你也可以在 “数据> 转换” 中使用 “扩展网格（Expand grid）” 创建输入数据集，或在电子表格中创建后通过 “数据 > 管理” 标签页粘贴到 Radiant 中。你还可以加载 csv 数据作为输入。例如，将以下链接`https://radiant-rstats.github.io/docs/examples/glm_pred.csv`粘贴到 Radiant 的 “数据> 管理” 标签页中，尝试生成相同的预测。提示：使用 “csv (url)” 加载上述数据链接。 + +生成所需预测后，可通过点击屏幕右上角的下载图标将其保存为 CSV 文件。要将预测结果添加到用于估计的数据集，点击 “存储（Store）” 按钮。 + +### 示例 2：DVD 销售情况 + +我们使用数据集`dvd.rds`，可从GitHub下载。该数据包含 20,000 名收到 “即时优惠券” 的客户样本信息。优惠券面值在 1 美元到 5 美元之间变化，并随机分配给选定客户。我们可以使用逻辑回归估计优惠券对新发行 DVD 购买行为的影响。数据中用变量`buy`标识收到优惠券并购买 DVD 的客户（`buy` = `yes`表示客户购买了 DVD，`buy` = `no`表示未购买）。由于我们要预测的变量是二元的，逻辑回归是合适的选择。 + +为简化示例，我们仅使用客户收到的优惠券面值信息。因此，`buy`是响应变量，`coupon`是解释（或预测）变量。 + +

    + +回归输出显示，优惠券面值是客户购买行为的显著预测因子。逻辑回归的系数为 0.701，优势比等于 2.015（即e0.701）。由于优势比大于 1，较高的优惠券面值与较高的购买优势相关。此外，由于系数的 p 值小于 0.05，我们得出结论：（1）系数在统计上显著异于 0；（2）优势比在统计上显著异于 1。优势比为 1 相当于线性回归中的系数估计为 0，意味着解释（或预测）变量对响应变量无影响。估计的优势比 2.015 表明，优惠券面值每增加 1 美元，购买优势增加 101.6%。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令或`gridExtra`进行自定义。详见下方示例和*数据 > 可视化*。 + +```r +plot(result, plots = "coef", custom = TRUE) + + labs(title = "Coefficient plot") +``` + +### R 函数 + +有关 Radiant 中用于估计逻辑回归模型的相关 R 函数概述，请参见*模型 > 逻辑回归*。 diff --git a/radiant.model/inst/app/tools/help/logistic.md b/radiant.model/inst/app/tools/help/logistic.md new file mode 100644 index 0000000000000000000000000000000000000000..86f3fa5b98376223cfda0ff420038d6558e64203 --- /dev/null +++ b/radiant.model/inst/app/tools/help/logistic.md @@ -0,0 +1,119 @@ +> 估计用于分类的逻辑回归 + +### 功能说明 + +要估计逻辑回归模型，我们需要一个二元响应变量和一个或多个解释变量。我们还需要指定响应变量中被视为 “成功事件” 的水平（即 “选择水平（Choose level:）” 下拉菜单）。在示例数据集`titanic`中，变量`survived`的成功水平为`Yes`（存活）。 + +要获取该数据集，请前往 “数据> 管理”，从 “加载数据类型（Load data of type）” 下拉菜单中选择`examples`，然后点击 “加载（Load）” 按钮，接着选择`titanic`数据集。 + +在 “摘要（Summary）” 标签页中，我们可以通过在 “待检验变量（Variables to test）” 下拉菜单中选择变量，来检验两个或多个变量是否共同对模型拟合有显著贡献。此功能对于检验因子（factor）类型变量的整体影响是否具有统计显著性非常有用。 + +需要重新估计的额外输出： + +* 标准化（Standardize）：如果解释变量的测量尺度不同，优势比（Odds-ratios）可能难以比较。通过在估计前对解释变量进行标准化，我们可以看出哪些变量的影响更大。Radiant 中对逻辑回归数据的标准化方法是将所有解释变量X替换为(X−mean(X))/(2×sd(X))。详见Gelman 2008的讨论。 +* 中心化（Center）：将所有解释变量X替换为X−mean(X)。这在解释交互效应时可能有用。 +* 逐步回归（Stepwise）：一种数据挖掘方法，用于选择拟合效果最佳的模型。使用时需谨慎！ +* 稳健标准误（Robust standard errors）：选择 “稳健（robust）” 后，系数估计值与普通逻辑回归相同，但标准误会进行调整。当估计中指定概率权重时，默认使用此调整。 + +无需重新估计的额外输出： + +- VIF：方差膨胀因子（Variance Inflation Factors）和 R 平方（Rsq），这些是解释变量间多重共线性的度量指标。 +- 置信区间（Confidence intervals）：系数的置信区间。 +- 优势比（Odds）：带置信区间的优势比。 + +### 示例 1：泰坦尼克号生存情况 + +我们以描述泰坦尼克号乘客生存状态的数据集为例。泰坦尼克号乘客数据的主要来源是《泰坦尼克号百科全书》。原始来源之一是 Eaton & Haas（1994）的《Titanic: Triumph and Tragedy》（Patrick Stephens Ltd 出版），其中包含由多位研究者编制并经 Michael A. Findlay 编辑的乘客名单。假设我们想研究哪些因素与泰坦尼克号沉没时的生存概率密切相关。我们重点关注数据中的四个变量： + +- `survived`：因子变量，水平为`Yes`（存活）和`No`（未存活） +- `pclass`：乘客等级（1st、2nd、3rd），作为社会经济地位（SES）的替代指标（1st≈上层；2nd≈中层；3rd≈下层） +- `sex`：性别（female 女性、male 男性） +- `age`：年龄（岁） + +选择`survived`作为响应变量，并在 “选择水平（Choose level）” 中选择`Yes`。选择`pclass`、`sex`和`age`作为解释变量。在下方截图中，我们看到每个系数都具有统计显著性（p 值 <0.05），且模型具有一定的预测能力（卡方统计量 < 0.05）。遗憾的是，逻辑回归模型的系数难以直接解释。“OR” 列提供了估计的优势比。我们发现，与一等舱乘客相比，二等舱和三等舱乘客的生存优势显著更低；男性的生存优势也低于女性。虽然年龄的影响在统计上显著，但每增加 1 岁，生存优势的变化并不强烈（另见标准化系数）。 + +对于每个解释变量，可针对优势比提出以下原假设和备择假设： + +* H0：解释变量 x 相关的优势比等于 1 +* Ha：解释变量 x 相关的优势比不等于 1 + +逻辑回归的优势比可解释如下： + +- 在模型中其他变量保持不变的情况下，与一等舱乘客相比，二等舱乘客的生存优势低 72%。 +- 在模型中其他变量保持不变的情况下，与一等舱乘客相比，三等舱乘客的生存优势低 89.8%。 +- 在模型中其他变量保持不变的情况下，与女性乘客相比，男性乘客的生存优势低 91.7%。 +- 在模型中其他变量保持不变的情况下，乘客年龄每增加 1 岁，生存优势下降 3.4%。 + +

    + +除了 “摘要” 标签页中的数值输出外，我们还可以可视化评估生存状态（`survival`）与等级（`class`）、性别（`sex`）和年龄（`age`）之间的关系（见 “绘图（Plot）” 标签页）。在下方截图中，我们看到带有置信区间的系数（更准确地说是优势比）图。性别和等级相对于年龄的重要性明显突出。注意：在 “摘要” 标签页中勾选标准化系数（`standardize`），看看结论是否会改变。 + +

    + +概率通常比逻辑回归模型的系数或优势比更便于解释。我们可以使用 “预测（Predict）” 标签页来预测解释变量取不同值时的概率（这是逻辑回归模型的常见用途）。首先，通过 “预测输入类型（Prediction input type）” 下拉菜单选择预测输入类型，可选择现有数据集（“Data”）或指定命令（“Command”）生成预测输入。如果选择输入命令，必须在 “预测命令（Prediction command）” 框中至少指定一个变量和一个值才能获得预测结果。如果未为模型中的每个变量指定值，则会使用均值或最频繁的水平。只能基于模型中使用的变量预测结果（例如，要预测 90 岁乘客的生存概率，`age`必须是所选解释变量之一）。 + +要查看生存概率如何随乘客等级变化，请在 “预测” 标签页的 “预测输入类型” 下拉菜单中选择 “Command”，在 “预测命令” 框中输入`pclass = levels(pclass)`，然后按回车。 + +

    + +上图显示，与一等舱乘客相比，二等舱和三等舱乘客的生存概率大幅下降。对于平均年龄（样本中约 30 岁）的男性，生存概率接近 50%；而对于 30 岁、男性、三等舱乘客，这一概率接近 9%。 + +```r + age sex pclass pred + 29.881 male 1st 0.499 + 29.881 male 2nd 0.217 + 29.881 male 3rd 0.092 +``` + +要查看性别的影响，在 “预测命令” 框中输入`sex = levels(sex)`并按回车。对于平均年龄的三等舱女性，生存概率约为 50%；而具有相同年龄和等级特征的男性，生存概率接近 9%。 + +```r + age pclass sex pred + 29.881 3rd female 0.551 + 29.881 3rd male 0.092 +``` + +要查看年龄的影响，在 “预测命令” 框中输入`age = seq(0, 100, 20)`并按回车。对于三等舱的男婴，生存概率约为 22%；对于 60 岁的三等舱男性，这一概率降至约 3.5%；对于船上年龄最大的男性，模型预测的生存概率接近 1%。 + +```r + pclass sex age pred + 3rd male 0 0.220 + 3rd male 20 0.124 + 3rd male 40 0.067 + 3rd male 60 0.035 + 3rd male 80 0.018 + 3rd male 100 0.009 +``` + +要更全面地了解性别、年龄和乘客等级对生存概率的影响，可在 “预测” 标签页的 “预测输入” 下拉菜单中选择 “Data”，并从 “预测数据（Prediction data）” 下拉菜单中选择`titanic`，生成完整的概率表。表格形式的大量数据难以直观解释，但下图清晰展示了生存概率如何随`age`、`gender`和`pclass`变化： + +

    + +你也可以在 “数据> 转换” 中使用 “扩展网格（Expand grid）” 创建输入数据集，或在电子表格中创建后通过 “数据 > 管理” 标签页粘贴到 Radiant 中。你还可以加载 csv 数据作为输入。例如，将以下链接`https://radiant-rstats.github.io/docs/examples/glm_pred.csv`粘贴到 Radiant 的 “数据> 管理” 标签页中，尝试生成相同的预测。提示：使用 “csv (url)” 加载上述数据链接。 + +生成所需预测后，可通过点击屏幕右上角的下载图标将其保存为 CSV 文件。要将预测结果添加到用于估计的数据集，点击 “存储（Store）” 按钮。 + +### 示例 2：DVD 销售情况 + +我们使用数据集`dvd.rds`，可从GitHub下载。该数据包含 20,000 名收到 “即时优惠券” 的客户样本信息。优惠券面值在 1 美元到 5 美元之间变化，并随机分配给选定客户。我们可以使用逻辑回归估计优惠券对新发行 DVD 购买行为的影响。数据中用变量`buy`标识收到优惠券并购买 DVD 的客户（`buy` = `yes`表示客户购买了 DVD，`buy` = `no`表示未购买）。由于我们要预测的变量是二元的，逻辑回归是合适的选择。 + +为简化示例，我们仅使用客户收到的优惠券面值信息。因此，`buy`是响应变量，`coupon`是解释（或预测）变量。 + +

    + +回归输出显示，优惠券面值是客户购买行为的显著预测因子。逻辑回归的系数为 0.701，优势比等于 2.015（即e0.701）。由于优势比大于 1，较高的优惠券面值与较高的购买优势相关。此外，由于系数的 p 值小于 0.05，我们得出结论：（1）系数在统计上显著异于 0；（2）优势比在统计上显著异于 1。优势比为 1 相当于线性回归中的系数估计为 0，意味着解释（或预测）变量对响应变量无影响。估计的优势比 2.015 表明，优惠券面值每增加 1 美元，购买优势增加 101.6%。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令或`gridExtra`进行自定义。详见下方示例和*数据 > 可视化*。 + +```r +plot(result, plots = "coef", custom = TRUE) + + labs(title = "Coefficient plot") +``` + +### R 函数 + +有关 Radiant 中用于估计逻辑回归模型的相关 R 函数概述，请参见*模型 > 逻辑回归*。 diff --git a/radiant.model/inst/app/tools/help/mnl.Rmd b/radiant.model/inst/app/tools/help/mnl.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..846e2a5ee60158396b5cec4ea25ff08ce7af2cb9 --- /dev/null +++ b/radiant.model/inst/app/tools/help/mnl.Rmd @@ -0,0 +1,104 @@ +> 估计用于分类的多项式逻辑回归（MNL） + +### 功能说明 + +要估计多项逻辑回归（MNL）模型，我们需要一个具有两个或多个水平的分类响应变量，以及一个或多个解释变量。我们还需要指定响应变量中用作比较基准的水平。在示例数据集`ketchup`中，我们可以通过在 “摘要（Summary）” 标签页的 “选择水平（Choose level）” 下拉菜单中选择`heinz28`，将其设为基准水平。 + +要获取`ketchup`数据集，请前往 “数据> 管理”，从 “加载数据类型（Load data of type）” 下拉菜单中选择`examples`，点击 “加载（Load）” 按钮，然后选择`ketchup`数据集。 + +在 “摘要” 标签页中，我们可以通过在 “待检验变量（Variables to test）” 下拉菜单中选择变量，检验两个或多个变量是否共同改善模型拟合。此功能对于评估具有三个或更多水平的因子（factor）类型变量的整体影响非常有用。 + +需要重新估计的额外输出： + +* 标准化（Standardize）：如果解释变量的测量尺度不同，相对风险比（RRRs）可能难以比较。通过在估计前对解释变量进行标准化，我们可以看出哪些变量的影响更大。Radiant 中对多项逻辑回归数据的标准化方法是将所有解释变量X替换为(X−mean(X))/(2×sd(X))。详见Gelman 2008的讨论。 +* 中心化（Center）：将所有解释变量X替换为X−mean(X)。这在解释交互效应时可能有用。 +* 逐步回归（Stepwise）：一种数据挖掘方法，用于选择拟合效果最佳的模型。使用时需谨慎！ + +无需重新估计的额外输出： + +- 置信区间（Confidence intervals）：系数的置信区间。 +- 相对风险比（RRRs）：带置信区间的相对风险比。 +- 混淆矩阵（Confusion）：展示（1）数据中观察到的实际类别与（2）模型预测的最可能类别之间一致性（或不一致性）的混淆矩阵。 + +### 示例：番茄酱选择行为 + +我们以美国密苏里州斯普林菲尔德市一个家庭面板中 300 名个体的选择行为数据集为例。该数据记录了约 2 年时间内 2798 次购买场景的信息，包含以下变量： + +* `id`：个体标识 +* `choice`：选择结果，取值为 heinz41、heinz32、heinz28、hunts32 中的一种 +* `price.x`：产品 x 的价格 +* `disp.x`：产品 x 是否有陈列（是或否） +* `feat.x`：产品 x 是否有报纸特色广告（是或否） + +下方 “数据> 透视表” 标签页的截图显示，`heinz32`是最受欢迎的选择，其次是`heinz28`。`heinz41`和`hunts32`在家庭面板成员中的选择频率低得多。 + +

    + +假设我们想研究不同产品的价格如何影响番茄酱品牌和包装规格的选择。在 “模型> 多项逻辑回归（MNL） > 摘要” 标签页中，选择`choice`作为响应变量，并从 “选择基准水平（Choose base level）” 下拉菜单中选择`heinz28`。选择`price.heinz28`至`price.hunts32`作为解释变量。在下方截图中，我们看到大多数（但并非全部）系数的 p 值非常小，且模型具有一定的预测能力（卡方统计量的 p 值 < 0.001）。最左侧的输出列显示系数对应的产品。例如，系数和统计量的第二行反映了`price.heinz28`的变化对选择`heinz32`相对于基准产品（即`heinz28`）的影响。如果消费者将`heinz28`和`heinz32`视为替代品（这很可能），我们预期`price.heinz28`上涨会导致消费者选择`heinz32`而非`heinz28`的优势增加。 + +遗憾的是，多项逻辑回归模型的系数难以直接解释。但 “RRR” 列提供了相对风险比（或优势比）的估计值，更便于分析。`RRR`值是回归系数的指数化结果（即exp(1.099)=3.000）。我们发现，在模型中其他变量保持不变的情况下，`price.heinz28`每上涨 1 美元，购买`heinz32`而非`heinz28`的 “风险”（或优势）变为原来的 3 倍。 + +

    + +对于每个解释变量，可提出以下原假设和备择假设： + +- H0：解释变量 x 相关的相对风险比等于 1 +- Ha：解释变量 x 相关的相对风险比不等于 1 + +多项逻辑回归中部分相对风险比的解释如下： + +```r + RRR coefficient std.error z.value p.value + heinz32 price.heinz32 0.101 -2.296 0.135 -17.033 < .001 *** + hunts32 price.heinz28 3.602 1.282 0.126 10.200 < .001 *** + hunts32 price.hunts32 0.070 -2.655 0.208 -12.789 < .001 *** +``` + +- `price.heinz32`每上涨 1 美元，选择`heinz32`而非`heinz28`的相对优势比为 0.101。即当`heinz32`价格上涨 1 美元时，在模型中其他变量保持不变的情况下，选择`heinz32`而非`heinz28`的优势变为原来的 0.101 倍，或下降 89.9%。 +- `price.heinz28`每上涨 1 美元，选择`hunts32`而非`heinz28`的相对优势比为 3.602。即当`heinz28`价格上涨 1 美元时，在模型中其他变量保持不变的情况下，选择`hunts32`而非`heinz28`的优势变为原来的 3.602 倍，或增加 260.2%。 +- `price.hunts32`每上涨 1 美元，选择`hunts32`而非`heinz28`的相对优势比为 0.070。即当`hunts32`价格上涨 1 美元时，在模型中其他变量保持不变的情况下，选择`hunts32`而非`heinz28`的优势变为原来的 0.070 倍，或下降 93%。 + +模型中估计的其他`RRRs`可按类似方式解释。 + +除了 “摘要” 标签页中的数值输出外，我们还可以可视化评估选择结果（`choice`）与四种产品价格之间的关系（见 “绘图（Plot）” 标签页）。在下方截图中，我们看到带有置信区间的系数（更准确地说是 RRR）图。我们观察到以下模式： + +- 当`price.heinz28`上涨 1 美元时，选择`heinz32`、`heinz41`和`hunts32`的相对优势显著增加 +- 当`price.heinz32`上涨时，选择`heinz32`而非`heinz28`的优势显著下降。当`heinz41`和`hunts32`的价格上涨时，我们也观察到相同模式 +- `hunts32`是唯一一种在`price.heinz32`上涨时，相对于`heinz28`的购买优势显著提升的产品 + +

    + +概率通常比多项逻辑回归模型的系数或相对风险比更便于解释。我们可以使用 “预测（Predict）” 标签页，在给定所选解释变量特定值的情况下，预测响应变量每个水平的概率。首先，通过 “预测输入类型（Prediction input type）” 下拉菜单选择预测输入类型，可选择现有数据集（“Data”）或指定命令（“Command”）生成预测输入。如果选择输入命令，必须在 “预测命令（Prediction command）” 框中至少指定一个变量和一个值才能获得预测结果。如果未为模型中的每个变量指定值，则会使用均值或最频繁出现的水平。只能基于模型中使用的变量预测概率。例如，要预测`heinz32`定价为 3.80 美元时的选择概率，`price.heinz32`必须是所选解释变量之一。 + +* 要预测商店中`hunts32`有陈列时四种产品的选择概率，在命令框中输入`disp.hunts32 = "yes"`并按回车 +* 要预测`heinz41`有无陈列和有无特色广告时的选择概率，输入`disp.heinz41 = c("yes", "no"), feat.heinz41 = c("yes", "no")`并按回车 +* 要查看随着`price.heinz28`上涨，每种产品的选择概率如何变化，输入`price.heinz28 = seq(3.40, 5.20, 0.1)`并按回车。见下方截图。 + +

    + +上图显示，随着`price.heinz28`上涨，`heinz28`的购买概率大幅下降。数据中最受欢迎的`heinz32`，在`price.heinz28`上涨后，其预测购买概率大幅增加。尽管图表中`hunts32`的预测购买概率增幅看似不如`heinz32`显著，但相对增幅更大（即`hunts32`从 3.2% 增至 8.4%，而`heinz32`从 39.3% 增至 72.8%）。 + +要更全面地评估四种产品的价格变化对购买概率的影响，可在 “预测” 标签页的 “预测输入类型” 下拉菜单中选择 “Data”，并从 “预测数据（Predict data）” 下拉菜单中选择`ketchup`，生成完整的预测表。你也可以在 “数据> 转换” 中使用 “扩展网格（Expand grid）” 创建输入数据集，或在电子表格中创建后通过 “数据 > 管理” 标签页粘贴到 Radiant 中。 + +生成所需预测后，可通过点击预测表右上角的下载图标将其保存为 CSV 文件。要将预测结果添加到用于估计的数据集，点击 “存储（Store）” 按钮。 + +注意，MNL 模型生成的概率列数与分类响应变量的水平数相同（即番茄酱数据中有 4 列）。如果只想将第一水平（即`heinz28`）的预测结果添加到用于估计的数据集，在 “存储预测（Store predictions）” 输入框中仅提供一个名称即可。如果想存储所有番茄酱产品的预测结果，输入四个变量名，用逗号分隔。 + +> 注意：在上述讨论中，我们忽略了内生性问题。例如，假设`price.heinz28`的变化源于`heinz28`质量的变化，质量变化会影响价格，也可能影响产品需求。除非我们以某种方式控制质量变化，否则价格变化的估计效应很可能不准确（即存在偏差）。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令或`gridExtra`进行自定义。详见下方示例和*数据 > 可视化*。 + +```r +plot(result, plots = "coef", custom = TRUE) + + labs(title = "Coefficient plot") +``` + +### R 函数 + +有关 Radiant 中用于估计多项逻辑回归模型的相关 R 函数概述，请参见*模型 > 多项式逻辑回归*。 + +`mnl`工具中使用的核心函数包括`nnet`包中的`multinom`和`car`包中的`linearHypothesis`。 diff --git a/radiant.model/inst/app/tools/help/mnl.html b/radiant.model/inst/app/tools/help/mnl.html new file mode 100644 index 0000000000000000000000000000000000000000..4fd6e858d04e62f8a982361c14c653f158d2e1bb --- /dev/null +++ b/radiant.model/inst/app/tools/help/mnl.html @@ -0,0 +1,491 @@ + + + + + + + + + + + + + + +mnl.utf8.md + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    + + + + + + + +
    +

    Estimate a Multinomial Logistic regression (MNL) for classification

    +
    +
    +

    Functionality

    +

    To estimate a Multinomial Logistic regression (MNL) we need a categorical response variable with two or more levels and one or more explanatory variables. We also need to specify the level of the response variable to count as the base level for comparison (i.e., use the Choose level: dropdown). In the example data file, ketchup, we can use heinz28 as the base for comparison.

    +

    To access this dataset go to Data > Manage, select examples from the Load data of type dropdown, and press the Load button. Then select the ketchup dataset.

    +

    In the Summary tab we can test if two or more variables together add significantly to the fit of a model by selecting them in the Variables to test dropdown. This functionality can be very useful to test if the overall influence of a variable of type factor is statistically significant.

    +

    Additional output that requires re-estimation:

    +
      +
    • Standardize: Relative risk ratios (RRRs) can be hard to compare if the explanatory variables are measured on different scales. By standardizing the explanatory variables before estimation we can see which variables move-the-needle most. Note that in radiant a one-unit change will now equated to 2 x the standard deviation of the explanatory variable.
      • +
    • Center: Replace all explanatory variables X by X - mean(X). This can be useful when trying to interpret interaction effects.
      • +
    • Stepwise: A data-mining approach to select the best fitting model
      • +
    +

    Additional output that does not require re-estimation:

    +
      +
    • Confidence intervals: Coefficient confidence intervals
      • +
    • RRRs: Relative Risk Ratios with confidence intervals
      • +
    • Confusion: A confusion matrix that shows the (lack) of consistency between (1) the classes observed in the data and (2) the class predicted as most likely by the model.
      • +
    +

    We can use the Predict tab to predict probabilities for different values of the explanatory variable(s) (i.e., a common use of MNL models). First, select the type of input for prediction using the Prediction radio buttons. Choose either an existing dataset for prediction (“Data”) or specify a command (“Command”) to generate the prediction inputs. If you choose to enter a command you must specify at least one variable and one value to get a prediction. If you do not specify a value for each variable in the model either the mean value or the most frequent level will be used. It is only possible to predict outcomes based on variables used in the model (e.g., price.heinz32 must be one of the selected explanatory variables to predict the probability of choosing to buy heinz32 when priced at $3.80.

    +
      +
    • To predict the probability of choosing hunts32 when a display is available in stores use disp.hunts32 = "yes" and press enter
      • +
    • To predict the probability of choosing heinz28 when priced between $3 and $6 at 10 cent intervals type price.heinz28 = seq(3, 6, 0.1) and press enter
      • +
    • To predict the probability of choosing heinz41 when the brand is (not) on display and (not) featured type disp.heinz41 = c("yes", "no"), feat.heinz41 = c("yes", "no") and press enter
      • +
    +

    To generate predicted values for all cases in, for example, the ketchup dataset select Data from the Prediction input dropdown then select the ketchup dataset. You can also create a dataset for input in Data > Transform using Expand grid or in a spreadsheet and then paste it into Radiant through the Data > Manage tab. You can also load CSV data as input for prediction.

    +

    Once the desired predictions have been generated they can be saved to a CSV file by clicking the download button button on the top right of the screen. To add predictions to the dataset used for estimation, click the Store button. Note that MNL models generate as many columns of probabilities as there are level in the categorical response variable. If you want to store only the predictions for the first level (e.g., heinz28) provide only one name in the the Store predictions input. If you want to store predictions for all ketchup brands, enter four variable names, separated by a comma.

    +
    +
    +

    Example: Choice of ketchup brands

    +

    As an example we will use a dataset on on choice behavior for 300 individuals in a panel of households in Springfield, Missouri (USA). The data captures information on 2,798 purchase occasions over a period of around 2 years and includes the follow variables:

    +
      +
    • id: individual identifier
      • +
    • choice: one of heinz41, heinz32, heinz28, hunts32
      • +
    • price.z: price of brand z
      • +
    • disp.z: is there a display for brand z (yes or no)?
      • +
    • feat.z: is there a newspaper feature advertisement for brand z (yes or no)?
      • +
    +

    Suppose we want to investigate how prices of the different products influence the choice of ketchup brand and package size. In the Model > Multinomial logistic regression (MNL) select choice as the response variable and heinz28 from the Choose base level dropdown menu. Select price.heinz28 through price.hunts32 as the explanatory variables. In the screenshot below we see that several, but not all, of the coefficients are statistically significant (p.value < .05) and that the model has some predictive power (Chi-squared statistic < .05). The left-most output column show the which brand the coefficients apply to.

    +

    Unfortunately the coefficients from a logistic regression model are difficult to interpret. The OR column provides estimated odds-ratios. We see that the odds of survival were significantly lower for 2nd and 3rd class passengers compared to 1st class passenger. The odds of survival for males were also lower than for females. While the effect of age is statically significant, for each extra year in age the odds of survival are not as strongly affected (see also the standardized coefficient).

    + + + + +

    For each of the explanatory variables the following null and alternate hypotheses can be formulated for the odds ratios:

    +
      +
    • H0: The odds-ratio associated with explanatory variable x is equal to 1
      • +
    • Ha: The odds-ratio associated with explanatory variable x is not equal to 1
      • +
    +

    The odds-ratios from the logistic regression can be interpreted as follows:

    +
      +
    • Compared to 1st class passengers, the odds of survival for 2nd class passengers was 72% lower, keeping all other variables in the model constant.
      • +
    • Compared to 1st class passengers, the odds of survival for 3rd class passengers was 89.8% lower, keeping all other variables in the model constant.
      • +
    • Compared to female passengers, the odds of survival for male passengers was 91.7% lower, keeping all other variables in the model constant.
      • +
    • For an increase in passenger age of 1 year the odds of survival decreased by 3.4%, keeping all other variables in the model constant.
      • +
    +
    +
    +

    Report > Rmd

    +

    Add code to Report > Rmd to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing ALT-enter on your keyboard.

    +

    If a plot was created it can be customized using ggplot2 commands or with gridExtra. See example below and Data > Visualize for details.

    +
    plot(result, plots = "coef", custom = TRUE) +
+  labs(title = "Coefficient plot")
    +
    +
    +

    R-functions

    +

    This document is a work in progress. For a worked example using the multinom function, see the link below.

    + + +
    +
    +

    R-functions

    +

    For an overview of related R-functions used by Radiant to estimate a multinomial logistic regression model see Model > Multinomial logistic regression.

    +

    The key functions used in the mnl tool are multinom from the nnet package and linearHypothesis from the car package.

    +
    + + + + +
    + + + + + + + + + + + + + + + diff --git a/radiant.model/inst/app/tools/help/mnl.md b/radiant.model/inst/app/tools/help/mnl.md new file mode 100644 index 0000000000000000000000000000000000000000..846e2a5ee60158396b5cec4ea25ff08ce7af2cb9 --- /dev/null +++ b/radiant.model/inst/app/tools/help/mnl.md @@ -0,0 +1,104 @@ +> 估计用于分类的多项式逻辑回归（MNL） + +### 功能说明 + +要估计多项逻辑回归（MNL）模型，我们需要一个具有两个或多个水平的分类响应变量，以及一个或多个解释变量。我们还需要指定响应变量中用作比较基准的水平。在示例数据集`ketchup`中，我们可以通过在 “摘要（Summary）” 标签页的 “选择水平（Choose level）” 下拉菜单中选择`heinz28`，将其设为基准水平。 + +要获取`ketchup`数据集，请前往 “数据> 管理”，从 “加载数据类型（Load data of type）” 下拉菜单中选择`examples`，点击 “加载（Load）” 按钮，然后选择`ketchup`数据集。 + +在 “摘要” 标签页中，我们可以通过在 “待检验变量（Variables to test）” 下拉菜单中选择变量，检验两个或多个变量是否共同改善模型拟合。此功能对于评估具有三个或更多水平的因子（factor）类型变量的整体影响非常有用。 + +需要重新估计的额外输出： + +* 标准化（Standardize）：如果解释变量的测量尺度不同，相对风险比（RRRs）可能难以比较。通过在估计前对解释变量进行标准化，我们可以看出哪些变量的影响更大。Radiant 中对多项逻辑回归数据的标准化方法是将所有解释变量X替换为(X−mean(X))/(2×sd(X))。详见Gelman 2008的讨论。 +* 中心化（Center）：将所有解释变量X替换为X−mean(X)。这在解释交互效应时可能有用。 +* 逐步回归（Stepwise）：一种数据挖掘方法，用于选择拟合效果最佳的模型。使用时需谨慎！ + +无需重新估计的额外输出： + +- 置信区间（Confidence intervals）：系数的置信区间。 +- 相对风险比（RRRs）：带置信区间的相对风险比。 +- 混淆矩阵（Confusion）：展示（1）数据中观察到的实际类别与（2）模型预测的最可能类别之间一致性（或不一致性）的混淆矩阵。 + +### 示例：番茄酱选择行为 + +我们以美国密苏里州斯普林菲尔德市一个家庭面板中 300 名个体的选择行为数据集为例。该数据记录了约 2 年时间内 2798 次购买场景的信息，包含以下变量： + +* `id`：个体标识 +* `choice`：选择结果，取值为 heinz41、heinz32、heinz28、hunts32 中的一种 +* `price.x`：产品 x 的价格 +* `disp.x`：产品 x 是否有陈列（是或否） +* `feat.x`：产品 x 是否有报纸特色广告（是或否） + +下方 “数据> 透视表” 标签页的截图显示，`heinz32`是最受欢迎的选择，其次是`heinz28`。`heinz41`和`hunts32`在家庭面板成员中的选择频率低得多。 + +

    + +假设我们想研究不同产品的价格如何影响番茄酱品牌和包装规格的选择。在 “模型> 多项逻辑回归（MNL） > 摘要” 标签页中，选择`choice`作为响应变量，并从 “选择基准水平（Choose base level）” 下拉菜单中选择`heinz28`。选择`price.heinz28`至`price.hunts32`作为解释变量。在下方截图中，我们看到大多数（但并非全部）系数的 p 值非常小，且模型具有一定的预测能力（卡方统计量的 p 值 < 0.001）。最左侧的输出列显示系数对应的产品。例如，系数和统计量的第二行反映了`price.heinz28`的变化对选择`heinz32`相对于基准产品（即`heinz28`）的影响。如果消费者将`heinz28`和`heinz32`视为替代品（这很可能），我们预期`price.heinz28`上涨会导致消费者选择`heinz32`而非`heinz28`的优势增加。 + +遗憾的是，多项逻辑回归模型的系数难以直接解释。但 “RRR” 列提供了相对风险比（或优势比）的估计值，更便于分析。`RRR`值是回归系数的指数化结果（即exp(1.099)=3.000）。我们发现，在模型中其他变量保持不变的情况下，`price.heinz28`每上涨 1 美元，购买`heinz32`而非`heinz28`的 “风险”（或优势）变为原来的 3 倍。 + +

    + +对于每个解释变量，可提出以下原假设和备择假设： + +- H0：解释变量 x 相关的相对风险比等于 1 +- Ha：解释变量 x 相关的相对风险比不等于 1 + +多项逻辑回归中部分相对风险比的解释如下： + +```r + RRR coefficient std.error z.value p.value + heinz32 price.heinz32 0.101 -2.296 0.135 -17.033 < .001 *** + hunts32 price.heinz28 3.602 1.282 0.126 10.200 < .001 *** + hunts32 price.hunts32 0.070 -2.655 0.208 -12.789 < .001 *** +``` + +- `price.heinz32`每上涨 1 美元，选择`heinz32`而非`heinz28`的相对优势比为 0.101。即当`heinz32`价格上涨 1 美元时，在模型中其他变量保持不变的情况下，选择`heinz32`而非`heinz28`的优势变为原来的 0.101 倍，或下降 89.9%。 +- `price.heinz28`每上涨 1 美元，选择`hunts32`而非`heinz28`的相对优势比为 3.602。即当`heinz28`价格上涨 1 美元时，在模型中其他变量保持不变的情况下，选择`hunts32`而非`heinz28`的优势变为原来的 3.602 倍，或增加 260.2%。 +- `price.hunts32`每上涨 1 美元，选择`hunts32`而非`heinz28`的相对优势比为 0.070。即当`hunts32`价格上涨 1 美元时，在模型中其他变量保持不变的情况下，选择`hunts32`而非`heinz28`的优势变为原来的 0.070 倍，或下降 93%。 + +模型中估计的其他`RRRs`可按类似方式解释。 + +除了 “摘要” 标签页中的数值输出外，我们还可以可视化评估选择结果（`choice`）与四种产品价格之间的关系（见 “绘图（Plot）” 标签页）。在下方截图中，我们看到带有置信区间的系数（更准确地说是 RRR）图。我们观察到以下模式： + +- 当`price.heinz28`上涨 1 美元时，选择`heinz32`、`heinz41`和`hunts32`的相对优势显著增加 +- 当`price.heinz32`上涨时，选择`heinz32`而非`heinz28`的优势显著下降。当`heinz41`和`hunts32`的价格上涨时，我们也观察到相同模式 +- `hunts32`是唯一一种在`price.heinz32`上涨时，相对于`heinz28`的购买优势显著提升的产品 + +

    + +概率通常比多项逻辑回归模型的系数或相对风险比更便于解释。我们可以使用 “预测（Predict）” 标签页，在给定所选解释变量特定值的情况下，预测响应变量每个水平的概率。首先，通过 “预测输入类型（Prediction input type）” 下拉菜单选择预测输入类型，可选择现有数据集（“Data”）或指定命令（“Command”）生成预测输入。如果选择输入命令，必须在 “预测命令（Prediction command）” 框中至少指定一个变量和一个值才能获得预测结果。如果未为模型中的每个变量指定值，则会使用均值或最频繁出现的水平。只能基于模型中使用的变量预测概率。例如，要预测`heinz32`定价为 3.80 美元时的选择概率，`price.heinz32`必须是所选解释变量之一。 + +* 要预测商店中`hunts32`有陈列时四种产品的选择概率，在命令框中输入`disp.hunts32 = "yes"`并按回车 +* 要预测`heinz41`有无陈列和有无特色广告时的选择概率，输入`disp.heinz41 = c("yes", "no"), feat.heinz41 = c("yes", "no")`并按回车 +* 要查看随着`price.heinz28`上涨，每种产品的选择概率如何变化，输入`price.heinz28 = seq(3.40, 5.20, 0.1)`并按回车。见下方截图。 + +

    + +上图显示，随着`price.heinz28`上涨，`heinz28`的购买概率大幅下降。数据中最受欢迎的`heinz32`，在`price.heinz28`上涨后，其预测购买概率大幅增加。尽管图表中`hunts32`的预测购买概率增幅看似不如`heinz32`显著，但相对增幅更大（即`hunts32`从 3.2% 增至 8.4%，而`heinz32`从 39.3% 增至 72.8%）。 + +要更全面地评估四种产品的价格变化对购买概率的影响，可在 “预测” 标签页的 “预测输入类型” 下拉菜单中选择 “Data”，并从 “预测数据（Predict data）” 下拉菜单中选择`ketchup`，生成完整的预测表。你也可以在 “数据> 转换” 中使用 “扩展网格（Expand grid）” 创建输入数据集，或在电子表格中创建后通过 “数据 > 管理” 标签页粘贴到 Radiant 中。 + +生成所需预测后，可通过点击预测表右上角的下载图标将其保存为 CSV 文件。要将预测结果添加到用于估计的数据集，点击 “存储（Store）” 按钮。 + +注意，MNL 模型生成的概率列数与分类响应变量的水平数相同（即番茄酱数据中有 4 列）。如果只想将第一水平（即`heinz28`）的预测结果添加到用于估计的数据集，在 “存储预测（Store predictions）” 输入框中仅提供一个名称即可。如果想存储所有番茄酱产品的预测结果，输入四个变量名，用逗号分隔。 + +> 注意：在上述讨论中，我们忽略了内生性问题。例如，假设`price.heinz28`的变化源于`heinz28`质量的变化，质量变化会影响价格，也可能影响产品需求。除非我们以某种方式控制质量变化，否则价格变化的估计效应很可能不准确（即存在偏差）。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令或`gridExtra`进行自定义。详见下方示例和*数据 > 可视化*。 + +```r +plot(result, plots = "coef", custom = TRUE) + + labs(title = "Coefficient plot") +``` + +### R 函数 + +有关 Radiant 中用于估计多项逻辑回归模型的相关 R 函数概述，请参见*模型 > 多项式逻辑回归*。 + +`mnl`工具中使用的核心函数包括`nnet`包中的`multinom`和`car`包中的`linearHypothesis`。 diff --git a/radiant.model/inst/app/tools/help/nb.md b/radiant.model/inst/app/tools/help/nb.md new file mode 100644 index 0000000000000000000000000000000000000000..6905770a11905b2b19caa886f995efb1c27ac6a1 --- /dev/null +++ b/radiant.model/inst/app/tools/help/nb.md @@ -0,0 +1,15 @@ +> 估计朴素贝叶斯模型 + +要估计模型，请选择响应变量（Response variable）和一个或多个解释变量（Explanatory variables）。点击`Estimate`按钮或按`CTRL-enter`（在 Mac 上为`CMD-enter`）生成结果。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令对其进行自定义（例如，`plot(result) + labs(title = "变量重要性")`）。详情请参见*数据 > 可视化*。 + +### R 函数 + +有关 Radiant 中用于估计朴素贝叶斯分类模型的相关 R 函数概述，请参见*模型 > 朴素贝叶斯*。 + +`nb`工具中使用的来自`e1071`包的核心函数是`naiveBayes`。 diff --git a/radiant.model/inst/app/tools/help/nn.md b/radiant.model/inst/app/tools/help/nn.md new file mode 100644 index 0000000000000000000000000000000000000000..3f095b7287722e9a71030f5e29c9211acb471c5d --- /dev/null +++ b/radiant.model/inst/app/tools/help/nn.md @@ -0,0 +1,19 @@ +> 估计神经网络 + +要估计模型，请选择类型（即分类或回归）、响应变量以及一个或多个解释变量。点击`Estimate`按钮或按`CTRL-enter`（在 Mac 上为`CMD-enter`）生成结果。可通过更改`Size`（即隐藏层中的节点数）和调整`Decay`（衰减率）对模型进行 “调优”。`Decay`设置的值越高，对权重（平方和）大小的惩罚就越重。当`Decay`设为 0 时，模型具有最大的灵活性来准确拟合（训练）数据。然而，没有`Decay`的情况下，模型也更有可能过拟合。 + +确定`Size`和`Decay`最优值的最佳方法是使用交叉验证。在 Radiant 中，你可以使用`cv.nn`函数实现此目的。更多信息请参见文档。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建 “Olden” 图或 “Garson” 图，可使用`ggplot2`命令对其进行自定义（例如，`plot(result, plots = "garson", custom = TRUE) + labs(title = "Garson图")`）。详情请参见*数据 > 可视化*。 + +例如，要为网络图添加标题，可使用`title(main = "网络图")`。更多信息请参见R 图形文档。 + +### R 函数 + +有关 Radiant 中用于估计神经网络模型的相关 R 函数概述，请参见*模型 > 神经网络*。 + +`nn`工具中使用的来自`nnet`包的核心函数是`nnet`。 diff --git a/radiant.model/inst/app/tools/help/regress.Rmd b/radiant.model/inst/app/tools/help/regress.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..1ec4ec97b3a4ce435a18d456076ec8890916f69d --- /dev/null +++ b/radiant.model/inst/app/tools/help/regress.Rmd @@ -0,0 +1,373 @@ +> （线性）回归：社会科学实证研究的主力方法 + +下文讨论的所有示例文件均可从 “数据> 管理” 页面加载。点击`examples`单选按钮并按 “加载（Load）”。 + +### 功能说明 + +首先选择响应变量和一个或多个解释变量。如果模型中包含两个或多个解释变量，我们可能需要研究是否存在交互效应。当一个解释变量对响应变量的影响至少部分由另一个解释变量的水平决定时，交互效应就存在。例如，1 克拉与 2 克拉钻石的价格涨幅可能取决于钻石的净度等级。 + +在 “摘要（Summary）” 标签页中，我们可以通过在 “待检验变量（Variables to test）” 下拉菜单中选择变量，检验两个或多个变量是否共同对模型拟合有显著贡献。此功能对于检验因子（factor）类型变量的整体影响是否显著非常有用。 + +需要重新估计的额外输出： + +* 标准化（Standardize）：如果解释变量的测量尺度不同，系数可能难以比较。通过在估计前对响应变量和解释变量进行标准化，我们可以看出哪些变量的影响更大。Radiant 中对数据的标准化方法是将响应变量Y替换为(Y−mean(Y))/(2×sd(Y))，并将所有解释变量X替换为(X−mean(X))/(2×sd(X))。详见Gelman 2008的讨论。 +* 中心化（Center）：将响应变量Y替换为Y−mean(Y)，并将所有解释变量X替换为X−mean(X)。这在解释交互效应时可能有用。 +* 逐步回归（Stepwise）：一种数据挖掘方法，用于选择拟合效果最佳的模型。使用时需谨慎！ +* 稳健标准误（Robust standard errors）：选择 “稳健（robust）” 后，系数估计值与普通最小二乘（OLS）相同，但标准误会进行调整，以解决（轻微的）异方差性和非正态性问题。 + +无需重新估计的额外输出： + +* RMSE：均方根误差（Root Mean Squared Error）和残差标准差（Residual Standard Deviation） +* 平方和（Sum of Squares）：响应变量的总方差分解为回归解释的方差和未解释的方差（即误差） +* VIF：方差膨胀因子（Variance Inflation Factors）和 R 平方（Rsq），这些是解释变量间多重共线性的度量指标 +* 置信区间（Confidence intervals）：系数的置信区间 + +“预测（Predict）” 标签页允许计算回归模型的预测值。你可以选择基于数据集预测响应（即从 “预测输入（Prediction input）” 下拉菜单中选择`Data`）、基于命令预测（即从 “预测输入” 下拉菜单中选择`Command`），或结合两者（即从 “预测输入” 下拉菜单中选择`Data & Command`）。 + +如果选择`Command`，必须至少指定一个变量和值才能获得预测结果。如果未为模型中的每个变量指定值，则会使用均值或最频繁的水平。只能基于模型中的变量预测结果（例如，要预测 2 克拉钻石的`price`，`carat`必须是所选解释变量之一）。 + +* 要预测 1 克拉钻石的价格，输入`carat = 1`并按回车 +* 要预测从 0.5 到 1 克拉、步长为 0.05 的钻石价格，输入`carat = seq(.5, 1, .05)`并按回车 +* 要预测 1、2 或 3 克拉理想切工钻石的价格，输入`carat = 1:3, cut = "Ideal"`并按回车 + +生成所需预测后，可通过点击屏幕右上角的下载图标将其保存为 CSV 文件。要将预测结果添加到用于估计的数据集，点击 “存储（Store）” 按钮。 + +“绘图（Plot）” 标签页用于提供数据的基本可视化以及验证回归模型的诊断图。 + +### 示例 1：目录销售数据 + +我们获取了一家通过邮购目录销售男女服装的公司的数据（数据集`catalog`）。该公司维护着关于过往和当前客户价值及特征的数据库。客户价值定义为过去一年对客户的总销售额（美元）。数据是从公司数据库中随机抽取的 200 名客户，包含以下 4 个变量： + +- `Sales` = 家庭过去一年的总销售额（美元） +- `Income` = 家庭收入（千美元） +- `HH.size` = 家庭规模（人数） +- `Age` = 家庭户主年龄 + +该目录公司有意重新设计其客户关系管理（CRM）策略。我们将分步骤进行： + +1. 使用去年的销售总额估计回归模型。响应变量：200 个家庭的销售总额；解释变量：家庭收入（以千美元计）、家庭规模和家庭户主年龄。要获取该数据集，前往 “数据> 管理”，从 “加载数据类型（Load data of type）” 下拉菜单中选择`examples`，按 “加载” 按钮，然后选择`catalog`数据集。 +2. 解释每个估计系数。同时对模型整体进行统计评估。 +3. 哪些解释变量是客户价值的显著预测因子（使用 95% 置信水平）？ + +**答案：** + +选择上述相关变量，按 “估计模型（Estimate model）” 按钮或按`CTRL-enter`（Mac 上为`CMD-enter`）。“模型> 线性回归（OLS）” 的输出如下： + +

    + +F 检验的原假设和备择假设可表述为： + +- H0：所有回归系数均等于 0 +- Ha：至少有一个回归系数不等于 0 + +F 统计量表明，回归模型整体解释了`Sales`的显著方差。计算得到的 F 统计量为 32.33，p 值极小（< 0.001）。模型解释的销售方差比例为 33.1%（见 R 平方）。 + +我们可以通过在 “待检验变量（Variables to test）” 框中选择`income`、`HH.size`和`Age`，复现所有回归输出中报告的标准 F 检验。相关输出如下： + +Regression 1 - F-test + +注意，在本示例中，“模型 1（model 1）” 是不含解释变量的回归。正如预期，模型 1 的解释方差为 0。F 检验比较模型 1 和模型 2 的拟合优度，并根据两个模型估计系数数量的差异进行调整。使用的检验统计量如下。R22是模型 2 的解释方差，R12是模型 1 的解释方差。n等于数据中的行数，k2（k1）是模型 2（模型 1）中估计的系数数量。 + +$$ +\begin{eqnarray} + F & = & \frac{(R^2_2 - R^2_1)/(k_2 - k_1)}{(1 - R^2_2)/(n - k_2 - 1)} \\\\ + & = & \frac{(0.331 - 0)/(3 - 0)}{(1 - 0.331)/(200 - 3 - 1)} \\\\ + & = & 32.325 +\end{eqnarray} +$$ + +我们可以使用与 F 统计量 32.325 相关的 p 值评估原假设。也可以使用概率计算器计算临界 F 统计量。从下方输出可知，该值为 2.651。由于相关 p 值 <0.001，且计算的 F 统计量大于临界值（32.325> 2.651），我们拒绝所有系数均等于 0 的原假设。 + +

    + +回归系数的解释如下： + +- 在模型中其他变量保持不变的情况下，收入每增加 1000 美元，我们预期销售额平均增加 1.7754 美元。 +- 在模型中其他变量保持不变的情况下，家庭规模每增加 1 人，我们预期销售额平均增加 22.1218 美元。 +- 在模型中其他变量保持不变的情况下，家庭户主年龄每增加 1 岁，我们预期销售额平均增加 0.45 美元。 + +对于每个解释变量，可提出以下原假设和备择假设： + +- H0：解释变量 x 相关的系数等于 0 +- Ha：解释变量 x 相关的系数不等于 0 + +`Income`和`HH.size`的系数均显著（p 值 < 0.05），即我们可以拒绝这两个系数的 H0。`Age HH`的系数不显著（p 值 > 0.05），即我们无法拒绝`Age HH`的 H0。我们得出结论：家庭户主年龄的变化不会导致销售额的显著变化。 + +我们也可以使用 t 值评估系数的原假设和备择假设。由于`Income`和`HH.size`的计算 t 值**大于**临界 t 值，我们拒绝这两个效应的原假设。可通过 “基础（Basics）” 菜单中的概率计算器获取临界 t 值。对于自由度为 196 的 t 分布（见上文 “平方和（Sum of Squares）” 表中的 “误差（Errors）” 行），临界 t 值为 1.972。由于备择假设是 “双侧（two.sided）”，我们需在概率计算器中输入 0.025 和 0.975 作为上下概率界。 + +

    +
    + +### 示例 2：理想的回归数据 + +数据集`ideal`包含模拟数据，非常适合演示回归数据及残差的理想状态。该数据有 1000 个观测值，涉及 4 个变量。`y`是响应变量，`x1`、`x2`和`x3`是解释变量。下方图表可作为真实世界数据回归的基准。我们将使用 “模型> 线性回归（OLS）” 进行分析。首先，前往 “绘图（Plots）” 标签页，选择`y`作为响应变量，`x1`、`x2`和`x3`作为解释变量。 + +`y`、`x2`和`x3`大致呈正态分布，而`x1`大致呈均匀分布。没有异常值或严重偏态分布的迹象。 + +

    + +在相关性图中，响应变量与解释变量之间、解释变量彼此之间存在明显关联。注意，在实验中，关注的 x 变量应具有零相关性。但在历史数据中，这几乎不可能。图表下三角部分的散点图显示，变量之间的关系（近似）线性。 + +

    + +响应变量`y`与每个解释变量的散点图证实了相关性图的结论。拟合在散点图中的线足够灵活，可捕捉任何非线性关系。但这些线非常平直，表明线性模型可能适用。 + +

    + +六个残差图组成的面板看起来非常理想，这符合我们对模拟数据的预期。响应变量的真实值与回归预测值形成带随机散点的直线，即随着响应变量实际值的增加，模型预测值也增加。残差（即响应变量实际值与回归预测值的差异）无模式，随机分布在水平线周围。任何模式都表明模型对数据某些部分的预测效果优于（或差于）其他部分。如果残差与行顺序图中存在模式，我们可能需关注自相关性。残差仍均匀分布在水平轴附近。注意，自相关性主要是时间序列数据中需要关注的问题。Q-Q 图显示整齐的对角直线，表明残差呈正态分布。残差的直方图和密度图（绿色）与理论正态分布密度（蓝色线）的对比也证实了这一结论。 + +

    + +我们要讨论的最后一个诊断是残差与解释变量（或预测因子）的一组图表。没有迹象表明存在趋势或异方差性。这些图表中的任何模式都值得关注。也没有异常值（即远离主要数据点集群的点）。 + +

    + +由于诊断结果良好，我们可以从回归中得出推论。首先，模型整体显著：F 统计量的 p 值小于 0.05，因此我们拒绝回归中三个变量斜率均为零的原假设。其次，每个变量都具有统计显著性。例如，`x1`的 t 统计量 p 值小于 0.05，因此当`x2`和`x3`也在模型中时（即 “保持模型中其他变量不变”），我们拒绝`x1`斜率为零的原假设。 + +`x1`和`x3`的增加与`y`的增加相关，而`x2`的增加与`y`的减少相关。由于是模拟数据，系数的具体解释不太重要。但散点图中`x3`的增加似乎与`y`的减少相关，这一差异如何解释？提示：考虑相关性图。 + +

    +
    + +### 示例 3：线性回归还是对数 - 对数回归？ + +线性回归和对数 - 对数回归均常用于商业数据。在本示例中，我们将从数据和残差中寻找证据，判断哪种模型设定更适合现有数据。 + +数据集`diamonds`包含 3000 颗钻石的价格信息。“数据> 管理” 页面提供了更完整的数据和变量描述。选择`price`作为响应变量，`carat`和`clarity`作为解释变量。在查看回归参数估计前，前往 “绘图” 标签页查看数据和残差。下方是模型中变量的直方图。`Price`和`carat`似乎向右偏斜。注意，偏斜方向由 “尾部” 位置决定。 + +

    + +在相关性图中，响应变量与解释变量之间存在明显关联。`price`与`carat`的相关性非常高（即 0.93）。钻石的`carat`与`clarity`的相关性显著且为负。 + +

    + +响应变量`price`与解释变量的散点图不如示例 2 中的`ideal`数据整洁。拟合在散点图中的线足够灵活，可捕捉非线性关系。`carat`的线似乎有一定曲率，点围绕该线的分布并非随机。实际上，在价格和克拉数较高时，点似乎呈扇形展开。不同`clarity`水平下，`price`的变动似乎不大。即便有变动，钻石价格似乎也随净度增加而下降。这一令人惊讶的结果我们将在下文详细讨论。 + +

    + +六个残差图组成的面板表现欠佳。响应变量的真实值与回归预测值形成 S 形曲线。在实际值和预测值较高时，点围绕线的分布更分散，这与`price`对`carat`的散点图一致。残差（即实际数据与回归预测值的差异）呈现明显模式，并非随机分布在水平轴周围。残差与行顺序图非常平直，表明自相关性不是问题。最后，与示例 2 中的`ideal`数据不同，此处 Q-Q 图的点在右极端明显偏离直线，表明残差不呈正态分布。残差的直方图和密度图显示比正态分布更尖的形状，也证实了这一结论。 + +

    + +我们要讨论的最后一个诊断是残差与解释变量（或预测因子）的一组图表。在残差对克拉数的图中，残差从左到右呈扇形展开。`clarity`对残差的散点图显示，净度较低时存在强负值异常值，净度较高时存在强正值异常值。 + +

    + +由于诊断结果不佳，我们**不应**从该回归中得出推论。对数 - 对数设定可能更合适。可通过 “数据> 可视化” 标签页快速检查对数 - 对数模型的有效性。在 “散点（Scatter）” 图中选择`price`作为 Y 变量，`carat`作为 X 变量。勾选 “log X” 和 “log Y” 框，生成下方图表。对数价格与对数克拉数之间的关系接近线性，这正是我们所期望的！ + +

    + +我们将对`price`和`carat`均进行（自然）对数（ln）转换，重新运行分析，看对数 - 对数设定是否更适合现有数据。可在 “数据> 转换” 中完成此转换。选择变量`price`和`carat`。从 “转换类型（Transformation type）” 下拉菜单中选择 “转换（Transform）”，从 “应用函数（Apply function）” 下拉菜单中选择 “Ln（自然对数）”。确保点击 “存储（Store）” 按钮，将新变量添加到数据集。注意，不能对`clarity`应用对数转换，因为它是分类变量。 + +在 “模型> 线性回归（OLS）” 中，选择`price_ln`作为响应变量，`carat_ln`和`clarity`作为解释变量。在查看回归参数估计前，前往 “绘图” 标签页查看数据和残差。下方是模型中变量的直方图。注意，`price_ln`和`carat_ln`不再右偏，这是好迹象。 + +

    + +在相关性图中，响应变量与解释变量之间仍存在明显关联。`price_ln`与`carat_ln`的相关性极高（即 0.93）。钻石的`carat_ln`与`clarity`的相关性显著且为负。 + +

    + +响应变量`price_ln`与解释变量的散点图现在整洁得多。`price_ln`对`carat_ln`的散点图中的线（基本）平直。尽管点在线周围呈轻微块状分布，但散射基本随机。我们不再看到`price_ln`和`carat_ln`值较高时的扇形展开。不同`clarity`水平下，`price_ln`的变动似乎稍大。但钻石的`price_ln`仍随`clarity`增加而下降，这不符合预期。我们将在下文讨论这一结果。 + +

    + +六个残差图组成的面板比线性模型好得多。响应变量的真实值与回归预测值（几乎）形成直线。尽管在实际值和预测值较高及较低时，线可能仍略呈曲线。残差更接近围绕水平线的随机散射。残差与行顺序图仍非常平直，表明自相关性不是问题。最后，Q-Q 图显示整齐的对角直线，与示例 2 中的`ideal`数据相同，表明残差现在呈正态分布。残差的直方图和密度图也证实了这一结论。 + +

    + +我们要讨论的最后一个诊断是残差与解释变量（或预测因子）的一组图表。与线性模型相比，残差更接近围绕水平线的随机散射。尽管`carat_ln`值较低（较高）时，残差可能稍高（较低）。 + +

    + +由于诊断结果现在好得多，我们可以更有信心地从该回归中得出推论。回归结果见 “摘要” 标签页。注意，`clarity`变量有 7 个系数，而`carat_ln`只有 1 个。为什么？查看数据描述（“数据> 管理”）可知，净度是分类变量，水平从 IF（最差净度）到 I1（最佳净度）。在应用回归等数值分析工具前，分类变量必须转换为一组虚拟（或指示）变量。每个虚拟变量表示某颗钻石是否具有特定净度等级（=1）或不具有（=0）。有趣的是，要捕捉 8 级净度变量的所有信息，我们只需 7 个虚拟变量。注意，没有净度等级 I1 的虚拟变量，因为回归中实际上不需要它。当一颗钻石**不是**净度 SI2、SI1、VS2、VS1、VVS2、VVS1 或 IF 时，我们从数据中可知它一定是净度 I1。 + +F 统计量表明，回归模型整体解释了`price_ln`的显著方差。F 统计量非常大，p 值极小（< 0.001），因此我们可以拒绝所有回归系数均等于 0 的原假设。模型解释的`price_ln`方差比例为 96.6%。钻石价格似乎比钻石需求更容易预测。 + +F 检验的原假设和备择假设可表述为： +H0：所有回归系数均等于 0 +Ha：至少有一个回归系数不等于 0 + +回归系数的解释如下： + +- 在模型中其他变量保持不变的情况下，克拉数每增加 1%，我们预期钻石价格平均增加 1.809%。 +- 在模型中其他变量保持不变的情况下，与净度 I1 的钻石相比，我们预期净度 SI2 的钻石价格平均高 100×(exp (.444)-1) = 55.89%。 +- 在模型中其他变量保持不变的情况下，与净度 I1 的钻石相比，我们预期净度 SI1 的钻石价格平均高 100×(exp (.591)-1) = 80.58%。 +- 在模型中其他变量保持不变的情况下，与净度 I1 的钻石相比，我们预期净度 IF 的钻石价格平均高 100×(exp (1.080)-1) = 194.47%。 + +净度各等级的系数表明，`clarity`提高会增加钻石价格。那为什么净度与（对数）价格的散点图显示价格随净度增加而下降？差异在于，回归中我们可以确定一个变量（如净度）变化的影响，同时保持模型中其他变量不变（即克拉数）。较大、较重的钻石比较小的钻石更可能有瑕疵，因此查看散点图时，我们实际看到的不仅是净度提高对价格的影响，还有与净度呈负相关的克拉数的影响。在回归中，我们可以比较**相同大小**（即保持克拉数不变）的钻石在不同净度水平下对（对数）价格的影响。如果模型中没有（对数）克拉数，由于遗漏变量偏差，净度的估计效应可能不正确。实际上，从`price_ln`对`clarity`的回归中，我们会得出数据中净度最高的钻石（IF）比净度最低的钻石（I1）价格低 59.22% 的结论。显然这不是合理结论。 + +对于每个解释变量，可提出以下原假设和备择假设： +H0：解释变量 X 相关的系数等于 0 +Ha：解释变量 X 相关的系数不等于 0 + +该回归中的所有系数均高度显著。 + +

    + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令或`patchwork`进行自定义。详见下方示例和*数据 > 可视化*。 + +```r +result <- regress(diamonds, rvar = "price", evar = c("carat", "clarity", "cut", "color")) +summary(result) +plot(result, plots = "scatter", custom = TRUE) %>% + wrap_plots(plot_list, ncol = 2) + plot_annotation(title = "Scatter plots") +``` + +### 视频教程 + +将以下完整命令复制粘贴到 RStudio 控制台（即左下角窗口），按回车即可获取 Radiant 教程系列中线性回归模块使用的所有材料： + +
    usethis::use_course("https://www.dropbox.com/sh/s70cb6i0fin7qq4/AACje2BAivEKDx7WrLrPr5m9a?dl=1")
    + +回归的数据探索与前置检查（一） + +- 本视频展示如何使用 Radiant 在运行线性回归前探索和可视化数据 +- 主题列表： + - 查看数据 + - 可视化数据 + +回归结果解读与预测（二） + +- 本视频解释如何解读回归结果并从线性回归模型计算预测值 +- 主题列表： + - 解释系数（数值变量和分类变量） + - 解释 R 平方和调整后 R 平方 + - 解释 F 检验结果 + - 从回归模型进行预测 + +处理分类变量（三） + +- 本视频展示如何在线性回归模型中处理分类变量 +- 主题列表： + - 在 Radiant 中查看基准类别 + - 更改基准类别 + +向回归模型添加新变量（四） + +- 本视频演示如何检验添加新变量是否能得到解释力显著提高的更优模型 +- 主题列表： + - 在 Radiant 中设置添加新变量的假设检验 + - 解释 F 检验结果 + - 将此 F 检验与回归摘要中的默认 F 检验进行比较 + +线性回归验证（五） + +- 本视频演示如何验证线性回归模型 +- 主题列表： + - 线性性（散点图，与前置检查中的相同） + - 正态性检验（正态 Q-Q 图） + - 多重共线性（VIF） + - 异方差性 + +对数 - 对数回归（六） + +- 本视频演示何时及如何运行对数 - 对数回归 +- 主题列表： + - 使用自然对数函数转换偏态分布数据 + - 解释对数 - 对数回归中的系数 + +### 技术说明 + +#### 线性模型的系数解释 + +为说明回归模型中系数的解释，我们从以下方程开始： +$$ + S_t = a + b P_t + c D_t + \epsilon_t +$$ + +其中St是t时刻的单位销售量，Pt是t时刻的价格（美元），Dt是指示产品在某周是否有陈列的虚拟变量，ϵt是误差项。 + +对于价格等连续变量，在保持模型中其他变量不变的情况下，我们可通过对销售方程求关于P的偏导数，确定 1 美元变化的影响。 +$$ + \frac{ \partial S_t }{ \partial P_t } = b +$$ + +因此，b是价格每变化 1 美元对销售量的边际效应。由于D等虚拟变量不是连续的，我们不能使用微分，确定边际效应的方法略有不同。比较D=1和D=0时的销售水平，我们得到： + +$$ + a + b P_t + c \times 1 - a + b P_t + c \times 0 = c +$$ + +对于线性模型，c是产品有陈列时对销售量的边际效应。 + +#### 半对数模型的系数解释 + +为说明半对数回归模型中系数的解释，我们从以下方程开始： +$$ +ln S_t = a + b P_t + c D_t + \epsilon_t +$$ + +其中ln S_t是t时刻销售量的（自然）对数。对于价格等连续变量，在保持模型中其他变量不变的情况下，我们可通过对销售方程求关于P的偏导数，确定小幅度变化（如 100 美元产品变化 1 美元）的影响。对于方程左侧，我们可使用链式法则： + +$$ + \frac {\partial ln S_t}{\partial P_t} = \frac{1}{S_t} \frac{\partial S_t}{\partial P_t} +$$ + +通俗地说，变量自然对数的导数是该变量的倒数乘以该变量的导数。从上述线性模型的讨论中，我们知道： + +$$ + \frac{ \partial a + b P_t + c D_t}{ \partial P_t } = b +$$ + +结合这两个方程： + +$$ + \frac {1}{S_t} \frac{\partial S_t}{\partial P_t} = b \; \text{or} \; \frac {\Delta S_t}{S_t} \approx b +$$ + +因此，价格每变化 1 美元会导致销售量变化100×b%。注意，此近似仅适用于解释变量的小幅变化，且可能受使用的尺度影响（如价格以美分、美元或千美元计）。下文针对虚拟变量的方法更通用，也可应用于连续变量。 + +由于D等虚拟变量不是连续的，我们不能使用微分，再次比较D=1和D=0时的销售水平，得到StΔSt。为使左侧为St而非lnSt，我们对两边取指数，得到St=ea+bPt+cDt。当Dt从 0 变为 1 时，St的百分比变化为： +$$ + \begin{aligned} + \frac {\Delta S_t}{S_t} &\approx \frac{ e^{a + b P_t + c\times 1} - e^{a + b P_t + c \times 0} } {e^{a + b P_t + c \times 0} }\\ + &= \frac{ e^{a + b P_t} e^c - e^{a + b P_t} }{ e^{a + b P_t} }\\ + &= e^c - 1 + \end{aligned} +$$ + +对于半对数模型，100×(exp(c)−1)是产品有陈列时销售量的百分比变化。类似地，价格每增加 10 美元，在保持其他变量不变的情况下，我们预期销售量变化100×(exp(b×10)−1)。 + +#### 对数 - 对数模型的系数解释 + +为说明对数 - 对数回归模型中系数的解释，我们从以下方程开始： +$$ + ln S_t = a + b ln P_t + \epsilon_t +$$ + +其中lnPt是t时刻价格的（自然）对数。为简化，忽略误差项，我们可通过对两边取指数，将模型改写为乘法形式： + +$$ +\begin{aligned} + S_t &= e^a + e^{b ln P_t}\\ + S_t &= a^* P^b_t + \end{aligned} +$$ + +其中a∗=ea。对于价格等连续变量，我们可通过对销售方程求关于Pt的偏导数，得到边际效应： + +$$ + \begin{aligned} + \frac{\partial S_t}{\partial P_t} &= b a^* P^{b-1}_t\\ + &= b S_t P^{-1}_t\\ + &= b \frac{S_t}{P_t} + \end{aligned} +$$ + +弹性的一般公式是∂St/∂Pt*Pt/St。将此信息添加到上述方程中，我们看到对数 - 对数回归估计的系数b可直接解释为弹性： + +$$ + \frac{\partial S_t}{\partial P_t} \frac{P_t}{S_t} = b \frac{S_t}{P_t} \frac{P_t}{S_t} = b +$$ + +因此，价格每变化 1% 会导致销售量变化b%。 + +### R 函数 + +有关 Radiant 中用于估计线性回归模型的相关 R 函数概述，请参见*模型 > 线性回归（普通最小二乘法）*。 + +`regress`工具中使用的核心函数包括`stats`包中的`lm`，以及`car`包中的`vif`和`linearHypothesis`。 diff --git a/radiant.model/inst/app/tools/help/regress.md b/radiant.model/inst/app/tools/help/regress.md new file mode 100644 index 0000000000000000000000000000000000000000..1ec4ec97b3a4ce435a18d456076ec8890916f69d --- /dev/null +++ b/radiant.model/inst/app/tools/help/regress.md @@ -0,0 +1,373 @@ +> （线性）回归：社会科学实证研究的主力方法 + +下文讨论的所有示例文件均可从 “数据> 管理” 页面加载。点击`examples`单选按钮并按 “加载（Load）”。 + +### 功能说明 + +首先选择响应变量和一个或多个解释变量。如果模型中包含两个或多个解释变量，我们可能需要研究是否存在交互效应。当一个解释变量对响应变量的影响至少部分由另一个解释变量的水平决定时，交互效应就存在。例如，1 克拉与 2 克拉钻石的价格涨幅可能取决于钻石的净度等级。 + +在 “摘要（Summary）” 标签页中，我们可以通过在 “待检验变量（Variables to test）” 下拉菜单中选择变量，检验两个或多个变量是否共同对模型拟合有显著贡献。此功能对于检验因子（factor）类型变量的整体影响是否显著非常有用。 + +需要重新估计的额外输出： + +* 标准化（Standardize）：如果解释变量的测量尺度不同，系数可能难以比较。通过在估计前对响应变量和解释变量进行标准化，我们可以看出哪些变量的影响更大。Radiant 中对数据的标准化方法是将响应变量Y替换为(Y−mean(Y))/(2×sd(Y))，并将所有解释变量X替换为(X−mean(X))/(2×sd(X))。详见Gelman 2008的讨论。 +* 中心化（Center）：将响应变量Y替换为Y−mean(Y)，并将所有解释变量X替换为X−mean(X)。这在解释交互效应时可能有用。 +* 逐步回归（Stepwise）：一种数据挖掘方法，用于选择拟合效果最佳的模型。使用时需谨慎！ +* 稳健标准误（Robust standard errors）：选择 “稳健（robust）” 后，系数估计值与普通最小二乘（OLS）相同，但标准误会进行调整，以解决（轻微的）异方差性和非正态性问题。 + +无需重新估计的额外输出： + +* RMSE：均方根误差（Root Mean Squared Error）和残差标准差（Residual Standard Deviation） +* 平方和（Sum of Squares）：响应变量的总方差分解为回归解释的方差和未解释的方差（即误差） +* VIF：方差膨胀因子（Variance Inflation Factors）和 R 平方（Rsq），这些是解释变量间多重共线性的度量指标 +* 置信区间（Confidence intervals）：系数的置信区间 + +“预测（Predict）” 标签页允许计算回归模型的预测值。你可以选择基于数据集预测响应（即从 “预测输入（Prediction input）” 下拉菜单中选择`Data`）、基于命令预测（即从 “预测输入” 下拉菜单中选择`Command`），或结合两者（即从 “预测输入” 下拉菜单中选择`Data & Command`）。 + +如果选择`Command`，必须至少指定一个变量和值才能获得预测结果。如果未为模型中的每个变量指定值，则会使用均值或最频繁的水平。只能基于模型中的变量预测结果（例如，要预测 2 克拉钻石的`price`，`carat`必须是所选解释变量之一）。 + +* 要预测 1 克拉钻石的价格，输入`carat = 1`并按回车 +* 要预测从 0.5 到 1 克拉、步长为 0.05 的钻石价格，输入`carat = seq(.5, 1, .05)`并按回车 +* 要预测 1、2 或 3 克拉理想切工钻石的价格，输入`carat = 1:3, cut = "Ideal"`并按回车 + +生成所需预测后，可通过点击屏幕右上角的下载图标将其保存为 CSV 文件。要将预测结果添加到用于估计的数据集，点击 “存储（Store）” 按钮。 + +“绘图（Plot）” 标签页用于提供数据的基本可视化以及验证回归模型的诊断图。 + +### 示例 1：目录销售数据 + +我们获取了一家通过邮购目录销售男女服装的公司的数据（数据集`catalog`）。该公司维护着关于过往和当前客户价值及特征的数据库。客户价值定义为过去一年对客户的总销售额（美元）。数据是从公司数据库中随机抽取的 200 名客户，包含以下 4 个变量： + +- `Sales` = 家庭过去一年的总销售额（美元） +- `Income` = 家庭收入（千美元） +- `HH.size` = 家庭规模（人数） +- `Age` = 家庭户主年龄 + +该目录公司有意重新设计其客户关系管理（CRM）策略。我们将分步骤进行： + +1. 使用去年的销售总额估计回归模型。响应变量：200 个家庭的销售总额；解释变量：家庭收入（以千美元计）、家庭规模和家庭户主年龄。要获取该数据集，前往 “数据> 管理”，从 “加载数据类型（Load data of type）” 下拉菜单中选择`examples`，按 “加载” 按钮，然后选择`catalog`数据集。 +2. 解释每个估计系数。同时对模型整体进行统计评估。 +3. 哪些解释变量是客户价值的显著预测因子（使用 95% 置信水平）？ + +**答案：** + +选择上述相关变量，按 “估计模型（Estimate model）” 按钮或按`CTRL-enter`（Mac 上为`CMD-enter`）。“模型> 线性回归（OLS）” 的输出如下： + +

    + +F 检验的原假设和备择假设可表述为： + +- H0：所有回归系数均等于 0 +- Ha：至少有一个回归系数不等于 0 + +F 统计量表明，回归模型整体解释了`Sales`的显著方差。计算得到的 F 统计量为 32.33，p 值极小（< 0.001）。模型解释的销售方差比例为 33.1%（见 R 平方）。 + +我们可以通过在 “待检验变量（Variables to test）” 框中选择`income`、`HH.size`和`Age`，复现所有回归输出中报告的标准 F 检验。相关输出如下： + +Regression 1 - F-test + +注意，在本示例中，“模型 1（model 1）” 是不含解释变量的回归。正如预期，模型 1 的解释方差为 0。F 检验比较模型 1 和模型 2 的拟合优度，并根据两个模型估计系数数量的差异进行调整。使用的检验统计量如下。R22是模型 2 的解释方差，R12是模型 1 的解释方差。n等于数据中的行数，k2（k1）是模型 2（模型 1）中估计的系数数量。 + +$$ +\begin{eqnarray} + F & = & \frac{(R^2_2 - R^2_1)/(k_2 - k_1)}{(1 - R^2_2)/(n - k_2 - 1)} \\\\ + & = & \frac{(0.331 - 0)/(3 - 0)}{(1 - 0.331)/(200 - 3 - 1)} \\\\ + & = & 32.325 +\end{eqnarray} +$$ + +我们可以使用与 F 统计量 32.325 相关的 p 值评估原假设。也可以使用概率计算器计算临界 F 统计量。从下方输出可知，该值为 2.651。由于相关 p 值 <0.001，且计算的 F 统计量大于临界值（32.325> 2.651），我们拒绝所有系数均等于 0 的原假设。 + +

    + +回归系数的解释如下： + +- 在模型中其他变量保持不变的情况下，收入每增加 1000 美元，我们预期销售额平均增加 1.7754 美元。 +- 在模型中其他变量保持不变的情况下，家庭规模每增加 1 人，我们预期销售额平均增加 22.1218 美元。 +- 在模型中其他变量保持不变的情况下，家庭户主年龄每增加 1 岁，我们预期销售额平均增加 0.45 美元。 + +对于每个解释变量，可提出以下原假设和备择假设： + +- H0：解释变量 x 相关的系数等于 0 +- Ha：解释变量 x 相关的系数不等于 0 + +`Income`和`HH.size`的系数均显著（p 值 < 0.05），即我们可以拒绝这两个系数的 H0。`Age HH`的系数不显著（p 值 > 0.05），即我们无法拒绝`Age HH`的 H0。我们得出结论：家庭户主年龄的变化不会导致销售额的显著变化。 + +我们也可以使用 t 值评估系数的原假设和备择假设。由于`Income`和`HH.size`的计算 t 值**大于**临界 t 值，我们拒绝这两个效应的原假设。可通过 “基础（Basics）” 菜单中的概率计算器获取临界 t 值。对于自由度为 196 的 t 分布（见上文 “平方和（Sum of Squares）” 表中的 “误差（Errors）” 行），临界 t 值为 1.972。由于备择假设是 “双侧（two.sided）”，我们需在概率计算器中输入 0.025 和 0.975 作为上下概率界。 + +

    +
    + +### 示例 2：理想的回归数据 + +数据集`ideal`包含模拟数据，非常适合演示回归数据及残差的理想状态。该数据有 1000 个观测值，涉及 4 个变量。`y`是响应变量，`x1`、`x2`和`x3`是解释变量。下方图表可作为真实世界数据回归的基准。我们将使用 “模型> 线性回归（OLS）” 进行分析。首先，前往 “绘图（Plots）” 标签页，选择`y`作为响应变量，`x1`、`x2`和`x3`作为解释变量。 + +`y`、`x2`和`x3`大致呈正态分布，而`x1`大致呈均匀分布。没有异常值或严重偏态分布的迹象。 + +

    + +在相关性图中，响应变量与解释变量之间、解释变量彼此之间存在明显关联。注意，在实验中，关注的 x 变量应具有零相关性。但在历史数据中，这几乎不可能。图表下三角部分的散点图显示，变量之间的关系（近似）线性。 + +

    + +响应变量`y`与每个解释变量的散点图证实了相关性图的结论。拟合在散点图中的线足够灵活，可捕捉任何非线性关系。但这些线非常平直，表明线性模型可能适用。 + +

    + +六个残差图组成的面板看起来非常理想，这符合我们对模拟数据的预期。响应变量的真实值与回归预测值形成带随机散点的直线，即随着响应变量实际值的增加，模型预测值也增加。残差（即响应变量实际值与回归预测值的差异）无模式，随机分布在水平线周围。任何模式都表明模型对数据某些部分的预测效果优于（或差于）其他部分。如果残差与行顺序图中存在模式，我们可能需关注自相关性。残差仍均匀分布在水平轴附近。注意，自相关性主要是时间序列数据中需要关注的问题。Q-Q 图显示整齐的对角直线，表明残差呈正态分布。残差的直方图和密度图（绿色）与理论正态分布密度（蓝色线）的对比也证实了这一结论。 + +

    + +我们要讨论的最后一个诊断是残差与解释变量（或预测因子）的一组图表。没有迹象表明存在趋势或异方差性。这些图表中的任何模式都值得关注。也没有异常值（即远离主要数据点集群的点）。 + +

    + +由于诊断结果良好，我们可以从回归中得出推论。首先，模型整体显著：F 统计量的 p 值小于 0.05，因此我们拒绝回归中三个变量斜率均为零的原假设。其次，每个变量都具有统计显著性。例如，`x1`的 t 统计量 p 值小于 0.05，因此当`x2`和`x3`也在模型中时（即 “保持模型中其他变量不变”），我们拒绝`x1`斜率为零的原假设。 + +`x1`和`x3`的增加与`y`的增加相关，而`x2`的增加与`y`的减少相关。由于是模拟数据，系数的具体解释不太重要。但散点图中`x3`的增加似乎与`y`的减少相关，这一差异如何解释？提示：考虑相关性图。 + +

    +
    + +### 示例 3：线性回归还是对数 - 对数回归？ + +线性回归和对数 - 对数回归均常用于商业数据。在本示例中，我们将从数据和残差中寻找证据，判断哪种模型设定更适合现有数据。 + +数据集`diamonds`包含 3000 颗钻石的价格信息。“数据> 管理” 页面提供了更完整的数据和变量描述。选择`price`作为响应变量，`carat`和`clarity`作为解释变量。在查看回归参数估计前，前往 “绘图” 标签页查看数据和残差。下方是模型中变量的直方图。`Price`和`carat`似乎向右偏斜。注意，偏斜方向由 “尾部” 位置决定。 + +

    + +在相关性图中，响应变量与解释变量之间存在明显关联。`price`与`carat`的相关性非常高（即 0.93）。钻石的`carat`与`clarity`的相关性显著且为负。 + +

    + +响应变量`price`与解释变量的散点图不如示例 2 中的`ideal`数据整洁。拟合在散点图中的线足够灵活，可捕捉非线性关系。`carat`的线似乎有一定曲率，点围绕该线的分布并非随机。实际上，在价格和克拉数较高时，点似乎呈扇形展开。不同`clarity`水平下，`price`的变动似乎不大。即便有变动，钻石价格似乎也随净度增加而下降。这一令人惊讶的结果我们将在下文详细讨论。 + +

    + +六个残差图组成的面板表现欠佳。响应变量的真实值与回归预测值形成 S 形曲线。在实际值和预测值较高时，点围绕线的分布更分散，这与`price`对`carat`的散点图一致。残差（即实际数据与回归预测值的差异）呈现明显模式，并非随机分布在水平轴周围。残差与行顺序图非常平直，表明自相关性不是问题。最后，与示例 2 中的`ideal`数据不同，此处 Q-Q 图的点在右极端明显偏离直线，表明残差不呈正态分布。残差的直方图和密度图显示比正态分布更尖的形状，也证实了这一结论。 + +

    + +我们要讨论的最后一个诊断是残差与解释变量（或预测因子）的一组图表。在残差对克拉数的图中，残差从左到右呈扇形展开。`clarity`对残差的散点图显示，净度较低时存在强负值异常值，净度较高时存在强正值异常值。 + +

    + +由于诊断结果不佳，我们**不应**从该回归中得出推论。对数 - 对数设定可能更合适。可通过 “数据> 可视化” 标签页快速检查对数 - 对数模型的有效性。在 “散点（Scatter）” 图中选择`price`作为 Y 变量，`carat`作为 X 变量。勾选 “log X” 和 “log Y” 框，生成下方图表。对数价格与对数克拉数之间的关系接近线性，这正是我们所期望的！ + +

    + +我们将对`price`和`carat`均进行（自然）对数（ln）转换，重新运行分析，看对数 - 对数设定是否更适合现有数据。可在 “数据> 转换” 中完成此转换。选择变量`price`和`carat`。从 “转换类型（Transformation type）” 下拉菜单中选择 “转换（Transform）”，从 “应用函数（Apply function）” 下拉菜单中选择 “Ln（自然对数）”。确保点击 “存储（Store）” 按钮，将新变量添加到数据集。注意，不能对`clarity`应用对数转换，因为它是分类变量。 + +在 “模型> 线性回归（OLS）” 中，选择`price_ln`作为响应变量，`carat_ln`和`clarity`作为解释变量。在查看回归参数估计前，前往 “绘图” 标签页查看数据和残差。下方是模型中变量的直方图。注意，`price_ln`和`carat_ln`不再右偏，这是好迹象。 + +

    + +在相关性图中，响应变量与解释变量之间仍存在明显关联。`price_ln`与`carat_ln`的相关性极高（即 0.93）。钻石的`carat_ln`与`clarity`的相关性显著且为负。 + +

    + +响应变量`price_ln`与解释变量的散点图现在整洁得多。`price_ln`对`carat_ln`的散点图中的线（基本）平直。尽管点在线周围呈轻微块状分布，但散射基本随机。我们不再看到`price_ln`和`carat_ln`值较高时的扇形展开。不同`clarity`水平下，`price_ln`的变动似乎稍大。但钻石的`price_ln`仍随`clarity`增加而下降，这不符合预期。我们将在下文讨论这一结果。 + +

    + +六个残差图组成的面板比线性模型好得多。响应变量的真实值与回归预测值（几乎）形成直线。尽管在实际值和预测值较高及较低时，线可能仍略呈曲线。残差更接近围绕水平线的随机散射。残差与行顺序图仍非常平直，表明自相关性不是问题。最后，Q-Q 图显示整齐的对角直线，与示例 2 中的`ideal`数据相同，表明残差现在呈正态分布。残差的直方图和密度图也证实了这一结论。 + +

    + +我们要讨论的最后一个诊断是残差与解释变量（或预测因子）的一组图表。与线性模型相比，残差更接近围绕水平线的随机散射。尽管`carat_ln`值较低（较高）时，残差可能稍高（较低）。 + +

    + +由于诊断结果现在好得多，我们可以更有信心地从该回归中得出推论。回归结果见 “摘要” 标签页。注意，`clarity`变量有 7 个系数，而`carat_ln`只有 1 个。为什么？查看数据描述（“数据> 管理”）可知，净度是分类变量，水平从 IF（最差净度）到 I1（最佳净度）。在应用回归等数值分析工具前，分类变量必须转换为一组虚拟（或指示）变量。每个虚拟变量表示某颗钻石是否具有特定净度等级（=1）或不具有（=0）。有趣的是，要捕捉 8 级净度变量的所有信息，我们只需 7 个虚拟变量。注意，没有净度等级 I1 的虚拟变量，因为回归中实际上不需要它。当一颗钻石**不是**净度 SI2、SI1、VS2、VS1、VVS2、VVS1 或 IF 时，我们从数据中可知它一定是净度 I1。 + +F 统计量表明，回归模型整体解释了`price_ln`的显著方差。F 统计量非常大，p 值极小（< 0.001），因此我们可以拒绝所有回归系数均等于 0 的原假设。模型解释的`price_ln`方差比例为 96.6%。钻石价格似乎比钻石需求更容易预测。 + +F 检验的原假设和备择假设可表述为： +H0：所有回归系数均等于 0 +Ha：至少有一个回归系数不等于 0 + +回归系数的解释如下： + +- 在模型中其他变量保持不变的情况下，克拉数每增加 1%，我们预期钻石价格平均增加 1.809%。 +- 在模型中其他变量保持不变的情况下，与净度 I1 的钻石相比，我们预期净度 SI2 的钻石价格平均高 100×(exp (.444)-1) = 55.89%。 +- 在模型中其他变量保持不变的情况下，与净度 I1 的钻石相比，我们预期净度 SI1 的钻石价格平均高 100×(exp (.591)-1) = 80.58%。 +- 在模型中其他变量保持不变的情况下，与净度 I1 的钻石相比，我们预期净度 IF 的钻石价格平均高 100×(exp (1.080)-1) = 194.47%。 + +净度各等级的系数表明，`clarity`提高会增加钻石价格。那为什么净度与（对数）价格的散点图显示价格随净度增加而下降？差异在于，回归中我们可以确定一个变量（如净度）变化的影响，同时保持模型中其他变量不变（即克拉数）。较大、较重的钻石比较小的钻石更可能有瑕疵，因此查看散点图时，我们实际看到的不仅是净度提高对价格的影响，还有与净度呈负相关的克拉数的影响。在回归中，我们可以比较**相同大小**（即保持克拉数不变）的钻石在不同净度水平下对（对数）价格的影响。如果模型中没有（对数）克拉数，由于遗漏变量偏差，净度的估计效应可能不正确。实际上，从`price_ln`对`clarity`的回归中，我们会得出数据中净度最高的钻石（IF）比净度最低的钻石（I1）价格低 59.22% 的结论。显然这不是合理结论。 + +对于每个解释变量，可提出以下原假设和备择假设： +H0：解释变量 X 相关的系数等于 0 +Ha：解释变量 X 相关的系数不等于 0 + +该回归中的所有系数均高度显著。 + +

    + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令或`patchwork`进行自定义。详见下方示例和*数据 > 可视化*。 + +```r +result <- regress(diamonds, rvar = "price", evar = c("carat", "clarity", "cut", "color")) +summary(result) +plot(result, plots = "scatter", custom = TRUE) %>% + wrap_plots(plot_list, ncol = 2) + plot_annotation(title = "Scatter plots") +``` + +### 视频教程 + +将以下完整命令复制粘贴到 RStudio 控制台（即左下角窗口），按回车即可获取 Radiant 教程系列中线性回归模块使用的所有材料： + +
    usethis::use_course("https://www.dropbox.com/sh/s70cb6i0fin7qq4/AACje2BAivEKDx7WrLrPr5m9a?dl=1")
    + +回归的数据探索与前置检查（一） + +- 本视频展示如何使用 Radiant 在运行线性回归前探索和可视化数据 +- 主题列表： + - 查看数据 + - 可视化数据 + +回归结果解读与预测（二） + +- 本视频解释如何解读回归结果并从线性回归模型计算预测值 +- 主题列表： + - 解释系数（数值变量和分类变量） + - 解释 R 平方和调整后 R 平方 + - 解释 F 检验结果 + - 从回归模型进行预测 + +处理分类变量（三） + +- 本视频展示如何在线性回归模型中处理分类变量 +- 主题列表： + - 在 Radiant 中查看基准类别 + - 更改基准类别 + +向回归模型添加新变量（四） + +- 本视频演示如何检验添加新变量是否能得到解释力显著提高的更优模型 +- 主题列表： + - 在 Radiant 中设置添加新变量的假设检验 + - 解释 F 检验结果 + - 将此 F 检验与回归摘要中的默认 F 检验进行比较 + +线性回归验证（五） + +- 本视频演示如何验证线性回归模型 +- 主题列表： + - 线性性（散点图，与前置检查中的相同） + - 正态性检验（正态 Q-Q 图） + - 多重共线性（VIF） + - 异方差性 + +对数 - 对数回归（六） + +- 本视频演示何时及如何运行对数 - 对数回归 +- 主题列表： + - 使用自然对数函数转换偏态分布数据 + - 解释对数 - 对数回归中的系数 + +### 技术说明 + +#### 线性模型的系数解释 + +为说明回归模型中系数的解释，我们从以下方程开始： +$$ + S_t = a + b P_t + c D_t + \epsilon_t +$$ + +其中St是t时刻的单位销售量，Pt是t时刻的价格（美元），Dt是指示产品在某周是否有陈列的虚拟变量，ϵt是误差项。 + +对于价格等连续变量，在保持模型中其他变量不变的情况下，我们可通过对销售方程求关于P的偏导数，确定 1 美元变化的影响。 +$$ + \frac{ \partial S_t }{ \partial P_t } = b +$$ + +因此，b是价格每变化 1 美元对销售量的边际效应。由于D等虚拟变量不是连续的，我们不能使用微分，确定边际效应的方法略有不同。比较D=1和D=0时的销售水平，我们得到： + +$$ + a + b P_t + c \times 1 - a + b P_t + c \times 0 = c +$$ + +对于线性模型，c是产品有陈列时对销售量的边际效应。 + +#### 半对数模型的系数解释 + +为说明半对数回归模型中系数的解释，我们从以下方程开始： +$$ +ln S_t = a + b P_t + c D_t + \epsilon_t +$$ + +其中ln S_t是t时刻销售量的（自然）对数。对于价格等连续变量，在保持模型中其他变量不变的情况下，我们可通过对销售方程求关于P的偏导数，确定小幅度变化（如 100 美元产品变化 1 美元）的影响。对于方程左侧，我们可使用链式法则： + +$$ + \frac {\partial ln S_t}{\partial P_t} = \frac{1}{S_t} \frac{\partial S_t}{\partial P_t} +$$ + +通俗地说，变量自然对数的导数是该变量的倒数乘以该变量的导数。从上述线性模型的讨论中，我们知道： + +$$ + \frac{ \partial a + b P_t + c D_t}{ \partial P_t } = b +$$ + +结合这两个方程： + +$$ + \frac {1}{S_t} \frac{\partial S_t}{\partial P_t} = b \; \text{or} \; \frac {\Delta S_t}{S_t} \approx b +$$ + +因此，价格每变化 1 美元会导致销售量变化100×b%。注意，此近似仅适用于解释变量的小幅变化，且可能受使用的尺度影响（如价格以美分、美元或千美元计）。下文针对虚拟变量的方法更通用，也可应用于连续变量。 + +由于D等虚拟变量不是连续的，我们不能使用微分，再次比较D=1和D=0时的销售水平，得到StΔSt。为使左侧为St而非lnSt，我们对两边取指数，得到St=ea+bPt+cDt。当Dt从 0 变为 1 时，St的百分比变化为： +$$ + \begin{aligned} + \frac {\Delta S_t}{S_t} &\approx \frac{ e^{a + b P_t + c\times 1} - e^{a + b P_t + c \times 0} } {e^{a + b P_t + c \times 0} }\\ + &= \frac{ e^{a + b P_t} e^c - e^{a + b P_t} }{ e^{a + b P_t} }\\ + &= e^c - 1 + \end{aligned} +$$ + +对于半对数模型，100×(exp(c)−1)是产品有陈列时销售量的百分比变化。类似地，价格每增加 10 美元，在保持其他变量不变的情况下，我们预期销售量变化100×(exp(b×10)−1)。 + +#### 对数 - 对数模型的系数解释 + +为说明对数 - 对数回归模型中系数的解释，我们从以下方程开始： +$$ + ln S_t = a + b ln P_t + \epsilon_t +$$ + +其中lnPt是t时刻价格的（自然）对数。为简化，忽略误差项，我们可通过对两边取指数，将模型改写为乘法形式： + +$$ +\begin{aligned} + S_t &= e^a + e^{b ln P_t}\\ + S_t &= a^* P^b_t + \end{aligned} +$$ + +其中a∗=ea。对于价格等连续变量，我们可通过对销售方程求关于Pt的偏导数，得到边际效应： + +$$ + \begin{aligned} + \frac{\partial S_t}{\partial P_t} &= b a^* P^{b-1}_t\\ + &= b S_t P^{-1}_t\\ + &= b \frac{S_t}{P_t} + \end{aligned} +$$ + +弹性的一般公式是∂St/∂Pt*Pt/St。将此信息添加到上述方程中，我们看到对数 - 对数回归估计的系数b可直接解释为弹性： + +$$ + \frac{\partial S_t}{\partial P_t} \frac{P_t}{S_t} = b \frac{S_t}{P_t} \frac{P_t}{S_t} = b +$$ + +因此，价格每变化 1% 会导致销售量变化b%。 + +### R 函数 + +有关 Radiant 中用于估计线性回归模型的相关 R 函数概述，请参见*模型 > 线性回归（普通最小二乘法）*。 + +`regress`工具中使用的核心函数包括`stats`包中的`lm`，以及`car`包中的`vif`和`linearHypothesis`。 diff --git a/radiant.model/inst/app/tools/help/rforest.md b/radiant.model/inst/app/tools/help/rforest.md new file mode 100644 index 0000000000000000000000000000000000000000..ec2bcba87a09e41c9f6c8bd19511e0ed214af53f --- /dev/null +++ b/radiant.model/inst/app/tools/help/rforest.md @@ -0,0 +1,15 @@ +> 估计随机森林 + +要创建随机森林，首先选择类型（即分类或回归）、响应变量以及一个或多个解释变量。点击`Estimate model`按钮或按`CTRL-enter`（在 Mac 上为`CMD-enter`）生成结果。 + +可通过更改`mtry`、`# trees`、`Min node size`和`Sample fraction`输入对模型进行 “调优”。确定这些超参数最优值的最佳方法是使用交叉验证。在 Radiant 中，你可以使用`cv.rforest`函数实现此目的。更多信息请参见文档。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +### R 函数 + +有关 Radiant 中用于估计神经网络模型的相关 R 函数概述，请参见*模型 > 神经网络*。 + +`rforest`工具中使用的来自`ranger`包的核心函数是`ranger`。 diff --git a/radiant.model/inst/app/tools/help/simulater.Rmd b/radiant.model/inst/app/tools/help/simulater.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..f36402d9e16b5e2f3be186381a3c209e80b1d4fd --- /dev/null +++ b/radiant.model/inst/app/tools/help/simulater.Rmd @@ -0,0 +1,361 @@ +> 用于决策分析的模拟 + + + +首先，从 “模拟（Simulate）” 标签页的 “选择类型（Select types）” 下拉菜单中选择模拟中使用的变量类型。可用类型包括二项分布（Binomial）、常数（Constant）、离散分布（Discrete）、对数正态分布（Log normal）、正态分布（Normal）、均匀分布（Uniform）、数据（Data）、网格搜索（Grid search）和序列（Sequence）。 + +### 二项分布（Binomial） + +使用 “二项分布变量（Binomial variables）” 输入框添加二项分布随机变量。首先指定名称（`crash`）、试验次数（n）（例如 20）和成功概率（p）（0.01），然后点击图标。或者，直接在文本输入区域输入（或删除）内容（例如`crash 20 .01`）。 + +### 常数（Constant） + +在 “常数变量（Constant variables）” 输入框中列出分析中要包含的常数。你可以直接在文本区域输入名称和值（例如`cost 3`），或者分别在 “名称（Name）” 和 “值（Value）” 输入框中输入名称（`cost`）和值（5），然后点击图标。点击图标可删除条目。注意，只有（较大的）文本输入框中列出的变量才会包含在模拟中。 + +### 离散分布（Discrete） + +使用 “离散分布变量（Discrete variables）” 输入框定义离散分布随机变量。首先指定名称（`price`）、取值（6 8）及其相关概率（.3 .7），然后点击图标。或者，直接在文本输入区域输入（或删除）内容（例如`price 6 8 .3 .7`）。注意，概率之和必须为 1，否则会显示错误信息，模拟无法运行。 + +### 对数正态分布（Log Normal） + +要在分析中包含对数正态分布随机变量，从 “选择类型（Select types）” 下拉菜单中选择 “对数正态分布（Log Normal）”，并使用 “对数正态分布变量（Log-normal variables）” 输入框。更多信息见下文 “正态分布（Normal）” 部分。 + +### 正态分布（Normal） + +要在分析中包含正态分布随机变量，从 “选择类型（Select types）” 下拉菜单中选择 “正态分布（Normal）”，并使用 “正态分布变量（Normal variables）” 输入框。例如，输入名称（`demand`）、均值（Mean）（1000）和标准差（St.dev.）（100），然后点击图标。或者，直接在文本输入区域输入（或删除）内容（例如`demand 1000 100`）。 + +### 泊松分布（Poisson） + +泊松分布适用于模拟特定时间范围内事件发生的次数，例如晚上 10 点到 11 点急诊室的就诊人数。要在分析中包含泊松分布随机变量，从 “选择类型（Select types）” 下拉菜单中选择 “泊松分布（Poisson）”，并使用 “泊松分布变量（Poisson variables）” 输入框。例如，输入名称（`patients`）和事件发生次数的参数 “Lambda” 值（20），然后点击图标。或者，直接在文本输入区域输入（或删除）内容（例如`patients 20`）。 + +### 均匀分布（Uniform） + +要在分析中包含均匀分布随机变量，从 “选择类型（Select types）” 下拉菜单中选择 “均匀分布（Uniform）”，在 “均匀分布变量（Uniform variables）” 输入框中提供参数。例如，输入名称（`cost`）、最小值（Min）（10）和最大值（Max）（15），然后点击图标。或者，直接在文本输入区域输入（或删除）内容（例如`cost 10 15`）。 + +### 数据（Data） + +要在 “模拟公式（Simulation formulas）” 输入框指定的计算中包含来自其他数据集的变量，从 “计算输入数据（Input data for calculations）” 下拉菜单中选择数据集。这与 “网格搜索（Grid search）” 功能结合使用时，对投资组合优化非常有用。但与其他输入结合使用时，必须确保不同计算返回的值数量相同，否则会出现如下错误： + +`Error: arguments imply differing number of rows: 999, 3000` + +### 网格搜索（Grid search） + +要包含值序列，从 “选择类型（Select types）” 下拉菜单中选择 “网格搜索（Grid search）”，在 “网格搜索（Grid search）” 输入框中提供最小值、最大值和步长。例如，输入名称（`price`）、最小值（Min）（4）、最大值（Max）（10）和步长（Step）（0.01）。如果在 “网格搜索（Grid search）” 中指定多个变量，模拟会生成并评估所有可能的取值组合。例如，假设在 “网格搜索（Grid search）” 文本输入框中定义第一个变量为`x 1 3 1`，第二个为`y 4 5 1`，则会生成以下数据： + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    x y
    1 4
    2 4
    3 4
    1 5
    2 5
    3 5
    + +注意，如果选择了 “网格搜索（Grid search）”，生成的值数量将覆盖 “模拟次数（# sims）” 或 “重复次数（# reps）” 中指定的数量。如果不希望如此，请使用 “序列（Sequence）”。然后点击图标。或者，直接在文本输入区域输入（或删除）内容（例如`price 4 10 0.01`）。 + +### 序列（Sequence） + +要包含值序列，从 “选择类型（Select types）” 下拉菜单中选择 “序列（Sequence）”，在 “序列变量（Sequence variables）” 输入框中提供最小值和最大值。例如，输入名称（`trend`）、最小值（Min）（1）和最大值（Max）（1000）。注意，“步数” 由模拟次数决定。然后点击图标。或者，直接在文本输入区域输入（或删除）内容（例如`trend 1 1000`）。 + +### 公式（Formulas） + +要使用生成的变量执行计算，在主面板的 “模拟公式（Simulation formulas）” 输入框中创建公式（例如`profit = demand * (price - cost)`）。公式用于向模拟添加（计算得到的）变量或更新现有变量。必须在`=`左侧指定新变量的名称。变量名称可包含字母、数字和`_`，但不能包含其他字符或空格。可以输入多个公式。例如，如果还想计算每次模拟的边际利润，在第一个公式后按回车，输入`margin = price - cost`。 + +“数据> 转换” 标签页中 “创建（Create）” 功能和 “数据 > 查看” 标签页中 “筛选数据（Filter data）” 功能使用的许多函数也可包含在公式中。可以使用`>`和`<`符号并组合它们。例如，`x > 3 & y == 2`在变量`x`的值大于 3**且**变量`y`的值等于 2 时，结果为`TRUE`。注意，在 R 和大多数其他编程语言中，`=`用于**赋值**，`==`用于判断变量值是否**恰好等于**某个值。相反，`!=`用于判断变量值**不等于**某个值。也可以使用包含**或（OR）** 条件的表达式。例如，要判断 “Salary” 小于 100,000 美元**或**大于 20,000 美元，使用`Salary > 20000 | Salary < 100000`。`|`是**或（OR）** 的符号，`&`是**且（AND）** 的符号（另见 “数据> 查看” 的帮助文件）。 + +下面展示几个公式示例： + +- 创建新变量 z，为变量 x 和 y 的差值 + +```r +z = x - y +``` + +- 创建新的逻辑变量 z，当 x > y 时取值为 TRUE，否则为 FALSE + +```r +z = x > y +``` + +- 创建新的逻辑变量 z，当 x 等于 y 时取值为 TRUE，否则为 FALSE + +```r +z = x == y +``` + +- 上面的命令与下面使用`ifelse`的命令等效。注意与 Excel 中的`if`语句类似 + +```r +z = ifelse(x < y, TRUE, FALSE) +``` + +- `ifelse`语句也可用于创建更复杂的（数值）变量。在下面的示例中，如果 x 小于 60，z 取值为 0；如果 x 大于 100，z 取值为 1；最后，当 x 为 60、100 或介于 60 到 100 之间时，z 取值为 2。**注意：** 确保包含适当数量的左括号`(`和右括号`)`！ + +```r +z = ifelse(x < 60, 0, ifelse(x > 100, 1, 2)) +``` + +- 创建新变量 z，为变量 x 的转换，且均值为 0： + +```r +z = x - mean(x) +``` + +- 创建新变量 z，为 x 的绝对值： + +```r +z = abs(x) +``` + +- 要找到使`profit`最大化的`price`值，使用`find_max`命令。在本示例中，`price`可以是随机变量或 “序列变量（Sequence variable）”。还有`find_min`命令。 + +```r +optimal_price = find_max(profit, price) +``` + +- 要确定多个变量（例如 x 和 y）中每对值的最小值（最大值），使用函数`pmin`和`pmax`。在下面的示例中，当 x 大于 y 时，z 取值为 x；否则，z 取值为 y。 + +```r +z = pmax(x, y) +``` + +示例见下表： + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    x y pmax(x,y)
    1 0 1
    2 3 3
    3 8 8
    4 2 4
    5 10 10
    +- 与`pmin`和`pmax`类似，有一些函数可用于计算多个变量的汇总统计量。例如，`psum`计算不同向量元素的总和。更多信息见https://radiant-rstats.github.io/radiant.data/reference/pfun.html。 + +```r +z = psum(x, y) +``` + +示例见下表： + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    x y psum(x,y)
    1 0 1
    2 3 5
    3 8 11
    4 2 6
    5 10 15
    + + +其他常用函数包括`ln`（自然对数，例如`ln(x)`）、`sqrt`（x 的平方根，例如`sqrt(x)`）和`square`（计算变量的平方，例如`square(x)`）。 + +要从计算中返回单个值，使用`min`、`max`、`mean`、`sd`等函数。 + +- 投资组合优化中一个有用的特殊函数是`sdw`。它接受权重和变量作为输入，返回变量加权和的标准差。例如，要计算三只股票（如波音、通用汽车和埃克森美孚）投资组合的标准差，可在 “模拟公式（Simulation formulas）” 输入框中使用以下方程。`f`和`g`可以是值（例如 0.2 和 0.8），或通过 “网格搜索（Grid search）” 输入框指定的不同权重向量（见上文）。`Boeing`、`GM`和`Exxon`是使用 “数据（Data）” 输入框（见上文）包含在模拟中的数据集中的变量名称。 + +```r +Pstdev = sdw(f, g, 1-f-g, Boeing, GM, Exxon) +``` + +关于如何使用模拟工具进行投资组合优化的示例，见可下载的状态文件此处。 + +### 函数（Functions） + +可能 R 中可用的标准函数不足以灵活地进行你想要的模拟。如果是这种情况，点击屏幕左下角的 “添加函数（Add functions）” 复选框，在主面板的 “模拟函数（Simulation functions）” 输入框中创建自定义函数。要学习编写 R 函数，https://www.statmethods.net/management/userfunctions.html是一个很好的起点。 + +关于如何在赌博模拟中使用自定义 R 函数的示例，见可下载的状态文件此处。通过 “报告> Rmd” 生成的报告提供了关于模拟设置和函数使用的更多信息。 + +### 运行模拟 + +“模拟次数（# sims）” 输入框中显示的值决定模拟**抽取**的次数。要使用相同的随机生成值重新进行模拟，在 “设置随机种子（Set random seed）” 输入框中指定一个数字（例如 1234）。 + +要保存模拟数据供进一步分析，在 “模拟数据（Simulated data）” 输入框中指定名称。然后，可在任何 “数据” 标签页（例如 “数据 > 查看”、“数据 > 可视化” 或 “数据 > 探索”）的 “数据集（Datasets）” 下拉菜单中选择指定名称的数据集，以研究模拟数据。 + +指定所有必要输入后，点击 “模拟（Simulate）” 按钮运行模拟。 + +在下方截图中，`var_cost`和`fixed_cost`被指定为常数。`E`服从均值为 0、标准差为 100 的正态分布。`price`是离散随机变量，取值为 6 美元（概率 30%）或 8 美元（概率 70%）。“模拟公式（Simulation formulas）” 文本输入框中有三个公式。第一个公式确定 “需求（demand）” 对模拟变量 “价格（price）” 的依赖关系；第二个公式指定利润函数；最后一个公式用于确定利润低于 100 的案例数量（和比例），结果赋值给新变量`profit_small`。 + +

    + +在 “模拟摘要（Simulation summary）” 的输出中，首先看到模拟规格的详细信息（例如模拟次数）。“常数（Constants）” 部分列出各模拟中不变的变量值。“随机变量（Random variables）” 和 “逻辑变量（Logicals）” 部分列出模拟结果。我们看到模拟中的平均 “需求（demand）” 为 627.94，标准差为 109.32。还提供了模拟数据的其他特征（例如最大利润为 1758.77）。最后，我们看到利润低于 100 的概率为 0.32（即 1000 次模拟中，有 315 次利润低于 100 美元）。 + +要查看随机变量以及使用 “模拟公式（Simulation formulas）” 创建的变量的直方图，请确保勾选 “显示图表（Show plots）”。 + +

    + +由于我们在 “模拟数据（Simulated data）” 框中指定了名称，数据在 Radiant 中以`simdat`为名可用（见下方截图）。要在 Excel 中使用该数据，点击 “数据> 查看” 标签页右上角的下载图标，或前往 “数据 > 管理” 标签页将数据保存为 csv 文件（或使用剪贴板功能）。更多信息见 “数据 > 管理” 标签页的帮助文件。 + +

    + +## 重复模拟 + +假设上述模拟用于更好地理解每日利润。要深入了解年度利润，我们可以重新运行模拟 365 次。但通过 “重复（Repeat）” 标签页的功能可以更方便地实现。首先，在 “要重新模拟的变量（Variables to re-simulate）” 中选择变量，此处为`E`和`price`。然后在 “输出变量（Output variables）” 框中选择关注的变量（例如`profit`）。将 “重复次数（# reps）” 设置为 365。 + +接下来，需要确定如何汇总数据。如果在 “分组依据（Group by）” 中选择 “模拟（Simulation）”，数据将按每次模拟抽取**在**365 次重复模拟中汇总，得到 1000 个值。如果选择 “重复（Repeat）”，数据将按每次重复**在**1000 次模拟中汇总，得到 365 个值。如果将完整的重复模拟数据集想象为 1000 行 365 列的表格，按 “模拟（Simulation）” 分组将为每行创建汇总统计量，按 “重复（Repeat）” 分组将为每列创建汇总统计量。在本示例中，要确定 365 次重复模拟的每日利润总和，在 “分组依据（Group by）” 框中选择 “模拟（Simulation）”，在 “应用函数（Apply function）” 框中选择 “sum”。 + +要确定年度利润低于 36,500 美元的概率，在 “重复模拟公式（Repeated simulation formula）” 文本输入框中输入以下公式： + +```r +profit_365 = profit_sum < 36500 +``` + +注意，`profit_sum`是 “模拟（Simulation）” 标签页中定义的`profit`变量的重复模拟总和。输入所有值后，点击 “重复（Repeat）” 按钮。由于我们为 “重复数据（Repeat data）” 指定了名称，将创建新数据集。`repdat`将包含按模拟分组的汇总数据（即 1000 行）。要存储所有 365×1000 次模拟 / 重复结果，从 “应用函数（Apply function）” 下拉菜单中选择 “none”。 + +重复模拟的描述性统计量显示在主面板的 “重复模拟摘要（Repeated simulation summary）” 下。我们看到公司的年度预期利润（即`profit_sum`的均值）为 172,311.84 美元，标准差为 10,772.29 美元。尽管上文发现每日利润可能低于 100 美元，但全年利润低于 365×100 美元的可能性几乎为零（即年度利润低于 36,500 美元的重复模拟比例为 0）。 + +

    + +如果勾选 “显示图表（Show plots）”，“重复模拟图表（Repeated simulation plots）” 下将显示年度利润（`profit_sum`）的直方图。`profit_365`没有图表，因为它只有一个值（即 FALSE）。 + +

    + +下方截图中示例的状态文件可从此处下载。 + +关于如何使用模拟工具找到最大化利润的价格的简单示例，见可下载的状态文件此处。 + +### 在重复标签页中使用网格搜索 + +注意，“重复（Repeat）” 标签页也可以使用 “网格搜索（Grid search）” 输入，通过迭代方式替换 “模拟（Simulation）” 标签页中指定的一个或多个 “常数（Constants）” 来重复模拟。仅当 “分组依据（Group by）” 设置为 “重复（Repeat）” 时，才显示此输入选项。在 “网格搜索（Grid search）” 输入框中提供最小值、最大值和步长。例如，输入名称（`price`）、最小值（Min）（4）、最大值（Max）（10）和步长（Step）（0.01）。如果在 “网格搜索（Grid search）” 中指定多个变量，模拟会生成并评估所有可能的取值组合。注意，如果选择了 “网格搜索（Grid search）”，生成的值数量将覆盖 “重复次数（# reps）” 中指定的数量。然后点击图标。或者，直接在文本区域输入（或删除）内容（例如`price 4 10 0.01`）。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令或`patchwork`进行自定义。详见下方示例和*数据 > 可视化*。 + + +```r +plot(result, custom = TRUE) %>% + wrap_plots(plot_list, ncol = 2) + plot_annotation(title = "Simulation plots") +``` + +### R 函数 + +有关 Radiant 中用于构建和评估（重复）模拟模型的相关 R 函数概述，请参见*模型 > 模拟*。 + +`simulater`工具中使用的来自`stats`包的核心函数包括`rbinom`、`rlnorm`、`rnorm`、`rpois`和`runif`。 + +### 视频教程 + +将以下完整命令复制粘贴到 RStudio 控制台（即左下角窗口），按回车即可获取 Radiant 教程系列中模拟模块使用的所有材料： + +
    usethis::use_course("https://www.dropbox.com/sh/72kpk88ty4p1uh5/AABWcfhrycLzCuCvI6FRu0zia?dl=1")
    + +在 Radiant 中设置模拟（一） + +- 本视频演示如何使用 Radiant 设置模拟 +- 主题列表： + - 泊松分布简介 + - 指定模拟 + - 模拟摘要解读 + +在 Radiant 中设置重复模拟（二） + +- 本视频展示如何使用 Radiant 设置重复模拟 +- 主题列表： + - 指定重复模拟 + - 重复模拟摘要解读 + +使用模拟解决概率问题（三） + +- 本视频演示如何使用 Radiant 中的模拟解决概率问题 +- 主题列表： + - 回顾设置（重复）模拟 + - 模拟摘要解读 + - 重复模拟工作原理的直观理解 + +模拟公式技巧（四） + +- 本视频讨论模拟公式中常用的一些实用函数 +- 主题列表： + - 使用`ifelse`指定模拟公式 + - 使用`pmax`指定模拟公式 + +在模拟中使用网格搜索（五） + +- 本视频演示如何在模拟中使用网格搜索 +- 主题列表： + - 通过排序模拟数据或创建图表找到最优值 + - 使用`find_max`函数找到最优值 diff --git a/radiant.model/inst/app/tools/help/simulater.md b/radiant.model/inst/app/tools/help/simulater.md new file mode 100644 index 0000000000000000000000000000000000000000..f36402d9e16b5e2f3be186381a3c209e80b1d4fd --- /dev/null +++ b/radiant.model/inst/app/tools/help/simulater.md @@ -0,0 +1,361 @@ +> 用于决策分析的模拟 + + + +首先，从 “模拟（Simulate）” 标签页的 “选择类型（Select types）” 下拉菜单中选择模拟中使用的变量类型。可用类型包括二项分布（Binomial）、常数（Constant）、离散分布（Discrete）、对数正态分布（Log normal）、正态分布（Normal）、均匀分布（Uniform）、数据（Data）、网格搜索（Grid search）和序列（Sequence）。 + +### 二项分布（Binomial） + +使用 “二项分布变量（Binomial variables）” 输入框添加二项分布随机变量。首先指定名称（`crash`）、试验次数（n）（例如 20）和成功概率（p）（0.01），然后点击图标。或者，直接在文本输入区域输入（或删除）内容（例如`crash 20 .01`）。 + +### 常数（Constant） + +在 “常数变量（Constant variables）” 输入框中列出分析中要包含的常数。你可以直接在文本区域输入名称和值（例如`cost 3`），或者分别在 “名称（Name）” 和 “值（Value）” 输入框中输入名称（`cost`）和值（5），然后点击图标。点击图标可删除条目。注意，只有（较大的）文本输入框中列出的变量才会包含在模拟中。 + +### 离散分布（Discrete） + +使用 “离散分布变量（Discrete variables）” 输入框定义离散分布随机变量。首先指定名称（`price`）、取值（6 8）及其相关概率（.3 .7），然后点击图标。或者，直接在文本输入区域输入（或删除）内容（例如`price 6 8 .3 .7`）。注意，概率之和必须为 1，否则会显示错误信息，模拟无法运行。 + +### 对数正态分布（Log Normal） + +要在分析中包含对数正态分布随机变量，从 “选择类型（Select types）” 下拉菜单中选择 “对数正态分布（Log Normal）”，并使用 “对数正态分布变量（Log-normal variables）” 输入框。更多信息见下文 “正态分布（Normal）” 部分。 + +### 正态分布（Normal） + +要在分析中包含正态分布随机变量，从 “选择类型（Select types）” 下拉菜单中选择 “正态分布（Normal）”，并使用 “正态分布变量（Normal variables）” 输入框。例如，输入名称（`demand`）、均值（Mean）（1000）和标准差（St.dev.）（100），然后点击图标。或者，直接在文本输入区域输入（或删除）内容（例如`demand 1000 100`）。 + +### 泊松分布（Poisson） + +泊松分布适用于模拟特定时间范围内事件发生的次数，例如晚上 10 点到 11 点急诊室的就诊人数。要在分析中包含泊松分布随机变量，从 “选择类型（Select types）” 下拉菜单中选择 “泊松分布（Poisson）”，并使用 “泊松分布变量（Poisson variables）” 输入框。例如，输入名称（`patients`）和事件发生次数的参数 “Lambda” 值（20），然后点击图标。或者，直接在文本输入区域输入（或删除）内容（例如`patients 20`）。 + +### 均匀分布（Uniform） + +要在分析中包含均匀分布随机变量，从 “选择类型（Select types）” 下拉菜单中选择 “均匀分布（Uniform）”，在 “均匀分布变量（Uniform variables）” 输入框中提供参数。例如，输入名称（`cost`）、最小值（Min）（10）和最大值（Max）（15），然后点击图标。或者，直接在文本输入区域输入（或删除）内容（例如`cost 10 15`）。 + +### 数据（Data） + +要在 “模拟公式（Simulation formulas）” 输入框指定的计算中包含来自其他数据集的变量，从 “计算输入数据（Input data for calculations）” 下拉菜单中选择数据集。这与 “网格搜索（Grid search）” 功能结合使用时，对投资组合优化非常有用。但与其他输入结合使用时，必须确保不同计算返回的值数量相同，否则会出现如下错误： + +`Error: arguments imply differing number of rows: 999, 3000` + +### 网格搜索（Grid search） + +要包含值序列，从 “选择类型（Select types）” 下拉菜单中选择 “网格搜索（Grid search）”，在 “网格搜索（Grid search）” 输入框中提供最小值、最大值和步长。例如，输入名称（`price`）、最小值（Min）（4）、最大值（Max）（10）和步长（Step）（0.01）。如果在 “网格搜索（Grid search）” 中指定多个变量，模拟会生成并评估所有可能的取值组合。例如，假设在 “网格搜索（Grid search）” 文本输入框中定义第一个变量为`x 1 3 1`，第二个为`y 4 5 1`，则会生成以下数据： + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    x y
    1 4
    2 4
    3 4
    1 5
    2 5
    3 5
    + +注意，如果选择了 “网格搜索（Grid search）”，生成的值数量将覆盖 “模拟次数（# sims）” 或 “重复次数（# reps）” 中指定的数量。如果不希望如此，请使用 “序列（Sequence）”。然后点击图标。或者，直接在文本输入区域输入（或删除）内容（例如`price 4 10 0.01`）。 + +### 序列（Sequence） + +要包含值序列，从 “选择类型（Select types）” 下拉菜单中选择 “序列（Sequence）”，在 “序列变量（Sequence variables）” 输入框中提供最小值和最大值。例如，输入名称（`trend`）、最小值（Min）（1）和最大值（Max）（1000）。注意，“步数” 由模拟次数决定。然后点击图标。或者，直接在文本输入区域输入（或删除）内容（例如`trend 1 1000`）。 + +### 公式（Formulas） + +要使用生成的变量执行计算，在主面板的 “模拟公式（Simulation formulas）” 输入框中创建公式（例如`profit = demand * (price - cost)`）。公式用于向模拟添加（计算得到的）变量或更新现有变量。必须在`=`左侧指定新变量的名称。变量名称可包含字母、数字和`_`，但不能包含其他字符或空格。可以输入多个公式。例如，如果还想计算每次模拟的边际利润，在第一个公式后按回车，输入`margin = price - cost`。 + +“数据> 转换” 标签页中 “创建（Create）” 功能和 “数据 > 查看” 标签页中 “筛选数据（Filter data）” 功能使用的许多函数也可包含在公式中。可以使用`>`和`<`符号并组合它们。例如，`x > 3 & y == 2`在变量`x`的值大于 3**且**变量`y`的值等于 2 时，结果为`TRUE`。注意，在 R 和大多数其他编程语言中，`=`用于**赋值**，`==`用于判断变量值是否**恰好等于**某个值。相反，`!=`用于判断变量值**不等于**某个值。也可以使用包含**或（OR）** 条件的表达式。例如，要判断 “Salary” 小于 100,000 美元**或**大于 20,000 美元，使用`Salary > 20000 | Salary < 100000`。`|`是**或（OR）** 的符号，`&`是**且（AND）** 的符号（另见 “数据> 查看” 的帮助文件）。 + +下面展示几个公式示例： + +- 创建新变量 z，为变量 x 和 y 的差值 + +```r +z = x - y +``` + +- 创建新的逻辑变量 z，当 x > y 时取值为 TRUE，否则为 FALSE + +```r +z = x > y +``` + +- 创建新的逻辑变量 z，当 x 等于 y 时取值为 TRUE，否则为 FALSE + +```r +z = x == y +``` + +- 上面的命令与下面使用`ifelse`的命令等效。注意与 Excel 中的`if`语句类似 + +```r +z = ifelse(x < y, TRUE, FALSE) +``` + +- `ifelse`语句也可用于创建更复杂的（数值）变量。在下面的示例中，如果 x 小于 60，z 取值为 0；如果 x 大于 100，z 取值为 1；最后，当 x 为 60、100 或介于 60 到 100 之间时，z 取值为 2。**注意：** 确保包含适当数量的左括号`(`和右括号`)`！ + +```r +z = ifelse(x < 60, 0, ifelse(x > 100, 1, 2)) +``` + +- 创建新变量 z，为变量 x 的转换，且均值为 0： + +```r +z = x - mean(x) +``` + +- 创建新变量 z，为 x 的绝对值： + +```r +z = abs(x) +``` + +- 要找到使`profit`最大化的`price`值，使用`find_max`命令。在本示例中，`price`可以是随机变量或 “序列变量（Sequence variable）”。还有`find_min`命令。 + +```r +optimal_price = find_max(profit, price) +``` + +- 要确定多个变量（例如 x 和 y）中每对值的最小值（最大值），使用函数`pmin`和`pmax`。在下面的示例中，当 x 大于 y 时，z 取值为 x；否则，z 取值为 y。 + +```r +z = pmax(x, y) +``` + +示例见下表： + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    x y pmax(x,y)
    1 0 1
    2 3 3
    3 8 8
    4 2 4
    5 10 10
    +- 与`pmin`和`pmax`类似，有一些函数可用于计算多个变量的汇总统计量。例如，`psum`计算不同向量元素的总和。更多信息见https://radiant-rstats.github.io/radiant.data/reference/pfun.html。 + +```r +z = psum(x, y) +``` + +示例见下表： + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    x y psum(x,y)
    1 0 1
    2 3 5
    3 8 11
    4 2 6
    5 10 15
    + + +其他常用函数包括`ln`（自然对数，例如`ln(x)`）、`sqrt`（x 的平方根，例如`sqrt(x)`）和`square`（计算变量的平方，例如`square(x)`）。 + +要从计算中返回单个值，使用`min`、`max`、`mean`、`sd`等函数。 + +- 投资组合优化中一个有用的特殊函数是`sdw`。它接受权重和变量作为输入，返回变量加权和的标准差。例如，要计算三只股票（如波音、通用汽车和埃克森美孚）投资组合的标准差，可在 “模拟公式（Simulation formulas）” 输入框中使用以下方程。`f`和`g`可以是值（例如 0.2 和 0.8），或通过 “网格搜索（Grid search）” 输入框指定的不同权重向量（见上文）。`Boeing`、`GM`和`Exxon`是使用 “数据（Data）” 输入框（见上文）包含在模拟中的数据集中的变量名称。 + +```r +Pstdev = sdw(f, g, 1-f-g, Boeing, GM, Exxon) +``` + +关于如何使用模拟工具进行投资组合优化的示例，见可下载的状态文件此处。 + +### 函数（Functions） + +可能 R 中可用的标准函数不足以灵活地进行你想要的模拟。如果是这种情况，点击屏幕左下角的 “添加函数（Add functions）” 复选框，在主面板的 “模拟函数（Simulation functions）” 输入框中创建自定义函数。要学习编写 R 函数，https://www.statmethods.net/management/userfunctions.html是一个很好的起点。 + +关于如何在赌博模拟中使用自定义 R 函数的示例，见可下载的状态文件此处。通过 “报告> Rmd” 生成的报告提供了关于模拟设置和函数使用的更多信息。 + +### 运行模拟 + +“模拟次数（# sims）” 输入框中显示的值决定模拟**抽取**的次数。要使用相同的随机生成值重新进行模拟，在 “设置随机种子（Set random seed）” 输入框中指定一个数字（例如 1234）。 + +要保存模拟数据供进一步分析，在 “模拟数据（Simulated data）” 输入框中指定名称。然后，可在任何 “数据” 标签页（例如 “数据 > 查看”、“数据 > 可视化” 或 “数据 > 探索”）的 “数据集（Datasets）” 下拉菜单中选择指定名称的数据集，以研究模拟数据。 + +指定所有必要输入后，点击 “模拟（Simulate）” 按钮运行模拟。 + +在下方截图中，`var_cost`和`fixed_cost`被指定为常数。`E`服从均值为 0、标准差为 100 的正态分布。`price`是离散随机变量，取值为 6 美元（概率 30%）或 8 美元（概率 70%）。“模拟公式（Simulation formulas）” 文本输入框中有三个公式。第一个公式确定 “需求（demand）” 对模拟变量 “价格（price）” 的依赖关系；第二个公式指定利润函数；最后一个公式用于确定利润低于 100 的案例数量（和比例），结果赋值给新变量`profit_small`。 + +

    + +在 “模拟摘要（Simulation summary）” 的输出中，首先看到模拟规格的详细信息（例如模拟次数）。“常数（Constants）” 部分列出各模拟中不变的变量值。“随机变量（Random variables）” 和 “逻辑变量（Logicals）” 部分列出模拟结果。我们看到模拟中的平均 “需求（demand）” 为 627.94，标准差为 109.32。还提供了模拟数据的其他特征（例如最大利润为 1758.77）。最后，我们看到利润低于 100 的概率为 0.32（即 1000 次模拟中，有 315 次利润低于 100 美元）。 + +要查看随机变量以及使用 “模拟公式（Simulation formulas）” 创建的变量的直方图，请确保勾选 “显示图表（Show plots）”。 + +

    + +由于我们在 “模拟数据（Simulated data）” 框中指定了名称，数据在 Radiant 中以`simdat`为名可用（见下方截图）。要在 Excel 中使用该数据，点击 “数据> 查看” 标签页右上角的下载图标，或前往 “数据 > 管理” 标签页将数据保存为 csv 文件（或使用剪贴板功能）。更多信息见 “数据 > 管理” 标签页的帮助文件。 + +

    + +## 重复模拟 + +假设上述模拟用于更好地理解每日利润。要深入了解年度利润，我们可以重新运行模拟 365 次。但通过 “重复（Repeat）” 标签页的功能可以更方便地实现。首先，在 “要重新模拟的变量（Variables to re-simulate）” 中选择变量，此处为`E`和`price`。然后在 “输出变量（Output variables）” 框中选择关注的变量（例如`profit`）。将 “重复次数（# reps）” 设置为 365。 + +接下来，需要确定如何汇总数据。如果在 “分组依据（Group by）” 中选择 “模拟（Simulation）”，数据将按每次模拟抽取**在**365 次重复模拟中汇总，得到 1000 个值。如果选择 “重复（Repeat）”，数据将按每次重复**在**1000 次模拟中汇总，得到 365 个值。如果将完整的重复模拟数据集想象为 1000 行 365 列的表格，按 “模拟（Simulation）” 分组将为每行创建汇总统计量，按 “重复（Repeat）” 分组将为每列创建汇总统计量。在本示例中，要确定 365 次重复模拟的每日利润总和，在 “分组依据（Group by）” 框中选择 “模拟（Simulation）”，在 “应用函数（Apply function）” 框中选择 “sum”。 + +要确定年度利润低于 36,500 美元的概率，在 “重复模拟公式（Repeated simulation formula）” 文本输入框中输入以下公式： + +```r +profit_365 = profit_sum < 36500 +``` + +注意，`profit_sum`是 “模拟（Simulation）” 标签页中定义的`profit`变量的重复模拟总和。输入所有值后，点击 “重复（Repeat）” 按钮。由于我们为 “重复数据（Repeat data）” 指定了名称，将创建新数据集。`repdat`将包含按模拟分组的汇总数据（即 1000 行）。要存储所有 365×1000 次模拟 / 重复结果，从 “应用函数（Apply function）” 下拉菜单中选择 “none”。 + +重复模拟的描述性统计量显示在主面板的 “重复模拟摘要（Repeated simulation summary）” 下。我们看到公司的年度预期利润（即`profit_sum`的均值）为 172,311.84 美元，标准差为 10,772.29 美元。尽管上文发现每日利润可能低于 100 美元，但全年利润低于 365×100 美元的可能性几乎为零（即年度利润低于 36,500 美元的重复模拟比例为 0）。 + +

    + +如果勾选 “显示图表（Show plots）”，“重复模拟图表（Repeated simulation plots）” 下将显示年度利润（`profit_sum`）的直方图。`profit_365`没有图表，因为它只有一个值（即 FALSE）。 + +

    + +下方截图中示例的状态文件可从此处下载。 + +关于如何使用模拟工具找到最大化利润的价格的简单示例，见可下载的状态文件此处。 + +### 在重复标签页中使用网格搜索 + +注意，“重复（Repeat）” 标签页也可以使用 “网格搜索（Grid search）” 输入，通过迭代方式替换 “模拟（Simulation）” 标签页中指定的一个或多个 “常数（Constants）” 来重复模拟。仅当 “分组依据（Group by）” 设置为 “重复（Repeat）” 时，才显示此输入选项。在 “网格搜索（Grid search）” 输入框中提供最小值、最大值和步长。例如，输入名称（`price`）、最小值（Min）（4）、最大值（Max）（10）和步长（Step）（0.01）。如果在 “网格搜索（Grid search）” 中指定多个变量，模拟会生成并评估所有可能的取值组合。注意，如果选择了 “网格搜索（Grid search）”，生成的值数量将覆盖 “重复次数（# reps）” 中指定的数量。然后点击图标。或者，直接在文本区域输入（或删除）内容（例如`price 4 10 0.01`）。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令或`patchwork`进行自定义。详见下方示例和*数据 > 可视化*。 + + +```r +plot(result, custom = TRUE) %>% + wrap_plots(plot_list, ncol = 2) + plot_annotation(title = "Simulation plots") +``` + +### R 函数 + +有关 Radiant 中用于构建和评估（重复）模拟模型的相关 R 函数概述，请参见*模型 > 模拟*。 + +`simulater`工具中使用的来自`stats`包的核心函数包括`rbinom`、`rlnorm`、`rnorm`、`rpois`和`runif`。 + +### 视频教程 + +将以下完整命令复制粘贴到 RStudio 控制台（即左下角窗口），按回车即可获取 Radiant 教程系列中模拟模块使用的所有材料： + +
    usethis::use_course("https://www.dropbox.com/sh/72kpk88ty4p1uh5/AABWcfhrycLzCuCvI6FRu0zia?dl=1")
    + +在 Radiant 中设置模拟（一） + +- 本视频演示如何使用 Radiant 设置模拟 +- 主题列表： + - 泊松分布简介 + - 指定模拟 + - 模拟摘要解读 + +在 Radiant 中设置重复模拟（二） + +- 本视频展示如何使用 Radiant 设置重复模拟 +- 主题列表： + - 指定重复模拟 + - 重复模拟摘要解读 + +使用模拟解决概率问题（三） + +- 本视频演示如何使用 Radiant 中的模拟解决概率问题 +- 主题列表： + - 回顾设置（重复）模拟 + - 模拟摘要解读 + - 重复模拟工作原理的直观理解 + +模拟公式技巧（四） + +- 本视频讨论模拟公式中常用的一些实用函数 +- 主题列表： + - 使用`ifelse`指定模拟公式 + - 使用`pmax`指定模拟公式 + +在模拟中使用网格搜索（五） + +- 本视频演示如何在模拟中使用网格搜索 +- 主题列表： + - 通过排序模拟数据或创建图表找到最优值 + - 使用`find_max`函数找到最优值 diff --git a/radiant.model/inst/app/tools/help/svm.md b/radiant.model/inst/app/tools/help/svm.md new file mode 100644 index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 diff --git a/radiant.model/inst/app/ui.R b/radiant.model/inst/app/ui.R new file mode 100644 index 0000000000000000000000000000000000000000..0debb3430523669ec3cf772bd0d79fe113f139cb --- /dev/null +++ b/radiant.model/inst/app/ui.R @@ -0,0 +1,15 @@ +## ui for model menu in radiant +navbar_proj( + suppressWarnings( + do.call( + navbarPage, + c( + "Radiant for R", + getOption("radiant.nav_ui"), + getOption("radiant.model_ui"), + getOption("radiant.shared_ui"), + help_menu("help_model_ui") + ) + ) + ) +) diff --git a/radiant.model/inst/app/www/js/store.js b/radiant.model/inst/app/www/js/store.js new file mode 100644 index 0000000000000000000000000000000000000000..4d1ee11ac01bda8d7dfc9983af9780e7c4ba98f5 --- /dev/null +++ b/radiant.model/inst/app/www/js/store.js @@ -0,0 +1,96 @@ +$(document).keydown(function (event) { + // focusing in text (area) inputs + + if (event.metaKey === false && event.ctrlKey === false && event.shiftKey === false) { + + if ($("#reg_store_res_name").is(":focus") && event.keyCode == 13) { + $("#reg_store_res").click(); + } else if ($("#reg_store_pred_name").is(":focus") && event.keyCode == 13) { + $("#reg_store_pred").click(); + } else if ($("#logit_store_res_name").is(":focus") && event.keyCode == 13) { + $("#logit_store_res").click(); + } else if ($("#logit_store_pred_name").is(":focus") && event.keyCode == 13) { + $("#logit_store_pred").click(); + } else if ($("#mnl_store_res_name").is(":focus") && event.keyCode == 13) { + $("#mnl_store_res").click(); + } else if ($("#mnl_store_pred_name").is(":focus") && event.keyCode == 13) { + $("#mnl_store_pred").click(); + } else if ($("#nb_store_pred_name").is(":focus") && event.keyCode == 13) { + $("#nb_store_pred").click(); + } else if ($("#nn_store_res_name").is(":focus") && event.keyCode == 13) { + $("#nn_store_res").click(); + } else if ($("#nn_store_pred_name").is(":focus") && event.keyCode == 13) { + $("#nn_store_pred").click(); + } else if ($("#crtree_store_res_name").is(":focus") && event.keyCode == 13) { + $("#crtree_store_res").click(); + } else if ($("#crtree_store_pred_name").is(":focus") && event.keyCode == 13) { + $("#crtree_store_pred").click(); + } else if ($("#rf_store_res_name").is(":focus") && event.keyCode == 13) { + $("#rf_store_res").click(); + } else if ($("#rf_store_pred_name").is(":focus") && event.keyCode == 13) { + $("#rf_store_pred").click(); + } else if ($("#gbt_store_res_name").is(":focus") && event.keyCode == 13) { + $("#gbt_store_res").click(); + } else if ($("#gbt_store_pred_name").is(":focus") && event.keyCode == 13) { + $("#gbt_store_pred").click(); + } else if ($("#crs_store_pred_name").is(":focus") && event.keyCode == 13) { + $("#crs_store_pred").click(); + } else if ($("#sim_binom_p").is(":focus") && event.keyCode == 13) { + $("#sim_binom_add").click(); + } else if ($("#sim_discrete_prob").is(":focus") && event.keyCode == 13) { + $("#sim_discrete_add").click(); + } else if ($("#sim_lnorm_sd").is(":focus") && event.keyCode == 13) { + $("#sim_lnorm_add").click(); + } else if ($("#sim_norm_sd").is(":focus") && event.keyCode == 13) { + $("#sim_norm_add").click(); + } else if ($("#sim_pois_lambda").is(":focus") && event.keyCode == 13) { + $("#sim_pois_add").click(); + } else if ($("#sim_unif_max").is(":focus") && event.keyCode == 13) { + $("#sim_unif_add").click(); + } else if ($("#sim_const_nr").is(":focus") && event.keyCode == 13) { + $("#sim_const_add").click(); + } else if ($("#sim_grid_step").is(":focus") && event.keyCode == 13) { + $("#sim_grid_add").click(); + } else if ($("#sim_sequ_max").is(":focus") && event.keyCode == 13) { + $("#sim_sequ_add").click(); + } else if ($("#rep_grid_step").is(":focus") && event.keyCode == 13) { + $("#rep_grid_add").click(); + } else if ($("#dtree_sense_step").is(":focus") && event.keyCode == 13) { + $("#dtree_sense_add").click(); + } + } + + if ($("#dtree_load_yaml").is(":visible") && (event.metaKey || event.ctrlKey) && + event.shiftKey === false && event.keyCode == 79) { + $("#dtree_load_yaml").click(); + event.preventDefault(); + } else if ($("#dtree_save_yaml").is(":visible") && (event.metaKey || event.ctrlKey) && + event.shiftKey === false && event.keyCode == 83) { + $("#dtree_save_yaml").click(); + event.preventDefault(); + } +}); + +function generate_dtree_plot() { + html2canvas($("#dtree_plot")[0],{ignoreElements:function (el) {return el.className === 'dropdown-menu';}}).then(canvas=>{ + var img = document.createElement("img"); + img.src = canvas.toDataURL("png"); + img.width = parseInt(canvas.style.width); + img.height = parseInt(canvas.style.height); + $("#screenshot_preview").empty(); + $("#screenshot_preview").append(img); + }); +} + +function generate_crtree_plot() { + html2canvas($("#crtree_plot")[0],{ignoreElements:function (el) {return el.className === 'dropdown-menu';}}).then(canvas=>{ + var img = document.createElement("img"); + img.src = canvas.toDataURL("png"); + img.width = parseInt(canvas.style.width); + img.height = parseInt(canvas.style.height); + $("#screenshot_preview").empty(); + $("#screenshot_preview").append(img); + }); +} + + diff --git a/radiant.model/inst/app/www/style.css b/radiant.model/inst/app/www/style.css new file mode 100644 index 0000000000000000000000000000000000000000..cb703711a52276bfafb8860ddacf34b701d616f0 --- /dev/null +++ b/radiant.model/inst/app/www/style.css @@ -0,0 +1,85 @@ +#sim_form, #rep_form { + width: 100%; +} + +/* from: https://github.com/swarm-lab/editR/blob/master/inst/app/www/editR.css */ +#dtree_edit { + position: absolute; + top: 165px; + bottom: 0; + left: 0; + right: 50%; + padding-right: 10px; +} + +div.mermaidTooltip { + text-align: left !important; + max-width: 300px !important; +} + +/* +div.mermaidTooltip { + position: absolute; + text-align: center; + max-width: 200px; + padding: 2px; + font-family: 'trebuchet ms', verdana, arial; + font-size: 12px; + background: #ffffde; + border: 1px solid #aaaa33; + border-radius: 2px; + pointer-events: none; + z-index: 100; +} +*/ + +/* from: https://github.com/swarm-lab/editR/blob/master/inst/app/www/editR.css */ +#dtree_print { + position: absolute; + top: 165px; + bottom: 0; + left: 50%; + right: 0; + padding-left: 10px; + overflow-y: scroll; +} + +/* print option relevant to print a decision tree to pdf */ +/* based on http://stackoverflow.com/a/2618980/1974918 */ +@media print { + + #dtree * { + visibility: hidden; + } + #dtree_plot, #dtree_plot * { + visibility: visible; + } + #dtree_plot { + display:inline; + width: 100%; + height: 100%; + padding: 0; + } + #crtree * { + visibility: hidden; + } + #crtree_plot, #crtree_plot * { + visibility: visible; + } + #crtree_plot { + position: fixed; + top: 0; + left: 0; + width: 100%; + height: 100%; + padding: 0; + + /*display:inline; */ + /*width: 100%;*/ + /*height: 100%;*/ + /*padding: 0;*/ + + /*height: 100%;*/ + /*height: auto;*/ + } +} diff --git a/radiant.model/inst/translations/translation_zh.csv b/radiant.model/inst/translations/translation_zh.csv new file mode 100644 index 0000000000000000000000000000000000000000..7adf034894f5e6ce67c63c07c7bccd7458b0e15c --- /dev/null +++ b/radiant.model/inst/translations/translation_zh.csv @@ -0,0 +1,411 @@ +en,zh,source +Help,帮助,"global.R, radiant.R" +Keyboard shortcuts,键盘快捷键,global.R +User id:,用户 ID:,crs_ui.R +Product id:,产品 ID:,crs_ui.R +Choose products to recommend:,选择要推荐的产品:,crs_ui.R +Ratings variable:,评分变量:,crs_ui.R +Provide data name,请输入数据名称,crs_ui.R +Estimate model,估计模型,"crs_ui.R, crtree_ui.R, gbt_ui.R, logistic_ui.R" +Re-estimate model,重新估计模型,"crs_ui.R, crtree_ui.R, gbt_ui.R, logistic_ui.R" +,,crs_ui.R +Store,保存,"crs_ui.R, gbt_ui.R, logistic_ui.R" +Collaborative Filtering,协同过滤,crs_ui.R +Model > Recommend,模型 > 推荐,crs_ui.R +"This analysis requires a user id, a product id, and product ratings. +If these variables are not available please select another dataset. + +","此分析需要用户 ID、产品 ID 和评分变量。 +如果这些变量不存在，请选择另一个数据集。 + +",crs_ui.R +"A data filter or slice must be set to generate recommendations using +collaborative filtering. Add a filter or slice in the Data > View tab. +Note that the users in the training sample should not overlap +with the users in the test sample.","必须设置数据过滤或切片才能使用协同过滤生成推荐。 +在“数据 > 查看”选项卡中添加过滤器或切片。 +注意：训练集和测试集中的用户不应重叠。",crs_ui.R +"An invalid filter has been set for this dataset. Please +adjust the filter in the Data > View tab and try again","此数据集设置了无效的过滤条件。 +请在“数据 > 查看”中调整过滤条件并重试。",crs_ui.R +Please select one or more products to generate recommendations,请选择一个或多个产品以生成推荐,crs_ui.R +Estimating model,正在估计模型,"crs_ui.R, crtree_ui.R" +** Press the Estimate button to generate recommendations **,** 请点击“估计模型”按钮以生成推荐 **,crs_ui.R +Generating plots,正在生成图形表,"crs_ui.R, crtree_ui.R, gbt_ui.R, logistic_ui.R" +No data selected to generate recommendations,未选择任何数据用于生成推荐,crs_ui.R +Data Stored,数据已保存,crs_ui.R +Dataset '{fixed}' was successfully added to the datasets dropdown. Add code to Report > Rmd or Report > R to (re)create the dataset by clicking the report icon on the bottom left of your screen.,数据集“{fixed}”已成功添加到数据下拉菜单中。要在报告中（重新）生成该数据集，请点击左下角的报告图标，并添加到“报告 > Rmd”或“报告 > R”。,crs_ui.R +OK,确定,"crs_ui.R, evalbin_ui.R" +No recommendations available,无推荐结果可用,crs_ui.R +Save collaborative filtering recommendations,保存协同过滤推荐结果,crs_ui.R +Save collaborative filtering plot,保存协同过滤图表,crs_ui.R +None,无,"crtree_ui.R, gbt_ui.R" +Prune,修剪,crtree_ui.R +Tree,决策树,crtree_ui.R +Permutation Importance,特征重要性,"crtree_ui.R, gbt_ui.R" +Prediction plots,预测图,"crtree_ui.R, gbt_ui.R" +Partial Dependence,部分依赖图,"crtree_ui.R, gbt_ui.R" +Dashboard,仪表盘,"crtree_ui.R, gbt_ui.R" +Acquiring variable information,获取变量信息,"crtree_ui.R, evalbin_ui.R, evalreg_ui.R, gbt_ui.R, logistic_ui.R" +Response variable:,因变量:,"crtree_ui.R, evalbin_ui.R, evalreg_ui.R, gbt_ui.R, logistic_ui.R" +Choose level:,选择水平:,"crtree_ui.R, evalbin_ui.R, logistic_ui.R" +Explanatory variables:,自变量:,"crtree_ui.R, gbt_ui.R, logistic_ui.R" +Explanatory variables to include:,包含的自变量:,"crtree_ui.R, logistic_ui.R" +2-way interactions to explore:,要探索的二阶交互项:,"crtree_ui.R, logistic_ui.R" +Weights:,权重:,"crtree_ui.R, gbt_ui.R, logistic_ui.R" +classification,分类,"crtree_ui.R, gbt_ui.R" +regression,回归,"crtree_ui.R, gbt_ui.R" +Prior:,先验:,crtree_ui.R +Min obs.:,最小观测数:,crtree_ui.R +Cost:,成本:,"crtree_ui.R, evalbin_ui.R" +Margin:,边际:,"crtree_ui.R, evalbin_ui.R" +Complexity:,复杂度:,crtree_ui.R +Max. nodes:,最大节点数:,crtree_ui.R +Prune compl.:,修剪复杂度:,crtree_ui.R +Seed:,随机种子:,"crtree_ui.R, gbt_ui.R" +Store residuals:,存储残差:,"crtree_ui.R, logistic_ui.R" +Provide variable name,提供变量名,crtree_ui.R +Number of data points plotted:,绘图数据点数:,"crtree_ui.R, gbt_ui.R, logistic_ui.R" +Classification and regression trees,分类与回归树,crtree_ui.R +Prediction input type:,预测输入类型:,"crtree_ui.R, gbt_ui.R, logistic_ui.R" +Prediction data:,预测数据:,"crtree_ui.R, gbt_ui.R" +Prediction command:,预测指令:,"crtree_ui.R, gbt_ui.R, logistic_ui.R" +"Type a formula to set values for model variables (e.g., carat = 1; cut = 'Ideal') and press return",在此输入用于模型预测的变量值 (如 carat = 1; cut = 'Ideal') 并按回车键,"crtree_ui.R, gbt_ui.R, naivebayes_ui.R" +Plot predictions,绘制预测图,"crtree_ui.R, gbt_ui.R, logistic_ui.R" +Store predictions:,存储预测值:,"crtree_ui.R, gbt_ui.R" +Plots:,绘图选项:,"crtree_ui.R, evalbin_ui.R, gbt_ui.R, logistic_ui.R" +Plot direction:,绘图方向:,"crtree_ui.R, dtree_ui.R" +Left-right,左-右,"crtree_ui.R, dtree_ui.R" +Top-down,上-下,"crtree_ui.R, dtree-ui.R" +Right-left,右-左,crtree_ui.R +Bottom-Top,下-上,crtree_ui.R +Width:,宽度:,crtree_ui.R +Save crtree predictions,保存预测结果,crtree_ui.R +Save decision tree prediction plot,保存预测图,crtree_ui.R +Save decision tree plot,保存决策树图,crtree_ui.R +Generating predictions,正在生成预测,"crtree_ui.R, gbt_ui.R, logistic_ui.R" +Generating prediction plot,正在生成预测图,"crtree_ui.R, gbt_ui.R, logistic_ui.R" +Generating tree diagramm,正在生成树图,crtree_ui.R +Model > Estimate,模型 > 估计,"crtree_ui.R, logistic_ui.R" +** Press the Estimate button to estimate the model **,** 请点击“估计模型”按钮以生成推荐 **,"crtree_ui.R, gbt_ui.R" +Please select one or more explanatory variables.,请选择一个或多个自变量。,"crtree_ui.R, gbt_ui.R, nn_ui.R" +Max:,最大化:,dtree_ui.R +Min:,最小化:,dtree_ui.R +Max,最大化,dtree_ui.R +Min,最小化,dtree_ui.R +Remove,删除,dtree_ui.R +"No variables are available for sensitivity analysis. If the input file does contain a variables section, press the Calculate button to show the list of available variables.",没有可用于敏感性分析的变量。如果输入文件包含 variables 部分，请点击“计算树”按钮以显示可用变量列表。,dtree_ui.R +Sensitivity to changes in:,敏感性分析变量：,dtree_ui.R +Decisions to evaluate:,要评估的决策：,dtree_ui.R +Select decisions to evaluate,选择要评估的决策,dtree_ui.R +"","",dtree_ui.R +Step:,步长:,dtree_ui.R +Add variable,添加变量,"dtree_ui.R, simulater_ui.R" +Model,模型,dtree_ui.R +Decision analysis,决策分析,dtree_ui.R +,,dtree_ui.R +,,dtree_ui.R +Calculate tree,计算树,dtree_ui.R +Load input,加载输入,dtree_ui.R +Load decision tree input file (.yaml),加载决策树输入文件 (.yaml),dtree_ui.R +Save input,保存输入,dtree_ui.R +Save output,保存输出,dtree_ui.R +Provide structured input for a decision tree. Then click the 'Calculate tree' button to generate results. Click the ? icon on the top left of your screen for help and examples,为决策树提供结构化输入，然后点击“计算树”按钮生成结果。如需帮助和示例，请点击左上角的 ? 图标。,dtree_ui.R +Plot,图形,"dtree_ui.R, gbt_ui.R" +,,dtree_ui.R +,,dtree_ui.R +,,dtree_ui.R +Plot decision tree:,绘制决策树：,dtree_ui.R +Initial,初始,dtree_ui.R +Final,最终,dtree_ui.R +Decimals,小数位,dtree_ui.R +Symbol,符号,dtree_ui.R +Sensitivity,敏感性,dtree_ui.R +Evaluate sensitivity,评估敏感性,dtree_ui.R +At least one decision should be selected for evaluation,至少应选择一个决策进行评估,dtree_ui.R +No variables were specified for evaluation.\nClick the + icon to add variables for sensitivity evaluation,未指定任何变量用于评估。\n点击 + 图标添加要进行敏感性评估的变量,dtree_ui.R +Conducting sensitivity analysis,正在进行敏感性分析,dtree_ui.R +Making plot,正在生成图形,dtree_ui.R +Creating decision tree,正在创建决策树,dtree_ui.R +** Click the calculate button to generate results **,** 请点击计算按钮以生成结果 **,dtree_ui.R +Save decision tree output,保存决策树输出,dtree_ui.R +Save decision tree input,保存决策树输入,dtree_ui.R +Save decision tree sensitivity plot,保存敏感性分析图,dtree_ui.R +Lift,提升图,evalbin_ui.R +Gains,收益图,evalbin_ui.R +Profit,利润图,evalbin_ui.R +Expected profit,预期利润,evalbin_ui.R +ROME,投资回报率,evalbin_ui.R +All,全部,"evalbin_ui.R, evalreg_ui.R" +Training,训练集,"evalbin_ui.R, evalreg_ui.R" +Test,测试集,"evalbin_ui.R, evalreg_ui.R" +Both,训练集与测试集,"evalbin_ui.R, evalreg_ui.R" +Incremental uplift,增量提升,evalbin_ui.R +Uplift,提升,evalbin_ui.R +Incremental profit,增量利润,evalbin_ui.R +More than 50 levels. Please choose another response variable,超过 50 个水平。请选择其他响应变量,evalbin_ui.R +Treatment variable:,处理变量：,evalbin_ui.R +Select stored predictions:,选择已保存的预测：,"evalbin_ui.R, evalreg_ui.R" +Show results for:,显示结果：,"evalbin_ui.R, evalreg_ui.R" +Store uplift table as:,保存提升表为：,evalbin_ui.R +Provide a table name,请输入表名,evalbin_ui.R +Evaluate models,评估模型,"evalbin_ui.R, evalreg_ui.R" +Re-evaluate models,重新评估模型,"evalbin_ui.R, evalreg_ui.R" +# quantiles:,分位数数量：,evalbin_ui.R +Scale:,缩放因子：,evalbin_ui.R +Show model performance table,显示模型性能表,evalbin_ui.R +Show uplift table,显示提升表,evalbin_ui.R +Show plots,显示图形,"evalbin_ui.R, evalreg_ui.R" +Scale free,统一纵轴,evalbin_ui.R +Evaluate classification,评估分类模型,evalbin_ui.R +Confusion matrix,混淆矩阵,evalbin_ui.R +Evaluate uplift,评估提升效果,evalbin_ui.R +Uplift Table Stored,提升表已保存,evalbin_ui.R +The uplift table ',提升表 ',evalbin_ui.R +"' was successfully added to the + datasets dropdown. Add code to Report > Rmd or + Report > R to (re)create the results by clicking + the report icon on the bottom left of your screen.",' 已成功添加到数据集下拉菜单。可在 Report > Rmd 或 Report > R 中添加代码以（重新）生成结果，方法是点击屏幕左下角的报告图标。,evalbin_ui.R +Save model evaluations,保存模型评估结果,"evalbin_ui.R, evalreg_ui.R" +Save model performance metrics,保存模型性能指标,evalbin_ui.R +Save uplift evaluations,保存提升评估结果,evalbin_ui.R +Save model evaluation plot,保存模型评估图,"evalbin_ui.R, evalreg_ui.R" +Save confusion plots,保存混淆图,evalbin_ui.R +Save uplift plots,保存提升图,evalbin_ui.R +Evaluate,评估,evalbin_ui.R +Model > Evaluate,模型 > 评估,"evalbin_ui.R, evalreg_ui.R" +** Press the Evaluate button to evaluate models **,** 请点击“评估”按钮以评估模型 **,"evalbin_ui.R, evalreg_ui.R" +,,evalbin_ui.R +"This analysis requires a response variable of type factor and one or more +predictors of type numeric. If these variable types are not available please +select another dataset. + +For an example dataset go to Data > Manage, select 'examples' from the +'Load data of type' dropdown, and press the 'Load examples' button. Then +select the 'titanic' dataset.","此分析需要一个因变量（类别型）和一个或多个自变量（数值型）。如果这些变量类型不可用，请选择另一个数据集。 + +如需示例数据集，请前往“数据 > 管理”，在“加载数据类型”下拉菜单中选择“示例”，然后点击“加载示例”按钮。接着选择“titanic”数据集。",evalbin_ui.R +"This analysis requires a response variable of type factor and one or more +predictors of type numeric. If these variable types are not available please +select another dataset. +",此分析需要一个因变量（类别型）和一个或多个自变量（数值型）。如果这些变量类型不可用，请选择另一个数据集。,evalbin_ui.R +Evaluate Regression,回归评估,evalreg_ui.R +This analysis requires a numeric response variable and one or more\nnumeric predictors. If these variable types are not available please\nselect another dataset.\n\n,本分析要求一个数值型因变量和一个或多个数值型自变量。如果当前数据集中不包含这些类型的变量，请选择另一个数据集。\n\n,evalreg_ui.R +Choose first level:,选择第一个水平：,gbt_ui.R +Max depth:,最大深度：,gbt_ui.R +Learning rate:,学习率：,gbt_ui.R +Min split loss:,最小分裂损失：,gbt_ui.R +Min child weight:,最小子节点权重：,gbt_ui.R +Sub-sample:,子样本比例：,gbt_ui.R +# rounds:,迭代轮数：,gbt_ui.R +Early stopping:,提前停止：,gbt_ui.R +Gradient Boosted Trees,梯度提升树,gbt_ui.R +Model > Trees,模型 > 树模型,gbt_ui.R +** Select prediction input **,** 请选择预测输入 **,"gbt_ui.R, logistic_ui.R" +** Select data for prediction **,** 请选择用于预测的数据 **,"gbt_ui.R, logistic_ui.R" +** Enter prediction commands **,** 请输入预测命令 **,"gbt_ui.R, logistic_ui.R" +Please select a gradient boosted trees plot from the drop-down menu,请从下拉菜单中选择一个梯度提升树图表,gbt_ui.R +Storing predictions,正在保存预测结果,"gbt_ui.R, logistic_ui.R" +No output available. Press the Estimate button to generate results,无可用输出。请点击“估计模型”按钮生成结果,"gbt_ui.R, logistic_ui.R" +Save predictions,保存预测结果,"gbt_ui.R, logistic_ui.R" +Save gradient boosted trees prediction plot,保存梯度提升树预测图,gbt_ui.R +Save gradient boosted trees plot,保存梯度提升树图,gbt_ui.R +This analysis requires a response variable with two levels and one\nor more explanatory variables. If these variables are not available\nplease select another dataset.\n\n,此分析需要一个具有两个水平的响应变量和一个\n或多个解释变量。如果这些变量不可用\n请选择其他数据集。\n\n,gbt_ui.R +This analysis requires a response variable of type integer\nor numeric and one or more explanatory variables.\nIf these variables are not available please select another dataset.\n\n,此分析需要一个整数类型的响应变量\n或数值型，以及一个或多个解释变量。\n如果这些变量不可用，请选择其他数据集。\n\n,gbt_ui.R +Summary,摘要,gbt_ui.R +Predict,预测,gbt_ui.R +Storing residuals,存储残差,logistic_ui.R +Save coefficients,保存系数,logistic_ui.R +Save logistic prediction plot,保存逻辑回归预测图,logistic_ui.R +Save logistic plot,保存逻辑回归图,logistic_ui.R +Variables to test:,测试的变量：,logistic_ui.R +Interactions:,交互作用：,logistic_ui.R +Confidence level:,置信水平：,logistic_ui.R +"Type a formula to set values for model variables (e.g., class = '1st'; gender = 'male') and press return",输入公式设置模型变量的值（例如，class = '1st'; gender = 'male'），然后按回车,logistic_ui.R +Include intercept,包含截距,logistic_ui.R +Save,保存,logistic_ui.R +Logistic regression (GLM),逻辑回归（GLM）,logistic_ui.R +Logistic regression,逻辑回归,logistic_ui.R +3-way, "三项交互", "logistic_ui.R" +Data, "数据", "logistic_ui.R" +Command, "命令", "logistic_ui.R" +Data & Command, "数据和命令", "logistic_ui.R" +Standardize, "标准化", "logistic_ui.R" +Center, "居中", "logistic_ui.R" +Stepwise, "逐步回归", "logistic_ui.R" +Robust, "稳健", "logistic_ui.R" +VIF, "方差膨胀因子", "logistic_ui.R" +Confidence intervals, "置信区间", "logistic_ui.R" +Odds, "赔率", "logistic_ui.R" +Distribution, "分布", "logistic_ui.R" +Correlations, "相关性", "logistic_ui.R" +Scatter, "散点图", "logistic_ui.R" +Model fit, "模型拟合", "logistic_ui.R" +Coefficient (OR) plot, "系数（OR）图", "logistic_ui.R" +Influential observations, "影响观察值", "logistic_ui.R" +This analysis requires a response variable with two levels and one or more explanatory variables. If these variables are not available please select another dataset., "该分析需要一个具有两个级别的响应变量以及一个或多个解释变量。如果这些变量不可用，请选择另一个数据集。", "logistic_ui.R" +Drop intercept,去除截距项,mnl_ui.R +RRRs,相对风险比 (RRR),mnl_ui.R +Coefficient (RRR) plot,系数图（RRR）,mnl_ui.R +Multinomial logistic regression (MNL),多项式逻辑回归（MNL）,mnl_ui.R +Save mnl prediction plot,保存 MNL 预测图,mnl_ui.R +Save mnl plot,保存 MNL 图表,mnl_ui.R +Please select a mnl regression plot from the drop-down menu,请从下拉菜单中选择一个 MNL 回归图,mnl_ui.R +Choose base level:,选择基准水平：,mnl_ui.R +Variable importance,变量重要性,naivebayes_ui.R +Naive Bayes,朴素贝叶斯,naivebayes_ui.R +Laplace:,拉普拉斯修正：,naivebayes_ui.R +Save naive Bayes prediction plot,保存朴素贝叶斯预测图,naivebayes_ui.R +Save naive Bayes plot,保存朴素贝叶斯图,naivebayes_ui.R +Please select a naive Bayes plot from the drop-down menu,请从下拉菜单中选择一个朴素贝叶斯图,naivebayes_ui.R +All levels,所有水平,naivebayes_ui.R +Network,网络结构,nn_ui.R +Olden,节点权重贡献图（Olden 方法）,nn_ui.R +Garson,输入变量重要性图（Garson 方法）,nn_ui.R +Neural Network,神经网络,nn_ui.R +Regression,回归,nn_ui.R +Size:,大小：,nn_ui.R +Decay:,衰减：,nn_ui.R +Save neural network prediction plot,保存神经网络预测图,nn_ui.R +Save neural network plot,保存神经网络图,nn_ui.R +Please select a neural network plot from the drop-down menu,请从下拉菜单中选择一种神经网络图,nn_ui.R +RMSE,均方根误差,regress_ui.R +Sum of squares,平方和,regress_ui.R +Line,线性,regress_ui.R +Loess,局部加权回归（Loess）,regress_ui.R +Jitter,扰动点（Jitter）,regress_ui.R +Residual vs explanatory,残差对解释变量图,regress_ui.R +Coefficient plot,系数图,regress_ui.R +Linear regression (OLS),线性回归（最小二乘法）,regress_ui.R +Save regression predictions,保存回归预测结果,regress_ui.R +Save regression plot,保存回归图表,regress_ui.R +Please select one or more explanatory variables. Then press the Estimate\nbutton to estimate the model.,请选择一个或多个解释变量，然后点击“估计模型”按钮。,regress_ui.R +Save regression prediction plot,保存回归预测图,regress_ui.R +Please select a regression plot from the drop-down menu,请从下拉菜单中选择一个回归图,regress_ui.R +Random Forest,随机森林,rforest_ui.R +mtry:,mtry：特征子集数,rforest_ui.R +# trees:,树数量：,rforest_ui.R +Min node size:,最小节点样本数：,rforest_ui.R +Sample fraction:,样本抽样比例：,rforest_ui.R +Save random forest plot,保存随机森林图,rforest_ui.R +Binomial,二项分布,simulater_ui.R +Discrete,离散分布,simulater_ui.R +Log normal,对数正态分布,simulater_ui.R +Normal,正态分布,simulater_ui.R +Poisson,泊松分布,simulater_ui.R +Uniform,均匀分布,simulater_ui.R +Constant,常数,simulater_ui.R +Grid search,网格搜索,simulater_ui.R +Sequence,序列,simulater_ui.R +Run simulation,运行模拟,simulater_ui.R +Repeat simulation,重复模拟,simulater_ui.R +Simulate,模拟,simulater_ui.R +,,simulater_ui.R +"Use formulas to perform calculations on simulated variables +(e.g., demand = 5 * price). Press the Run simulation button +to run the simulation. Click the ? icon on the bottom left +of your screen for help and examples",使用公式对模拟变量进行计算（例如：demand = 5 * price）。点击“运行模拟”按钮开始模拟。点击左下角的问号图标查看帮助和示例。,simulater_ui.R +
    ,
    ,simulater_ui.R +"Create your own R functions (e.g., add = function(x, y) {x + y}). +Call these functions from the 'formula' input and press the Run +simulation button to run the simulation. Click the ? icon on the +bottom left of your screen for help and examples","创建你自己的 R 函数（例如：add = function(x, y) {x + y}）。在“公式”输入框中调用这些函数并点击“运行模拟”按钮。点击左下角的问号图标查看帮助和示例。",simulater_ui.R +Repeat,重复,simulater_ui.R +,,simulater_ui.R +"Press the Repeat simulation button to repeat the simulation specified in the +Simulate tab. Use formulas to perform additional calculations on the repeated +simulation data. Click the ? icon on the bottom left of your screen for help +and examples",点击“重复模拟”按钮，对“模拟”页中指定的模拟进行重复执行。你可以使用公式对重复模拟的数据执行额外计算。点击左下角的问号图标查看帮助和示例。,simulater_ui.R +
    ,
    ,simulater_ui.R +
    ,
    ,simulater_ui.R +
    ,
    ,simulater_ui.R +Model > Decide,建模 > 决策,simulater_ui.R +Name:,名称：,simulater_ui.R +n:,n：,simulater_ui.R +p:,p：,simulater_ui.R +Value:,数值：,simulater_ui.R +Values:,数值：,simulater_ui.R +Prob.:,概率：,simulater_ui.R +Mean:,均值：,simulater_ui.R +St.dev.:,标准差：,simulater_ui.R +Use exact specifications,使用精确指定,simulater_ui.R +Correlations:,相关性：,simulater_ui.R +Set random seed:,设置随机种子：,simulater_ui.R +# sims:,模拟次数：,simulater_ui.R +Simulated data:,模拟数据：,simulater_ui.R +Decimals:,小数位数：,simulater_ui.R +Add functions,添加函数,simulater_ui.R +** Press the Run simulation button to simulate data **,** 请点击“运行模拟”按钮以生成数据 **,simulater_ui.R +Select types,选择类型,simulater_ui.R +Select types:,选择类型：,simulater_ui.R +Save simulation plots,保存模拟图表,simulater_ui.R +** Press the Repeat simulation button **,** 请点击“重复模拟”按钮 **,simulater_ui.R +Select group-by variable,选择分组变量,simulater_ui.R +Group by:,分组变量：,simulater_ui.R +sum,求和,simulater_ui.R +mean,均值,simulater_ui.R +median,中位数,simulater_ui.R +min,最小值,simulater_ui.R +max,最大值,simulater_ui.R +sd,标准差,simulater_ui.R +var,方差,simulater_ui.R +sdprop,标准差比例,simulater_ui.R +varprop,方差比例,simulater_ui.R +p01,第1百分位数,simulater_ui.R +p025,第2.5百分位数,simulater_ui.R +p05,第5百分位数,simulater_ui.R +p10,第10百分位数,simulater_ui.R +p25,第25百分位数,simulater_ui.R +p75,第75百分位数,simulater_ui.R +p90,第90百分位数,simulater_ui.R +p95,第95百分位数,simulater_ui.R +p975,第97.5百分位数,simulater_ui.R +p99,第99百分位数,simulater_ui.R +first,第一个值,simulater_ui.R +last,最后一个值,simulater_ui.R +Apply function:,应用函数：,simulater_ui.R +Provide values in the input boxes above and then press the + symbol,请在上方输入框中填写数值，然后点击加号按钮,simulater_ui.R +Lambda:,λ：,simulater_ui.R +# reps:,重复次数：,simulater_ui.R +Repeat data:,重复模拟数据：,simulater_ui.R +No formulas or simulated variables specified,未指定任何公式或模拟变量,simulater_ui.R +Running simulation,正在运行模拟,simulater_ui.R +Generating simulation plots,正在生成模拟图表,simulater_ui.R +
    ,
    ,simulater_ui.R +
    ,
    ,simulater_ui.R +Re-run simulation,重新运行模拟,simulater_ui.R +Simulation,模拟,simulater_ui.R +Binomial variables:, "二项变量：", "simulater_ui.R" +Grid search:, "网格搜索：", "simulater_ui.R" +Remove variable, "删除变量", "simulater_ui.R" +Save repeated simulation plots, "保存重复模拟图", "simulater_ui.R" +Inputs required, "需要输入", "simulater_ui.R" +Select at least one Output variable, "请至少选择一个输出变量", "simulater_ui.R" +Constant variables,常量变量,simulater_ui.R +Discrete variables,离散变量,simulater_ui.R +Log-normal variables,对数正态变量,simulater_ui.R +Normal variables,正态变量,simulater_ui.R +Poisson variables,泊松变量,simulater_ui.R +Uniform variables,均匀变量,simulater_ui.R +Sequence variables,序列变量,simulater_ui.R +Model,模型,init.R +Estimate,估计,init.R +Linear regression (OLS),线性回归（普通最小二乘法）,init.R +Logistic regression (GLM),逻辑回归（广义线性模型）,init.R +Multinomial logistic regression (MNL),多项逻辑回归,init.R +Naive Bayes,朴素贝叶斯,init.R +Neural Network,神经网络,init.R +Trees,树模型,init.R +Classification and regression trees,分类与回归树,init.R +Random Forest,随机森林,init.R +Gradient Boosted Trees,梯度提升树,init.R +Evaluate,评估,init.R +Evaluate regression,回归模型评估,init.R +Evaluate classification,分类模型评估,init.R +Recommend,推荐,init.R +Collaborative Filtering,协同过滤,init.R +Decide,决策,init.R +Decision analysis,决策分析,init.R +Simulate,模拟,init.R diff --git a/radiant.model/man/MAE.Rd b/radiant.model/man/MAE.Rd new file mode 100644 index 0000000000000000000000000000000000000000..23df96bc65f494536797bdf0fd903b8fec489dcd --- /dev/null +++ b/radiant.model/man/MAE.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/evalreg.R +\name{MAE} +\alias{MAE} +\title{Mean Absolute Error} +\usage{ +MAE(pred, rvar) +} +\arguments{ +\item{pred}{Prediction (vector)} + +\item{rvar}{Response (vector)} +} +\value{ +Mean Absolute Error +} +\description{ +Mean Absolute Error +} diff --git a/radiant.model/man/RMSE.Rd b/radiant.model/man/RMSE.Rd new file mode 100644 index 0000000000000000000000000000000000000000..54aaff132ed0ffa76a155eb4fa7754ec82d31a48 --- /dev/null +++ b/radiant.model/man/RMSE.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/evalreg.R +\name{RMSE} +\alias{RMSE} +\title{Root Mean Squared Error} +\usage{ +RMSE(pred, rvar) +} +\arguments{ +\item{pred}{Prediction (vector)} + +\item{rvar}{Response (vector)} +} +\value{ +Root Mean Squared Error +} +\description{ +Root Mean Squared Error +} diff --git a/radiant.model/man/Rsq.Rd b/radiant.model/man/Rsq.Rd new file mode 100644 index 0000000000000000000000000000000000000000..01a37146a871ce3fdf574c1d4bced3ef3db79c78 --- /dev/null +++ b/radiant.model/man/Rsq.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/evalreg.R +\name{Rsq} +\alias{Rsq} +\title{R-squared} +\usage{ +Rsq(pred, rvar) +} +\arguments{ +\item{pred}{Prediction (vector)} + +\item{rvar}{Response (vector)} +} +\value{ +R-squared +} +\description{ +R-squared +} diff --git a/radiant.model/man/auc.Rd b/radiant.model/man/auc.Rd new file mode 100644 index 0000000000000000000000000000000000000000..9cd62eb489caeee8b0180ddb032da4c7e92e32e2 --- /dev/null +++ b/radiant.model/man/auc.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/evalbin.R +\name{auc} +\alias{auc} +\title{Area Under the RO Curve (AUC)} +\usage{ +auc(pred, rvar, lev) +} +\arguments{ +\item{pred}{Prediction or predictor} + +\item{rvar}{Response variable} + +\item{lev}{The level in the response variable defined as success} +} +\value{ +AUC statistic +} +\description{ +Area Under the RO Curve (AUC) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +} +\examples{ +auc(runif(20000), dvd$buy, "yes") +auc(ifelse(dvd$buy == "yes", 1, 0), dvd$buy, "yes") +} +\seealso{ +\code{\link{evalbin}} to calculate results + +\code{\link{summary.evalbin}} to summarize results + +\code{\link{plot.evalbin}} to plot results +} diff --git a/radiant.model/man/catalog.Rd b/radiant.model/man/catalog.Rd new file mode 100644 index 0000000000000000000000000000000000000000..b2b8479974b239d2f41acfb78b897e3f95a25b20 --- /dev/null +++ b/radiant.model/man/catalog.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{catalog} +\alias{catalog} +\title{Catalog sales for men's and women's apparel} +\format{ +A data frame with 200 rows and 5 variables +} +\usage{ +data(catalog) +} +\description{ +Catalog sales for men's and women's apparel +} +\details{ +Description provided in attr(catalog, "description") +} +\keyword{datasets} diff --git a/radiant.model/man/confint_robust.Rd b/radiant.model/man/confint_robust.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a6463dd212b4d4e88ca1a0a22bf4d8c84a364f7b --- /dev/null +++ b/radiant.model/man/confint_robust.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/logistic.R +\name{confint_robust} +\alias{confint_robust} +\title{Confidence interval for robust estimators} +\usage{ +confint_robust(object, level = 0.95, dist = "norm", vcov = NULL, ...) +} +\arguments{ +\item{object}{A fitted model object} + +\item{level}{The confidence level required} + +\item{dist}{Distribution to use ("norm" or "t")} + +\item{vcov}{Covariance matrix generated by, e.g., sandwich::vcovHC} + +\item{...}{Additional argument(s) for methods} +} +\description{ +Confidence interval for robust estimators +} +\details{ +Wrapper for confint with robust standard errors. See \url{https://stackoverflow.com/questions/3817182/vcovhc-and-confidence-interval/3820125#3820125} +} diff --git a/radiant.model/man/confusion.Rd b/radiant.model/man/confusion.Rd new file mode 100644 index 0000000000000000000000000000000000000000..14a9f39ef373b4e9e73e11f9b9302c71a6cb6309 --- /dev/null +++ b/radiant.model/man/confusion.Rd @@ -0,0 +1,68 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/evalbin.R +\name{confusion} +\alias{confusion} +\title{Confusion matrix} +\usage{ +confusion( + dataset, + pred, + rvar, + lev = "", + cost = 1, + margin = 2, + scale = 1, + train = "All", + data_filter = "", + arr = "", + rows = NULL, + envir = parent.frame(), + ... +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{pred}{Predictions or predictors} + +\item{rvar}{Response variable} + +\item{lev}{The level in the response variable defined as success} + +\item{cost}{Cost for each connection (e.g., email or mailing)} + +\item{margin}{Margin on each customer purchase} + +\item{scale}{Scaling factor to apply to calculations} + +\item{train}{Use data from training ("Training"), test ("Test"), both ("Both"), or all data ("All") to evaluate model evalbin} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{arr}{Expression to arrange (sort) the data on (e.g., "color, desc(price)")} + +\item{rows}{Rows to select from the specified dataset} + +\item{envir}{Environment to extract data from} + +\item{...}{further arguments passed to or from other methods} +} +\value{ +A list of results +} +\description{ +Confusion matrix +} +\details{ +Confusion matrix and additional metrics to evaluate binary classification models. See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +} +\examples{ +data.frame(buy = dvd$buy, pred1 = runif(20000), pred2 = ifelse(dvd$buy == "yes", 1, 0)) \%>\% + confusion(c("pred1", "pred2"), "buy") \%>\% + str() +} +\seealso{ +\code{\link{summary.confusion}} to summarize results + +\code{\link{plot.confusion}} to plot results +} diff --git a/radiant.model/man/coxp.Rd b/radiant.model/man/coxp.Rd new file mode 100644 index 0000000000000000000000000000000000000000..8aa57f92a4143ac0a09f039ee6b0226477f72ba9 --- /dev/null +++ b/radiant.model/man/coxp.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cox.R +\name{coxp} +\alias{coxp} +\title{Cox Proportional Hazards Regression (minimal)} +\usage{ +coxp( + dataset, + time, + status, + evar, + int = "", + check = "", + form, + data_filter = "", + arr = "", + rows = NULL, + envir = parent.frame() +) +} +\description{ +Cox Proportional Hazards Regression (minimal) +} diff --git a/radiant.model/man/crs.Rd b/radiant.model/man/crs.Rd new file mode 100644 index 0000000000000000000000000000000000000000..abf414ccbbff2ffa4bcb0dab1d2ce1fcca1e6a54 --- /dev/null +++ b/radiant.model/man/crs.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/crs.R +\name{crs} +\alias{crs} +\title{Collaborative Filtering} +\usage{ +crs( + dataset, + id, + prod, + pred, + rate, + data_filter = "", + arr = "", + rows = NULL, + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{id}{String with name of the variable containing user ids} + +\item{prod}{String with name of the variable with product ids} + +\item{pred}{Products to predict for} + +\item{rate}{String with name of the variable with product ratings} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "training == 1")} + +\item{arr}{Expression to arrange (sort) the data on (e.g., "color, desc(price)")} + +\item{rows}{Rows to select from the specified dataset} + +\item{envir}{Environment to extract data from} +} +\value{ +A data.frame with the original data and a new column with predicted ratings +} +\description{ +Collaborative Filtering +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/crs.html} for an example in Radiant +} +\examples{ +crs(ratings, + id = "Users", prod = "Movies", pred = c("M6", "M7", "M8", "M9", "M10"), + rate = "Ratings", data_filter = "training == 1" +) \%>\% str() +} +\seealso{ +\code{\link{summary.crs}} to summarize results + +\code{\link{plot.crs}} to plot results if the actual ratings are available +} diff --git a/radiant.model/man/crtree.Rd b/radiant.model/man/crtree.Rd new file mode 100644 index 0000000000000000000000000000000000000000..0ed700ae770568281e3ce8b66d78113c0879a4a1 --- /dev/null +++ b/radiant.model/man/crtree.Rd @@ -0,0 +1,100 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/crtree.R +\name{crtree} +\alias{crtree} +\title{Classification and regression trees based on the rpart package} +\usage{ +crtree( + dataset, + rvar, + evar, + type = "", + lev = "", + wts = "None", + minsplit = 2, + minbucket = round(minsplit/3), + cp = 0.001, + pcp = NA, + nodes = NA, + K = 10, + seed = 1234, + split = "gini", + prior = NA, + adjprob = TRUE, + cost = NA, + margin = NA, + check = "", + data_filter = "", + arr = "", + rows = NULL, + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{rvar}{The response variable in the model} + +\item{evar}{Explanatory variables in the model} + +\item{type}{Model type (i.e., "classification" or "regression")} + +\item{lev}{The level in the response variable defined as _success_} + +\item{wts}{Weights to use in estimation} + +\item{minsplit}{The minimum number of observations that must exist in a node in order for a split to be attempted.} + +\item{minbucket}{the minimum number of observations in any terminal node. If only one of minbucket or minsplit is specified, the code either sets minsplit to minbucket*3 or minbucket to minsplit/3, as appropriate.} + +\item{cp}{Minimum proportion of root node deviance required for split (default = 0.001)} + +\item{pcp}{Complexity parameter to use for pruning} + +\item{nodes}{Maximum size of tree in number of nodes to return} + +\item{K}{Number of folds use in cross-validation} + +\item{seed}{Random seed used for cross-validation} + +\item{split}{Splitting criterion to use (i.e., "gini" or "information")} + +\item{prior}{Adjust the initial probability for the selected level (e.g., set to .5 in unbalanced samples)} + +\item{adjprob}{Setting a prior will rescale the predicted probabilities. Set adjprob to TRUE to adjust the probabilities back to their original scale after estimation} + +\item{cost}{Cost for each treatment (e.g., mailing)} + +\item{margin}{Margin associated with a successful treatment (e.g., a purchase)} + +\item{check}{Optional estimation parameters (e.g., "standardize")} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{arr}{Expression to arrange (sort) the data on (e.g., "color, desc(price)")} + +\item{rows}{Rows to select from the specified dataset} + +\item{envir}{Environment to extract data from} +} +\value{ +A list with all variables defined in crtree as an object of class tree +} +\description{ +Classification and regression trees based on the rpart package +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/crtree.html} for an example in Radiant +} +\examples{ +crtree(titanic, "survived", c("pclass", "sex"), lev = "Yes") \%>\% summary() +result <- crtree(titanic, "survived", c("pclass", "sex")) \%>\% summary() +result <- crtree(diamonds, "price", c("carat", "clarity"), type = "regression") \%>\% str() +} +\seealso{ +\code{\link{summary.crtree}} to summarize results + +\code{\link{plot.crtree}} to plot results + +\code{\link{predict.crtree}} for prediction +} diff --git a/radiant.model/man/cv.crtree.Rd b/radiant.model/man/cv.crtree.Rd new file mode 100644 index 0000000000000000000000000000000000000000..9e7235ba8a24d015af1f81f38c9c8eb785cb4918 --- /dev/null +++ b/radiant.model/man/cv.crtree.Rd @@ -0,0 +1,69 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/crtree.R +\name{cv.crtree} +\alias{cv.crtree} +\title{Cross-validation for Classification and Regression Trees} +\usage{ +cv.crtree( + object, + K = 5, + repeats = 1, + cp, + pcp = seq(0, 0.01, length.out = 11), + seed = 1234, + trace = TRUE, + fun, + ... +) +} +\arguments{ +\item{object}{Object of type "rpart" or "crtree" to use as a starting point for cross validation} + +\item{K}{Number of cross validation passes to use} + +\item{repeats}{Number of times to repeat the K cross-validation steps} + +\item{cp}{Complexity parameter used when building the (e.g., 0.0001)} + +\item{pcp}{Complexity parameter to use for pruning} + +\item{seed}{Random seed to use as the starting point} + +\item{trace}{Print progress} + +\item{fun}{Function to use for model evaluation (e.g., auc for classification or RMSE for regression)} + +\item{...}{Additional arguments to be passed to 'fun'} +} +\value{ +A data.frame sorted by the mean, sd, min, and max of the performance metric +} +\description{ +Cross-validation for Classification and Regression Trees +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/crtree.html} for an example in Radiant +} +\examples{ +\dontrun{ +result <- crtree(dvd, "buy", c("coupon", "purch", "last")) +cv.crtree(result, cp = 0.0001, pcp = seq(0, 0.01, length.out = 11)) +cv.crtree(result, cp = 0.0001, pcp = c(0, 0.001, 0.002), fun = profit, cost = 1, margin = 5) +result <- crtree(diamonds, "price", c("carat", "color", "clarity"), type = "regression", cp = 0.001) +cv.crtree(result, cp = 0.001, pcp = seq(0, 0.01, length.out = 11), fun = MAE) +} + +} +\seealso{ +\code{\link{crtree}} to generate an initial model that can be passed to cv.crtree + +\code{\link{Rsq}} to calculate an R-squared measure for a regression + +\code{\link{RMSE}} to calculate the Root Mean Squared Error for a regression + +\code{\link{MAE}} to calculate the Mean Absolute Error for a regression + +\code{\link{auc}} to calculate the area under the ROC curve for classification + +\code{\link{profit}} to calculate profits for classification at a cost/margin threshold +} diff --git a/radiant.model/man/cv.gbt.Rd b/radiant.model/man/cv.gbt.Rd new file mode 100644 index 0000000000000000000000000000000000000000..bd8735fdeaed70b23a46ed2b7d44dcd53fb93c6a --- /dev/null +++ b/radiant.model/man/cv.gbt.Rd @@ -0,0 +1,91 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gbt.R +\name{cv.gbt} +\alias{cv.gbt} +\title{Cross-validation for Gradient Boosted Trees} +\usage{ +cv.gbt( + object, + K = 5, + repeats = 1, + params = list(), + nrounds = 500, + early_stopping_rounds = 10, + nthread = 12, + train = NULL, + type = "classification", + trace = TRUE, + seed = 1234, + maximize = NULL, + fun, + ... +) +} +\arguments{ +\item{object}{Object of type "gbt" or "ranger"} + +\item{K}{Number of cross validation passes to use (aka nfold)} + +\item{repeats}{Repeated cross validation} + +\item{params}{List of parameters (see XGBoost documentation)} + +\item{nrounds}{Number of trees to create} + +\item{early_stopping_rounds}{Early stopping rule} + +\item{nthread}{Number of parallel threads to use. Defaults to 12 if available} + +\item{train}{An optional xgb.DMatrix object containing the original training data. Not needed when using Radiant's gbt function} + +\item{type}{Model type ("classification" or "regression")} + +\item{trace}{Print progress} + +\item{seed}{Random seed to use as the starting point} + +\item{maximize}{When a custom function is used, xgb.cv requires the user indicate if the function output should be maximized (TRUE) or minimized (FALSE)} + +\item{fun}{Function to use for model evaluation (i.e., auc for classification and RMSE for regression)} + +\item{...}{Additional arguments to be passed to 'fun'} +} +\value{ +A data.frame sorted by the mean of the performance metric +} +\description{ +Cross-validation for Gradient Boosted Trees +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/gbt.html} for an example in Radiant +} +\examples{ +\dontrun{ +result <- gbt(dvd, "buy", c("coupon", "purch", "last")) +cv.gbt(result, params = list(max_depth = 1:6)) +cv.gbt(result, params = list(max_depth = 1:6), fun = "logloss") +cv.gbt( + result, + params = list(learning_rate = seq(0.1, 1.0, 0.1)), + maximize = TRUE, fun = profit, cost = 1, margin = 5 +) +result <- gbt(diamonds, "price", c("carat", "color", "clarity"), type = "regression") +cv.gbt(result, params = list(max_depth = 1:2, min_child_weight = 1:2)) +cv.gbt(result, params = list(learning_rate = seq(0.1, 0.5, 0.1)), fun = Rsq, maximize = TRUE) +cv.gbt(result, params = list(learning_rate = seq(0.1, 0.5, 0.1)), fun = MAE, maximize = FALSE) +} + +} +\seealso{ +\code{\link{gbt}} to generate an initial model that can be passed to cv.gbt + +\code{\link{Rsq}} to calculate an R-squared measure for a regression + +\code{\link{RMSE}} to calculate the Root Mean Squared Error for a regression + +\code{\link{MAE}} to calculate the Mean Absolute Error for a regression + +\code{\link{auc}} to calculate the area under the ROC curve for classification + +\code{\link{profit}} to calculate profits for classification at a cost/margin threshold +} diff --git a/radiant.model/man/cv.nn.Rd b/radiant.model/man/cv.nn.Rd new file mode 100644 index 0000000000000000000000000000000000000000..5734a164f23c023d2c318a5cff68f193a357bf10 --- /dev/null +++ b/radiant.model/man/cv.nn.Rd @@ -0,0 +1,70 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nn.R +\name{cv.nn} +\alias{cv.nn} +\title{Cross-validation for a Neural Network} +\usage{ +cv.nn( + object, + K = 5, + repeats = 1, + decay = seq(0, 1, 0.2), + size = 1:5, + seed = 1234, + trace = TRUE, + fun, + ... +) +} +\arguments{ +\item{object}{Object of type "nn" or "nnet"} + +\item{K}{Number of cross validation passes to use} + +\item{repeats}{Repeated cross validation} + +\item{decay}{Parameter decay} + +\item{size}{Number of units (nodes) in the hidden layer} + +\item{seed}{Random seed to use as the starting point} + +\item{trace}{Print progress} + +\item{fun}{Function to use for model evaluation (i.e., auc for classification and RMSE for regression)} + +\item{...}{Additional arguments to be passed to 'fun'} +} +\value{ +A data.frame sorted by the mean of the performance metric +} +\description{ +Cross-validation for a Neural Network +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/nn.html} for an example in Radiant +} +\examples{ +\dontrun{ +result <- nn(dvd, "buy", c("coupon", "purch", "last")) +cv.nn(result, decay = seq(0, 1, .5), size = 1:2) +cv.nn(result, decay = seq(0, 1, .5), size = 1:2, fun = profit, cost = 1, margin = 5) +result <- nn(diamonds, "price", c("carat", "color", "clarity"), type = "regression") +cv.nn(result, decay = seq(0, 1, .5), size = 1:2) +cv.nn(result, decay = seq(0, 1, .5), size = 1:2, fun = Rsq) +} + +} +\seealso{ +\code{\link{nn}} to generate an initial model that can be passed to cv.nn + +\code{\link{Rsq}} to calculate an R-squared measure for a regression + +\code{\link{RMSE}} to calculate the Root Mean Squared Error for a regression + +\code{\link{MAE}} to calculate the Mean Absolute Error for a regression + +\code{\link{auc}} to calculate the area under the ROC curve for classification + +\code{\link{profit}} to calculate profits for classification at a cost/margin threshold +} diff --git a/radiant.model/man/cv.rforest.Rd b/radiant.model/man/cv.rforest.Rd new file mode 100644 index 0000000000000000000000000000000000000000..5d3b53618410545d82e642ea7fa071e1f2304a98 --- /dev/null +++ b/radiant.model/man/cv.rforest.Rd @@ -0,0 +1,82 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rforest.R +\name{cv.rforest} +\alias{cv.rforest} +\title{Cross-validation for a Random Forest} +\usage{ +cv.rforest( + object, + K = 5, + repeats = 1, + mtry = 1:5, + num.trees = NULL, + min.node.size = 1, + sample.fraction = NA, + trace = TRUE, + seed = 1234, + fun, + ... +) +} +\arguments{ +\item{object}{Object of type "rforest" or "ranger"} + +\item{K}{Number of cross validation passes to use} + +\item{repeats}{Repeated cross validation} + +\item{mtry}{Number of variables to possibly split at in each node. Default is the (rounded down) square root of the number variables} + +\item{num.trees}{Number of trees to create} + +\item{min.node.size}{Minimal node size} + +\item{sample.fraction}{Fraction of observations to sample. Default is 1 for sampling with replacement and 0.632 for sampling without replacement} + +\item{trace}{Print progress} + +\item{seed}{Random seed to use as the starting point} + +\item{fun}{Function to use for model evaluation (i.e., auc for classification and RMSE for regression)} + +\item{...}{Additional arguments to be passed to 'fun'} +} +\value{ +A data.frame sorted by the mean of the performance metric +} +\description{ +Cross-validation for a Random Forest +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/rforest.html} for an example in Radiant +} +\examples{ +\dontrun{ +result <- rforest(dvd, "buy", c("coupon", "purch", "last")) +cv.rforest( + result, + mtry = 1:3, min.node.size = seq(1, 10, 5), + num.trees = c(100, 200), sample.fraction = 0.632 +) +result <- rforest(titanic, "survived", c("pclass", "sex"), max.depth = 1) +cv.rforest(result, mtry = 1:3, min.node.size = seq(1, 10, 5)) +cv.rforest(result, mtry = 1:3, num.trees = c(100, 200), fun = profit, cost = 1, margin = 5) +result <- rforest(diamonds, "price", c("carat", "color", "clarity"), type = "regression") +cv.rforest(result, mtry = 1:3, min.node.size = 1) +cv.rforest(result, mtry = 1:3, min.node.size = 1, fun = Rsq) +} + +} +\seealso{ +\code{\link{rforest}} to generate an initial model that can be passed to cv.rforest + +\code{\link{Rsq}} to calculate an R-squared measure for a regression + +\code{\link{RMSE}} to calculate the Root Mean Squared Error for a regression + +\code{\link{MAE}} to calculate the Mean Absolute Error for a regression + +\code{\link{auc}} to calculate the area under the ROC curve for classification + +\code{\link{profit}} to calculate profits for classification at a cost/margin threshold +} diff --git a/radiant.model/man/direct_marketing.Rd b/radiant.model/man/direct_marketing.Rd new file mode 100644 index 0000000000000000000000000000000000000000..acf742599a8c8cd4153b053de42deb90dfdbea55 --- /dev/null +++ b/radiant.model/man/direct_marketing.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{direct_marketing} +\alias{direct_marketing} +\title{Direct marketing data} +\format{ +A data frame with 1,000 rows and 12 variables +} +\usage{ +data(direct_marketing) +} +\description{ +Direct marketing data +} +\details{ +Description provided in attr(direct_marketing, "description") +} +\keyword{datasets} diff --git a/radiant.model/man/dot-as_int.Rd b/radiant.model/man/dot-as_int.Rd new file mode 100644 index 0000000000000000000000000000000000000000..ca425c34f0103426b032192e39bdd3be6e4cf885 --- /dev/null +++ b/radiant.model/man/dot-as_int.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simulater.R +\name{.as_int} +\alias{.as_int} +\title{Convenience function used in "simulater"} +\usage{ +.as_int(x, dataset = list()) +} +\arguments{ +\item{x}{Character vector to be converted to integer} + +\item{dataset}{Data list} +} +\value{ +An integer vector +} +\description{ +Convenience function used in "simulater" +} diff --git a/radiant.model/man/dot-as_num.Rd b/radiant.model/man/dot-as_num.Rd new file mode 100644 index 0000000000000000000000000000000000000000..e99e777b546125fbcdb5c9828f6a27e5a283a1f8 --- /dev/null +++ b/radiant.model/man/dot-as_num.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simulater.R +\name{.as_num} +\alias{.as_num} +\title{Convenience function used in "simulater"} +\usage{ +.as_num(x, dataset = list()) +} +\arguments{ +\item{x}{Character vector to be converted to an numeric value} + +\item{dataset}{Data list} +} +\value{ +An numeric vector +} +\description{ +Convenience function used in "simulater" +} diff --git a/radiant.model/man/dtree.Rd b/radiant.model/man/dtree.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a6aba49a69da01056e5cd6eb445dae40ac8d2786 --- /dev/null +++ b/radiant.model/man/dtree.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dtree.R +\name{dtree} +\alias{dtree} +\title{Create a decision tree} +\usage{ +dtree(yl, opt = "max", base = character(0), envir = parent.frame()) +} +\arguments{ +\item{yl}{A yaml string or a list (e.g., from yaml::yaml.load_file())} + +\item{opt}{Find the maximum ("max") or minimum ("min") value for each decision node} + +\item{base}{List of variable definitions from a base tree used when calling a sub-tree} + +\item{envir}{Environment to extract data from} +} +\value{ +A list with the initial tree, the calculated tree, and a data.frame with results (i.e., payoffs, probabilities, etc.) +} +\description{ +Create a decision tree +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/dtree.html} for an example in Radiant +} +\examples{ +yaml::as.yaml(movie_contract) \%>\% cat() +dtree(movie_contract, opt = "max") \%>\% summary(output = TRUE) +dtree(movie_contract)$payoff +dtree(movie_contract)$prob +dtree(movie_contract)$solution_df + +} +\seealso{ +\code{\link{summary.dtree}} to summarize results + +\code{\link{plot.dtree}} to plot results + +\code{\link{sensitivity.dtree}} to plot results +} diff --git a/radiant.model/man/dtree_parser.Rd b/radiant.model/man/dtree_parser.Rd new file mode 100644 index 0000000000000000000000000000000000000000..9d94b24f6a49293f5473301b95bb0c588d556881 --- /dev/null +++ b/radiant.model/man/dtree_parser.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dtree.R +\name{dtree_parser} +\alias{dtree_parser} +\title{Parse yaml input for dtree to provide (more) useful error messages} +\usage{ +dtree_parser(yl) +} +\arguments{ +\item{yl}{A yaml string} +} +\value{ +An updated yaml string or a vector messages to return to the users +} +\description{ +Parse yaml input for dtree to provide (more) useful error messages +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/dtree.html} for an example in Radiant +} +\seealso{ +\code{\link{dtree}} to calculate tree + +\code{\link{summary.dtree}} to summarize results + +\code{\link{plot.dtree}} to plot results +} diff --git a/radiant.model/man/dvd.Rd b/radiant.model/man/dvd.Rd new file mode 100644 index 0000000000000000000000000000000000000000..0b48cb63c95176987d5b001d51a42171df4a08d2 --- /dev/null +++ b/radiant.model/man/dvd.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{dvd} +\alias{dvd} +\title{Data on DVD sales} +\format{ +A data frame with 20,000 rows and 4 variables +} +\usage{ +data(dvd) +} +\description{ +Data on DVD sales +} +\details{ +Binary purchase response to coupon value. Description provided in attr(dvd,"description") +} +\keyword{datasets} diff --git a/radiant.model/man/evalbin.Rd b/radiant.model/man/evalbin.Rd new file mode 100644 index 0000000000000000000000000000000000000000..ded81c1dcd4f74a58b91131197028ef29e44abf5 --- /dev/null +++ b/radiant.model/man/evalbin.Rd @@ -0,0 +1,68 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/evalbin.R +\name{evalbin} +\alias{evalbin} +\title{Evaluate the performance of different (binary) classification models} +\usage{ +evalbin( + dataset, + pred, + rvar, + lev = "", + qnt = 10, + cost = 1, + margin = 2, + scale = 1, + train = "All", + data_filter = "", + arr = "", + rows = NULL, + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{pred}{Predictions or predictors} + +\item{rvar}{Response variable} + +\item{lev}{The level in the response variable defined as success} + +\item{qnt}{Number of bins to create} + +\item{cost}{Cost for each connection (e.g., email or mailing)} + +\item{margin}{Margin on each customer purchase} + +\item{scale}{Scaling factor to apply to calculations} + +\item{train}{Use data from training ("Training"), test ("Test"), both ("Both"), or all data ("All") to evaluate model evalbin} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{arr}{Expression to arrange (sort) the data on (e.g., "color, desc(price)")} + +\item{rows}{Rows to select from the specified dataset} + +\item{envir}{Environment to extract data from} +} +\value{ +A list of results +} +\description{ +Evaluate the performance of different (binary) classification models +} +\details{ +Evaluate different (binary) classification models based on predictions. See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +} +\examples{ +data.frame(buy = dvd$buy, pred1 = runif(20000), pred2 = ifelse(dvd$buy == "yes", 1, 0)) \%>\% + evalbin(c("pred1", "pred2"), "buy") \%>\% + str() +} +\seealso{ +\code{\link{summary.evalbin}} to summarize results + +\code{\link{plot.evalbin}} to plot results +} diff --git a/radiant.model/man/evalreg.Rd b/radiant.model/man/evalreg.Rd new file mode 100644 index 0000000000000000000000000000000000000000..72be5c5f562573e99cb107efb1b614eb32a55e56 --- /dev/null +++ b/radiant.model/man/evalreg.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/evalreg.R +\name{evalreg} +\alias{evalreg} +\title{Evaluate the performance of different regression models} +\usage{ +evalreg( + dataset, + pred, + rvar, + train = "All", + data_filter = "", + arr = "", + rows = NULL, + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{pred}{Predictions or predictors} + +\item{rvar}{Response variable} + +\item{train}{Use data from training ("Training"), test ("Test"), both ("Both"), or all data ("All") to evaluate model evalreg} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "training == 1")} + +\item{arr}{Expression to arrange (sort) the data on (e.g., "color, desc(price)")} + +\item{rows}{Rows to select from the specified dataset} + +\item{envir}{Environment to extract data from} +} +\value{ +A list of results +} +\description{ +Evaluate the performance of different regression models +} +\details{ +Evaluate different regression models based on predictions. See \url{https://radiant-rstats.github.io/docs/model/evalreg.html} for an example in Radiant +} +\examples{ +data.frame(price = diamonds$price, pred1 = rnorm(3000), pred2 = diamonds$price) \%>\% + evalreg(pred = c("pred1", "pred2"), "price") \%>\% + str() + +} +\seealso{ +\code{\link{summary.evalreg}} to summarize results + +\code{\link{plot.evalreg}} to plot results +} diff --git a/radiant.model/man/find_max.Rd b/radiant.model/man/find_max.Rd new file mode 100644 index 0000000000000000000000000000000000000000..94de36d2f8a7f508c950e46c99ccc55bb2320a5f --- /dev/null +++ b/radiant.model/man/find_max.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simulater.R +\name{find_max} +\alias{find_max} +\title{Find maximum value of a vector} +\usage{ +find_max(x, y) +} +\arguments{ +\item{x}{Variable to find the maximum for} + +\item{y}{Variable to find the value for at the maximum of var} +} +\value{ +Value of val at the maximum of var +} +\description{ +Find maximum value of a vector +} +\details{ +Find the value of y at the maximum value of x +} +\examples{ +find_max(1:10, 21:30) + +} diff --git a/radiant.model/man/find_min.Rd b/radiant.model/man/find_min.Rd new file mode 100644 index 0000000000000000000000000000000000000000..83c19acecac51504a9e69df61b44b08ee6b92e2c --- /dev/null +++ b/radiant.model/man/find_min.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simulater.R +\name{find_min} +\alias{find_min} +\title{Find minimum value of a vector} +\usage{ +find_min(x, y) +} +\arguments{ +\item{x}{Variable to find the minimum for} + +\item{y}{Variable to find the value for at the maximum of var} +} +\value{ +Value of val at the minimum of var +} +\description{ +Find minimum value of a vector +} +\details{ +Find the value of y at the minimum value of x +} +\examples{ +find_min(1:10, 21:30) + +} diff --git a/radiant.model/man/gbt.Rd b/radiant.model/man/gbt.Rd new file mode 100644 index 0000000000000000000000000000000000000000..91e058956a9414306b51250bc24e7dd7447457dc --- /dev/null +++ b/radiant.model/man/gbt.Rd @@ -0,0 +1,108 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gbt.R +\name{gbt} +\alias{gbt} +\title{Gradient Boosted Trees using XGBoost} +\usage{ +gbt( + dataset, + rvar, + evar, + type = "classification", + lev = "", + max_depth = 6, + learning_rate = 0.3, + min_split_loss = 0, + min_child_weight = 1, + subsample = 1, + nrounds = 100, + early_stopping_rounds = 10, + nthread = 12, + wts = "None", + seed = NA, + data_filter = "", + arr = "", + rows = NULL, + envir = parent.frame(), + ... +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{rvar}{The response variable in the model} + +\item{evar}{Explanatory variables in the model} + +\item{type}{Model type (i.e., "classification" or "regression")} + +\item{lev}{Level to use as the first column in prediction output} + +\item{max_depth}{Maximum 'depth' of tree} + +\item{learning_rate}{Learning rate (eta)} + +\item{min_split_loss}{Minimal improvement (gamma)} + +\item{min_child_weight}{Minimum number of instances allowed in each node} + +\item{subsample}{Subsample ratio of the training instances (0-1)} + +\item{nrounds}{Number of trees to create} + +\item{early_stopping_rounds}{Early stopping rule} + +\item{nthread}{Number of parallel threads to use. Defaults to 12 if available} + +\item{wts}{Weights to use in estimation} + +\item{seed}{Random seed to use as the starting point} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{arr}{Expression to arrange (sort) the data on (e.g., "color, desc(price)")} + +\item{rows}{Rows to select from the specified dataset} + +\item{envir}{Environment to extract data from} + +\item{...}{Further arguments to pass to xgboost} +} +\value{ +A list with all variables defined in gbt as an object of class gbt +} +\description{ +Gradient Boosted Trees using XGBoost +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/gbt.html} for an example in Radiant +} +\examples{ +\dontrun{ +gbt(titanic, "survived", c("pclass", "sex"), lev = "Yes") \%>\% summary() +gbt(titanic, "survived", c("pclass", "sex")) \%>\% str() +} +gbt( + titanic, "survived", c("pclass", "sex"), lev = "Yes", + early_stopping_rounds = 0, nthread = 1 +) \%>\% summary() +gbt( + titanic, "survived", c("pclass", "sex"), + early_stopping_rounds = 0, nthread = 1 +) \%>\% str() +gbt( + titanic, "survived", c("pclass", "sex"), + eval_metric = paste0("error@", 0.5 / 6), nthread = 1 +) \%>\% str() +gbt( + diamonds, "price", c("carat", "clarity"), type = "regression", nthread = 1 +) \%>\% summary() + +} +\seealso{ +\code{\link{summary.gbt}} to summarize results + +\code{\link{plot.gbt}} to plot results + +\code{\link{predict.gbt}} for prediction +} diff --git a/radiant.model/man/houseprices.Rd b/radiant.model/man/houseprices.Rd new file mode 100644 index 0000000000000000000000000000000000000000..5bbe840690bbf2068addf9b3724afa287a4364c7 --- /dev/null +++ b/radiant.model/man/houseprices.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{houseprices} +\alias{houseprices} +\title{Houseprices} +\format{ +A data frame with 128 home sales and 6 variables +} +\usage{ +data(houseprices) +} +\description{ +Houseprices +} +\details{ +Description provided in attr(houseprices, "description") +} +\keyword{datasets} diff --git a/radiant.model/man/ideal.Rd b/radiant.model/man/ideal.Rd new file mode 100644 index 0000000000000000000000000000000000000000..029f2199fd31771c8873e788fba94c06bcb4cae4 --- /dev/null +++ b/radiant.model/man/ideal.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{ideal} +\alias{ideal} +\title{Ideal data for linear regression} +\format{ +A data frame with 1,000 rows and 4 variables +} +\usage{ +data(ideal) +} +\description{ +Ideal data for linear regression +} +\details{ +Description provided in attr(ideal, "description") +} +\keyword{datasets} diff --git a/radiant.model/man/kaggle_uplift.Rd b/radiant.model/man/kaggle_uplift.Rd new file mode 100644 index 0000000000000000000000000000000000000000..0a360af02bc6a3f7d7286cc06f12f733ad445fde --- /dev/null +++ b/radiant.model/man/kaggle_uplift.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{kaggle_uplift} +\alias{kaggle_uplift} +\title{Kaggle uplift} +\format{ +A data frame with 1,000 rows and 22 variables +} +\usage{ +data(kaggle_uplift) +} +\description{ +Kaggle uplift +} +\details{ +Use uplift modeling to quantify the effectiveness of an experimental treatment +} +\keyword{datasets} diff --git a/radiant.model/man/ketchup.Rd b/radiant.model/man/ketchup.Rd new file mode 100644 index 0000000000000000000000000000000000000000..bb7db06765d98db32714d61691c6f8004a3b237d --- /dev/null +++ b/radiant.model/man/ketchup.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{ketchup} +\alias{ketchup} +\title{Data on ketchup choices} +\format{ +A data frame with 2,798 rows and 14 variables +} +\usage{ +data(ketchup) +} +\description{ +Data on ketchup choices +} +\details{ +Choice behavior for a sample of 300 individuals in a panel of households in Springfield, Missouri (USA). Description provided in attr(ketchup,"description") +} +\keyword{datasets} diff --git a/radiant.model/man/logistic.Rd b/radiant.model/man/logistic.Rd new file mode 100644 index 0000000000000000000000000000000000000000..026e7168d83ce0f3d178d5b54d9c7fe828e3d71f --- /dev/null +++ b/radiant.model/man/logistic.Rd @@ -0,0 +1,71 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/logistic.R +\name{logistic} +\alias{logistic} +\title{Logistic regression} +\usage{ +logistic( + dataset, + rvar, + evar, + lev = "", + int = "", + wts = "None", + check = "", + form, + ci_type, + data_filter = "", + arr = "", + rows = NULL, + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{rvar}{The response variable in the model} + +\item{evar}{Explanatory variables in the model} + +\item{lev}{The level in the response variable defined as _success_} + +\item{int}{Interaction term to include in the model} + +\item{wts}{Weights to use in estimation} + +\item{check}{Use "standardize" to see standardized coefficient estimates. Use "stepwise-backward" (or "stepwise-forward", or "stepwise-both") to apply step-wise selection of variables in estimation. Add "robust" for robust estimation of standard errors (HC1)} + +\item{form}{Optional formula to use instead of rvar, evar, and int} + +\item{ci_type}{To use the profile-likelihood (rather than Wald) for confidence intervals use "profile". For datasets with more than 5,000 rows the Wald method will be used, unless "profile" is explicitly set} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{arr}{Expression to arrange (sort) the data on (e.g., "color, desc(price)")} + +\item{rows}{Rows to select from the specified dataset} + +\item{envir}{Environment to extract data from} +} +\value{ +A list with all variables defined in logistic as an object of class logistic +} +\description{ +Logistic regression +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/logistic.html} for an example in Radiant +} +\examples{ +logistic(titanic, "survived", c("pclass", "sex"), lev = "Yes") \%>\% summary() +logistic(titanic, "survived", c("pclass", "sex")) \%>\% str() +} +\seealso{ +\code{\link{summary.logistic}} to summarize the results + +\code{\link{plot.logistic}} to plot the results + +\code{\link{predict.logistic}} to generate predictions + +\code{\link{plot.model.predict}} to plot prediction output +} diff --git a/radiant.model/man/minmax.Rd b/radiant.model/man/minmax.Rd new file mode 100644 index 0000000000000000000000000000000000000000..0767790b26282064c4b45b4e8a7add5a4d2d5d4b --- /dev/null +++ b/radiant.model/man/minmax.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/logistic.R +\name{minmax} +\alias{minmax} +\title{Calculate min and max before standardization} +\usage{ +minmax(dataset) +} +\arguments{ +\item{dataset}{Data frame} +} +\value{ +Data frame min and max attributes +} +\description{ +Calculate min and max before standardization +} diff --git a/radiant.model/man/mnl.Rd b/radiant.model/man/mnl.Rd new file mode 100644 index 0000000000000000000000000000000000000000..46fc3b89da7d4a27689d6f0907e668ffb1d81ddb --- /dev/null +++ b/radiant.model/man/mnl.Rd @@ -0,0 +1,71 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mnl.R +\name{mnl} +\alias{mnl} +\title{Multinomial logistic regression} +\usage{ +mnl( + dataset, + rvar, + evar, + lev = "", + int = "", + wts = "None", + check = "", + data_filter = "", + arr = "", + rows = NULL, + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{rvar}{The response variable in the model} + +\item{evar}{Explanatory variables in the model} + +\item{lev}{The level in the response variable to use as the baseline} + +\item{int}{Interaction term to include in the model} + +\item{wts}{Weights to use in estimation} + +\item{check}{Use "standardize" to see standardized coefficient estimates. Use "stepwise-backward" (or "stepwise-forward", or "stepwise-both") to apply step-wise selection of variables in estimation.} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{arr}{Expression to arrange (sort) the data on (e.g., "color, desc(price)")} + +\item{rows}{Rows to select from the specified dataset} + +\item{envir}{Environment to extract data from} +} +\value{ +A list with all variables defined in mnl as an object of class mnl +} +\description{ +Multinomial logistic regression +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/mnl.html} for an example in Radiant +} +\examples{ +result <- mnl( + ketchup, + rvar = "choice", + evar = c("price.heinz28", "price.heinz32", "price.heinz41", "price.hunts32"), + lev = "heinz28" +) +str(result) + +} +\seealso{ +\code{\link{summary.mnl}} to summarize the results + +\code{\link{plot.mnl}} to plot the results + +\code{\link{predict.mnl}} to generate predictions + +\code{\link{plot.model.predict}} to plot prediction output +} diff --git a/radiant.model/man/movie_contract.Rd b/radiant.model/man/movie_contract.Rd new file mode 100644 index 0000000000000000000000000000000000000000..cfb0b592c6084c3d072993507b5db4a75922c0fc --- /dev/null +++ b/radiant.model/man/movie_contract.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{movie_contract} +\alias{movie_contract} +\title{Movie contract decision tree} +\format{ +A nested list for decision and chance nodes, probabilities and payoffs +} +\usage{ +data(movie_contract) +} +\description{ +Movie contract decision tree +} +\details{ +Use decision analysis to create a decision tree for an actor facing a contract decision +} +\keyword{datasets} diff --git a/radiant.model/man/nb.Rd b/radiant.model/man/nb.Rd new file mode 100644 index 0000000000000000000000000000000000000000..b6f07ce140b1b7c70a17294af1b66d3fc1b4152f --- /dev/null +++ b/radiant.model/man/nb.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nb.R +\name{nb} +\alias{nb} +\title{Naive Bayes using e1071::naiveBayes} +\usage{ +nb( + dataset, + rvar, + evar, + laplace = 0, + data_filter = "", + arr = "", + rows = NULL, + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{rvar}{The response variable in the logit (probit) model} + +\item{evar}{Explanatory variables in the model} + +\item{laplace}{Positive double controlling Laplace smoothing. The default (0) disables Laplace smoothing.} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{arr}{Expression to arrange (sort) the data on (e.g., "color, desc(price)")} + +\item{rows}{Rows to select from the specified dataset} + +\item{envir}{Environment to extract data from} +} +\value{ +A list with all variables defined in nb as an object of class nb +} +\description{ +Naive Bayes using e1071::naiveBayes +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/nb.html} for an example in Radiant +} +\examples{ +nb(titanic, "survived", c("pclass", "sex", "age")) \%>\% summary() +nb(titanic, "survived", c("pclass", "sex", "age")) \%>\% str() + +} +\seealso{ +\code{\link{summary.nb}} to summarize results + +\code{\link{plot.nb}} to plot results + +\code{\link{predict.nb}} for prediction +} diff --git a/radiant.model/man/nn.Rd b/radiant.model/man/nn.Rd new file mode 100644 index 0000000000000000000000000000000000000000..5e7c97e498e44a4a57e5e3698a8d06b342fd575b --- /dev/null +++ b/radiant.model/man/nn.Rd @@ -0,0 +1,76 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nn.R +\name{nn} +\alias{nn} +\title{Neural Networks using nnet} +\usage{ +nn( + dataset, + rvar, + evar, + type = "classification", + lev = "", + size = 1, + decay = 0.5, + wts = "None", + seed = NA, + check = "standardize", + form, + data_filter = "", + arr = "", + rows = NULL, + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{rvar}{The response variable in the model} + +\item{evar}{Explanatory variables in the model} + +\item{type}{Model type (i.e., "classification" or "regression")} + +\item{lev}{The level in the response variable defined as _success_} + +\item{size}{Number of units (nodes) in the hidden layer} + +\item{decay}{Parameter decay} + +\item{wts}{Weights to use in estimation} + +\item{seed}{Random seed to use as the starting point} + +\item{check}{Optional estimation parameters ("standardize" is the default)} + +\item{form}{Optional formula to use instead of rvar and evar} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{arr}{Expression to arrange (sort) the data on (e.g., "color, desc(price)")} + +\item{rows}{Rows to select from the specified dataset} + +\item{envir}{Environment to extract data from} +} +\value{ +A list with all variables defined in nn as an object of class nn +} +\description{ +Neural Networks using nnet +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/nn.html} for an example in Radiant +} +\examples{ +nn(titanic, "survived", c("pclass", "sex"), lev = "Yes") \%>\% summary() +nn(titanic, "survived", c("pclass", "sex")) \%>\% str() +nn(diamonds, "price", c("carat", "clarity"), type = "regression") \%>\% summary() +} +\seealso{ +\code{\link{summary.nn}} to summarize results + +\code{\link{plot.nn}} to plot results + +\code{\link{predict.nn}} for prediction +} diff --git a/radiant.model/man/onehot.Rd b/radiant.model/man/onehot.Rd new file mode 100644 index 0000000000000000000000000000000000000000..ef4338e847fb823c93ca61549ad64141163ce2e1 --- /dev/null +++ b/radiant.model/man/onehot.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{onehot} +\alias{onehot} +\title{One hot encoding of data.frames} +\usage{ +onehot(dataset, all = FALSE, df = FALSE) +} +\arguments{ +\item{dataset}{Dataset to endcode} + +\item{all}{Extract all factor levels (e.g., for tree-based models)} + +\item{df}{Return a data.frame (tibble)} +} +\description{ +One hot encoding of data.frames +} +\examples{ +head(onehot(diamonds, df = TRUE)) +head(onehot(diamonds, all = TRUE, df = TRUE)) +} diff --git a/radiant.model/man/pdp_plot.Rd b/radiant.model/man/pdp_plot.Rd new file mode 100644 index 0000000000000000000000000000000000000000..3ef8fed65dbc7c07e5a594bab603c4283765a99d --- /dev/null +++ b/radiant.model/man/pdp_plot.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/regress.R +\name{pdp_plot} +\alias{pdp_plot} +\title{Create Partial Dependence Plots} +\usage{ +pdp_plot( + x, + plot_list = list(), + incl, + incl_int, + fix = TRUE, + hline = TRUE, + nr = 20, + minq = 0.025, + maxq = 0.975 +) +} +\arguments{ +\item{x}{Return value from a model} + +\item{plot_list}{List used to store plots} + +\item{incl}{Which variables to include in PDP plots} + +\item{incl_int}{Which interactions to investigate in PDP plots} + +\item{fix}{Set the desired limited on yhat or have it calculated automatically. +Set to FALSE to have y-axis limits set by ggplot2 for each plot} + +\item{hline}{Add a horizontal line at the average of the target variable. When set to FALSE +no line is added. When set to a specific number, the horizontal line will be added at that value} + +\item{nr}{Number of values to use to generate predictions for a numeric explanatory variable} + +\item{minq}{Quantile to use for the minimum value for simulation of numeric variables} + +\item{maxq}{Quantile to use for the maximum value for simulation of numeric variables} +} +\description{ +Create Partial Dependence Plots +} diff --git a/radiant.model/man/plot.confusion.Rd b/radiant.model/man/plot.confusion.Rd new file mode 100644 index 0000000000000000000000000000000000000000..2a9f985a3df3f7f004b06d8889c142a79e5d3c1f --- /dev/null +++ b/radiant.model/man/plot.confusion.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/evalbin.R +\name{plot.confusion} +\alias{plot.confusion} +\title{Plot method for the confusion matrix} +\usage{ +\method{plot}{confusion}( + x, + vars = c("kappa", "index", "ROME", "AUC"), + scale_y = TRUE, + size = 13, + ... +) +} +\arguments{ +\item{x}{Return value from \code{\link{confusion}}} + +\item{vars}{Measures to plot, i.e., one or more of "TP", "FP", "TN", "FN", "total", "TPR", "TNR", "precision", "accuracy", "kappa", "profit", "index", "ROME", "contact", "AUC"} + +\item{scale_y}{Free scale in faceted plot of the confusion matrix (TRUE or FALSE)} + +\item{size}{Font size used} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the confusion matrix +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +} +\examples{ +data.frame(buy = dvd$buy, pred1 = runif(20000), pred2 = ifelse(dvd$buy == "yes", 1, 0)) \%>\% + confusion(c("pred1", "pred2"), "buy") \%>\% + plot() +} +\seealso{ +\code{\link{confusion}} to generate results + +\code{\link{summary.confusion}} to summarize results +} diff --git a/radiant.model/man/plot.crs.Rd b/radiant.model/man/plot.crs.Rd new file mode 100644 index 0000000000000000000000000000000000000000..ce18e66b8630693f0c01559924b48062662d3c74 --- /dev/null +++ b/radiant.model/man/plot.crs.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/crs.R +\name{plot.crs} +\alias{plot.crs} +\title{Plot method for the crs function} +\usage{ +\method{plot}{crs}(x, ...) +} +\arguments{ +\item{x}{Return value from \code{\link{crs}}} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the crs function +} +\details{ +Plot that compares actual to predicted ratings. See \url{https://radiant-rstats.github.io/docs/model/crs.html} for an example in Radiant +} +\seealso{ +\code{\link{crs}} to generate results + +\code{\link{summary.crs}} to summarize results +} diff --git a/radiant.model/man/plot.crtree.Rd b/radiant.model/man/plot.crtree.Rd new file mode 100644 index 0000000000000000000000000000000000000000..8b0485441870d5630404cdaba274f9ee5ff658ed --- /dev/null +++ b/radiant.model/man/plot.crtree.Rd @@ -0,0 +1,68 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/crtree.R +\name{plot.crtree} +\alias{plot.crtree} +\title{Plot method for the crtree function} +\usage{ +\method{plot}{crtree}( + x, + plots = "tree", + orient = "LR", + width = "900px", + labs = TRUE, + nrobs = Inf, + dec = 2, + incl = NULL, + incl_int = NULL, + shiny = FALSE, + custom = FALSE, + ... +) +} +\arguments{ +\item{x}{Return value from \code{\link{crtree}}} + +\item{plots}{Plots to produce for the specified rpart tree. "tree" shows a tree diagram. "prune" shows a line graph to evaluate appropriate tree pruning. "imp" shows a variable importance plot} + +\item{orient}{Plot orientation for tree: LR for vertical and TD for horizontal} + +\item{width}{Plot width in pixels for tree (default is "900px")} + +\item{labs}{Use factor labels in plot (TRUE) or revert to default letters used by tree (FALSE)} + +\item{nrobs}{Number of data points to show in dashboard scatter plots (-1 for all)} + +\item{dec}{Decimal places to round results to} + +\item{incl}{Which variables to include in a coefficient plot or PDP plot} + +\item{incl_int}{Which interactions to investigate in PDP plots} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the crtree function +} +\details{ +Plot a decision tree using mermaid, permutation plots , prediction plots, or partial dependence plots. For regression trees, a residual dashboard can be plotted. See \url{https://radiant-rstats.github.io/docs/model/crtree.html} for an example in Radiant. +} +\examples{ +result <- crtree(titanic, "survived", c("pclass", "sex"), lev = "Yes") +plot(result) +result <- crtree(diamonds, "price", c("carat", "clarity", "cut")) +plot(result, plots = "prune") +result <- crtree(dvd, "buy", c("coupon", "purch", "last"), cp = .01) +plot(result, plots = "imp") + +} +\seealso{ +\code{\link{crtree}} to generate results + +\code{\link{summary.crtree}} to summarize results + +\code{\link{predict.crtree}} for prediction +} diff --git a/radiant.model/man/plot.dtree.Rd b/radiant.model/man/plot.dtree.Rd new file mode 100644 index 0000000000000000000000000000000000000000..bb476e6bc5404869482d56d8148e2205b05b668f --- /dev/null +++ b/radiant.model/man/plot.dtree.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dtree.R +\name{plot.dtree} +\alias{plot.dtree} +\title{Plot method for the dtree function} +\usage{ +\method{plot}{dtree}( + x, + symbol = "$", + dec = 2, + final = FALSE, + orient = "LR", + width = "900px", + ... +) +} +\arguments{ +\item{x}{Return value from \code{\link{dtree}}} + +\item{symbol}{Monetary symbol to use ($ is the default)} + +\item{dec}{Decimal places to round results to} + +\item{final}{If TRUE plot the decision tree solution, else the initial decision tree} + +\item{orient}{Plot orientation: LR for vertical and TD for horizontal} + +\item{width}{Plot width in pixels (default is "900px")} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the dtree function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/dtree.html} for an example in Radiant +} +\examples{ +dtree(movie_contract, opt = "max") \%>\% plot() +dtree(movie_contract, opt = "max") \%>\% plot(final = TRUE, orient = "TD") + +} +\seealso{ +\code{\link{dtree}} to generate the result + +\code{\link{summary.dtree}} to summarize results + +\code{\link{sensitivity.dtree}} to plot results +} diff --git a/radiant.model/man/plot.evalbin.Rd b/radiant.model/man/plot.evalbin.Rd new file mode 100644 index 0000000000000000000000000000000000000000..9ef0d2cc23f044c5459fd46808779d2b6c3f4ac7 --- /dev/null +++ b/radiant.model/man/plot.evalbin.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/evalbin.R +\name{plot.evalbin} +\alias{plot.evalbin} +\title{Plot method for the evalbin function} +\usage{ +\method{plot}{evalbin}( + x, + plots = c("lift", "gains"), + size = 13, + shiny = FALSE, + custom = FALSE, + ... +) +} +\arguments{ +\item{x}{Return value from \code{\link{evalbin}}} + +\item{plots}{Plots to return} + +\item{size}{Font size used} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the evalbin function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +} +\examples{ +data.frame(buy = dvd$buy, pred1 = runif(20000), pred2 = ifelse(dvd$buy == "yes", 1, 0)) \%>\% + evalbin(c("pred1", "pred2"), "buy") \%>\% + plot() +} +\seealso{ +\code{\link{evalbin}} to generate results + +\code{\link{summary.evalbin}} to summarize results +} diff --git a/radiant.model/man/plot.evalreg.Rd b/radiant.model/man/plot.evalreg.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f718e3231c700264fe88cbf1b84d0dbded6631cf --- /dev/null +++ b/radiant.model/man/plot.evalreg.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/evalreg.R +\name{plot.evalreg} +\alias{plot.evalreg} +\title{Plot method for the evalreg function} +\usage{ +\method{plot}{evalreg}(x, vars = c("Rsq", "RMSE", "MAE"), ...) +} +\arguments{ +\item{x}{Return value from \code{\link{evalreg}}} + +\item{vars}{Measures to plot, i.e., one or more of "Rsq", "RMSE", "MAE"} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the evalreg function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/evalreg.html} for an example in Radiant +} +\examples{ +data.frame(price = diamonds$price, pred1 = rnorm(3000), pred2 = diamonds$price) \%>\% + evalreg(pred = c("pred1", "pred2"), "price") \%>\% + plot() + +} +\seealso{ +\code{\link{evalreg}} to generate results + +\code{\link{summary.evalreg}} to summarize results +} diff --git a/radiant.model/man/plot.gbt.Rd b/radiant.model/man/plot.gbt.Rd new file mode 100644 index 0000000000000000000000000000000000000000..bcd7f7c2f0f8714a3d06dc46eb690def15b2aec2 --- /dev/null +++ b/radiant.model/man/plot.gbt.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gbt.R +\name{plot.gbt} +\alias{plot.gbt} +\title{Plot method for the gbt function} +\usage{ +\method{plot}{gbt}( + x, + plots = "", + nrobs = Inf, + incl = NULL, + incl_int = NULL, + shiny = FALSE, + custom = FALSE, + ... +) +} +\arguments{ +\item{x}{Return value from \code{\link{gbt}}} + +\item{plots}{Plots to produce for the specified Gradient Boosted Tree model. Use "" to avoid showing any plots (default). Options are ...} + +\item{nrobs}{Number of data points to show in scatter plots (-1 for all)} + +\item{incl}{Which variables to include in a coefficient plot or PDP plot} + +\item{incl_int}{Which interactions to investigate in PDP plots} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. +This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). +See examples and \url{https://ggplot2.tidyverse.org} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the gbt function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/gbt.html} for an example in Radiant +} +\examples{ +result <- gbt( + titanic, "survived", c("pclass", "sex"), + early_stopping_rounds = 0, nthread = 1 +) +plot(result) + +} +\seealso{ +\code{\link{gbt}} to generate results + +\code{\link{summary.gbt}} to summarize results + +\code{\link{predict.gbt}} for prediction +} diff --git a/radiant.model/man/plot.logistic.Rd b/radiant.model/man/plot.logistic.Rd new file mode 100644 index 0000000000000000000000000000000000000000..6659656c9af028ca45b7576e29d40ae9acb710c0 --- /dev/null +++ b/radiant.model/man/plot.logistic.Rd @@ -0,0 +1,62 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/logistic.R +\name{plot.logistic} +\alias{plot.logistic} +\title{Plot method for the logistic function} +\usage{ +\method{plot}{logistic}( + x, + plots = "coef", + conf_lev = 0.95, + intercept = FALSE, + incl = NULL, + excl = NULL, + incl_int = NULL, + nrobs = -1, + shiny = FALSE, + custom = FALSE, + ... +) +} +\arguments{ +\item{x}{Return value from \code{\link{logistic}}} + +\item{plots}{Plots to produce for the specified GLM model. Use "" to avoid showing any plots (default). "dist" shows histograms (or frequency bar plots) of all variables in the model. "scatter" shows scatter plots (or box plots for factors) for the response variable with each explanatory variable. "coef" provides a coefficient plot and "influence" shows (potentially) influential observations} + +\item{conf_lev}{Confidence level to use for coefficient and odds confidence intervals (.95 is the default)} + +\item{intercept}{Include the intercept in the coefficient plot (TRUE or FALSE). FALSE is the default} + +\item{incl}{Which variables to include in a coefficient plot} + +\item{excl}{Which variables to exclude in a coefficient plot} + +\item{incl_int}{Which interactions to investigate in PDP plots} + +\item{nrobs}{Number of data points to show in scatter plots (-1 for all)} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the logistic function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/logistic.html} for an example in Radiant +} +\examples{ +result <- logistic(titanic, "survived", c("pclass", "sex"), lev = "Yes") +plot(result, plots = "coef") +} +\seealso{ +\code{\link{logistic}} to generate results + +\code{\link{plot.logistic}} to plot results + +\code{\link{predict.logistic}} to generate predictions + +\code{\link{plot.model.predict}} to plot prediction output +} diff --git a/radiant.model/man/plot.mnl.Rd b/radiant.model/man/plot.mnl.Rd new file mode 100644 index 0000000000000000000000000000000000000000..fde385e2d630d66e3aa9b8f6d95f16e5d55e4184 --- /dev/null +++ b/radiant.model/man/plot.mnl.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mnl.R +\name{plot.mnl} +\alias{plot.mnl} +\title{Plot method for the mnl function} +\usage{ +\method{plot}{mnl}( + x, + plots = "coef", + conf_lev = 0.95, + intercept = FALSE, + nrobs = -1, + shiny = FALSE, + custom = FALSE, + ... +) +} +\arguments{ +\item{x}{Return value from \code{\link{mnl}}} + +\item{plots}{Plots to produce for the specified MNL model. Use "" to avoid showing any plots (default). "dist" shows histograms (or frequency bar plots) of all variables in the model. "scatter" shows scatter plots (or box plots for factors) for the response variable with each explanatory variable. "coef" provides a coefficient plot} + +\item{conf_lev}{Confidence level to use for coefficient and relative risk ratios (RRRs) intervals (.95 is the default)} + +\item{intercept}{Include the intercept in the coefficient plot (TRUE or FALSE). FALSE is the default} + +\item{nrobs}{Number of data points to show in scatter plots (-1 for all)} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the mnl function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/mnl.html} for an example in Radiant +} +\examples{ +result <- mnl( + ketchup, + rvar = "choice", + evar = c("price.heinz28", "price.heinz32", "price.heinz41", "price.hunts32"), + lev = "heinz28" +) +plot(result, plots = "coef") + +} +\seealso{ +\code{\link{mnl}} to generate results + +\code{\link{predict.mnl}} to generate predictions + +\code{\link{plot.model.predict}} to plot prediction output +} diff --git a/radiant.model/man/plot.mnl.predict.Rd b/radiant.model/man/plot.mnl.predict.Rd new file mode 100644 index 0000000000000000000000000000000000000000..9d85be9ebf384c0c8a1e5226ed84de2331377ba0 --- /dev/null +++ b/radiant.model/man/plot.mnl.predict.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mnl.R +\name{plot.mnl.predict} +\alias{plot.mnl.predict} +\title{Plot method for mnl.predict function} +\usage{ +\method{plot}{mnl.predict}(x, xvar = "", facet_row = ".", facet_col = ".", color = ".class", ...) +} +\arguments{ +\item{x}{Return value from predict function predict.mnl} + +\item{xvar}{Variable to display along the X-axis of the plot} + +\item{facet_row}{Create vertically arranged subplots for each level of the selected factor variable} + +\item{facet_col}{Create horizontally arranged subplots for each level of the selected factor variable} + +\item{color}{Adds color to a scatter plot to generate a heat map. For a line plot one line is created for each group and each is assigned a different color} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for mnl.predict function +} +\examples{ +result <- mnl( + ketchup, + rvar = "choice", + evar = c("price.heinz28", "price.heinz32", "price.heinz41", "price.hunts32"), + lev = "heinz28" +) +pred <- predict(result, pred_cmd = "price.heinz28 = seq(3, 5, 0.1)") +plot(pred, xvar = "price.heinz28") + +} +\seealso{ +\code{\link{predict.mnl}} to generate predictions +} diff --git a/radiant.model/man/plot.model.predict.Rd b/radiant.model/man/plot.model.predict.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f94abe32d2a6b7edad48caf94320b3b53b2a334b --- /dev/null +++ b/radiant.model/man/plot.model.predict.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/regress.R +\name{plot.model.predict} +\alias{plot.model.predict} +\title{Plot method for model.predict functions} +\usage{ +\method{plot}{model.predict}( + x, + xvar = "", + facet_row = ".", + facet_col = ".", + color = "none", + conf_lev = 0.95, + ... +) +} +\arguments{ +\item{x}{Return value from predict functions (e.g., predict.regress)} + +\item{xvar}{Variable to display along the X-axis of the plot} + +\item{facet_row}{Create vertically arranged subplots for each level of the selected factor variable} + +\item{facet_col}{Create horizontally arranged subplots for each level of the selected factor variable} + +\item{color}{Adds color to a scatter plot to generate a heat map. For a line plot one line is created for each group and each is assigned a different color} + +\item{conf_lev}{Confidence level to use for prediction intervals (.95 is the default)} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for model.predict functions +} +\examples{ +regress(diamonds, "price", c("carat", "clarity")) \%>\% + predict(pred_cmd = "carat = 1:10") \%>\% + plot(xvar = "carat") +logistic(titanic, "survived", c("pclass", "sex", "age"), lev = "Yes") \%>\% + predict(pred_cmd = c("pclass = levels(pclass)", "sex = levels(sex)", "age = 0:100")) \%>\% + plot(xvar = "age", color = "sex", facet_col = "pclass") + +} +\seealso{ +\code{\link{predict.regress}} to generate predictions + +\code{\link{predict.logistic}} to generate predictions +} diff --git a/radiant.model/man/plot.nb.Rd b/radiant.model/man/plot.nb.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d98479507dd10e6f3e89d9f4fd80e8532d7a0b49 --- /dev/null +++ b/radiant.model/man/plot.nb.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nb.R +\name{plot.nb} +\alias{plot.nb} +\title{Plot method for the nb function} +\usage{ +\method{plot}{nb}(x, plots = "correlations", lev = "All levels", nrobs = 1000, ...) +} +\arguments{ +\item{x}{Return value from \code{\link{nb}}} + +\item{plots}{Plots to produce for the specified model. Use "" to avoid showing any plots. Use "vimp" for variable importance or "correlations" to examine conditional independence} + +\item{lev}{The level(s) in the response variable used as the basis for plots (defaults to "All levels")} + +\item{nrobs}{Number of data points to show in scatter plots (-1 for all)} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the nb function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/nb.html} for an example in Radiant +} +\examples{ +result <- nb(titanic, "survived", c("pclass", "sex")) +plot(result) +result <- nb(titanic, "pclass", c("sex", "age")) +plot(result) + +} +\seealso{ +\code{\link{nb}} to generate results + +\code{\link{summary.nb}} to summarize results + +\code{\link{predict.nb}} for prediction +} diff --git a/radiant.model/man/plot.nb.predict.Rd b/radiant.model/man/plot.nb.predict.Rd new file mode 100644 index 0000000000000000000000000000000000000000..511bd4fed496463915e480573867ab5589f1b337 --- /dev/null +++ b/radiant.model/man/plot.nb.predict.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nb.R +\name{plot.nb.predict} +\alias{plot.nb.predict} +\title{Plot method for nb.predict function} +\usage{ +\method{plot}{nb.predict}(x, xvar = "", facet_row = ".", facet_col = ".", color = ".class", ...) +} +\arguments{ +\item{x}{Return value from predict function predict.nb} + +\item{xvar}{Variable to display along the X-axis of the plot} + +\item{facet_row}{Create vertically arranged subplots for each level of the selected factor variable} + +\item{facet_col}{Create horizontally arranged subplots for each level of the selected factor variable} + +\item{color}{Adds color to a scatter plot to generate a heat map. For a line plot one line is created for each group and each is assigned a different color} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for nb.predict function +} +\examples{ +result <- nb(titanic, "survived", c("pclass", "sex", "age")) +pred <- predict( + result, + pred_cmd = c("pclass = levels(pclass)", "sex = levels(sex)", "age = seq(0, 100, 20)") +) +plot(pred, xvar = "age", facet_col = "sex", facet_row = "pclass") +pred <- predict(result, pred_data = titanic) +plot(pred, xvar = "age", facet_col = "sex") + +} +\seealso{ +\code{\link{predict.nb}} to generate predictions +} diff --git a/radiant.model/man/plot.nn.Rd b/radiant.model/man/plot.nn.Rd new file mode 100644 index 0000000000000000000000000000000000000000..ac9f7e84088a63465e70a2a0561f8c952ec9b4cd --- /dev/null +++ b/radiant.model/man/plot.nn.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nn.R +\name{plot.nn} +\alias{plot.nn} +\title{Plot method for the nn function} +\usage{ +\method{plot}{nn}( + x, + plots = "vip", + size = 12, + pad_x = 0.9, + nrobs = -1, + incl = NULL, + incl_int = NULL, + shiny = FALSE, + custom = FALSE, + ... +) +} +\arguments{ +\item{x}{Return value from \code{\link{nn}}} + +\item{plots}{Plots to produce for the specified Neural Network model. Use "" to avoid showing any plots (default). Options are "olden" or "garson" for importance plots, or "net" to depict the network structure} + +\item{size}{Font size used} + +\item{pad_x}{Padding for explanatory variable labels in the network plot. Default value is 0.9, smaller numbers (e.g., 0.5) increase the amount of padding} + +\item{nrobs}{Number of data points to show in dashboard scatter plots (-1 for all)} + +\item{incl}{Which variables to include in a coefficient plot or PDP plot} + +\item{incl_int}{Which interactions to investigate in PDP plots} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the nn function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/nn.html} for an example in Radiant +} +\examples{ +result <- nn(titanic, "survived", c("pclass", "sex"), lev = "Yes") +plot(result, plots = "net") +plot(result, plots = "olden") +} +\seealso{ +\code{\link{nn}} to generate results + +\code{\link{summary.nn}} to summarize results + +\code{\link{predict.nn}} for prediction +} diff --git a/radiant.model/man/plot.regress.Rd b/radiant.model/man/plot.regress.Rd new file mode 100644 index 0000000000000000000000000000000000000000..4a88768102c876272ca42d8f01d494fe7dc2475f --- /dev/null +++ b/radiant.model/man/plot.regress.Rd @@ -0,0 +1,69 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/regress.R +\name{plot.regress} +\alias{plot.regress} +\title{Plot method for the regress function} +\usage{ +\method{plot}{regress}( + x, + plots = "", + lines = "", + conf_lev = 0.95, + intercept = FALSE, + incl = NULL, + excl = NULL, + incl_int = NULL, + nrobs = -1, + shiny = FALSE, + custom = FALSE, + ... +) +} +\arguments{ +\item{x}{Return value from \code{\link{regress}}} + +\item{plots}{Regression plots to produce for the specified regression model. Enter "" to avoid showing any plots (default). "dist" to shows histograms (or frequency bar plots) of all variables in the model. "correlations" for a visual representation of the correlation matrix selected variables. "scatter" to show scatter plots (or box plots for factors) for the response variable with each explanatory variable. "dashboard" for a series of six plots that can be used to evaluate model fit visually. "resid_pred" to plot the explanatory variables against the model residuals. "coef" for a coefficient plot with adjustable confidence intervals and "influence" to show (potentially) influential observations} + +\item{lines}{Optional lines to include in the select plot. "line" to include a line through a scatter plot. "loess" to include a polynomial regression fit line. To include both use c("line", "loess")} + +\item{conf_lev}{Confidence level used to estimate confidence intervals (.95 is the default)} + +\item{intercept}{Include the intercept in the coefficient plot (TRUE, FALSE). FALSE is the default} + +\item{incl}{Which variables to include in a coefficient plot or PDP plot} + +\item{excl}{Which variables to exclude in a coefficient plot} + +\item{incl_int}{Which interactions to investigate in PDP plots} + +\item{nrobs}{Number of data points to show in scatter plots (-1 for all)} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the regress function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/regress.html} for an example in Radiant +} +\examples{ +result <- regress(diamonds, "price", c("carat", "clarity")) +plot(result, plots = "coef", conf_lev = .99, intercept = TRUE) +\dontrun{ +plot(result, plots = "dist") +plot(result, plots = "scatter", lines = c("line", "loess")) +plot(result, plots = "resid_pred", lines = "line") +plot(result, plots = "dashboard", lines = c("line", "loess")) +} +} +\seealso{ +\code{\link{regress}} to generate the results + +\code{\link{summary.regress}} to summarize results + +\code{\link{predict.regress}} to generate predictions +} diff --git a/radiant.model/man/plot.repeater.Rd b/radiant.model/man/plot.repeater.Rd new file mode 100644 index 0000000000000000000000000000000000000000..7178428cd159609719e81eea64bfddb309ecbd91 --- /dev/null +++ b/radiant.model/man/plot.repeater.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simulater.R +\name{plot.repeater} +\alias{plot.repeater} +\title{Plot repeated simulation} +\usage{ +\method{plot}{repeater}(x, bins = 20, shiny = FALSE, custom = FALSE, ...) +} +\arguments{ +\item{x}{Return value from \code{\link{repeater}}} + +\item{bins}{Number of bins used for histograms (1 - 50)} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot repeated simulation +} +\seealso{ +\code{\link{repeater}} to run a repeated simulation + +\code{\link{summary.repeater}} to summarize results from repeated simulation +} diff --git a/radiant.model/man/plot.rforest.Rd b/radiant.model/man/plot.rforest.Rd new file mode 100644 index 0000000000000000000000000000000000000000..ae53067a0d0092736f5dec195d6cf8a2bebc3fa9 --- /dev/null +++ b/radiant.model/man/plot.rforest.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rforest.R +\name{plot.rforest} +\alias{plot.rforest} +\title{Plot method for the rforest function} +\usage{ +\method{plot}{rforest}( + x, + plots = "", + nrobs = Inf, + incl = NULL, + incl_int = NULL, + shiny = FALSE, + custom = FALSE, + ... +) +} +\arguments{ +\item{x}{Return value from \code{\link{rforest}}} + +\item{plots}{Plots to produce for the specified Random Forest model. Use "" to avoid showing any plots (default). Options are ...} + +\item{nrobs}{Number of data points to show in dashboard scatter plots (-1 for all)} + +\item{incl}{Which variables to include in PDP or Prediction plots} + +\item{incl_int}{Which interactions to investigate in PDP or Prediction plots} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. +This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples +and \url{https://ggplot2.tidyverse.org} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the rforest function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/rforest.html} for an example in Radiant +} +\examples{ +result <- rforest(titanic, "survived", c("pclass", "sex"), lev = "Yes") + +} +\seealso{ +\code{\link{rforest}} to generate results + +\code{\link{summary.rforest}} to summarize results + +\code{\link{predict.rforest}} for prediction +} diff --git a/radiant.model/man/plot.rforest.predict.Rd b/radiant.model/man/plot.rforest.predict.Rd new file mode 100644 index 0000000000000000000000000000000000000000..7d0da26241d5db328dc9afc966ddd2065af14c2e --- /dev/null +++ b/radiant.model/man/plot.rforest.predict.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rforest.R +\name{plot.rforest.predict} +\alias{plot.rforest.predict} +\title{Plot method for rforest.predict function} +\usage{ +\method{plot}{rforest.predict}(x, xvar = "", facet_row = ".", facet_col = ".", color = "none", ...) +} +\arguments{ +\item{x}{Return value from predict function predict.rforest} + +\item{xvar}{Variable to display along the X-axis of the plot} + +\item{facet_row}{Create vertically arranged subplots for each level of the selected factor variable} + +\item{facet_col}{Create horizontally arranged subplots for each level of the selected factor variable} + +\item{color}{Adds color to a scatter plot to generate a heat map. For a line plot one line is created for each group and each is assigned a different color} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for rforest.predict function +} +\examples{ +result <- mnl( + ketchup, + rvar = "choice", + evar = c("price.heinz28", "price.heinz32", "price.heinz41", "price.hunts32"), + lev = "heinz28" +) +pred <- predict(result, pred_cmd = "price.heinz28 = seq(3, 5, 0.1)") +plot(pred, xvar = "price.heinz28") + +} +\seealso{ +\code{\link{predict.mnl}} to generate predictions +} diff --git a/radiant.model/man/plot.simulater.Rd b/radiant.model/man/plot.simulater.Rd new file mode 100644 index 0000000000000000000000000000000000000000..2a26b375917f20ad8b1c792616831721a906bbbc --- /dev/null +++ b/radiant.model/man/plot.simulater.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simulater.R +\name{plot.simulater} +\alias{plot.simulater} +\title{Plot method for the simulater function} +\usage{ +\method{plot}{simulater}(x, bins = 20, shiny = FALSE, custom = FALSE, ...) +} +\arguments{ +\item{x}{Return value from \code{\link{simulater}}} + +\item{bins}{Number of bins used for histograms (1 - 50)} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the simulater function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/simulater} for an example in Radiant +} +\examples{ +simdat <- simulater( + const = "cost 3", + norm = "demand 2000 1000", + discrete = "price 5 8 .3 .7", + form = "profit = demand * (price - cost)", + seed = 1234 +) +plot(simdat, bins = 25) + +} +\seealso{ +\code{\link{simulater}} to generate the result + +\code{\link{summary.simulater}} to summarize results +} diff --git a/radiant.model/man/plot.uplift.Rd b/radiant.model/man/plot.uplift.Rd new file mode 100644 index 0000000000000000000000000000000000000000..981dfe7a7529334a96e69d6a1dbd4cc6b3fd2240 --- /dev/null +++ b/radiant.model/man/plot.uplift.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/evalbin.R +\name{plot.uplift} +\alias{plot.uplift} +\title{Plot method for the uplift function} +\usage{ +\method{plot}{uplift}( + x, + plots = c("inc_uplift", "uplift"), + size = 13, + shiny = FALSE, + custom = FALSE, + ... +) +} +\arguments{ +\item{x}{Return value from \code{\link{evalbin}}} + +\item{plots}{Plots to return} + +\item{size}{Font size used} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the uplift function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +} +\examples{ +data.frame(buy = dvd$buy, pred1 = runif(20000), pred2 = ifelse(dvd$buy == "yes", 1, 0)) \%>\% + evalbin(c("pred1", "pred2"), "buy") \%>\% + plot() +} +\seealso{ +\code{\link{evalbin}} to generate results + +\code{\link{summary.evalbin}} to summarize results +} diff --git a/radiant.model/man/pred_plot.Rd b/radiant.model/man/pred_plot.Rd new file mode 100644 index 0000000000000000000000000000000000000000..44203737099977db51ce7cdbf2743a551b9b99b4 --- /dev/null +++ b/radiant.model/man/pred_plot.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/regress.R +\name{pred_plot} +\alias{pred_plot} +\title{Prediction Plots} +\usage{ +pred_plot( + x, + plot_list = list(), + incl, + incl_int, + fix = TRUE, + hline = TRUE, + nr = 20, + minq = 0.025, + maxq = 0.975 +) +} +\arguments{ +\item{x}{Return value from a model} + +\item{plot_list}{List used to store plots} + +\item{incl}{Which variables to include in prediction plots} + +\item{incl_int}{Which interactions to investigate in prediction plots} + +\item{fix}{Set the desired limited on yhat or have it calculated automatically. +Set to FALSE to have y-axis limits set by ggplot2 for each plot} + +\item{hline}{Add a horizontal line at the average of the target variable. When set to FALSE +no line is added. When set to a specific number, the horizontal line will be added at that value} + +\item{nr}{Number of values to use to generate predictions for a numeric explanatory variable} + +\item{minq}{Quantile to use for the minimum value for simulation of numeric variables} + +\item{maxq}{Quantile to use for the maximum value for simulation of numeric variables} +} +\description{ +Prediction Plots +} +\details{ +Faster, but less robust, alternative for PDP plots. Variable +values not included in the prediction are set to either the mean or +the most common value (level) +} diff --git a/radiant.model/man/predict.coxp.Rd b/radiant.model/man/predict.coxp.Rd new file mode 100644 index 0000000000000000000000000000000000000000..18b67eda3f565ed3d0462e80c08a2161e64e8ac2 --- /dev/null +++ b/radiant.model/man/predict.coxp.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cox.R +\name{predict.coxp} +\alias{predict.coxp} +\title{Predict 占位} +\usage{ +\method{predict}{coxp}( + object, + pred_data = NULL, + pred_cmd = "", + dec = 3, + envir = parent.frame(), + ... +) +} +\description{ +Predict 占位 +} diff --git a/radiant.model/man/predict.crtree.Rd b/radiant.model/man/predict.crtree.Rd new file mode 100644 index 0000000000000000000000000000000000000000..6ae0eb5612805a2669a34a0d9b30e4ff71d270a4 --- /dev/null +++ b/radiant.model/man/predict.crtree.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/crtree.R +\name{predict.crtree} +\alias{predict.crtree} +\title{Predict method for the crtree function} +\usage{ +\method{predict}{crtree}( + object, + pred_data = NULL, + pred_cmd = "", + conf_lev = 0.95, + se = FALSE, + dec = 3, + envir = parent.frame(), + ... +) +} +\arguments{ +\item{object}{Return value from \code{\link{crtree}}} + +\item{pred_data}{Provide the dataframe to generate predictions (e.g., titanic). The dataset must contain all columns used in the estimation} + +\item{pred_cmd}{Generate predictions using a command. For example, `pclass = levels(pclass)` would produce predictions for the different levels of factor `pclass`. To add another variable, create a vector of prediction strings, (e.g., c('pclass = levels(pclass)', 'age = seq(0,100,20)')} + +\item{conf_lev}{Confidence level used to estimate confidence intervals (.95 is the default)} + +\item{se}{Logical that indicates if prediction standard errors should be calculated (default = FALSE)} + +\item{dec}{Number of decimals to show} + +\item{envir}{Environment to extract data from} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Predict method for the crtree function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/crtree.html} for an example in Radiant +} +\examples{ +result <- crtree(titanic, "survived", c("pclass", "sex"), lev = "Yes") +predict(result, pred_cmd = "pclass = levels(pclass)") +result <- crtree(titanic, "survived", "pclass", lev = "Yes") +predict(result, pred_data = titanic) \%>\% head() +} +\seealso{ +\code{\link{crtree}} to generate the result + +\code{\link{summary.crtree}} to summarize results +} diff --git a/radiant.model/man/predict.gbt.Rd b/radiant.model/man/predict.gbt.Rd new file mode 100644 index 0000000000000000000000000000000000000000..7bbf3693077ca514529d51e24ecbde4e6c7101de --- /dev/null +++ b/radiant.model/man/predict.gbt.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gbt.R +\name{predict.gbt} +\alias{predict.gbt} +\title{Predict method for the gbt function} +\usage{ +\method{predict}{gbt}( + object, + pred_data = NULL, + pred_cmd = "", + dec = 3, + envir = parent.frame(), + ... +) +} +\arguments{ +\item{object}{Return value from \code{\link{gbt}}} + +\item{pred_data}{Provide the dataframe to generate predictions (e.g., diamonds). The dataset must contain all columns used in the estimation} + +\item{pred_cmd}{Generate predictions using a command. For example, `pclass = levels(pclass)` would produce predictions for the different levels of factor `pclass`. To add another variable, create a vector of prediction strings, (e.g., c('pclass = levels(pclass)', 'age = seq(0,100,20)')} + +\item{dec}{Number of decimals to show} + +\item{envir}{Environment to extract data from} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Predict method for the gbt function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/gbt.html} for an example in Radiant +} +\examples{ +result <- gbt( + titanic, "survived", c("pclass", "sex"), + early_stopping_rounds = 2, nthread = 1 +) +predict(result, pred_cmd = "pclass = levels(pclass)") +result <- gbt(diamonds, "price", "carat:color", type = "regression", nthread = 1) +predict(result, pred_cmd = "carat = 1:3") +predict(result, pred_data = diamonds) \%>\% head() +} +\seealso{ +\code{\link{gbt}} to generate the result + +\code{\link{summary.gbt}} to summarize results +} diff --git a/radiant.model/man/predict.logistic.Rd b/radiant.model/man/predict.logistic.Rd new file mode 100644 index 0000000000000000000000000000000000000000..398b2c3ea35c37b63a8ee88a146fff978487e24c --- /dev/null +++ b/radiant.model/man/predict.logistic.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/logistic.R +\name{predict.logistic} +\alias{predict.logistic} +\title{Predict method for the logistic function} +\usage{ +\method{predict}{logistic}( + object, + pred_data = NULL, + pred_cmd = "", + conf_lev = 0.95, + se = TRUE, + interval = "confidence", + dec = 3, + envir = parent.frame(), + ... +) +} +\arguments{ +\item{object}{Return value from \code{\link{logistic}}} + +\item{pred_data}{Provide the dataframe to generate predictions (e.g., titanic). The dataset must contain all columns used in the estimation} + +\item{pred_cmd}{Generate predictions using a command. For example, `pclass = levels(pclass)` would produce predictions for the different levels of factor `pclass`. To add another variable, create a vector of prediction strings, (e.g., c('pclass = levels(pclass)', 'age = seq(0,100,20)')} + +\item{conf_lev}{Confidence level used to estimate confidence intervals (.95 is the default)} + +\item{se}{Logical that indicates if prediction standard errors should be calculated (default = FALSE)} + +\item{interval}{Type of interval calculation ("confidence" or "none"). Set to "none" if se is FALSE} + +\item{dec}{Number of decimals to show} + +\item{envir}{Environment to extract data from} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Predict method for the logistic function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/logistic.html} for an example in Radiant +} +\examples{ +result <- logistic(titanic, "survived", c("pclass", "sex"), lev = "Yes") +predict(result, pred_cmd = "pclass = levels(pclass)") +logistic(titanic, "survived", c("pclass", "sex"), lev = "Yes") \%>\% + predict(pred_cmd = "sex = c('male','female')") +logistic(titanic, "survived", c("pclass", "sex"), lev = "Yes") \%>\% + predict(pred_data = titanic) +} +\seealso{ +\code{\link{logistic}} to generate the result + +\code{\link{summary.logistic}} to summarize results + +\code{\link{plot.logistic}} to plot results + +\code{\link{plot.model.predict}} to plot prediction output +} diff --git a/radiant.model/man/predict.mnl.Rd b/radiant.model/man/predict.mnl.Rd new file mode 100644 index 0000000000000000000000000000000000000000..948746d229da97a0671992630148f99025870f5e --- /dev/null +++ b/radiant.model/man/predict.mnl.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mnl.R +\name{predict.mnl} +\alias{predict.mnl} +\title{Predict method for the mnl function} +\usage{ +\method{predict}{mnl}( + object, + pred_data = NULL, + pred_cmd = "", + pred_names = "", + dec = 3, + envir = parent.frame(), + ... +) +} +\arguments{ +\item{object}{Return value from \code{\link{mnl}}} + +\item{pred_data}{Provide the dataframe to generate predictions (e.g., ketchup). The dataset must contain all columns used in the estimation} + +\item{pred_cmd}{Generate predictions using a command. For example, `pclass = levels(pclass)` would produce predictions for the different levels of factor `pclass`. To add another variable, create a vector of prediction strings, (e.g., c('pclass = levels(pclass)', 'age = seq(0,100,20)')} + +\item{pred_names}{Names for the predictions to be stored. If one name is provided, only the first column of predictions is stored. If empty, the levels in the response variable of the mnl model will be used} + +\item{dec}{Number of decimals to show} + +\item{envir}{Environment to extract data from} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Predict method for the mnl function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/mnl.html} for an example in Radiant +} +\examples{ +result <- mnl( + ketchup, + rvar = "choice", + evar = c("price.heinz28", "price.heinz32", "price.heinz41", "price.hunts32"), + lev = "heinz28" +) +predict(result, pred_cmd = "price.heinz28 = seq(3, 5, 0.1)") +predict(result, pred_data = slice(ketchup, 1:20)) + +} +\seealso{ +\code{\link{mnl}} to generate the result + +\code{\link{summary.mnl}} to summarize results +} diff --git a/radiant.model/man/predict.nb.Rd b/radiant.model/man/predict.nb.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d8b30912e7da453d1b3ebf006e0aba8e3e9546ea --- /dev/null +++ b/radiant.model/man/predict.nb.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nb.R +\name{predict.nb} +\alias{predict.nb} +\title{Predict method for the nb function} +\usage{ +\method{predict}{nb}( + object, + pred_data = NULL, + pred_cmd = "", + pred_names = "", + dec = 3, + envir = parent.frame(), + ... +) +} +\arguments{ +\item{object}{Return value from \code{\link{nb}}} + +\item{pred_data}{Provide the dataframe to generate predictions (e.g., titanic). The dataset must contain all columns used in the estimation} + +\item{pred_cmd}{Generate predictions using a command. For example, `pclass = levels(pclass)` would produce predictions for the different levels of factor `pclass`. To add another variable, create a vector of prediction strings, (e.g., c('pclass = levels(pclass)', 'age = seq(0,100,20)')} + +\item{pred_names}{Names for the predictions to be stored. If one name is provided, only the first column of predictions is stored. If empty, the level in the response variable of the nb model will be used} + +\item{dec}{Number of decimals to show} + +\item{envir}{Environment to extract data from} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Predict method for the nb function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/nb.html} for an example in Radiant +} +\examples{ +result <- nb(titanic, "survived", c("pclass", "sex", "age")) +predict(result, pred_data = titanic) +predict(result, pred_data = titanic, pred_names = c("Yes", "No")) +predict(result, pred_cmd = "pclass = levels(pclass)") +result <- nb(titanic, "pclass", c("survived", "sex", "age")) +predict(result, pred_data = titanic) +predict(result, pred_data = titanic, pred_names = c("1st", "2nd", "3rd")) +predict(result, pred_data = titanic, pred_names = "") + +} +\seealso{ +\code{\link{nb}} to generate the result + +\code{\link{summary.nb}} to summarize results +} diff --git a/radiant.model/man/predict.nn.Rd b/radiant.model/man/predict.nn.Rd new file mode 100644 index 0000000000000000000000000000000000000000..b38f6c65e2972255fbc1d225e6174c6ead9e6604 --- /dev/null +++ b/radiant.model/man/predict.nn.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nn.R +\name{predict.nn} +\alias{predict.nn} +\title{Predict method for the nn function} +\usage{ +\method{predict}{nn}( + object, + pred_data = NULL, + pred_cmd = "", + dec = 3, + envir = parent.frame(), + ... +) +} +\arguments{ +\item{object}{Return value from \code{\link{nn}}} + +\item{pred_data}{Provide the dataframe to generate predictions (e.g., diamonds). The dataset must contain all columns used in the estimation} + +\item{pred_cmd}{Generate predictions using a command. For example, `pclass = levels(pclass)` would produce predictions for the different levels of factor `pclass`. To add another variable, create a vector of prediction strings, (e.g., c('pclass = levels(pclass)', 'age = seq(0,100,20)')} + +\item{dec}{Number of decimals to show} + +\item{envir}{Environment to extract data from} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Predict method for the nn function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/nn.html} for an example in Radiant +} +\examples{ +result <- nn(titanic, "survived", c("pclass", "sex"), lev = "Yes") +predict(result, pred_cmd = "pclass = levels(pclass)") +result <- nn(diamonds, "price", "carat:color", type = "regression") +predict(result, pred_cmd = "carat = 1:3") +predict(result, pred_data = diamonds) \%>\% head() +} +\seealso{ +\code{\link{nn}} to generate the result + +\code{\link{summary.nn}} to summarize results +} diff --git a/radiant.model/man/predict.regress.Rd b/radiant.model/man/predict.regress.Rd new file mode 100644 index 0000000000000000000000000000000000000000..afc9f2f37f052f483bb96a2fc7a06c2973518836 --- /dev/null +++ b/radiant.model/man/predict.regress.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/regress.R +\name{predict.regress} +\alias{predict.regress} +\title{Predict method for the regress function} +\usage{ +\method{predict}{regress}( + object, + pred_data = NULL, + pred_cmd = "", + conf_lev = 0.95, + se = TRUE, + interval = "confidence", + dec = 3, + envir = parent.frame(), + ... +) +} +\arguments{ +\item{object}{Return value from \code{\link{regress}}} + +\item{pred_data}{Provide the dataframe to generate predictions (e.g., diamonds). The dataset must contain all columns used in the estimation} + +\item{pred_cmd}{Command used to generate data for prediction} + +\item{conf_lev}{Confidence level used to estimate confidence intervals (.95 is the default)} + +\item{se}{Logical that indicates if prediction standard errors should be calculated (default = FALSE)} + +\item{interval}{Type of interval calculation ("confidence" or "prediction"). Set to "none" if se is FALSE} + +\item{dec}{Number of decimals to show} + +\item{envir}{Environment to extract data from} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Predict method for the regress function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/regress.html} for an example in Radiant +} +\examples{ +result <- regress(diamonds, "price", c("carat", "clarity")) +predict(result, pred_cmd = "carat = 1:10") +predict(result, pred_cmd = "clarity = levels(clarity)") +result <- regress(diamonds, "price", c("carat", "clarity"), int = "carat:clarity") +predict(result, pred_data = diamonds) \%>\% head() + +} +\seealso{ +\code{\link{regress}} to generate the result + +\code{\link{summary.regress}} to summarize results + +\code{\link{plot.regress}} to plot results +} diff --git a/radiant.model/man/predict.rforest.Rd b/radiant.model/man/predict.rforest.Rd new file mode 100644 index 0000000000000000000000000000000000000000..47b82c48854f0788f509ba75c78eb43499d9970d --- /dev/null +++ b/radiant.model/man/predict.rforest.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rforest.R +\name{predict.rforest} +\alias{predict.rforest} +\title{Predict method for the rforest function} +\usage{ +\method{predict}{rforest}( + object, + pred_data = NULL, + pred_cmd = "", + pred_names = "", + OOB = NULL, + dec = 3, + envir = parent.frame(), + ... +) +} +\arguments{ +\item{object}{Return value from \code{\link{rforest}}} + +\item{pred_data}{Provide the dataframe to generate predictions (e.g., diamonds). The dataset must contain all columns used in the estimation} + +\item{pred_cmd}{Generate predictions using a command. For example, `pclass = levels(pclass)` would produce predictions for the different +levels of factor `pclass`. To add another variable, create a vector of prediction strings, (e.g., c('pclass = levels(pclass)', 'age = seq(0,100,20)')} + +\item{pred_names}{Names for the predictions to be stored. If one name is provided, only the first column of predictions is stored. If empty, the levels +in the response variable of the rforest model will be used} + +\item{OOB}{Use Out-Of-Bag predictions (TRUE or FALSE). Relevant when evaluating predictions for the training sample. If set to NULL, datasets will be compared +to determine if OOB predictions should be used} + +\item{dec}{Number of decimals to show} + +\item{envir}{Environment to extract data from} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Predict method for the rforest function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/rforest.html} for an example in Radiant +} +\examples{ +result <- rforest(titanic, "survived", c("pclass", "sex"), lev = "Yes") +predict(result, pred_cmd = "pclass = levels(pclass)") +result <- rforest(diamonds, "price", "carat:color", type = "regression") +predict(result, pred_cmd = "carat = 1:3") +predict(result, pred_data = diamonds) \%>\% head() + +} +\seealso{ +\code{\link{rforest}} to generate the result + +\code{\link{summary.rforest}} to summarize results +} diff --git a/radiant.model/man/predict.svm.Rd b/radiant.model/man/predict.svm.Rd new file mode 100644 index 0000000000000000000000000000000000000000..96103d5e55fbb5d2cd8f41a281c78de33f30972f --- /dev/null +++ b/radiant.model/man/predict.svm.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/svm.R +\name{predict.svm} +\alias{predict.svm} +\title{Predict method} +\usage{ +\method{predict}{svm}( + object, + pred_data = NULL, + pred_cmd = "", + dec = 3, + envir = parent.frame(), + ... +) +} +\description{ +Predict method +} diff --git a/radiant.model/man/predict_model.Rd b/radiant.model/man/predict_model.Rd new file mode 100644 index 0000000000000000000000000000000000000000..912041e39863a783a16e7dfe389c1ac77e3cd058 --- /dev/null +++ b/radiant.model/man/predict_model.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/regress.R +\name{predict_model} +\alias{predict_model} +\title{Predict method for model functions} +\usage{ +predict_model( + object, + pfun, + mclass, + pred_data = NULL, + pred_cmd = "", + conf_lev = 0.95, + se = FALSE, + dec = 3, + envir = parent.frame(), + ... +) +} +\arguments{ +\item{object}{Return value from \code{\link{regress}}} + +\item{pfun}{Function to use for prediction} + +\item{mclass}{Model class to attach} + +\item{pred_data}{Dataset to use for prediction} + +\item{pred_cmd}{Command used to generate data for prediction (e.g., 'carat = 1:10')} + +\item{conf_lev}{Confidence level used to estimate confidence intervals (.95 is the default)} + +\item{se}{Logical that indicates if prediction standard errors should be calculated (default = FALSE)} + +\item{dec}{Number of decimals to show} + +\item{envir}{Environment to extract data from} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Predict method for model functions +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/regress.html} for an example in Radiant +} diff --git a/radiant.model/man/print.coxp.predict.Rd b/radiant.model/man/print.coxp.predict.Rd new file mode 100644 index 0000000000000000000000000000000000000000..4eda373a5d3ec19e582911b6cc022c6de04ab62c --- /dev/null +++ b/radiant.model/man/print.coxp.predict.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cox.R +\name{print.coxp.predict} +\alias{print.coxp.predict} +\title{Print 预测占位} +\usage{ +\method{print}{coxp.predict}(x, ..., n = 10) +} +\description{ +Print 预测占位 +} diff --git a/radiant.model/man/print.crtree.predict.Rd b/radiant.model/man/print.crtree.predict.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a4eac4ae29adcc8c4265760c4b5d3b245492ab51 --- /dev/null +++ b/radiant.model/man/print.crtree.predict.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/crtree.R +\name{print.crtree.predict} +\alias{print.crtree.predict} +\title{Print method for predict.crtree} +\usage{ +\method{print}{crtree.predict}(x, ..., n = 10) +} +\arguments{ +\item{x}{Return value from prediction method} + +\item{...}{further arguments passed to or from other methods} + +\item{n}{Number of lines of prediction results to print. Use -1 to print all lines} +} +\description{ +Print method for predict.crtree +} diff --git a/radiant.model/man/print.gbt.predict.Rd b/radiant.model/man/print.gbt.predict.Rd new file mode 100644 index 0000000000000000000000000000000000000000..e7ebc25f50b2069ee304ff7c4affce46eaa340da --- /dev/null +++ b/radiant.model/man/print.gbt.predict.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gbt.R +\name{print.gbt.predict} +\alias{print.gbt.predict} +\title{Print method for predict.gbt} +\usage{ +\method{print}{gbt.predict}(x, ..., n = 10) +} +\arguments{ +\item{x}{Return value from prediction method} + +\item{...}{further arguments passed to or from other methods} + +\item{n}{Number of lines of prediction results to print. Use -1 to print all lines} +} +\description{ +Print method for predict.gbt +} diff --git a/radiant.model/man/print.logistic.predict.Rd b/radiant.model/man/print.logistic.predict.Rd new file mode 100644 index 0000000000000000000000000000000000000000..055b94ed3e694b80683e06bf805f10357ea48662 --- /dev/null +++ b/radiant.model/man/print.logistic.predict.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/logistic.R +\name{print.logistic.predict} +\alias{print.logistic.predict} +\title{Print method for logistic.predict} +\usage{ +\method{print}{logistic.predict}(x, ..., n = 10) +} +\arguments{ +\item{x}{Return value from prediction method} + +\item{...}{further arguments passed to or from other methods} + +\item{n}{Number of lines of prediction results to print. Use -1 to print all lines} +} +\description{ +Print method for logistic.predict +} diff --git a/radiant.model/man/print.mnl.predict.Rd b/radiant.model/man/print.mnl.predict.Rd new file mode 100644 index 0000000000000000000000000000000000000000..2f4f7bb1900a5eca480a48e898bc2045c9db1c94 --- /dev/null +++ b/radiant.model/man/print.mnl.predict.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mnl.R +\name{print.mnl.predict} +\alias{print.mnl.predict} +\title{Print method for mnl.predict} +\usage{ +\method{print}{mnl.predict}(x, ..., n = 10) +} +\arguments{ +\item{x}{Return value from prediction method} + +\item{...}{further arguments passed to or from other methods} + +\item{n}{Number of lines of prediction results to print. Use -1 to print all lines} +} +\description{ +Print method for mnl.predict +} diff --git a/radiant.model/man/print.nb.predict.Rd b/radiant.model/man/print.nb.predict.Rd new file mode 100644 index 0000000000000000000000000000000000000000..412ffc560ffcfdf5ecde73ce7190a738d3af35c8 --- /dev/null +++ b/radiant.model/man/print.nb.predict.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nb.R +\name{print.nb.predict} +\alias{print.nb.predict} +\title{Print method for predict.nb} +\usage{ +\method{print}{nb.predict}(x, ..., n = 10) +} +\arguments{ +\item{x}{Return value from prediction method} + +\item{...}{further arguments passed to or from other methods} + +\item{n}{Number of lines of prediction results to print. Use -1 to print all lines} +} +\description{ +Print method for predict.nb +} diff --git a/radiant.model/man/print.nn.predict.Rd b/radiant.model/man/print.nn.predict.Rd new file mode 100644 index 0000000000000000000000000000000000000000..bb9d1c360d1c9d51c478f0ebc78068485aab0c48 --- /dev/null +++ b/radiant.model/man/print.nn.predict.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nn.R +\name{print.nn.predict} +\alias{print.nn.predict} +\title{Print method for predict.nn} +\usage{ +\method{print}{nn.predict}(x, ..., n = 10) +} +\arguments{ +\item{x}{Return value from prediction method} + +\item{...}{further arguments passed to or from other methods} + +\item{n}{Number of lines of prediction results to print. Use -1 to print all lines} +} +\description{ +Print method for predict.nn +} diff --git a/radiant.model/man/print.regress.predict.Rd b/radiant.model/man/print.regress.predict.Rd new file mode 100644 index 0000000000000000000000000000000000000000..7c8160e4c66c9c35a44a0db2dcbd634886812a83 --- /dev/null +++ b/radiant.model/man/print.regress.predict.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/regress.R +\name{print.regress.predict} +\alias{print.regress.predict} +\title{Print method for predict.regress} +\usage{ +\method{print}{regress.predict}(x, ..., n = 10) +} +\arguments{ +\item{x}{Return value from prediction method} + +\item{...}{further arguments passed to or from other methods} + +\item{n}{Number of lines of prediction results to print. Use -1 to print all lines} +} +\description{ +Print method for predict.regress +} diff --git a/radiant.model/man/print.rforest.predict.Rd b/radiant.model/man/print.rforest.predict.Rd new file mode 100644 index 0000000000000000000000000000000000000000..4177307c8c86b59aa52e401e1b609bbe63fbb7d4 --- /dev/null +++ b/radiant.model/man/print.rforest.predict.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rforest.R +\name{print.rforest.predict} +\alias{print.rforest.predict} +\title{Print method for predict.rforest} +\usage{ +\method{print}{rforest.predict}(x, ..., n = 10) +} +\arguments{ +\item{x}{Return value from prediction method} + +\item{...}{further arguments passed to or from other methods} + +\item{n}{Number of lines of prediction results to print. Use -1 to print all lines} +} +\description{ +Print method for predict.rforest +} diff --git a/radiant.model/man/print.svm.predict.Rd b/radiant.model/man/print.svm.predict.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d65cec104dbb6a92eb0c36d11811ed9eac0939e4 --- /dev/null +++ b/radiant.model/man/print.svm.predict.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/svm.R +\name{print.svm.predict} +\alias{print.svm.predict} +\title{Print predictions} +\usage{ +\method{print}{svm.predict}(x, ..., n = 10) +} +\description{ +Print predictions +} diff --git a/radiant.model/man/print_predict_model.Rd b/radiant.model/man/print_predict_model.Rd new file mode 100644 index 0000000000000000000000000000000000000000..9f24dfb245e5138a7863987b24332865ecad98a0 --- /dev/null +++ b/radiant.model/man/print_predict_model.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/regress.R +\name{print_predict_model} +\alias{print_predict_model} +\title{Print method for the model prediction} +\usage{ +print_predict_model(x, ..., n = 10, header = "") +} +\arguments{ +\item{x}{Return value from prediction method} + +\item{...}{further arguments passed to or from other methods} + +\item{n}{Number of lines of prediction results to print. Use -1 to print all lines} + +\item{header}{Header line} +} +\description{ +Print method for the model prediction +} diff --git a/radiant.model/man/profit.Rd b/radiant.model/man/profit.Rd new file mode 100644 index 0000000000000000000000000000000000000000..19cd8367f310f7f3216dd75e9501be8a9eebfc8e --- /dev/null +++ b/radiant.model/man/profit.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/evalbin.R +\name{profit} +\alias{profit} +\title{Calculate Profit based on cost:margin ratio} +\usage{ +profit(pred, rvar, lev, cost = 1, margin = 2) +} +\arguments{ +\item{pred}{Prediction or predictor} + +\item{rvar}{Response variable} + +\item{lev}{The level in the response variable defined as success} + +\item{cost}{Cost per treatment (e.g., mailing costs)} + +\item{margin}{Margin, or benefit, per 'success' (e.g., customer purchase). A cost:margin ratio of 1:2 implies +the cost of False Positive are equivalent to the benefits of a True Positive} +} +\value{ +profit +} +\description{ +Calculate Profit based on cost:margin ratio +} +\examples{ +profit(runif(20000), dvd$buy, "yes", cost = 1, margin = 2) +profit(ifelse(dvd$buy == "yes", 1, 0), dvd$buy, "yes", cost = 1, margin = 20) +profit(ifelse(dvd$buy == "yes", 1, 0), dvd$buy) +} diff --git a/radiant.model/man/radiant.model-deprecated.Rd b/radiant.model/man/radiant.model-deprecated.Rd new file mode 100644 index 0000000000000000000000000000000000000000..b0c0b324f26696630f54014523f9bf368087cc80 --- /dev/null +++ b/radiant.model/man/radiant.model-deprecated.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/deprecated.R +\name{radiant.model-deprecated} +\alias{radiant.model-deprecated} +\alias{ann} +\title{Deprecated function(s) in the radiant.model package} +\usage{ +ann(...) +} +\arguments{ +\item{...}{Parameters to be passed to the updated functions} +} +\description{ +These functions are provided for compatibility with previous versions of +radiant. They will eventually be removed. +} +\section{Details}{ + +\tabular{rl}{ + \code{ann} is now a synonym for \code{\link{nn}}\cr + \code{scaledf} is now a synonym for \code{\link{scale_df}}\cr +} +} + diff --git a/radiant.model/man/radiant.model.Rd b/radiant.model/man/radiant.model.Rd new file mode 100644 index 0000000000000000000000000000000000000000..11919e754a07872932c2b601339060ed3023bd7f --- /dev/null +++ b/radiant.model/man/radiant.model.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R, R/radiant.R +\name{radiant.model} +\alias{radiant.model} +\title{radiant.model} +\usage{ +radiant.model(state, ...) +} +\arguments{ +\item{state}{Path to state file to load} + +\item{...}{additional arguments to pass to shiny::runApp (e.g, port = 8080)} +} +\description{ +Launch radiant.model in the default web browser +} +\details{ +See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +} +\examples{ +\dontrun{ +radiant.model() +} +} diff --git a/radiant.model/man/radiant.model_viewer.Rd b/radiant.model/man/radiant.model_viewer.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a41230fd8eeb53523cafe79d6d58ef15b2bf6f1e --- /dev/null +++ b/radiant.model/man/radiant.model_viewer.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{radiant.model_viewer} +\alias{radiant.model_viewer} +\title{Launch radiant.model in the Rstudio viewer} +\usage{ +radiant.model_viewer(state, ...) +} +\arguments{ +\item{state}{Path to state file to load} + +\item{...}{additional arguments to pass to shiny::runApp (e.g, port = 8080)} +} +\description{ +Launch radiant.model in the Rstudio viewer +} +\details{ +See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +} +\examples{ +\dontrun{ +radiant.model_viewer() +} +} diff --git a/radiant.model/man/radiant.model_window.Rd b/radiant.model/man/radiant.model_window.Rd new file mode 100644 index 0000000000000000000000000000000000000000..103881544b1e1de4b9f18574f783626af2aa2749 --- /dev/null +++ b/radiant.model/man/radiant.model_window.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{radiant.model_window} +\alias{radiant.model_window} +\title{Launch radiant.model in an Rstudio window} +\usage{ +radiant.model_window(state, ...) +} +\arguments{ +\item{state}{Path to state file to load} + +\item{...}{additional arguments to pass to shiny::runApp (e.g, port = 8080)} +} +\description{ +Launch radiant.model in an Rstudio window +} +\details{ +See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +} +\examples{ +\dontrun{ +radiant.model_window() +} +} diff --git a/radiant.model/man/ratings.Rd b/radiant.model/man/ratings.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f1e20a6c66c7cbbc89d63f8b303817a03f398acc --- /dev/null +++ b/radiant.model/man/ratings.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{ratings} +\alias{ratings} +\title{Movie ratings} +\format{ +A data frame with 110 rows and 4 variables +} +\usage{ +data(ratings) +} +\description{ +Movie ratings +} +\details{ +Use collaborative filtering to create recommendations based on ratings from existing users. Description provided in attr(ratings, "description") +} +\keyword{datasets} diff --git a/radiant.model/man/regress.Rd b/radiant.model/man/regress.Rd new file mode 100644 index 0000000000000000000000000000000000000000..692082e7c35c12f67339f4ca28320a097f011d2f --- /dev/null +++ b/radiant.model/man/regress.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/regress.R +\name{regress} +\alias{regress} +\title{Linear regression using OLS} +\usage{ +regress( + dataset, + rvar, + evar, + int = "", + check = "", + form, + data_filter = "", + arr = "", + rows = NULL, + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{rvar}{The response variable in the regression} + +\item{evar}{Explanatory variables in the regression} + +\item{int}{Interaction terms to include in the model} + +\item{check}{Use "standardize" to see standardized coefficient estimates. Use "stepwise-backward" (or "stepwise-forward", or "stepwise-both") to apply step-wise selection of variables in estimation. Add "robust" for robust estimation of standard errors (HC1)} + +\item{form}{Optional formula to use instead of rvar, evar, and int} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{arr}{Expression to arrange (sort) the data on (e.g., "color, desc(price)")} + +\item{rows}{Rows to select from the specified dataset} + +\item{envir}{Environment to extract data from} +} +\value{ +A list of all variables used in the regress function as an object of class regress +} +\description{ +Linear regression using OLS +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/regress.html} for an example in Radiant +} +\examples{ +regress(diamonds, "price", c("carat", "clarity"), check = "standardize") \%>\% summary() +regress(diamonds, "price", c("carat", "clarity")) \%>\% str() + +} +\seealso{ +\code{\link{summary.regress}} to summarize results + +\code{\link{plot.regress}} to plot results + +\code{\link{predict.regress}} to generate predictions +} diff --git a/radiant.model/man/remove_comments.Rd b/radiant.model/man/remove_comments.Rd new file mode 100644 index 0000000000000000000000000000000000000000..47bf09c319f53f707f1c2588fc62f6be4dfbd5b8 --- /dev/null +++ b/radiant.model/man/remove_comments.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simulater.R +\name{remove_comments} +\alias{remove_comments} +\title{Remove comments from formula before it is evaluated} +\usage{ +remove_comments(x) +} +\arguments{ +\item{x}{Input string} +} +\value{ +Cleaned string +} +\description{ +Remove comments from formula before it is evaluated +} diff --git a/radiant.model/man/render.DiagrammeR.Rd b/radiant.model/man/render.DiagrammeR.Rd new file mode 100644 index 0000000000000000000000000000000000000000..14e29c5a3ccd49d6673deeb27842ac20a284f3c9 --- /dev/null +++ b/radiant.model/man/render.DiagrammeR.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{render.DiagrammeR} +\alias{render.DiagrammeR} +\title{Method to render DiagrammeR plots} +\usage{ +\method{render}{DiagrammeR}(object, shiny = shiny::getDefaultReactiveDomain(), ...) +} +\arguments{ +\item{object}{DiagrammeR plot} + +\item{shiny}{Check if function is called from a shiny application} + +\item{...}{Additional arguments} +} +\description{ +Method to render DiagrammeR plots +} diff --git a/radiant.model/man/repeater.Rd b/radiant.model/man/repeater.Rd new file mode 100644 index 0000000000000000000000000000000000000000..11fe8b60feec5433523bbb185988dd8df763376a --- /dev/null +++ b/radiant.model/man/repeater.Rd @@ -0,0 +1,79 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simulater.R +\name{repeater} +\alias{repeater} +\title{Repeated simulation} +\usage{ +repeater( + dataset, + nr = 12, + vars = "", + grid = "", + sum_vars = "", + byvar = ".sim", + fun = "sum", + form = "", + seed = NULL, + name = "", + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Return value from the simulater function} + +\item{nr}{Number times to repeat the simulation} + +\item{vars}{Variables to use in repeated simulation} + +\item{grid}{Character vector of expressions to use in grid search for constants} + +\item{sum_vars}{(Numeric) variables to summaries} + +\item{byvar}{Variable(s) to group data by before summarizing} + +\item{fun}{Functions to use for summarizing} + +\item{form}{A character vector with the formula to apply to the summarized data} + +\item{seed}{Seed for the repeated simulation} + +\item{name}{Deprecated argument} + +\item{envir}{Environment to extract data from} +} +\description{ +Repeated simulation +} +\examples{ +simdat <- simulater( + const = c("var_cost 5", "fixed_cost 1000"), + norm = "E 0 100;", + discrete = "price 6 8 .3 .7;", + form = c( + "demand = 1000 - 50*price + E", + "profit = demand*(price-var_cost) - fixed_cost", + "profit_small = profit < 100" + ), + seed = 1234 +) + +repdat <- repeater( + simdat, + nr = 12, + vars = c("E", "price"), + sum_vars = "profit", + byvar = ".sim", + form = "profit_365 = profit_sum < 36500", + seed = 1234, +) + +head(repdat) +summary(repdat) +plot(repdat) + +} +\seealso{ +\code{\link{summary.repeater}} to summarize results from repeated simulation + +\code{\link{plot.repeater}} to plot results from repeated simulation +} diff --git a/radiant.model/man/rforest.Rd b/radiant.model/man/rforest.Rd new file mode 100644 index 0000000000000000000000000000000000000000..9424e8ba0b27e96a49fe9ae0aa5cd1eac1ed0136 --- /dev/null +++ b/radiant.model/man/rforest.Rd @@ -0,0 +1,87 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rforest.R +\name{rforest} +\alias{rforest} +\title{Random Forest using Ranger} +\usage{ +rforest( + dataset, + rvar, + evar, + type = "classification", + lev = "", + mtry = NULL, + num.trees = 100, + min.node.size = 1, + sample.fraction = 1, + replace = NULL, + num.threads = 12, + wts = "None", + seed = NA, + data_filter = "", + arr = "", + rows = NULL, + envir = parent.frame(), + ... +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{rvar}{The response variable in the model} + +\item{evar}{Explanatory variables in the model} + +\item{type}{Model type (i.e., "classification" or "regression")} + +\item{lev}{Level to use as the first column in prediction output} + +\item{mtry}{Number of variables to possibly split at in each node. Default is the (rounded down) square root of the number variables} + +\item{num.trees}{Number of trees to create} + +\item{min.node.size}{Minimal node size} + +\item{sample.fraction}{Fraction of observations to sample. Default is 1 for sampling with replacement and 0.632 for sampling without replacement} + +\item{replace}{Sample with (TRUE) or without (FALSE) replacement. If replace is NULL it will be reset to TRUE if the sample.fraction is equal to 1 and will be set to FALSE otherwise} + +\item{num.threads}{Number of parallel threads to use. Defaults to 12 if available} + +\item{wts}{Case weights to use in estimation} + +\item{seed}{Random seed to use as the starting point} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{arr}{Expression to arrange (sort) the data on (e.g., "color, desc(price)")} + +\item{rows}{Rows to select from the specified dataset} + +\item{envir}{Environment to extract data from} + +\item{...}{Further arguments to pass to ranger} +} +\value{ +A list with all variables defined in rforest as an object of class rforest +} +\description{ +Random Forest using Ranger +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/rforest.html} for an example in Radiant +} +\examples{ +rforest(titanic, "survived", c("pclass", "sex"), lev = "Yes") \%>\% summary() +rforest(titanic, "survived", c("pclass", "sex")) \%>\% str() +rforest(titanic, "survived", c("pclass", "sex"), max.depth = 1) +rforest(diamonds, "price", c("carat", "clarity"), type = "regression") \%>\% summary() + +} +\seealso{ +\code{\link{summary.rforest}} to summarize results + +\code{\link{plot.rforest}} to plot results + +\code{\link{predict.rforest}} for prediction +} diff --git a/radiant.model/man/rig.Rd b/radiant.model/man/rig.Rd new file mode 100644 index 0000000000000000000000000000000000000000..43abba333b64e03af62f1f5c7b18bea91edba70f --- /dev/null +++ b/radiant.model/man/rig.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/evalbin.R +\name{rig} +\alias{rig} +\title{Relative Information Gain (RIG)} +\usage{ +rig(pred, rvar, lev, crv = 1e-07, na.rm = TRUE) +} +\arguments{ +\item{pred}{Prediction or predictor} + +\item{rvar}{Response variable} + +\item{lev}{The level in the response variable defined as success} + +\item{crv}{Correction value to avoid log(0)} + +\item{na.rm}{Logical that indicates if missing values should be removed (TRUE) or not (FALSE)} +} +\value{ +RIG statistic +} +\description{ +Relative Information Gain (RIG) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +} +\examples{ +rig(runif(20000), dvd$buy, "yes") +rig(ifelse(dvd$buy == "yes", 1, 0), dvd$buy, "yes") +} +\seealso{ +\code{\link{evalbin}} to calculate results + +\code{\link{summary.evalbin}} to summarize results + +\code{\link{plot.evalbin}} to plot results +} diff --git a/radiant.model/man/scale_df.Rd b/radiant.model/man/scale_df.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d5c196e174f004226d1a8d130e33035769367c7e --- /dev/null +++ b/radiant.model/man/scale_df.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nn.R +\name{scale_df} +\alias{scale_df} +\title{Center or standardize variables in a data frame} +\usage{ +scale_df(dataset, center = TRUE, scale = TRUE, sf = 2, wts = NULL, calc = TRUE) +} +\arguments{ +\item{dataset}{Data frame} + +\item{center}{Center data (TRUE or FALSE)} + +\item{scale}{Scale data (TRUE or FALSE)} + +\item{sf}{Scaling factor (default is 2)} + +\item{wts}{Weights to use (default is NULL for no weights)} + +\item{calc}{Calculate mean and sd or use attributes attached to dat} +} +\value{ +Scaled data frame +} +\description{ +Center or standardize variables in a data frame +} diff --git a/radiant.model/man/sdw.Rd b/radiant.model/man/sdw.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f78cacfedb5068a1fe2112ac9a296d056283f215 --- /dev/null +++ b/radiant.model/man/sdw.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simulater.R +\name{sdw} +\alias{sdw} +\title{Standard deviation of weighted sum of variables} +\usage{ +sdw(...) +} +\arguments{ +\item{...}{A matched number of weights and stocks} +} +\value{ +A vector of standard deviation estimates +} +\description{ +Standard deviation of weighted sum of variables +} diff --git a/radiant.model/man/sensitivity.Rd b/radiant.model/man/sensitivity.Rd new file mode 100644 index 0000000000000000000000000000000000000000..65a4a54945530dfbf437320ee7f14a0ee12e5bda --- /dev/null +++ b/radiant.model/man/sensitivity.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{sensitivity} +\alias{sensitivity} +\title{Method to evaluate sensitivity of an analysis} +\usage{ +sensitivity(object, ...) +} +\arguments{ +\item{object}{Object of relevant class for which to evaluate sensitivity} + +\item{...}{Additional arguments} +} +\description{ +Method to evaluate sensitivity of an analysis +} +\seealso{ +\code{\link{sensitivity.dtree}} to plot results +} diff --git a/radiant.model/man/sensitivity.dtree.Rd b/radiant.model/man/sensitivity.dtree.Rd new file mode 100644 index 0000000000000000000000000000000000000000..22f641f298b2a558529bf992ce71e61e0a532c51 --- /dev/null +++ b/radiant.model/man/sensitivity.dtree.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dtree.R +\name{sensitivity.dtree} +\alias{sensitivity.dtree} +\title{Evaluate sensitivity of the decision tree} +\usage{ +\method{sensitivity}{dtree}( + object, + vars = NULL, + decs = NULL, + envir = parent.frame(), + shiny = FALSE, + custom = FALSE, + ... +) +} +\arguments{ +\item{object}{Return value from \code{\link{dtree}}} + +\item{vars}{Variables to include in the sensitivity analysis} + +\item{decs}{Decisions to include in the sensitivity analysis} + +\item{envir}{Environment to extract data from} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org} for options.} + +\item{...}{Additional arguments} +} +\description{ +Evaluate sensitivity of the decision tree +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/dtree.html} for an example in Radiant +} +\examples{ +dtree(movie_contract, opt = "max") \%>\% + sensitivity( + vars = "legal fees 0 100000 10000", + decs = c("Sign with Movie Company", "Sign with TV Network"), + custom = FALSE + ) + +} +\seealso{ +\code{\link{dtree}} to generate the result + +\code{\link{plot.dtree}} to summarize results + +\code{\link{summary.dtree}} to summarize results +} diff --git a/radiant.model/man/sim_cleaner.Rd b/radiant.model/man/sim_cleaner.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a02a0d47532abfd87329159972bb379de7c4e20f --- /dev/null +++ b/radiant.model/man/sim_cleaner.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simulater.R +\name{sim_cleaner} +\alias{sim_cleaner} +\title{Clean input command string} +\usage{ +sim_cleaner(x) +} +\arguments{ +\item{x}{Input string} +} +\value{ +Cleaned string +} +\description{ +Clean input command string +} diff --git a/radiant.model/man/sim_cor.Rd b/radiant.model/man/sim_cor.Rd new file mode 100644 index 0000000000000000000000000000000000000000..7f35494aa387666dcb91d233126dfadd61e8d357 --- /dev/null +++ b/radiant.model/man/sim_cor.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simulater.R +\name{sim_cor} +\alias{sim_cor} +\title{Simulate correlated normally distributed data} +\usage{ +sim_cor(n, rho, means, sds, exact = FALSE) +} +\arguments{ +\item{n}{The number of values to simulate (i.e., the number of rows in the simulated data)} + +\item{rho}{A vector of correlations to apply to the columns of the simulated data. The number of values should be equal to one or to the number of combinations of variables to be simulated} + +\item{means}{A vector of means. The number of values should be equal to the number of variables to simulate} + +\item{sds}{A vector of standard deviations. The number of values should be equal to the number of variables to simulate} + +\item{exact}{A logical that indicates if the inputs should be interpreted as population of sample characteristics} +} +\value{ +A data.frame with the simulated data +} +\description{ +Simulate correlated normally distributed data +} +\examples{ +sim <- sim_cor(100, .74, c(0, 10), c(1, 5), exact = TRUE) +cor(sim) +sim_summary(sim) + +} diff --git a/radiant.model/man/sim_splitter.Rd b/radiant.model/man/sim_splitter.Rd new file mode 100644 index 0000000000000000000000000000000000000000..0e85bec427799f4e062f0978d829ad2f3207ca5b --- /dev/null +++ b/radiant.model/man/sim_splitter.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simulater.R +\name{sim_splitter} +\alias{sim_splitter} +\title{Split input command string} +\usage{ +sim_splitter(x, symbol = " ") +} +\arguments{ +\item{x}{Input string} + +\item{symbol}{Symbol used to split the command string} +} +\value{ +Split input command string +} +\description{ +Split input command string +} diff --git a/radiant.model/man/sim_summary.Rd b/radiant.model/man/sim_summary.Rd new file mode 100644 index 0000000000000000000000000000000000000000..54693501582318143c15b56875baeb2aa7e4017b --- /dev/null +++ b/radiant.model/man/sim_summary.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simulater.R +\name{sim_summary} +\alias{sim_summary} +\title{Print simulation summary} +\usage{ +sim_summary(dataset, dc = get_class(dataset), fun = "", dec = 4) +} +\arguments{ +\item{dataset}{Simulated data} + +\item{dc}{Variable classes} + +\item{fun}{Summary function to apply} + +\item{dec}{Number of decimals to show} +} +\description{ +Print simulation summary +} +\examples{ +simulater( + const = "cost 3", + norm = "demand 2000 1000", + discrete = "price 5 8 .3 .7", + form = c("profit = demand * (price - cost)", "profit5K = profit > 5000"), + seed = 1234 +) \%>\% sim_summary() + +} +\seealso{ +\code{\link{simulater}} to run a simulation + +\code{\link{repeater}} to run a repeated simulation +} diff --git a/radiant.model/man/simulater.Rd b/radiant.model/man/simulater.Rd new file mode 100644 index 0000000000000000000000000000000000000000..830ab8b3b83a3db90c50e501f11a517b9763b2be --- /dev/null +++ b/radiant.model/man/simulater.Rd @@ -0,0 +1,91 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simulater.R +\name{simulater} +\alias{simulater} +\title{Simulate data for decision analysis} +\usage{ +simulater( + const = "", + lnorm = "", + norm = "", + unif = "", + discrete = "", + binom = "", + pois = "", + sequ = "", + grid = "", + data = NULL, + form = "", + funcs = "", + seed = NULL, + nexact = FALSE, + ncorr = NULL, + name = "", + nr = 1000, + dataset = NULL, + envir = parent.frame() +) +} +\arguments{ +\item{const}{A character vector listing the constants to include in the analysis (e.g., c("cost = 3", "size = 4"))} + +\item{lnorm}{A character vector listing the log-normally distributed random variables to include in the analysis (e.g., "demand 2000 1000" where the first number is the log-mean and the second is the log-standard deviation)} + +\item{norm}{A character vector listing the normally distributed random variables to include in the analysis (e.g., "demand 2000 1000" where the first number is the mean and the second is the standard deviation)} + +\item{unif}{A character vector listing the uniformly distributed random variables to include in the analysis (e.g., "demand 0 1" where the first number is the minimum value and the second is the maximum value)} + +\item{discrete}{A character vector listing the random variables with a discrete distribution to include in the analysis (e.g., "price 5 8 .3 .7" where the first set of numbers are the values and the second set the probabilities} + +\item{binom}{A character vector listing the random variables with a binomial distribution to include in the analysis (e.g., "crash 100 .01") where the first number is the number of trials and the second is the probability of success)} + +\item{pois}{A character vector listing the random variables with a poisson distribution to include in the analysis (e.g., "demand 10") where the number is the lambda value (i.e., the average number of events or the event rate)} + +\item{sequ}{A character vector listing the start and end for a sequence to include in the analysis (e.g., "trend 1 100 1"). The number of 'steps' is determined by the number of simulations} + +\item{grid}{A character vector listing the start, end, and step for a set of sequences to include in the analysis (e.g., "trend 1 100 1"). The number of rows in the expanded will over ride the number of simulations} + +\item{data}{Dataset to be used in the calculations} + +\item{form}{A character vector with the formula to evaluate (e.g., "profit = demand * (price - cost)")} + +\item{funcs}{A named list of user defined functions to apply to variables generated as part of the simulation} + +\item{seed}{Optional seed used in simulation} + +\item{nexact}{Logical to indicate if normally distributed random variables should be simulated to the exact specified values} + +\item{ncorr}{A string of correlations used for normally distributed random variables. The number of values should be equal to one or to the number of combinations of variables simulated} + +\item{name}{Deprecated argument} + +\item{nr}{Number of simulations} + +\item{dataset}{Data list from previous simulation. Used by repeater function} + +\item{envir}{Environment to extract data from} +} +\value{ +A data.frame with the simulated data +} +\description{ +Simulate data for decision analysis +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/simulater.html} for an example in Radiant +} +\examples{ +simulater( + const = "cost 3", + norm = "demand 2000 1000", + discrete = "price 5 8 .3 .7", + form = "profit = demand * (price - cost)", + seed = 1234 +) \%>\% str() + +} +\seealso{ +\code{\link{summary.simulater}} to summarize results + +\code{\link{plot.simulater}} to plot results +} diff --git a/radiant.model/man/store.crs.Rd b/radiant.model/man/store.crs.Rd new file mode 100644 index 0000000000000000000000000000000000000000..3dd987e73a4f6584827062008016ae61ec525f22 --- /dev/null +++ b/radiant.model/man/store.crs.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/crs.R +\name{store.crs} +\alias{store.crs} +\title{Deprecated: Store method for the crs function} +\usage{ +\method{store}{crs}(dataset, object, name, ...) +} +\arguments{ +\item{dataset}{Dataset} + +\item{object}{Return value from \code{\link{crs}}} + +\item{name}{Name to assign to the dataset} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Deprecated: Store method for the crs function +} +\details{ +Return recommendations See \url{https://radiant-rstats.github.io/docs/model/crs.html} for an example in Radiant +} diff --git a/radiant.model/man/store.mnl.predict.Rd b/radiant.model/man/store.mnl.predict.Rd new file mode 100644 index 0000000000000000000000000000000000000000..56236f3611da8ec2441528f44f9e7fb86188595c --- /dev/null +++ b/radiant.model/man/store.mnl.predict.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mnl.R +\name{store.mnl.predict} +\alias{store.mnl.predict} +\title{Store predicted values generated in the mnl function} +\usage{ +\method{store}{mnl.predict}(dataset, object, name = NULL, ...) +} +\arguments{ +\item{dataset}{Dataset to add predictions to} + +\item{object}{Return value from model function} + +\item{name}{Variable name(s) assigned to predicted values. If empty, the levels of the response variable will be used} + +\item{...}{Additional arguments} +} +\description{ +Store predicted values generated in the mnl function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/mnl.html} for an example in Radiant +} +\examples{ +result <- mnl( + ketchup, + rvar = "choice", + evar = c("price.heinz28", "price.heinz32", "price.heinz41", "price.hunts32"), + lev = "heinz28" +) +pred <- predict(result, pred_data = ketchup) +ketchup <- store(ketchup, pred, name = c("heinz28", "heinz32", "heinz41", "hunts32")) + +} diff --git a/radiant.model/man/store.model.Rd b/radiant.model/man/store.model.Rd new file mode 100644 index 0000000000000000000000000000000000000000..3c4970a9906eb2135bb35d35d5c7726e33079b48 --- /dev/null +++ b/radiant.model/man/store.model.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/regress.R +\name{store.model} +\alias{store.model} +\title{Store residuals from a model} +\usage{ +\method{store}{model}(dataset, object, name = "residuals", ...) +} +\arguments{ +\item{dataset}{Dataset to append residuals to} + +\item{object}{Return value from a model function} + +\item{name}{Variable name(s) assigned to model residuals} + +\item{...}{Additional arguments} +} +\description{ +Store residuals from a model +} +\details{ +The store method for objects of class "model". Adds model residuals to the dataset while handling missing values and filters. See \url{https://radiant-rstats.github.io/docs/model/regress.html} for an example in Radiant +} +\examples{ +regress(diamonds, rvar = "price", evar = c("carat", "cut"), data_filter = "price > 1000") \%>\% + store(diamonds, ., name = "resid") \%>\% + head() + +} diff --git a/radiant.model/man/store.model.predict.Rd b/radiant.model/man/store.model.predict.Rd new file mode 100644 index 0000000000000000000000000000000000000000..7b4b44e018eb01ebafd55d4a7691d7e007ad796a --- /dev/null +++ b/radiant.model/man/store.model.predict.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/regress.R +\name{store.model.predict} +\alias{store.model.predict} +\title{Store predicted values generated in model functions} +\usage{ +\method{store}{model.predict}(dataset, object, name = "prediction", ...) +} +\arguments{ +\item{dataset}{Dataset to add predictions to} + +\item{object}{Return value from model function} + +\item{name}{Variable name(s) assigned to predicted values} + +\item{...}{Additional arguments} +} +\description{ +Store predicted values generated in model functions +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/regress.html} for an example in Radiant +} +\examples{ +regress(diamonds, rvar = "price", evar = c("carat", "cut")) \%>\% + predict(pred_data = diamonds) \%>\% + store(diamonds, ., name = c("pred", "pred_low", "pred_high")) \%>\% + head() + +} diff --git a/radiant.model/man/store.nb.predict.Rd b/radiant.model/man/store.nb.predict.Rd new file mode 100644 index 0000000000000000000000000000000000000000..141788c0025524e95cadbbef357b51882059153c --- /dev/null +++ b/radiant.model/man/store.nb.predict.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nb.R +\name{store.nb.predict} +\alias{store.nb.predict} +\title{Store predicted values generated in the nb function} +\usage{ +\method{store}{nb.predict}(dataset, object, name = NULL, ...) +} +\arguments{ +\item{dataset}{Dataset to add predictions to} + +\item{object}{Return value from model function} + +\item{name}{Variable name(s) assigned to predicted values. If empty, the levels of the response variable will be used} + +\item{...}{Additional arguments} +} +\description{ +Store predicted values generated in the nb function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/nb.html} for an example in Radiant +} +\examples{ +result <- nb(titanic, rvar = "survived", evar = c("pclass", "sex", "age")) +pred <- predict(result, pred_data = titanic) +titanic <- store(titanic, pred, name = c("Yes", "No")) + +} diff --git a/radiant.model/man/store.rforest.predict.Rd b/radiant.model/man/store.rforest.predict.Rd new file mode 100644 index 0000000000000000000000000000000000000000..60f2325624c30d6652d15133842e885f36b6171e --- /dev/null +++ b/radiant.model/man/store.rforest.predict.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rforest.R +\name{store.rforest.predict} +\alias{store.rforest.predict} +\title{Store predicted values generated in the rforest function} +\usage{ +\method{store}{rforest.predict}(dataset, object, name = NULL, ...) +} +\arguments{ +\item{dataset}{Dataset to add predictions to} + +\item{object}{Return value from model function} + +\item{name}{Variable name(s) assigned to predicted values. If empty, the levels of the response variable will be used} + +\item{...}{Additional arguments} +} +\description{ +Store predicted values generated in the rforest function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/rforest.html} for an example in Radiant +} +\examples{ +result <- rforest( + ketchup, + rvar = "choice", + evar = c("price.heinz28", "price.heinz32", "price.heinz41", "price.hunts32"), + lev = "heinz28" +) +pred <- predict(result, pred_data = ketchup) +ketchup <- store(ketchup, pred, name = c("heinz28", "heinz32", "heinz41", "hunts32")) + +} diff --git a/radiant.model/man/summary.confusion.Rd b/radiant.model/man/summary.confusion.Rd new file mode 100644 index 0000000000000000000000000000000000000000..bb86739497802366fcd6c444049684df02cfe581 --- /dev/null +++ b/radiant.model/man/summary.confusion.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/evalbin.R +\name{summary.confusion} +\alias{summary.confusion} +\title{Summary method for the confusion matrix} +\usage{ +\method{summary}{confusion}(object, dec = 3, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{confusion}}} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the confusion matrix +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +} +\examples{ +data.frame(buy = dvd$buy, pred1 = runif(20000), pred2 = ifelse(dvd$buy == "yes", 1, 0)) \%>\% + confusion(c("pred1", "pred2"), "buy") \%>\% + summary() +} +\seealso{ +\code{\link{confusion}} to generate results + +\code{\link{plot.confusion}} to visualize result +} diff --git a/radiant.model/man/summary.coxp.Rd b/radiant.model/man/summary.coxp.Rd new file mode 100644 index 0000000000000000000000000000000000000000..955a0cb5a78da5c13fd879f273b4c250d04a7d9a --- /dev/null +++ b/radiant.model/man/summary.coxp.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cox.R +\name{summary.coxp} +\alias{summary.coxp} +\title{Summary 占位} +\usage{ +\method{summary}{coxp}(object, ...) +} +\description{ +Summary 占位 +} diff --git a/radiant.model/man/summary.crs.Rd b/radiant.model/man/summary.crs.Rd new file mode 100644 index 0000000000000000000000000000000000000000..b7deb3776ff9644b58496895f6b53535cfe173bf --- /dev/null +++ b/radiant.model/man/summary.crs.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/crs.R +\name{summary.crs} +\alias{summary.crs} +\title{Summary method for Collaborative Filter} +\usage{ +\method{summary}{crs}(object, n = 36, dec = 2, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{crs}}} + +\item{n}{Number of lines of recommendations to print. Use -1 to print all lines} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for Collaborative Filter +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/crs.html} for an example in Radiant +} +\examples{ +crs(ratings, + id = "Users", prod = "Movies", pred = c("M6", "M7", "M8", "M9", "M10"), + rate = "Ratings", data_filter = "training == 1" +) \%>\% summary() +} +\seealso{ +\code{\link{crs}} to generate the results + +\code{\link{plot.crs}} to plot results if the actual ratings are available +} diff --git a/radiant.model/man/summary.crtree.Rd b/radiant.model/man/summary.crtree.Rd new file mode 100644 index 0000000000000000000000000000000000000000..edaed64c7eacc726ab72dd05ae187569812740af --- /dev/null +++ b/radiant.model/man/summary.crtree.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/crtree.R +\name{summary.crtree} +\alias{summary.crtree} +\title{Summary method for the crtree function} +\usage{ +\method{summary}{crtree}(object, prn = TRUE, splits = FALSE, cptab = FALSE, modsum = FALSE, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{crtree}}} + +\item{prn}{Print tree in text form} + +\item{splits}{Print the tree splitting metrics used} + +\item{cptab}{Print the cp table} + +\item{modsum}{Print the model summary} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the crtree function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/crtree.html} for an example in Radiant +} +\examples{ +result <- crtree(titanic, "survived", c("pclass", "sex"), lev = "Yes") +summary(result) +result <- crtree(diamonds, "price", c("carat", "color"), type = "regression") +summary(result) +} +\seealso{ +\code{\link{crtree}} to generate results + +\code{\link{plot.crtree}} to plot results + +\code{\link{predict.crtree}} for prediction +} diff --git a/radiant.model/man/summary.dtree.Rd b/radiant.model/man/summary.dtree.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a8d1122269c57c990be5ccf3625e8a553e8690fa --- /dev/null +++ b/radiant.model/man/summary.dtree.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dtree.R +\name{summary.dtree} +\alias{summary.dtree} +\title{Summary method for the dtree function} +\usage{ +\method{summary}{dtree}(object, input = TRUE, output = FALSE, dec = 2, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{simulater}}} + +\item{input}{Print decision tree input} + +\item{output}{Print decision tree output} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the dtree function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/dtree.html} for an example in Radiant +} +\examples{ +dtree(movie_contract, opt = "max") \%>\% summary(input = TRUE) +dtree(movie_contract, opt = "max") \%>\% summary(input = FALSE, output = TRUE) + +} +\seealso{ +\code{\link{dtree}} to generate the results + +\code{\link{plot.dtree}} to plot results + +\code{\link{sensitivity.dtree}} to plot results +} diff --git a/radiant.model/man/summary.evalbin.Rd b/radiant.model/man/summary.evalbin.Rd new file mode 100644 index 0000000000000000000000000000000000000000..8451d09bfe5f8f2a6ab3fcee68f4eeb1caa41852 --- /dev/null +++ b/radiant.model/man/summary.evalbin.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/evalbin.R +\name{summary.evalbin} +\alias{summary.evalbin} +\title{Summary method for the evalbin function} +\usage{ +\method{summary}{evalbin}(object, prn = TRUE, dec = 3, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{evalbin}}} + +\item{prn}{Print full table of measures per model and bin} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the evalbin function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +} +\examples{ +data.frame(buy = dvd$buy, pred1 = runif(20000), pred2 = ifelse(dvd$buy == "yes", 1, 0)) \%>\% + evalbin(c("pred1", "pred2"), "buy") \%>\% + summary() +} +\seealso{ +\code{\link{evalbin}} to summarize results + +\code{\link{plot.evalbin}} to plot results +} diff --git a/radiant.model/man/summary.evalreg.Rd b/radiant.model/man/summary.evalreg.Rd new file mode 100644 index 0000000000000000000000000000000000000000..090c8c0ed79a1c342e37431d758cbd6f526980f3 --- /dev/null +++ b/radiant.model/man/summary.evalreg.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/evalreg.R +\name{summary.evalreg} +\alias{summary.evalreg} +\title{Summary method for the evalreg function} +\usage{ +\method{summary}{evalreg}(object, dec = 3, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{evalreg}}} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the evalreg function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/evalreg.html} for an example in Radiant +} +\examples{ +data.frame(price = diamonds$price, pred1 = rnorm(3000), pred2 = diamonds$price) \%>\% + evalreg(pred = c("pred1", "pred2"), "price") \%>\% + summary() + +} +\seealso{ +\code{\link{evalreg}} to summarize results + +\code{\link{plot.evalreg}} to plot results +} diff --git a/radiant.model/man/summary.gbt.Rd b/radiant.model/man/summary.gbt.Rd new file mode 100644 index 0000000000000000000000000000000000000000..8e147b3f40834794cc1c954907bee9ac1c19be28 --- /dev/null +++ b/radiant.model/man/summary.gbt.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gbt.R +\name{summary.gbt} +\alias{summary.gbt} +\title{Summary method for the gbt function} +\usage{ +\method{summary}{gbt}(object, prn = TRUE, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{gbt}}} + +\item{prn}{Print iteration history} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the gbt function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/gbt.html} for an example in Radiant +} +\examples{ +result <- gbt( + titanic, "survived", c("pclass", "sex"), + early_stopping_rounds = 0, nthread = 1 +) +summary(result) +} +\seealso{ +\code{\link{gbt}} to generate results + +\code{\link{plot.gbt}} to plot results + +\code{\link{predict.gbt}} for prediction +} diff --git a/radiant.model/man/summary.logistic.Rd b/radiant.model/man/summary.logistic.Rd new file mode 100644 index 0000000000000000000000000000000000000000..ba362d15b9450a68ee4b7f6adabf31b46bb67208 --- /dev/null +++ b/radiant.model/man/summary.logistic.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/logistic.R +\name{summary.logistic} +\alias{summary.logistic} +\title{Summary method for the logistic function} +\usage{ +\method{summary}{logistic}(object, sum_check = "", conf_lev = 0.95, test_var = "", dec = 3, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{logistic}}} + +\item{sum_check}{Optional output. "vif" to show multicollinearity diagnostics. "confint" to show coefficient confidence interval estimates. "odds" to show odds ratios and confidence interval estimates.} + +\item{conf_lev}{Confidence level to use for coefficient and odds confidence intervals (.95 is the default)} + +\item{test_var}{Variables to evaluate in model comparison (i.e., a competing models Chi-squared test)} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the logistic function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/logistic.html} for an example in Radiant +} +\examples{ + +result <- logistic(titanic, "survived", "pclass", lev = "Yes") +result <- logistic(titanic, "survived", "pclass", lev = "Yes") +summary(result, test_var = "pclass") +res <- logistic(titanic, "survived", c("pclass", "sex"), int = "pclass:sex", lev = "Yes") +summary(res, sum_check = c("vif", "confint", "odds")) +titanic \%>\% + logistic("survived", c("pclass", "sex", "age"), lev = "Yes") \%>\% + summary("vif") +} +\seealso{ +\code{\link{logistic}} to generate the results + +\code{\link{plot.logistic}} to plot the results + +\code{\link{predict.logistic}} to generate predictions + +\code{\link{plot.model.predict}} to plot prediction output +} diff --git a/radiant.model/man/summary.mnl.Rd b/radiant.model/man/summary.mnl.Rd new file mode 100644 index 0000000000000000000000000000000000000000..223edb15aebf2135e1a42100025f42a0c7e3cf08 --- /dev/null +++ b/radiant.model/man/summary.mnl.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mnl.R +\name{summary.mnl} +\alias{summary.mnl} +\title{Summary method for the mnl function} +\usage{ +\method{summary}{mnl}(object, sum_check = "", conf_lev = 0.95, test_var = "", dec = 3, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{mnl}}} + +\item{sum_check}{Optional output. "confint" to show coefficient confidence interval estimates. "rrr" to show relative risk ratios (RRRs) and confidence interval estimates.} + +\item{conf_lev}{Confidence level to use for coefficient and RRRs confidence intervals (.95 is the default)} + +\item{test_var}{Variables to evaluate in model comparison (i.e., a competing models Chi-squared test)} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the mnl function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/mnl.html} for an example in Radiant +} +\examples{ +result <- mnl( + ketchup, + rvar = "choice", + evar = c("price.heinz28", "price.heinz32", "price.heinz41", "price.hunts32"), + lev = "heinz28" +) +summary(result) + +} +\seealso{ +\code{\link{mnl}} to generate the results + +\code{\link{plot.mnl}} to plot the results + +\code{\link{predict.mnl}} to generate predictions + +\code{\link{plot.model.predict}} to plot prediction output +} diff --git a/radiant.model/man/summary.nb.Rd b/radiant.model/man/summary.nb.Rd new file mode 100644 index 0000000000000000000000000000000000000000..200cb8af2edb52d0e54cbc0930b1c7ca5446e92c --- /dev/null +++ b/radiant.model/man/summary.nb.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nb.R +\name{summary.nb} +\alias{summary.nb} +\title{Summary method for the nb function} +\usage{ +\method{summary}{nb}(object, dec = 3, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{nb}}} + +\item{dec}{Decimals} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the nb function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/nb.html} for an example in Radiant +} +\examples{ +result <- nb(titanic, "survived", c("pclass", "sex", "age")) +summary(result) + +} +\seealso{ +\code{\link{nb}} to generate results + +\code{\link{plot.nb}} to plot results + +\code{\link{predict.nb}} for prediction +} diff --git a/radiant.model/man/summary.nn.Rd b/radiant.model/man/summary.nn.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d6221f74c99943621e1f5d0256e4d31a2f7df03a --- /dev/null +++ b/radiant.model/man/summary.nn.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nn.R +\name{summary.nn} +\alias{summary.nn} +\title{Summary method for the nn function} +\usage{ +\method{summary}{nn}(object, prn = TRUE, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{nn}}} + +\item{prn}{Print list of weights} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the nn function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/nn.html} for an example in Radiant +} +\examples{ +result <- nn(titanic, "survived", "pclass", lev = "Yes") +summary(result) +} +\seealso{ +\code{\link{nn}} to generate results + +\code{\link{plot.nn}} to plot results + +\code{\link{predict.nn}} for prediction +} diff --git a/radiant.model/man/summary.regress.Rd b/radiant.model/man/summary.regress.Rd new file mode 100644 index 0000000000000000000000000000000000000000..90cd6f23326467a32dae556392748d4f81cb32bc --- /dev/null +++ b/radiant.model/man/summary.regress.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/regress.R +\name{summary.regress} +\alias{summary.regress} +\title{Summary method for the regress function} +\usage{ +\method{summary}{regress}(object, sum_check = "", conf_lev = 0.95, test_var = "", dec = 3, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{regress}}} + +\item{sum_check}{Optional output. "rsme" to show the root mean squared error and the standard deviation of the residuals. "sumsquares" to show the sum of squares table. "vif" to show multicollinearity diagnostics. "confint" to show coefficient confidence interval estimates.} + +\item{conf_lev}{Confidence level used to estimate confidence intervals (.95 is the default)} + +\item{test_var}{Variables to evaluate in model comparison (i.e., a competing models F-test)} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the regress function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/regress.html} for an example in Radiant +} +\examples{ +result <- regress(diamonds, "price", c("carat", "clarity")) +summary(result, sum_check = c("rmse", "sumsquares", "vif", "confint"), test_var = "clarity") +result <- regress(ideal, "y", c("x1", "x2")) +summary(result, test_var = "x2") +ideal \%>\% + regress("y", "x1:x3") \%>\% + summary() + +} +\seealso{ +\code{\link{regress}} to generate the results + +\code{\link{plot.regress}} to plot results + +\code{\link{predict.regress}} to generate predictions +} diff --git a/radiant.model/man/summary.repeater.Rd b/radiant.model/man/summary.repeater.Rd new file mode 100644 index 0000000000000000000000000000000000000000..5995e6b74efaddfd049e637defcbf5493f17abe7 --- /dev/null +++ b/radiant.model/man/summary.repeater.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simulater.R +\name{summary.repeater} +\alias{summary.repeater} +\title{Summarize repeated simulation} +\usage{ +\method{summary}{repeater}(object, dec = 4, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{repeater}}} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summarize repeated simulation +} +\seealso{ +\code{\link{repeater}} to run a repeated simulation + +\code{\link{plot.repeater}} to plot results from repeated simulation +} diff --git a/radiant.model/man/summary.rforest.Rd b/radiant.model/man/summary.rforest.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a4a87a4e900d13eaf0a7e4353e95809542911223 --- /dev/null +++ b/radiant.model/man/summary.rforest.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rforest.R +\name{summary.rforest} +\alias{summary.rforest} +\title{Summary method for the rforest function} +\usage{ +\method{summary}{rforest}(object, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{rforest}}} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the rforest function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/rforest.html} for an example in Radiant +} +\examples{ +result <- rforest(titanic, "survived", "pclass", lev = "Yes") +summary(result) + +} +\seealso{ +\code{\link{rforest}} to generate results + +\code{\link{plot.rforest}} to plot results + +\code{\link{predict.rforest}} for prediction +} diff --git a/radiant.model/man/summary.simulater.Rd b/radiant.model/man/summary.simulater.Rd new file mode 100644 index 0000000000000000000000000000000000000000..927379d53e72cb42819e93589c55c195199424e0 --- /dev/null +++ b/radiant.model/man/summary.simulater.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simulater.R +\name{summary.simulater} +\alias{summary.simulater} +\title{Summary method for the simulater function} +\usage{ +\method{summary}{simulater}(object, dec = 4, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{simulater}}} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the simulater function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/simulater.html} for an example in Radiant +} +\examples{ +simdat <- simulater(norm = "demand 2000 1000", seed = 1234) +summary(simdat) + +} +\seealso{ +\code{\link{simulater}} to generate the results + +\code{\link{plot.simulater}} to plot results +} diff --git a/radiant.model/man/summary.svm.Rd b/radiant.model/man/summary.svm.Rd new file mode 100644 index 0000000000000000000000000000000000000000..3e97ec3afc804ca26e56e4c7bb2204e003cc190d --- /dev/null +++ b/radiant.model/man/summary.svm.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/svm.R +\name{summary.svm} +\alias{summary.svm} +\title{Summary method} +\usage{ +\method{summary}{svm}(object, ...) +} +\description{ +Summary method +} diff --git a/radiant.model/man/summary.uplift.Rd b/radiant.model/man/summary.uplift.Rd new file mode 100644 index 0000000000000000000000000000000000000000..77d0f7667757c8ee6235fb668ac48e8d2596d7fe --- /dev/null +++ b/radiant.model/man/summary.uplift.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/evalbin.R +\name{summary.uplift} +\alias{summary.uplift} +\title{Summary method for the uplift function} +\usage{ +\method{summary}{uplift}(object, prn = TRUE, dec = 3, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{evalbin}}} + +\item{prn}{Print full table of measures per model and bin} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the uplift function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +} +\examples{ +data.frame(buy = dvd$buy, pred1 = runif(20000), pred2 = ifelse(dvd$buy == "yes", 1, 0)) \%>\% + evalbin(c("pred1", "pred2"), "buy") \%>\% + summary() +} +\seealso{ +\code{\link{evalbin}} to summarize results + +\code{\link{plot.evalbin}} to plot results +} diff --git a/radiant.model/man/svm.Rd b/radiant.model/man/svm.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d7c5600c507f40594f205b6febf5ffc7e22df59a --- /dev/null +++ b/radiant.model/man/svm.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/svm.R +\name{svm} +\alias{svm} +\title{Support Vector Machine using e1071} +\usage{ +svm( + dataset, + rvar, + evar, + type = "classification", + lev = "", + kernel = "radial", + cost = 1, + gamma = "auto", + degree = 3, + coef0 = 0, + nu = 0.5, + epsilon = 0.1, + probability = FALSE, + wts = "None", + seed = 1234, + check = NULL, + form, + data_filter = "", + arr = "", + rows = NULL, + envir = parent.frame() +) +} +\description{ +Support Vector Machine using e1071 +} diff --git a/radiant.model/man/test_specs.Rd b/radiant.model/man/test_specs.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d22f2ed8e2467c2f99c6d6507c56e24e1da26638 --- /dev/null +++ b/radiant.model/man/test_specs.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/regress.R +\name{test_specs} +\alias{test_specs} +\title{Add interaction terms to list of test variables if needed} +\usage{ +test_specs(tv, int) +} +\arguments{ +\item{tv}{List of variables to use for testing for regress or logistic} + +\item{int}{Interaction terms specified} +} +\value{ +A vector of variables names to test +} +\description{ +Add interaction terms to list of test variables if needed +} +\details{ +See \url{https://radiant-rstats.github.io/docs/model/regress.html} for an example in Radiant +} +\examples{ +test_specs("a", "a:b") +test_specs("a", c("a:b", "b:c")) +test_specs("a", c("a:b", "b:c", "I(c^2)")) +test_specs(c("a", "b", "c"), c("a:b", "b:c", "I(c^2)")) + +} diff --git a/radiant.model/man/uplift.Rd b/radiant.model/man/uplift.Rd new file mode 100644 index 0000000000000000000000000000000000000000..b01b53a0dec2ac500acd60c3b0957e1d96529a6a --- /dev/null +++ b/radiant.model/man/uplift.Rd @@ -0,0 +1,74 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/evalbin.R +\name{uplift} +\alias{uplift} +\title{Evaluate uplift for different (binary) classification models} +\usage{ +uplift( + dataset, + pred, + rvar, + lev = "", + tvar, + tlev = "", + qnt = 10, + cost = 1, + margin = 2, + scale = 1, + train = "All", + data_filter = "", + arr = "", + rows = NULL, + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{pred}{Predictions or predictors} + +\item{rvar}{Response variable} + +\item{lev}{The level in the response variable defined as success} + +\item{tvar}{Treatment variable} + +\item{tlev}{The level in the treatment variable defined as the treatment} + +\item{qnt}{Number of bins to create} + +\item{cost}{Cost for each connection (e.g., email or mailing)} + +\item{margin}{Margin on each customer purchase} + +\item{scale}{Scaling factor to apply to calculations} + +\item{train}{Use data from training ("Training"), test ("Test"), both ("Both"), or all data ("All") to evaluate model evalbin} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{arr}{Expression to arrange (sort) the data on (e.g., "color, desc(price)")} + +\item{rows}{Rows to select from the specified dataset} + +\item{envir}{Environment to extract data from} +} +\value{ +A list of results +} +\description{ +Evaluate uplift for different (binary) classification models +} +\details{ +Evaluate uplift for different (binary) classification models based on predictions. See \url{https://radiant-rstats.github.io/docs/model/evalbin.html} for an example in Radiant +} +\examples{ +data.frame(buy = dvd$buy, pred1 = runif(20000), pred2 = ifelse(dvd$buy == "yes", 1, 0)) \%>\% + evalbin(c("pred1", "pred2"), "buy") \%>\% + str() +} +\seealso{ +\code{\link{summary.evalbin}} to summarize results + +\code{\link{plot.evalbin}} to plot results +} diff --git a/radiant.model/man/var_check.Rd b/radiant.model/man/var_check.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d107c7fdf61753c9b27c8b13e272d6109c3ab19f --- /dev/null +++ b/radiant.model/man/var_check.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/regress.R +\name{var_check} +\alias{var_check} +\title{Check if main effects for all interaction effects are included in the model} +\usage{ +var_check(ev, cn, intv = c()) +} +\arguments{ +\item{ev}{List of explanatory variables provided to \code{\link{regress}} or \code{\link{logistic}}} + +\item{cn}{Column names for all explanatory variables in the dataset} + +\item{intv}{Interaction terms specified} +} +\value{ +\code{vars} is a vector of right-hand side variables, possibly with interactions, \code{iv} is the list of explanatory variables, and \code{intv} are interaction terms +} +\description{ +Check if main effects for all interaction effects are included in the model +} +\details{ +If ':' is used to select a range evar is updated. See \url{https://radiant-rstats.github.io/docs/model/regress.html} for an example in Radiant +} +\examples{ +var_check("a:d", c("a", "b", "c", "d")) +var_check(c("a", "b"), c("a", "b"), "a:c") +var_check(c("a", "b"), c("a", "b"), "a:c") +var_check(c("a", "b"), c("a", "b"), c("a:c", "I(b^2)")) + +} diff --git a/radiant.model/man/varimp.Rd b/radiant.model/man/varimp.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a7931a650fb5fada0774e6d9bd99737b0271fc06 --- /dev/null +++ b/radiant.model/man/varimp.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nn.R +\name{varimp} +\alias{varimp} +\title{Variable importance using the vip package and permutation importance} +\usage{ +varimp(object, rvar, lev, data = NULL, seed = 1234) +} +\arguments{ +\item{object}{Model object created by Radiant} + +\item{rvar}{Label to identify the response or target variable} + +\item{lev}{Reference class for binary classifier (rvar)} + +\item{data}{Data to use for prediction. Will default to the data used to estimate the model} + +\item{seed}{Random seed for reproducibility} +} +\description{ +Variable importance using the vip package and permutation importance +} diff --git a/radiant.model/man/varimp_plot.Rd b/radiant.model/man/varimp_plot.Rd new file mode 100644 index 0000000000000000000000000000000000000000..dda339c5875feb7f4a7723650aef24ef78ce8f6a --- /dev/null +++ b/radiant.model/man/varimp_plot.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nn.R +\name{varimp_plot} +\alias{varimp_plot} +\title{Plot permutation importance} +\usage{ +varimp_plot(object, rvar, lev, data = NULL, seed = 1234) +} +\arguments{ +\item{object}{Model object created by Radiant} + +\item{rvar}{Label to identify the response or target variable} + +\item{lev}{Reference class for binary classifier (rvar)} + +\item{data}{Data to use for prediction. Will default to the data used to estimate the model} + +\item{seed}{Random seed for reproducibility} +} +\description{ +Plot permutation importance +} diff --git a/radiant.model/man/write.coeff.Rd b/radiant.model/man/write.coeff.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d31f6dc506c3c97c69ed84a12d8d36482451b8ec --- /dev/null +++ b/radiant.model/man/write.coeff.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/logistic.R +\name{write.coeff} +\alias{write.coeff} +\title{Write coefficient table for linear and logistic regression} +\usage{ +write.coeff(object, file = "", sort = FALSE, intercept = TRUE) +} +\arguments{ +\item{object}{A fitted model object of class regress or logistic} + +\item{file}{A character string naming a file. "" indicates output to the console} + +\item{sort}{Sort table by variable importance} + +\item{intercept}{Include the intercept in the output (TRUE or FALSE). TRUE is the default} +} +\description{ +Write coefficient table for linear and logistic regression +} +\details{ +Write coefficients and importance scores to csv or or return as a data.frame +} +\examples{ + +regress( + diamonds, + rvar = "price", evar = c("carat", "clarity", "color", "x"), + int = c("carat:clarity", "clarity:color", "I(x^2)"), check = "standardize" +) \%>\% + write.coeff(sort = TRUE) \%>\% + format_df(dec = 3) + +logistic(titanic, "survived", c("pclass", "sex"), lev = "Yes") \%>\% + write.coeff(intercept = FALSE, sort = TRUE) \%>\% + format_df(dec = 2) +} diff --git a/radiant.model/tests/testthat.R b/radiant.model/tests/testthat.R new file mode 100644 index 0000000000000000000000000000000000000000..b73fd38795ccbe2ee276408da49c4469c88d79d6 --- /dev/null +++ b/radiant.model/tests/testthat.R @@ -0,0 +1,5 @@ +## use shift-cmd-t to run all tests +library(testthat) +test_check("radiant.model") +# if (interactive() && !exists("coverage_test")) devtools::run_examples() +# devtools::run_examples(start = "single_prop") diff --git a/radiant.model/tests/testthat/output/regress1.txt b/radiant.model/tests/testthat/output/regress1.txt new file mode 100644 index 0000000000000000000000000000000000000000..6c84363d395075f86aa9cdc9c98780f89eeb2099 --- /dev/null +++ b/radiant.model/tests/testthat/output/regress1.txt @@ -0,0 +1,24 @@ +Linear regression (OLS) + Data : diamonds + Response variable : price + Explanatory variables: carat, clarity + Null hyp.: the effect of x on price is zero + Alt. hyp.: the effect of x on price is not zero + + coefficient std.error t.value p.value + (Intercept) -6780.993 204.952 -33.086 < .001 *** + carat 8438.030 51.101 165.125 < .001 *** + clarity|SI2 2790.760 201.395 13.857 < .001 *** + clarity|SI1 3608.531 200.508 17.997 < .001 *** + clarity|VS2 4249.906 201.607 21.080 < .001 *** + clarity|VS1 4461.956 204.592 21.809 < .001 *** + clarity|VVS2 5109.476 210.207 24.307 < .001 *** + clarity|VVS1 5027.669 214.251 23.466 < .001 *** + clarity|IF 5265.170 233.658 22.534 < .001 *** + + Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + + R-squared: 0.904, Adjusted R-squared: 0.904 + F-statistic: 3530.024 df(8,2991), p.value < .001 + Nr obs: 3,000 + diff --git a/radiant.model/tests/testthat/test_stats.R b/radiant.model/tests/testthat/test_stats.R new file mode 100644 index 0000000000000000000000000000000000000000..70b13e6bc5dbcd9e9caa8f8cfeb7e54af0142f95 --- /dev/null +++ b/radiant.model/tests/testthat/test_stats.R @@ -0,0 +1,170 @@ +# library(radiant.model) +# library(testthat) +trim <- function(x) gsub("^\\s+|\\s+$", "", x) + +######### tests ######## +context("Linear regression (regress)") + +test_that("regress", { + result <- regress(diamonds, "price", c("carat", "clarity")) + res1 <- capture.output(summary(result))[10] %>% trim() + # cat(paste0(res1, "\n")) + res2 <- "carat 8438.030 51.101 165.125 < .001 ***" + expect_equal(res1, res2) + + result <- regress(diamonds, "price", "carat:clarity") + res1 <- capture.output(summary(result))[10] %>% trim() + expect_equal(res1, res2) + + res1 <- capture.output(summary(result)) %>% trim() + # cat(paste0(res1,"\n"), file = "~/GitHub/radiant/tests/testthat/output/regression1.txt") + ## full output - cannot open file when testing the tests + res2 <- paste0(readLines("output/regress1.txt")) %>% trim() + expect_equal(res1, res2) +}) + +test_that("regress - predict", { + result <- regress(diamonds, "price", c("carat", "clarity")) + res1 <- capture.output(predict(result, pred_cmd = "carat = 1:10"))[17] %>% trim() + # cat(paste0(res1, "\n")) + res2 <- "SI1 9 72769.811 71948.301 73591.322 821.511" + expect_equal(res1, res2) + + result <- regress(diamonds, "price", "carat:clarity") + res1 <- capture.output(predict(result, pred_cmd = "carat = 1:10"))[17] %>% trim() + expect_equal(res1, res2) +}) + +test_that("regress - predict with quadratic term", { + result <- regress(diamonds, "price", c("carat", "clarity"), int = "I(carat^2)") + res1 <- capture.output(predict(result, pred_cmd = "carat = 1:10"))[17] %>% trim() + cat(paste0(res1, "\n")) + res2 <- "SI1 9 114304.420 104924.680 123684.159 9379.739" + expect_equal(res1, res2) + + result <- regress(diamonds, "price", "carat:clarity", int = "I(carat^2)") + res1 <- capture.output(predict(result, pred_cmd = "carat = 1:10"))[17] %>% trim() + expect_equal(res1, res2) +}) + +test_that("regress - predict with date", { + result <- regress(diamonds, "price", c("carat", "clarity", "date")) + res1 <- capture.output(predict(result, pred_cmd = "carat = 1:10"))[17] %>% trim() + res2 <- "SI1 2012-03-19 9 72719.464 71896.008 73542.920 823.456" + expect_equal(res1, res2) + res1 <- capture.output(predict(result, pred_cmd = "date = '2012-1-1'"))[9] %>% trim() + res2 <- "0.794 SI1 2012-01-01 3471.070 3357.438 3584.701 113.631" + expect_equal(res1, res2) +}) + + +context("Logistic regression (logistic)") + +test_that("logistic", { + result <- logistic(titanic, "survived", c("pclass", "sex")) + res1 <- capture.output(summary(result))[13] %>% trim() + cat(paste0(res1, "\n")) + res2 <- "sex|male 0.080 -92.0% -2.522 0.163 -15.447 < .001 ***" + expect_equal(res1, res2) + result <- logistic(titanic, "survived", "pclass:sex") + res1 <- capture.output(summary(result))[13] %>% trim() + expect_equal(res1, res2) +}) + +test_that("logistic - predict", { + result <- logistic(titanic, "survived", c("pclass", "sex")) + res1 <- capture.output(predict(result, pred_cmd = "pclass = levels(pclass); sex = 'female'"))[11] %>% trim() + cat(paste0(res1, "\n")) + res2 <- "2nd female 0.779 0.712 0.833" + expect_equal(res1, res2) + + result <- logistic(titanic, "survived", "pclass:sex") + res1 <- capture.output(predict(result, pred_cmd = "pclass = levels(pclass); sex = 'female'"))[11] %>% trim() + expect_equal(res1, res2) + + res1 <- capture.output(predict(result, pred_data = titanic))[11] %>% trim() + cat(paste0(res1, "\n")) + res2 <- "1st female 0.896 0.856 0.926" + expect_equal(res1, res2) +}) + +test_that("logistic - predict with quadratic term", { + result <- logistic(titanic, "survived", c("pclass", "sex", "age"), int = "I(age^2)") + res1 <- capture.output(predict(result, pred_cmd = "pclass = levels(pclass); sex = 'female'; age = 1:100"))[11] %>% trim() + # cat(paste0(res1, "\n")) + res2 <- "1st female 1 0.976 0.952 0.988" + expect_equal(res1, res2) + + result <- logistic(titanic, "survived", "pclass:age", int = "I(age^2)") + res1 <- capture.output(predict(result, pred_cmd = "pclass = levels(pclass); sex = 'female'; age = 1:100"))[11] %>% trim() + expect_equal(res1, res2) + + res1 <- capture.output(predict(result, pred_data = titanic))[11] %>% trim() + cat(paste0(res1, "\n")) + res2 <- "1st female 29.000 0.919 0.880 0.945" + expect_equal(res1, res2) +}) + +context("Neural Network (nn)") + +test_that("Neural Network - predict for classification", { + result <- nn(titanic, "survived", c("pclass", "sex"), seed = 1234) + res1 <- capture.output(predict(result, pred_cmd = "pclass = levels(pclass); sex = 'female'", dec = 1))[10] %>% trim() + # cat(paste0(res1, "\n")) + res2 <- "2nd female 0.8" + expect_equal(res1, res2) + + result <- nn(titanic, "survived", "pclass:sex", seed = 1234) + res1 <- capture.output(predict(result, pred_cmd = "pclass = levels(pclass); sex = 'female'", dec = 1))[10] %>% trim() + expect_equal(res1, res2) + + res1 <- capture.output(predict(result, pred_data = titanic, dec = 1))[10] %>% trim() + # cat(paste0(res1, "\n")) + res2 <- "1st female 0.9" + expect_equal(res1, res2) +}) + +test_that("Neural Network - predict for regression", { + result <- nn(diamonds, "price", c("carat", "clarity"), type = "regression", seed = 1234) + res1 <- capture.output(predict(result, pred_cmd = "carat = 1:10", dec = 1))[16] %>% trim() + # cat(paste0(res1, "\n")) + res2 <- "SI1 9 18466.7" + expect_equal(res1, res2) + + result <- nn(diamonds, "price", "carat:clarity", type = "regression", seed = 1234) + res1 <- capture.output(predict(result, pred_cmd = "carat = 1:10", dec = 1))[16] %>% trim() + expect_equal(res1, res2) + + res1 <- capture.output(predict(result, pred_data = diamonds, dec = 1))[16] %>% trim() + # cat(paste0(res1, "\n")) + res2 <- "0.9 SI1 3997.9" + expect_equal(res1, res2) +}) + +test_that("Neural Network - predict with date", { + result <- nn(diamonds, "price", c("carat", "clarity", "date"), type = "regression", seed = 1234) + res1 <- capture.output(predict(result, pred_cmd = "carat = 1:10"))[17] %>% trim() + res2 <- "SI1 2012-03-19 10 3907.186" + expect_equal(res1, res2) + res1 <- capture.output(predict(result, pred_cmd = "date = '2012-1-1'"))[8] %>% trim() + res2 <- "0.794 SI1 2012-01-01 3907.186" + expect_equal(res1, res2) +}) + +# context("Gradient Boosted Trees (gbt)") +# +# test_that("Gradient Boosting - NoLD test", { +# result <- gbt(titanic, "survived", c("pclass", "sex"), lev = "Yes", early_stopping_rounds = 0) +# res1 <- round(result$model$importance$Gain, 3) +# res2 <- c(0.758, 0.210, 0.032) +# expect_equal(res1, res2, tolerance = 1e-3) +# }) + +# context("Linear regression (plot.regress)") + +# test_that("regress - plots", { +# result <- regress(diamonds, "price", c("carat", "clarity")) +# grb <- plot(result, plots = "dashboard", shiny = TRUE) +# expect_true(all(c("patchwork", "gg", "ggplot") %in% class(grb))) +# unlink("Rplots.pdf") +# }) diff --git a/radiant.model/vignettes/pkgdown/_crs.Rmd b/radiant.model/vignettes/pkgdown/_crs.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..529e1f216e4363cc0136f5be19305ad573e70ec7 --- /dev/null +++ b/radiant.model/vignettes/pkgdown/_crs.Rmd @@ -0,0 +1,15 @@ +> Predict product ratings using Collaborative Filtering + +To estimate recommendations using Collaborative Filtering select a user id, a product id, one or more products to generate recommendations for, and product ratings. To generate recommendations press the `Estimate` button or `CTRL-enter` (`CMD-enter` on mac). + +

    + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If a plot was created it can be customized using `ggplot2` commands (e.g., `plot(result) + labs(caption = "Based on data from ...")`). See _Data > Visualize_ for details. + +### R-functions + +For an overview of related R-functions used by Radiant for collaborative filtering see _Model > Collaborative Filtering_ diff --git a/radiant.model/vignettes/pkgdown/_crtree.Rmd b/radiant.model/vignettes/pkgdown/_crtree.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..9750a92666e3189670dae3dbfd55b705d5c83183 --- /dev/null +++ b/radiant.model/vignettes/pkgdown/_crtree.Rmd @@ -0,0 +1,17 @@ +> Estimate a classification or regression tree + +To create a tree model, first select the type (i.e., Classification or Regression), response variable, and one or more explanatory variables. Press the `Estimate model` button or `CTRL-enter` (`CMD-enter` on mac) to generate results. + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If either a `Prune` or `Importance` plot was created it can be customized using `ggplot2` commands (e.g., `plot(result, plots = "prune", custom = TRUE) + labs(x = "# nodes")`). See _Data > Visualize_ for details. + +It is not currently possible to add a title or caption directly to a `Tree` plot. + +### R-functions + +For an overview of related R-functions used by Radiant to estimate classification and regression trees see _Model > Classification and regression trees_ + +The key function from the `rpart` package used in the `crtree` tool is `rpart`. diff --git a/radiant.model/vignettes/pkgdown/_dtree.Rmd b/radiant.model/vignettes/pkgdown/_dtree.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..7a60d85e758698cdf89f89d4cffa84ac046994b1 --- /dev/null +++ b/radiant.model/vignettes/pkgdown/_dtree.Rmd @@ -0,0 +1,232 @@ +> Create and evaluate a decision tree for decision analysis + +To create and evaluate a decision tree first (1) enter the structure of the tree in the input editor or (2) load a tree structure from a file. When you first navigate to the _Model > Decide > Decision analysis_ tab you will see an example tree structure. This structure is based on an example by Christoph Glur, the developer of the data.tree library. + +To enter a new structure, start by providing a name for the tree and enter a label in the input box next to the `Calculate` button. In the example below the name for the decision tree is entered as follow: `name: Sign contract`. The next step is to indicate the **type** of the first **node**. Options are `type: decision` or `type: chance`. Note that we are skipping `variables` for now but will return to this section below. + +In the provided example, the first node is a **decision node**. The decision maker has to decide to `Sign with Movie Company` or `Sign with TV Network`. The first option leads to a **chance** node with probabilities and payoffs. The second has a fixed payoff. + +> **Note:** Indentation is critically important when defining a tree structure. Use tabs to create branches as shown in the example. Names for branches **must** be followed by a `:` and information about the branch **must** be indented using the `tab` key. + +After providing the name for the decision `Sign with Movie Company`, the next line **must** be indented using the `tab` key. In the example, the next line starts the description of a chance node (`type: chance`). There are 3 possibilities in the example: (1) `Small Box Office`, (2) `Medium Box Office`, and (3) `Large Box Office`, each with a probability and a payoff. These are end-points for one branch of the tree and are often referred to as `terminal nodes` or `leaves`. All endpoints must have a `payoff` value. + +> **Note:** Probabilities for a chance node should sum to 1 and all probabilities must be between 0 and 1. + +A decision can also be assigned a `cost`. For example, if we decide to sign with the movie studio we may incur a cost of $5,000 for legal support. Assume the contract with the TV network is simpler and does not require legal assistance. Note that using `costs` is optional. In the example we could also subtract \$5,000 from each of the possible box-office payoffs. + +If some values in the tree are related or repeated it can be useful to use a `variables` section. Here you can assign labels to values, enter formulas, and even reference other (sub)trees. Note that formulas should only reference entries from the `variables` section and cannot contain any R-commands. In the `Sign contract` example only one variable is created (i.e., `legal fees`). The _Sensitivity_ tab requires that a `variables` section is included in the tree structure. An adapted version of the `Sign contract` example that uses more variables and a formula is shown below. + + +```yaml +name: Sign contract +variables: + legal fees: 5000 + P(small): 0.3 + P(medium): 0.6 + P(large): 1 - P(small) - P(medium) +type: decision +Sign with Movie Company: + cost: legal fees + type: chance + Small Box Office: + p: P(small) + payoff: 200000 + Medium Box Office: + p: P(medium) + payoff: 1000000 + Large Box Office: + p: P(large) + payoff: 3000000 +Sign with TV Network: + payoff: 900000 +``` + +To reference another (sub)tree use the `dtree` function in the `variables` section and the name of the (sub)tree. For example, suppose you want to include a tree ("tuesday_tree") that evaluates a pricing decision on Tuesday into a tree that evaluates a pricing decision on Monday. The start of the `variables` section might look as follows: + +```yaml +variables: + tuesday_emv: dtree("tuesday_tree") +``` + +Then in the Monday tree you would refer to `tuesday_emv` in spots where you need the EMV from Tuesday's pricing decision. + +## Rules for decision tree input + +1. Always start with a tree name (e.g., `name: My tree`) +2. The second line should start a `variables` section or a node definition (i.e., type: chance or type: decision) +3. All lines must have a `:`. For node names the `:` ends the line. For all other lines it assigns a value. Specifically, it assigns a name (e.g., `name: My tree`), a node type (e.g., `type: decision`), a variable (e.g., `legal fees: 5000`), or a number (e.g., `payoff: 100`, `p: 0.1`, `cost: 10`) +4. A node type must be followed on the next line by a node name (e.g., `Cancel orders:`) +5. Use only letters and spaces in node names (i.e., no symbols) +6. The line after a node name must **always** be indented +7. End (or terminal or leave) nodes must have a payoff (e.g., `payoff: 100`) +8. If linked to a chance node, terminal nodes must have a probability (e.g, `p: 0.4`) and a payoff + +After specifying the tree structure in the editor, press the `Calculate` button to see the `Initial` and `Final` decision tree in text format on the right side of the screen (see screen shot below). The initial tree simply shows the tree structure that was specified, together with the node types, probabilities, costs, and payoffs. The final tree shows the optimal decision strategy determined by `folding-back` the tree. In this case, the optimal decision is to `Sign with Movie Company` because this decision has a higher **Expected Monetary Value (EMV)**. + +

    + +For a visual representation of the decision tree open the _Plot_ tab. If you already clicked the `Calculate` button in the _Model_ tab you will see a graph of the `Initial` decision tree (see screen shot below). Decision nodes are shown in green and chance nodes in orange. If the tree does not look as you intended/expected, return to the _Model_ tab and edit the tree structure. + +

    + +The `Final` graph shows the optimal decision determined by `folding-back` the tree. The optimal decision is to `Sign with Movie Company` because this decision has a higher **Expected Monetary Value**. Note that the optimal decision at each decision node is shown by a thicker line connecting to the nodes. + +

    + +The EMV for `Sign with TV Network` is \$900,000. If we ignore costs the expected payoff from `Sign with Movie Company` is: + +$$ + 0.3 \times 200,000 + 0.6 \times 1,000,000 + 0.1 \times 3000,000 = 960,000 +$$ + +The EMV from signing with the movie company is however $960,000 - 5,000 = 955,000$ because we do incur a cost of \$5,000 in legal fees. Hover the cursor over the chance node shown on screen to see a `tooltip` that shows the calculation. To highlight that a `cost` was specified the chance node in the figure has a dashed outer line. + +In the `Sign contract` example it is clear that `Sign with Movie Company` is the preferred option. However, suppose the legal fees associated with this option were $10,000, or $30,000, would we still choose the same option? This is where the _Sensitivity_ tab is useful. Here we can evaluate how decisions (e.g., `Sign with Movie Company` and `Sign with TV Network`) would change if the legal fee changes. Enter 0 as the `Min` value, 80000 as the `Max value`, 10000 as the `Step` size, and then press the icon. After pressing `Evaluate sensitivity` a graph will be shown that illustrates how payoffs for the decisions change. Notice that for legal fees higher than \$60,000 `Sign with TV Network` produces the highest EMV. + +

    + +## Video Tutorials + +Copy-and-paste the full command below into the RStudio console (i.e., the bottom-left window) and press return to gain access to all materials used in the decision tree module of the Radiant Tutorial Series: + +
    usethis::use_course("https://www.dropbox.com/sh/bit4p1ffbkb2dgh/AACm1RVy2BxBDiVbjoLiN5_Ea?dl=1")
    + +Introduction to Decision Analysis (#1) + +* This video walks you through the required steps to construct and solve a basic decision tree by hand +* Topics List: + - Chance nodes vs. decision nodes + - Folding back the tree (i.e., start from the right-most nodes and work backwards to the left-most nodes) + +Using Radiant to Construct a Decision Tree (#2) + +* This video demonstrates how to construct a basic decision tree in Radiant +* Topics List: + - Rename a tree file + - Construct a tree (following the rules for decision tree input) + - Interpret the results (initial tree vs final tree) + - Save the decision tree input .yaml file + +How to Write Decision Tree Results into a Report (#3) + +* This video demonstrates how to construct a basic decision tree in Radiant and add the generated R-code to a report +* Topics List: + - Construct a decision tree and define variables in the decision tree + - Add multiple trees to a report + - Demo some useful keyboard shortcuts + - Save the Radiant state file and the report + +Sensitivity Analysis of Decision Tree (#4) + +* This video shows two ways to conduct sensitivity analysis of a decision tree in Radiant +* Topics List: + - Quick review of writing decision tree results to a report + - Method 1: manually update the value + - Method 2: use "variables" + +How to Debug Decision Tree Input (#5) + +* This video demonstrates how to debug decision tree input if you get an error message +* Topics List: + - Colon missing + - Indent issue + - Probabilities don't sum to 1 + - Value missing + +Decision Trees with Imperfect Information (#6) + +* This video shows how to determine the appropriate (conditional) probabilities to use in a decision tree when the available information is imperfect +* Topics List: + - Imperfect information + - Test + - Conditional probabilities + +Solving a Decision Tree with Imperfect Information (#7) + +* This video shows how to use Radiant to construct and solve a decision tree when the available information is imperfect +* Topics List: + - Specify variables + - Build a tree with imperfect information + - Check the tree + - Interpret the decision tree result + +Building a Decision Tree with Sub-trees in Radiant (#8) + +* This video shows how to build a decision tree with sub-trees in radiant +* Topics List: + - Create a main tree that references a sub-tree + - Specify a sub-tree that references the main tree in the variables section + +For the full "Radiant Tutorial Series" see the link below: + +https://www.youtube.com/playlist?list=PLNhtaetb48EdKRIY7MewCyvb_1x7dV3xw + +## Buttons + +In the _Model_ tab: + +* To see this help file click the icon +* To generate a report about the decision tree in the _Report > Rmd_ tab click the icon or press `ALT-enter` on your keyboard +* Choose to maximize (`Max`) or minimize (`Min`) payoffs. Note that payoffs can be negative +* Click the `Calculate` button or press `CTRL-enter` (`CMD-enter` on mac) to generate or update results +* Specify a name for your decision tree in the text input next to the `Calculate` button. Clicking on the `Calculate` button will store your settings. If multiple tree structures are available there will also be a dropdown where you can select which structure to use and a `Remove` button to delete tree structures +* To save the tree structure entered into the editor window to disk press the `Save input` button +* To save the text representation of the initial and final tree to a file click the `Save output` button +* To load a tree structure from a file in `yaml` format click the `Choose File` button + +In the _Plot_ tab: + +* To see this help file click the icon +* To generate a report about the decision tree in the _Report > Rmd_ tab click the icon or press `ALT-enter` on your keyboard +* Show either the `Initial` or `Final` decision tree +* Click the `Calculate` button or press `CTRL-enter` (`CMD-enter` on mac) to generate or update results +* Enter the number of decimal places to show in the plot (default is 2 for payoffs and 4 for probabilities) +* Provide a symbol to use for the payoffs (e.g., $ or RMB) +* Click the download icon in the top right of your browser to download either the initial or final plot to png file + +It is not currently possible to add a title or caption directly to the `Decision Tree` plot. + +In the _Sensitivity_ tab: + +* To see this help file click the icon +* To generate a report about the decision tree in the _Report > Rmd_ tab click the icon or press `ALT-enter` on your keyboard +* Select one or more `Decisions to evaluate` +* Select variables in `Sensitivity to changes in`. These variables must be defined in the `variables` section of the decision tree structure in the _Model_ tab +* Enter the minimum, maximum, and step size for the selected variable and press the icon +* Press `Evaluate sensitivity` or press `CTRL-enter` (`CMD-enter` on mac) to generate results and the plot +* Click the download icon in the top right of your browser to download the plot to a png file + +If a sensitivity plot was created it can be customized using `ggplot2` commands (see example below). See _Data > Visualize_ for details. + +```r +sensitivity( + result, + vars = "legal fees 0 100000 1000;", + decs = c("Sign with Movie Company", "Sign with TV Network"), + custom = TRUE +) + labs(caption = "Based on example created by ...") +``` + +## The decision tree editor + +Useful keyboard short-cuts: + +* Comment current or selected line(s) (Win: Ctrl-/ Mac: Cmd-/) +* Fold all lines (Win: Alt-0 Mac: Alt-Cmd-0) +* Unfold all lines (Win: Shift-Alt-0 Mac: Shift-Alt-Cmd-0) +* Search (Win: Ctrl-f, Mac: Cmd-f) +* Search & Replace (Win: Ctrl-f-f, Mac: Cmd-f-f) +* Undo edit (Win: Ctrl-z, Mac: Cmd-z) +* Redo edit (Win: Shift-Ctrl-z, Mac: Shift-Cmd-z) + +You can also (un)fold lines using the small triangles next to the line numbers. + +For additional shortcuts see: + +https://github.com/ajaxorg/ace/wiki/Default-Keyboard-Shortcuts + +### R-functions + +For an overview of related R-functions used by Radiant for decision analysis see _Model > Decision analysis_. + +The key elements from the `data.tree` package used in the `dtree` tool are the `as.Node` function and the `Get` and `Do` methods. diff --git a/radiant.model/vignettes/pkgdown/_evalbin.Rmd b/radiant.model/vignettes/pkgdown/_evalbin.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..43375d54afa86b282c106dbd0ead1800e62788e6 --- /dev/null +++ b/radiant.model/vignettes/pkgdown/_evalbin.Rmd @@ -0,0 +1,112 @@ +> Evaluate model performance for (binary) classification + +#### Response variable + +Select the outcome, or response, variable of interest. This should be a binary variable, either a factor or an integer with two value (i.e., 0 and 1). + +#### Choose level + +The level in the response variable that is considered a _success_. For example, a purchase or buyer is equal to "yes". + +#### Predictor + +Select one or more variables that can be used to _predict_ the chosen level in the response variable. This could be a variable, an RFM index, or predicted values from a model (e.g., from a logistic regression estimated using _Model > Logistic regression (GLM)_ or a Neural Network estimated using _Model > Neural Network_). + +#### # quantiles + +The number of bins to create. + +#### Margin & Cost + +To use the `Profit` and `ROME` (Return on Marketing Expenditures) charts, enter the `Margin` for each sale and the estimated `Cost` per contact (e.g., mailing costs or opportunity cost of email or text message). For example, if the margin on a sale is \$10 (excluding the contact cost) and the contact cost is \$1 enter 10 and 1 in the `Margin` and `Cost` input windows. + +#### Show results for + +If a `filter` is active (e.g., set in the _Data > View_ tab) generate results for `All` data, `Training` data, `Test` data, or `Both` training and test data. If no filter is active calculations are applied to all data. + +#### Plots + +Generate Lift, Gains, Profit, and/or ROME charts. + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If we create a set of four charts in the _Plots_ tab we can add a title above the group of plots and impose a two-column layout using `patchwork` as follows: + +```r +plot(result, plots = c("lift", "gains", "profit", "rome"), custom = TRUE) %>% + wrap_plots(plot_list, ncol = 2) + plot_annotation(title = "Model evaluation") +``` + +The single plot can be customized using `ggplot2` commands (see example below)). See _Data > Visualize_ for details. + +```r +plot(result, plots = "lift", custom = TRUE) + + labs(caption = "Based on data from ...") +``` + +#### Confusion matrix + +Predicted probabilities probabilities selected through `Predictor` are first converted to a class (e.g., a positive or negative outcome) using the values entered in `Margin` and `Cost`. It will be profitable to contact a customer if the predicted probability of response exceeds `Cost / Margin`. For example, if the break-even response rate is 0.1 and the predicted probability of response is 0.25 that customer will be assigned the label _Positive_. If, on the other hand, the predicted probability does not exceed the break-even response rate a customer will be assigned a _Negative_ label. + +Once each prediction has been converted to a class label (i.e., Positive or Negative) the result is compared to the values of the response variable. The following key measures are shown in the generated table for each predictor. + +Label | Description +------------------------ | ------------------------------------------------------------------ +TP (True Positive) | Number of cases where the positive prediction matches the positive outcome in the data +FP (False Positive) | Number of cases with a positive prediction but a negative outcome in the data +TN (True Negative) | Number of cases where the negative prediction matches the negative outcome in the data +FN (False Negative) | Number of cases with a negative prediction but a positive outcome in the data +total | Total number of cases (i.e., TP + FP + TN + FN) +TPR (True Positive Rate) | Proportion of positive outcomes in the data that received a positive prediction (i.e., TP / (TP + FN)). Also known as _sensitivity_ or _recall_ +TNR (True Negative Rate) | Proportion of negative outcomes in the data that received a negative prediction (i.e., TN / (TN + FP)). Also known as _specificity_ +precision | Proportion of positive predictions with a positive outcome in the data (i.e., TP / (TP + FP)) +F-score | The harmonic mean of _precision_ and TPR (_sensitivity_) +accuracy | Proportion of all outcomes that was correctly predicted as either positive or negative (i.e., (TP + TN) / total) +kappa | Corrects the accuracy measure for the probability of generating a correct prediction purely by chance +profit | Total profitability achieved by targeting all customers with a predicted probability above the break-even response rate +index | Index of relative profitability achieved across the selected `Predictor` variables (maximum is 1) +ROME | Return on Marketing Expenditures (ROME) achieved by targeting all customers with a predicted probability above the break-even response rate +contact | Proportion of customers to contact, i.e., (TP + FP) / total +AUC | Area Under the ROC Curve (AUC). ROC stands for Receiver Operating Characteristic. + +### Report > Rmd (confusion) + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +Only `kappa`, `index`, `ROME`, and `AUC` are plotted by default. It is possible to customize the plotted results through _Report > Rmd_. To change the plot use, for example: + +```r +plot(result, vars = c("precision", "profit", "AUC")) +``` + +The plot can be further customized using `ggplot2` commands (see example below)). See _Data > Visualize_ for details. + +```r +plot(result, vars = c("precision", "profit", "AUC")) + + labs(caption = "Based on data from ...") +``` + +#### Download options + +To download a table as a csv-files click the download button on the top-right of your screen. To download plots as png files click the download icon on the middle-right of your screen. + +## Example + +The Lift and Gains charts below show little evidence of overfitting and suggest that targeting approximately 65% of customers would maximize profits. + +

    + + + +The prediction used in the screen shots above was derived from a logistic regression on the `dvd` data. The data is available through the _Data > Manage_ tab (i.e., choose `Examples` from the `Load data of type` drop-down and press `Load`). The model was estimated using _Model > Logistic regression (GLM)_. The predictions shown below were generated in the _Predict_ tab. + +

    + +### R-functions + +For an overview of related R-functions used by Radiant to evaluate (binary) classification models see _Model > Evaluate classification_ diff --git a/radiant.model/vignettes/pkgdown/_evalreg.Rmd b/radiant.model/vignettes/pkgdown/_evalreg.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..ca1abf1899aebb26017750d8dc54858343a792cd --- /dev/null +++ b/radiant.model/vignettes/pkgdown/_evalreg.Rmd @@ -0,0 +1,46 @@ +> Evaluate regression model performance + +To download the table as a csv-files click the top download button on the right of your screen. To download the plots at a png file click the lower download icon on the right of your screen. + +#### Response variable + +The numeric outcome, or response, variable of interest. + +#### Predictor + +Select one or more variables that can be used to _predict_ the value of the response variable. This could be a variable or predicted values from a model (e.g., from a regression estimated using _Model > Linear regression (OLS)_ or a Neural Network estimated using _Model > Neural Network_). + +#### Show results for + +If a `filter` is active (e.g., set in the _Data > View_ tab) generate results for `All` data, `Training` data, `Test` data, or `Both` training and test data. If no filter is active calculations are applied to all data. + +## Example + +Predictions were derived from a linear regression and an neural network with two nodes in the hidden layer on the `diamonds` data. The variables `price` and `carat` were log-transformed prior to estimation.The data is available through the _Data > Manage_ tab (i.e., choose `Examples` from the `Load data of type` drop-down and press `Load`). The predictions shown below were generated in the _Predict_ tab. + +

    + +The test statistics show a small, but consistent, advantage for the NN. + +

    + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +`Rsq`, `RSME`, and `MAE` are plotted by default. It is possible to customize the plotted results through _Report > Rmd_. To change the plot use, for example: + +```r +plot(result, vars = "Rsq") +``` + +The plot can be further customized using `ggplot2` commands (see example below)). See _Data > Visualize_ for details. + +```r +plot(result, vars = "Rsq") + + labs(caption = "Based on data from ...") +``` + +### R-functions + +For an overview of related R-functions used by Radiant to evaluate regression models see _Model > Evaluate regression_ diff --git a/radiant.model/vignettes/pkgdown/_footer.md b/radiant.model/vignettes/pkgdown/_footer.md new file mode 100644 index 0000000000000000000000000000000000000000..05010f02dd76f9e82c3cb8a79ee3cfcec670384d --- /dev/null +++ b/radiant.model/vignettes/pkgdown/_footer.md @@ -0,0 +1,2 @@ + +© Vincent Nijs (2023) Creative Commons License diff --git a/radiant.model/vignettes/pkgdown/_gbt.Rmd b/radiant.model/vignettes/pkgdown/_gbt.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..cd6d71ab4ee74305759dea658531bf3a10d84de1 --- /dev/null +++ b/radiant.model/vignettes/pkgdown/_gbt.Rmd @@ -0,0 +1,20 @@ +> Estimate Gradient Boosted Trees + +To estimate a Gradient Boosted Trees model model select the type (i.e., Classification or Regression), response variable, and one or more explanatory variables. Press the `Estimate` button or `CTRL-enter` (`CMD-enter` on mac) to generate results. + +The model can be "tuned" by changing by adjusting the parameter inputs available in Radiant. In addition to these parameters, any others can be adjusted in _Report > Rmd_. The best way to determine the optimal values for all these hyper-parameters is to use Cross-Validation. In Radiant, you can use the `cv.gbt` function for this purpose. See the documentation for more information. + +For more information on parameters that can be set for XGBoost, see the links below + +* https://xgboost.readthedocs.io/en/latest/parameter.html +* https://xgboost.readthedocs.io/en/latest/tutorials/param_tuning.html + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +### R-functions + +For an overview of related R-functions used by Radiant to estimate a neural network model see _Model > Neural network_. + +The key function from the `xgboost` package used in the `gbt` tool is `xgboost`. diff --git a/radiant.model/vignettes/pkgdown/_logistic.Rmd b/radiant.model/vignettes/pkgdown/_logistic.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..06f9d02bd81de3f4398e93f3db441bd4edbc9126 --- /dev/null +++ b/radiant.model/vignettes/pkgdown/_logistic.Rmd @@ -0,0 +1,122 @@ +> Estimate a Logistic regression for classification + +### Functionality + +To estimate a logistic regression we need a binary response variable and one or more explanatory variables. We also need specify the level of the response variable we will count as _success_ (i.e., the `Choose level:` dropdown). In the example data file `titanic`, success for the variable `survived` would be the level `Yes`. + +To access this dataset go to _Data > Manage_, select `examples` from the `Load data of type` dropdown, and press the `Load` button. Then select the `titanic` dataset. + +In the _Summary_ tab we can test if two or more variables together add significantly to the fit of a model by selecting variables in the `Variables to test` dropdown. This functionality can be very useful to test if the overall influence of a variable of type `factor` is statistically significant. + +Additional output that requires re-estimation: + +* Standardize: Odds-ratios can be hard to compare if the explanatory variables are measured on different scales. By standardizing the explanatory variables before estimation we can see which variables move-the-needle most. Radiant standardizes data for logistic regression by replacing all explanatory variables $X$ by $(X - mean(X))/(2 \times sd(X))$. See Gelman 2008 for discussion. +* Center: Replace all explanatory variables X by X - mean(X). This can be useful when trying to interpret interaction effects +* Stepwise: A data-mining approach to select the best fitting model. Use with caution! +* Robust standard errors: When `robust` is selected the coefficient estimates are the same as a normal logistic regression standard errors are adjusted. This adjustment is used by default when probability weights are specified in estimation. + +Additional output that does not require re-estimation: + +* VIF: Variance Inflation Factors and Rsq. These are measures of multi-collinearity among the explanatory variables +* Confidence intervals: Coefficient confidence intervals +* Odds: Odds-ratios with confidence intervals + + +### Example 1: Titanic Survival + +As an example we will use a dataset that describes the survival status of individual passengers on the Titanic. The principal source for data about Titanic passengers is the Encyclopedia Titanic. One of the original sources is Eaton & Haas (1994) Titanic: Triumph and Tragedy, Patrick Stephens Ltd, which includes a passenger list created by many researchers and edited by Michael A. Findlay. Suppose we want to investigate which factors are most strongly associated with the chance of surviving the sinking of the Titanic. Lets focus on four variables in the database: + +- survived = a factor with levels `Yes` and `No` +- pclass = Passenger Class (1st, 2nd, 3rd). This is a proxy for socio-economic status (SES) 1st ~ Upper; 2nd ~ Middle; 3rd ~ Lower +- sex = Sex (female, male) +- age = Age in years + +Select `survived` as the response variable and `Yes` in **Choose level**. Select `pclass`, `sex` and `age` as the explanatory variables. In the screenshot below we see that each of the coefficients is statistically significant (p.value < .05) and that the model has some predictive power (Chi-squared statistic < .05). Unfortunately the coefficients from a logistic regression model are difficult to interpret. The `OR` column provides estimated odds-ratios. We see that the odds of survival were significantly lower for 2nd and 3rd class passengers compared to 1st class passenger. The odds of survival for males were also lower than for females. While the effect of age is statically significant, for each extra year in age the odds of survival are not as strongly affected (see also the standardized coefficient). + +For each of the explanatory variables the following null and alternate hypotheses can be formulated for the odds ratios: + +* H0: The odds-ratio associated with explanatory variable x is equal to 1 +* Ha: The odds-ratio associated with explanatory variable x is not equal to 1 + +The odds-ratios from the logistic regression can be interpreted as follows: + +- Compared to 1st class passengers, the odds of survival for 2nd class passengers was 72% lower, keeping all other variables in the model constant. +- Compared to 1st class passengers, the odds of survival for 3rd class passengers was 89.8% lower, keeping all other variables in the model constant. +- Compared to female passengers, the odds of survival for male passengers was 91.7% lower, keeping all other variables in the model constant. +- For an increase in passenger age of 1 year the odds of survival decreased by 3.4%, keeping all other variables in the model constant. + +

    + +In addition to the numerical output provided in the _Summary_ tab we can also evaluate the link between `survival`, `class`, `sex`, and `age` visually (see _Plot_ tab). In the screenshot below we see a coefficient (or rather an odds-ratio) plot with confidence intervals. The relative importance of gender and class compared to age clearly stands out. Note: click the check box for standardized coefficients (i.e., `standardize`) in the _Summary_ tab and see if your conclusion changes. + +

    + +Probabilities, are often more convenient for interpretation than coefficients or odds from a logistic regression model. We can use the _Predict_ tab to predict probabilities for different values of the explanatory variable(s) (i.e., a common use of Logistic regression models). First, select the type of input for prediction using the `Prediction input type` dropdown. Choose either an existing dataset for prediction ("Data") or specify a command ("Command") to generate the prediction inputs. If you choose to enter a command you must specify at least one variable and one value in the **Prediction command** box to get a prediction. If you do not specify a value for each variable in the model either the mean value or the most frequent level will be used. It is only possible to predict outcomes based on variables used in the model (e.g., `age` must be one of the selected explanatory variables to predict survival probability for a 90 year old passenger). + +To see how survival probabilities change across passenger classes select `Command` from the `Prediction input type` dropdown in the _Predict_ tab, type `pclass = levels(pclass)`, and press return. + +

    + +The figure above shows that the probabilities drop sharply for 2nd and 3rd class passengers compared to 1st class passengers. For males of average age (approx. 30 yo in the sample) the survival probability was close to 50%. For 30 yo, male, 3rd class passengers this probability was closer to 9%. + +```r + age sex pclass pred + 29.881 male 1st 0.499 + 29.881 male 2nd 0.217 + 29.881 male 3rd 0.092 +``` + +To see the effects of gender type `sex = levels(sex)` in the **Prediction command** box and press return. For average age females in 3rd class the survival probability was around 50%. For males with the same age and class characteristics the chance of survival was closer to 9%. + +```r + age pclass sex pred + 29.881 3rd female 0.551 + 29.881 3rd male 0.092 +``` + +To see the effects for age type `age = seq(0, 100, 20)` in the **Prediction command** box and press return. For male infants in 3rd class the survival probability was around 22%. For 60 year old males in 3rd class the probability drops to around 3.5%. For the oldest males on board, the model predicts a survival probability close to 1%. + +```r + pclass sex age pred + 3rd male 0 0.220 + 3rd male 20 0.124 + 3rd male 40 0.067 + 3rd male 60 0.035 + 3rd male 80 0.018 + 3rd male 100 0.009 +``` + +For a more comprehensive overview of the influence of gender, age, and passenger class on the chances of survival we can generate a full table of probabilities by selecting `Data` from the `Prediction input` dropdown in the _Predict_ tab and selecting `titanic` from the `Prediction data` dropdown. There are too many numbers to easily interpret in table form but the figure gives a clear overview of how survival probabilities change with `age`, `gender`, and `pclass`: + +

    + +You can also create a dataset for input in _Data > Transform_ using `Expand grid` or in a spreadsheet and then paste it into Radiant through the _Data > Manage_ tab. You can also load csv data as input. For example, paste the following link `https://radiant-rstats.github.io/docs/examples/glm_pred.csv` file into Radiant through the _Data > Manage_ tab and try to generate the same predictions. Hint: Use `csv (url)` to load the data link above. + +Once the desired predictions have been generated they can be saved to a CSV file by clicking the download icon on the top right of the screen. To add predictions to the dataset used for estimation, click the `Store` button. + +### Example 2: DVD sales + +We will use the dataset `dvd.rds`, available for download from GitHub. The data contain information on a sample of 20,000 customers who received an "instant coupon." The value of the coupon was varied between \$1 and \$5 and randomly assigned to the selected customers. We can use logistic regression to estimate the effect of the coupon on purchase of a newly released DVD. Customers who received the coupon and purchased the DVD are identified in the data by the variable `buy`. Because the variable we want to predict is binary (`buy` = `yes` if the customer purchased the DVD and `buy` = `no` if she did not), logistic regression is appropriate. + +To keep the example simple, we use only information on the value of the coupon customers received. Hence, `buy` is our response variable and `coupon` is our explanatory (or predictor) variable. + +

    + +The regression output shows that coupon value is a statistically significant predictor of customer purchase. The coefficient from the logistic regression is 0.701 and the odds ratio is equal to 2.015 (i.e., $e^{0.701}$). Because the odds ratio is larger than 1, a higher coupon value is associated with higher odds of purchase. Also, because the p.value for the coefficient is smaller than 0.05 we conclude that (1) the coefficient is statistically significantly different from 0 and (2) the odds ratio is statistically significantly different from 1. An odds ratio of 1 is equivalent to a coefficient estimate of 0 in a linear regression and implies that the explanatory (or predictor) variable has no effect on the response variable. The estimated odds ratio of 2.015 suggests that the odds of purchase increase by 101.6% for each dollar increase in coupon value. + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If a plot was created it can be customized using `ggplot2` commands or with `gridExtra`. See example below and _Data > Visualize_ for details. + +```r +plot(result, plots = "coef", custom = TRUE) + + labs(title = "Coefficient plot") +``` + +### R-functions + +For an overview of related R-functions used by Radiant to estimate a logistic regression model see _Model > Logistic regression_. + +The key functions used in the `logistic` tool are `glm` from the `stats` package and `vif` and `linearHypothesis` from the `car` package. diff --git a/radiant.model/vignettes/pkgdown/_mnl.Rmd b/radiant.model/vignettes/pkgdown/_mnl.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..91401f1959a0899f08e3bfa9c9dc4e2048faf3b2 --- /dev/null +++ b/radiant.model/vignettes/pkgdown/_mnl.Rmd @@ -0,0 +1,104 @@ +> Estimate a Multinomial logistic regression (MNL) for classification + +### Functionality + +To estimate a Multinomial logistic regression (MNL) we require a categorical response variable with two or more levels and one or more explanatory variables. We also need to specify the level of the response variable to be used as the _base_ for comparison. In the example data file, `ketchup`, we could assign `heinz28` as the base level by selecting it from the `Choose level` dropdown in the _Summary_ tab. + +To access the `ketchup` dataset go to _Data > Manage_, select `examples` from the `Load data of type` dropdown, and press the `Load` button. Then select the `ketchup` dataset. + +In the _Summary_ tab we can test if two or more variables together improve the fit of a model by selecting them in the `Variables to test` dropdown. This functionality can be very useful to evaluate the overall influence of a variable of type `factor` with three or more levels. + +Additional output that requires re-estimation: + +* Standardize: Relative risk ratios (RRRs) can be hard to compare if the explanatory variables are measured on different scales. By standardizing the explanatory variables before estimation we can see which variables move-the-needle most. Radiant standardizes data for multinomial logistic regression by replacing all explanatory variables $X$ by $(X - mean(X))/(2 \times sd(X))$. See Gelman 2008 for discussion. +* Center: Replace all explanatory variables X by X - mean(X). This can be useful when trying to interpret interaction effects +* Stepwise: A data-mining approach to select the best fitting model. Use with caution! + +Additional output that does not require re-estimation: + +* Confidence intervals: Coefficient confidence intervals +* RRRs: Relative Risk Ratios with confidence intervals +* Confusion: A confusion matrix that shows the (lack) of consistency between (1) the actual classes observed in the data and (2) the classes predicted as most likely by the model + +### Example: Choice of ketchup + +As an example we will use a dataset on choice behavior for 300 individuals in a panel of households in Springfield, Missouri (USA). The data captures information on 2,798 purchase occasions over a period of approximately 2 years and includes the follow variables: + +* id: Individual identifier +* choice: One of heinz41, heinz32, heinz28, hunts32 +* price.x: Price of product x +* disp.x: Is there a display for product x (yes or no)? +* feat.x: Is there a newspaper feature advertisement for product x (yes or no)? + +The screenshot of the _Data > Pivot_ tab shown below indicates that `heinz32` is the most popular choice option, followed by `heinz28`. `heinz41` and `hunts32` are much less common choices among the household panel members. + +

    + +Suppose we want to investigate how prices of the different products influence the choice of ketchup brand and package size. In the _Model > Multinomial logistic regression (MNL) > Summary_ tab select `choice` as the response variable and `heinz28` from the **Choose base level** dropdown menu. Select `price.heinz28` through `price.hunts32` as the explanatory variables. In the screenshot below we see that most, but not all, of the coefficients have very small p.values and that the model has some predictive power (p.value for the chi-squared statistic < .001). The left-most output column shows which product a coefficient applies to. For example, the 2nd row of coefficients and statistics captures the effect of changes in `price.heinz28` on the choice of `heinz32` relative to the base product (i.e., `heinz28`). If consumers see `heinz28` and `heinz32` as substitutes, which seems likely, we would expect that an increase in `price.heinz28` would lead to an increase in the odds that a consumer chooses `heinz32` rather than `heinz28`. + +Unfortunately the coefficients from a multinomial logistic regression model are difficult to interpret directly. The `RRR` column, however, provides estimates of Relative-Risk-Ratios (or odds) that are easier to work with. The `RRR` values are the exponentiated coefficients from the regression (i.e., $exp(1.099) = 3.000). We see that the `risk` (or odds) of buying `heinz32` rather than `heinz28` is 3 times higher after a \$1 increase in `price.heinz28`, keeping all other variables in the model constant. + +

    + +For each of the explanatory variables the following null and alternate hypotheses can be formulated: + +* H0: The relative risk ratio associated with explanatory variable x is equal to 1 +* Ha: The relative risk ratio associated with explanatory variable x is not equal to 1 + +A selected set of relative risk ratios from the multinomial logistic regression can be interpreted as follows: + +```r + RRR coefficient std.error z.value p.value + heinz32 price.heinz32 0.101 -2.296 0.135 -17.033 < .001 *** + hunts32 price.heinz28 3.602 1.282 0.126 10.200 < .001 *** + hunts32 price.hunts32 0.070 -2.655 0.208 -12.789 < .001 *** +``` + +- The RRR for a \$1 increase in `price.heinz32` on the relative odds or purchasing `heinz32` rather than `heinz28` is 0.101. If the price for `heinz32` increased by \$1, the odds of purchasing `heinz32` rather than `heinz28` would decrease by a factor of 0.101, or decrease by 89.9%, while holding all other variables in the model constant. +- The RRR for a \$1 increase in `price.heinz28` on the relative odds or purchasing `hunts32` rather than `heinz28` is 3.602. If the price for `heinz28` increased by \$1, the odds of purchasing `hunts32` rather than `heinz28` would increase by a factor of 3.602, or increase by 260.2%, while holding all other variables in the model constant. +- The RRR for a \$1 increase in `price.hunts32` on the relative odds or purchasing `hunts32` rather than `heinz28` is 0.070. If the price for `hunts32` increased by \$1, the odds of purchasing `hunts32` rather than `heinz28` would decrease by a factor of 0.070, or decrease by 93%, while holding all other variables in the model constant. + +The other `RRRs` estimated in the model can be interpreted similarly. + +In addition to the numerical output provided in the _Summary_ tab we can also evaluate the link between `choice` and the prices of each of the four products visually (see _Plot_ tab). In the screenshot below we see a coefficient (or rather an RRR) plot with confidence intervals. We see the following patterns: + +- When `price.heinz28` increases by \$1 the relative purchase odds for `heinz32`, `heinz41`, and `hunts32` increase significantly +- When `price.heinz32` increases, the odds of purchase for `heinz32` compared to `heinz28` decrease significantly. We see the same pattern for `heinz41` and `hunts32` when their prices increase +- `hunts32` is the only product to see a significant improvement in purchase odds relative to `heinz28` from an increase in `price.heinz32` + +

    + +Probabilities, are often more convenient for interpretation than coefficients or RRRs from a multinomial logistic regression model. We can use the _Predict_ tab to predict probabilities for each of the different response variable levels given specific values for the selected explanatory variable(s). First, select the type of input for prediction using the `Prediction input type` dropdown. Choose either an existing dataset for prediction ("Data") or specify a command ("Command") to generate the prediction inputs. If you choose to enter a command, you must specify at least one variable and one value in the **Prediction command** box to get a prediction. If you do not specify a value for each of the variables in the model either the mean value or the most frequently observed level will be used. It is only possible to predict probabilities based on variables used in the model. For example, `price.heinz32` must be one of the selected explanatory variables to predict the probability of choosing to buy `heinz32` when priced at \$3.80. + +* To predict the probability of choosing any the four products when a display for `hunts32` is available in stores type `disp.hunts32 = "yes"` as the command and press enter +* To predict choice probabilities when `heinz41` is (not) on display and (not) featured type `disp.heinz41 = c("yes", "no"), feat.heinz41 = c("yes", "no")` and press enter +* To see how choice probabilities change for each of the products as `price.heinz28` increases type `price.heinz28 = seq(3.40, 5.20, 0.1)` and press enter. See screenshot below. + +

    + +The figure above shows that the probability of purchase drops sharply for `heinz28` as `price.heinz28` increases. `heinz32`, the most popular option in the data, is predicted to see a large increase in purchase probability following an increase in `price.heinz28`. Although the predicted increase in purchase probability for `hunts32` does not look as impressive in the graph compared to the effect on `heinz32`, the relative predicted increase is larger (i.e., 3.2% to 8.4% for `hunts32` versus 39.3% to 72.8% for `heinz32`). + +For a more comprehensive assessment of the impact of price changes for each of the four products on purchase probabilities we can generate a full table of predictions by selecting `Data` from the `Prediction input type` dropdown in the _Predict_ tab and selecting `ketchup` from the `Predict data` dropdown. You can also create a dataset for input in _Data > Transform_ using `Expand grid` or in a spreadsheet and then paste it into Radiant using the _Data > Manage_ tab. + +Once the desired predictions have been generated they can be saved to a CSV file by clicking the download icon on the top right of the prediction table. To add predictions to the dataset used for estimation, click the `Store` button. + +Note that MNL models generate as many columns of probabilities as there are levels in the categorical response variable (i.e., four in the ketchup data). If you want to add only the predictions for the first level (i.e., `heinz28`) to the dataset used for estimation, provide only one name in the `Store predictions` input. If you want to store predictions for all ketchup products, enter four variable names, separated by a comma. + +> Note: We ignored endogeneity concerns in the above discussion. Suppose, for example, that `price.heinz28` changes due to changes in the quality of `heinz28`. Changes in quality effect the price and, likely, also demand for the product. Unless we control in some way for these changes in quality, the estimated effects of price changes are likely to be incorrect (i.e., biased). + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If a plot was created, it can be customized using `ggplot2` commands or with `gridExtra`. See example below and _Data > Visualize_ for details. + +```r +plot(result, plots = "coef", custom = TRUE) + + labs(title = "Coefficient plot") +``` + +### R-functions + +For an overview of related R-functions used by Radiant to estimate a multinomial logistic regression model see _Model > Multinomial logistic regression_. + +The key functions used in the `mnl` tool are `multinom` from the `nnet` package and `linearHypothesis` from the `car` package. diff --git a/radiant.model/vignettes/pkgdown/_nb.Rmd b/radiant.model/vignettes/pkgdown/_nb.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..b14281ec47118f2742c45e2bb9265e40b483dc06 --- /dev/null +++ b/radiant.model/vignettes/pkgdown/_nb.Rmd @@ -0,0 +1,15 @@ +> Estimate a Naive Bayes model + +To estimate a model select the Response variable and one or more Explanatory variables. Press the `Estimate` button or `CTRL-enter` (`CMD-enter` on mac) to generate results. + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If either a plot was created it can be customized using `ggplot2` commands (e.g., `plot(result) + labs(title = "Variable Importance")`). See _Data > Visualize_ for details. + +### R-functions + +For an overview of related R-functions used by Radiant to estimate a naive Bayes classification model see _Model > Naive Bayes_ + +The key function from the `e1071` package used in the `nb` tool is `naiveBayes`. diff --git a/radiant.model/vignettes/pkgdown/_nn.Rmd b/radiant.model/vignettes/pkgdown/_nn.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..da49aeb834c4397f137114cf2c9632118e2859d8 --- /dev/null +++ b/radiant.model/vignettes/pkgdown/_nn.Rmd @@ -0,0 +1,19 @@ +> Estimate a Neural Network + +To estimate a model select the type (i.e., Classification or Regression), response variable, and one or more explanatory variables. Press the `Estimate` button or `CTRL-enter` (`CMD-enter` on mac) to generate results. The model can be "tuned" by changing the `Size` (i.e., the number of nodes in the hidden layer) and by adjusting the `Decay` rate. The higher the value set for `Decay`, the higher the penalty on the size of (the sum of squares of) the weights. When `Decay` is set to 0, the model has the most flexibility to fit the (training) data accurately. However, without `Decay` the model is also more likely to overfit. + +The best way to determine the optimal values for `Size` and `Decays` is to use Cross-Validation. In radiant, you can use the `cv.nn` function for this purpose. See the documentation for more information. + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If either a `Olden` or `Garson` plot was created it can be customized using `ggplot2` commands (e.g., `plot(result, plots = "garson", custom = TRUE) + labs(title = "Garson plot")`). See _Data > Visualize_ for details. + +To add, for example, a title to a network plot use `title(main = "Network plot")`. See the R graphics documentation for additional information. + +### R-functions + +For an overview of related R-functions used by Radiant to estimate a neural network model see _Model > Neural network_. + +The key function from the `nnet` package used in the `nn` tool is `nnet`. diff --git a/radiant.model/vignettes/pkgdown/_regress.Rmd b/radiant.model/vignettes/pkgdown/_regress.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..fb2fe9a903c6bc3bc760f7a26ac7a7e23e67d1f2 --- /dev/null +++ b/radiant.model/vignettes/pkgdown/_regress.Rmd @@ -0,0 +1,378 @@ +> (Linear) Regression: The workhorse of empirical research in the social sciences + +All example files discussed below can be loaded from the Data > Manage page. Click the `examples` radio button and press `Load`. + +### Functionality + +Start by selecting a response variable and one or more explanatory variables. If two or more explanatory variables are included in the model we may want to investigate if any interactions are present. An interaction exists when the effect of an explanatory variable on the response variable is determined, at least partially, by the level of another explanatory variable. For example, the increase in price for a 1 versus a 2 carrot diamond may depend on the clarity level of the diamond. + +In the _Summary_ tab we can test if two or more variables together add significantly to the fit of a model by selecting variables in the `Variables to test` dropdown. This functionality can be very useful to test if the overall influence of a variable of type `factor` is significant. + +Additional output that requires re-estimation: + +* Standardize: Coefficients can be hard to compare if the explanatory variables are measured on different scales. By standardizing the response variable and the explanatory variables before estimation we can see which variables move-the-needle most. Radiant standardizes data by replacing the response variable $Y$ by $(Y - mean(Y))/(2 \times sd(Y))$ and replacing all explanatory variables $X$ by $(X - mean(X))/(2 \times sd(X))$. See Gelman 2008 for discussion +* Center: Replace the response variable Y by Y - mean(Y) and replace all explanatory variables X by X - mean(X). This can be useful when trying to interpret interaction effects +* Stepwise: A data-mining approach to select the best fitting model. Use with caution! +* Robust standard errors: When `robust` is selected the coefficient estimates are the same as OLS. However, standard errors are adjusted to account for (minor) heterogeneity and non-normality concerns. + +Additional output that does not require re-estimation: + +* RMSE: Root Mean Squared Error and Residual Standard Deviation +* Sum of Squares: The total variance in the response variable split into the variance explained by the Regression and the variance that is left unexplained (i.e., Error) +* VIF: Variance Inflation Factors and Rsq. These are measures of multi-collinearity among the explanatory variables +* Confidence intervals: Coefficient confidence intervals + +The _Predict_ tab allows you calculate predicted values from a regression model. You can choose to predict responses for a dataset (i.e., select `Data` from the `Prediction input` dropdown), based on a command (i.e., select `Command` from the `Prediction input` dropdown), or a combination of the two (i.e., select `Data & Command` from the `Prediction input` dropdown). + +If you choose `Command` you must specify at least one variable and value to get a prediction. If you do not specify a value for each variable in the model, either the mean value or the most frequent level will be used. It is only possible to predict outcomes based on variables in the model (e.g., `carat` must be one of the selected explanatory variables to predict the `price` of a 2-carat diamond). + +* To predict the price of a 1-carat diamond type `carat = 1` and press return +* To predict the price of diamonds ranging from .5 to 1 carat at steps of size .05 type `carat = seq(.5,.1,.05)` and press return +* To predict the price of 1,2, or 3 carat diamonds with an ideal cut type `carat = 1:3, cut = "Ideal"` and press return + +Once the desired predictions have been generated they can be saved to a CSV file by clicking the download icon on the top right of the screen. To add predictions to the dataset used for estimation, click the `Store` button. + +The _Plot_ tab is used to provide basic visualizations of the data as well as diagnostic plots to validate the regression model. + +### Example 1: Catalog sales + +We have access to data from a company selling men's and women's apparel through mail-order catalogs (dataset `catalog`). The company maintains a database on past and current customers' value and characteristics. Value is determined as the total \$ sales to the customer in the last year. The data are a random sample of 200 customers from the company's database and has the following 4 variables + +- Sales = Total sales (in \$) to a household in the past year +- Income = Household income (\$1000) +- HH.size = Size of the household (# of people) +- Age = Age of the head of the household + +The catalog company is interested in redesigning their Customer Relationship Management (CRM) strategy. We will proceed in two steps: + +1. Estimate a regression model using last year's sales total. Response variable: sales total for each of the 200 households; Explanatory variables: household income (measured in thousands of dollars), size of household, and age of the household head. To access this dataset go to _Data > Manage_, select `examples` from the `Load data of type` dropdown, and press the `Load` button. Then select the `catalog` dataset. +2. Interpret each of the estimated coefficients. Also provide a statistical evaluation of the model as a whole. +3. Which explanatory variables are significant predictors of customer value (use a 95% confidence level)? + +**Answer:** + +Select the relevant variables mentioned above and press the `Estimate model` button or press `CTRL-enter` (`CMD-enter` on mac). Output from _Model > Linear regression (OLS)_ is provided below: + +

    + +The null and alternate hypothesis for the F-test can be formulated as follows: + +* $H_0$: All regression coefficients are equal to 0 +* $H_a$: At least one regression coefficient is not equal to zero + +The F-statistic suggests that the regression model as a whole explains a significant amount of variance in `Sales`. The calculated F-statistic is equal to 32.33 and has a very small p.value (< 0.001). The amount of variance in sales explained by the model is equal to 33.1% (see R-squared). + +We can replicate the standard F-test that is reported as part of all regression output by selecting `income`, `HH.size`, and `Age` in the `Variables to test` box. The relevant output is shown below. + +Regression 1 - F-test + +Note that in this example, "model 1" is a regression without explanatory variables. As you might expect, the explained variance for model 1 is equal to zero. The F-test compares the _fit_ of model 1 and model 2, adjusted for the difference in the number of coefficients estimated in each model. The test statistic to use is described below. $R^2_2$ is the explained variance for model 2 and $R^2_1$ is the explained variance for model 1. $n$ is equal to the number of rows in the data, and $k_2$ ($k_1$) is equal to the number of estimated coefficients in model 2 (model 1). + +$$ +\begin{eqnarray} + F & = & \frac{(R^2_2 - R^2_1)/(k_2 - k_1)}{(1 - R^2_2)/(n - k_2 - 1)} \\\\ + & = & \frac{(0.331 - 0)/(3 - 0)}{(1 - 0.331)/(200 - 3 - 1)} \\\\ + & = & 32.325 +\end{eqnarray} +$$ + +We can use the provided p.value associated with an F-statistic of 32.325 to evaluate the null hypothesis. We can also calculate the critical F-statistic using the probability calculator. As we can see from the output below that value is 2.651. Because the provided p.value is < 0.001 and the calculated F-statistic is larger than the critical value (32.325 > 2.651) we reject null hypothesis that all coefficient are equal to zero. + +

    + +The coefficients from the regression can be interpreted as follows: + +- For an increase in income of \$1000 we expect, on average, to see an increase in sales of \$1.7754, keeping all other variables in the model constant. +- For an increase in household size of 1 person we expect, on average, to see an increase in sales of \$22.1218, keeping all other variables in the model constant. +- For an increase in the age of the head of the household of 1 year we expect, on average, to see an increase in sales of \$0.45, keeping all other variables in the model constant. + +For each of the explanatory variables the following null and alternate hypotheses can be formulated: + +* H0: The coefficient associated with explanatory variable x is equal to 0 +* Ha: The coefficient associated with explanatory variable x is not equal to 0 + +The coefficients for `Income` and `HH.size` are both significant (p.values < 0.05), i.e., we can reject H0 for each of these coefficients. The coefficient for `Age HH` is not significant (p.value > 0.05), i.e., we cannot reject H0 for `Age HH`. We conclude that a change in Age of the household head does not lead to a significant change in sales. + +We can also use the t.values to evaluate the null and alternative hypotheses for the coefficients. Because the calculated t.value for `Income` and `HH.size` is **larger** than the _critical_ t.value we reject the null hypothesis for both effects. We can obtain the critical t.value by using the probability calculator in the _Basics_ menu. For a t-distribution with 196 degrees of freedom (see the `Errors` line in the `Sum of Squares` table shown above) the critical t.value is 1.972. We have to enter 0.025 and 0.975 as the lower and upper probability bounds in the probability calculator because the alternative hypothesis is `two.sided`. + +

    +
    + +### Example 2: Ideal data for regression + +The data `ideal` contains simulated data that is very useful to demonstrate what data for, and residuals from, a regression should ideally look like. The data has 1,000 observations on 4 variables. `y` is the response variable and `x1`, `x2`, and `x3` are explanatory variables. The plots shown below can be used as a bench mark for regressions on real world data. We will use _Model > Linear regression (OLS)_ to conduct the analysis. First, go the the _Plots_ tab and select `y` as the response variable and `x1`, `x2`, and `x3` as the explanatory variables. + +`y`, `x2`, and `x3` appear (roughly) normally distributed whereas `x1` appears (roughly) uniformly distributed. There are no indication of outliers or severely skewed distributions. + +

    + +In the plot of correlations there are clear associations among the response and explanatory variables as well as among the explanatory variables themselves. Note that in an experiment the x's of interest would have a zero correlation. This is very unlikely in historical data however. The scatter plots in the lower-diagonal part of the plot show that the relationships between the variables are (approximately) linear. + +

    + +The scatter plots of `y` (the response variable) against each of the explanatory variables confirm the insight from the correlation plot. The line fitted through the scatter plots is sufficiently flexible that it would pickup any non-linearities. The lines are, however, very straight, suggesting that a linear model will likely be appropriate. + +

    + +The dashboard of six residual plots looks excellent, as we might expect for these data. True values and predicted values from the regression form a straight line with random scatter, i.e., as the actual values of the response variable go up, so do the predicted values from the model. The residuals (i.e., the differences between the values of the response variable data and the values predicted by the regression) show no pattern and are randomly scattered around a horizontal line. Any pattern would suggest that the model is better (or worse) at predicting some parts of the data compared to others. If a pattern were visible in the Residual vs Row order plot we might be concerned about auto-correlation. Again, the residuals are nicely scattered about a horizontal axis. Note that auto-correlation is a problem we are really only concerned about when we have time-series data. The Q-Q plot shows a nice straight and diagonal line, evidence that the residuals are normally distributed. This conclusion is confirmed by the histogram of the residuals and the density plot of the residuals (green) versus the theoretical density of a normally distributed variable (blue line). + +

    + +The final diagnostic we will discuss is a set of plots of the residuals versus the explanatory variables (or predictors). There is no indication of any trends or heteroscedasticity. Any patterns in these plots would be cause for concern. There are also no outliers, i.e., points that are far from the main cloud of data points. + +

    + +Since the diagnostics look good, we can draw inferences from the regression. First, the model is significant as a whole: the p.value on the F-statistic is less than 0.05 therefore we reject the null hypothesis that all three variables in the regression have slope equal to zero. Second, each variable is statistically significant. For example, the p.value on the t-statistic for `x1` is less than 0.05 therefore we reject the null hypothesis that `x1` has a slope equal to zero when `x2` and `x3` are also in the model (i.e., 'holding all other variables in the model constant'). + +Increases in `x1` and `x3` are associated with increases in `y` whereas increases in `x2` are associated with decreases in `y`. Since these are simulated data the exact interpretation of the coefficient is not very interesting. However, in the scatterplot it looks like increases in `x3` are associated with decreases in `y`. What explains the difference? Hint: consider the correlation plots. + +

    +
    + +### Example 3: Linear or log-log regression? + +Both linear and log-log regressions are commonly applied to business data. In this example we will look for evidence in the data and residuals that may suggest which model specification is appropriate for the available data. + +The data `diamonds` contains information on prices of 3,000 diamonds. A more complete description of the data and variables is available from the _Data > Manage_ page. Select the variable `price` as the response variable and `carat` and `clarity` as the explanatory variables. Before looking at the parameter estimates from the regression go to the _Plots_ tab to take a look at the data and residuals. Below are the histograms for the variables in the model. `Price` and `carat` seem skewed to the right. Note that the direction of skew is determined by where the _tail_ is. + +

    + +In the plot of correlations there are clear associations among the response and explanatory variables. The correlation between `price` and `carat` is very large (i.e., 0.93). The correlation between `carat` and `clarity` of the diamond is significant and negative. + +

    + +The scatter plots of `price` (the response variable) against the explanatory variables are not as clean as for the `ideal` data in Example 2. The line fitted through the scatter plots is sufficiently flexible to pickup non-linearities. The line for `carat` seems to have some curvature and the points do not look randomly scattered around that line. In fact the points seem to fan-out for higher prices and number of carats. There does not seem to be very much movement in `price` for different levels of `clarity`. If anything, the price of the diamond seems to go down as clarity increase. A surprising result we will discuss in more detail below. + +

    + +The dashboard of six residual plots looks less than stellar. The true values and predicted values from the regression form an S-shaped curve. At higher actual and predicted values the spread of points around the line is wider, consistent with what we saw in the scatter plot of `price` versus `carat`. The residuals (i.e., the differences between the actual data and the values predicted by the regression) show an even more distinct pattern as they are clearly not randomly scattered around a horizontal axis. The Residual vs Row order plot looks perfectly straight indicating that auto-correlation is not a concern. Finally, while for the `ideal` data in Example 2 the Q-Q plot showed a nice straight diagonal line, here dots clearly separate from the line at the right extreme. Evidence that the residuals are not normally distributed. This conclusions is confirmed by the histogram and density plots of the residuals that show a more spiked appearance than a normally distributed variable would. + +

    + +The final diagnostic we will discuss is a set of plots of the residuals versus the explanatory variables (or predictors). The residuals fan-out from left to right in the plot of residuals vs carats. The scatter plot of `clarity` versus residuals shows outliers with strong negative values for lower levels of `clarity` and outliers with strong positive values for diamonds with higher levels of `clarity`. + +

    + +Since the diagnostics do not look good, we should **not** draw inferences from this regression. A log-log specification may be preferable. A quick way to check the validity of a log-log model change is available through the _Data > Visualize_ tab. Select `price` as the Y-variable and `carat` as the X-variable in a `Scatter` plot. Check the `log X` and `log Y` boxes to produce the plot below. The relationship between log-price and log-carat looks close to linear. Exactly what we are looking for! + +

    + +We will apply a (natural) log (or _ln_) transformation to both `price` and `carat` and rerun the analysis to see if the log-log specification is more appropriate for the available data. This transformation can be done in _Data > Transform_. Select the variables `price` and `carat`. Choose `Transform` from the `Transformation type` drop-down and choose `Ln (natural log)` from the `Apply function` drop-down. Make sure to click the `Store` button so the new variables are added to the dataset. Note that we cannot apply a log transformation to `clarity` because it is a categorical variable. + +In _Model > Linear regression (OLS)_ select the variable `price_ln` as the response variable and `carat_ln` and `clarity` as the explanatory variables. Before looking at the parameter estimates from the regression go to the _Plots_ tab to take a look at the data and residuals. Below are the histograms for the variables in the model. Note that `price_ln` and `carat_ln` are not right skewed, a good sign. + +

    + +In the plot of correlations there are still clear associations among the response and explanatory variables. The correlation between `price_ln` and `carat_ln` is extremely large (i.e., .93). The correlation between `carat_ln` and `clarity` of the diamond is significant and negative. + +

    + +The scatter plots of `price_ln` (the response variable) against the explanatory variables are now much cleaner. The line through the scatter plot of `price_ln` versus `carat_ln` is (mostly) straight. Although the points do have a bit of a blocked shape around the line, the scattering seems mostly random. We no longer see the points fan-out for higher values of `price_ln` and `carat_ln`. There seems to be a bit more movement in `price_ln` for different levels of `clarity`. However, the `price_ln` of the diamond still goes down as `clarity` increases which is unexpected. We will discuss this result below. + +

    + +The dashboard of six residual plots looks much better than for the linear model. The true values and predicted values from the regression (almost) form a straight line. Although at higher and lower actual and predicted values the line is perhaps still very slightly curved. The residuals are much closer to a random scatter around a horizontal line. The Residual vs Row order plot still looks perfectly straight indicating that auto-correlation is not a concern. Finally, the Q-Q plot shows a nice straight and diagonal line, just like we saw for the `ideal` data in Example 2. Evidence that the residuals are now normally distributed. This conclusion is confirmed by the histogram and density plot of the residuals. + +

    + +The final diagnostic we will discuss is a set of plots of the residuals versus the explanatory variables (or predictors). The residuals look much closer to random scatter around a horizontal line compared to the linear model. Although for low (high) values of `carat_ln` the residuals may be a bit higher (lower). + +

    + +Since the diagnostics now look much better, we can feel more confident about drawing inferences from this regression. The regression results are available in the _Summary_ tab. Note that we get 7 coefficients for the variable clarity compared to only one for `carat_ln`. How come? If you look at the data description (_Data > Manage_) you will see that clarity is a categorical variables with levels that go from IF (worst clarity) to I1 (best clarity). Categorical variables must be converted to a set of dummy (or indicator) variables before we can apply numerical analysis tools like regression. Each dummy indicates if a particular diamond has a particular clarity level (=1) or not (=0). Interestingly, to capture all information in the 8-level clarity variable we only need 7 dummy variables. Note there is no dummy variable for the clarity level I1 because we don't actually need it in the regression. When a diamond is **not** of clarity SI2, SI1, VS2, VS1, VVS2, VVS1 or IF we know that in our data it must be of clarity I1. + +The F-statistic suggests that the regression model as a whole explains a significant amount of variance in `price_ln`. The F-statistic is very large and has a very small p.value (< 0.001) so we can reject the null hypothesis that all regression coefficients are equal to zero. The amount of variance in `price_ln` explained by the model is equal to 96.6. It seems likely that prices of diamonds will be much easier to predict than demand for diamonds. + +The null and alternate hypothesis for the F-test can be formulated as follows: +H0: All regression coefficients are equal to 0 +Ha: At least one regression coefficient is not equal to zero + +The coefficients from the regression can be interpreted as follows: + +- For a 1% increase in carats we expect, on average, to see a 1.809% increase in the price of a diamond of, keeping all other variables in the model constant +- Compared to a diamond of clarity I1 we expect, on average, to pay 100x(exp(.444)-1) = 55.89% more for a diamond of clarity SI2, keeping all other variables in the model constant +- Compared to a diamond of clarity I1 we expect, on average, to pay 100x(exp(.591)-1) = 80.58% more for a diamond of clarity SI1, keeping all other variables in the model constant +- Compared to a diamond of clarity I1 we expect, on average, to pay 100x(exp(1.080)-1) = 194.47% more for a diamond of clarity IF, keeping all other variables in the model constant + +The coefficients for each of the levels of clarity imply that an increase in `clarity` will increase the price of diamond. Why then did the scatter plot of clarity versus (log) price show price decreasing with clarity? The difference is that in a regression we can determine the effect of a change in one variable (e.g., clarity) keeping all other variables in the model constant (i.e., carat). Bigger, heavier, diamonds are more likely to have flaws compared to small diamonds so when we look at the scatter plot we are really seeing the effect of not only improving clarity on price but also the effect of carats which are negatively correlated with clarity. In a regression, we can compare the effects of different levels of clarity on (log) price for a diamond of **the same size** (i.e., keeping carat constant). Without (log) carat in the model the estimated effect of clarity would be incorrect due to omitted variable bias. In fact, from a regression of `price_ln` on `clarity` we would conclude that a diamond of the highest clarity in the data (IF) would cost 59.22% less compared to a diamond of the lowest clarity (I1). Clearly this is not a sensible conclusion. + +For each of the explanatory variables the following null and alternate hypotheses can be formulated: +H0: The coefficient associated with explanatory variable X is equal to 0 +Ha: The coefficient associated with explanatory variable X is not equal to 0 + +All coefficients in this regression are highly significant. + +

    + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If a plot was created it can be customized using `ggplot2` commands or with `patchwork`. See example below and _Data > Visualize_ for details. + +```r +result <- regress(diamonds, rvar = "price", evar = c("carat", "clarity", "cut", "color")) +summary(result) +plot(result, plots = "scatter", custom = TRUE) %>% + wrap_plots(plot_list, ncol = 2) + plot_annotation(title = "Scatter plots") +``` + +### Video Tutorials + +Copy-and-paste the full command below into the RStudio console (i.e., the bottom-left window) and press return to gain access to all materials used in the linear regression module of the Radiant Tutorial Series: + +
    usethis::use_course("https://www.dropbox.com/sh/s70cb6i0fin7qq4/AACje2BAivEKDx7WrLrPr5m9a?dl=1")
    + +Data Exploration and Pre-check of Regression (#1) + +* This video shows how to use Radiant to explore and visualize data before running a linear regression +* Topics List: + - View data + - Visualize data + +Interpretation of Regression Results and Prediction (#2) + +* This video explains how to interpret the regression results and calculate the predicted value from a linear regression model +* Topics List: + - Interpret coefficients (numeric and categorical variables) + - Interpret R-squared and adjusted R-squared + - Interpret F-test result + - Predict from a regression model + +Dealing with Categorical Variables (#3) + +* This video shows how to deal with categorical variables in a linear regression model +* Topics List: + - Check the baseline category in Radiant + - Change the baseline category + +Adding New Variables into a Regression Model (#4) + +* This video demonstrates how to test if adding new variables will lead to a better model with significantly higher explanatory power +* Topics List: + - Set up a hypothesis test for adding new variables in Radiant + - Interpret the F-test results + - Compare this F-test to the default F-test in regression summary + +Linear Regression Validation (#5) + +* This video demonstrates how to validate a linear regression model +* Topics List: + - Linearity (scatter plots, same as the one in the pre-check) + - Normality Check (Normal Q-Q plot) + - Multicollinearity (VIF) + - Heteroscedasticity + +Log-log Regression (#6) + +* This video demonstrates when and how to run a log-log regression +* Topics List: + - Transform data with skewed distributions by natural log function + - Interpret the coefficients in a log-log regression + +### Technical notes + +#### Coefficient interpretation for a linear model + +To illustrate the interpretation of coefficients in a regression model we start with the following equation: + +$$ + S_t = a + b P_t + c D_t + \epsilon_t +$$ + +where $S_t$ is sales in units at time $t$, $P_t$ is the price in \$ at time $t$, $D_t$ is a dummy variable that indicates if a product is on display in a given week, and $\epsilon_t$ is the error term. + +For a continuous variable such as price we can determine the effect of a \$1 change, while keeping all other variables in the model constant, by taking the partial derivative of the sales equation with respect to $P$. + +$$ + \frac{ \partial S_t }{ \partial P_t } = b +$$ + +So $b$ is the marginal effect on sales of a \$1 change in price. Because a dummy variable such as $D$ is not continuous we cannot use differentiation and the approach needed to determine the marginal effect is a little different. If we compare sales levels when $D = 1$ to sales levels when $D = 0$ we see that + +$$ + a + b P_t + c \times 1 - a + b P_t + c \times 0 = c +$$ + +For a linear model $c$ is the marginal effect on sales when the product is on display. + +#### Coefficient interpretation for a semi-log model + +To illustrate the interpretation of coefficients in a semi-log regression model we start with the following equation: + +$$ + ln S_t = a + b P_t + c D_t + \epsilon_t +$$ + +where $ln S_t$ is the (natural) log of sales at time $t$. For a continuous variable such as price we can again determine the effect of a small change (e.g., \$1 for a \$100 dollar product), while keeping all other variables in the model constant, by taking the partial derivative of the sales equation with respect to $P$. For the left-hand side of the equation we can use the chain-rule to get + +$$ + \frac {\partial ln S_t}{\partial P_t} = \frac{1}{S_t} \frac{\partial S_t}{\partial P_t} +$$ + +In words, the derivative of the natural logarithm of a variable is the reciprocal of that variable, times the derivative of that variable. From the discussion on the linear model above we know that + +$$ + \frac{ \partial a + b P_t + c D_t}{ \partial P_t } = b +$$ + +Combining these two equations gives + +$$ + \frac {1}{S_t} \frac{\partial S_t}{\partial P_t} = b \; \text{or} \; \frac {\Delta S_t}{S_t} \approx b +$$ + +So a \$1 change in price leads to a $100 \times b\%$ change in sales. Note that this approximation is only appropriate for small changes in the explanatory variable and may be affected by the scaling used (e.g., price in cents, dollars, or 1,000s of dollars). The approach outlined below for dummy variables is more general and can also be applied to continuous variables. + +Because a dummy variable such as $D$ is not continuous we cannot use differentiation and will again compare sales levels when $D = 1$ to sales levels when $D = 0$ to get $\frac {\Delta S_t}{S_t}$. To get $S_t$ rather than $ln S_t$ on the left hand side we take the exponent of both sides. This gives $S_t = e^{a + b P_t + c D_t}$. The percentage change in $S_t$ when $D_t$ changes from 0 to 1 is then given by: + +$$ + \begin{aligned} + \frac {\Delta S_t}{S_t} &\approx \frac{ e^{a + b P_t + c\times 1} - e^{a + b P_t + c \times 0} } {e^{a + b P_t + c \times 0} }\\ + &= \frac{ e^{a + b P_t} e^c - e^{a + b P_t} }{ e^{a + b P_t} }\\ + &= e^c - 1 + \end{aligned} +$$ + +For the semi-log model $100 \times \: (exp(c)-1)$ is the percentage change in sales when the product is on display. Similarly, for a \$10 increase in price we would expect a $100 \times \: (exp(b \times 10)-1)$ increase in sales, keeping other variables constant. + +#### Coefficient interpretation for a log-log model + +To illustrate the interpretation of coefficients in a log-log regression model we start with the following equation: + +$$ + ln S_t = a + b ln P_t + \epsilon_t +$$ + +where $ln P_t$ is the (natural) log of sales at time $t$. Ignoring the error term for simplicity we can rewrite this model in its multiplicative form by taking the exponent on both sides: + +$$ + \begin{aligned} + S_t &= e^a + e^{b ln P_t}\\ + S_t &= a^* P^b_t + \end{aligned} +$$ + +where $a^* = e^a$ For a continuous variable such as price we can again take the partial derivative of the sales equation with respect to $P_t$ to get the marginal effect. + +$$ + \begin{aligned} + \frac{\partial S_t}{\partial P_t} &= b a^* P^{b-1}_t\\ + &= b S_t P^{-1}_t\\ + &= b \frac{S_t}{P_t} + \end{aligned} +$$ + +The general formula for an elasticity is $\frac{\partial S_t}{\partial P_t} \frac{P_t}{S_t}$. Adding this information to the equation above we see that the coefficient $b$ estimated from a log-log regression can be directly interpreted as an elasticity: + +$$ + \frac{\partial S_t}{\partial P_t} \frac{P_t}{S_t} = b \frac{S_t}{P_t} \frac{P_t}{S_t} = b +$$ + +So a 1% change in price leads to a $b$% change in sales. + +### R-functions + +For an overview of related R-functions used by Radiant to estimate a linear regression model see _Model > Linear regression (OLS)_. + +The key functions used in the `regress` tool are `lm` from the `stats` package and `vif` and `linearHypothesis` from the `car` package. diff --git a/radiant.model/vignettes/pkgdown/_rforest.Rmd b/radiant.model/vignettes/pkgdown/_rforest.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..be36adc87c964714b4037291655456b460a8e785 --- /dev/null +++ b/radiant.model/vignettes/pkgdown/_rforest.Rmd @@ -0,0 +1,15 @@ +> Estimate a Random Forest + +To create a Random Forest, first select the type (i.e., Classification or Regression), response variable, and one or more explanatory variables. Press the `Estimate model` button or `CTRL-enter` (`CMD-enter` on mac) to generate results. + +The model can be "tuned" by changing the `mtry`, `# trees`, `Min node size`, and `Sample fraction` inputs. The best way to determine the optimal values for these hyper parameters is to use Cross-Validation. In radiant, you can use the `cv.rforest` function for this purpose. See the documentation for more information. + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +### R-functions + +For an overview of related R-functions used by Radiant to estimate a neural network model see _Model > Neural network_. + +The key function from the `ranger` package used in the `rforest` tool is `ranger`. diff --git a/radiant.model/vignettes/pkgdown/_simulater.Rmd b/radiant.model/vignettes/pkgdown/_simulater.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..f4471f936ea64e738de19b8d0ae5a75ab4820a1e --- /dev/null +++ b/radiant.model/vignettes/pkgdown/_simulater.Rmd @@ -0,0 +1,288 @@ +> Simulation for decision analysis + +```{r include = FALSE} +library(radiant.data) +``` + +Start by selecting the types of variables to use in the simulation from the `Select types` dropdown in the _Simulate_ tab. Available types include Binomial, Constant, Discrete, Log normal, Normal, Uniform, Data, Grid search, and Sequence. + +### Binomial + +Add random variables with a binomial distribution using the `Binomial variables` inputs. Start by specifying a `Name` (`crash`), the number of trials (n) (e.g., 20) and the probability (p) of a `success` (.01). Then press the icon. Alternatively, enter (or remove) input directly in the text input area (e.g., crash 20 .01). + +### Constant + +List the constants to include in the analysis in the `Constant variables` input. You can either enter names and values directly into the text area (e.g., `cost 3`) or enter a name (`cost`) and a value (5) in the `Name` and `Value` input respectively and then press the icon. Press the icon to remove an entry. Note that only variables listed in the (larger) text-input boxes will be included in the simulation. + +### Discrete + +Define random variables with a discrete distribution using the `Discrete variables` inputs. Start by specifying a `Name` (`price`), the values (6 8), and their associated probabilities (.3 .7). Then press the icon. Alternatively, enter (or remove) input directly in the text input area (e.g., price 6 8 .3 .7). Note that the probabilities must sum to 1. If not, a message will be displayed and the simulation cannot be run. + +### Log Normal + +To include log normally distributed random variables in the analysis select `Log Normal` from the `Select types` dropdown and use `Log-normal variables` inputs. See the section `Normal` below for additional information. + +### Normal + +To include normally distributed random variables in the analysis select `Normal` from the `Select types` dropdown and use `Normal variables` inputs. For example, enter a `Name` (`demand`), the `Mean` (1000) and the standard deviation (`St.dev.`, 100). Then press the icon. Alternatively, enter (or remove) input directly in the text input area (e.g., `demand 1000 100`). + +### Poisson + +The Poisson distribution is useful to simulate the number of times and event occurs in a particular time span, such as the number of patients arriving in an emergency room between 10 and 11pm. To include Poisson distributed random variables in the analysis select `Poisson` from the `Select types` dropdown and use `Poisson variables` inputs. For example, enter a `Name` (`patients`) and a value for the number of occurrences `Lambda` the event of interest (20). Then press the icon. Alternatively, enter (or remove) input directly in the text input area (e.g., `patients 20`). + +### Uniform + +To include uniformly distributed random variables in the analysis select `Uniform` from the `Select types` dropdown. Provide parameters in the `Uniform variables` inputs. For example, enter a `Name` (`cost`), the `Min` (10) and the `Max` (15) value. Then press the icon. Alternatively, enter (or remove) input directly in the text input area (e.g., `cost 10 15`). + +### Data + +To include variables from a separate data-set in the calculations specified in the `Simulation formulas` input box, choose a data-set from the `Input data for calculations` dropdown. This can be very useful in combination with the `Grid search` feature for portfolio optimization. However, when used in conjunction with other inputs care must be taken to ensure the number of values returned by different calculations is the same. Otherwise you will see an error like: + +`Error: arguments imply differing number of rows: 999, 3000` + +### Grid search + +To include a sequence of values select `Grid search` from the `Select types` dropdown. Provide the minimum and maximum values as well as the step-size in the `Grid search` inputs. For example, enter a `Name` (`price`), the `Min` (4), `Max` (10), and `Step` (0.01) value. If multiple variables are specified in `Grid search` all possible value combinations will be created and evaluated in the simulation. For example, suppose a first variable is defined as `x 1 3 1` and a second as `y 4 5 1` in the `Grid search` text input then the following data is generated: + +```{r results = 'asis', echo = FALSE} +x <- c(1, 2, 3) +y <- c(4, 5) +tab_large <- "class='table table-condensed table-hover' style='width:40%;'" +expand.grid(x, y) %>% + set_names(c("x", "y")) %>% + knitr::kable(align = "l", format = "html", escape = FALSE, table.attr = tab_large) +``` + +Note that if `Grid search` has been selected the number of values generated will override the number of simulations or repetitions specified in `# sims` or `# reps`. If this is not what you want use `Sequence`. Then press the icon. Alternatively, enter (or remove) input directly in the text input area (e.g., `price 4 10 0.01`). + +### Sequence + +To include a sequence of values select `Sequence` from the `Select types` dropdown. Provide the minimum and maximum values in the `Sequence variables` inputs. For example, enter a `Name` (`trend`), the `Min` (1) and the `Max` (1000) value. Note that the number of 'steps' is determined by the number of simulations. Then press the icon. Alternatively, enter (or remove) input directly in the text input area (e.g., `trend 1 1000`). + +### Formulas + +To perform a calculation using the generated variables, create a formula in the `Simulation formulas` input box in the main panel (e.g., `profit = demand * (price - cost)`). Formulas are used to add (calculated) variables to the simulation or to update existing variables. You must specify the name of the new variable to the left of a `=` sign. Variable names can contain letters, numbers, and `_` but no other characters or spaces. You can enter multiple formulas. If, for example, you would also like to calculate the margin in each simulation press `return` after the first formula and type `margin = price - cost`. + +Many of the same functions used with `Create` in the _Data > Transform_ tab and in `Filter data` in _Data > View_ can also be included in formulas. You can use `>` and `<` signs and combine them. For example `x > 3 & y == 2` would evaluate to `TRUE` when the variable `x` has values larger than 3 **AND** `y` has values equal to 2. Recall that in R, and most other programming languages, `=` is used to _assign_ a value and `==` to evaluate if the value of a variable is exactly equal to some other value. In contrast `!=` is used to determine if a variable is _unequal_ to some value. You can also use expressions that have an **OR** condition. For example, to determine when `Salary` is smaller than \$100,000 **OR** larger than \$20,000 use `Salary > 20000 | Salary < 100000`. `|` is the symbol for **OR** and `&` is the symbol for **AND** (see also the help file for _Data > View_). + +A few additional examples of formulas are shown below: + +- Create a new variable z that is the difference between variables x and y + +```r +z = x - y +``` + +- Create a new `logical` variable z that takes on the value TRUE when x > y and FALSE otherwise + +```r +z = x > y +``` + +- Create a new `logical` z that takes on the value TRUE when x is equal to y and FALSE otherwise + +```r +z = x == y +``` + +- The command above is equivalent to the one below using `ifelse`. Note the similarity to `if` statements in Excel + +```r +z = ifelse(x < y, TRUE, FALSE) +``` + +- `ifelse` statements can be used to create more complex (numeric) variables as well. In the example below, z will take on the value 0 if x is smaller than 60. If x is larger than 100, z is set equal to 1. Finally, when x is 60, 100, or between 60 and 100, z is set to 2. **Note:** make sure to include the appropriate number of opening `(` and closing `)` brackets! + +```r +z = ifelse(x < 60, 0, ifelse(x > 100, 1, 2)) +``` + +- To create a new variable z that is a transformation of variable x but with mean equal to zero: + +```r +z = x - mean(x) +``` + +- To create a new variable z that shows the absolute values of x: + +```r +z = abs(x) +``` + +- To find the value for `price` that maximizes `profit` use the `find_max` command. In this example `price` could be a random or `Sequence variable`. There is also a `find_min` command. + +```r +optimal_price = find_max(profit, price) +``` + +- To determine the minimum (maximum) value for each pair of values across multiple variables (e.g., x and y) use the functions `pmin` and `pmax`. In the example below, z will take on the value of x when x is larger than y and take on the value of y otherwise. + +```r +z = pmax(x, y) +``` + +See the table below for an example: + +```{r results = 'asis', echo = FALSE} +x <- c(1, 2, 3, 4, 5) +y <- c(0, 3, 8, 2, 10) +tab_large <- "class='table table-condensed table-hover' style='width:40%;'" +data.frame( + x = x, + y = y, + `pmax(x,y)` = pmax(x, y), + check.names = FALSE +) %>% + knitr::kable(align = "l", format = "html", escape = FALSE, table.attr = tab_large) +``` +- Similar to `pmin` and `pmax` a number of functions are available to calculate summary statics across multiple variables. For example, `psum` calculates the sum of elements across different vectors. See https://radiant-rstats.github.io/radiant.data/reference/pfun.html for more information. + +```r +z = psum(x, y) +``` + +See the table below for an example: + +```{r results = 'asis', echo = FALSE} +x <- c(1, 2, 3, 4, 5) +y <- c(0, 3, 8, 2, 10) +tab_large <- "class='table table-condensed table-hover' style='width:40%;'" +data.frame( + x = x, + y = y, + `psum(x,y)` = psum(x, y), + check.names = FALSE +) %>% + knitr::kable(align = "l", format = "html", escape = FALSE, table.attr = tab_large) +``` + + +Other commonly used functions are `ln` for the natural logarithm (e.g., `ln(x)`), `sqrt` for the square-root of x (e.g., `sqrt(x)`) and `square` to calculate square of a variable (e.g., `square(x)`). + +To return a single value from a calculation use functions such as `min`, `max`, `mean`, `sd`, etc. + +- A special function useful for portfolio optimization is `sdw`. It takes weights and variables as inputs and returns the standard deviation of the weighted sum of the variables. For example, to calculated the standard deviation for a portfolio of three stocks (e.g., Boeing, GM, and Exxon) you could use the equation below in the `Simulation formulas` input. `f` and `g` could be values (e.g., 0.2 and 0.8) or vectors of different weights specified in a `Grid search` input (see above). `Boeing`, `GM`, and `Exxon` are names of variables in a data-set included in the simulation using a `Data` input (see above). + +```r +Pstdev = sdw(f, g, 1-f-g, Boeing, GM, Exxon) +``` + +For an example of how the simulate tool could be used for portfolio optimization see the state-file available for download here + +### Functions + +It is possible that the standard functions available in R are not sufficiently flexible to conduct the simulation you have in mind. If this is the case, click on the `Add functions` check box on the bottom left of your screen and can create your own custom function in the `Simulation functions` input box in the main panel. To learn about writing R-functions see https://www.statmethods.net/management/userfunctions.html for a good place to start. + +For an example of how to use custom R-functions in a gambling simulation, see the state-file available for download here. The report generated through _Report > Rmd_ provides additional information about the simulation setup and the use of functions. + +### Running the simulation + +The value shown in the `# sims` input determines the number of simulation _draws_. To redo a simulation with the same randomly generated values, specify a number in the `Set random seed` input (e.g., 1234). + +To save the simulated data for further analysis, specify a name in the `Simulated data` input box. You can then investigate the simulated data by choosing the data with the specified name from the `Datasets` dropdown in any of the _Data_ tabs (e.g., _Data > View_, _Data > Visualize_, or _Data > Explore_). + +When all required inputs have been specified press the `Simulate` button to run the simulation. + +In the screen shot below `var_cost` and `fixed_cost` are specified as constants. `E` is normally distributed with a mean of 0 and a standard deviation of 100. `price` is a discrete random variable that is set to \$6 (30% probability) or $8 (70% probability). There are three formulas in the `Simulation formulas` text-input. The first establishes the dependence of `demand` on the simulated variable `price`. The second formula specifies the profit function. The final formula is used to determine the number (and proportion) of cases where profit is below 100. The result is assigned to a new variable `profit_small`. + +

    + +In the output under `Simulation summary` we first see details on the specification of the simulation (e.g., the number of simulations). The section `Constants` lists the value of variables that do not vary across simulations. The sections `Random variables` and `Logicals` list the outcomes of the simulation. We see that average `demand` in the simulation is 627.94 with a standard deviation of 109.32. Other characteristics of the simulated data are also provided (e.g., the maximum profit is 1758.77). Finally, we see that the probability of `profits` below 100 is equal 0.32 (i.e., profits were below \$100 in 315 out of the 1,000 simulations). + +To view histograms of the random variables as well as the variables created using `Simulation formulas` ensure `Show plots` is checked. + +

    + +Because we specified a name in the `Simulated data` box the data are available as `simdat` within Radiant (see screen shots below). To use the data in Excel click the download icon on the top-right of the screen in the _Data > View_ tab or go to the _Data > Manage_ tab and save the data to a csv file (or use the clipboard feature). For more information see the help file for the _Data > Manage_ tab. + +

    + +## Repeating the simulation + +Suppose the simulation discussed above was used to get a better understanding of daily profits. To develop insights into annual profits we could re-run the simulation 365 times. However, this can be done more conveniently by using the functionality available in the _Repeat_ tab. First, select the `Variables to re-simulate`, here `E` and `price`. Then select the variable(s) of interest in the `Output variables` box (e.g., `profit`). Set `# reps` to 365. + +Next, we need to determine how to summarize the data. If we select `Simulation` in `Group by` the data will be summarized for each draw in the simulation **across** 365 repeated simulations resulting in 1,000 values. If we select `Repeat` in `Group by` the data will be summarized for each repetition **across** 1,000 simulations resulting in 365 values. If you imagine the full set of repeated simulated data as a table with 1,000 rows and 365 columns, grouping by `Simulation` will create a summary statistic for each row and grouping by `Repeat` will create a summary statistic for each column. In this example we want to determine the `sum` of simulated daily profits across 365 repetitions so we select `Simulation` in the `Group by` box and `sum` in the `Apply function` box. + +To determine, the probability that annual profits are below \$36,500 we enter the formula below into the `Repeated simulation formula` text input. + +```r +profit_365 = profit_sum < 36500 +``` + +Note that `profit_sum` is the `sum` of repeated simulations of the `profit` variable defined in the _Simulate_ tab. When you are done with the input values click the `Repeat` button. Because we specified a name for `Repeat data` a new data set will be created. `repdat` will contain the summarized data grouped per simulation (i.e., 1,000 rows). To store all 365 x 1,000 simulations/repetitions select `none` from the `Apply function` dropdown. + +Descriptive statistics for the repeated simulation are shown in the main panel under `Repeated simulation summary`. We see that the annual expected profit (i.e., the mean of `profit_sum`) for the company is 172,311.84 with a standard deviation of 10,772.29. Although we found above that daily profits can be below \$100, the chance that profits are below $365 \times 100$ for the entire year are slim to none (i.e., the proportion of repeated simulations with annual profits below \$36,500 is equal to 0). + +

    + +If `Show plots` is checked a histogram of annual profits (`profit_sum`) is shown under `Repeated simulation plots`. There is no plot for `profit_365` because it has only one value (i.e., FALSE). + +

    + +The state-file for the example in the screenshots above is available for download here + +For a simple example of how the simulate tool could be used to find the price that maximizes profits see the state-file available for download here + +### Using Grid Search in the Repeat tab + +Note that the _Repeat_ tab also has the option to use a `Grid search` input to repeat a simulation by replacing one or more `Constants` specified in the `Simulation` tab in an iterative fashion. This input option is shown only when `Group by` is set to `Repeat`. Provide the minimum and maximum values as well as the step-size in the `Grid search` inputs. For example, enter a `Name` (`price`), the `Min` (4), `Max` (10), and `Step` (0.01) value. If multiple variables are specified in `Grid search` all possible value combinations will be created and evaluated in the simulation. Note that if `Grid search` has been selected the number of values generated will override the number of repetitions specified in `# reps`. Then press the icon. Alternatively, enter (or remove) input directly in the text area (e.g., `price 4 10 0.01`). + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If a plot was created it can be customized using `ggplot2` commands or with `patchwork`. See example below and _Data > Visualize_ for details. + +```{r echo=TRUE, eval=FALSE} +plot(result, custom = TRUE) %>% + wrap_plots(plot_list, ncol = 2) + plot_annotation(title = "Simulation plots") +``` + +### R-functions + +For an overview of related R-functions used by Radiant to construct and evaluate (repeated) simulation models see _Model > Simulate_. + +Key functions from the `stats` package used in the `simulater` tool are `rbinom`, `rlnorm`, `rnorm`, `rpios`, and `runif` + +### Video Tutorials + +Copy-and-paste the full command below into the RStudio console (i.e., the bottom-left window) and press return to gain access to all materials used in the simulation module of the Radiant Tutorial Series: + +
    usethis::use_course("https://www.dropbox.com/sh/72kpk88ty4p1uh5/AABWcfhrycLzCuCvI6FRu0zia?dl=1")
    + +Setting Up a Simulation in Radiant (#1) + +* This video demonstrates how to use Radiant to set up a simulation +* Topics List: + - Brief introduction to the Poisson distribution + - Specifying a simulation + - Interpretation of the simulation summary + +Setting Up a Repeated Simulation in Radiant (#2) + +* This video shows how to use Radiant to set up a repeated simulation +* Topics List: + - Specifying a repeated simulation + - Interpretation of the repeated simulation summary + +Using simulation to solve probability questions (#3) + +* This video demonstrates how to use simulation to solve probability questions in Radiant +* Topics List: + - Review of setting up a (repeated) simulation + - Interpretation of the simulation summary + - Intuition of how repeated simulations work + +Simulation Formula Tips (#4) + +* This video discusses some helpful functions that are commonly used in simulation formulas +* Topics List: + - Use `ifelse` to specify a simulation formula + - Use `pmax` to specify a simulation formula + +Using Grid Search in Simulation (#5) + +* This video demonstrates how to use grid search in simulation +* Topics List: + - Find an optimal value by sorting simulated data or create a plot + - Find an optimal value by using the `find_max` function diff --git a/radiant.model/vignettes/pkgdown/crs.Rmd b/radiant.model/vignettes/pkgdown/crs.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..23cc23e85757c2bf9058a649e8ff0daa5bd1ed8d --- /dev/null +++ b/radiant.model/vignettes/pkgdown/crs.Rmd @@ -0,0 +1,10 @@ +--- +title: "Model > Collaborative Filtering" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_crs.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.model/vignettes/pkgdown/crtree.Rmd b/radiant.model/vignettes/pkgdown/crtree.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..41eac7cf6403a964f8af642cb4cb685429208874 --- /dev/null +++ b/radiant.model/vignettes/pkgdown/crtree.Rmd @@ -0,0 +1,10 @@ +--- +title: "Model > Classification and regression trees" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_crtree.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.model/vignettes/pkgdown/dtree.Rmd b/radiant.model/vignettes/pkgdown/dtree.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..efa3f0973e52efdfe905a24ebeb5fe26b229ddef --- /dev/null +++ b/radiant.model/vignettes/pkgdown/dtree.Rmd @@ -0,0 +1,10 @@ +--- +title: "Model > Decision Analysis" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_dtree.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.model/vignettes/pkgdown/evalbin.Rmd b/radiant.model/vignettes/pkgdown/evalbin.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..e13782a5f30a2bee5c6321f27862508914b668a2 --- /dev/null +++ b/radiant.model/vignettes/pkgdown/evalbin.Rmd @@ -0,0 +1,10 @@ +--- +title: "Model > Evaluate classification" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_evalbin.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.model/vignettes/pkgdown/evalreg.Rmd b/radiant.model/vignettes/pkgdown/evalreg.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..d5bd2b9ed287d3a632ad195ef38e09ec68c2b031 --- /dev/null +++ b/radiant.model/vignettes/pkgdown/evalreg.Rmd @@ -0,0 +1,10 @@ +--- +title: "Model > Evaluate regression" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_evalreg.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.model/vignettes/pkgdown/gbt.Rmd b/radiant.model/vignettes/pkgdown/gbt.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..15698c73075b9f2c9698b2d77d3b35c6c914d165 --- /dev/null +++ b/radiant.model/vignettes/pkgdown/gbt.Rmd @@ -0,0 +1,10 @@ +--- +title: "Model > Gradient Boosted Trees" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_gbt.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.model/vignettes/pkgdown/images/by-nc-sa.png b/radiant.model/vignettes/pkgdown/images/by-nc-sa.png new file mode 100644 index 0000000000000000000000000000000000000000..76eb5da461b41405c500a557253eec5f65169519 Binary files /dev/null and b/radiant.model/vignettes/pkgdown/images/by-nc-sa.png differ diff --git a/radiant.model/vignettes/pkgdown/logistic.Rmd b/radiant.model/vignettes/pkgdown/logistic.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..0ca96e1311d87163d13b54004d9370de60fbe79d --- /dev/null +++ b/radiant.model/vignettes/pkgdown/logistic.Rmd @@ -0,0 +1,10 @@ +--- +title: "Model > Logistic regression" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_logistic.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.model/vignettes/pkgdown/mnl.Rmd b/radiant.model/vignettes/pkgdown/mnl.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..fac749807406fe8b80222d9f593e964734b2f77b --- /dev/null +++ b/radiant.model/vignettes/pkgdown/mnl.Rmd @@ -0,0 +1,10 @@ +--- +title: "Model > Multinomial logistic regression" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_mnl.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.model/vignettes/pkgdown/nb.Rmd b/radiant.model/vignettes/pkgdown/nb.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..86673f036c42bf9c551ec9a18a1d037f4c7c6d02 --- /dev/null +++ b/radiant.model/vignettes/pkgdown/nb.Rmd @@ -0,0 +1,10 @@ +--- +title: "Model > Naive Bayes" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_nb.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.model/vignettes/pkgdown/nn.Rmd b/radiant.model/vignettes/pkgdown/nn.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..04e635a572b9933a44b20cb50b91e93c1320913b --- /dev/null +++ b/radiant.model/vignettes/pkgdown/nn.Rmd @@ -0,0 +1,10 @@ +--- +title: "Model > Neural Network" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_nn.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.model/vignettes/pkgdown/regress.Rmd b/radiant.model/vignettes/pkgdown/regress.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..ece9688b118f12ae366915dbb278d8572d25cd33 --- /dev/null +++ b/radiant.model/vignettes/pkgdown/regress.Rmd @@ -0,0 +1,10 @@ +--- +title: "Model > Linear regression (OLS)" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_regress.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.model/vignettes/pkgdown/rforest.Rmd b/radiant.model/vignettes/pkgdown/rforest.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..5801adefe798e3792f39cce37905e73d98ff9eaa --- /dev/null +++ b/radiant.model/vignettes/pkgdown/rforest.Rmd @@ -0,0 +1,10 @@ +--- +title: "Model > Random Forest" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_rforest.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.model/vignettes/pkgdown/simulater.Rmd b/radiant.model/vignettes/pkgdown/simulater.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..242e979874ffd2f8c4e0b29f7f25a3599c0dd078 --- /dev/null +++ b/radiant.model/vignettes/pkgdown/simulater.Rmd @@ -0,0 +1,15 @@ +--- +title: "Model > Simulate" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r include = FALSE} +library(dplyr) +library(magrittr) +``` + +```{r child = "_simulater.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.multivariate b/radiant.multivariate deleted file mode 160000 index 220f5ec83db9ae8e636c9be128e9faf699526618..0000000000000000000000000000000000000000 --- a/radiant.multivariate +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 220f5ec83db9ae8e636c9be128e9faf699526618 diff --git a/radiant.multivariate/.Rbuildignore b/radiant.multivariate/.Rbuildignore new file mode 100644 index 0000000000000000000000000000000000000000..2eeef44b77ec02c67bcdd67ddf95665ae38ed97e --- /dev/null +++ b/radiant.multivariate/.Rbuildignore @@ -0,0 +1,13 @@ +^CRAN-RELEASE$ +^.*\.Rproj$ +^\.Rproj\.user$ +^inst/rstudio$ +build/ +docs/ +vignettes/ +^\.travis\.yml$ +_pkgdown.yml +cran-comments.md +radiant.multivariate.code-workspace +.vscode/ +^CRAN-SUBMISSION$ diff --git a/radiant.multivariate/.gitignore b/radiant.multivariate/.gitignore new file mode 100644 index 0000000000000000000000000000000000000000..a460ee64df009100abffc57e57c7bf4ef064f374 --- /dev/null +++ b/radiant.multivariate/.gitignore @@ -0,0 +1,10 @@ +.Rproj.user +.Rhistory +.Rapp.history +.RData +.Ruserdata +.DS_Store +revdep/ +docs/ +cran-comments.md +.vscode/ diff --git a/radiant.multivariate/.travis.yml b/radiant.multivariate/.travis.yml new file mode 100644 index 0000000000000000000000000000000000000000..6b72dd9e0bca33fea5126fe10cff61348c269987 --- /dev/null +++ b/radiant.multivariate/.travis.yml @@ -0,0 +1,31 @@ +language: r +cache: packages +r: + - oldrel + - release + - devel +warnings_are_errors: true +sudo: required +dist: trusty + +r_packages: + - devtools + +r_github_packages: + - trestletech/shinyAce + - radiant-rstats/radiant.data + - radiant-rstats/radiant.basics + - radiant-rstats/radiant.model + +## based on https://www.datacamp.com/community/tutorials/cd-package-docs-pkgdown-travis +after_success: + - Rscript -e 'pkgdown::build_site()' + +deploy: + provider: pages + skip-cleanup: true + github-token: $GITHUB_PAT + keep-history: true + local-dir: docs + on: + branch: master diff --git a/radiant.multivariate/COPYING b/radiant.multivariate/COPYING new file mode 100644 index 0000000000000000000000000000000000000000..78083412282aeb84c32e37d5c99bd3bf75a2f613 --- /dev/null +++ b/radiant.multivariate/COPYING @@ -0,0 +1,728 @@ +The radiant package is licensed to you under the AGPLv3, the terms of +which are included below. The help files are licensed under the creative +commons attribution non-commercial share-alike license [CC-NC-SA]. + +Radiant code license +-------------------------------------------------------------------------------------------- + GNU AFFERO GENERAL PUBLIC LICENSE + Version 3, 19 November 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU Affero General Public License is a free, copyleft license for +software and other kinds of works, specifically designed to ensure +cooperation with the community in the case of network server software. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +our General Public Licenses are intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + Developers that use our General Public Licenses protect your rights +with two steps: (1) assert copyright on the software, and (2) offer +you this License which gives you legal permission to copy, distribute +and/or modify the software. + + A secondary benefit of defending all users' freedom is that +improvements made in alternate versions of the program, if they +receive widespread use, become available for other developers to +incorporate. Many developers of free software are heartened and +encouraged by the resulting cooperation. However, in the case of +software used on network servers, this result may fail to come about. +The GNU General Public License permits making a modified version and +letting the public access it on a server without ever releasing its +source code to the public. + + The GNU Affero General Public License is designed specifically to +ensure that, in such cases, the modified source code becomes available +to the community. It requires the operator of a network server to +provide the source code of the modified version running there to the +users of that server. Therefore, public use of a modified version, on +a publicly accessible server, gives the public access to the source +code of the modified version. + + An older license, called the Affero General Public License and +published by Affero, was designed to accomplish similar goals. This is +a different license, not a version of the Affero GPL, but Affero has +released a new version of the Affero GPL which permits relicensing under +this license. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU Affero General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Remote Network Interaction; Use with the GNU General Public License. + + Notwithstanding any other provision of this License, if you modify the +Program, your modified version must prominently offer all users +interacting with it remotely through a computer network (if your version +supports such interaction) an opportunity to receive the Corresponding +Source of your version by providing access to the Corresponding Source +from a network server at no charge, through some standard or customary +means of facilitating copying of software. This Corresponding Source +shall include the Corresponding Source for any work covered by version 3 +of the GNU General Public License that is incorporated pursuant to the +following paragraph. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the work with which it is combined will remain governed by version +3 of the GNU General Public License. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU Affero General Public License from time to time. Such new versions +will be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU Affero General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU Affero General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU Affero General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If your software can interact with users remotely through a computer +network, you should also make sure that it provides a way for users to +get its source. For example, if your program is a web application, its +interface could display a "Source" link that leads users to an archive +of the code. There are many ways you could offer source, and different +solutions will be better for different programs; see section 13 for the +specific requirements. + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU AGPL, see +. + + +Help file License +-------------------------------------------------------------------------------------------- + +THE WORK (AS DEFINED BELOW) IS PROVIDED UNDER THE TERMS OF THIS CREATIVE COMMONS PUBLIC LICENSE ("CCPL" OR "LICENSE"). THE WORK IS PROTECTED BY COPYRIGHT AND/OR OTHER APPLICABLE LAW. ANY USE OF THE WORK OTHER THAN AS AUTHORIZED UNDER THIS LICENSE OR COPYRIGHT LAW IS PROHIBITED. + +BY EXERCISING ANY RIGHTS TO THE WORK PROVIDED HERE, YOU ACCEPT AND AGREE TO BE BOUND BY THE TERMS OF THIS LICENSE. TO THE EXTENT THIS LICENSE MAY BE CONSIDERED TO BE A CONTRACT, THE LICENSOR GRANTS YOU THE RIGHTS CONTAINED HERE IN CONSIDERATION OF YOUR ACCEPTANCE OF SUCH TERMS AND CONDITIONS. + +1. Definitions + +"Adaptation" means a work based upon the Work, or upon the Work and other pre-existing works, such as a translation, adaptation, derivative work, arrangement of music or other alterations of a literary or artistic work, or phonogram or performance and includes cinematographic adaptations or any other form in which the Work may be recast, transformed, or adapted including in any form recognizably derived from the original, except that a work that constitutes a Collection will not be considered an Adaptation for the purpose of this License. For the avoidance of doubt, where the Work is a musical work, performance or phonogram, the synchronization of the Work in timed-relation with a moving image ("synching") will be considered an Adaptation for the purpose of this License. +"Collection" means a collection of literary or artistic works, such as encyclopedias and anthologies, or performances, phonograms or broadcasts, or other works or subject matter other than works listed in Section 1(g) below, which, by reason of the selection and arrangement of their contents, constitute intellectual creations, in which the Work is included in its entirety in unmodified form along with one or more other contributions, each constituting separate and independent works in themselves, which together are assembled into a collective whole. A work that constitutes a Collection will not be considered an Adaptation (as defined above) for the purposes of this License. +"Distribute" means to make available to the public the original and copies of the Work or Adaptation, as appropriate, through sale or other transfer of ownership. +"License Elements" means the following high-level license attributes as selected by Licensor and indicated in the title of this License: Attribution, Noncommercial, ShareAlike. +"Licensor" means the individual, individuals, entity or entities that offer(s) the Work under the terms of this License. +"Original Author" means, in the case of a literary or artistic work, the individual, individuals, entity or entities who created the Work or if no individual or entity can be identified, the publisher; and in addition (i) in the case of a performance the actors, singers, musicians, dancers, and other persons who act, sing, deliver, declaim, play in, interpret or otherwise perform literary or artistic works or expressions of folklore; (ii) in the case of a phonogram the producer being the person or legal entity who first fixes the sounds of a performance or other sounds; and, (iii) in the case of broadcasts, the organization that transmits the broadcast. +"Work" means the literary and/or artistic work offered under the terms of this License including without limitation any production in the literary, scientific and artistic domain, whatever may be the mode or form of its expression including digital form, such as a book, pamphlet and other writing; a lecture, address, sermon or other work of the same nature; a dramatic or dramatico-musical work; a choreographic work or entertainment in dumb show; a musical composition with or without words; a cinematographic work to which are assimilated works expressed by a process analogous to cinematography; a work of drawing, painting, architecture, sculpture, engraving or lithography; a photographic work to which are assimilated works expressed by a process analogous to photography; a work of applied art; an illustration, map, plan, sketch or three-dimensional work relative to geography, topography, architecture or science; a performance; a broadcast; a phonogram; a compilation of data to the extent it is protected as a copyrightable work; or a work performed by a variety or circus performer to the extent it is not otherwise considered a literary or artistic work. +"You" means an individual or entity exercising rights under this License who has not previously violated the terms of this License with respect to the Work, or who has received express permission from the Licensor to exercise rights under this License despite a previous violation. +"Publicly Perform" means to perform public recitations of the Work and to communicate to the public those public recitations, by any means or process, including by wire or wireless means or public digital performances; to make available to the public Works in such a way that members of the public may access these Works from a place and at a place individually chosen by them; to perform the Work to the public by any means or process and the communication to the public of the performances of the Work, including by public digital performance; to broadcast and rebroadcast the Work by any means including signs, sounds or images. +"Reproduce" means to make copies of the Work by any means including without limitation by sound or visual recordings and the right of fixation and reproducing fixations of the Work, including storage of a protected performance or phonogram in digital form or other electronic medium. +2. Fair Dealing Rights. Nothing in this License is intended to reduce, limit, or restrict any uses free from copyright or rights arising from limitations or exceptions that are provided for in connection with the copyright protection under copyright law or other applicable laws. + +3. License Grant. Subject to the terms and conditions of this License, Licensor hereby grants You a worldwide, royalty-free, non-exclusive, perpetual (for the duration of the applicable copyright) license to exercise the rights in the Work as stated below: + +to Reproduce the Work, to incorporate the Work into one or more Collections, and to Reproduce the Work as incorporated in the Collections; +to create and Reproduce Adaptations provided that any such Adaptation, including any translation in any medium, takes reasonable steps to clearly label, demarcate or otherwise identify that changes were made to the original Work. For example, a translation could be marked "The original work was translated from English to Spanish," or a modification could indicate "The original work has been modified."; +to Distribute and Publicly Perform the Work including as incorporated in Collections; and, +to Distribute and Publicly Perform Adaptations. +The above rights may be exercised in all media and formats whether now known or hereafter devised. The above rights include the right to make such modifications as are technically necessary to exercise the rights in other media and formats. Subject to Section 8(f), all rights not expressly granted by Licensor are hereby reserved, including but not limited to the rights described in Section 4(e). + +4. Restrictions. The license granted in Section 3 above is expressly made subject to and limited by the following restrictions: + +You may Distribute or Publicly Perform the Work only under the terms of this License. You must include a copy of, or the Uniform Resource Identifier (URI) for, this License with every copy of the Work You Distribute or Publicly Perform. You may not offer or impose any terms on the Work that restrict the terms of this License or the ability of the recipient of the Work to exercise the rights granted to that recipient under the terms of the License. You may not sublicense the Work. You must keep intact all notices that refer to this License and to the disclaimer of warranties with every copy of the Work You Distribute or Publicly Perform. When You Distribute or Publicly Perform the Work, You may not impose any effective technological measures on the Work that restrict the ability of a recipient of the Work from You to exercise the rights granted to that recipient under the terms of the License. This Section 4(a) applies to the Work as incorporated in a Collection, but this does not require the Collection apart from the Work itself to be made subject to the terms of this License. If You create a Collection, upon notice from any Licensor You must, to the extent practicable, remove from the Collection any credit as required by Section 4(d), as requested. If You create an Adaptation, upon notice from any Licensor You must, to the extent practicable, remove from the Adaptation any credit as required by Section 4(d), as requested. +You may Distribute or Publicly Perform an Adaptation only under: (i) the terms of this License; (ii) a later version of this License with the same License Elements as this License; (iii) a Creative Commons jurisdiction license (either this or a later license version) that contains the same License Elements as this License (e.g., Attribution-NonCommercial-ShareAlike 3.0 US) ("Applicable License"). You must include a copy of, or the URI, for Applicable License with every copy of each Adaptation You Distribute or Publicly Perform. You may not offer or impose any terms on the Adaptation that restrict the terms of the Applicable License or the ability of the recipient of the Adaptation to exercise the rights granted to that recipient under the terms of the Applicable License. You must keep intact all notices that refer to the Applicable License and to the disclaimer of warranties with every copy of the Work as included in the Adaptation You Distribute or Publicly Perform. When You Distribute or Publicly Perform the Adaptation, You may not impose any effective technological measures on the Adaptation that restrict the ability of a recipient of the Adaptation from You to exercise the rights granted to that recipient under the terms of the Applicable License. This Section 4(b) applies to the Adaptation as incorporated in a Collection, but this does not require the Collection apart from the Adaptation itself to be made subject to the terms of the Applicable License. +You may not exercise any of the rights granted to You in Section 3 above in any manner that is primarily intended for or directed toward commercial advantage or private monetary compensation. The exchange of the Work for other copyrighted works by means of digital file-sharing or otherwise shall not be considered to be intended for or directed toward commercial advantage or private monetary compensation, provided there is no payment of any monetary compensation in con-nection with the exchange of copyrighted works. +If You Distribute, or Publicly Perform the Work or any Adaptations or Collections, You must, unless a request has been made pursuant to Section 4(a), keep intact all copyright notices for the Work and provide, reasonable to the medium or means You are utilizing: (i) the name of the Original Author (or pseudonym, if applicable) if supplied, and/or if the Original Author and/or Licensor designate another party or parties (e.g., a sponsor institute, publishing entity, journal) for attribution ("Attribution Parties") in Licensor's copyright notice, terms of service or by other reasonable means, the name of such party or parties; (ii) the title of the Work if supplied; (iii) to the extent reasonably practicable, the URI, if any, that Licensor specifies to be associated with the Work, unless such URI does not refer to the copyright notice or licensing information for the Work; and, (iv) consistent with Section 3(b), in the case of an Adaptation, a credit identifying the use of the Work in the Adaptation (e.g., "French translation of the Work by Original Author," or "Screenplay based on original Work by Original Author"). The credit required by this Section 4(d) may be implemented in any reasonable manner; provided, however, that in the case of a Adaptation or Collection, at a minimum such credit will appear, if a credit for all contributing authors of the Adaptation or Collection appears, then as part of these credits and in a manner at least as prominent as the credits for the other contributing authors. For the avoidance of doubt, You may only use the credit required by this Section for the purpose of attribution in the manner set out above and, by exercising Your rights under this License, You may not implicitly or explicitly assert or imply any connection with, sponsorship or endorsement by the Original Author, Licensor and/or Attribution Parties, as appropriate, of You or Your use of the Work, without the separate, express prior written permission of the Original Author, Licensor and/or Attribution Parties. +For the avoidance of doubt: + +Non-waivable Compulsory License Schemes. In those jurisdictions in which the right to collect royalties through any statutory or compulsory licensing scheme cannot be waived, the Licensor reserves the exclusive right to collect such royalties for any exercise by You of the rights granted under this License; +Waivable Compulsory License Schemes. In those jurisdictions in which the right to collect royalties through any statutory or compulsory licensing scheme can be waived, the Licensor reserves the exclusive right to collect such royalties for any exercise by You of the rights granted under this License if Your exercise of such rights is for a purpose or use which is otherwise than noncommercial as permitted under Section 4(c) and otherwise waives the right to collect royalties through any statutory or compulsory licensing scheme; and, +Voluntary License Schemes. The Licensor reserves the right to collect royalties, whether individually or, in the event that the Licensor is a member of a collecting society that administers voluntary licensing schemes, via that society, from any exercise by You of the rights granted under this License that is for a purpose or use which is otherwise than noncommercial as permitted under Section 4(c). +Except as otherwise agreed in writing by the Licensor or as may be otherwise permitted by applicable law, if You Reproduce, Distribute or Publicly Perform the Work either by itself or as part of any Adaptations or Collections, You must not distort, mutilate, modify or take other derogatory action in relation to the Work which would be prejudicial to the Original Author's honor or reputation. Licensor agrees that in those jurisdictions (e.g. Japan), in which any exercise of the right granted in Section 3(b) of this License (the right to make Adaptations) would be deemed to be a distortion, mutilation, modification or other derogatory action prejudicial to the Original Author's honor and reputation, the Licensor will waive or not assert, as appropriate, this Section, to the fullest extent permitted by the applicable national law, to enable You to reasonably exercise Your right under Section 3(b) of this License (right to make Adaptations) but not otherwise. +5. Representations, Warranties and Disclaimer + +UNLESS OTHERWISE MUTUALLY AGREED TO BY THE PARTIES IN WRITING AND TO THE FULLEST EXTENT PERMITTED BY APPLICABLE LAW, LICENSOR 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, NONINFRINGEMENT, OR THE ABSENCE OF LATENT OR OTHER DEFECTS, ACCURACY, OR THE PRESENCE OF ABSENCE OF ERRORS, WHETHER OR NOT DISCOVERABLE. SOME JURISDICTIONS DO NOT ALLOW THE EXCLUSION OF IMPLIED WARRANTIES, SO THIS EXCLUSION MAY NOT APPLY TO YOU. + +6. Limitation on Liability. EXCEPT TO THE EXTENT REQUIRED BY APPLICABLE LAW, IN NO EVENT WILL LICENSOR BE LIABLE TO YOU ON ANY LEGAL THEORY FOR ANY SPECIAL, INCIDENTAL, CONSEQUENTIAL, PUNITIVE OR EXEMPLARY DAMAGES ARISING OUT OF THIS LICENSE OR THE USE OF THE WORK, EVEN IF LICENSOR HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. + +7. Termination + +This License and the rights granted hereunder will terminate automatically upon any breach by You of the terms of this License. Individuals or entities who have received Adaptations or Collections from You under this License, however, will not have their licenses terminated provided such individuals or entities remain in full compliance with those licenses. Sections 1, 2, 5, 6, 7, and 8 will survive any termination of this License. +Subject to the above terms and conditions, the license granted here is perpetual (for the duration of the applicable copyright in the Work). Notwithstanding the above, Licensor reserves the right to release the Work under different license terms or to stop distributing the Work at any time; provided, however that any such election will not serve to withdraw this License (or any other license that has been, or is required to be, granted under the terms of this License), and this License will continue in full force and effect unless terminated as stated above. +8. Miscellaneous + +Each time You Distribute or Publicly Perform the Work or a Collection, the Licensor offers to the recipient a license to the Work on the same terms and conditions as the license granted to You under this License. +Each time You Distribute or Publicly Perform an Adaptation, Licensor offers to the recipient a license to the original Work on the same terms and conditions as the license granted to You under this License. +If any provision of this License is invalid or unenforceable under applicable law, it shall not affect the validity or enforceability of the remainder of the terms of this License, and without further action by the parties to this agreement, such provision shall be reformed to the minimum extent necessary to make such provision valid and enforceable. +No term or provision of this License shall be deemed waived and no breach consented to unless such waiver or consent shall be in writing and signed by the party to be charged with such waiver or consent. +This License constitutes the entire agreement between the parties with respect to the Work licensed here. There are no understandings, agreements or representations with respect to the Work not specified here. Licensor shall not be bound by any additional provisions that may appear in any communication from You. This License may not be modified without the mutual written agreement of the Licensor and You. +The rights granted under, and the subject matter referenced, in this License were drafted utilizing the terminology of the Berne Convention for the Protection of Literary and Artistic Works (as amended on September 28, 1979), the Rome Convention of 1961, the WIPO Copyright Treaty of 1996, the WIPO Performances and Phonograms Treaty of 1996 and the Universal Copyright Convention (as revised on July 24, 1971). These rights and subject matter take effect in the relevant jurisdiction in which the License terms are sought to be enforced according to the corresponding provisions of the implementation of those treaty provisions in the applicable national law. If the standard suite of rights granted under applicable copyright law includes additional rights not granted under this License, such additional rights are deemed to be included in the License; this License is not intended to restrict the license of any rights under applicable law. \ No newline at end of file diff --git a/radiant.multivariate/CRAN-RELEASE b/radiant.multivariate/CRAN-RELEASE new file mode 100644 index 0000000000000000000000000000000000000000..68222c98a50a01b36757b3d0aa9093d437c2a0f1 --- /dev/null +++ b/radiant.multivariate/CRAN-RELEASE @@ -0,0 +1,2 @@ +This package was submitted to CRAN on 2019-05-15. +Once it is accepted, delete this file and tag the release (commit ab4959f99f). diff --git a/radiant.multivariate/CRAN-SUBMISSION b/radiant.multivariate/CRAN-SUBMISSION new file mode 100644 index 0000000000000000000000000000000000000000..6e74f1d96310e569bee5dd204030939664169da8 --- /dev/null +++ b/radiant.multivariate/CRAN-SUBMISSION @@ -0,0 +1,3 @@ +Version: 1.6.6 +Date: 2024-05-19 23:58:57 UTC +SHA: f6e90c00074729af1faa96c1f7c9df34a7d14611 diff --git a/radiant.multivariate/DESCRIPTION b/radiant.multivariate/DESCRIPTION new file mode 100644 index 0000000000000000000000000000000000000000..499949c8725680c063011e9ff981215f10b787da --- /dev/null +++ b/radiant.multivariate/DESCRIPTION @@ -0,0 +1,43 @@ +Package: radiant.multivariate +Type: Package +Title: Multivariate Menu for Radiant: Business Analytics using R and Shiny +Version: 1.6.7 +Date: 2025-3-9 +Authors@R: person("Vincent", "Nijs", , "radiant@rady.ucsd.edu", c("aut", "cre")) +Description: The Radiant Multivariate menu includes interfaces for perceptual + mapping, factor analysis, cluster analysis, and conjoint analysis. The + application extends the functionality in 'radiant.data'. +Depends: + R (>= 4.3.0), + radiant.data (>= 1.6.6) +Imports: + radiant.model (>= 1.6.6), + shiny (>= 1.8.1), + dplyr (>= 1.0.7), + rlang (>= 0.4.10), + ggplot2 (>= 2.2.1), + scales (>= 0.4.0), + magrittr (>= 1.5), + psych (>= 1.8.4), + GPArotation (>= 2014.11-1), + car (>= 2.1.1), + MASS (>= 7.3), + import (>= 1.1.0), + ggrepel (>= 0.8), + lubridate (>= 1.7.4), + polycor (>= 0.7.10), + gower (>= 0.2.1), + shiny.i18n, + clustMixType (>= 0.2.1), + patchwork (>= 1.0.0) +Suggests: + testthat (>= 2.0.0), + pkgdown (>= 1.1.0) +URL: https://github.com/radiant-rstats/radiant.multivariate/, + https://radiant-rstats.github.io/radiant.multivariate/, + https://radiant-rstats.github.io/docs/ +BugReports: https://github.com/radiant-rstats/radiant.multivariate/issues/ +License: AGPL-3 | file LICENSE +LazyData: true +Encoding: UTF-8 +RoxygenNote: 7.3.2 diff --git a/radiant.multivariate/LICENSE b/radiant.multivariate/LICENSE new file mode 100644 index 0000000000000000000000000000000000000000..e6223dd602551e8b2d862761eebef9cf5806e900 --- /dev/null +++ b/radiant.multivariate/LICENSE @@ -0,0 +1,105 @@ +Radiant and its components are licensed under AGPL3 (http://www.tldrlegal.com/l/AGPL3). The radiant help files are licensed under the creative commons attribution, non-commercial, share-alike license CC-NC-SA (http://creativecommons.org/licenses/by-nc-sa/4.0/). + +As a summary, the AGPLv3 license requires, attribution, including copyright and license information in copies of the software, stating changes if the code is modified, and disclosure of all source code. Details are in the COPYING file. + +If you are interested in using Radiant please email me at radiant@rady.ucsd.edu + +ALL HELPFILES IN THE RADIANT APPLICATION USE THE FOLLOWING LICENSE (http://creativecommons.org/licenses/by-nc-sa/4.0/) +======================================================================================================================== + +Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International Public License + +By exercising the Licensed Rights (defined below), You accept and agree to be bound by the terms and conditions of this Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International Public License ("Public License"). To the extent this Public License may be interpreted as a contract, You are granted the Licensed Rights in consideration of Your acceptance of these terms and conditions, and the Licensor grants You such rights in consideration of benefits the Licensor receives from making the Licensed Material available under these terms and conditions. + +Section 1 – Definitions. + +Adapted Material means material subject to Copyright and Similar Rights that is derived from or based upon the Licensed Material and in which the Licensed Material is translated, altered, arranged, transformed, or otherwise modified in a manner requiring permission under the Copyright and Similar Rights held by the Licensor. For purposes of this Public License, where the Licensed Material is a musical work, performance, or sound recording, Adapted Material is always produced where the Licensed Material is synched in timed relation with a moving image. +Adapter's License means the license You apply to Your Copyright and Similar Rights in Your contributions to Adapted Material in accordance with the terms and conditions of this Public License. +BY-NC-SA Compatible License means a license listed at creativecommons.org/compatiblelicenses, approved by Creative Commons as essentially the equivalent of this Public License. +Copyright and Similar Rights means copyright and/or similar rights closely related to copyright including, without limitation, performance, broadcast, sound recording, and Sui Generis Database Rights, without regard to how the rights are labeled or categorized. For purposes of this Public License, the rights specified in Section 2(b)(1)-(2) are not Copyright and Similar Rights. +Effective Technological Measures means those measures that, in the absence of proper authority, may not be circumvented under laws fulfilling obligations under Article 11 of the WIPO Copyright Treaty adopted on December 20, 1996, and/or similar international agreements. +Exceptions and Limitations means fair use, fair dealing, and/or any other exception or limitation to Copyright and Similar Rights that applies to Your use of the Licensed Material. +License Elements means the license attributes listed in the name of a Creative Commons Public License. The License Elements of this Public License are Attribution, NonCommercial, and ShareAlike. +Licensed Material means the artistic or literary work, database, or other material to which the Licensor applied this Public License. +Licensed Rights means the rights granted to You subject to the terms and conditions of this Public License, which are limited to all Copyright and Similar Rights that apply to Your use of the Licensed Material and that the Licensor has authority to license. +Licensor means the individual(s) or entity(ies) granting rights under this Public License. +NonCommercial means not primarily intended for or directed towards commercial advantage or monetary compensation. For purposes of this Public License, the exchange of the Licensed Material for other material subject to Copyright and Similar Rights by digital file-sharing or similar means is NonCommercial provided there is no payment of monetary compensation in connection with the exchange. +Share means to provide material to the public by any means or process that requires permission under the Licensed Rights, such as reproduction, public display, public performance, distribution, dissemination, communication, or importation, and to make material available to the public including in ways that members of the public may access the material from a place and at a time individually chosen by them. +Sui Generis Database Rights means rights other than copyright resulting from Directive 96/9/EC of the European Parliament and of the Council of 11 March 1996 on the legal protection of databases, as amended and/or succeeded, as well as other essentially equivalent rights anywhere in the world. +You means the individual or entity exercising the Licensed Rights under this Public License. Your has a corresponding meaning. +Section 2 – Scope. + +License grant. +Subject to the terms and conditions of this Public License, the Licensor hereby grants You a worldwide, royalty-free, non-sublicensable, non-exclusive, irrevocable license to exercise the Licensed Rights in the Licensed Material to: +reproduce and Share the Licensed Material, in whole or in part, for NonCommercial purposes only; and +produce, reproduce, and Share Adapted Material for NonCommercial purposes only. +Exceptions and Limitations. For the avoidance of doubt, where Exceptions and Limitations apply to Your use, this Public License does not apply, and You do not need to comply with its terms and conditions. +Term. The term of this Public License is specified in Section 6(a). +Media and formats; technical modifications allowed. The Licensor authorizes You to exercise the Licensed Rights in all media and formats whether now known or hereafter created, and to make technical modifications necessary to do so. The Licensor waives and/or agrees not to assert any right or authority to forbid You from making technical modifications necessary to exercise the Licensed Rights, including technical modifications necessary to circumvent Effective Technological Measures. For purposes of this Public License, simply making modifications authorized by this Section 2(a)(4) never produces Adapted Material. +Downstream recipients. +Offer from the Licensor – Licensed Material. Every recipient of the Licensed Material automatically receives an offer from the Licensor to exercise the Licensed Rights under the terms and conditions of this Public License. +Additional offer from the Licensor – Adapted Material. Every recipient of Adapted Material from You automatically receives an offer from the Licensor to exercise the Licensed Rights in the Adapted Material under the conditions of the Adapter’s License You apply. +No downstream restrictions. You may not offer or impose any additional or different terms or conditions on, or apply any Effective Technological Measures to, the Licensed Material if doing so restricts exercise of the Licensed Rights by any recipient of the Licensed Material. +No endorsement. Nothing in this Public License constitutes or may be construed as permission to assert or imply that You are, or that Your use of the Licensed Material is, connected with, or sponsored, endorsed, or granted official status by, the Licensor or others designated to receive attribution as provided in Section 3(a)(1)(A)(i). +Other rights. + +Moral rights, such as the right of integrity, are not licensed under this Public License, nor are publicity, privacy, and/or other similar personality rights; however, to the extent possible, the Licensor waives and/or agrees not to assert any such rights held by the Licensor to the limited extent necessary to allow You to exercise the Licensed Rights, but not otherwise. +Patent and trademark rights are not licensed under this Public License. +To the extent possible, the Licensor waives any right to collect royalties from You for the exercise of the Licensed Rights, whether directly or through a collecting society under any voluntary or waivable statutory or compulsory licensing scheme. In all other cases the Licensor expressly reserves any right to collect such royalties, including when the Licensed Material is used other than for NonCommercial purposes. +Section 3 – License Conditions. + +Your exercise of the Licensed Rights is expressly made subject to the following conditions. + +Attribution. + +If You Share the Licensed Material (including in modified form), You must: + +retain the following if it is supplied by the Licensor with the Licensed Material: +identification of the creator(s) of the Licensed Material and any others designated to receive attribution, in any reasonable manner requested by the Licensor (including by pseudonym if designated); +a copyright notice; +a notice that refers to this Public License; +a notice that refers to the disclaimer of warranties; +a URI or hyperlink to the Licensed Material to the extent reasonably practicable; +indicate if You modified the Licensed Material and retain an indication of any previous modifications; and +indicate the Licensed Material is licensed under this Public License, and include the text of, or the URI or hyperlink to, this Public License. +You may satisfy the conditions in Section 3(a)(1) in any reasonable manner based on the medium, means, and context in which You Share the Licensed Material. For example, it may be reasonable to satisfy the conditions by providing a URI or hyperlink to a resource that includes the required information. +If requested by the Licensor, You must remove any of the information required by Section 3(a)(1)(A) to the extent reasonably practicable. +ShareAlike. +In addition to the conditions in Section 3(a), if You Share Adapted Material You produce, the following conditions also apply. + +The Adapter’s License You apply must be a Creative Commons license with the same License Elements, this version or later, or a BY-NC-SA Compatible License. +You must include the text of, or the URI or hyperlink to, the Adapter's License You apply. You may satisfy this condition in any reasonable manner based on the medium, means, and context in which You Share Adapted Material. +You may not offer or impose any additional or different terms or conditions on, or apply any Effective Technological Measures to, Adapted Material that restrict exercise of the rights granted under the Adapter's License You apply. +Section 4 – Sui Generis Database Rights. + +Where the Licensed Rights include Sui Generis Database Rights that apply to Your use of the Licensed Material: + +for the avoidance of doubt, Section 2(a)(1) grants You the right to extract, reuse, reproduce, and Share all or a substantial portion of the contents of the database for NonCommercial purposes only; +if You include all or a substantial portion of the database contents in a database in which You have Sui Generis Database Rights, then the database in which You have Sui Generis Database Rights (but not its individual contents) is Adapted Material, including for purposes of Section 3(b); and +You must comply with the conditions in Section 3(a) if You Share all or a substantial portion of the contents of the database. +For the avoidance of doubt, this Section 4 supplements and does not replace Your obligations under this Public License where the Licensed Rights include other Copyright and Similar Rights. +Section 5 – Disclaimer of Warranties and Limitation of Liability. + +Unless otherwise separately undertaken by the Licensor, to the extent possible, the Licensor offers the Licensed Material as-is and as-available, and makes no representations or warranties of any kind concerning the Licensed Material, whether express, implied, statutory, or other. This includes, without limitation, warranties of title, merchantability, fitness for a particular purpose, non-infringement, absence of latent or other defects, accuracy, or the presence or absence of errors, whether or not known or discoverable. Where disclaimers of warranties are not allowed in full or in part, this disclaimer may not apply to You. +To the extent possible, in no event will the Licensor be liable to You on any legal theory (including, without limitation, negligence) or otherwise for any direct, special, indirect, incidental, consequential, punitive, exemplary, or other losses, costs, expenses, or damages arising out of this Public License or use of the Licensed Material, even if the Licensor has been advised of the possibility of such losses, costs, expenses, or damages. Where a limitation of liability is not allowed in full or in part, this limitation may not apply to You. +The disclaimer of warranties and limitation of liability provided above shall be interpreted in a manner that, to the extent possible, most closely approximates an absolute disclaimer and waiver of all liability. +Section 6 – Term and Termination. + +This Public License applies for the term of the Copyright and Similar Rights licensed here. However, if You fail to comply with this Public License, then Your rights under this Public License terminate automatically. +Where Your right to use the Licensed Material has terminated under Section 6(a), it reinstates: + +automatically as of the date the violation is cured, provided it is cured within 30 days of Your discovery of the violation; or +upon express reinstatement by the Licensor. +For the avoidance of doubt, this Section 6(b) does not affect any right the Licensor may have to seek remedies for Your violations of this Public License. +For the avoidance of doubt, the Licensor may also offer the Licensed Material under separate terms or conditions or stop distributing the Licensed Material at any time; however, doing so will not terminate this Public License. +Sections 1, 5, 6, 7, and 8 survive termination of this Public License. +Section 7 – Other Terms and Conditions. + +The Licensor shall not be bound by any additional or different terms or conditions communicated by You unless expressly agreed. +Any arrangements, understandings, or agreements regarding the Licensed Material not stated herein are separate from and independent of the terms and conditions of this Public License. +Section 8 – Interpretation. + +For the avoidance of doubt, this Public License does not, and shall not be interpreted to, reduce, limit, restrict, or impose conditions on any use of the Licensed Material that could lawfully be made without permission under this Public License. +To the extent possible, if any provision of this Public License is deemed unenforceable, it shall be automatically reformed to the minimum extent necessary to make it enforceable. If the provision cannot be reformed, it shall be severed from this Public License without affecting the enforceability of the remaining terms and conditions. +No term or condition of this Public License will be waived and no failure to comply consented to unless expressly agreed to by the Licensor. +Nothing in this Public License constitutes or may be interpreted as a limitation upon, or waiver of, any privileges and immunities that apply to the Licensor or You, including from the legal processes of any jurisdiction or authority. diff --git a/radiant.multivariate/NAMESPACE b/radiant.multivariate/NAMESPACE new file mode 100644 index 0000000000000000000000000000000000000000..9156db1aea325ddf50a8e54a0177c71b74c9b60d --- /dev/null +++ b/radiant.multivariate/NAMESPACE @@ -0,0 +1,114 @@ +# Generated by roxygen2: do not edit by hand + +S3method(plot,conjoint) +S3method(plot,full_factor) +S3method(plot,hclus) +S3method(plot,kclus) +S3method(plot,mds) +S3method(plot,pre_factor) +S3method(plot,prmap) +S3method(predict,conjoint) +S3method(print,conjoint.predict) +S3method(store,conjoint) +S3method(store,conjoint.predict) +S3method(store,full_factor) +S3method(store,hclus) +S3method(store,kclus) +S3method(summary,conjoint) +S3method(summary,full_factor) +S3method(summary,hclus) +S3method(summary,kclus) +S3method(summary,mds) +S3method(summary,pre_factor) +S3method(summary,prmap) +export(clean_loadings) +export(conjoint) +export(full_factor) +export(hclus) +export(kclus) +export(mds) +export(pre_factor) +export(predict_conjoint_by) +export(prmap) +export(radiant.multivariate) +export(radiant.multivariate_viewer) +export(radiant.multivariate_window) +export(the_table) +import(ggplot2) +import(radiant.data) +import(shiny) +importFrom(GPArotation,oblimin) +importFrom(GPArotation,quartimax) +importFrom(GPArotation,simplimax) +importFrom(MASS,isoMDS) +importFrom(car,vif) +importFrom(clustMixType,kproto) +importFrom(dplyr,across) +importFrom(dplyr,bind_rows) +importFrom(dplyr,everything) +importFrom(dplyr,filter) +importFrom(dplyr,funs) +importFrom(dplyr,group_by) +importFrom(dplyr,group_by_at) +importFrom(dplyr,lag) +importFrom(dplyr,mutate) +importFrom(dplyr,mutate_all) +importFrom(dplyr,mutate_if) +importFrom(dplyr,rename) +importFrom(dplyr,select) +importFrom(dplyr,select_at) +importFrom(dplyr,select_if) +importFrom(dplyr,slice) +importFrom(dplyr,summarise) +importFrom(dplyr,summarise_all) +importFrom(ggrepel,geom_text_repel) +importFrom(gower,gower_dist) +importFrom(grDevices,rainbow) +importFrom(graphics,abline) +importFrom(graphics,arrows) +importFrom(graphics,par) +importFrom(graphics,plot) +importFrom(graphics,points) +importFrom(graphics,text) +importFrom(graphics,title) +importFrom(import,from) +importFrom(lubridate,is.Date) +importFrom(magrittr,"%<>%") +importFrom(magrittr,"%>%") +importFrom(magrittr,"%T>%") +importFrom(magrittr,set_colnames) +importFrom(magrittr,set_names) +importFrom(magrittr,set_rownames) +importFrom(patchwork,plot_annotation) +importFrom(patchwork,wrap_plots) +importFrom(polycor,hetcor) +importFrom(psych,KMO) +importFrom(psych,cortest.bartlett) +importFrom(psych,fa) +importFrom(psych,fa.sort) +importFrom(psych,factor.scores) +importFrom(psych,principal) +importFrom(psych,scoreIrt) +importFrom(radiant.data,launch) +importFrom(radiant.model,predict_model) +importFrom(radiant.model,print_predict_model) +importFrom(rlang,.data) +importFrom(scales,percent) +importFrom(stats,as.dendrogram) +importFrom(stats,as.dist) +importFrom(stats,as.formula) +importFrom(stats,cmdscale) +importFrom(stats,cor) +importFrom(stats,cov) +importFrom(stats,cutree) +importFrom(stats,dist) +importFrom(stats,factanal) +importFrom(stats,hclust) +importFrom(stats,kmeans) +importFrom(stats,lm) +importFrom(stats,median) +importFrom(stats,na.omit) +importFrom(stats,predict) +importFrom(stats,qt) +importFrom(stats,sd) +importFrom(utils,head) diff --git a/radiant.multivariate/NEWS.md b/radiant.multivariate/NEWS.md new file mode 100644 index 0000000000000000000000000000000000000000..6124f9ca4e5041749c5312d3e7dd890f6fe88452 --- /dev/null +++ b/radiant.multivariate/NEWS.md @@ -0,0 +1,172 @@ +# radiant.multivariate 1.6.7 + +* Fixed labeling bug in mds function + +# radiant.multivariate 1.6.6 + +* Require Shiny 1.8.1. Adjustments related to icon-buttons were made to address a breaking change in Shiny 1.8.1 +* Reverting changes that removed `req(input$dataset)` in different places + +# radiant.multivariate 1.6.1 + +* Updated test for MDS to account for the possibility that signs can be switched. + +# radiant.multivariate 1.6.0 + +* Using "Radiant for R" in UI to differentiate from "Radiant for Python" +* Addressed a package documentation issue due to a change in roxygen2 + +# radiant.multivariate 1.5.0.0 + +* Improvements to screenshot feature. Navigation bar is omitted and the image is adjusted to the length of the UI. +* Line graphs treated more similarly to bar-graphs (i.e., can have a binary factor variable on the y-axis) +* Removed all references to `aes_string` which is being deprecated in ggplot soon +* Replaced reference to 'size' in favor of 'linewidth' due to changes in ggplot2 +* Code styling + +# radiant.multivariate 1.4.4.0 + +* Added option to create screenshots of settings on a page. Approach is inspired by the snapper package by @yonicd + +# radiant.multivariate 1.4.1.0 + +* Fixed `is_empty` function clash with `rlang` +* Adjustments to work with the latest version of `shiny` and `bootstrap4` + +# radiant.multivariate 1.3.6.0 + +* Allowing singular correlation matrix in `pre_factor` + +# radiant.multivariate 1.3.5.0 + +* Minor adjustments in anticipation of dplyr 1.0.0 + +# radiant.multivariate 1.3.2.0 + +* Allow factor variables in K-clustering using clustMixType::kproto + +# radiant.multivariate 1.3.0.0 + +* Allow factor variables in pre-factor, factor, and attribute based maps. Correlations will be calculated `polycor::hetcor` and factor scores are calculated using `psych::score.irt.poly`. +* Add option to save cluster membership for hierarchical clustering +* Add `gower` distance as a distance metric for hierarchical clustering +* Use `patchwork` for grouping multiple plots together +* Update action buttons that initiate model estimation when one or more inputs are changed. When a model should be re-estimated, a spinning "refresh" icon will be shown + +# radiant.multivariate 1.1.1.0 + +* Documentation updates (i.e., key functions for each tool) +* Numerous small code changes to support enhanced auto-completion, tooltips, and annotations in shinyAce 0.4.1 + +# radiant.multivariate 0.9.9.2 + +* Label numbers for stored factor scores from factor analysis will now always correspond to the numbers used in the summary output +* Fix for kmeans bar-plot after dplyr 0.8.1 release +* Add information on R-squared when storing PW and IW tables for conjoint analysis with individual level data +* Added option to (not) standardize data for K-clustering or Hierarchical clustering. + +# radiant.multivariate 0.9.9.0 + +* Create bi-plots in _Multivariate > Factor_ +* Fixes to accommodate breaking changes in dplyr 0.8.0 + +# radiant.multivariate 0.9.8.0 + +* Ensure variable and dataset names are valid for R (i.e., no spaces or symbols), "fixing" the input as needed +* Fix initial plot size for `kclus` in the browser interface +* Fix labels in `pre_factor` after a ggplot2 update +* Avoid a warning in the `pre_factor` Plot tab on refresh +* Option to pass additional arguments to `shiny::runApp` when starting radiant such as the port to use. For example, radiant.multivariate::radiant.multivariate("https://github.com/radiant-rstats/docs/raw/gh-pages/examples/demo-dvd-rnd.state.rda", port = 8080) +* Avoid generatign `pred_data = ""` for conjoint predictions +* Load a state file on startup by providing a (relative) file path or a url + +# radiant.multivariate 0.9.7.0 + +## Major changes + +* Using [`shinyFiles`](https://github.com/thomasp85/shinyFiles) to provide convenient access to data located on a server + +## Minor changes + +* Option to add selected labels to the dendogram in hierarchical clustering +* Replace non-ASCII characters in example datasets +* Remove `rstudioapi` as a direct import +* Revert from `svg` to `png` for plots in `_Report > Rmd_ and _Report > R_. `svg` scatter plots with many point get to big for practical use on servers that have to transfer images to a local browser +* Removed dependency on `methods` package + +# radiant.multivariate 0.9.5.0 + +* Fix to accomodate changes in `deparse` in R 3.5 + +# radiant.multivariate 0.9.3.1 + +## Major changes + +* Various changes to the code to accomodate the use of `shiny::makeReactiveBinding`. The advantage is that the code generated for _Report > Rmd_ and _Report > R_ will no longer have to use `r_data` to store and access data. This means that code generated and used in the Radiant browser interface will be directly usable without the browser interface as well. +* Used `ggplot2` and `ggrepel` for `mds` brand maps +* Used `ggplot2` and `ggrepel` for `prmap` brand maps + +## Deprecated + +* `pmap` was renamed to `prmap` to avoid conflict with `purrr::pmap` + +# radiant.multivariate 0.9.2.0 + +## Major changes + +* Renamed `pmap` function for perceptual maps to `prmap` to avoid conflict with `purrr::pmap` +* `Estimate` buttons indicate when models should be re-estimated based on changes in user input +* Upload and download data using the Rstudio file browser. Allows using relative paths to files (e.g., data or images inside an Rstudio project) +* Long lines of code generated for _Report > Rmd_ or _Report > R_ will be wrapped to enhance readability + +## Minor changes + +* Enhanced keyboard shortcuts +* Upgraded tidyr dependency to 0.7 + +## Bug fixes + +* Fix for `pmap` and `mds` when a tibble is passed + +# radiant.multivariate 0.8.7.1 + +* Upgraded dplyr dependency to 0.7.1 + +# radiant.multivariate 0.8.2.0 + +## Minor changes + +* Updated output formatting code to make coefficient information more easily accessible +* Add KMO measures for individual variables to _Factor > Pre-factor_ +* Code cleanup + +## Bug fixes + +* Pass plot sizing function to plot_downloader to ensure proper display + +# radiant.multivariate VERSION 0.8.0 + +## Major changes + +* Added k-medians, from the Gmedians package, as an option in _Multivariate > K-clustering_ +* Added additional rotation options in _Multivariate > Factor_ +* Added predict tab for conjoint +* Added option to analyse conjoint data for multiple respondents (`By`) or for a specific respondent (`Show`) +* Store PWs or IWs from conjoint analysis for multiple respondents +* Derive and store predictions based on conjoint analysis for multiple respondents + +## Minor changes + +* Show dataset name in output if dataframe passed directly to analysis function +* As an alternative to using the Estimate button to run a model you can now also use CTRL-enter or CMD-enter +* Use ALT-enter to put code into _Report > Rmd_ or _Report > R_ + +## Bug fixes + +- Import from `GPArotation` + +## Deprecated + +* kmeans_clus was replaced by kclus +* hier_clus was replaced by hclus +* Use of *_each is deprecated diff --git a/radiant.multivariate/R/aaa.R b/radiant.multivariate/R/aaa.R new file mode 100644 index 0000000000000000000000000000000000000000..54a9cb982f86d3e411cf9ddf2a947cd2b9f80f7c --- /dev/null +++ b/radiant.multivariate/R/aaa.R @@ -0,0 +1,111 @@ +# to avoid 'no visible binding for global variable' NOTE +globalVariables(c( + ".", "y", "nr_clus", "nr_fact", "height", "bump", "n", "se", "me", + "cent" +)) + +#' radiant.multivariate +#' +#' @name radiant.multivariate +#' @import radiant.data shiny ggplot2 +#' @importFrom dplyr select select_at select_if filter mutate mutate_if funs group_by group_by_at lag slice bind_rows mutate_all summarise_all rename summarise across everything +#' @importFrom rlang .data +#' @importFrom magrittr %>% %<>% %T>% set_colnames set_rownames set_names +#' @importFrom scales percent +#' @importFrom import from +#' @importFrom patchwork wrap_plots plot_annotation +#' @importFrom grDevices rainbow +#' @importFrom graphics abline arrows par plot points text title +#' @importFrom stats as.dendrogram as.dist cmdscale cor cov cutree dist factanal hclust kmeans lm na.omit qt sd as.formula predict median +#' @importFrom utils head +NULL + +#' Conjoint data for MP3 players +#' @details Ratings reflect the evaluation of 18 alternative MP3 players by one respondent. Description provided in attr(mp3, "description") +#' @docType data +#' @keywords datasets +#' @name mp3 +#' @usage data(mp3) +#' @format A data frame with 18 rows and 6 variables +NULL + +#' Conjoint data for Movie theaters +#' @details Rankings reflect the evaluation of 18 alternative movie theaters by one respondent. Description provided in attr(movie, "description") +#' @docType data +#' @keywords datasets +#' @name movie +#' @usage data(movie) +#' @format A data frame with 18 rows and 6 variables +NULL + +#' Carpet cleaners +#' @details Rankings reflect the evaluation of 18 alternative carpet cleaners by one respondent. Description provided in attr(carpet," description") +#' @docType data +#' @keywords datasets +#' @name carpet +#' @usage data(carpet) +#' @format A data frame with 18 rows and 5 variables +NULL + +#' Shopping attitudes +#' @details Attitudinal data on shopping for 20 consumers. Description provided in attr(shopping, "description") +#' @docType data +#' @keywords datasets +#' @name shopping +#' @usage data(shopping) +#' @format A data frame with 20 rows and 7 variables +NULL + +#' Toothpaste attitudes +#' @details Attitudinal data on toothpaste for 60 consumers. Description provided in attr(toothpaste, "description") +#' @docType data +#' @keywords datasets +#' @name toothpaste +#' @usage data(toothpaste) +#' @format A data frame with 60 rows and 10 variables +NULL + +#' City distances +#' @details Distance in miles between nine cities in the USA. The dataset is used to illustrate multi-dimensional scaling (MDS). Description provided in attr(city, "description") +#' @docType data +#' @keywords datasets +#' @name city +#' @usage data(city) +#' @format A data frame with 45 rows and 3 variables +NULL + +#' City distances 2 +#' @details Distance in miles between 12 cities in the USA. The dataset is used to illustrate multi-dimensional scaling (MDS). Description provided in attr(city2, "description") +#' @docType data +#' @keywords datasets +#' @name city2 +#' @usage data(city2) +#' @format A data frame with 78 rows and 3 variables +NULL + +#' Toothpaste brands +#' @details Perceived (dis)similarity of a set of toothpaste brands. The dataset is used to illustrate multi-dimensional scaling (MDS). Description provided in attr(tpbrands, "description") +#' @docType data +#' @keywords datasets +#' @name tpbrands +#' @usage data(tpbrands) +#' @format A data frame with 45 rows and 4 variables +NULL + +#' Perceptions of computer (re)sellers +#' @details Perceptions of computer (re)sellers. The dataset is used to illustrate perceptual maps. Description provided in attr(computer, "description") +#' @docType data +#' @keywords datasets +#' @name computer +#' @usage data(computer) +#' @format A data frame with 5 rows and 8 variables +NULL + +#' Perceptions of retailers +#' @details Consumer evaluations for a set of retailers in the Chicago area on 7 attributes. The dataset is used to illustrate perceptual maps. Description provided in attr(retailers, "description") +#' @docType data +#' @keywords datasets +#' @name retailers +#' @usage data(retailers) +#' @format A data frame with 6 rows and 10 variables +NULL diff --git a/radiant.multivariate/R/conjoint.R b/radiant.multivariate/R/conjoint.R new file mode 100644 index 0000000000000000000000000000000000000000..d5c441c9006ef792db5afb27b8652cc353e701fc --- /dev/null +++ b/radiant.multivariate/R/conjoint.R @@ -0,0 +1,586 @@ +#' Conjoint analysis +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/conjoint.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param rvar The response variable (e.g., profile ratings) +#' @param evar Explanatory variables in the regression +#' @param int Interaction terms to include in the model +#' @param by Variable to group data by before analysis (e.g., a respondent id) +#' @param reverse Reverse the values of the response variable (`rvar`) +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param envir Environment to extract data from +#' +#' @return A list with all variables defined in the function as an object of class conjoint +#' +#' @examples +#' conjoint(mp3, rvar = "Rating", evar = "Memory:Shape") %>% str() +#' +#' @seealso \code{\link{summary.conjoint}} to summarize results +#' @seealso \code{\link{plot.conjoint}} to plot results +#' +#' @export +conjoint <- function(dataset, rvar, evar, + int = "", by = "none", + reverse = FALSE, data_filter = "", + envir = parent.frame()) { + vars <- c(rvar, evar) + if (by != "none") vars <- c(vars, by) + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, vars, filt = data_filter, envir = envir) + radiant.model::var_check(evar, colnames(dataset)[-1], int) %>% + (function(x) { + vars <<- x$vars + evar <<- x$ev + int <<- x$intv + }) + + ## in case : was used to select a range of variables + # evar <- colnames(dataset)[-1] + if (!is.empty(by, "none")) { + evar <- base::setdiff(evar, by) + vars <- base::setdiff(vars, by) + bylevs <- dataset[[by]] %>% + as_factor() %>% + levels() + model_list <- vector("list", length(bylevs)) %>% set_names(bylevs) + } else { + bylevs <- "full" + model_list <- list(full = list(model = NA, coeff = NA, tab = NA)) + } + + formula <- paste(rvar, "~", paste(vars, collapse = " + ")) %>% as.formula() + + for (i in seq_along(bylevs)) { + if (!by == "none") { + cdat <- filter(dataset, .data[[by]] == bylevs[i]) %>% + select_at(.vars = base::setdiff(colnames(dataset), by)) + } else { + cdat <- dataset + } + + if (reverse) { + cdat[[rvar]] <- cdat[[rvar]] %>% + (function(x) (max(x) + 1) - x) + } + + model <- sshhr(lm(formula, data = cdat)) + coeff <- tidy(model) %>% + na.omit() %>% + as.data.frame() + tab <- the_table(coeff, cdat, evar) + + coeff$sig_star <- sig_stars(coeff$p.value) %>% + format(justify = "left") + colnames(coeff) <- c("label", "coefficient", "std.error", "t.value", "p.value", "sig_star") + hasLevs <- sapply(select(dataset, -1), function(x) is.factor(x) || is.logical(x) || is.character(x)) + if (sum(hasLevs) > 0) { + for (j in names(hasLevs[hasLevs])) { + coeff$label %<>% gsub(paste0("^", j), paste0(j, "|"), .) %>% + gsub(paste0(":", j), paste0(":", j, "|"), .) + } + rm(j, hasLevs) + } + model_list[[bylevs[i]]] <- list(model = model, coeff = coeff, tab = tab) + } + + ## creating PW and IW data.frames + if (!is.empty(by, "none")) { + cn <- gsub("\\|", "_", model_list[[1]]$coeff$label) %>% + gsub("[^A-z0-9_\\.]", "", .) + + PW <- matrix(NA, nrow = length(bylevs), ncol = length(cn) + 2) %>% + as.data.frame(stringsAsFactors = FALSE) %>% + set_colnames(c(by, ".Rsq", cn)) + PW[[by]] <- bylevs + + for (i in seq_along(bylevs)) { + PW[i, 2] <- glance(model_list[[bylevs[i]]]$model)$r.squared + PW[i, 3:ncol(PW)] <- model_list[[bylevs[i]]]$coeff$coefficient + } + + ## creating IW data.frame + cn <- model_list[[1]]$tab$IW$Attribute %>% + gsub("[^A-z0-9_\\.]", "", .) + + IW <- matrix(NA, nrow = length(bylevs), ncol = length(cn) + 2) %>% + as.data.frame(stringsAsFactors = FALSE) %>% + set_colnames(c(by, ".Rsq", cn)) + IW[[by]] <- bylevs + + for (i in seq_along(bylevs)) { + IW[i, 2] <- glance(model_list[[bylevs[i]]]$model)$r.squared + IW[i, 3:ncol(IW)] <- model_list[[bylevs[i]]]$tab$IW$IW + } + rm(cn) + } + + rm(model, coeff, tab, envir) + + as.list(environment()) %>% add_class("conjoint") +} + +#' Summary method for the conjoint function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/conjoint.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{conjoint}} +#' @param show Level in by variable to analyze (e.g., a specific respondent) +#' @param mc_diag Shows multicollinearity diagnostics. +#' @param additional Show additional regression results +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- conjoint(mp3, rvar = "Rating", evar = "Memory:Shape") +#' summary(result, mc_diag = TRUE) +#' +#' @seealso \code{\link{conjoint}} to generate results +#' @seealso \code{\link{plot.conjoint}} to plot results +#' +#' @importFrom car vif +#' +#' @export +summary.conjoint <- function(object, show = "", mc_diag = FALSE, + additional = FALSE, dec = 3, ...) { + cat("Conjoint analysis\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + if (object$by != "none") { + cat("Show :", object$by, "==", show, "\n") + } + rvar <- if (object$reverse) paste0(object$rvar, " (reversed)") else object$rvar + cat("Response variable :", rvar, "\n") + cat("Explanatory variables:", paste0(object$evar, collapse = ", "), "\n\n") + + if (object$by == "none" || is.empty(show) || !show %in% names(object$model_list)) { + show <- names(object$model_list)[1] + } + + tab <- object$model_list[[show]]$tab + cat("Conjoint part-worths:\n") + tab$PW[, 1:2] %<>% format(justify = "left") + print(format_df(tab$PW, dec), row.names = FALSE) + cat("\nConjoint importance weights:\n") + tab$IW[, 1:2] %<>% format(justify = "left") + print(format_df(tab$IW, dec), row.names = FALSE) + cat("\nConjoint regression results:\n\n") + + coeff <- object$model_list[[show]]$coeff + coeff$label %<>% format(justify = "left") + if (!additional) { + coeff[, 2] %<>% (function(x) sprintf(paste0("%.", dec, "f"), x)) + print(dplyr::rename(coeff[, 1:2], ` ` = "label"), row.names = FALSE) + cat("\n") + } else { + if (all(coeff$p.value == "NaN")) { + coeff[, 2] %<>% (function(x) sprintf(paste0("%.", dec, "f"), x)) + print(dplyr::rename(coeff[, 1:2], ` ` = "label"), row.names = FALSE) + cat("\nInsufficient variation in explanatory variable(s) to report additional statistics") + return() + } else { + p.small <- coeff$p.value < .001 + coeff[, 2:5] %<>% format_df(dec) + coeff$p.value[p.small] <- "< .001" + print(dplyr::rename(coeff, ` ` = "label", ` ` = "sig_star"), row.names = FALSE) + } + + model <- object$model_list[[show]]$model + + if (nrow(model$model) <= (length(object$evar) + 1)) { + return("\nInsufficient observations to estimate model") + } + + ## adjusting df for included intercept term + df_int <- if (attr(model$terms, "intercept")) 1L else 0L + + reg_fit <- glance(model) %>% round(dec) + if (reg_fit["p.value"] < .001) reg_fit["p.value"] <- "< .001" + cat("\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n\n") + cat("R-squared:", paste0(reg_fit$r.squared, ", "), "Adjusted R-squared:", reg_fit$adj.r.squared, "\n") + cat("F-statistic:", reg_fit$statistic, paste0("df(", reg_fit$df - df_int, ",", reg_fit$df.residual, "), p.value"), reg_fit$p.value) + cat("\nNr obs:", format_nr(reg_fit$df + reg_fit$df.residual, dec = 0), "\n\n") + + if (anyNA(model$coeff)) { + cat("The set of explanatory variables exhibit perfect multicollinearity.\nOne or more variables were dropped from the estimation.\n") + } + } + + if (mc_diag) { + if (length(object$evar) > 1) { + cat("Multicollinearity diagnostics:\n") + car::vif(object$model_list[[show]]$model) %>% + (function(x) if (!dim(x) %>% is.null()) x[, "GVIF"] else x) %>% # needed when factors are included + data.frame( + VIF = ., + Rsq = 1 - 1 / ., + stringsAsFactors = FALSE + ) %>% + round(dec) %>% + .[order(.$VIF, decreasing = T), ] %>% + (function(x) if (nrow(x) < 8) t(x) else x) %>% + print() + } else { + cat("Insufficient number of attributes selected to calculate\nmulticollinearity diagnostics") + } + } +} + +#' Predict method for the conjoint function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/conjoint.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{conjoint}} +#' @param pred_data Provide the dataframe to generate predictions. The dataset must contain all columns used in the estimation +#' @param pred_cmd Command used to generate data for prediction +#' @param conf_lev Confidence level used to estimate confidence intervals (.95 is the default) +#' @param se Logical that indicates if prediction standard errors should be calculated (default = FALSE) +#' @param interval Type of interval calculation ("confidence" or "prediction"). Set to "none" if se is FALSE +#' @param dec Number of decimals to show +#' @param envir Environment to extract data from +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{conjoint}} to generate the result +#' @seealso \code{\link{summary.conjoint}} to summarize results +#' @seealso \code{\link{plot.conjoint}} to plot results +#' +#' @examples +#' result <- conjoint(mp3, rvar = "Rating", evar = "Memory:Shape") +#' predict(result, pred_data = mp3) +#' +#' @importFrom radiant.model predict_model +#' +#' @export +predict.conjoint <- function(object, pred_data = NULL, pred_cmd = "", + conf_lev = 0.95, se = FALSE, + interval = "confidence", dec = 3, + envir = parent.frame(), ...) { + if (is.character(object)) { + return(object) + } + if (!isTRUE(se)) { + interval <- "none" + } else if (isTRUE(interval == "none")) { + se <- FALSE + } + + ## ensure you have a name for the prediction dataset + if (is.data.frame(pred_data)) { + df_name <- deparse(substitute(pred_data)) + } else { + df_name <- pred_data + } + + pfun <- function(model, pred, se, conf_lev) { + pred_val <- + try( + sshhr( + predict(model, pred, interval = ifelse(se, interval, "none"), level = conf_lev) + ), + silent = TRUE + ) + + if (!inherits(pred_val, "try-error")) { + if (se) { + pred_val %<>% data.frame(stringsAsFactors = FALSE) %>% mutate(diff = .[, 3] - .[, 1]) + ci_perc <- ci_label(cl = conf_lev) + colnames(pred_val) <- c("Prediction", ci_perc[1], ci_perc[2], "+/-") + } else { + pred_val %<>% data.frame(stringsAsFactors = FALSE) %>% select(1) + colnames(pred_val) <- "Prediction" + } + } + + pred_val + } + + if (is.empty(object$by, "none")) { + object$model <- object$model_list[["full"]]$model + predict_model(object, pfun, "conjoint.predict", pred_data, pred_cmd, conf_lev, se, dec, envir = envir) %>% + set_attr("radiant_interval", interval) %>% + set_attr("radiant_pred_data", df_name) + } else { + predict_conjoint_by(object, pfun, pred_data, pred_cmd, conf_lev, se, dec, envir = envir) %>% + set_attr("radiant_interval", interval) %>% + set_attr("radiant_pred_data", df_name) + } +} + +#' Predict method for the conjoint function when a by variables is used +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/conjoint.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{conjoint}} +#' @param pfun Function to use for prediction +#' @param pred_data Name of the dataset to use for prediction +#' @param pred_cmd Command used to generate data for prediction +#' @param conf_lev Confidence level used to estimate confidence intervals (.95 is the default) +#' @param se Logical that indicates if prediction standard errors should be calculated (default = FALSE) +#' @param dec Number of decimals to show +#' @param envir Environment to extract data from +#' @param ... further arguments passed to or from other methods +#' +#' @seealso \code{\link{conjoint}} to generate the result +#' @seealso \code{\link{summary.conjoint}} to summarize results +#' @seealso \code{\link{plot.conjoint}} to plot results +#' +#' @importFrom radiant.model predict_model +#' +#' @export +predict_conjoint_by <- function(object, pfun, pred_data = NULL, pred_cmd = "", + conf_lev = 0.95, se = FALSE, dec = 3, + envir = parent.frame(), ...) { + if (is.character(object)) { + return(object) + } + ## ensure you have a name for the prediction dataset + if (is.data.frame(pred_data)) { + attr(pred_data, "radiant_pred_data") <- deparse(substitute(pred_data)) + } + + pred <- list() + bylevs <- object$bylevs + + for (i in seq_along(bylevs)) { + object$model <- object$model_list[[bylevs[i]]]$model + pred[[i]] <- predict_model(object, pfun, "conjoint.predict", pred_data, pred_cmd, conf_lev, se, dec, envir = envir) + + ## when se is true reordering the columns removes attributes for some reason + if (i == 1) att <- attributes(pred[[1]]) + + if (is.character(pred[[i]])) { + return(pred[[i]]) + } + pred[[i]] %<>% + (function(x) { + x[[object$by]] <- bylevs[i] + x + }) %>% + (function(x) x[, c(object$by, head(colnames(x), -1))]) + } + + pred <- bind_rows(pred) + att$row.names <- 1:nrow(pred) + att$vars <- att$names <- colnames(pred) + attributes(pred) <- att + add_class(pred, "conjoint.predict.by") %>% + add_class("conjoint.predict") +} + +#' Print method for predict.conjoint +#' +#' @param x Return value from prediction method +#' @param ... further arguments passed to or from other methods +#' @param n Number of lines of prediction results to print. Use -1 to print all lines +#' +#' @importFrom radiant.model print_predict_model +#' +#' @export +print.conjoint.predict <- function(x, ..., n = 20) { + print_predict_model(x, ..., n = n, header = "Conjoint Analysis") +} + +#' Plot method for the conjoint function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/conjoint.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{conjoint}} +#' @param plots Show either the part-worth ("pw") or importance-weights ("iw") plot +#' @param show Level in by variable to analyze (e.g., a specific respondent) +#' @param scale_plot Scale the axes of the part-worth plots to the same range +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- conjoint(mp3, rvar = "Rating", evar = "Memory:Shape") +#' plot(result, scale_plot = TRUE) +#' plot(result, plots = "iw") +#' +#' @seealso \code{\link{conjoint}} to generate results +#' @seealso \code{\link{summary.conjoint}} to summarize results +#' +#' @importFrom rlang .data +#' +#' @export +plot.conjoint <- function(x, plots = "pw", show = "", scale_plot = FALSE, + shiny = FALSE, custom = FALSE, ...) { + if (x$by == "none" || is.empty(show) || !show %in% names(x$model_list)) { + show <- names(x$model_list)[1] + } + + the_table <- x$model_list[[show]]$tab + plot_ylim <- the_table$plot_ylim + plot_list <- list() + + if ("pw" %in% plots) { + PW.df <- the_table[["PW"]] + + lab <- if (x$by == "none") "" else paste0("(", show, ")") + + for (var in x$evar) { + PW.var <- PW.df[PW.df[["Attributes"]] == var, ] + + # setting the levels in the same order as in the_table. Without this + # ggplot would change the ordering of the price levels + PW.var$Levels <- factor(PW.var$Levels, levels = PW.var$Levels, ordered = FALSE) + + p <- ggplot(PW.var, aes(x = .data$Levels, y = .data$PW, group = 1)) + + geom_line(color = "blue", linetype = "dotdash", linewidth = .7) + + geom_point(color = "blue", size = 4, shape = 21, fill = "white") + + labs(title = paste("Part-worths for", var, lab), x = "") + + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + + if (scale_plot) { + p <- p + ylim(plot_ylim[var, "Min"], plot_ylim[var, "Max"]) + } + plot_list[[var]] <- p + } + } + + if ("iw" %in% plots) { + IW.df <- the_table[["IW"]] + lab <- if (x$by == "none") "" else paste0(" (", show, ")") + plot_list[["iw"]] <- ggplot(IW.df, aes(x = .data$Attributes, y = .data$IW, fill = .data$Attributes)) + + geom_bar(stat = "identity", alpha = 0.5) + + theme(legend.position = "none") + + labs(title = paste0("Importance weights", lab)) + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = min(length(plot_list), 2)) %>% + (function(x) if (isTRUE(shiny)) x else print(x)) + } + } +} + +#' Function to calculate the PW and IW table for conjoint +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/conjoint.html} for an example in Radiant +#' +#' @param model Tidied model results (broom) output from \code{\link{conjoint}} passed on by summary.conjoint +#' @param dataset Conjoint data +#' @param evar Explanatory variables used in the conjoint regression +#' +#' @examples +#' result <- conjoint(mp3, rvar = "Rating", evar = "Memory:Shape") +#' the_table(tidy(result$model_list[[1]][["model"]]), result$dataset, result$evar) +#' +#' @seealso \code{\link{conjoint}} to generate results +#' @seealso \code{\link{summary.conjoint}} to summarize results +#' @seealso \code{\link{plot.conjoint}} to plot results +#' +#' @export +the_table <- function(model, dataset, evar) { + if (is.character(model)) { + return(list("PW" = "No attributes selected.")) + } + + attr <- select_at(dataset, .vars = evar) %>% + mutate_if(is.logical, as.factor) %>% + mutate_if(is.character, as.factor) + + isFct <- sapply(attr, is.factor) + if (sum(isFct) < ncol(attr)) { + return(list("PW" = "Only factors can be used.", "IW" = "Only factors can be used.")) + } + bylevs <- lapply(attr[, isFct, drop = FALSE], levels) + vars <- colnames(attr)[isFct] + + nlevs <- sapply(bylevs, length) + PW.df <- data.frame(rep(vars, nlevs), unlist(bylevs), stringsAsFactors = FALSE) + colnames(PW.df) <- c("Attributes", "Levels") + PW.df$PW <- 0 + + ## Calculate PW and IW's when interactions are present + ## http://www.slideshare.net/SunnyBose/conjoint-analysis-12090511 + rownames(PW.df) <- paste(PW.df[["Attributes"]], PW.df[["Levels"]], sep = "") + + coeff <- model$estimate + PW.df[model$term[-1], "PW"] <- coeff[-1] + + minPW <- PW.df[tapply(1:nrow(PW.df), PW.df$Attributes, function(i) i[which.min(PW.df$PW[i])]), ] + maxPW <- PW.df[tapply(1:nrow(PW.df), PW.df$Attributes, function(i) i[which.max(PW.df$PW[i])]), ] + rownames(minPW) <- minPW$Attributes + rownames(maxPW) <- maxPW$Attributes + + rangePW <- data.frame(cbind(maxPW[vars, "PW"], minPW[vars, "PW"]), stringsAsFactors = FALSE) + rangePW$Range <- rangePW[[1]] - rangePW[[2]] + colnames(rangePW) <- c("Max", "Min", "Range") + rownames(rangePW) <- vars + + ## for plot range if standardized + maxlim <- rangePW[["Max"]] > abs(rangePW[["Min"]]) + maxrange <- max(rangePW[["Range"]]) + plot_ylim <- rangePW[c("Min", "Max")] + + plot_ylim[maxlim, "Max"] <- plot_ylim[maxlim, "Max"] + maxrange - rangePW$Range[maxlim] + plot_ylim[!maxlim, "Min"] <- plot_ylim[!maxlim, "Min"] - (maxrange - rangePW$Range[!maxlim]) + plot_ylim <- plot_ylim * 1.01 ## expanded max to avoid hiding max points in plot + + IW <- data.frame(vars, stringsAsFactors = FALSE) + IW$IW <- rangePW$Range / sum(rangePW$Range) + colnames(IW) <- c("Attributes", "IW") + + PW.df[["Attributes"]] <- as.character(PW.df[["Attributes"]]) + PW.df[["Levels"]] <- as.character(PW.df[["Levels"]]) + PW.df <- rbind(PW.df, c("Base utility", "~", coeff[1])) + PW.df[["PW"]] <- as.numeric(PW.df[["PW"]]) + + PW.df[["PW"]] <- round(PW.df[["PW"]], 3) + IW[["IW"]] <- round(IW[["IW"]], 3) + + list("PW" = PW.df, "IW" = IW, "plot_ylim" = plot_ylim) +} + +#' Store method for the Multivariate > Conjoint tab +#' +#' @details Store data frame with PWs or IWs in Radiant r_data list if available +#' +#' @param dataset Dataset +#' @param object Return value from conjoint +#' @param name Variable name(s) assigned to predicted values +#' @param ... further arguments passed to or from other methods +#' +#' @export +store.conjoint <- function(dataset, object, name, ...) { + if (missing(name)) { + object$tab + } else { + stop( + paste0( + "This function is deprecated. Use the code below for part worths instead:\n\n", + name, " <- ", deparse(substitute(object)), "$PW\nregister(\"", + name, ")\n\n", + "This function is deprecated. Use the code below for importance weights instead:\n\n", + name, " <- ", deparse(substitute(object)), "$IW\nregister(\"", + name, ")" + ), + call. = FALSE + ) + } +} + +##' Store predicted values generated in predict.conjoint +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/conjoint.html} for an example in Radiant +#' +#' @param dataset Dataset to add predictions to +#' @param object Return value from model predict function +#' @param name Variable name(s) assigned to predicted values +#' @param ... Additional arguments +#' +#' @examples +#' conjoint(mp3, rvar = "Rating", evar = "Memory:Shape") %>% +#' predict(mp3) %>% +#' store(mp3, ., name = "pred_pref") +#' +#' @export +store.conjoint.predict <- function(dataset, object, name = "prediction", ...) { + radiant.model:::store.model.predict(dataset, object, name = name, ...) +} \ No newline at end of file diff --git a/radiant.multivariate/R/full_factor.R b/radiant.multivariate/R/full_factor.R new file mode 100644 index 0000000000000000000000000000000000000000..f1bd6d3cf48a86dc388bd243d8394a4da7194e46 --- /dev/null +++ b/radiant.multivariate/R/full_factor.R @@ -0,0 +1,382 @@ +#' Factor analysis (PCA) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/full_factor.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param vars Variables to include in the analysis +#' @param method Factor extraction method to use +#' @param nr_fact Number of factors to extract +#' @param rotation Apply varimax rotation or no rotation ("varimax" or "none") +#' @param hcor Use polycor::hetcor to calculate the correlation matrix +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param envir Environment to extract data from +#' +#' @return A list with all variables defined in the function as an object of class full_factor +#' +#' @examples +#' full_factor(shopping, "v1:v6") %>% str() +#' +#' @seealso \code{\link{summary.full_factor}} to summarize results +#' @seealso \code{\link{plot.full_factor}} to plot results +#' +#' @importFrom psych principal fa factor.scores +#' @importFrom GPArotation quartimax oblimin simplimax +#' @importFrom polycor hetcor +#' @importFrom psych scoreIrt +#' @importFrom dplyr across everything summarise +#' +#' @export +full_factor <- function(dataset, vars, method = "PCA", hcor = FALSE, nr_fact = 1, + rotation = "varimax", data_filter = "", + envir = parent.frame()) { + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, vars, filt = data_filter, envir = envir) %>% + mutate_if(is.Date, as.numeric) + rm(envir) + + ## in case : is used + if (length(vars) < ncol(dataset)) { + vars <- colnames(dataset) + } + + ## check if there is variation in the data + not_vary <- vars[summarise(dataset, across(everything(), does_vary)) == FALSE] + if (length(not_vary) > 0) { + return(paste0("The following variable(s) show no variation. Please select other variables.\n\n** ", paste0(not_vary, collapse = ", "), " **") %>% + add_class("full_factor")) + } + + anyCategorical <- sapply(dataset, function(x) is.numeric(x) || is.Date(x)) == FALSE + nrObs <- nrow(dataset) + nrFac <- max(1, as.numeric(nr_fact)) + if (nrFac > ncol(dataset)) { + return("The number of factors cannot exceed the number of variables" %>% + add_class("full_factor")) + nrFac <- ncol(dataset) + } + + if (hcor) { + cmat <- try(sshhr(polycor::hetcor(dataset, ML = FALSE, std.err = FALSE)), silent = TRUE) + dataset <- mutate_all(dataset, radiant.data::as_numeric) + if (inherits(cmat, "try-error")) { + warning("Calculating the heterogeneous correlation matrix produced an error.\nUsing standard correlation matrix instead") + hcor <- "Calculation failed" + cmat <- cor(dataset) + } else { + cmat <- cmat$correlations + } + } else { + dataset <- mutate_all(dataset, radiant.data::as_numeric) + cmat <- cor(dataset) + } + + if (method == "PCA") { + fres <- psych::principal( + cmat, + nfactors = nrFac, rotate = rotation, scores = FALSE, + oblique.scores = FALSE + ) + m <- fres$loadings[, colnames(fres$loadings)] + cscm <- m %*% solve(crossprod(m)) + fres$scores <- as.matrix(mutate_all(dataset, radiant.data::standardize)) %*% cscm + } else { + fres <- try(psych::fa(cmat, nfactors = nrFac, rotate = rotation, oblique.scores = FALSE, fm = "ml"), silent = TRUE) + if (inherits(fres, "try-error")) { + return( + "An error occured. Increase the number of variables or reduce the number of factors" %>% + add_class("full_factor") + ) + } + if (sum(anyCategorical) == ncol(dataset) && isTRUE(hcor)) { + ## necessary to deal with psych::irt.tau qnorm issue + isMaxMinOne <- sapply(dataset, function(x) (max(x, na.rm = TRUE) - min(x, na.rm = TRUE) == 1)) + dataset <- mutate_if(dataset, isMaxMinOne, ~ (. - min(., na.rm = TRUE)) / (max(., na.rm = TRUE) - min(., na.rm = TRUE))) + .irt.tau <- function() { + tau <- psych::irt.tau(dataset) + m <- fres$loadings[, colnames(fres$loadings), drop = FALSE] + nf <- dim(m)[2] + max_dat <- max(dataset) + min_dat <- min(dataset) + if (any(tau == Inf)) { + tau[tau == Inf] <- max((max_dat - min_dat) * 5, 4) + warning("Tau values of Inf found. Adjustment applied") + } + if (any(tau == -Inf)) { + tau[tau == -Inf] <- min(-(max_dat - min_dat) * 5, -4) + warning("Tau values of -Inf found. Adjustment applied") + } + diffi <- list() + for (i in 1:nf) diffi[[i]] <- tau / sqrt(1 - m[, i]^2) + discrim <- m / sqrt(1 - m^2) + new.stats <- list(difficulty = diffi, discrimination = discrim) + psych::score.irt.poly(new.stats, dataset, cut = 0, bounds = c(-4, 4)) + } + scores <- try(.irt.tau(), silent = TRUE) + # scores <- psych::scoreIrt(fres, dataset, cut = 0) + rm(.irt.tau) + if (inherits(scores, "try-error")) { + return( + paste0("An error occured estimating latent factor scores using psychIrt. The error message was:\n\n", attr(scores, "condition")$message) %>% add_class("full_factor") + ) + } else { + fres$scores <- apply(scores[, 1:nrFac, drop = FALSE], 2, radiant.data::standardize) + rm(scores) + colnames(fres$scores) <- colnames(fres$loadings) + } + } else { + fres$scores <- psych::factor.scores(as.matrix(dataset), fres, method = "Thurstone")$scores + } + } + + ## convert loadings object to data.frame + floadings <- + fres$loadings %>% + { + dn <- dimnames(.) + matrix(., nrow = length(dn[[1]])) %>% + set_colnames(., dn[[2]]) %>% + set_rownames(., dn[[1]]) %>% + data.frame(stringsAsFactors = FALSE) + } + + as.list(environment()) %>% add_class("full_factor") +} + +#' Summary method for the full_factor function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/full_factor.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{full_factor}} +#' @param cutoff Show only loadings with (absolute) values above cutoff (default = 0) +#' @param fsort Sort factor loadings +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- full_factor(shopping, "v1:v6", nr_fact = 2) +#' summary(result) +#' summary(result, cutoff = .5, fsort = TRUE) +#' +#' @seealso \code{\link{full_factor}} to calculate results +#' @seealso \code{\link{plot.full_factor}} to plot results +#' +#' @importFrom psych fa.sort +#' +#' @export +summary.full_factor <- function(object, cutoff = 0, fsort = FALSE, + dec = 2, ...) { + if (is.character(object)) { + return(cat(object)) + } + + cat("Factor analysis\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + cat("Variables :", paste0(object$vars, collapse = ", "), "\n") + cat("Factors :", object$nr_fact, "\n") + cat("Method :", object$method, "\n") + cat("Rotation :", object$rotation, "\n") + cat("Observations:", format_nr(object$nrObs, dec = 0), "\n") + if (is.character(object$hcor)) { + cat(paste0("Correlation : Pearson (adjustment using polycor::hetcor failed)\n")) + } else if (isTRUE(object$hcor)) { + if (sum(object$anyCategorical) > 0) { + cat(paste0("Correlation : Heterogeneous correlations using polycor::hetcor\n")) + } else { + cat(paste0("Correlation : Pearson\n")) + } + } else { + cat("Correlation : Pearson\n") + } + if (sum(object$anyCategorical) > 0) { + if (isTRUE(object$hcor)) { + cat("** Variables of type {factor} are assumed to be ordinal **\n") + if (object$method == "PCA") { + cat("** Factor scores are biased when using PCA when one or more {factor} variables are included **\n\n") + } else if (sum(object$anyCategorical) == length(object$vars)) { + cat("** Factor scores calculated using psych::scoreIrt **\n\n") + } else if (sum(object$anyCategorical) < length(object$vars)) { + cat("** Factor scores are biased when a mix of {factor} and numeric variables are used **\n\n") + } + } else { + cat("** Variables of type {factor} included without adjustment **\n\n") + } + } else if (isTRUE(object$hcor)) { + cat("** No variables of type {factor} selected. No adjustment applied **\n\n") + } else { + cat("\n") + } + + cat("Factor loadings:\n") + + ## show only the loadings > cutoff + clean_loadings(object$floadings, cutoff = cutoff, fsort = fsort, dec = dec, repl = "") %>% + print() + + ## fit measures + cat("\nFit measures:\n") + colSums(object$floadings^2) %>% + rbind(., 100 * (. / nrow(object$floadings))) %>% + rbind(., cumsum(.[2, ])) %>% + as.data.frame(stringsAsFactors = FALSE) %>% + format_df(dec = dec) %>% + set_rownames(c("Eigenvalues", "Variance %", "Cumulative %")) %>% + print() + + # results from psych - uncomment to validate results + # object$fres$loadings %>% + # { if (fsort) psych::fa.sort(.) else . } %>% + # print(cutoff = cutoff, digits = 2) + + cat("\nAttribute communalities:") + data.frame(1 - object$fres$uniqueness, stringsAsFactors = FALSE) %>% + format_df(dec = dec, perc = TRUE) %>% + set_rownames(object$vars) %>% + set_colnames("") %>% + print() + + cat("\nFactor scores (max 10 shown):\n") + as.data.frame(object$fres$scores, stringsAsFactors = FALSE) %>% + .[1:min(nrow(.), 10), , drop = FALSE] %>% + format_df(dec = dec) %>% + print(row.names = FALSE) +} + +#' Plot method for the full_factor function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/full_factor.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{full_factor}} +#' @param plots Include attribute ("attr"), respondents ("resp") or both in the plot +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- full_factor(shopping, "v1:v6", nr_fact = 2) +#' plot(result) +#' +#' @seealso \code{\link{full_factor}} to calculate results +#' @seealso \code{\link{plot.full_factor}} to plot results +#' +#' @importFrom ggrepel geom_text_repel +#' @importFrom rlang .data +#' +#' @export +plot.full_factor <- function(x, plots = "attr", shiny = FALSE, custom = FALSE, ...) { + + ## when no analysis was conducted (e.g., no variables selected) + if (is.character(x)) { + return(plot(x = 1, type = "n", main = x, axes = FALSE, xlab = "", ylab = "")) + } else if (x$fres$factors < 2) { + x <- "Plots require two or more factors" + return(plot(x = 1, type = "n", main = x, axes = FALSE, xlab = "", ylab = "")) + } + + df <- x$floadings + scores <- as.data.frame(x$fres$scores) + plot_scale <- if ("resp" %in% plots) max(scores) else 1 + rnames <- rownames(df) + cnames <- colnames(df) + plot_list <- list() + for (i in 1:(length(cnames) - 1)) { + for (j in (i + 1):length(cnames)) { + i_name <- cnames[i] + j_name <- cnames[j] + df2 <- cbind(df[, c(i_name, j_name)], rnames) + + p <- ggplot(df2, aes(x = .data[[i_name]], y = .data[[j_name]])) + + theme(legend.position = "none") + + coord_cartesian(xlim = c(-plot_scale, plot_scale), ylim = c(-plot_scale, plot_scale)) + + geom_vline(xintercept = 0) + + geom_hline(yintercept = 0) + + if ("resp" %in% plots) { + p <- p + geom_point(data = scores, aes(x = .data[[i_name]], y = .data[[j_name]]), alpha = 0.5) + } + + if ("attr" %in% plots) { + p <- p + geom_point(aes(color = .data$rnames)) + + ggrepel::geom_text_repel(aes(color = .data$rnames, label = .data$rnames)) + + geom_segment( + aes(x = 0, y = 0, xend = .data[[i_name]], yend = .data[[j_name]], color = .data$rnames), + linewidth = 0.5, linetype = "dashed", alpha = 0.5 + ) + } + + plot_list[[paste0(i_name, "_", j_name)]] <- p + } + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = min(length(plot_list), 2)) %>% + (function(x) if (shiny) x else print(x)) + } + } +} + +#' Store factor scores to active dataset +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/full_factor.html} for an example in Radiant +#' +#' @param dataset Dataset to append to factor scores to +#' @param object Return value from \code{\link{full_factor}} +#' @param name Name of factor score variables +#' @param ... Additional arguments +#' +#' @examples +#' full_factor(shopping, "v1:v6", nr_fact = 3) %>% +#' store(shopping, .) %>% +#' head() +#' +#' @seealso \code{\link{full_factor}} to generate results +#' @seealso \code{\link{summary.full_factor}} to summarize results +#' @seealso \code{\link{plot.full_factor}} to plot results +#' +#' @export +store.full_factor <- function(dataset, object, name = "", ...) { + if (is.empty(name)) name <- "factor" + fscores <- as.data.frame(object$fres$scores, stringsAsFactors = FALSE) + indr <- indexr(dataset, object$vars, object$data_filter) + fs <- data.frame(matrix(NA, nrow = indr$nr, ncol = ncol(fscores)), stringsAsFactors = FALSE) + fs[indr$ind, ] <- fscores + dataset[, sub("^[a-zA-Z]+([0-9]+)$", paste0(name, "\\1"), colnames(fscores))] <- fs + dataset +} + +#' Sort and clean loadings +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/full_factor.html} for an example in Radiant +#' +#' @param floadings Data frame with loadings +#' @param fsort Sort factor loadings +#' @param cutoff Show only loadings with (absolute) values above cutoff (default = 0) +#' @param dec Number of decimals to show +#' @param repl Replace loadings below the cutoff by NA (or "") +#' +#' @examples +#' result <- full_factor(shopping, "v1:v6", nr_fact = 2) +#' clean_loadings(result$floadings, fsort = TRUE, cutoff = .5, dec = 2) +#' +#' @importFrom psych fa.sort +#' +#' @export +clean_loadings <- function(floadings, cutoff = 0, fsort = FALSE, dec = 8, repl = NA) { + if (fsort) { + floadings <- select(psych::fa.sort(floadings), -order) + } + + if (cutoff == 0) { + floadings %<>% round(dec) + } else { + ind <- abs(floadings) < cutoff + floadings %<>% round(dec) + floadings[ind] <- repl + } + floadings +} diff --git a/radiant.multivariate/R/hclus.R b/radiant.multivariate/R/hclus.R new file mode 100644 index 0000000000000000000000000000000000000000..4d4ba7962e303e59ff047a865d14f44811909a36 --- /dev/null +++ b/radiant.multivariate/R/hclus.R @@ -0,0 +1,242 @@ +#' Hierarchical cluster analysis +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/hclus.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param vars Vector of variables to include in the analysis +#' @param labels A vector of labels for the leaves of the tree +#' @param distance Distance +#' @param method Method +#' @param max_cases Maximum number of cases allowed (default is 1000). Set to avoid long-running analysis in the radiant web-interface +#' @param standardize Standardized data (TRUE or FALSE) +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param envir Environment to extract data from +#' +#' @return A list of all variables used in hclus as an object of class hclus +#' +#' @examples +#' hclus(shopping, vars = "v1:v6") %>% str() +#' +#' @seealso \code{\link{summary.hclus}} to summarize results +#' @seealso \code{\link{plot.hclus}} to plot results +#' +#' @importFrom gower gower_dist +#' +#' @export +hclus <- function(dataset, vars, labels = "none", distance = "sq.euclidian", + method = "ward.D", max_cases = 5000, + standardize = TRUE, data_filter = "", + envir = parent.frame()) { + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, if (labels == "none") vars else c(labels, vars), filt = data_filter, envir = envir) %>% + as.data.frame() %>% + mutate_if(is.Date, as.numeric) + rm(envir) + if (nrow(dataset) > max_cases) { + return("The number of cases to cluster exceed the maximum set. Change\nthe number of cases allowed using the 'Max cases' input box." %>% + add_class("hclus")) + } + + anyCategorical <- sapply(dataset, function(x) is.numeric(x)) == FALSE + ## in case : is used + if (length(vars) < ncol(dataset)) vars <- colnames(dataset) + if (any(anyCategorical) && distance != "gower") distance <- "gower" + + if (labels != "none") { + if (length(unique(dataset[[1]])) == nrow(dataset)) { + rownames(dataset) <- dataset[[1]] + } else { + message("\nThe provided labels are not unique. Please select another labels variable\n") + rownames(dataset) <- seq_len(nrow(dataset)) + } + dataset <- select(dataset, -1) + } + + if (standardize) { + dataset <- mutate_if(dataset, is.numeric, ~ as.vector(scale(.))) + } + + if (distance == "sq.euclidian") { + d <- dist(dataset, method = "euclidean")^2 + } else if (distance == "gower") { + d <- sapply(1:nrow(dataset), function(i) gower::gower_dist(dataset[i, ], dataset)) %>% + as.dist() + } else { + d <- dist(dataset, method = distance) + } + hc_out <- hclust(d = d, method = method) + as.list(environment()) %>% add_class("hclus") +} + +#' Summary method for the hclus function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/hclus.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{hclus}} +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- hclus(shopping, vars = c("v1:v6")) +#' summary(result) +#' +#' @seealso \code{\link{hclus}} to generate results +#' @seealso \code{\link{plot.hclus}} to plot results +#' +#' @export +summary.hclus <- function(object, ...) { + if (is.character(object)) { + return(object) + } + + cat("Hierarchical cluster analysis\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + cat("Variables :", paste0(object$vars, collapse = ", "), "\n") + cat("Method :", object$method, "\n") + cat("Distance :", object$distance, "\n") + cat("Standardize :", object$standardize, "\n") + cat("Observations:", format_nr(length(object$hc_out$order), dec = 0), "\n") + if (sum(object$anyCategorical) > 0 && object$distance != "gower") { + cat("** When {factor} variables are included \"Gower\" distance is used **\n\n") + } +} + +#' Plot method for the hclus function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/hclus.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{hclus}} +#' @param plots Plots to return. "change" shows the percentage change in within-cluster heterogeneity as respondents are grouped into different number of clusters, "dendro" shows the dendrogram, "scree" shows a scree plot of within-cluster heterogeneity +#' @param cutoff For large datasets plots can take time to render and become hard to interpret. By selection a cutoff point (e.g., 0.05 percent) the initial steps in hierarchical cluster analysis are removed from the plot +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- hclus(shopping, vars = c("v1:v6")) +#' plot(result, plots = c("change", "scree"), cutoff = .05) +#' plot(result, plots = "dendro", cutoff = 0) +#' +#' @seealso \code{\link{hclus}} to generate results +#' @seealso \code{\link{summary.hclus}} to summarize results +#' +#' @export +plot.hclus <- function(x, plots = c("scree", "change"), + cutoff = 0.05, + shiny = FALSE, custom = FALSE, ...) { + if (is.empty(plots)) { + return(invisible()) + } + if (is.character(x)) { + return(invisible()) + } + if (is_not(cutoff)) cutoff <- 0 + x$hc_out$height %<>% (function(x) x / max(x)) + + plot_list <- list() + if ("scree" %in% plots) { + plot_list[["scree"]] <- + x$hc_out$height[x$hc_out$height > cutoff] %>% + data.frame( + height = ., + nr_clus = as.integer(length(.):1), + stringsAsFactors = FALSE + ) %>% + ggplot(aes(x = factor(nr_clus, levels = nr_clus), y = height, group = 1)) + + geom_line(color = "blue", linetype = "dotdash", linewidth = .7) + + geom_point(color = "blue", size = 4, shape = 21, fill = "white") + + scale_y_continuous(labels = scales::percent) + + labs( + title = "Scree plot", + x = "# clusters", + y = "Within-cluster heterogeneity" + ) + } + + if ("change" %in% plots) { + plot_list[["change"]] <- + x$hc_out$height[x$hc_out$height > cutoff] %>% + (function(x) (x - lag(x)) / lag(x)) %>% + data.frame( + bump = ., + nr_clus = paste0((length(.) + 1):2, "-", length(.):1), + stringsAsFactors = FALSE + ) %>% + na.omit() %>% + ggplot(aes(x = factor(nr_clus, levels = nr_clus), y = bump)) + + geom_bar(stat = "identity", alpha = 0.5, fill = "blue") + + scale_y_continuous(labels = scales::percent) + + labs( + title = "Change in within-cluster heterogeneity", + x = "# clusters", + y = "Change in within-cluster heterogeneity" + ) + } + + if ("dendro" %in% plots) { + hc <- as.dendrogram(x$hc_out) + xlab <- "" + if (length(plots) > 1) { + xlab <- "When dendrogram is selected no other plots can be shown.\nCall the plot function separately in Report > Rmd to view different plot types." + } + + ## trying out ggraph - looks great but dendrogram very slow for larger datasets + # install.packages("ggraph") + # library(ggraph) + # https://www.r-graph-gallery.com/335-custom-ggraph-dendrogram/ + # plot_list[["dendro"]] <- ggraph(hc, 'dendrogram', circular = FALSE) + + # geom_edge_elbow() + + if (cutoff == 0) { + plot(hc, main = "Dendrogram", xlab = xlab, ylab = "Within-cluster heterogeneity") + # plot_list[["dendro"]] <- patchwork::wrap_elements(~ plot(hc), clip = FALSE) + } else { + plot( + hc, + ylim = c(cutoff, 1), leaflab = "none", + main = "Cutoff dendrogram", xlab = xlab, ylab = "Within-cluster heterogeneity" + ) + # plot_list[["dendro"]] <- patchwork::wrap_elements(~ plot(hc), clip = FALSE) + } + return(invisible()) + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = 1) %>% + (function(x) if (isTRUE(shiny)) x else print(x)) + } + } +} + +#' Add a cluster membership variable to the active dataset +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/hclus.html} for an example in Radiant +#' +#' @param dataset Dataset to append to cluster membership variable to +#' @param object Return value from \code{\link{hclus}} +#' @param nr_clus Number of clusters to extract +#' @param name Name of cluster membership variable +#' @param ... Additional arguments +#' +#' @examples +#' hclus(shopping, vars = "v1:v6") %>% +#' store(shopping, ., nr_clus = 3) %>% +#' head() +#' @seealso \code{\link{hclus}} to generate results +#' @seealso \code{\link{summary.hclus}} to summarize results +#' @seealso \code{\link{plot.hclus}} to plot results +#' +#' @export +store.hclus <- function(dataset, object, nr_clus = 2, name = "", ...) { + if (is.empty(name)) name <- paste0("hclus", nr_clus) + indr <- indexr(dataset, object$vars, object$data_filter) + hm <- rep(NA, indr$nr) + hm[indr$ind] <- cutree(object$hc_out, nr_clus) + dataset[[name]] <- as.factor(hm) + dataset +} diff --git a/radiant.multivariate/R/kclus.R b/radiant.multivariate/R/kclus.R new file mode 100644 index 0000000000000000000000000000000000000000..455e650f3fdd636fb57504b71509440f03e37c94 --- /dev/null +++ b/radiant.multivariate/R/kclus.R @@ -0,0 +1,336 @@ +#' K-clustering +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/kclus.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param vars Vector of variables to include in the analysis +#' @param fun Use either "kmeans" or "kproto" for clustering +#' @param hc_init Use centers from hclus as the starting point +#' @param distance Distance for hclus +#' @param method Method for hclus +#' @param seed Random see to use for k-clustering if hc_init is FALSE +#' @param nr_clus Number of clusters to extract +#' @param standardize Standardize data (TRUE or FALSE) +#' @param lambda Parameter > 0 to trade off between Euclidean distance of numeric variables and simple matching coefficient between categorical variables. Also a vector of variable specific factors is possible where the order must correspond to the order of the variables in the data. In this case all variables' distances will be multiplied by their corresponding lambda value. +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param envir Environment to extract data from +#' +#' @return A list of all variables used in kclus as an object of class kclus +#' +#' @examples +#' kclus(shopping, c("v1:v6"), nr_clus = 3) %>% str() +#' @seealso \code{\link{summary.kclus}} to summarize results +#' @seealso \code{\link{plot.kclus}} to plot results +#' @seealso \code{\link{store.kclus}} to add cluster membership to the selected dataset +#' +#' @importFrom clustMixType kproto +#' @importFrom dplyr across everything summarise +#' +#' @export +kclus <- function(dataset, vars, fun = "kmeans", hc_init = TRUE, distance = "sq.euclidian", + method = "ward.D", seed = 1234, nr_clus = 2, standardize = TRUE, lambda = NULL, + data_filter = "", envir = parent.frame()) { + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, vars, filt = data_filter, envir = envir) + rm(envir) + + if (is.empty(lambda)) lambda <- NULL + + ## in case : is used + if (length(vars) < ncol(dataset)) { + vars <- colnames(dataset) + } + + if (fun == "median") { + stop("K-medians is deprecated. Use either 'kmeans' or 'kproto' for the 'fun' argument") + } else if (fun %in% c("mean", "kmeans")) { + fun <- "kmeans" + dataset <- select_if(dataset, function(x) !is.factor(x)) + if (ncol(dataset) < length(vars)) { + cat("** Categorical variables cannot be used with K-means **.\n** Select the K-proto option instead **\n\n") + } + vars <- colnames(dataset) + } else if (fun == "kproto") { + if (hc_init) distance <- "gower" + if (!any(sapply(dataset, function(x) is.numeric(x)) == FALSE)) { + fun <- "kmeans" + cat("** K-means used when no categorical variables included **\n\n") + } + } + + ## check if there is variation in the data + not_vary <- vars[summarise(dataset, across(everything(), does_vary)) == FALSE] + if (length(not_vary) > 0) { + return(paste0("The following variable(s) show no variation. Please select other variables.\n\n** ", paste0(not_vary, collapse = ", "), " **") %>% + add_class("kclus")) + } + + max_freq <- function(x) as.factor(names(which.max(table(x)))) + center_calc <- function(x, prop = FALSE) { + if (is.numeric(x)) { + mean(x) + } else { + mf <- max_freq(x) + if (prop) { + ps <- table(x) / length(x) + as.factor(paste0(mf, " (", 100 * round(ps[as.character(mf)], 2), "%)")) + } else { + mf + } + } + } + + if (hc_init) { + init <- hclus( + dataset, vars, + distance = distance, method = method, + max_cases = Inf, standardize = standardize + ) + clus_var <- cutree(init$hc_out, k = nr_clus) + hc_cent <- c() + km_out <- dataset %>% + mutate(clus_var = clus_var) %>% + (function(x) if (standardize) mutate_if(x, is.numeric, ~ as.vector(scale(.))) else x) %T>% + (function(x) { + hc_cent <<- + group_by(x, clus_var) %>% + summarise_all(center_calc) %>% + select(-clus_var) + }) %>% + select(-clus_var) %>% + (function(x) { + if (fun == "kproto") { + kp <- clustMixType::kproto(as.data.frame(x), k = hc_cent, iter.max = 500, verbose = FALSE, lambda = lambda) + ## kproto doesn't provide totss or betweenss by default + kp$totss <- clustMixType::kproto(as.data.frame(x), k = 1, iter.max = 1, verbose = FALSE, lambda = lambda)$tot.withinss + kp$betweenss <- kp$totss - kp$tot.withinss + kp + } else { + kmeans(x, centers = as.matrix(hc_cent), iter.max = 500) + } + }) + rm(init, hc_cent) + } else { + seed %>% + gsub("[^0-9]", "", .) %>% + (function(x) if (!is.empty(x)) set.seed(seed)) + km_out <- dataset %>% + (function(x) if (standardize) mutate_if(x, is.numeric, ~ as.vector(scale(.))) else x) %>% + (function(x) { + if (fun == "kproto") { + kp <- clustMixType::kproto(as.data.frame(x), k = nr_clus, iter.max = 500, verbose = FALSE, lambda = lambda) + ## kproto doesn't provide totss or betweenss by default + kp$totss <- clustMixType::kproto(as.data.frame(x), k = 1, iter.max = 1, verbose = FALSE, lambda = lambda)$tot.withinss + kp$betweenss <- kp$totss - kp$tot.withinss + kp + } else { + kmeans(x, centers = nr_clus, nstart = 10, iter.max = 500) + } + }) + } + + clus_names <- paste("Cluster", 1:nr_clus) + clus_means <- dataset %>% + mutate(clus_var = km_out$cluster) %>% + group_by(clus_var) %>% + summarise_all(function(x) center_calc(x, prop = TRUE)) %>% + select(-clus_var) %>% + as.data.frame(stringsAsFactors = FALSE) %>% + set_rownames(clus_names) + + nr_obs <- length(km_out$cluster) + + as.list(environment()) %>% add_class("kclus") +} + +#' Summary method for kclus +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/kclus.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{kclus}} +#' @param dec Number of decimals to show +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- kclus(shopping, vars = "v1:v6", nr_clus = 3) +#' summary(result) +#' @seealso \code{\link{kclus}} to generate results +#' @seealso \code{\link{plot.kclus}} to plot results +#' @seealso \code{\link{store.kclus}} to add cluster membership to the selected dataset +#' +#' @export +summary.kclus <- function(object, dec = 2, ...) { + if (is.character(object)) { + return(object) + } + cat(paste0("K-", substring(object$fun, 2), " cluster analysis\n")) + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + cat("Variables :", paste0(object$vars, collapse = ", "), "\n") + cat("Clustering by:", paste0("K-", substring(object$fun, 2), "\n")) + if (object$fun == "kproto") { + cat("Lambda :", round(object$km_out$lambda, dec), "\n") + } + if (object$hc_init) { + cat("HC method :", object$method, "\n") + cat("HC distance :", object$distance, "\n") + } + cat("Standardize :", object$standardize, "\n") + cat("Observations :", format_nr(object$nr_obs, dec = 0), "\n") + cat("Generated :", object$nr_clus, "clusters of sizes", paste0(format_nr(object$km_out$size, dec = 0), collapse = " | "), "\n\n") + + cat(paste0("Cluster means:\n")) + cm <- object$clus_means + cm <- cbind(data.frame(" " = paste0("Cluster ", 1:nrow(cm)), check.names = FALSE), cm) + print(format_df(cm, mark = ",", dec = dec), row.names = FALSE) + + ## percentage of within cluster heterogeneity accounted for by each cluster + cat("\nPercentage of within cluster heterogeneity accounted for by each cluster:\n") + data.frame(wcv = object$km_out$withinss / object$km_out$tot.withinss, stringsAsFactors = FALSE) %>% + format_df(perc = TRUE, dec = dec) %>% + set_rownames(object$clus_names) %>% + set_colnames("") %>% + print() + + ## percentage of between cluster heterogeneity versus the total, higher is better + format_nr(object$km_out$betweenss / object$km_out$totss, perc = TRUE, dec = dec) %>% + paste0("\nBetween cluster heterogeneity accounts for ", ., " of the\ntotal heterogeneity in the data (higher is better)") %>% + cat() +} + +#' Plot method for kclus +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/kclus.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{kclus}} +#' @param plots One of "density", "bar", or "scatter") +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- kclus(shopping, vars = "v1:v6", nr_clus = 3) +#' plot(result) +#' @seealso \code{\link{kclus}} to generate results +#' @seealso \code{\link{summary.kclus}} to summarize results +#' @seealso \code{\link{store.kclus}} to add cluster membership to the selected dataset +#' +#' @importFrom rlang .data +#' +#' @export +plot.kclus <- function(x, plots = "density", shiny = FALSE, custom = FALSE, ...) { + if (is.character(x)) { + return(x) + } + + x$dataset$Cluster <- as.factor(x$km_out$cluster) + vars <- colnames(x$dataset) %>% .[-length(.)] + + fct_plot <- function(dataset, var1, var2, color = "black", alpha = 0.5) { + tab <- as.data.frame(table(dataset[[var1]], dataset[[var2]])) + ggplot(tab, aes(x = .data$Var2, y = .data$Freq, fill = .data$Var1)) + + geom_bar(stat = "identity", position = "fill", alpha = alpha, color = color) + + scale_y_continuous(labels = scales::percent) + + labs(y = "", x = var2, fill = var1) + } + + plot_list <- list() + if ("density" %in% plots) { + for (var in vars) { + plot_list[[paste0("dens_", var)]] <- if (is.numeric(x$dataset[[var]])) { + ggplot(x$dataset, aes(x = .data[[var]], fill = .data$Cluster)) + + geom_density(adjust = 2.5, alpha = 0.3) + + labs(y = "") + + theme(axis.text.y = element_blank(), axis.ticks.y = element_blank()) + } else { + fct_plot(x$dataset, "Cluster", var, color = "black", alpha = 0.3) + } + } + } + if ("bar" %in% plots) { + me_calc <- function(se, n, conf.lev = .95) { + se * qt(conf.lev / 2 + .5, n - 1) + } + + for (var in vars) { + plot_list[[paste0("bar_", var)]] <- if (is.numeric(x$dataset[[var]])) { + dat_summary <- + select_at(x$dataset, .vars = c(var, "Cluster")) %>% + group_by_at(.vars = "Cluster") %>% + summarise_all( + list( + cent = mean, + n = length, + sd = sd, + se = se, + me = ~ me_calc(se, n, .95) + ) + ) + + ggplot(dat_summary, aes(x = .data$Cluster, y = .data$cent, fill = .data$Cluster)) + + geom_bar(stat = "identity", alpha = 0.5) + + geom_errorbar(width = .1, aes(ymin = cent - me, ymax = cent + me)) + + geom_errorbar(width = .05, aes(ymin = cent - se, ymax = cent + se), color = "blue") + + theme(legend.position = "none") + + labs(y = paste0(var, " (mean)")) + } else { + fct_plot(x$dataset, var, "Cluster") + } + } + } + if ("scatter" %in% plots) { + for (var in vars) { + plot_list[[paste0("scatter_", var)]] <- if (is.numeric(x$dataset[[var]])) { + visualize( + x$dataset, + xvar = "Cluster", yvar = var, + check = "jitter", + type = "scatter", + linecol = "blue", + pointcol = "black", + custom = TRUE + ) + } else { + fct_plot(x$dataset, var, "Cluster") + } + } + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = min(length(plot_list), 2)) %>% + (function(x) if (isTRUE(shiny)) x else print(x)) + } + } +} + +#' Add a cluster membership variable to the active dataset +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/kclus.html} for an example in Radiant +#' +#' @param dataset Dataset to append to cluster membership variable to +#' @param object Return value from \code{\link{kclus}} +#' @param name Name of cluster membership variable +#' @param ... Additional arguments +#' +#' @examples +#' kclus(shopping, vars = "v1:v6", nr_clus = 3) %>% +#' store(shopping, .) %>% +#' head() +#' @seealso \code{\link{kclus}} to generate results +#' @seealso \code{\link{summary.kclus}} to summarize results +#' @seealso \code{\link{plot.kclus}} to plot results +#' +#' @export +store.kclus <- function(dataset, object, name = "", ...) { + if (is.empty(name)) name <- paste0("kclus", object$nr_clus) + indr <- indexr(dataset, object$vars, object$data_filter) + km <- rep(NA, indr$nr) + km[indr$ind] <- object$km_out$cluster + dataset[[name]] <- as.factor(km) + dataset +} diff --git a/radiant.multivariate/R/mds.R b/radiant.multivariate/R/mds.R new file mode 100644 index 0000000000000000000000000000000000000000..2cb079b9cb47cf3910000cd4561b8a53ac77176e --- /dev/null +++ b/radiant.multivariate/R/mds.R @@ -0,0 +1,218 @@ +#' (Dis)similarity based brand maps (MDS) +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/mds.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param id1 A character variable or factor with unique entries +#' @param id2 A character variable or factor with unique entries +#' @param dis A numeric measure of brand dissimilarity +#' @param method Apply metric or non-metric MDS +#' @param nr_dim Number of dimensions +#' @param seed Random seed +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param envir Environment to extract data from +#' +#' @return A list of all variables defined in the function as an object of class mds +#' +#' @examples +#' mds(city, "from", "to", "distance") %>% str() +#' mds(diamonds, "clarity", "cut", "price") %>% str() +#' +#' @seealso \code{\link{summary.mds}} to summarize results +#' @seealso \code{\link{plot.mds}} to plot results +#' +#' @importFrom MASS isoMDS +#' +#' @export +mds <- function(dataset, id1, id2, dis, method = "metric", + nr_dim = 2, seed = 1234, data_filter = "", + envir = parent.frame()) { + nr_dim <- as.numeric(nr_dim) + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, c(id1, id2, dis), filt = data_filter, envir = envir, na.rm = FALSE) + + init_row <- nrow(dataset) + dataset <- na.omit(dataset) + nr_row <- nrow(dataset) + nr_na <- init_row - nr_row + if (nr_na > 0) { + return(paste0("The map cannot be created because the provided data contains ", nr_na, " rows with\nmissing data. Please choose other ID variables or another dataset.\n\nFor an example dataset go to Data > Manage, select 'examples' from the\n'Load data of type' dropdown, and press the 'Load examples' button. Then\nselect the \'city' dataset.") %>% + add_class("mds")) + } + + d <- dataset[[dis]] + id1_dat <- as.character(dataset[[id1]]) + id2_dat <- as.character(dataset[[id2]]) + rm(dataset, envir) + + ## ids + lab <- unique(c(id1_dat, id2_dat)) + nrLev <- length(lab) + + lower_nr <- (nrLev * (nrLev - 1)) / 2 + nrObs <- length(d) + + mds_dis_mat <- matrix(0, nrow = nrLev, ncol = nrLev) %>% + set_rownames(lab) %>% + set_colnames(lab) + + if (lower_nr != nrObs && (lower_nr + nrLev) != nrObs) { + return("Number of observations and unique IDs for the brand variable do not match.\nPlease choose other ID variables or another dataset.\n\nFor an example dataset go to Data > Manage, select 'examples' from the\n'Load data of type' dropdown, and press the 'Load examples' button. Then\nselect the \'city' dataset." %>% + add_class("mds")) + } else { + for (i in seq_len(nr_row)) { + id1 <- id1_dat[i] + id2 <- id2_dat[i] + mds_dis_mat[id1, id2] <- d[i] + mds_dis_mat[id2, id1] <- d[i] + } + + mds_dis_mat <- as.dist(mds_dis_mat) + } + + ## Alternative method, metaMDS - requires vegan + # res <- suppressWarnings(metaMDS(mds_dis_mat, k = nr_dim, trymax = 500)) + # if (res$converged == FALSE) return("The MDS algorithm did not converge. Please try again.") + + seed %>% + gsub("[^0-9]", "", .) %>% + (function(x) if (!is.empty(x)) set.seed(seed)) + res <- MASS::isoMDS(mds_dis_mat, k = nr_dim, trace = FALSE) + res$stress <- res$stress / 100 + + if (method == "metric") { + res$points <- cmdscale(mds_dis_mat, k = nr_dim) + ## Using R^2 + # res$stress <- sqrt(1 - cor(dist(res$points),mds_dis_mat)^2) * 100 + # Using standard Kruskal formula for metric MDS + res$stress <- sqrt((sum((dist(res$points) - mds_dis_mat)^2) / sum(mds_dis_mat^2))) + } + + as.list(environment()) %>% add_class("mds") +} + +#' Summary method for the mds function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/mds.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{mds}} +#' @param dec Rounding to use for output (default = 2). +1 used for stress measure +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- mds(city, "from", "to", "distance") +#' summary(result, dec = 1) +#' +#' @seealso \code{\link{mds}} to calculate results +#' @seealso \code{\link{plot.mds}} to plot results +#' +#' @export +summary.mds <- function(object, dec = 2, ...) { + if (is.character(object)) { + return(cat(object)) + } + + cat("(Dis)similarity based brand map (MDS)\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + cat("Variables :", paste0(c(object$id1, object$id2, object$dis), collapse = ", "), "\n") + cat("Dimensions :", object$nr_dim, "\n") + meth <- if (object$method == "non-metric") "Non-metric" else "Metric" + cat("Method :", meth, "\n") + cat("Observations:", object$nrObs, "\n") + + cat("\nOriginal distance data:\n") + object$mds_dis_mat %>% + round(dec) %>% + print() + + cat("\nRecovered distance data:\n") + object$res$points %>% + dist() %>% + round(dec) %>% + print() + + cat("\nCoordinates:\n") + object$res$points %>% + round(dec) %>% + set_colnames({ + paste("Dimension ", 1:ncol(.)) + }) %>% + print() + + cat("\nStress:", round(object$res$stress, dec + 1)) +} + +#' Plot method for the mds function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/mds.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{mds}} +#' @param rev_dim Flip the axes in plots +#' @param fontsz Font size to use in plots +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- mds(city, "from", "to", "distance") +#' plot(result, fontsz = 7) +#' plot(result, rev_dim = 1:2) +#' +#' @seealso \code{\link{mds}} to calculate results +#' @seealso \code{\link{summary.mds}} to plot results +#' +#' @importFrom ggrepel geom_text_repel +#' @importFrom rlang .data +#' +#' @export +plot.mds <- function(x, rev_dim = NULL, fontsz = 5, shiny = FALSE, custom = FALSE, ...) { + if (is.character(x)) { + return(cat(x)) + } + + ## set extremes for plot + lim <- max(abs(x$res$points)) + + ## set seed for ggrepel label positioning + set.seed(x$seed) + + tbl <- as.data.frame(x$res$points) %>% + set_colnames(paste0("dim", seq_len(ncol(.)))) + tbl$rnames <- rownames(tbl) + ## reverse selected dimensions + if (!is.empty(rev_dim)) { + rev_dim <- as.integer(rev_dim) + tbl[, rev_dim] <- -1 * tbl[, rev_dim] + } + + plot_list <- list() + for (i in 1:(x$nr_dim - 1)) { + for (j in (i + 1):x$nr_dim) { + i_name <- paste0("dim", i) + j_name <- paste0("dim", j) + plot_list[[paste0("dim", i, "_dim", j)]] <- ggplot(tbl, aes(x = .data[[i_name]], y = .data[[j_name]], color = .data$rnames, label = .data$rnames)) + + geom_point() + + ggrepel::geom_text_repel(size = fontsz) + + theme(legend.position = "none") + + coord_cartesian(xlim = c(-lim, lim), ylim = c(-lim, lim)) + + geom_vline(xintercept = 0, linewidth = 0.3) + + geom_hline(yintercept = 0, linewidth = 0.3) + + labs( + x = paste("Dimension", i), + y = paste("Dimension", j) + ) + } + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = 1) %>% + (function(x) if (isTRUE(shiny)) x else print(x)) + } + } +} diff --git a/radiant.multivariate/R/pre_factor.R b/radiant.multivariate/R/pre_factor.R new file mode 100644 index 0000000000000000000000000000000000000000..6db9bfa4a898b0275ecea103563bb784bc611d15 --- /dev/null +++ b/radiant.multivariate/R/pre_factor.R @@ -0,0 +1,252 @@ +#' Evaluate if data are appropriate for PCA / Factor analysis +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/pre_factor.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param vars Variables to include in the analysis +#' @param hcor Use polycor::hetcor to calculate the correlation matrix +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param envir Environment to extract data from +#' +#' @return A list with all variables defined in the function as an object of class pre_factor +#' +#' @examples +#' pre_factor(shopping, "v1:v6") %>% str() +#' +#' @seealso \code{\link{summary.pre_factor}} to summarize results +#' @seealso \code{\link{plot.pre_factor}} to plot results +#' +#' @importFrom psych KMO cortest.bartlett +#' @importFrom lubridate is.Date +#' @importFrom polycor hetcor +#' @importFrom dplyr across everything summarise +#' +#' @export +pre_factor <- function(dataset, vars, hcor = FALSE, data_filter = "", envir = parent.frame()) { + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, vars, filt = data_filter, envir = envir) + nrObs <- nrow(dataset) + + ## in case : is used + if (length(vars) < ncol(dataset)) { + vars <- colnames(dataset) + } + + ## check if there is variation in the data + not_vary <- vars[summarise(dataset, across(everything(), does_vary)) == FALSE] + if (length(not_vary) > 0) { + return(paste0("The following variable(s) show no variation. Please select other variables.\n\n** ", paste0(not_vary, collapse = ", "), " **") %>% + add_class("pre_factor")) + } + + anyCategorical <- sapply(dataset, function(x) is.numeric(x) || is.Date(x)) == FALSE + + if (hcor) { + dataset <- mutate_if(dataset, is.Date, as.numeric) + cmat <- try(sshhr(polycor::hetcor(dataset, ML = FALSE, std.err = FALSE)$correlations), silent = TRUE) + dataset <- mutate_all(dataset, radiant.data::as_numeric) + if (inherits(cmat, "try-error")) { + message("Calculating the heterogenous correlation matrix produced an error.\nUsing standard correlation matrix instead") + hcor <- "Calculation failed" + cmat <- cor(dataset) + } + } else { + dataset <- mutate_all(dataset, radiant.data::as_numeric) + cmat <- cor(dataset) + } + + btest <- psych::cortest.bartlett(cmat, nrow(dataset)) + pre_kmo <- psych::KMO(cmat) + pre_eigen <- eigen(cmat)$values + + if (det(cmat) > 0) { + scmat <- try(solve(cmat), silent = TRUE) + if (inherits(scmat, "try-error")) { + pre_r2 <- matrix(NA, nrow = nrow(cmat), ncol = 1) + rownames(pre_r2) <- rownames(cmat) + } else { + pre_r2 <- (1 - (1 / diag(scmat))) %>% + data.frame(stringsAsFactors = FALSE) %>% + set_colnames("Rsq") + } + } else { + pre_r2 <- matrix(NA, nrow = nrow(cmat), ncol = 1) + rownames(pre_r2) <- rownames(cmat) + } + + rm(dataset, envir) + + as.list(environment()) %>% add_class("pre_factor") +} + +## Notes: +# KMO is a measure of the relative size of (1) correlations between variables +# and (2) the partial correlations between those variables. This makes sense +# if you are interested in factors that have links to > 2 variables. +# But what if your factors are based on 2 indicators/variables? In that case +# your KMO would be horrible but a simple factor analysis would still cut the +# dimensionality of your data in halve. Use VIF or tolerance to indicate if +# factor analysis makes sense? + +#' Summary method for the pre_factor function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/pre_factor.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{pre_factor}} +#' @param dec Rounding to use for output +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- pre_factor(shopping, "v1:v6") +#' summary(result) +#' pre_factor(computer, "high_end:business") %>% summary() +#' @seealso \code{\link{pre_factor}} to calculate results +#' @seealso \code{\link{plot.pre_factor}} to plot results +#' +#' @export +summary.pre_factor <- function(object, dec = 2, ...) { + if (is.character(object)) { + return(cat(object)) + } + + if (is.character(object$pre_r2)) { + cat(object$pre_r2) + return(invisible()) + } + + cat("Pre-factor analysis diagnostics\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + cat("Variables :", paste0(object$vars, collapse = ", "), "\n") + cat("Observations:", format_nr(object$nrObs, dec = 0), "\n") + if (is.character(object$hcor)) { + cat(paste0("Correlation : Pearson (adjustment using polycor::hetcor failed)\n")) + } else if (isTRUE(object$hcor)) { + if (sum(object$anyCategorical) > 0) { + cat(paste0("Correlation : Heterogeneous correlations using polycor::hetcor\n")) + } else { + cat(paste0("Correlation : Pearson\n")) + } + } else { + cat("Correlation : Pearson\n") + } + if (sum(object$anyCategorical) > 0) { + if (isTRUE(object$hcor)) { + cat("** Variables of type {factor} are assumed to be ordinal **\n\n") + } else { + cat("** Variables of type {factor} included without adjustment **\n\n") + } + } else if (isTRUE(object$hcor)) { + cat("** No variables of type {factor} selected. No adjustment applied **\n\n") + } else { + cat("\n") + } + + btest <- object$btest + cat("Bartlett test\n") + cat("Null hyp. : variables are not correlated\n") + cat("Alt. hyp. : variables are correlated\n") + bt <- object$btest$p.value + bt <- if (!is.empty(bt) && bt < .001) "< .001" else round(bt, dec + 1) + cat(paste0( + "Chi-square: ", round(object$btest$chisq, 2), " df(", + object$btest$df, "), p.value ", bt, "\n" + )) + + cat("\nKMO test: ", round(object$pre_kmo$MSA, dec), "\n") + # cat("\nMeasures of sampling adequacy:\n") + # print(object$pre_kmo$MSAi, digits = dec) + + cat("\nVariable collinearity:\n") + if (all(is.na(object$pre_r2))) { + cat("\nRsq measures could not be calculated because the selected variables\nare perfectly collinear. Please check the correlations and remove\nany variable with a correlation of 1 or -1 from the analysis\n\n") + } + data.frame(Rsq = object$pre_r2, KMO = object$pre_kmo$MSAi, stringsAsFactors = FALSE) %>% + format_df(dec = dec) %>% + set_rownames(rownames(object$pre_r2)) %>% + print() + + ## fit measures, using transposed format because there could be many factors + cat("\nFit measures:\n") + object$pre_eigen %>% + { + data.frame( + ` ` = paste0("PC", 1:length(.)), + Eigenvalues = ., + `Variance %` = 100 * (. / sum(.)), + `Cumulative %` = 100 * (cumsum(. / sum(.))), + check.names = FALSE, + stringsAsFactors = FALSE + ) + } %>% + format_df(dec = dec) %>% + print(row.names = FALSE) +} + +#' Plot method for the pre_factor function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/pre_factor.html} for an example in Radiant +#' @param x Return value from \code{\link{pre_factor}} +#' @param plots Plots to return. "change" shows the change in eigenvalues as variables are grouped into different number of factors, "scree" shows a scree plot of eigenvalues +#' @param cutoff For large datasets plots can take time to render and become hard to interpret. By selection a cutoff point (e.g., eigenvalues of .8 or higher) factors with the least explanatory power are removed from the plot +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- pre_factor(shopping, "v1:v6") +#' plot(result, plots = c("change", "scree"), cutoff = .05) +#' @seealso \code{\link{pre_factor}} to calculate results +#' @seealso \code{\link{summary.pre_factor}} to summarize results +#' +#' @export +plot.pre_factor <- function(x, plots = c("scree", "change"), cutoff = 0.2, + shiny = FALSE, custom = FALSE, ...) { + if (is.character(x) || is.character(x$pre_r2) || length(plots) == 0) { + return(x) + } + + cutoff <- ifelse(is_not(cutoff), .2, cutoff) + pre_eigen <- with(x, pre_eigen[pre_eigen > cutoff]) + dat <- data.frame(y = pre_eigen, x = as.integer(1:length(pre_eigen)), stringsAsFactors = FALSE) + + plot_list <- list() + if ("scree" %in% plots) { + plot_list[[which("scree" == plots)]] <- + ggplot(dat, aes(x = x, y = y, group = 1)) + + geom_line(color = "blue", linetype = "dotdash", linewidth = .7) + + geom_point(color = "blue", size = 4, shape = 21, fill = "white") + + geom_hline(yintercept = 1, color = "black", linetype = "solid", linewidth = .5) + + labs(title = "Screeplot", x = "# factors", y = "Eigenvalues") + + scale_x_continuous(breaks = dat[["x"]]) + } + + if ("change" %in% plots) { + plot_list[[which("change" == plots)]] <- pre_eigen %>% + (function(x) (x - lag(x)) / lag(x)) %>% + (function(x) x / min(x, na.rm = TRUE)) %>% + data.frame( + bump = ., + nr_fact = paste0(0:(length(.) - 1), "-", 1:length(.)), + stringsAsFactors = FALSE + ) %>% + na.omit() %>% + ggplot(aes(x = factor(nr_fact, levels = nr_fact), y = bump)) + + geom_bar(stat = "identity", alpha = 0.5, fill = "blue") + + labs( + title = paste("Change in Eigenvalues"), + x = "# factors", y = "Rate of change index" + ) + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = 1) %>% + (function(x) if (shiny) x else print(x)) + } + } +} diff --git a/radiant.multivariate/R/prmap.R b/radiant.multivariate/R/prmap.R new file mode 100644 index 0000000000000000000000000000000000000000..5332d1f119e7e740ce32a63195e034d64b2726f3 --- /dev/null +++ b/radiant.multivariate/R/prmap.R @@ -0,0 +1,335 @@ +#' Attribute based brand maps +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/prmap.html} for an example in Radiant +#' +#' @param dataset Dataset +#' @param brand A character variable with brand names +#' @param attr Names of numeric variables +#' @param pref Names of numeric brand preference measures +#' @param nr_dim Number of dimensions +#' @param hcor Use polycor::hetcor to calculate the correlation matrix +#' @param data_filter Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000") +#' @param envir Environment to extract data from +#' +#' @return A list of all variables defined in the function as an object of class prmap +#' +#' @examples +#' prmap(computer, brand = "brand", attr = "high_end:business") %>% str() +#' +#' @seealso \code{\link{summary.prmap}} to summarize results +#' @seealso \code{\link{plot.prmap}} to plot results +#' +#' @importFrom psych principal +#' @importFrom lubridate is.Date +#' @importFrom polycor hetcor +#' +#' @export +prmap <- function(dataset, brand, attr, pref = "", nr_dim = 2, hcor = FALSE, + data_filter = "", envir = parent.frame()) { + nr_dim <- as.numeric(nr_dim) + vars <- c(brand, attr) + if (!is.empty(pref)) vars <- c(vars, pref) + df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset)) + dataset <- get_data(dataset, vars, filt = data_filter, envir = envir) + + brands <- dataset[[brand]] %>% + as.character() %>% + gsub("^\\s+|\\s+$", "", .) + f_data <- get_data(dataset, attr, envir = envir) + anyCategorical <- sapply(f_data, function(x) is.numeric(x) || is.Date(x)) == FALSE + nrObs <- nrow(dataset) + + # in case : is used + if (length(attr) < ncol(f_data)) attr <- colnames(f_data) + if (nr_dim > length(attr)) { + return("The number of dimensions cannot exceed the number of attributes" %>% + add_class("prmap")) + } + + if (hcor) { + f_data <- mutate_if(f_data, is.Date, as.numeric) + cmat <- try(sshhr(polycor::hetcor(f_data, ML = FALSE, std.err = FALSE)$correlations), silent = TRUE) + f_data <- mutate_all(f_data, radiant.data::as_numeric) + if (inherits(cmat, "try-error")) { + message("Calculating the heterogeneous correlation matrix produced an error.\nUsing standard correlation matrix instead") + hcor <- "Calculation failed" + cmat <- cor(f_data) + } + } else { + f_data <- mutate_all(f_data, radiant.data::as_numeric) + cmat <- cor(f_data) + } + + fres <- sshhr(psych::principal( + cmat, + nfactors = nr_dim, rotate = "varimax", + scores = FALSE, oblique.scores = FALSE + )) + + m <- fres$loadings[, colnames(fres$loadings)] + cscm <- m %*% solve(crossprod(m)) + ## store in fres so you can re-use save_factors + fres$scores <- scale(as.matrix(f_data), center = TRUE, scale = TRUE) %*% cscm + rownames(fres$scores) <- brands + + scores <- data.frame(fres$scores) %>% + mutate(brands = brands) %>% + group_by_at("brands") %>% + summarise_all(mean) %>% + as.data.frame() %>% + set_rownames(.[["brands"]]) %>% + select(-1) + + if (!is.empty(pref)) { + p_data <- get_data(dataset, pref, envir = envir) %>% + mutate_if(is.Date, as.numeric) + anyPrefCat <- sapply(p_data, function(x) is.numeric(x)) == FALSE + if (sum(anyPrefCat) > 0) { + pref_cor <- sshhr(polycor::hetcor(cbind(p_data, fres$scores), ML = FALSE, std.err = FALSE)$correlations) + pref_cor <- as.data.frame(pref_cor[-((length(pref) + 1):nrow(pref_cor)), -(1:length(pref))], stringsAsFactor = FALSE) + } else { + pref_cor <- p_data %>% + cor(fres$scores) %>% + data.frame(stringsAsFactors = FALSE) + } + pref <- colnames(pref_cor) + pref_cor$communalities <- rowSums(pref_cor^2) + rm(p_data, anyPrefCat) + } + + rm(f_data, m, cscm, envir) + as.list(environment()) %>% add_class(c("prmap", "full_factor")) +} + +#' Summary method for the prmap function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/prmap.html} for an example in Radiant +#' +#' @param object Return value from \code{\link{prmap}} +#' @param cutoff Show only loadings with (absolute) values above cutoff (default = 0) +#' @param dec Rounding to use for output +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- prmap(computer, brand = "brand", attr = "high_end:business") +#' summary(result) +#' summary(result, cutoff = .3) +#' prmap( +#' computer, +#' brand = "brand", attr = "high_end:dated", +#' pref = c("innovative", "business") +#' ) %>% summary() +#' +#' @seealso \code{\link{prmap}} to calculate results +#' @seealso \code{\link{plot.prmap}} to plot results +#' +#' @export +summary.prmap <- function(object, cutoff = 0, dec = 2, ...) { + if (is.character(object)) { + return(object) + } + + cat("Attribute based brand map\n") + cat("Data :", object$df_name, "\n") + if (!is.empty(object$data_filter)) { + cat("Filter :", gsub("\\n", "", object$data_filter), "\n") + } + cat("Attributes :", paste0(object$attr, collapse = ", "), "\n") + if (!is.empty(object$pref)) { + cat("Preferences :", paste0(object$pref, collapse = ", "), "\n") + } + cat("Dimensions :", object$nr_dim, "\n") + cat("Rotation : varimax\n") + cat("Observations:", object$nrObs, "\n") + if (is.character(object$hcor)) { + cat(paste0("Correlation : Pearson (adjustment using polycor::hetcor failed)\n")) + } else if (isTRUE(object$hcor)) { + if (sum(object$anyCategorical) > 0) { + cat(paste0("Correlation : Heterogeneous correlations using polycor::hetcor\n")) + } else { + cat(paste0("Correlation : Pearson\n")) + } + } else { + cat("Correlation : Pearson\n") + } + if (sum(object$anyCategorical) > 0) { + if (isTRUE(object$hcor)) { + cat("** Variables of type {factor} are assumed to be ordinal **\n\n") + } else { + cat("** Variables of type {factor} included without adjustment **\n\n") + } + } else if (isTRUE(object$hcor)) { + cat("** No variables of type {factor} selected. No adjustment applied **\n\n") + } else { + cat("\n") + } + + cat("Brand - Factor scores:\n") + round(object$scores, dec) %>% print() + + cat("\nAttribute - Factor loadings:\n") + + ## convert loadings object to data.frame + lds <- object$fres$loadings + dn <- dimnames(lds) + lds %<>% matrix(nrow = length(dn[[1]])) %>% + set_colnames(dn[[2]]) %>% + set_rownames(dn[[1]]) %>% + data.frame(stringsAsFactors = FALSE) + + ## show only the loadings > ff_cutoff + ind <- abs(lds) < cutoff + print_lds <- round(lds, dec) + print_lds[ind] <- "" + print(print_lds) + + if (!is.empty(object$pref)) { + cat("\nPreference correlations:\n") + print(round(object$pref_cor, dec), digits = dec) + } + + ## fit measures + cat("\nFit measures:\n") + colSums(lds^2) %>% + rbind(., 100 * (. / length(dn[[1]]))) %>% + rbind(., cumsum(.[2, ])) %>% + round(dec) %>% + set_rownames(c("Eigenvalues", "Variance %", "Cumulative %")) %>% + print() + + cat("\nAttribute communalities:") + data.frame(1 - object$fres$uniqueness, stringsAsFactors = FALSE) %>% + set_colnames("") %>% + round(dec) %>% + print() +} + +#' Plot method for the prmap function +#' +#' @details See \url{https://radiant-rstats.github.io/docs/multivariate/prmap.html} for an example in Radiant +#' +#' @param x Return value from \code{\link{prmap}} +#' @param plots Components to include in the plot ("brand", "attr"). If data on preferences is available use "pref" to add preference arrows to the plot +#' @param scaling Arrow scaling in the brand map +#' @param fontsz Font size to use in plots +#' @param seed Random seed +#' @param shiny Did the function call originate inside a shiny app +#' @param custom Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options. +#' @param ... further arguments passed to or from other methods +#' +#' @examples +#' result <- prmap(computer, brand = "brand", attr = "high_end:business") +#' plot(result, plots = "brand") +#' plot(result, plots = c("brand", "attr")) +#' plot(result, scaling = 1, plots = c("brand", "attr")) +#' prmap( +#' retailers, +#' brand = "retailer", +#' attr = "good_value:cluttered", +#' pref = c("segment1", "segment2") +#' ) %>% plot(plots = c("brand", "attr", "pref")) +#' +#' @seealso \code{\link{prmap}} to calculate results +#' @seealso \code{\link{summary.prmap}} to plot results +#' +#' @importFrom ggrepel geom_text_repel +#' @importFrom rlang .data +#' +#' @export +plot.prmap <- function(x, plots = "", scaling = 2, fontsz = 5, seed = 1234, + shiny = FALSE, custom = FALSE, ...) { + if (is.character(x)) { + return(x) + } + + ## set seed for ggrepel label positioning + set.seed(seed) + + ## need for dplyr as.symbol + type <- rnames <- NULL + + pm_dat <- list() + ## brand coordinates + pm_dat$brand <- as.data.frame(x$scores) %>% + set_colnames(paste0("dim", seq_len(ncol(.)))) %>% + mutate(rnames = rownames(.), type = "brand") + + ## preference coordinates + if (!is.empty(x$pref_cor)) { + pm_dat$pref <- x$pref_cor %>% + select(-ncol(.)) %>% + set_colnames(paste0("dim", seq_len(ncol(.)))) %>% + (function(x) x * scaling) %>% + mutate(rnames = rownames(.), type = "pref") + } else { + plots <- base::setdiff(plots, "pref") + } + + ## attribute coordinates + std_m <- x$fres$loadings + dn <- dimnames(std_m) + pm_dat$attr <- std_m %>% + matrix(nrow = length(dn[[1]])) %>% + set_colnames(paste0("dim", seq_len(ncol(.)))) %>% + set_rownames(dn[[1]]) %>% + data.frame(stringsAsFactors = FALSE) %>% + (function(x) x * scaling) %>% + mutate(rnames = rownames(.), type = "attr") + + ## combining data + pm_dat <- bind_rows(pm_dat) + + ## set plot limits + isNum <- sapply(pm_dat, is.numeric) + lim <- max(abs(select(pm_dat, which(isNum)))) + + label_colors <- c(brand = "black", attr = "darkblue", pref = "red") + plot_list <- list() + for (i in 1:(x$nr_dim - 1)) { + for (j in (i + 1):x$nr_dim) { + i_name <- paste0("dim", i) + j_name <- paste0("dim", j) + p <- ggplot() + + theme(legend.position = "none") + + coord_cartesian(xlim = c(-lim, lim), ylim = c(-lim, lim)) + + geom_vline(xintercept = 0, linewidth = 0.3) + + geom_hline(yintercept = 0, linewidth = 0.3) + + labs( + x = paste("Dimension", i), + y = paste("Dimension", j) + ) + + if (!is.empty(plots)) { + p <- p + ggrepel::geom_text_repel( + data = filter(pm_dat, !!as.symbol("type") %in% plots), + aes(x = .data[[i_name]], y = .data[[j_name]], label = .data$rnames, color = .data$type), + size = fontsz + ) + + scale_color_manual(values = label_colors) + + if ("brand" %in% plots) { + p <- p + geom_point(data = filter(pm_dat, !!as.symbol("type") == "brand"), aes(x = .data[[i_name]], y = .data[[j_name]])) + } + + if (any(c("attr", "pref") %in% plots)) { + pm_arrows <- filter(pm_dat, !!as.symbol("type") %in% base::setdiff(plots, "brand")) + pm_arrows[, isNum] <- pm_arrows[, isNum] * 0.9 + p <- p + geom_segment( + data = pm_arrows, aes(x = 0, y = 0, xend = .data[[i_name]], yend = .data[[j_name]], color = .data$type), + arrow = arrow(length = unit(0.01, "npc"), type = "closed"), linewidth = 0.3, linetype = "dashed" + ) + } + } + plot_list[[paste0("dim", i, "_dim", j)]] <- p + } + } + + if (length(plot_list) > 0) { + if (custom) { + if (length(plot_list) == 1) plot_list[[1]] else plot_list + } else { + patchwork::wrap_plots(plot_list, ncol = 1) %>% + (function(x) if (shiny) x else print(x)) + } + } +} diff --git a/radiant.multivariate/R/radiant.R b/radiant.multivariate/R/radiant.R new file mode 100644 index 0000000000000000000000000000000000000000..bf3215d45ea338b92a545d82f1a75e00e16d7396 --- /dev/null +++ b/radiant.multivariate/R/radiant.R @@ -0,0 +1,48 @@ +#' Launch radiant.multivariate in the default browser +#' +#' @description Launch radiant.multivariate in the default web browser +#' @details See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +#' +#' @param state Path to state file to load +#' @param ... additional arguments to pass to shiny::runApp (e.g, port = 8080) +#' +#' @importFrom radiant.data launch +#' +#' @examples +#' \dontrun{ +#' radiant.multivariate() +#' } +#' @export +radiant.multivariate <- function(state, ...) radiant.data::launch(package = "radiant.multivariate", run = "browser", state, ...) + +#' Launch radiant.multivariate in an Rstudio window +#' +#' @details See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +#' +#' @param state Path to state file to load +#' @param ... additional arguments to pass to shiny::runApp (e.g, port = 8080) +#' +#' @importFrom radiant.data launch +#' +#' @examples +#' \dontrun{ +#' radiant.multivariate_window() +#' } +#' @export +radiant.multivariate_window <- function(state, ...) radiant.data::launch(package = "radiant.multivariate", run = "window", state, ...) + +#' Launch radiant.multivariate in the Rstudio viewer +#' +#' @details See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +#' +#' @param state Path to state file to load +#' @param ... additional arguments to pass to shiny::runApp (e.g, port = 8080) +#' +#' @importFrom radiant.data launch +#' +#' @examples +#' \dontrun{ +#' radiant.multivariate_viewer() +#' } +#' @export +radiant.multivariate_viewer <- function(state, ...) radiant.data::launch(package = "radiant.multivariate", run = "viewer", state, ...) diff --git a/radiant.multivariate/README.md b/radiant.multivariate/README.md new file mode 100644 index 0000000000000000000000000000000000000000..fb3343f54842680665bbcdcd875f0a02363c1cdf --- /dev/null +++ b/radiant.multivariate/README.md @@ -0,0 +1,188 @@ +# Radiant - Business analytics using R and Shiny + + + +[![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/radiant.multivariate)](https://CRAN.R-project.org/package=radiant.multivariate) + + +Radiant is an open-source platform-independent browser-based interface for business analytics in [R](https://www.r-project.org/). The application is based on the [Shiny](https://shiny.posit.co/) package and can be run locally or on a server. Radiant was developed by Vincent Nijs. Please use the issue tracker on GitHub to suggest enhancements or report problems: https://github.com/radiant-rstats/radiant.multivariate/issues. For other questions and comments please use radiant@rady.ucsd.edu. + +## Key features + +- Explore: Quickly and easily summarize, visualize, and analyze your data +- Cross-platform: It runs in a browser on Windows, Mac, and Linux +- Reproducible: Recreate results and share work with others as a state file or an [Rmarkdown](https://rmarkdown.rstudio.com/) report +- Programming: Integrate Radiant's analysis functions with your own R-code +- Context: Data and examples focus on business applications + + + + +#### Playlists + +There are two youtube playlists with video tutorials. The first provides a general introduction to key features in Radiant. The second covers topics relevant in a course on business analytics (i.e., Probability, Decision Analysis, Hypothesis Testing, Linear Regression, and Simulation). + +* Introduction to Radiant +* Radiant Tutorial Series + +#### Explore + +Radiant is interactive. Results update immediately when inputs are changed (i.e., no separate dialog boxes) and/or when a button is pressed (e.g., `Estimate` in _Model > Estimate > Logistic regression (GLM)_). This facilitates rapid exploration and understanding of the data. + +#### Cross-platform + +Radiant works on Windows, Mac, or Linux. It can run without an Internet connection and no data will leave your computer. You can also run the app as a web application on a server. + +#### Reproducible + +To conduct high-quality analysis, simply saving output is not enough. You need the ability to reproduce results for the same data and/or when new data become available. Moreover, others may want to review your analysis and results. Save and load the state of the application to continue your work at a later time or on another computer. Share state files with others and create reproducible reports using [Rmarkdown](https://rmarkdown.rstudio.com/). See also the section on `Saving and loading state` below + +If you are using Radiant on a server you can even share the URL (include the SSUID) with others so they can see what you are working on. Thanks for this feature go to [Joe Cheng](https://github.com/jcheng5). + +#### Programming + +Although Radiant's web-interface can handle quite a few data and analysis tasks, you may prefer to write your own R-code. Radiant provides a bridge to programming in R(studio) by exporting the functions used for analysis (i.e., you can conduct your analysis using the Radiant web-interface or by calling Radiant's functions directly from R-code). For more information about programming with Radiant see the [programming](https://radiant-rstats.github.io/docs/programming.html) page on the documentation site. + +#### Context + +Radiant focuses on business data and decisions. It offers tools, examples, and documentation relevant for that context, effectively reducing the business analytics learning curve. + +## How to install Radiant + +- Required: [R](https://cran.r-project.org/) version 4.0.0 or later +- Required: [Rstudio](https://posit.co/download/rstudio-server/) + +In Rstudio you can start and update Radiant through the `Addins` menu at the top of the screen. To install the latest version of Radiant for Windows or Mac, with complete documentation for off-line access, open R(studio) and copy-and-paste the command below: + +```r +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org")) +install.packages("radiant") +``` + +Once all packages are installed, select `Start radiant` from the `Addins` menu in Rstudio or use the command below to launch the app: + +```r +radiant::radiant() +``` + +To launch Radiant in Rstudio's viewer pane use the command below: + +```r +radiant::radiant_viewer() +``` + +To launch Radiant in an Rstudio Window use the command below: + +```r +radiant::radiant_window() +``` + +To easily update Radiant and the required packages, install the `radiant.update` package using: + +```r +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org")) +install.packages("remotes") +remotes::install_github("radiant-rstats/radiant.update", upgrade = "never") +``` + +Then select `Update radiant` from the `Addins` menu in Rstudio or use the command below: + +```r +radiant.update::radiant.update() +``` + +See the [installing radiant](https://radiant-rstats.github.io/docs/install.html) page additional for details. + +**Optional:** You can also create a launcher on your Desktop to start Radiant by typing `radiant::launcher()` in the R(studio) console and pressing return. A file called `radiant.bat` (windows) or `radiant.command` (mac) will be created that you can double-click to start Radiant in your default browser. The `launcher` command will also create a file called `update_radiant.bat` (windows) or `update_radiant.command` (mac) that you can double-click to update Radiant to the latest release. + +When Radiant starts you will see data on diamond prices. To close the application click the icon in the navigation bar and then click `Stop`. The Radiant process will stop and the browser window will close (Chrome) or gray-out. + +## Documentation + +Documentation and tutorials are available at and in the Radiant web interface (the icons on each page and the icon in the navigation bar). + +Individual Radiant packages also each have their own [pkgdown](https://github.com/r-lib/pkgdown) sites: + +* http://radiant-rstats.github.io/radiant +* http://radiant-rstats.github.io/radiant.data +* http://radiant-rstats.github.io/radiant.design +* http://radiant-rstats.github.io/radiant.basics +* http://radiant-rstats.github.io/radiant.model +* http://radiant-rstats.github.io/radiant.multivariate + +Want some help getting started? Watch the tutorials on the [documentation site](https://radiant-rstats.github.io/docs/tutorials.html). + + +## Reporting issues + +Please use the GitHub issue tracker at github.com/radiant-rstats/radiant/issues if you have any problems using Radiant. + +## Try Radiant online + +Not ready to install Radiant on your computer? Try it online at the link below: + +https://vnijs.shinyapps.io/radiant + +Do **not** upload sensitive data to this public server. The size of data upload has been restricted to 10MB for security reasons. + +## Running Radiant on shinyapps.io + +To run your own instance of Radiant on shinyapps.io first install Radiant and its dependencies. Then clone the radiant repo and ensure you have the latest version of the Radiant packages installed by running `radiant/inst/app/for.shinyapps.io.R`. Finally, open `radiant/inst/app/ui.R` and [deploy](https://shiny.posit.co/articles/shinyapps.html) the application. + +## Running Radiant on shiny-server + +You can also host Radiant using [shiny-server](https://posit.co/download/shiny-server/). First, install radiant on the server using the command below: + +```r +options(repos = c(RSM = "https://radiant-rstats.github.io/minicran", CRAN = "https://cloud.r-project.org")) +install.packages("radiant") +``` + +Then clone the radiant repo and point shiny-server to the `inst/app/` directory. As a courtesy, please let me know if you intend to use Radiant on a server. + +When running Radiant on a server, by default, file uploads are limited to 10MB and R-code in _Report > Rmd_ and _Report > R_ will not be evaluated for security reasons. If you have `sudo` access to the server and have appropriate security in place you can change these settings by adding the following lines to `.Rprofile` for the `shiny` user on the server. + +```bash +options(radiant.maxRequestSize = -1) ## no file size limit +options(radiant.report = TRUE) +``` + +## Running Radiant in the cloud (e.g., AWS) + +To run radiant in the cloud you can use the customized Docker container. See https://github.com/radiant-rstats/docker for details + +## Saving and loading state + +To save your analyses save the state of the app to a file by clicking on the icon in the navbar and then on `Save radiant state file` (see also the _Data > Manage_ tab). You can open this state file at a later time or on another computer to continue where you left off. You can also share the file with others that may want to replicate your analyses. As an example, load the state file [`radiant-example.state.rda`](https://radiant-rstats.github.io/docs/examples/radiant-example.state.rda) by clicking on the icon in the navbar and then on `Load radiant state file`. Go to _Data > View_ and _Data > Visualize_ to see some of the settings from the previous "state" of the app. There is also a report in _Report > Rmd_ that was created using the Radiant interface. The html file `radiant-example.nb.html` contains the output. + +A related feature in Radiant is that state is maintained if you accidentally navigate to another web page, close (and reopen) the browser, and/or hit refresh. Use `Refresh` in the menu in the navigation bar to return to a clean/new state. + +Loading and saving state also works with Rstudio. If you start Radiant from Rstudio and use > `Stop` to stop the app, lists called `r_data`, `r_info`, and `r_state` will be put into Rstudio's global workspace. If you start radiant again using `radiant::radiant()` it will use these lists to restore state. Also, if you load a state file directly into Rstudio it will be used when you start Radiant to recreate a previous state. + +**Technical note**: Loading state works as follows in Radiant: When an input is initialized in a Shiny app you set a default value in the call to, for example, numericInput. In Radiant, when a state file has been loaded and an input is initialized it looks to see if there is a value for an input of that name in a list called `r_state`. If there is, this value is used. The `r_state` list is created when saving state using `reactiveValuesToList(input)`. An example of a call to `numericInput` is given below where the `state_init` function from `radiant.R` is used to check if a value from `r_state` can be used. + +```r +numericInput("sm_comp_value", "Comparison value:", state_init("sm_comp_value", 0)) +``` + +## Source code + +The source code for the radiant application is available on GitHub at . `radiant.data`, offers tools to load, save, view, visualize, summarize, combine, and transform data. `radiant.design` builds on `radiant.data` and adds tools for experimental design, sampling, and sample size calculation. `radiant.basics` covers the basics of statistical analysis (e.g., comparing means and proportions, cross-tabs, correlation, etc.) and includes a probability calculator. `radiant.model` covers model estimation (e.g., logistic regression and neural networks), model evaluation (e.g., gains chart, profit curve, confusion matrix, etc.), and decision tools (e.g., decision analysis and simulation). Finally, `radiant.multivariate` includes tools to generate brand maps and conduct cluster, factor, and conjoint analysis. + +These tools are used in the _Business Analytics_, _Quantitative Analysis_, _Research for Marketing Decisions_, _Applied Market Research_, _Consumer Behavior_, _Experiments in Firms_, _Pricing_, _Pricing Analytics_, and _Customer Analytics_ classes at the Rady School of Management (UCSD). + +## Credits + +Radiant would not be possible without [R](https://cran.r-project.org/) and [Shiny](https://shiny.posit.co/). I would like to thank [Joe Cheng](https://github.com/jcheng5), [Winston Chang](https://github.com/wch), and [Yihui Xie](https://github.com/yihui) for answering questions, providing suggestions, and creating amazing tools for the R community. Other key components used in Radiant are ggplot2, dplyr, tidyr, magrittr, broom, shinyAce, shinyFiles, rmarkdown, and DT. For an overview of other packages that Radiant relies on please see the about page. + + +## License + + +Radiant is licensed under the AGPLv3. As a summary, the AGPLv3 license requires, attribution, including copyright and license information in copies of the software, stating changes if the code is modified, and disclosure of all source code. Details are in the COPYING file. + +The documentation, images, and videos for the `radiant.data` package are licensed under the creative commons attribution and share-alike license CC-BY-SA. All other documentation and videos on this site, as well as the help files for `radiant.design`, `radiant.basics`, `radiant.model`, and `radiant.multivariate`, are licensed under the creative commons attribution, non-commercial, share-alike license CC-NC-SA. + +If you are interested in using any of the radiant packages please email me at radiant@rady.ucsd.edu + +© Vincent Nijs (2025) Creative Commons License \ No newline at end of file diff --git a/radiant.multivariate/_pkgdown.yml b/radiant.multivariate/_pkgdown.yml new file mode 100644 index 0000000000000000000000000000000000000000..76a1d27550a041caa52f6a5a9bd3ff813448a14f --- /dev/null +++ b/radiant.multivariate/_pkgdown.yml @@ -0,0 +1,119 @@ +url: https://radiant-rstats.github.io/radiant.multivariate + +template: + params: + docsearch: + api_key: 2038ba9d97ecd78525ca0ca8e051bec0 + index_name: radiant_multivariate + +navbar: + title: "radiant.multivariate" + left: + - icon: fa-home fa-lg + href: index.html + - text: "Reference" + href: reference/index.html + - text: "Articles" + href: articles/index.html + - text: "Changelog" + href: news/index.html + - text: "Other Packages" + menu: + - text: "radiant" + href: https://radiant-rstats.github.io/radiant/ + - text: "radiant.data" + href: https://radiant-rstats.github.io/radiant.data/ + - text: "radiant.design" + href: https://radiant-rstats.github.io/radiant.design/ + - text: "radiant.basics" + href: https://radiant-rstats.github.io/radiant.basics/ + - text: "radiant.model" + href: https://radiant-rstats.github.io/radiant.model/ + - text: "radiant.multivariate" + href: https://radiant-rstats.github.io/radiant.multivariate/ + - text: "docker" + href: https://github.com/radiant-rstats/docker + right: + - icon: fa-twitter fa-lg + href: https://twitter.com/vrnijs + - icon: fa-github fa-lg + href: https://github.com/radiant-rstats + +reference: +- title: Multivariate > Maps + desc: Create brand maps based on (dis)similarity or attribute data + contents: + - mds + - summary.mds + - plot.mds + - prmap + - summary.prmap + - plot.prmap +- title: Multivariate > Factor + desc: Conduct PCA or Factor analysis on numeric data + contents: + - pre_factor + - summary.pre_factor + - plot.pre_factor + - full_factor + - summary.full_factor + - plot.full_factor + - store.full_factor + - clean_loadings +- title: Multivariate > Cluster + desc: Conduct cluster analysis + contents: + - hclus + - summary.hclus + - plot.hclus + - kclus + - summary.kclus + - plot.kclus + - store.kclus +- title: Multivariate > Conjoint + desc: Estimate conjoint models + contents: + - conjoint + - summary.conjoint + - predict.conjoint + - plot.conjoint + - predict_conjoint_by + - print.conjoint.predict + - store.conjoint.predict + - the_table +- title: Starting radiant.multivariate + desc: Functions used to start radiant shiny apps + contents: + - radiant.multivariate + - radiant.multivariate_viewer + - radiant.multivariate_window +- title: Data sets + desc: Data sets bundled with radiant.multivariate + contents: + - carpet + - city + - city2 + - computer + - mp3 + - movie + - shopping + - toothpaste + - tpbrands + - retailers +- title: Deprecated + desc: Deprecated + contents: + - pmap + - store.conjoint +articles: +- title: Multivariate Menu + desc: > + These vignettes provide an introduction to the Multivariate menu in radiant + contents: + - pkgdown/mds + - pkgdown/prmap + - pkgdown/pre_factor + - pkgdown/full_factor + - pkgdown/hclus + - pkgdown/kclus + - pkgdown/conjoint diff --git a/radiant.multivariate/build/build.R b/radiant.multivariate/build/build.R new file mode 100644 index 0000000000000000000000000000000000000000..0f6d467bbc9f5ea41763ee2f0e2af16325bb8a99 --- /dev/null +++ b/radiant.multivariate/build/build.R @@ -0,0 +1,87 @@ +setwd(rstudioapi::getActiveProject()) +curr <- getwd() +pkg <- basename(curr) + +## building package for mac and windows +rv <- R.Version() +rv <- paste(rv$major, substr(rv$minor, 1, 1), sep = ".") + +rvprompt <- readline(prompt = paste0("Running for R version: ", rv, ". Is that what you wanted y/n: ")) +if (grepl("[nN]", rvprompt)) stop("Change R-version") + +dirsrc <- "../minicran/src/contrib" + +if (rv < "3.4") { + dirmac <- fs::path("../minicran/bin/macosx/mavericks/contrib", rv) +} else if (rv > "3.6") { + dirmac <- c( + fs::path("../minicran/bin/macosx/big-sur-arm64/contrib", rv), + fs::path("../minicran/bin/macosx/contrib", rv) + ) +} else { + dirmac <- fs::path("../minicran/bin/macosx/el-capitan/contrib", rv) +} + +dirwin <- fs::path("../minicran/bin/windows/contrib", rv) + +if (!fs::file_exists(dirsrc)) fs::dir_create(dirsrc, recursive = TRUE) +for (d in dirmac) { + if (!fs::file_exists(d)) fs::dir_create(d, recursive = TRUE) +} +if (!fs::file_exists(dirwin)) fs::dir_create(dirwin, recursive = TRUE) + +# delete older version of radiant +rem_old <- function(pkg) { + unlink(paste0(dirsrc, "/", pkg, "*")) + for (d in dirmac) { + unlink(paste0(d, "/", pkg, "*")) + } + unlink(paste0(dirwin, "/", pkg, "*")) +} + +sapply(pkg, rem_old) + +## avoid 'loaded namespace' stuff when building for mac +system(paste0(Sys.which("R"), " -e \"setwd('", getwd(), "'); app <- '", pkg, "'; source('build/build_mac.R')\"")) + +win <- readline(prompt = "Did you build on Windows? y/n: ") +if (grepl("[yY]", win)) { + + fl <- list.files(pattern = "*.zip", path = "~/Dropbox/r-packages/", full.names = TRUE) + for (f in fl) { + print(f) + file.copy(f, "~/gh/") + } + + ## move packages to radiant_miniCRAN. must package in Windows first + # path <- normalizePath("../") + pth <- fs::path_abs("../") + + sapply(list.files(pth, pattern = "*.tar.gz", full.names = TRUE), file.copy, dirsrc) + unlink("../*.tar.gz") + for (d in dirmac) { + sapply(list.files(pth, pattern = "*.tgz", full.names = TRUE), file.copy, d) + } + unlink("../*.tgz") + sapply(list.files(pth, pattern = "*.zip", full.names = TRUE), file.copy, dirwin) + unlink("../*.zip") + + tools::write_PACKAGES(dirwin, type = "win.binary") + for (d in dirmac) { + tools::write_PACKAGES(d, type = "mac.binary") + } + tools::write_PACKAGES(dirsrc, type = "source") + + # commit to repo + setwd("../minicran") + system("git add --all .") + mess <- paste0(pkg, " package update: ", format(Sys.Date(), format = "%m-%d-%Y")) + system(paste0("git commit -m '", mess, "'")) + system("git push") +} + +setwd(curr) + +# remove.packages(c("radiant.model", "radiant.data")) +# radiant.update::radiant.update() +# install.packages("radiant.update") diff --git a/radiant.multivariate/build/build_mac.R b/radiant.multivariate/build/build_mac.R new file mode 100644 index 0000000000000000000000000000000000000000..da4205d2075a009ae8fb3423ae2469624276d882 --- /dev/null +++ b/radiant.multivariate/build/build_mac.R @@ -0,0 +1,6 @@ +## build for mac +curr <- setwd("../") +devtools::install(app, upgrade = "never") +f <- devtools::build(app) +system(paste0("R CMD INSTALL --build ", f)) +setwd(curr) diff --git a/radiant.multivariate/build/build_win.R b/radiant.multivariate/build/build_win.R new file mode 100644 index 0000000000000000000000000000000000000000..e6861ceb5e94157a4ed21359a4d3339b9f1de8fb --- /dev/null +++ b/radiant.multivariate/build/build_win.R @@ -0,0 +1,26 @@ +## build for windows +rv <- R.Version() +rv <- paste(rv$major, substr(rv$minor, 1, 1), sep = ".") + +rvprompt <- readline(prompt = paste0("Running for R version: ", rv, ". Is that what you wanted y/n: ")) +if (grepl("[nN]", rvprompt)) + stop("Change R-version using Rstudio > Tools > Global Options > Rversion") + +## build for windows +setwd(rstudioapi::getActiveProject()) +f <- devtools::build(binary = TRUE) +devtools::install(upgrade = "never") + +fl <- list.files(pattern = "*.zip", path = "../", full.names = TRUE) + +for (f in fl) { + print(glue::glue("Copying: {f}")) + file.copy(f, "C:/Users/vnijs/Dropbox/r-packages/", overwrite = TRUE) + unlink(f) +} + +#options(repos = c(RSM = "https://radiant-rstats.github.io/minicran")) +#install.packages("radiant.data", type = "binary") +# remove.packages(c("radiant.data", "radiant.model")) +#install.packages("radiant.update") +# radiant.update::radiant.update() diff --git a/radiant.multivariate/build/remove_screenshots.R b/radiant.multivariate/build/remove_screenshots.R new file mode 100644 index 0000000000000000000000000000000000000000..42b0c8f6c5f874fc91d57252c888c05d7ac63174 --- /dev/null +++ b/radiant.multivariate/build/remove_screenshots.R @@ -0,0 +1,18 @@ +## based on https://gist.github.com/mages/1544009 +cdir <- setwd(file.path(rstudioapi::getActiveProject(), "/inst/app/tools/help")) + +## remove all local png files +list.files("./figures/", pattern = "*.png") +unlink("figures/*.png") +check <- list.files("./figures/", pattern = "*.png") +stopifnot(length(check) == 0) +cat("--", file = "figures/place_holder.txt") + +fn <- list.files(pattern = "\\.(md|Rmd)$") +for (f in fn) { + org <- readLines(f) + changed <- gsub("figures_multivariate/", "https://radiant-rstats.github.io/docs/multivariate/figures_multivariate/", org) + cat(changed, file = f, sep = "\n") +} + +setwd(rstudioapi::getActiveProject()) diff --git a/radiant.multivariate/data/carpet.rda b/radiant.multivariate/data/carpet.rda new file mode 100644 index 0000000000000000000000000000000000000000..20712b848f5b30a6cf48df4cc081c30edc566bd0 Binary files /dev/null and b/radiant.multivariate/data/carpet.rda differ diff --git a/radiant.multivariate/data/city.rda b/radiant.multivariate/data/city.rda new file mode 100644 index 0000000000000000000000000000000000000000..cae336ad9d877b92f8ea3c6160039b2f3186f17e Binary files /dev/null and b/radiant.multivariate/data/city.rda differ diff --git a/radiant.multivariate/data/city2.rda b/radiant.multivariate/data/city2.rda new file mode 100644 index 0000000000000000000000000000000000000000..98388ab86cdab94d2ccce3b87e28c658b0c424d7 Binary files /dev/null and b/radiant.multivariate/data/city2.rda differ diff --git a/radiant.multivariate/data/computer.rda b/radiant.multivariate/data/computer.rda new file mode 100644 index 0000000000000000000000000000000000000000..42d4230516e22f0d3ff2e25aed60b2d79d0dcca4 Binary files /dev/null and b/radiant.multivariate/data/computer.rda differ diff --git a/radiant.multivariate/data/movie.rda b/radiant.multivariate/data/movie.rda new file mode 100644 index 0000000000000000000000000000000000000000..d2532ffbe8bcb4a1de7198c97c58932437e98d19 Binary files /dev/null and b/radiant.multivariate/data/movie.rda differ diff --git a/radiant.multivariate/data/mp3.rda b/radiant.multivariate/data/mp3.rda new file mode 100644 index 0000000000000000000000000000000000000000..d14cbed8d8679b585ff7b8d8aae13912754ea46b Binary files /dev/null and b/radiant.multivariate/data/mp3.rda differ diff --git a/radiant.multivariate/data/retailers.rda b/radiant.multivariate/data/retailers.rda new file mode 100644 index 0000000000000000000000000000000000000000..6ab0753425cd6a7a5b0ee1bf5ab9b04740edee93 Binary files /dev/null and b/radiant.multivariate/data/retailers.rda differ diff --git a/radiant.multivariate/data/shopping.rda b/radiant.multivariate/data/shopping.rda new file mode 100644 index 0000000000000000000000000000000000000000..06d537763b6383fa346c4f7a332bbbbfac8e6a74 Binary files /dev/null and b/radiant.multivariate/data/shopping.rda differ diff --git a/radiant.multivariate/data/toothpaste.rda b/radiant.multivariate/data/toothpaste.rda new file mode 100644 index 0000000000000000000000000000000000000000..1668b8e41b9b6eae014269a1ef5265e6da4478df Binary files /dev/null and b/radiant.multivariate/data/toothpaste.rda differ diff --git a/radiant.multivariate/data/tpbrands.rda b/radiant.multivariate/data/tpbrands.rda new file mode 100644 index 0000000000000000000000000000000000000000..f34612a03f95b8e1ac2f3df8849b23efd3867323 Binary files /dev/null and b/radiant.multivariate/data/tpbrands.rda differ diff --git a/radiant.multivariate/inst/app/global.R b/radiant.multivariate/inst/app/global.R new file mode 100644 index 0000000000000000000000000000000000000000..217d6ca422ef0249071c1121716c96b6e83d565f --- /dev/null +++ b/radiant.multivariate/inst/app/global.R @@ -0,0 +1,33 @@ +library(shiny.i18n) +# file with translations +i18n <- Translator$new(translation_csvs_path = "../translations") + +# change this to zh +i18n$set_translation_language("zh") + +## sourcing from radiant.data +options(radiant.path.data = system.file(package = "radiant.data")) +source(file.path(getOption("radiant.path.data"), "app/global.R"), encoding = getOption("radiant.encoding", default = "UTF-8"), local = TRUE) + +ifelse(grepl("radiant.multivariate", getwd()) && file.exists("../../inst"), "..", system.file(package = "radiant.multivariate")) %>% + options(radiant.path.multivariate = .) + +## setting path for figures in help files +addResourcePath("figures_multivariate", "tools/help/figures/") + +## setting path for www resources +addResourcePath("www_multivariate", file.path(getOption("radiant.path.multivariate"), "app/www/")) + +if (is.null(getOption("radiant.path.model"))) options(radiant.path.model = system.file(package = "radiant.model")) + +## loading urls and ui +source("init.R", encoding = getOption("radiant.encoding", "UTF-8"), local = TRUE) +options(radiant.url.patterns = make_url_patterns()) + +if (!"package:radiant.multivariate" %in% search() && + isTRUE(getOption("radiant.development")) && + getOption("radiant.path.multivariate") == "..") { + options(radiant.from.package = FALSE) +} else { + options(radiant.from.package = TRUE) +} diff --git a/radiant.multivariate/inst/app/help.R b/radiant.multivariate/inst/app/help.R new file mode 100644 index 0000000000000000000000000000000000000000..8053c1fe5434691381db392f3f56b51dcae4554f --- /dev/null +++ b/radiant.multivariate/inst/app/help.R @@ -0,0 +1,25 @@ +help_multivariate <- c( + "(Dis)similarity map" = "mds.md", "Attribute map" = "prmap.md", + "Pre-factor" = "pre_factor.md", "Factor" = "full_factor.md", + "Hierarchical clustering" = "hclus.md", "K-clustering" = "kclus.md", + "Conjoint" = "conjoint.md" +) + +output$help_multivariate <- reactive(append_help("help_multivariate", file.path(getOption("radiant.path.multivariate"), "app/tools/help/"))) +observeEvent(input$help_multivariate_all, { + help_switch(input$help_multivariate_all, "help_multivariate") +}) +observeEvent(input$help_multivariate_none, { + help_switch(input$help_multivariate_none, "help_multivariate", help_on = FALSE) +}) + +help_multivariate_panel <- tagList( + wellPanel( + HTML(""), + checkboxGroupInput( + "help_multivariate", NULL, help_multivariate, + selected = state_group("help_multivariate"), inline = TRUE + ) + ) +) diff --git a/radiant.multivariate/inst/app/init.R b/radiant.multivariate/inst/app/init.R new file mode 100644 index 0000000000000000000000000000000000000000..096793de831e441026964f152a828cfb4f9a7445 --- /dev/null +++ b/radiant.multivariate/inst/app/init.R @@ -0,0 +1,46 @@ +## urls for menu +r_url_list <- getOption("radiant.url.list") +r_url_list[["(Dis)similarity"]] <- + list("tabs_mds" = list("Summary" = "multivariate/mds/", "Plot" = "multivariate/mds/plot/")) +r_url_list[["Attributes"]] <- + list("tabs_prmap" = list("Summary" = "multivariate/prmap/", "Plot" = "multivariate/prmap/plot/")) +r_url_list[["Pre-factor"]] <- + list("tabs_pre_factor" = list("Summary" = "multivariate/pfactor/", "Plot" = "multivariate/pfactor/plot/")) +r_url_list[["Factor"]] <- + list("tabs_full_factor" = list("Summary" = "multivariate/factor/", "Plot" = "multivariate/factor/plot/")) +r_url_list[["Hierarchical clustering"]] <- "multivariate/hclus/" +r_url_list[["K-clustering"]] <- + list("tabs_kclus" = list("Summary" = "multivariate/kclus/", "Plot" = "multivariate/kclus/plot/")) +r_url_list[["Conjoint"]] <- + list("tabs_conjoint" = list( + "Summary" = "multivariate/conjoint/", + "Predict" = "multivariate/conjoint/predict/", + "Plot" = "multivariate/conjoint/plot/" + )) + +options(radiant.url.list = r_url_list) +rm(r_url_list) + +## design menu +options( + radiant.multivariate_ui = + tagList( + navbarMenu( + i18n$t("Multivariate"), + tags$head( + tags$script(src = "www_multivariate/js/store.js") + ), + i18n$t("Maps"), + tabPanel(i18n$t("(Dis)similarity"), uiOutput("mds")), + tabPanel(i18n$t("Attributes"), uiOutput("prmap")), + "----", i18n$t("Factor"), + tabPanel(i18n$t("Pre-factor"), uiOutput("pre_factor")), + tabPanel(i18n$t("Factor"), uiOutput("full_factor")), + "----", i18n$t("Cluster"), + tabPanel(i18n$t("Hierarchical"), uiOutput("hclus")), + tabPanel(i18n$t("K-clustering"), uiOutput("kclus")), + "----", i18n$t("Conjoint"), + tabPanel(i18n$t("Conjoint"), uiOutput("conjoint")) + ) + ) +) diff --git a/radiant.multivariate/inst/app/server.R b/radiant.multivariate/inst/app/server.R new file mode 100644 index 0000000000000000000000000000000000000000..435a3f1cb528d3bad2fe594c171f00e1effbe1ca --- /dev/null +++ b/radiant.multivariate/inst/app/server.R @@ -0,0 +1,59 @@ +if (isTRUE(getOption("radiant.from.package"))) { + library(radiant.multivariate) +} + +shinyServer(function(input, output, session) { + + ## source shared functions + source(file.path(getOption("radiant.path.data"), "app/init.R"), encoding = getOption("radiant.encoding"), local = TRUE) + source(file.path(getOption("radiant.path.data"), "app/radiant.R"), encoding = getOption("radiant.encoding"), local = TRUE) + source("help.R", encoding = getOption("radiant.encoding"), local = TRUE) + + ## help ui + output$help_multivariate_ui <- renderUI({ + sidebarLayout( + sidebarPanel( + help_data_panel, + help_multivariate_panel, + uiOutput("help_text"), + width = 3 + ), + mainPanel( + HTML(paste0("

    Select help files to show and search

    ")), + htmlOutput("help_data"), + htmlOutput("help_multivariate") + ) + ) + }) + + ## packages to use for example data + options(radiant.example.data = c("radiant.data", "radiant.multivariate")) + + ## source data & app tools from radiant.data + for (file in list.files( + c( + file.path(getOption("radiant.path.data"), "app/tools/app"), + file.path(getOption("radiant.path.data"), "app/tools/data") + ), + pattern = "\\.(r|R)$", full.names = TRUE + )) + source(file, encoding = getOption("radiant.encoding"), local = TRUE) + + ## 'sourcing' package functions in the server.R environment for development + if (!isTRUE(getOption("radiant.from.package"))) { + for (file in list.files("../../R", pattern = "\\.(r|R)$", full.names = TRUE)) { + source(file, encoding = getOption("radiant.encoding"), local = TRUE) + } + cat("\nGetting radiant.multivariate from source ...\n") + } + + copy_from(radiant.model, predict_model, print_predict_model) + source(file.path(getOption("radiant.path.model"), "app/radiant.R"), encoding = getOption("radiant.encoding"), local = TRUE) + + ## source analysis tools for multivariate menu + for (file in list.files(c("tools/analysis"), pattern = "\\.(r|R)$", full.names = TRUE)) + source(file, encoding = getOption("radiant.encoding"), local = TRUE) + + ## save state on refresh or browser close + saveStateOnRefresh(session) +}) diff --git a/radiant.multivariate/inst/app/tools/analysis/conjoint_ui.R b/radiant.multivariate/inst/app/tools/analysis/conjoint_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..66a8f06f045099c8e09e16f5c2d4740b9b6595a2 --- /dev/null +++ b/radiant.multivariate/inst/app/tools/analysis/conjoint_ui.R @@ -0,0 +1,746 @@ +################################################################ +# Conjoint +################################################################ +# 交互阶数 +ca_show_interactions <- c("", 2, 3) +names(ca_show_interactions) <- c(i18n$t("None"), i18n$t("2-way"), i18n$t("3-way")) + +# 预测输入类型 +ca_predict <- c("none", "data", "cmd", "datacmd") +names(ca_predict) <- c(i18n$t("None"), i18n$t("Data"), i18n$t("Command"), i18n$t("Data & Command")) + +# 绘图选项 +ca_plots <- list("none", "pw", "iw") +names(ca_plots) <- c(i18n$t("None"), i18n$t("Part-worths"), i18n$t("Importance-weights")) + +# list of function arguments +ca_args <- as.list(formals(conjoint)) + +# list of function inputs selected by user +ca_inputs <- reactive({ + # loop needed because reactive values don't allow single bracket indexing + ca_args$data_filter <- if (input$show_filter) input$data_filter else "" + ca_args$dataset <- input$dataset + for (i in r_drop(names(ca_args))) { + ca_args[[i]] <- input[[paste0("ca_", i)]] + } + ca_args +}) + +ca_sum_args <- as.list(if (exists("summary.conjoint")) { + formals(summary.conjoint) +} else { + formals(radiant.multivariate:::summary.conjoint) +}) + +## list of function inputs selected by user +ca_sum_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(ca_sum_args)) { + ca_sum_args[[i]] <- input[[paste0("ca_", i)]] + } + ca_sum_args +}) + +ca_plot_args <- as.list(if (exists("plot.conjoint")) { + formals(plot.conjoint) +} else { + formals(radiant.multivariate:::plot.conjoint) +}) + +## list of function inputs selected by user +ca_plot_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(ca_plot_args)) { + ca_plot_args[[i]] <- input[[paste0("ca_", i)]] + } + ca_plot_args +}) + +ca_pred_args <- as.list(if (exists("predict.conjoint")) { + formals(predict.conjoint) +} else { + formals(radiant.multivariate:::predict.conjoint) +}) + +## list of function inputs selected by user +ca_pred_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(ca_pred_args)) { + ca_pred_args[[i]] <- input[[paste0("ca_", i)]] + } + + ca_pred_args$pred_cmd <- ca_pred_args$pred_data <- "" + if (input$ca_predict == "cmd") { + ca_pred_args$pred_cmd <- gsub("\\s{2,}", " ", input$ca_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% + gsub("\"", "\'", .) + } else if (input$ca_predict == "data") { + ca_pred_args$pred_data <- input$ca_pred_data + } else if (input$ca_predict == "datacmd") { + ca_pred_args$pred_cmd <- gsub("\\s{2,}", " ", input$ca_pred_cmd) %>% + gsub(";\\s+", ";", .) %>% + gsub("\"", "\'", .) + ca_pred_args$pred_data <- input$ca_pred_data + } + ca_pred_args +}) + +ca_pred_plot_args <- as.list(if (exists("plot.model.predict")) { + formals(plot.model.predict) +} else { + formals(radiant.model:::plot.model.predict) +}) + +## list of function inputs selected by user +ca_pred_plot_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(ca_pred_plot_args)) { + ca_pred_plot_args[[i]] <- input[[paste0("ca_", i)]] + } + ca_pred_plot_args +}) + +output$ui_ca_rvar <- renderUI({ + isNum <- "numeric" == .get_class() | "integer" == .get_class() + vars <- varnames()[isNum] + selectInput( + inputId = "ca_rvar", label = i18n$t("Profile evaluations:"), choices = vars, + selected = state_single("ca_rvar", vars), multiple = FALSE + ) +}) + +output$ui_ca_evar <- renderUI({ + hasLevs <- .get_class() %in% c("factor", "logical", "character") + vars <- varnames()[hasLevs] + selectInput( + inputId = "ca_evar", label = i18n$t("Attributes:"), choices = vars, + selected = state_multiple("ca_evar", vars), multiple = TRUE, + size = min(10, length(vars)), selectize = FALSE + ) +}) + +output$ui_ca_show_interactions <- renderUI({ + choices <- ca_show_interactions[1:max(min(3, length(input$ca_evar)), 1)] + radioButtons( + inputId = "ca_show_interactions", label = i18n$t("Interactions:"), + choices = choices, selected = state_init("ca_show_interactions"), + inline = TRUE + ) +}) + +output$ui_ca_int <- renderUI({ + if (isolate("ca_show_interactions" %in% names(input)) && + is.empty(input$ca_show_interactions)) { + choices <- character(0) + } else if (is.empty(input$ca_show_interactions)) { + return() + } else { + vars <- input$ca_evar + if (not_available(vars) || length(vars) < 2) { + return() + } + ## list of interaction terms to show + choices <- iterms(vars, input$ca_show_interactions) + } + + selectInput( + "ca_int", + label = NULL, choices = choices, + selected = state_init("ca_int"), + multiple = TRUE, size = min(4, length(choices)), selectize = FALSE + ) +}) + + +output$ui_ca_by <- renderUI({ + vars <- c("None" = "none", varnames()) + selectInput( + inputId = "ca_by", label = i18n$t("By:"), choices = vars, + selected = state_single("ca_by", vars, "none"), multiple = FALSE + ) +}) + +output$ui_ca_show <- renderUI({ + levs <- c() + if (available(input$ca_by)) { + levs <- .get_data()[[input$ca_by]] %>% + as_factor() %>% + levels() + } + selectInput( + inputId = "ca_show", label = i18n$t("Show:"), choices = levs, + selected = state_single("ca_show", levs, levs[1]), multiple = FALSE + ) +}) + +## reset ca_show if needed +observeEvent(input$ca_by == "none" && !is.empty(input$ca_show), { + updateSelectInput(session = session, inputId = "ca_show", selected = NULL) +}) + +## reset prediction and plot settings when the dataset changes +observeEvent(input$dataset, { + updateSelectInput(session = session, inputId = "ca_predict", selected = "none") + updateSelectInput(session = session, inputId = "ca_plots", selected = "none") +}) + +## add a spinning refresh icon if the tabel needs to be (re)calculated +run_refresh(ca_args, "ca", init = "evar", tabs = "tabs_conjoint", label = i18n$t("Estimate model"), relabel = i18n$t("Re-estimate model")) + +output$ui_ca_store <- renderUI({ + req(input$ca_by != "none") + tagList( + HTML(paste0("")), + tags$table( + tags$td(textInput("ca_store_pw_name", NULL, "", placeholder = i18n$t("Provide data name"))), + tags$td(actionButton("ca_store_pw", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top_mini") + ), + tags$br(), + HTML(paste0("")), + tags$table( + tags$td(textInput("ca_store_iw_name", NULL, "", placeholder = i18n$t("Provide data name"))), + tags$td(actionButton("ca_store_iw", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top_mini") + ) + ) +}) + +output$ui_ca_store_pred <- renderUI({ + req(input$ca_predict != "none") + req(input$ca_by) + lab <- paste0("") + name <- "pred_ca" + if (input$ca_by != "none") { + lab <- sub(":", paste0(" ", i18n$t("in new dataset:"), ":"), lab) + name <- "" + } + + tags$table( + if (!input$ca_pred_plot) tags$br(), + HTML(lab), + tags$td(textInput("ca_store_pred_name", NULL, name, placeholder = i18n$t("Provide data name"))), + tags$td(actionButton("ca_store_pred", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top_mini") + ) +}) + +output$ui_ca_predict_plot <- renderUI({ + req(input$ca_by) + if (input$ca_by != "none") { + predict_plot_controls("ca", vars_color = input$ca_by, init_color = input$ca_by) + } else { + predict_plot_controls("ca") + } +}) + +output$ui_ca_pred_data <- renderUI({ + selectizeInput( + inputId = "ca_pred_data", label = i18n$t("Prediction data:"), + choices = c("None" = "", r_info[["datasetlist"]]), + selected = state_single("ca_pred_data", c("None" = "", r_info[["datasetlist"]])), + multiple = FALSE + ) +}) + +output$ui_conjoint <- renderUI({ + req(input$dataset) + tagList( + conditionalPanel( + condition = "input.tabs_conjoint == 'Summary'", + wellPanel( + actionButton("ca_run", i18n$t("Estimate model"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ) + ), + wellPanel( + conditionalPanel( + condition = "input.tabs_conjoint == 'Summary'", + uiOutput("ui_ca_rvar"), + uiOutput("ui_ca_evar"), + # uiOutput("ui_ca_show_interactions"), + # conditionalPanel(condition = "input.ca_show_interactions != ''", + # uiOutput("ui_ca_int") + # ), + uiOutput("ui_ca_by"), + conditionalPanel( + condition = "input.tabs_conjoint != 'Predict' & input.ca_by != 'none'", + uiOutput("ui_ca_show") + ), + conditionalPanel( + condition = "input.tabs_conjoint == 'Summary'", + uiOutput("ui_ca_store") + ), + conditionalPanel( + condition = "input.ca_evar != null", + checkboxInput( + "ca_reverse", + label = i18n$t("Reverse evaluation scores"), + value = state_init("ca_reverse", FALSE) + ), + conditionalPanel( + condition = "input.tabs_conjoint == 'Summary'", + checkboxInput( + inputId = "ca_additional", label = i18n$t("Additional regression output"), + value = state_init("ca_additional", FALSE) + ), + checkboxInput( + inputId = "ca_mc_diag", label = i18n$t("VIF"), + value = state_init("ca_mc_diag", FALSE) + ) + ) + ) + ), + conditionalPanel( + condition = "input.tabs_conjoint == 'Predict'", + selectInput( + "ca_predict", + label = i18n$t("Prediction input type:"), ca_predict, + selected = state_single("ca_predict", ca_predict, "none") + ), + conditionalPanel( + "input.ca_predict == 'data' | input.ca_predict == 'datacmd'", + uiOutput("ui_ca_pred_data") + ), + conditionalPanel( + "input.ca_predict == 'cmd' | input.ca_predict == 'datacmd'", + returnTextAreaInput( + "ca_pred_cmd", i18n$t("Prediction command:"), + value = state_init("ca_pred_cmd", "") + ) + ), + conditionalPanel( + condition = "input.ca_predict != 'none'", + checkboxInput("ca_pred_plot", i18n$t("Plot predictions"), state_init("ca_pred_plot", FALSE)), + conditionalPanel( + "input.ca_pred_plot == true", + uiOutput("ui_ca_predict_plot") + ) + ), + ## only show if a dataset is used for prediction or storing predictions 'by' + conditionalPanel( + "input.ca_predict == 'data' | input.ca_predict == 'datacmd' | input.ca_by != 'none'", + uiOutput("ui_ca_store_pred") + ) + ), + conditionalPanel( + condition = "input.tabs_conjoint == 'Plot'", + selectInput( + "ca_plots", i18n$t("Conjoint plots:"), + choices = ca_plots, + selected = state_single("ca_plots", ca_plots, "none") + ), + conditionalPanel( + condition = "input.ca_plots == 'pw'", + checkboxInput( + inputId = "ca_scale_plot", label = i18n$t("Scale PW plots"), + value = state_init("ca_scale_plot", FALSE) + ) + ) + ) + ), + help_and_report( + modal_title = i18n$t("Conjoint"), + fun_name = "conjoint", + help_file = inclMD(file.path(getOption("radiant.path.multivariate"), "app/tools/help/conjoint.md")) + ) + ) +}) + +ca_available <- reactive({ + if (not_pressed(input$ca_run)) { + i18n$t("** Press the Estimate button to run the conjoint analysis **") + } else if (not_available(input$ca_rvar)) { + i18n$t("This analysis requires a response variable of type integer\nor numeric and one or more explanatory variables.\nIf these variables are not available please select another dataset.") %>% + suggest_data("carpet") + } else if (not_available(input$ca_evar)) { + i18n$t("Please select one or more explanatory variables of type factor.\nIf none are available please choose another dataset") %>% + suggest_data("carpet") + } else { + "available" + } +}) + +ca_plot <- reactive({ + req(pressed(input$ca_run)) + if (ca_available() != "available") { + return() + } + req(input$ca_plots) + + nrVars <- length(input$ca_evar) + plot_height <- plot_width <- 500 + if (input$ca_plots == "pw") { + plot_height <- 325 * (1 + floor((nrVars - 1) / 2)) + plot_width <- 325 * min(nrVars, 2) + } + list(plot_width = plot_width, plot_height = plot_height) +}) + +ca_plot_width <- function() { + ca_plot() %>% + { + if (is.list(.)) .$plot_width else 650 + } +} + +ca_plot_height <- function() { + ca_plot() %>% + { + if (is.list(.)) .$plot_height else 400 + } +} + +ca_pred_plot_height <- function() { + if (input$ca_pred_plot) 500 else 0 +} + +output$conjoint <- renderUI({ + register_print_output("summary_conjoint", ".summary_conjoint") + register_print_output("predict_conjoint", ".predict_print_conjoint") + register_plot_output( + "predict_plot_conjoint", ".predict_plot_conjoint", + height_fun = "ca_pred_plot_height" + ) + register_plot_output( + "plot_conjoint", ".plot_conjoint", + height_fun = "ca_plot_height", + width_fun = "ca_plot_width" + ) + + ## three separate tabs + ca_output_panels <- tabsetPanel( + id = "tabs_conjoint", + tabPanel( + i18n$t("Summary"), value = "Summary", + download_link("dl_ca_PWs"), br(), + verbatimTextOutput("summary_conjoint") + ), + tabPanel( + i18n$t("Predict"), value = "Predict", + conditionalPanel( + "input.ca_pred_plot == true", + download_link("dlp_ca_pred"), + plotOutput("predict_plot_conjoint", width = "100%", height = "100%") + ), + download_link("dl_ca_pred"), br(), + verbatimTextOutput("predict_conjoint") + ), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_conjoint"), + plotOutput("plot_conjoint", width = "100%", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Multivariate > Conjoint"), + tool = i18n$t("Conjoint"), + tool_ui = "ui_conjoint", + output_panels = ca_output_panels + ) +}) + +.conjoint <- eventReactive(input$ca_run, { + req(available(input$ca_rvar), available(input$ca_evar)) + withProgress(message = i18n$t("Estimating model"), value = 1, { + cai <- ca_inputs() + cai$envir <- r_data + do.call(conjoint, cai) + }) +}) + +.summary_conjoint <- reactive({ + if (not_pressed(input$ca_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } + if (ca_available() != "available") { + return(ca_available()) + } + cai <- ca_sum_inputs() + cai$object <- .conjoint() + do.call(summary, cai) +}) + +.predict_conjoint <- reactive({ + if (not_pressed(input$ca_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } + if (ca_available() != "available") { + return(ca_available()) + } + if (is.empty(input$ca_predict, "none")) { + return(i18n$t("** Select prediction input **")) + } + if ((input$ca_predict == "data" || input$ca_predict == "datacmd") && is.empty(input$ca_pred_data)) { + return(i18n$t("** Select data for prediction **")) + } + if (input$ca_predict == "cmd" && is.empty(input$ca_pred_cmd)) { + return(i18n$t("** Enter prediction commands **")) + } + + withProgress(message = i18n$t("Generating predictions"), value = 1, { + cai <- ca_pred_inputs() + cai$object <- .conjoint() + cai$envir <- r_data + do.call(predict, cai) + }) +}) + +.predict_print_conjoint <- reactive({ + .predict_conjoint() %>% + { + if (is.character(.)) cat(., "\n") else print(.) + } +}) + +.predict_plot_conjoint <- reactive({ + if (not_pressed(input$ca_run)) { + return(invisible()) + } + if (ca_available() != "available") { + return(ca_available()) + } + req(input$ca_pred_plot, available(input$ca_xvar)) + if (is.empty(input$ca_predict, "none")) { + return(invisible()) + } + if ((input$ca_predict == "data" || input$ca_predict == "datacmd") && is.empty(input$ca_pred_data)) { + return(invisible()) + } + if (input$ca_predict == "cmd" && is.empty(input$ca_pred_cmd)) { + return(invisible()) + } + withProgress(message = "Generating prediction plot", value = 1, { + do.call(plot, c(list(x = .predict_conjoint()), ca_pred_plot_inputs())) + }) +}) + +.plot_conjoint <- reactive({ + if (not_pressed(input$ca_run)) { + return(i18n$t("** Press the Estimate button to estimate the model **")) + } else if (is.empty(input$ca_plots, "none")) { + return(i18n$t("Please select a conjoint plot from the drop-down menu")) + } + input$ca_scale_plot + input$ca_plots + isolate({ + if (ca_available() != "available") { + return(ca_available()) + } + withProgress(message = i18n$t("Generating plots"), value = 1, { + do.call(plot, c(list(x = .conjoint()), ca_plot_inputs(), shiny = TRUE)) + }) + }) +}) + +conjoint_report <- function() { + outputs <- c("summary") + inp_out <- list("", "") + inp_out[[1]] <- clean_args(ca_sum_inputs(), ca_sum_args[-1]) + figs <- FALSE + if (!is.empty(input$ca_plots, "none")) { + inp_out[[2]] <- clean_args(ca_plot_inputs(), ca_plot_args[-1]) + inp_out[[2]]$custom <- FALSE + outputs <- c(outputs, "plot") + figs <- TRUE + } + xcmd <- "" + + if (input$ca_by != "none") { + if (!is.empty(input$ca_store_pw_name)) { + fixed <- fix_names(input$ca_store_pw_name) + updateTextInput(session, "ca_store_pw_name", value = fixed) + xcmd <- glue('{xcmd}{fixed} <- result$PW\nregister("{fixed}")\n\n') + } + if (!is.empty(input$ca_store_iw_name)) { + fixed <- fix_names(input$ca_store_iw_name) + updateTextInput(session, "ca_store_iw_name", value = fixed) + xcmd <- glue('{xcmd}{fixed} <- result$IW\nregister("{fixed}")\n\n') + } + } + + if (!is.empty(input$ca_predict, "none") && + (!is.empty(input$ca_pred_data) || !is.empty(input$ca_pred_cmd))) { + pred_args <- clean_args(ca_pred_inputs(), ca_pred_args[-1]) + if (!is.empty(pred_args$pred_cmd)) { + pred_args$pred_cmd <- strsplit(pred_args$pred_cmd, ";\\s*")[[1]] + } else { + pred_args$pred_cmd <- NULL + } + + if (!is.empty(pred_args$pred_data)) { + pred_args$pred_data <- as.symbol(pred_args$pred_data) + } else { + pred_args$pred_data <- NULL + } + + inp_out[[2 + figs]] <- pred_args + fixed <- "pred" + if (!is.empty(input$ca_by, "none") && !is.empty(input$ca_store_pred_name)) { + fixed <- fix_names(input$ca_store_pred_name) + updateTextInput(session, "ca_store_pred_name", value = fixed) + outputs <- c(outputs, paste0(fixed, " <- predict")) + xcmd <- paste0(xcmd, fixed %>% paste0("register(\"", ., "\")\nprint(", ., ", n = 10)")) + } else { + outputs <- c(outputs, "pred <- predict") + xcmd <- paste0(xcmd, "print(pred, n = 10)") + if (input$ca_predict %in% c("data", "datacmd")) { + if (is.empty(input$ca_by, "none")) { + fixed <- unlist(strsplit(input$ca_store_pred_name, "(\\s*,\\s*|\\s*;\\s*)")) %>% + fix_names() %>% + deparse(., control = getOption("dctrl"), width.cutoff = 500L) + xcmd <- paste0( + xcmd, "\n", input$ca_pred_data, " <- store(", + input$ca_pred_data, ", pred, name = ", fixed, ")" + ) + } + } + } + + if (input$ca_pred_plot && !is.empty(input$ca_xvar)) { + inp_out[[3 + figs]] <- clean_args(ca_pred_plot_inputs(), ca_pred_plot_args[-1]) + inp_out[[3 + figs]]$result <- pred_args$pred_name + outputs <- c(outputs, "plot") + figs <- TRUE + } + } + update_report( + inp_main = clean_args(ca_inputs(), ca_args), + fun_name = "conjoint", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = ca_plot_width(), + fig.height = ca_plot_height(), + xcmd = xcmd + ) +} + +observeEvent(input$ca_store_pw, { + name <- input$ca_store_pw_name + req(pressed(input$ca_run), name) + fixed <- fix_names(input$ca_store_pw_name) + updateTextInput(session, "ca_store_pw_name", value = fixed) + robj <- .conjoint() + if (!is.list(robj)) { + return() + } + withProgress( + message = i18n$t("Storing PWs"), value = 1, + r_data[[fixed]] <- robj$PW + ) + register(fixed) +}) + +observeEvent(input$ca_store_iw, { + name <- input$ca_store_iw_name + req(pressed(input$ca_run), name) + fixed <- fix_names(input$ca_store_iw_name) + updateTextInput(session, "ca_store_iw_name", value = fixed) + robj <- .conjoint() + if (!is.list(robj)) { + return() + } + withProgress( + message = i18n$t("Storing IWs"), value = 1, + r_data[[fixed]] <- robj$IW + ) + register(fixed) +}) + +observeEvent(input$ca_store_pred, { + req(!is.empty(input$ca_pred_data), pressed(input$ca_run)) + pred <- .predict_conjoint() + if (is.null(pred)) { + return() + } + fixed <- fix_names(input$ca_store_pred_name) + updateTextInput(session, "ca_store_pred_name", value = fixed) + if ("conjoint.predict.by" %in% class(pred)) { + withProgress( + message = i18n$t("Storing predictions in new dataset"), value = 1, + r_data[[fixed]] <- pred, + ) + register(fixed) + } else { + withProgress( + message = i18n$t("Storing predictions"), value = 1, + r_data[[input$ca_pred_data]] <- radiant.model:::store.model.predict( + r_data[[input$ca_pred_data]], pred, + name = fixed + ) + ) + } +}) + +dl_ca_PWs <- function(path) { + if (pressed(input$ca_run)) { + if (is.empty(input$ca_show)) { + tab <- .conjoint()$model_list[["full"]]$tab + } else { + tab <- .conjoint()$model_list[[input$ca_show]]$tab + } + write.csv(tab$PW, file = path, row.names = FALSE) + } else { + cat(i18n$t("No output available. Press the Estimate button to generate results"), file = path) + } +} + +download_handler( + id = "dl_ca_PWs", + fun = dl_ca_PWs, + fn = function() paste0(input$dataset, "_PWs"), + type = "csv", + caption = i18n$t("Save part worths") +) + +dl_ca_pred <- function(path) { + if (pressed(input$ca_run)) { + write.csv(.predict_conjoint(), file = path, row.names = FALSE) + } else { + cat(i18n$t("No output available. Press the Estimate button to generate results"), file = path) + } +} + +download_handler( + id = "dl_ca_pred", + fun = dl_ca_pred, + fn = function() paste0(input$dataset, "_conjoint_pred"), + type = "csv", + caption = i18n$t("Save predictions") +) + +download_handler( + id = "dlp_ca_pred", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_conjoint_pred"), + type = "png", + caption = i18n$t("Save conjoint prediction plot"), + plot = .predict_plot_conjoint, + width = plot_width, + height = ca_pred_plot_height +) + +download_handler( + id = "dlp_conjoint", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_conjoint"), + type = "png", + caption = i18n$t("Save conjoint plot"), + plot = .plot_conjoint, + width = ca_plot_width, + height = ca_plot_height +) + +observeEvent(input$conjoint_report, { + r_info[["latest_screenshot"]] <- NULL + conjoint_report() +}) + +observeEvent(input$conjoint_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_conjoint_screenshot") +}) + +observeEvent(input$modal_conjoint_screenshot, { + conjoint_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.multivariate/inst/app/tools/analysis/full_factor_ui.R b/radiant.multivariate/inst/app/tools/analysis/full_factor_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..ce39f1c67f9b1bba1da4a9922c60f840560ad851 --- /dev/null +++ b/radiant.multivariate/inst/app/tools/analysis/full_factor_ui.R @@ -0,0 +1,330 @@ +# 方法（分开包裹，不用等号） +ff_method <- c("PCA", "maxlik") +names(ff_method) <- c(i18n$t("Principal components"), i18n$t("Maximum Likelihood")) + +# 旋转（分开包裹，不用等号） +ff_rotation <- c("none", "varimax", "quartimax", "equamax", "promax", "oblimin", "simplimax") +names(ff_rotation) <- c( + i18n$t("None"), + i18n$t("Varimax"), + i18n$t("Quartimax"), + i18n$t("Equamax"), + i18n$t("Promax"), + i18n$t("Oblimin"), + i18n$t("Simplimax") +) + +## list of function arguments +ff_args <- as.list(formals(full_factor)) + +## list of function inputs selected by user +ff_inputs <- reactive({ + ff_args$data_filter <- if (input$show_filter) input$data_filter else "" + ff_args$dataset <- input$dataset + ## loop needed because reactive values don't allow single bracket indexing + for (i in r_drop(names(ff_args))) { + ff_args[[i]] <- input[[paste0("ff_", i)]] + } + ff_args +}) + +############################### +# Factor analysis +############################### +output$ui_ff_vars <- renderUI({ + vars <- varnames() + toSelect <- .get_class() %in% c("numeric", "integer", "date", "factor") + vars <- vars[toSelect] + selectInput( + inputId = "ff_vars", label = i18n$t("Variables:"), choices = vars, + selected = state_multiple("ff_vars", vars, input$pf_vars), + multiple = TRUE, size = min(10, length(vars)), selectize = FALSE + ) +}) + +output$ui_ff_store_name <- renderUI({ + req(input$dataset) + textInput("ff_store_name", i18n$t("Store factor scores:"), "", placeholder = i18n$t("Provide single variable name")) +}) + +## add a spinning refresh icon if the tabel needs to be (re)calculated +run_refresh(ff_args, "ff", init = "vars", tabs = "tabs_full_factor", label = i18n$t("Estimate model"), relabel = i18n$t("Re-estimate model")) + +output$ui_full_factor <- renderUI({ + req(input$dataset) + tagList( + conditionalPanel( + condition = "input.tabs_full_factor == 'Plot'", + wellPanel( + checkboxGroupInput( + "ff_plots", NULL, { + ch <- c("resp", "attr") + names(ch) <- c(i18n$t("Respondents"), i18n$t("Attributes")) + ch + }, + selected = state_group("ff_plots", "attr"), + inline = TRUE + ) + # conditionalPanel( + # condition = "input.tabs_full_factor == 'Plot'", + # tags$table( + # tags$td(numericInput("ff_scaling", "Respondent scale:", state_init("ff_scaling", 0.5), .5, 4, .1, width = "117px")), + # tags$td(numericInput("ff_fontsz", "Font size:", state_init("ff_fontsz", 5), 1, 20, 1, width = "117px")), + # width = "100%" + # ) + # ) + ) + ), + conditionalPanel( + condition = "input.tabs_full_factor == 'Summary'", + wellPanel( + actionButton("ff_run", i18n$t("Estimate model"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ), + wellPanel( + uiOutput("ui_ff_vars"), + selectInput( + "ff_method", + label = i18n$t("Method:"), choices = ff_method, + selected = state_single("ff_method", ff_method, "PCA") + ), + checkboxInput("ff_hcor", i18n$t("Adjust for {factor} variables"), value = state_init("ff_hcor", FALSE)), + tags$table( + tags$td(numericInput("ff_nr_fact", label = i18n$t("Nr. of factors:"), min = 1, value = state_init("ff_nr_fact", 1))), + tags$td(numericInput("ff_cutoff", label = i18n$t("Cutt-off:"), min = 0, max = 1, value = state_init("ff_cutoff", 0), step = .05, width = "117px")) + ), + checkboxInput("ff_fsort", i18n$t("Sort factor loadings"), value = state_init("ff_fsort", FALSE)), + selectInput( + "ff_rotation", + label = i18n$t("rotation:"), ff_rotation, + selected = state_single("ff_rotation", ff_rotation, "varimax") + ), + conditionalPanel( + condition = "input.ff_vars != null", + tags$table( + # tags$td(textInput("ff_store_name", "Store scores:", state_init("ff_store_name", "factor"))), + tags$td(uiOutput("ui_ff_store_name")), + tags$td(actionButton("ff_store", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ) + ) + ), + help_and_report( + modal_title = i18n$t("Factor"), + fun_name = "full_factor", + help_file = inclMD(file.path(getOption("radiant.path.multivariate"), "app/tools/help/full_factor.md")) + ) + ) +}) + +ff_plot <- reactive({ + if (pressed(input$ff_run) && length(input$ff_vars) > 1 && + isolate(input$ff_nr_fact) > 1) { + plot_height <- plot_width <- 350 + nrFact <- min(isolate(input$ff_nr_fact), length(input$ff_vars)) + nrPlots <- (nrFact * (nrFact - 1)) / 2 + + if (nrPlots > 2) { + plot_height <- 350 * ceiling(nrPlots / 2) + } + + if (nrPlots > 1) { + plot_width <- 700 + } + } else { + plot_height <- plot_width <- 700 + } + list(plot_width = plot_width, plot_height = plot_height) +}) + +ff_plot_width <- function() { + ff_plot() %>% + { + if (is.list(.)) .$plot_width else 650 + } +} + +ff_plot_height <- function() { + ff_plot() %>% + { + if (is.list(.)) .$plot_height else 400 + } +} + +output$full_factor <- renderUI({ + register_print_output("summary_full_factor", ".summary_full_factor") + register_plot_output( + "plot_full_factor", ".plot_full_factor", + width_fun = "ff_plot_width", + height_fun = "ff_plot_height" + ) + + ff_output_panels <- tabsetPanel( + id = "tabs_full_factor", + tabPanel( + i18n$t("Summary"), value = "Summary", + download_link("dl_ff_loadings"), br(), + verbatimTextOutput("summary_full_factor") + ), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_full_factor"), + plotOutput("plot_full_factor", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Multivariate > Factor"), + tool = i18n$t("Factor"), + tool_ui = "ui_full_factor", + output_panels = ff_output_panels + ) +}) + +.ff_available <- reactive({ + if (not_pressed(input$ff_run)) { + i18n$t("** Press the Estimate button to generate factor analysis results **") + } else if (not_available(input$ff_vars)) { + i18n$t("This analysis requires multiple variables of type numeric or integer.\nIf these variables are not available please select another dataset.") %>% + suggest_data("toothpaste") + } else if (length(input$ff_vars) < 2) { + i18n$t("Please select two or more variables") + } else { + "available" + } +}) + +.full_factor <- eventReactive(input$ff_run, { + withProgress(message = i18n$t("Estimating factor solution"), value = 1, { + ffi <- ff_inputs() + ffi$envir <- r_data + do.call(full_factor, ffi) + }) +}) + +.summary_full_factor <- eventReactive( + { + c(input$ff_run, input$ff_cutoff, input$ff_fsort) + }, + { + if (not_pressed(input$ff_run)) { + return(i18n$t("** Press the Estimate button to generate factor analysis results **")) + } + if (.ff_available() != "available") { + return(.ff_available()) + } + if (is_not(input$ff_nr_fact)) { + return(i18n$t("Number of factors should be >= 1")) + } + validate( + need( + input$ff_cutoff >= 0 && input$ff_cutoff <= 1, + i18n$t("Provide a correlation cutoff value in the range from 0 to 1") + ) + ) + summary(.full_factor(), cutoff = input$ff_cutoff, fsort = input$ff_fsort) + } +) + +.plot_full_factor <- eventReactive( + { + c(input$ff_run, !is.null(input$ff_plots)) + }, + { + if (not_pressed(input$ff_run)) { + i18n$t("** Press the Estimate button to generate factor analysis results **") + } else if (.ff_available() != "available") { + .ff_available() + } else if (is_not(input$ff_nr_fact) || input$ff_nr_fact < 2) { + i18n$t("Plot requires 2 or more factors.\nChange the number of factors in the Summary tab and re-estimate") + } else { + withProgress(message = i18n$t("Generating factor plots"), value = 1, { + plot(.full_factor(), plots = input$ff_plots, shiny = TRUE) + }) + } + } +) + +full_factor_report <- function() { + outputs <- c("summary", "plot") + inp_out <- list(list(cutoff = input$ff_cutoff, fsort = input$ff_fsort, dec = 2), list(custom = FALSE)) + if (!is.empty(input$ff_store_name)) { + fixed <- fix_names(input$ff_store_name) + updateTextInput(session, "ff_store_name", value = fixed) + xcmd <- glue('{input$dataset} <- store({input$dataset}, result, name = "{fixed}")') + } else { + xcmd <- "" + } + + # xcmd <- paste0(xcmd, "# clean_loadings(result$floadings, cutoff = ", input$ff_cutoff, ", fsort = ", input$ff_fsort, ", dec = 8) %>%\n# write.csv(file = \"~/loadings.csv\")") + # xcmd <- paste0("# store(result, name = \"", input$ff_store_name, "\")\n# clean_loadings(result$floadings, cutoff = ", input$ff_cutoff, ", fsort = ", input$ff_fsort, ", dec = 8) %>% write.csv(file = \"~/loadings.csv\")") + + update_report( + inp_main = clean_args(ff_inputs(), ff_args), + fun_name = "full_factor", + inp_out = inp_out, + fig.width = ff_plot_width(), + fig.height = ff_plot_height(), + xcmd = xcmd + ) +} + +## store factor scores +observeEvent(input$ff_store, { + req(input$ff_store_name, input$ff_run) + fixed <- fix_names(input$ff_store_name) + updateTextInput(session, "ff_store_name", value = fixed) + robj <- .full_factor() + if (!is.character(robj)) { + withProgress( + message = i18n$t("Storing factor scores"), value = 1, + r_data[[input$dataset]] <- store(r_data[[input$dataset]], robj, name = fixed) + ) + } +}) + +dl_ff_loadings <- function(path) { + if (pressed(input$ff_run)) { + .full_factor() %>% + { + if (is.list(.)) .$floadings else return() + } %>% + clean_loadings(input$ff_cutoff, input$ff_fsort) %>% + write.csv(file = path) + } else { + cat(i18n$t("No output available. Press the Estimate button to generate factor loadings"), file = path) + } +} + +download_handler( + id = "dl_ff_loadings", + fun = dl_ff_loadings, + fn = function() paste0(input$dataset, "_loadings"), + type = "csv", + caption = i18n$t("Save factor loadings") +) + +download_handler( + id = "dlp_full_factor", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_factor"), + type = "png", + caption = i18n$t("Save factor plots"), + plot = .plot_full_factor, + width = ff_plot_width, + height = ff_plot_height +) + +observeEvent(input$full_factor_report, { + r_info[["latest_screenshot"]] <- NULL + full_factor_report() +}) + +observeEvent(input$full_factor_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_full_factor_screenshot") +}) + +observeEvent(input$modal_full_factor_screenshot, { + full_factor_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.multivariate/inst/app/tools/analysis/hclus_ui.R b/radiant.multivariate/inst/app/tools/analysis/hclus_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..528915cbf7b23ef1fb7831c4843d904d65c00618 --- /dev/null +++ b/radiant.multivariate/inst/app/tools/analysis/hclus_ui.R @@ -0,0 +1,329 @@ +hc_method <- { + v <- c("ward.D", "single", "complete", "average", "mcquitty", "median", "centroid") + names(v) <- c( + i18n$t("Ward's"), + i18n$t("Single"), + i18n$t("Complete"), + i18n$t("Average"), + i18n$t("McQuitty"), + i18n$t("Median"), + i18n$t("Centroid") + ) + v +} + +hc_distance <- { + v <- c("sq.euclidian", "binary", "canberra", "euclidean", "gower", "manhattan", "maximum", "minkowski") + names(v) <- c( + i18n$t("Squared euclidean"), + i18n$t("Binary"), + i18n$t("Canberra"), + i18n$t("Euclidian"), + i18n$t("Gower"), + i18n$t("Manhattan"), + i18n$t("Maximum"), + i18n$t("Minkowski") + ) + v +} + +hc_plots <- { + v <- c("scree", "change", "dendro") + names(v) <- c(i18n$t("Scree"), i18n$t("Change"), i18n$t("Dendrogram")) + v +} + +## list of function arguments +hc_args <- as.list(formals(hclus)) + +hc_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + hc_args$data_filter <- if (input$show_filter) input$data_filter else "" + hc_args$dataset <- input$dataset + for (i in r_drop(names(hc_args))) { + hc_args[[i]] <- input[[paste0("hc_", i)]] + } + hc_args +}) + + +############################################################### +# Hierarchical clustering +############################################################### + +output$ui_hc_vars <- renderUI({ + vars <- varnames() + toSelect <- .get_class() %in% c("numeric", "integer", "date", "factor") + vars <- vars[toSelect] + selectInput( + inputId = "hc_vars", label = i18n$t("Variables:"), choices = vars, + selected = state_multiple("hc_vars", vars), + multiple = TRUE, size = min(8, length(vars)), selectize = FALSE + ) +}) + +output$ui_hc_labels <- renderUI({ + vars <- c(None = "none", varnames()) + selectInput( + inputId = "hc_labels", label = i18n$t("Labels:"), choices = vars, + selected = state_single("hc_labels", vars, "none"), + multiple = FALSE + ) +}) + +observeEvent(c(input$hc_vars, input$hc_labels != "none"), { + req(input$hc_vars, input$hc_labels) + if (input$hc_labels %in% input$hc_vars) { + updateSelectInput(session, "hc_labels", selected = "none") + } +}) + +output$ui_hc_store_name <- renderUI({ + req(input$dataset) + textInput("hc_store_name", NULL, "", placeholder = i18n$t("Provide variable name")) +}) + +## add a spinning refresh icon if the tabel needs to be (re)calculated +run_refresh(hc_args, "hc", init = "vars", label = i18n$t("Estimate model"), relabel = i18n$t("Re-estimate model")) + +output$ui_hclus <- renderUI({ + req(input$dataset) + tagList( + wellPanel( + actionButton("hc_run", i18n$t("Estimate model"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ), + wellPanel( + uiOutput("ui_hc_labels"), + uiOutput("ui_hc_vars"), + selectInput( + "hc_distance", + label = i18n$t("Distance measure:"), choices = hc_distance, + selected = state_single("hc_distance", hc_distance, "sq.euclidean"), + multiple = FALSE + ), + selectInput( + "hc_method", + label = i18n$t("Method:"), choices = hc_method, + selected = state_single("hc_method", hc_method, "ward.D"), multiple = FALSE + ), + selectizeInput( + "hc_plots", + label = i18n$t("Plot(s):"), choices = hc_plots, + selected = state_multiple("hc_plots", hc_plots, c("scree", "change")), + multiple = TRUE, + options = list( + placeholder = i18n$t("Select plot(s)"), + plugins = list("remove_button", "drag_drop") + ) + ), + with(tags, table( + tr( + td(numericInput( + "hc_cutoff", i18n$t("Plot cutoff:"), + min = 0, max = 1, + value = state_init("hc_cutoff", 0.05), step = .02 + ), width = "50%"), + td(numericInput( + "hc_max_cases", i18n$t("Max cases:"), + min = 100, max = 100000, step = 100, + value = state_init("hc_max_cases", 5000) + ), width = "50%") + ), + width = "100%" + )), + checkboxInput("hc_standardize", i18n$t("Standardize"), state_init("hc_standardize", TRUE)) + ), + wellPanel( + conditionalPanel( + condition = "input.hc_vars != null", + numericInput( + "hc_nr_clus", i18n$t("Number of clusters:"), + min = 2, + value = state_init("hc_nr_clus", 2) + ), + HTML(paste0("")), + tags$table( + tags$td(uiOutput("ui_hc_store_name")), + tags$td(actionButton("hc_store", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top_mini") + ) + ) + ), + help_and_report( + modal_title = i18n$t("Hierarchical cluster analysis"), + fun_name = "hclus", + help_file = inclMD(file.path(getOption("radiant.path.multivariate"), "app/tools/help/hclus.md")) + ) + ) +}) + +## reset +observeEvent(input$hc_plots, { + if (length(input$hc_plots) > 1 && "dendro" %in% input$hc_plots) { + updateSelectInput(session = session, inputId = "hc_plots", selected = "dendro") + } +}) + +hc_plot <- reactive({ + plots <- input$hc_plots + req(plots) + ph <- plots %>% + { + if (length(.) == 1 && . == "dendro") 800 else 400 + } + pw <- if (!is.empty(plots) && length(plots) == 1 && plots == "dendro") 900 else 650 + list(plot_width = pw, plot_height = ph * length(plots)) +}) + +hc_plot_width <- function() { + hc_plot() %>% + { + if (is.list(.)) .$plot_width else 650 + } +} + +hc_plot_height <- function() { + hc_plot() %>% + { + if (is.list(.)) .$plot_height else 400 + } +} + +## output is called from the main radiant ui.R +output$hclus <- renderUI({ + register_print_output("summary_hclus", ".summary_hclus") + register_plot_output( + "plot_hclus", ".plot_hclus", + width_fun = "hc_plot_width", + height_fun = "hc_plot_height" + ) + + ## one output with components stacked + hc_output_panels <- tagList( + tabPanel(i18n$t("Summary"), value = "Summary", verbatimTextOutput("summary_hclus")), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_hclus"), + plotOutput("plot_hclus", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Multivariate > Cluster"), + tool = i18n$t("Hierarchical"), + tool_ui = "ui_hclus", + output_panels = hc_output_panels + ) +}) + +.hclus <- eventReactive(input$hc_run, { + req(input$hc_vars) + withProgress(message = i18n$t("Estimating cluster solution"), value = 1, { + hci <- hc_inputs() + hci$envir <- r_data + do.call(hclus, hci) + }) +}) + +.summary_hclus <- reactive({ + if (not_available(input$hc_vars)) { + i18n$t("This analysis requires one or more variables of type integer or numeric.\nIf these variable types are not available please select another dataset.") %>% + suggest_data("toothpaste") + } else if (not_pressed(input$hc_run)) { + i18n$t("** Press the Estimate button to generate cluster solution **") + } else { + summary(.hclus()) + } +}) + +.plot_hclus <- eventReactive( + { + c(input$hc_run, input$hc_plots, input$hc_cutoff) + }, + { + if (length(input$hc_plots) > 1 && "dendro" %in% input$hc_plots) { + invisible() + } else { + withProgress( + message = i18n$t("Generating cluster plot"), value = 1, + capture_plot(plot(.hclus(), plots = input$hc_plots, cutoff = input$hc_cutoff)) + ) + } + } +) + +hclus_report <- function() { + if (length(input$hc_plots) > 0) { + if (input$hc_cutoff != 0.05) { + inp_out <- list("", list(plots = input$hc_plots, cutoff = input$hc_cutoff, custom = FALSE)) + } else { + inp_out <- list("", list(plots = input$hc_plots, custom = FALSE)) + } + outputs <- c("summary", "plot") + figs <- TRUE + } else { + outputs <- c("summary") + inp_out <- list("", "") + figs <- FALSE + } + + if (!is.empty(input$hc_store_name)) { + fixed <- fix_names(input$hc_store_name) + updateTextInput(session, "hc_store_name", value = fixed) + nr_clus <- ifelse(is.empty(input$hc_nr_clus), 2, input$hc_nr_clus) + xcmd <- glue('{input$dataset} <- store({input$dataset}, result, nr_clus = {nr_clus}, name = "{fixed}")') + } else { + xcmd <- "" + } + + update_report( + inp_main = clean_args(hc_inputs(), hc_args), + fun_name = "hclus", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = hc_plot_width(), + fig.height = hc_plot_height(), + xcmd = xcmd + ) +} + +## store cluster membership +observeEvent(input$hc_store, { + req(input$hc_store_name, input$hc_run) + fixed <- fix_names(input$hc_store_name) + nr_clus <- ifelse(is.empty(input$hc_nr_clus), 2, input$hc_nr_clus) + updateTextInput(session, "hc_store_name", value = fixed) + robj <- .hclus() + if (!is.character(robj)) { + withProgress( + message = i18n$t("Storing cluster membership"), value = 1, + r_data[[input$dataset]] <- store(r_data[[input$dataset]], robj, nr_clus = nr_clus, name = fixed) + ) + } +}) + +download_handler( + id = "dlp_hclus", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_hclustering"), + type = "png", + caption = i18n$t("Save hierarchical cluster plots"), + plot = .plot_hclus, + width = hc_plot_width, + height = hc_plot_height +) + +observeEvent(input$hclus_report, { + r_info[["latest_screenshot"]] <- NULL + hclus_report() +}) + +observeEvent(input$hclus_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_hclus_screenshot") +}) + +observeEvent(input$modal_hclus_screenshot, { + hclus_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.multivariate/inst/app/tools/analysis/kclus_ui.R b/radiant.multivariate/inst/app/tools/analysis/kclus_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..b861dd7f89d3226e2122ea6475ac588cfedb0ce0 --- /dev/null +++ b/radiant.multivariate/inst/app/tools/analysis/kclus_ui.R @@ -0,0 +1,325 @@ +############################################################### +# K-clustering +############################################################### + +# 图类型（分开包裹，不用等号） +km_plots <- c("none", "density", "bar", "scatter") +names(km_plots) <- c(i18n$t("None"), i18n$t("Density"), i18n$t("Bar"), i18n$t("Scatter")) + +# 算法（分开包裹，不用等号） +km_algorithm <- c("kmeans", "kproto") +names(km_algorithm) <- c(i18n$t("K-means"), i18n$t("K-proto")) + +# list of function arguments +km_args <- as.list(formals(kclus)) + +km_inputs <- reactive({ + # loop needed because reactive values don't allow single bracket indexing + km_args$data_filter <- if (input$show_filter) input$data_filter else "" + km_args$dataset <- input$dataset + for (i in r_drop(names(km_args))) { + km_args[[i]] <- input[[paste0("km_", i)]] + } + km_args +}) + +output$ui_km_vars <- renderUI({ + sel <- .get_class() %in% c("integer", "numeric", "factor") + vars <- varnames()[sel] + selectInput( + inputId = "km_vars", label = i18n$t("Variables:"), choices = vars, + selected = state_multiple("km_vars", vars, input$hc_vars), + multiple = TRUE, size = min(8, length(vars)), selectize = FALSE + ) +}) + +output$ui_km_lambda <- renderUI({ + numericInput( + "km_lambda", i18n$t("Lambda:"), + min = 0, + value = state_init("km_lambda", NA) + ) +}) + +observeEvent(input$km_fun, { + if (input$km_fun == "kmeans") { + updateNumericInput(session = session, inputId = "km_lambda", value = NA) + } +}) + +observeEvent(input$dataset, { + updateSelectInput(session = session, inputId = "km_plots", selected = "none") +}) + +output$ui_km_store_name <- renderUI({ + req(input$dataset) + textInput("km_store_name", NULL, "", placeholder = i18n$t("Provide variable name")) +}) + +## add a spinning refresh icon if the tabel needs to be (re)calculated +run_refresh(km_args, "km", init = "vars", tabs = "tabs_kclus", label = i18n$t("Estimate model"), relabel = i18n$t("Re-estimate model")) + +output$ui_kclus <- renderUI({ + req(input$dataset) + tagList( + conditionalPanel( + condition = "input.tabs_kclus == 'Summary'", + wellPanel( + actionButton("km_run", i18n$t("Estimate model"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ) + ), + wellPanel( + conditionalPanel( + condition = "input.tabs_kclus == 'Summary'", + selectInput( + "km_fun", + label = i18n$t("Algorithm:"), choices = km_algorithm, + selected = state_single("km_fun", km_algorithm, "kmeans"), multiple = FALSE + ), + uiOutput("ui_km_vars"), + conditionalPanel( + condition = "input.km_fun == 'kproto'", + uiOutput("ui_km_lambda") + ), + checkboxInput("km_standardize", i18n$t("Standardize"), state_init("km_standardize", TRUE)), + checkboxInput( + inputId = "km_hc_init", label = i18n$t("Initial centers from HC"), + value = state_init("km_hc_init", FALSE) + ), + conditionalPanel( + condition = "input.km_hc_init == true", + wellPanel( + selectInput( + "km_distance", + label = i18n$t("Distance measure:"), choices = hc_distance, + selected = state_single("km_distance", hc_distance, "sq.euclidian"), multiple = FALSE + ), + selectInput( + "km_method", + label = i18n$t("Method:"), choices = hc_method, + selected = state_single("km_method", hc_method, "ward.D"), multiple = FALSE + ) + ) + ), + conditionalPanel( + condition = "input.km_hc_init == false", + numericInput( + "km_seed", i18n$t("Set random seed:"), + min = 0, + value = state_init("km_seed", 1234) + ) + ), + numericInput( + "km_nr_clus", i18n$t("Number of clusters:"), + min = 2, + value = state_init("km_nr_clus", 2) + ), + conditionalPanel( + condition = "input.km_vars != null", + # HTML(""), + tags$label(i18n$t("Store cluster membership:")), + tags$table( + tags$td(uiOutput("ui_km_store_name")), + tags$td(actionButton("km_store", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top_mini") + ) + ) + ), + conditionalPanel( + condition = "input.tabs_kclus == 'Plot'", + selectInput( + "km_plots", + label = i18n$t("Plot(s):"), choices = km_plots, + selected = state_multiple("km_plots", km_plots, "none"), + multiple = FALSE + ) + ) + ), + help_and_report( + modal_title = i18n$t("K-clustering"), + fun_name = "kclus", + help_file = inclMD(file.path(getOption("radiant.path.multivariate"), "app/tools/help/kclus.md")) + ) + ) +}) + +km_plot <- eventReactive(c(input$km_run, input$km_plots), { + if (.km_available() == "available" && !is.empty(input$km_plots, "none")) { + list(plot_width = 750, plot_height = 300 * ceiling(length(input$km_vars) / 2)) + } +}) + +km_plot_width <- function() { + km_plot() %>% + { + if (is.list(.)) .$plot_width else 650 + } +} + +km_plot_height <- function() { + km_plot() %>% + { + if (is.list(.)) .$plot_height else 400 + } +} + +# output is called from the main radiant ui.R +output$kclus <- renderUI({ + register_print_output("summary_kclus", ".summary_kclus") + register_plot_output( + "plot_kclus", ".plot_kclus", + width_fun = "km_plot_width", + height_fun = "km_plot_height" + ) + + km_output_panels <- tabsetPanel( + id = "tabs_kclus", + tabPanel( + i18n$t("Summary"), value = "Summary", + download_link("dl_km_means"), br(), + verbatimTextOutput("summary_kclus") + ), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_kclus"), + plotOutput("plot_kclus", width = "100%", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Multivariate > Cluster"), + tool = i18n$t("K-clustering"), + tool_ui = "ui_kclus", + output_panels = km_output_panels + ) +}) + +.km_available <- reactive({ + if (not_pressed(input$km_run)) { + i18n$t("** Press the Estimate button to generate the cluster solution **") + } else if (not_available(input$km_vars)) { + i18n$t("This analysis requires one or more variables of type numeric or integer.\nIf these variable types are not available please select another dataset.") %>% + suggest_data("toothpaste") + } else { + "available" + } +}) + +.kclus <- eventReactive(input$km_run, { + withProgress(message = i18n$t("Estimating cluster solution"), value = 1, { + kmi <- km_inputs() + kmi$envir <- r_data + do.call(kclus, kmi) + }) +}) + +.summary_kclus <- reactive({ + if (.km_available() != "available") { + return(.km_available()) + } + summary(.kclus()) +}) + +.plot_kclus <- eventReactive(c(input$km_run, input$km_plots), { + if (.km_available() != "available") { + .km_available() + } else if (is.empty(input$km_plots, "none")) { + i18n$t("Please select a plot type from the drop-down menu") + } else { + withProgress(message = i18n$t("Generating plots"), value = 1, { + plot(.kclus(), plots = input$km_plots, shiny = TRUE) + }) + } +}) + +kclus_report <- function() { + inp_out <- list(list(dec = 2), "") + if (!is.empty(input$km_plots, "none")) { + figs <- TRUE + outputs <- c("summary", "plot") + inp_out[[2]] <- list(plots = input$km_plots, custom = FALSE) + } else { + outputs <- c("summary") + figs <- FALSE + } + + if (!is.empty(input$km_store_name)) { + fixed <- fix_names(input$km_store_name) + updateTextInput(session, "km_store_name", value = fixed) + xcmd <- glue('{input$dataset} <- store({input$dataset}, result, name = "{fixed}")') + } else { + xcmd <- "" + } + + kmi <- km_inputs() + if (input$km_fun == "kmeans") kmi$lambda <- NULL + + update_report( + inp_main = clean_args(kmi, km_args), + fun_name = "kclus", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = km_plot_width(), + fig.height = km_plot_height(), + xcmd = xcmd + ) +} + +## store cluster membership +observeEvent(input$km_store, { + req(input$km_store_name, input$km_run) + fixed <- fix_names(input$km_store_name) + updateTextInput(session, "km_store_name", value = fixed) + robj <- .kclus() + if (!is.character(robj)) { + withProgress( + message = i18n$t("Storing cluster membership"), value = 1, + r_data[[input$dataset]] <- store(r_data[[input$dataset]], robj, name = fixed) + ) + } +}) + +dl_km_means <- function(path) { + if (pressed(input$km_run)) { + .kclus() %>% + { + if (is.list(.)) write.csv(.$clus_means, file = path) + } + } else { + cat(i18n$t("No output available. Press the Estimate button to generate the cluster solution"), file = path) + } +} + +download_handler( + id = "dl_km_means", + fun = dl_km_means, + fn = function() paste0(input$dataset, "_kclus"), + type = "csv", + caption = i18n$t("Save clustering results ") +) + +download_handler( + id = "dlp_kclus", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_kclustering"), + type = "png", + caption = i18n$t("Save k-cluster plots"), + plot = .plot_kclus, + width = km_plot_width, + height = km_plot_height +) + +observeEvent(input$kclus_report, { + r_info[["latest_screenshot"]] <- NULL + kclus_report() +}) + +observeEvent(input$kclus_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_kclus_screenshot") +}) + +observeEvent(input$modal_kclus_screenshot, { + kclus_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.multivariate/inst/app/tools/analysis/mds_ui.R b/radiant.multivariate/inst/app/tools/analysis/mds_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..96631d7363650b313297606c4d58765f14becf62 --- /dev/null +++ b/radiant.multivariate/inst/app/tools/analysis/mds_ui.R @@ -0,0 +1,274 @@ +############################### +# Multidimensional scaling +############################### +mds_nr_dim <- c(2, 3) +names(mds_nr_dim) <- c(i18n$t("2 dimensions"), i18n$t("3 dimensions")) + +# 方法选项（值=内部值；显示名通过 names() + i18n$t） +mds_method <- c("metric", "non-metric") +names(mds_method) <- c(i18n$t("metric"), i18n$t("non-metric")) + +## list of function arguments +mds_args <- as.list(formals(mds)) + +## list of function inputs selected by user +mds_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + mds_args$data_filter <- if (input$show_filter) input$data_filter else "" + mds_args$dataset <- input$dataset + for (i in r_drop(names(mds_args))) { + mds_args[[i]] <- input[[paste0("mds_", i)]] + } + mds_args +}) + +mds_plot_args <- as.list(if (exists("plot.mds")) { + formals(plot.mds) +} else { + formals(radiant.multivariate:::plot.mds) +}) + +## list of function inputs selected by user +mds_plot_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(mds_plot_args)) { + mds_plot_args[[i]] <- input[[paste0("mds_", i)]] + } + mds_plot_args +}) + +output$ui_mds_id1 <- renderUI({ + isLabel <- "character" == .get_class() | "factor" == .get_class() + vars <- varnames()[isLabel] + selectInput( + inputId = "mds_id1", label = i18n$t("ID 1:"), choices = vars, + selected = state_single("mds_id1", vars), multiple = FALSE + ) +}) + +output$ui_mds_id2 <- renderUI({ + isLabel <- "character" == .get_class() | "factor" == .get_class() + vars <- varnames()[isLabel] + if (length(vars) > 0) vars <- vars[-which(vars == input$mds_id1)] + selectInput( + inputId = "mds_id2", label = i18n$t("ID 2:"), choices = vars, + selected = state_single("mds_id2", vars), multiple = FALSE + ) +}) + +output$ui_mds_dis <- renderUI({ + isNum <- "numeric" == .get_class() | "integer" == .get_class() + vars <- varnames()[isNum] + selectInput( + inputId = "mds_dis", label = i18n$t("Dissimilarity:"), choices = vars, + selected = state_single("mds_dis", vars), multiple = FALSE + ) +}) + +output$ui_mds_rev_dim <- renderUI({ + # req(input$mds_nr_dim, input$mds_fontsz) + rev_list <- list() + # nr_dim <- ncol(.get_data()) + rev_list[paste("dimension", 1:input$mds_nr_dim)] <- 1:input$mds_nr_dim + checkboxGroupInput( + "mds_rev_dim", i18n$t("Reverse:"), rev_list, + selected = state_group("mds_rev_dim", ""), + inline = TRUE + ) +}) + +## add a spinning refresh icon if the map needs to be (re)created +run_refresh(mds_args, "mds", init = "id1", tabs = "tabs_mds", label = i18n$t("Estimate model"), relabel = i18n$t("Re-estimate model")) + +output$ui_mds <- renderUI({ + req(input$dataset) + tagList( + conditionalPanel( + condition = "input.tabs_mds == 'Summary'", + wellPanel( + actionButton("mds_run", i18n$t("Estimate model"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ) + ), + wellPanel( + conditionalPanel( + condition = "input.tabs_mds == 'Summary'", + uiOutput("ui_mds_id1"), + uiOutput("ui_mds_id2"), + uiOutput("ui_mds_dis"), + radioButtons( + inputId = "mds_method", label = NULL, mds_method, + selected = state_init("mds_method", "metric"), + inline = TRUE + ), + radioButtons( + inputId = "mds_nr_dim", label = NULL, mds_nr_dim, + selected = state_init("mds_nr_dim", 2), + inline = TRUE + ) + ), + conditionalPanel( + condition = "input.tabs_mds == 'Plot'", + numericInput("mds_fontsz", i18n$t("Font size:"), state_init("mds_fontsz", 5), 1, 30, 1), + uiOutput("ui_mds_rev_dim") + ) + ), + help_and_report( + modal_title = i18n$t("(Dis)similarity based brand maps (MDS)"), + fun_name = "mds", + help_file = inclMD(file.path(getOption("radiant.path.multivariate"), "app/tools/help/mds.md")) + ) + ) +}) + +mds_plot <- eventReactive(input$mds_run, { + req(input$mds_nr_dim) + nrDim <- .mds() %>% + (function(x) if (is.list(x)) ncol(x$res$points) else as.numeric(input$mds_nr_dim)) + nrPlots <- (nrDim * (nrDim - 1)) / 2 + list(plot_width = 650, plot_height = 650 * nrPlots) +}) + +mds_plot_width <- function() { + mds_plot() %>% + (function(x) if (is.list(x)) x$plot_width else 650) +} + +mds_plot_height <- function() { + mds_plot() %>% + (function(x) if (is.list(x)) x$plot_height else 650) +} + +output$mds <- renderUI({ + register_print_output("summary_mds", ".summary_mds") + register_plot_output( + "plot_mds", ".plot_mds", + width_fun = "mds_plot_width", + height_fun = "mds_plot_height" + ) + + mds_output_panels <- tabsetPanel( + id = "tabs_mds", + tabPanel( + i18n$t("Summary"), value = "Summary", + download_link("dl_mds_coord"), br(), + verbatimTextOutput("summary_mds") + ), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_mds"), + plotOutput("plot_mds", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Multivariate > Maps"), + tool = i18n$t("(Dis)similarity"), + tool_ui = "ui_mds", + output_panels = mds_output_panels + ) +}) + +.mds_available <- reactive({ + if (not_pressed(input$mds_run)) { + i18n$t("** Press the Estimate button to generate maps **") + } else if (not_available(input$mds_id1) || not_available(input$mds_id2) || not_available(input$mds_dis)) { + i18n$t("This analysis requires two id-variables of type character or factor and a measure\nof dissimilarity of type numeric or interval. Please select another dataset") %>% + suggest_data("city") + } else { + "available" + } +}) + +.mds <- eventReactive(input$mds_run, { + req(input$mds_id1) + withProgress(message = i18n$t("Generating MDS solution"), value = 1, { + mdsi <- mds_inputs() + mdsi$envir <- r_data + do.call(mds, mdsi) + }) +}) + +.summary_mds <- reactive({ + if (.mds_available() != "available") { + return(.mds_available()) + } + .mds() %>% + { + if (is.character(.)) . else summary(., dec = 2) + } +}) + +.plot_mds <- reactive({ + if (.mds_available() != "available") { + return(.mds_available()) + } + req("mds_rev_dim" %in% names(input)) + robj <- .mds() + if (is.character(robj)) { + return(robj) + } + withProgress(message = i18n$t("Generating brand maps"), value = 1, { + do.call(plot, c(list(x = robj), mds_plot_inputs(), shiny = TRUE)) + }) +}) + +mds_report <- function() { + outputs <- c("summary", "plot") + inp_out <- list(list(dec = 2), "") + inp <- mds_inputs() + inp$nr_dim <- as.integer(inp$nr_dim) + mpi <- mds_plot_inputs() + if (length(mpi$rev_dim) > 0) mpi$rev_dim <- as.integer(mpi$rev_dim) + inp_out[[2]] <- clean_args(mpi, mds_plot_args[-1]) + update_report( + inp_main = clean_args(inp, mds_args), + fun_name = "mds", + inp_out = inp_out, + fig.width = mds_plot_width(), + fig.height = mds_plot_height() + ) +} + +dl_mds_coord <- function(path) { + if (pressed(input$mds_run)) { + .mds()$res$points %>% + (function(x) set_colnames(x, paste0("Dimension", 1:ncol(x)))) %>% + write.csv(file = path, row.names = FALSE) + } else { + cat(i18n$t("No output available. Press the Estimate button to generate results"), file = path) + } +} + +download_handler( + id = "dl_mds_coord", + fun = dl_mds_coord, + fn = function() paste0(input$dataset, "_mds_coordinates"), + type = "csv", + caption = i18n$t("Save MDS coordinates") +) + +download_handler( + id = "dlp_mds", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_mds"), + type = "png", + caption = i18n$t("Save MDS plot"), + plot = .plot_mds, + width = mds_plot_width, + height = mds_plot_height +) + +observeEvent(input$mds_report, { + r_info[["latest_screenshot"]] <- NULL + mds_report() +}) + +observeEvent(input$mds_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_mds_screenshot") +}) + +observeEvent(input$modal_mds_screenshot, { + mds_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.multivariate/inst/app/tools/analysis/pre_factor_ui.R b/radiant.multivariate/inst/app/tools/analysis/pre_factor_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..1843354a584e6d06a8a2f3561bb0ac9b6606440a --- /dev/null +++ b/radiant.multivariate/inst/app/tools/analysis/pre_factor_ui.R @@ -0,0 +1,200 @@ +############################### +# Pre-factor analysis +############################### + +pf_plots <- c("scree", "change") +names(pf_plots) <- c(i18n$t("Scree"), i18n$t("Change")) + +## list of function arguments +pf_args <- as.list(formals(pre_factor)) + +## list of function inputs selected by user +pf_inputs <- reactive({ + pf_args$data_filter <- if (input$show_filter) input$data_filter else "" + pf_args$dataset <- input$dataset + ## loop needed because reactive values don't allow single bracket indexing + for (i in r_drop(names(pf_args))) { + pf_args[[i]] <- input[[paste0("pf_", i)]] + } + pf_args +}) + +output$ui_pf_vars <- renderUI({ + vars <- varnames() + toSelect <- .get_class() %in% c("numeric", "integer", "date", "factor") + vars <- vars[toSelect] + selectInput( + inputId = "pf_vars", label = i18n$t("Variables:"), choices = vars, + selected = state_multiple("pf_vars", vars), + multiple = TRUE, size = min(15, length(vars)), selectize = FALSE + ) +}) + +## add a spinning refresh icon if the factors need to be updated +run_refresh(pf_args, "pf", init = "vars", tabs = "tabs_pre_factor", label = i18n$t("Estimate model"), relabel = i18n$t("Re-estimate model")) + +output$ui_pre_factor <- renderUI({ + req(input$dataset) + tagList( + conditionalPanel( + condition = "input.tabs_pre_factor == 'Summary'", + wellPanel( + actionButton("pf_run", i18n$t("Estimate model"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ) + ), + wellPanel( + conditionalPanel( + condition = "input.tabs_pre_factor == 'Summary'", + uiOutput("ui_pf_vars"), + checkboxInput("pf_hcor", i18n$t("Adjust for {factor} variables"), value = state_init("pf_hcor", FALSE)), + ), + conditionalPanel( + condition = "input.tabs_pre_factor == 'Plot'", + selectizeInput( + "pf_plots", + label = i18n$t("Plot(s):"), choices = pf_plots, + selected = state_multiple("pf_plots", pf_plots, c("scree", "change")), + multiple = TRUE, + options = list( + placeholder = i18n$t("Select plot(s)"), + plugins = list("remove_button", "drag_drop") + ) + ), + numericInput("pf_cutoff", i18n$t("Plot cutoff:"), min = 0, max = 2, value = state_init("pf_cutoff", 0.1), step = .05) + ) + ), + help_and_report( + modal_title = i18n$t("Pre-factor analysis"), + fun_name = "pre_factor", + help_file = inclMD(file.path(getOption("radiant.path.multivariate"), "app/tools/help/pre_factor.md")) + ) + ) +}) + +# pf_plot <- reactive({ +pf_plot <- eventReactive(input$pf_plots, { + list(plot_width = 600, plot_height = length(input$pf_plots) * 400) +}) + +pf_plot_width <- function() { + pf_plot() %>% + { + if (is.list(.)) .$plot_width else 600 + } +} + +pf_plot_height <- function() { + pf_plot() %>% + { + if (is.list(.)) .$plot_height else 400 + } +} + +output$pre_factor <- renderUI({ + register_print_output("summary_pre_factor", ".summary_pre_factor") + register_plot_output( + "plot_pre_factor", ".plot_pre_factor", + width_fun = "pf_plot_width", + height_fun = "pf_plot_height" + ) + + ## two outputs in a summary and plot tab + pf_output_panels <- tabsetPanel( + id = "tabs_pre_factor", + tabPanel(i18n$t("Summary"), value = "Summary", verbatimTextOutput("summary_pre_factor")), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_pre_factor"), + plotOutput("plot_pre_factor", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Multivariate > Factor"), + tool = i18n$t("Pre-factor"), + tool_ui = "ui_pre_factor", + output_panels = pf_output_panels + ) +}) + +.pre_factor <- eventReactive(input$pf_run, { + withProgress(message = i18n$t("Estimating factor solution"), value = 1, { + pfi <- pf_inputs() + pfi$envir <- r_data + do.call(pre_factor, pfi) + }) +}) + +.summary_pre_factor <- reactive({ + if (not_pressed(input$pf_run)) { + return(i18n$t("** Press the Estimate button to generate factor analysis diagnostics **")) + } + isolate({ + if (not_available(input$pf_vars)) { + return(i18n$t("This analysis requires multiple variables of type numeric or integer.\nIf these variables are not available please select another dataset.") %>% suggest_data("toothpaste")) + } else if (length(input$pf_vars) < 2) { + return(i18n$t("Please select two or more numeric variables")) + } + }) + summary(.pre_factor()) +}) + +.plot_pre_factor <- eventReactive(c(input$pf_run, input$pf_plots), { + if (not_available(input$pf_vars)) { + i18n$t("This analysis requires multiple variables of type numeric or integer.\nIf these variables are not available please select another dataset.") %>% + suggest_data("toothpaste") + } else if (length(input$pf_vars) < 2) { + i18n$t("Please select two or more numeric variables\nin the Summary tab and re-estimate the model") + } else { + withProgress(message = i18n$t("Generating factor plots"), value = 1, { + plot(.pre_factor(), plots = input$pf_plots, cutoff = input$pf_cutoff, shiny = TRUE) + }) + } +}) + +pre_factor_report <- function() { + inp_out <- list(list(dec = 2), "") + if (length(input$pf_plots) > 0) { + figs <- TRUE + outputs <- c("summary", "plot") + inp_out[[2]] <- list(plots = input$pf_plots, custom = FALSE) + } else { + outputs <- c("summary") + figs <- FALSE + } + update_report( + inp_main = clean_args(pf_inputs(), pf_args), + fun_name = "pre_factor", + inp_out = inp_out, + outputs = outputs, + figs = figs, + fig.width = pf_plot_width(), + fig.height = pf_plot_height() + ) +} + +download_handler( + id = "dlp_pre_factor", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_pre_factor"), + type = "png", + caption = i18n$t("Save pre-factor plot"), + plot = .plot_pre_factor, + width = pf_plot_width, + height = pf_plot_height +) + +observeEvent(input$pre_factor_report, { + r_info[["latest_screenshot"]] <- NULL + pre_factor_report() +}) + +observeEvent(input$pre_factor_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_pre_factor_screenshot") +}) + +observeEvent(input$modal_pre_factor_screenshot, { + pre_factor_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.multivariate/inst/app/tools/analysis/prmap_ui.R b/radiant.multivariate/inst/app/tools/analysis/prmap_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..f940fb29a885d36d27571bc409d7b5bf20f692c5 --- /dev/null +++ b/radiant.multivariate/inst/app/tools/analysis/prmap_ui.R @@ -0,0 +1,339 @@ +######################################### +# Perceptual map using factor analysis +######################################### +pm_nr_dim <- c(2, 3) +names(pm_nr_dim) <- c(i18n$t("2 dimensions"), i18n$t("3 dimensions")) + +## list of function arguments +pm_args <- as.list(formals(prmap)) + +## list of function inputs selected by user +pm_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + pm_args$data_filter <- if (input$show_filter) input$data_filter else "" + pm_args$dataset <- input$dataset + for (i in r_drop(names(pm_args))) { + pm_args[[i]] <- input[[paste0("pm_", i)]] + } + pm_args +}) + +pm_plot_args <- as.list(if (exists("plot.prmap")) { + formals(plot.prmap) +} else { + formals(radiant.multivariate:::plot.prmap) +}) + +## list of function inputs selected by user +pm_plot_inputs <- reactive({ + ## loop needed because reactive values don't allow single bracket indexing + for (i in names(pm_plot_args)) { + pm_plot_args[[i]] <- input[[paste0("pm_", i)]] + } + pm_plot_args +}) + +output$ui_pm_brand <- renderUI({ + isLabel <- "character" == .get_class() | "factor" == .get_class() + vars <- varnames()[isLabel] + selectInput( + inputId = "pm_brand", label = i18n$t("Brand:"), choices = vars, + selected = state_single("pm_brand", vars), multiple = FALSE + ) +}) + +output$ui_pm_attr <- renderUI({ + vars <- varnames() + ## can't get valid factor scores with PCA and {factor} variables + # toSelect <- .get_class() %in% c("numeric", "integer", "date", "factor") + toSelect <- .get_class() %in% c("numeric", "integer", "date") + vars <- vars[toSelect] + selectInput( + inputId = "pm_attr", label = i18n$t("Attributes:"), choices = vars, + selected = state_multiple("pm_attr", vars), multiple = TRUE, + size = min(10, length(vars)), selectize = FALSE + ) +}) + +output$ui_pm_pref <- renderUI({ + if (not_available(input$pm_attr)) { + return() + } + vars <- varnames() + toSelect <- .get_class() %in% c("numeric", "integer", "date", "factor") + vars <- vars[toSelect] + if (length(vars) > 0) vars <- vars[-which(vars %in% c(input$pm_brand, input$pm_attr))] + selectInput( + inputId = "pm_pref", label = i18n$t("Preferences:"), choices = vars, + selected = state_multiple("pm_pref", vars), multiple = TRUE, + size = max(1, min(5, length(vars))), selectize = FALSE + ) +}) + +output$ui_pm_plots <- renderUI({ + plot_list <- c("brand", "attr") + names(plot_list) <- c(i18n$t("Brands"), i18n$t("Attributes")) + if (!is.empty(input$pm_pref)) { + plot_list <- c(plot_list, "pref") + names(plot_list)[length(plot_list)] <- i18n$t("Preferences") + } + checkboxGroupInput( + "pm_plots", NULL, plot_list, + selected = state_group("pm_plots"), + inline = TRUE + ) +}) + +output$ui_pm_store_name <- renderUI({ + req(input$dataset) + textInput("pm_store_name", i18n$t("Store factor scores:"), "", placeholder = i18n$t("Provide single variable name")) +}) + +## add a spinning refresh icon if the factors need to be updated +run_refresh(pm_args, "pm", init = "attr", tabs = "tabs_prmap", label = i18n$t("Estimate model"), relabel = i18n$t("Re-estimate model")) + +output$ui_prmap <- renderUI({ + req(input$dataset) + tagList( + conditionalPanel( + condition = "input.tabs_prmap == 'Summary'", + wellPanel( + actionButton("pm_run", i18n$t("Estimate model"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") + ) + ), + wellPanel( + conditionalPanel( + condition = "input.tabs_prmap == 'Summary'", + uiOutput("ui_pm_brand"), + uiOutput("ui_pm_attr"), + uiOutput("ui_pm_pref"), + radioButtons( + inputId = "pm_nr_dim", label = NULL, pm_nr_dim, + selected = state_init("pm_nr_dim", 2), + inline = TRUE + ), + # checkboxInput("pm_hcor", "Adjust for {factor} variables", value = state_init("pm_hcor", FALSE)), + numericInput( + "pm_cutoff", + label = i18n$t("Loadings cutoff:"), min = 0, + max = 1, state_init("pm_cutoff", 0), step = .05 + ), + conditionalPanel( + condition = "input.pm_attr != null", + tags$table( + tags$td(uiOutput("ui_pm_store_name")), + tags$td(actionButton("pm_store", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top") + ) + ) + ), + conditionalPanel( + condition = "input.tabs_prmap == 'Plot'", + uiOutput("ui_pm_plots"), + tags$table( + tags$td(numericInput("pm_scaling", i18n$t("Attribute scale:"), state_init("pm_scaling", 2), .5, 4, .1, width = "117px")), + tags$td(numericInput("pm_fontsz", i18n$t("Font size:"), state_init("pm_fontsz", 5), 1, 20, 1, width = "117px")), + width = "100%" + ) + ) + ), + help_and_report( + modal_title = i18n$t("Attribute based brand maps"), + fun_name = "prmap", + help_file = inclMD(file.path(getOption("radiant.path.multivariate"), "app/tools/help/prmap.md")) + ) + ) +}) + +pm_plot <- eventReactive(input$pm_run, { + req(input$pm_nr_dim) + nrDim <- as.numeric(input$pm_nr_dim) + nrPlots <- (nrDim * (nrDim - 1)) / 2 + list(plot_width = 650, plot_height = 650 * nrPlots) +}) + +pm_plot_width <- function() { + pm_plot() %>% + { + if (is.list(.)) .$plot_width else 650 + } +} + +pm_plot_height <- function() { + pm_plot() %>% + { + if (is.list(.)) .$plot_height else 650 + } +} + +output$prmap <- renderUI({ + register_print_output("summary_prmap", ".summary_prmap") + register_plot_output( + "plot_prmap", ".plot_prmap", + width_fun = "pm_plot_width", + height_fun = "pm_plot_height" + ) + + pm_output_panels <- tabsetPanel( + id = "tabs_prmap", + tabPanel( + i18n$t("Summary"), value = "Summary", + download_link("dl_pm_loadings"), br(), + verbatimTextOutput("summary_prmap") + ), + tabPanel( + i18n$t("Plot"), value = "Plot", + download_link("dlp_prmap"), + plotOutput("plot_prmap", height = "100%") + ) + ) + + stat_tab_panel( + menu = i18n$t("Multivariate > Maps"), + tool = i18n$t("Attributes"), + tool_ui = "ui_prmap", + output_panels = pm_output_panels + ) +}) + +.prmap_available <- reactive({ + if (not_pressed(input$pm_run)) { + i18n$t("** Press the Estimate button to generate perceptual maps **") + } else if (not_available(input$pm_brand) || not_available(input$pm_attr)) { + i18n$t("This analysis requires a brand variable of type factor or character and multiple attribute variables\nof type numeric or integer. If these variables are not available please select another dataset.") %>% + suggest_data("retailers") + } else if (length(input$pm_attr) < 2) { + i18n$t("Please select two or more attribute variables") + } else { + # brand <- .get_data()[[input$pm_brand]] + # if (length(unique(brand)) < length(brand)) { + # "Number of observations and unique IDs for the brand variable do not match.\nPlease choose another brand variable or another dataset.\n\n" %>% + # suggest_data("retailers") + # } else { + "available" + # } + } +}) + +.prmap <- eventReactive(input$pm_run, { + withProgress(message = i18n$t("Generating perceptual map"), value = 1, { + pmi <- pm_inputs() + pmi$envir <- r_data + do.call(prmap, pmi) + }) +}) + +.summary_prmap <- reactive({ + if (.prmap_available() != "available") { + return(.prmap_available()) + } + validate( + need( + input$pm_cutoff >= 0 && input$pm_cutoff <= 1, + i18n$t("Provide a correlation cutoff value in the range from 0 to 1") + ) + ) + summary(.prmap(), cutoff = input$pm_cutoff) +}) + +.plot_prmap <- eventReactive( + { + c(input$pm_run, pm_plot_inputs()) + }, + { + if (.prmap_available() != "available") { + return(.prmap_available()) + } + req("pm_plots" %in% names(input)) + robj <- .prmap() + if (is.character(robj)) { + return(robj) + } + withProgress(message = i18n$t("Generating brand maps"), value = 1, { + do.call(plot, c(list(x = robj), pm_plot_inputs(), shiny = TRUE)) + }) + } +) + +prmap_report <- function() { + outputs <- c("summary", "plot") + inp_out <- list(list(cutoff = input$pm_cutoff, dec = 2), "") + inp_out[[2]] <- clean_args(pm_plot_inputs(), pm_plot_args[-1]) + inp <- clean_args(pm_inputs(), pm_args) + if (!is.empty(inp$nr_dim)) inp$nr_dim <- as_integer(inp$nr_dim) + if (!is.empty(input$pm_store_name)) { + fixed <- fix_names(input$pm_store_name) + updateTextInput(session, "pm_store_name", value = fixed) + xcmd <- glue('{input$dataset} <- store({input$dataset}, result, name = "{fixed}")') + } else { + xcmd <- "" + } + update_report( + inp_main = inp, + fun_name = "prmap", + inp_out = inp_out, + fig.width = pm_plot_width(), + fig.height = pm_plot_height(), + xcmd = xcmd + ) +} + +## store factor scores +observeEvent(input$pm_store, { + req(input$pm_store_name, input$pm_run) + fixed <- fix_names(input$pm_store_name) + updateTextInput(session, "pm_store_name", value = fixed) + robj <- .prmap() + if (!is.character(robj)) { + withProgress( + message = i18n$t("Storing factor scores"), value = 1, + r_data[[input$dataset]] <- store(r_data[[input$dataset]], robj, name = fixed) + ) + } +}) + +dl_pm_loadings <- function(path) { + if (pressed(input$pm_run)) { + .prmap() %>% + { + if (is.list(.)) .$fres$loadings else return() + } %>% + clean_loadings(input$pm_cutoff, fsort = FALSE) %>% + write.csv(file = path) + } else { + cat(i18n$t("No output available. Press the Estimate button to generate the factor analysis results"), file = path) + } +} + +download_handler( + id = "dl_pm_loadings", + fun = dl_pm_loadings, + fn = function() paste0(input$dataset, "_prmap_loadings"), + type = "csv", + caption = i18n$t("Save factor loadings") +) + +download_handler( + id = "dlp_prmap", + fun = download_handler_plot, + fn = function() paste0(input$dataset, "_prmap"), + type = "png", + caption = i18n$t("Save preceptual map plot"), + plot = .plot_prmap, + width = pm_plot_width, + height = pm_plot_height +) + +observeEvent(input$prmap_report, { + r_info[["latest_screenshot"]] <- NULL + prmap_report() +}) + +observeEvent(input$prmap_screenshot, { + r_info[["latest_screenshot"]] <- NULL + radiant_screenshot_modal("modal_prmap_screenshot") +}) + +observeEvent(input$modal_prmap_screenshot, { + prmap_report() + removeModal() ## remove shiny modal after save +}) diff --git a/radiant.multivariate/inst/app/tools/help/conjoint.md b/radiant.multivariate/inst/app/tools/help/conjoint.md new file mode 100644 index 0000000000000000000000000000000000000000..89d351a34ee1c994ac3e7d74ef4a59d78729ae77 --- /dev/null +++ b/radiant.multivariate/inst/app/tools/help/conjoint.md @@ -0,0 +1,87 @@ +> 联合调查响应分析 + +要从头开始设置联合研究，我们需要确定应包含的属性和属性水平。完成后，通常需要生成联合轮廓的部分因子设计。这是为所选属性和水平生成的所有可能轮廓的子集（见*设计 > DOE> 实验设计*）。 + +一旦获得受访者的数据，就可以分析他们的评估结果，以确定部分价值（Part Worths, PW）和重要性权重（Importance Weights, IW）。 + +要估计模型，请选择受访者的评分（或排名）作为 “轮廓评估（Profile evaluations）”，并选择轮廓 “属性（Attributes）”。点击`Estimate`按钮或按`CTRL-enter`（Mac 上为`CMD-enter`）生成结果。 + +### 示例：地毯清洁剂 + +在一项联合研究中，向受访者展示了 18 个地毯清洁产品的轮廓，这些产品由 5 个属性描述。要获取`carpet`数据集，请前往 “数据> 管理”，从 “加载数据类型（Load data of type）” 下拉菜单中选择`Examples`，点击 “加载（Load）” 按钮，然后选择`carpet`数据集。 + +- `design` = 包装设计（A、B、C） +- `brand` = 品牌名称（K2R、Glory、Bissell） +- `price` = 价格（1.19 美元、1.39 美元、1.59 美元） +- `seal` = 《好管家》认证标志（有或无） +- `money_back` = 退款保证（有或无） +- `ranking` = 受访者对 18 个属性的排名 + +设计特征： + +

    + +基于这些属性，可创建 108 种可能的轮廓（即 3×3×3×2×2 = 108）。向受访者提供了 18 个轮廓，要求他们将这些轮廓从最偏好（排名 1）到最不偏好（排名 18）进行排序。前 5 列代表 5 个属性，最后一列是受访者的排名。 + +a. 计算属性变量的方差膨胀因子（VIF）。你注意到了什么？这关于呈现给受访者的 18 个轮廓集说明了什么？ + +下方显示的 VIF 值表明属性完全正交。在部分因子设计中，轮廓是经过特意选择的，因此所有属性都是不相关的。 + + Multicollinearity diagnostics: + design brand price seal money_back + VIF 1 1 1 1 1 + Rsq 0 0 0 0 0 + +b. 使用受访者的评估作为因变量，属性作为预测变量，估计联合模型。展示完整的部分价值和重要性权重列表。 + +

    +

    + +c. 计算以下选项的预测效用： + +* 包装 A、K2R 品牌、1.19 美元、无《好管家》认证、无退款保证 + - 基于部分价值的预测效用：6.5 + 0 + 0 + 0 + 0 + 0 = 6.5 +* 包装 C、Bissell 品牌、1.19 美元、无《好管家》认证、有退款保证 + - 基于部分价值的预测效用：6.5 + 4.5 + 1.5 + 0 + 4.5 = 17 +* 包装 B、Bissell 品牌、1.59 美元、有《好管家》认证、有退款保证 + - 基于部分价值的预测效用：6.5 + 8.0 + 1.5 - 7.67 + 1.5 + 4.5 = 14.33 + +d. 可获得的最高预测效用是多少？该选项的特征是什么？ + +* 具有最高（预测）效用的选项是：包装 B、Bissell 品牌、1.19 美元、有《好管家》认证、有退款保证 +* 基于部分价值的预测效用：6.5 + 8.0 + 1.5 + 0 + 1.5 + 4.5 = 22 + +我们可以通过三个步骤验证这一结果：（1）在 “数据> 转换” 中使用 “扩展网格（Expand grid）” 创建包含所有 36 个轮廓的新数据集；（2）在 “多元分析 > 联合分析 > 预测（Predict）” 标签页中选择新创建的数据集，将预测结果存储在新变量`predict_ca`中；（3）在 “数据> 查看” 标签页中按`predict_ca`对新数据集排序。以下截图展示了这三个步骤： + +#### 步骤 1：创建数据集 + +

    + +#### 步骤 2：预测效用 + +

    + +#### 步骤 3：排序预测结果 + +

    + +## 多个受访者 + +如果有多个受访者的轮廓评估数据，且数据集中包含受访者 ID 变量，我们可以通过从 “分组依据（By）” 下拉菜单中选择受访者 ID，在个体层面估计联合分析结果。然后，我们可以将所有受访者的部分价值和 / 或重要性权重保存到 Radiant 的新数据集中，并使用 “多元分析> K 聚类” 进行细分。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令或`patchwork`进行自定义。详见下方示例和*数据 > 可视化*。 + +```r +plot(result, plots = c("pw", "iw"), custom = TRUE) %>% + wrap_plots(plot_list, ncol = 2) + plot_annotation(title = "Conjoint Analysis") +``` + +### R 函数 + +有关 Radiant 中用于估计联合模型的相关 R 函数概述，请参见*多元分析> 联合分析*。 + +`conjoint`工具中使用的核心函数包括`stats`包中的`lm`和`car`包中的`vif`。 diff --git a/radiant.multivariate/inst/app/tools/help/figures/conjoint_carpet_design.png b/radiant.multivariate/inst/app/tools/help/figures/conjoint_carpet_design.png new file mode 100644 index 0000000000000000000000000000000000000000..dd2c5613c9745f1de0f6aeb91920aa88d0605483 Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/conjoint_carpet_design.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/conjoint_expand.png b/radiant.multivariate/inst/app/tools/help/figures/conjoint_expand.png new file mode 100644 index 0000000000000000000000000000000000000000..3d46220bc4c0b2d35db42a09f73ae21ede687bd0 Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/conjoint_expand.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/conjoint_plot.png b/radiant.multivariate/inst/app/tools/help/figures/conjoint_plot.png new file mode 100644 index 0000000000000000000000000000000000000000..ec4245a747fc1689be80eac5901c1cc03b91cd84 Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/conjoint_plot.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/conjoint_predict.png b/radiant.multivariate/inst/app/tools/help/figures/conjoint_predict.png new file mode 100644 index 0000000000000000000000000000000000000000..5df5457a22cec9e3defe94f16a7cbb2b87313d7b Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/conjoint_predict.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/conjoint_summary.png b/radiant.multivariate/inst/app/tools/help/figures/conjoint_summary.png new file mode 100644 index 0000000000000000000000000000000000000000..dd2dc1cca6c9cf977740129434e3664c1c3c7aa7 Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/conjoint_summary.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/conjoint_view.png b/radiant.multivariate/inst/app/tools/help/figures/conjoint_view.png new file mode 100644 index 0000000000000000000000000000000000000000..91c2b7cdcf76341ff4f699b923566410a78bfe10 Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/conjoint_view.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/full_factor_plot.png b/radiant.multivariate/inst/app/tools/help/figures/full_factor_plot.png new file mode 100644 index 0000000000000000000000000000000000000000..f714edce42e125786e25398b202b91f0142ad2df Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/full_factor_plot.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/full_factor_plot_rotation.png b/radiant.multivariate/inst/app/tools/help/figures/full_factor_plot_rotation.png new file mode 100644 index 0000000000000000000000000000000000000000..637158914bced5d3d1335c98930dd6e7f47f853b Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/full_factor_plot_rotation.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/full_factor_summary.png b/radiant.multivariate/inst/app/tools/help/figures/full_factor_summary.png new file mode 100644 index 0000000000000000000000000000000000000000..7beb1e16b05be65fe600053c289ed0afe8d7d2d7 Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/full_factor_summary.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/full_factor_summary_shopping.png b/radiant.multivariate/inst/app/tools/help/figures/full_factor_summary_shopping.png new file mode 100644 index 0000000000000000000000000000000000000000..eb9031426d889157d8d2bd827ed17df74b8cb393 Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/full_factor_summary_shopping.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/hclus_dendro.png b/radiant.multivariate/inst/app/tools/help/figures/hclus_dendro.png new file mode 100644 index 0000000000000000000000000000000000000000..3b2eedb34ca5c7da732a892f6954dd74a7fc1391 Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/hclus_dendro.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/hclus_scree.png b/radiant.multivariate/inst/app/tools/help/figures/hclus_scree.png new file mode 100644 index 0000000000000000000000000000000000000000..0cf1c4e7a78a4d365c0861cbbdca9af2bcd33280 Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/hclus_scree.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/kclus_cross_tabs_plot.png b/radiant.multivariate/inst/app/tools/help/figures/kclus_cross_tabs_plot.png new file mode 100644 index 0000000000000000000000000000000000000000..cdcc94116f02e84d7c796bb90b2b49bb2e02a39a Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/kclus_cross_tabs_plot.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/kclus_cross_tabs_summary.png b/radiant.multivariate/inst/app/tools/help/figures/kclus_cross_tabs_summary.png new file mode 100644 index 0000000000000000000000000000000000000000..a0506c91f3408028b1b6f772bb59c28cbfe3f134 Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/kclus_cross_tabs_summary.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/kclus_plot.png b/radiant.multivariate/inst/app/tools/help/figures/kclus_plot.png new file mode 100644 index 0000000000000000000000000000000000000000..07268be6f1885c7e1083c9215c4ada0cc61edb0a Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/kclus_plot.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/kclus_summary.png b/radiant.multivariate/inst/app/tools/help/figures/kclus_summary.png new file mode 100644 index 0000000000000000000000000000000000000000..6448270b1530525c06f986e3a1233f873f7197c4 Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/kclus_summary.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/kclus_transform_recode.png b/radiant.multivariate/inst/app/tools/help/figures/kclus_transform_recode.png new file mode 100644 index 0000000000000000000000000000000000000000..1cf8eedfe30f50d8485325e14813432c76117a14 Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/kclus_transform_recode.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/mds_plot.png b/radiant.multivariate/inst/app/tools/help/figures/mds_plot.png new file mode 100644 index 0000000000000000000000000000000000000000..3d8e029870ba5d89104d19cc318839e190639002 Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/mds_plot.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/mds_plot_flip.png b/radiant.multivariate/inst/app/tools/help/figures/mds_plot_flip.png new file mode 100644 index 0000000000000000000000000000000000000000..d62af5e482ee0dcdf24a980b835544b378bdb3df Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/mds_plot_flip.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/mds_plot_tpbrands.png b/radiant.multivariate/inst/app/tools/help/figures/mds_plot_tpbrands.png new file mode 100644 index 0000000000000000000000000000000000000000..287467fa4d704a51b265f3c1cfd342b79283f27e Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/mds_plot_tpbrands.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/mds_summary.png b/radiant.multivariate/inst/app/tools/help/figures/mds_summary.png new file mode 100644 index 0000000000000000000000000000000000000000..1bacb65c47ac2e983aac12ba8464f9d6b1dd1767 Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/mds_summary.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/mds_summary_tpbrands.png b/radiant.multivariate/inst/app/tools/help/figures/mds_summary_tpbrands.png new file mode 100644 index 0000000000000000000000000000000000000000..2b2e36db606b6920fed5aba5aa254b3a9437d860 Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/mds_summary_tpbrands.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/place_holder.txt b/radiant.multivariate/inst/app/tools/help/figures/place_holder.txt new file mode 100644 index 0000000000000000000000000000000000000000..7489accbf21dadfed2aa6bba3be0273032214a16 --- /dev/null +++ b/radiant.multivariate/inst/app/tools/help/figures/place_holder.txt @@ -0,0 +1 @@ +-- \ No newline at end of file diff --git a/radiant.multivariate/inst/app/tools/help/figures/pre_factor_plot.png b/radiant.multivariate/inst/app/tools/help/figures/pre_factor_plot.png new file mode 100644 index 0000000000000000000000000000000000000000..7ef48372aba45791dd5c274a4854c705ea9b2b31 Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/pre_factor_plot.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/pre_factor_summary.png b/radiant.multivariate/inst/app/tools/help/figures/pre_factor_summary.png new file mode 100644 index 0000000000000000000000000000000000000000..7531c98946b59fe714ed6d5994f21effae38d859 Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/pre_factor_summary.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/prmap_plot_all.png b/radiant.multivariate/inst/app/tools/help/figures/prmap_plot_all.png new file mode 100644 index 0000000000000000000000000000000000000000..ab794e0d0309ac78a860f908d901815604a6f65b Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/prmap_plot_all.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/prmap_plot_brands.png b/radiant.multivariate/inst/app/tools/help/figures/prmap_plot_brands.png new file mode 100644 index 0000000000000000000000000000000000000000..ddae3a6dfe1d6097169c5d9c354cebbc57e4b182 Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/prmap_plot_brands.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/prmap_plot_brands_attr.png b/radiant.multivariate/inst/app/tools/help/figures/prmap_plot_brands_attr.png new file mode 100644 index 0000000000000000000000000000000000000000..444cd15a4d7ba26038195cffb1a2ce1b4fbe0a9c Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/prmap_plot_brands_attr.png differ diff --git a/radiant.multivariate/inst/app/tools/help/figures/prmap_summary.png b/radiant.multivariate/inst/app/tools/help/figures/prmap_summary.png new file mode 100644 index 0000000000000000000000000000000000000000..52cf187b24773bf1af118ee2e83bb0e20fe19924 Binary files /dev/null and b/radiant.multivariate/inst/app/tools/help/figures/prmap_summary.png differ diff --git a/radiant.multivariate/inst/app/tools/help/full_factor.md b/radiant.multivariate/inst/app/tools/help/full_factor.md new file mode 100644 index 0000000000000000000000000000000000000000..0009f01dd1b86c8c168c82968f656cf1d54024d0 --- /dev/null +++ b/radiant.multivariate/inst/app/tools/help/full_factor.md @@ -0,0 +1,78 @@ +> 在不显著丢失信息的情况下降低数据维度 + +正如因子分析前置分析的文档中所述（见 “多元分析> 因子分析 > 预因子分析”），因子分析的目标是在不显著丢失信息的情况下降低数据维度。该工具通过寻找纳入分析的变量相关矩阵中的结构来实现这一目标。研究者通常会尝试将原始变量（或条目）与潜在因子关联，并为每个因子提供描述性标签。 + +### 示例：牙膏数据 + +首先，前往 “数据> 管理” 标签页，从 “加载数据类型（Load data of type）” 下拉菜单中选择**examples**，然后点击 “加载（Load）” 按钮。接着选择`toothpaste`数据集。该数据集包含 60 名消费者的信息，这些消费者被要求回答 6 个问题以确定他们对牙膏的态度。变量 v1-v6 所示的分数表示对陈述的同意程度，采用 7 分制，其中 1 = 强烈不同意，7 = 强烈同意。 + +确定要提取的因子数量后，我们可以对其进行旋转。因子旋转的目的是生成一种解决方案，在可能的情况下，使一个变量仅在一个因子上有高载荷。这是一个重要的优势，因为它使因子的解释更简单。虽然有多种算法可用于旋转因子载荷矩阵，但最常用的是最大方差旋转（Varimax rotation）。 + +要复现下方截图中的结果，请确保已加载`toothpaste`数据。然后选择变量`v1`至`v6`，将 “因子数量（Nr. of factors）” 设置为 2，点击 “估计（Estimate）” 按钮或按`CTRL-enter`（Mac 上为`CMD-enter`）生成结果。 + +

    + +“因子载荷（Factor loadings）” 表中的数值是 6 个变量与两个因子的相关系数。例如，变量`v1`与因子 1 的相关系数为 0.96，与因子 2 的相关系数为 - 0.03。因此，`v1`在因子 1 的命名中起重要作用，而在因子 2 的命名中作用不显著。 + +旋转后的因子载荷可用于确定不同因子的标签或名称。我们需要识别并突出显示每行中绝对值最大的因子载荷。通过将 “截断值（Cut-off）” 设置为 0.4 并勾选 “排序因子载荷（Sort factor loadings）” 框，可轻松实现这一点。输出如下： + +```r +Loadings: + RC1 RC2 +v1 0.96 +v5 -0.93 +v3 0.93 +v6 0.88 +v4 0.85 +v2 0.85 +``` + +每列（即每个因子）中显示的变量共同帮助我们理解因子的含义。问题 1、3 和 5 反映了健康问题的重要性，而问题 2、4 和 6 反映了美观问题（见 “数据> 管理” 标签页中的数据描述以了解变量详情）。因此，因子的合理名称可能是： + +* **因子 1：** 健康益处 +* **因子 2：** 社交益处 + +了解旋转作用的最佳方式是在 “旋转（Rotation）” 下拉菜单中切换 “最大方差旋转（Varimax）” 和 “无（None）”，并在点击 “估计模型（Estimate model）” 按钮后检查输出的变化。从 “旋转” 下拉菜单中选择 “无”，切换到 “绘图（Plot）” 标签页，点击 “估计模型” 按钮查看更新后的结果。下方左侧图像展示了变量在两个因子上的载荷。变量`v5`在因子 1 和因子 2 的轴之间。然而，当我们选择 “最大方差旋转” 时，`v5`的标签与水平轴（即因子 2）很好地对齐。这种对齐变化也反映在因子载荷中。`v5`的未旋转因子载荷在因子 1 上为 - 0.87，在因子 2 上为 - 0.35；旋转后的因子载荷在因子 1 上为 - 0.93，在因子 2 上为 - 0.08。 + +

    + +最后一步是生成因子得分。可以将这些得分视为与某个因子相关联的变量的加权平均值。它们近似于如果我们能通过单个问题询问因子时受访者会给出的得分，即受访者在因子上的推断评分。点击 “存储（Store）” 按钮后，牙膏数据文件中将添加两个新变量（即 factor1 和 factor2）。通过前往 “数据 > 查看” 标签页可以看到它们。我们可以在其他分析中使用因子得分（例如聚类分析或回归分析）。通过在 “数据 > 转换” 标签页中从 “转换类型（Transformation type）” 下拉菜单中选择 “重命名（Rename）”，可以将新变量重命名为`health`和`social`等。 + +要将因子载荷下载为 csv 文件，点击屏幕右上角的下载按钮。 + +### 总结 + +1. 使用巴特利特检验、KMO 检验和共线性分析确定数据是否适合因子分析（“多元分析> 因子分析 > 因子分析前置”） +2. 使用碎石图和特征值大于 1 准则确定要提取的因子数量（“多元分析> 因子分析 > 因子分析前置”） +3. 提取（旋转后的）因子解决方案，生成： + - 因子载荷：属性与因子之间的相关系数 + - 因子得分：新因子上的推断评分（即汇总原始变量的新变量） +4. 识别每行（即每个变量）中绝对值最大的因子载荷 +5. 使用最强的因子载荷为因子命名 + +如果想进一步练习，请打开`shopping`数据集，尝试复现下方 “摘要（Summary）” 标签页截图中的结果。使用 “多元分析 > 因子分析 > 预因子分析” 确定所选因子数量是否正确。你同意这个结果吗？为什么（不）？ + +

    + +## I纳入分类变量 + +“多元分析> 因子分析” 中显示的输出通过主成分分析（PCA）或最大似然法（ML）估计。用于估计的相关矩阵可基于`numeric`、`integer`、`date`和`factor`类型的变量计算。当纳入因子型变量时，应勾选 “调整因子型变量（Adjust for {factor} variables）” 框。进行调整后估计相关系数时，因子型变量将被视为（有序）分类变量，其他所有变量将被视为连续变量。 + +需要注意的是，如果混合使用因子型和数值型变量，估计的因子得分会存在偏差。如果想将因子得分用作进一步分析（如聚类）的输入，应使用（1）全部因子型变量或（2）全部数值型变量，以避免这种偏差。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令或`patchwork`进行自定义。详见下方示例和*数据 > 可视化*。 + +```r +plot(result, custom = TRUE) %>% + wrap_plots(plot_list, ncol = 2) + plot_annotation(title = "Factor Analysis") +``` + +### R 函数 + +有关 Radiant 中用于进行因子分析的相关 R 函数概述，请参见*多元分析 > 因子分析*。 + +`full_factor`工具中使用的来自`psych`包的核心函数是`principal`和`fa`。 diff --git a/radiant.multivariate/inst/app/tools/help/hclus.md b/radiant.multivariate/inst/app/tools/help/hclus.md new file mode 100644 index 0000000000000000000000000000000000000000..6c1ecbc5fc62fe585f113421143750fc5aedbbff --- /dev/null +++ b/radiant.multivariate/inst/app/tools/help/hclus.md @@ -0,0 +1,48 @@ +> 确定合适的细分数量 + +聚类分析的目标是根据需求、利益和 / 或行为将受访者（如消费者）分组为细分群体。该工具通过寻找相似的受访者，将他们归为一个聚类或细分群体，并将他们与其他不相似的受访者区分开来，以实现这一目标。研究者会比较这些细分群体，并为每个群体提供描述性标签。 + +### 示例：牙膏数据 + +首先，前往 “数据> 管理” 标签页，从 “加载数据类型（Load data of type）” 下拉菜单中选择**examples**，然后点击 “加载（Load）” 按钮。接着选择`toothpaste`数据集。该数据集包含 60 名消费者的信息，这些消费者被要求回答 6 个问题以确定他们对牙膏的态度。变量 v1-v6 所示的分数表示对陈述的同意程度，采用 7 分制，其中 1 = 强烈不同意，7 = 强烈同意。 + +我们首先使用层次聚类分析确定数据中的细分 / 聚类数量。沃德法（Ward’s method）与平方欧氏距离（Squared Euclidean distance）常被用于衡量个体间的（不）相似程度。这些是 Radiant 中的默认值，但如有需要可以更改。该分析中最重要的信息由图表提供，因此我们将重点关注图表。 + +在 “变量（Variables）” 框中选择变量 v1 至 v6，点击 “估计（Estimate）” 按钮或按`CTRL-enter`（Mac 上为`CMD-enter`）生成结果。注意，对于大型数据集，层次聚类分析可能耗时且占用大量内存。如果你的数据集有超过 5000 个观测值，请确保将 “最大案例数（Max cases）” 输入框中的值增加到适当数量。下方所示的树状图（Dendrogram）提供了帮助确定最合适聚类（或细分）数量的信息。 + +层次聚类分析从多个细分群体开始（数量与受访者数量相同），并通过逐步（即层次化）过程将最相似的受访者或群体合并，直到只剩下一个细分群体。要确定合适的细分数量，需寻找图表纵轴上的 “跳跃”。此时，两个不相似的细分群体被合并。纵轴上的度量表示已形成的细分群体内部的异质性水平。聚类的目的是创建同质群体，避免出现具有异质特征、需求等的细分群体。由于异质性最明显的 “跳跃” 出现在从 3 个细分群体合并为 2 个细分群体时，因此我们选择 3 个细分群体（即避免创建异质细分群体）。 + +

    + +另一个可用于确定细分数量的图表是碎石图（scree-plot）。该图的纵轴为集群内异质性，横轴为细分群体数量。同样，层次聚类分析从多个细分群体开始，将受访者逐步合并，直到只剩下一个细分群体。通过从 “图表（Plot (s)）” 下拉菜单中选择 “碎石图（Scree）”（和 “变化（Change）”）生成碎石图。如果 “图表截断值（Plot cutoff）” 设为 0，我们会看到所有可能聚类解决方案的结果。为便于评估图表，我们可以将 “图表截断值” 设为例如 0.05（即仅显示 “集群内异质性” 高于 5% 的解决方案）。 + +

    + +从左到右查看图表，我们发现当从 3 个细分群体变为 2 个细分群体时，群体内异质性急剧增加。这从 “集群内异质性变化（Change in within-cluster heterogeneity）” 图表（即 “变化（Change）”）中也能清晰看出。为避免创建异质细分群体，我们再次选择 3 个细分群体。确定了要提取的合适细分数量后，我们可以使用 “聚类 > 层次聚类（Cluster > Hierarchical）” 或 “聚类 > K 聚类（Cluster > K-clustering）” 生成最终的聚类解决方案。 + +要下载图表，点击屏幕右上角的下载按钮。 + +## 额外选项 + +* 默认情况下，数据在分析前会进行标准化。要将原始数据传入估计算法，请确保取消勾选 “标准化（Standardize）” 框。 +* 层次聚类分析（HC）会生成多个聚类解决方案。最大聚类数量等于数据中的观测值数量（例如，每个受访者都被视为一个单独的聚类）。评估的最小聚类数量为 1（例如，所有受访者被归为一个聚类）。尽管层次聚类分析通常作为诊断工具，用于在使用例如 K 均值法生成最终解决方案之前进行分析，但我们也可以存储使用层次聚类生成的任何特定聚类解决方案。为此，首先选择 “聚类数量（Number of clusters）”，然后为包含聚类分配信息的变量提供名称，最后点击 “存储（Store）” 按钮。 +* 如果用于聚类的数据包含 “因子（factor）” 类型的变量，将自动选择 “高维尔距离（gower distance）”。有关高维尔距离和相关 R 包的更多信息，请参见包说明文档。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令或`gridExtra`进行自定义。详见下方示例和*数据 > 可视化*。 + +```r +plot(result, plots = "change", custom = TRUE) + + labs(caption = "Data used from ...") +``` + +例如，要为树状图添加副标题，使用`title(sub = "数据来源：...")`。更多信息请参见R 图形文档。 + +### R 函数 + +有关 Radiant 中用于进行聚类分析的相关 R 函数概述，请参见*多元分析 > 聚类分析*。 + +`hclus`工具中使用的来自`stats`包的核心函数是`hclust`。 diff --git a/radiant.multivariate/inst/app/tools/help/kclus.md b/radiant.multivariate/inst/app/tools/help/kclus.md new file mode 100644 index 0000000000000000000000000000000000000000..e3dfc5cddf2e1f72ad928ed58806f290be244bf2 --- /dev/null +++ b/radiant.multivariate/inst/app/tools/help/kclus.md @@ -0,0 +1,68 @@ +> 使用 K 聚类创建细分群体 + +聚类分析的目标是根据需求、利益和 / 或行为将受访者（如消费者）分组为细分群体。该工具通过寻找相似的受访者，将他们归为一个聚类或细分群体，并将他们与其他不相似的受访者区分开来，以实现这一目标。研究者会比较这些细分群体，并为每个群体提供描述性标签。 + +### 示例：牙膏数据 + +首先，前往 “数据> 管理” 标签页，从 “加载数据类型（Load data of type）” 下拉菜单中选择**examples**，然后点击 “加载（Load）” 按钮。接着选择`toothpaste`数据集。该数据集包含 60 名消费者的信息，这些消费者被要求回答 6 个问题以确定他们对牙膏的态度。变量 v1-v6 所示的分数表示对陈述的同意程度，采用 7 分制，其中 1 = 强烈不同意，7 = 强烈同意。 + +使用层次聚类分析确定要提取的聚类数量后，我们使用 K 聚类创建最终的细分群体。该算法的主要优势是在寻找最合适的受访者分组时具有灵活性和稳健性。对于营销和商业数据，我们通常使用层次聚类分析选择细分群体数量，再用 K 聚类创建最终的细分群体。 + +要对牙膏数据应用 K 聚类，在算法中选择`K-means`，在 “变量（Variables）” 框中选择变量 v1 至 v6，选择 3 作为聚类数量。由于数据观测值相对较少，我们可以使用层次聚类分析（HC）提供初始聚类中心。更改设置后，点击 “估计（Estimate）” 按钮或按`CTRL-enter`（Mac 上为`CMD-enter`）生成结果。 + +在 “摘要（Summary）” 标签页中，我们使用 “聚类均值（Cluster means）” 表描述分配到某个细分群体的个体。表中的每个数值表示该细分群体中人们在某个变量上的平均得分。例如，细分群体 3 在问题 v2 上的平均得分为 5.750（满分 7 分）。我们需要寻找极高或极低的均值来帮助区分细分群体，因为我们要确定一个细分群体与其他群体的差异。如果某个变量在不同细分群体中的均值没有显著差异，那么该变量对解释分析结果用处不大。通过突出最能清晰区分不同细分群体的变量，我们可以生成描述每个细分群体中消费者的名称或标签，并说明各细分群体之间的差异。 + +

    + +通过绘制每个细分群体和变量的数据，可视化细分群体的分离程度会很有帮助。下方所示为密度图。对于变量 v1，聚类分离效果良好。细分群体 2（绿色）对 “购买预防蛀牙的牙膏很重要” 这一问题的平均响应似乎低于细分群体 3（蓝色）和细分群体 1（粉色）。而细分群体 1 在该问题上的得分又高于其他两个细分群体。对于问题 v4，我们看到不同的模式。细分群体 1（绿色）和细分群体 2（粉色）对 “我偏好清新口气的牙膏” 这一问题的平均响应非常相似，图表重叠。而细分群体 3（蓝色）在该问题上的得分高于其他两个细分群体。 + +

    + +通过查看 “摘要” 标签页中的聚类均值表和 “绘图” 标签页中的密度图，我们可以得出以下标签：细分群体 3 在问题 v2、v4 和 v6 上的得分较高，我们可以称他们为 “美容型刷牙者”；细分群体 1 在问题 v1 和 v3 上的得分较高，在 v5 上的得分较低，他们似乎最关注牙膏的健康益处，因此可以称他们为 “治疗型刷牙者”；细分群体 2 在 v1 和 v3 上的得分较低，在 v5 上的得分较高，即他们不太关注牙膏的健康益处，且在美容益处上的得分处于中等水平，因此可以称他们为 “无特定偏好型刷牙者”。要将聚类均值表保存为 csv 文件，按屏幕右上角的下载按钮。 + +对细分群体分类后，我们可以通过点击 “存储（Store）” 按钮创建细分群体（或聚类）成员变量。牙膏数据中会添加一个新变量，显示哪些受访者被分配到每个聚类（即聚类成员资格）。我们可以通过 “数据 > 转换” 菜单将创建的聚类变量修改为上述描述性标签。在 “选择列（Select column (s)）” 框中选择`kclus`变量，然后从 “转换类型（Transform type）” 下拉菜单中选择 “重编码（Recode）”。在重编码框中输入（或粘贴）以下命令并按回车： + +```r +1 = '治疗型'; 2 = '无特定偏好型'; 3 = '美容型' +``` + +这应生成下方所示的输出。确认结果符合预期后，点击 “存储（Store）” 按钮将重编码后的变量添加到牙膏数据集。 + +

    + +我们可以使用交叉表（如性别与细分群体成员资格）结合人口统计数据描述这些细分群体。前往 “基础> 表格 > 交叉表”。我们的原假设和备择假设如下： + +```r +H0：性别与细分群体成员资格之间无关联 +Ha：性别与细分群体成员资格之间有关联 +``` + +在 “摘要” 标签页中，我们看到这两个变量之间存在显著关联。p 值为 0.001，且没有单元格的预期值低于 5（详见 “基础 > 表格 > 交叉表” 的帮助文件）。 + +

    + +要图形化展示这种关联，前往 “绘图（Plot）” 标签页。如果选择 “标准差偏差（Deviation std.）”，我们看到 “无特定偏好型” 细分群体中的男性数量显著多于原假设（无关联）下的预期数量。我们也可以认为 “美容型” 细分群体中的女性数量多于原假设下的预期数量，尽管显著性水平较低（即 < 0.1 但不 < 0.05）。总之，在这些数据中，男性似乎更可能属于 “无特定偏好型刷牙者” 细分群体，而女性似乎（在较低显著性水平上）更可能属于 “美容型刷牙者” 细分群体。 + +

    + +## 额外选项 + +- 默认情况下，数据在分析前会进行标准化。要将原始数据传入估计算法，请确保取消勾选 “标准化（Standardize）” 框。 +- 如果用于聚类的数据包含 “因子（factor）” 类型的变量，应使用`K-proto`（K - 原型）算法。如果选择`K-means`，则仅保留数值变量用于分析。有关`kproto`函数和`clustMixType`R 包的更多信息，请参见R 期刊文章。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令或`patchwork`进行自定义。详见下方示例和*数据 > 可视化*。 + +```r +plot(result, plots = "bar", custom = TRUE) %>% + wrap_plots(plot_list, ncol = 2) + plot_annotation(title = "K-means Cluster Analysis") +``` + +### R 函数 + +有关 Radiant 中用于进行聚类分析的相关 R 函数概述，请参见*多元分析 > 聚类分析*。 + +`kclus`工具中使用的来自`stats`包的核心函数是`kmeans`。 diff --git a/radiant.multivariate/inst/app/tools/help/mds.md b/radiant.multivariate/inst/app/tools/help/mds.md new file mode 100644 index 0000000000000000000000000000000000000000..20de74c24d865ba2a2103ff043a79168a2035c53 --- /dev/null +++ b/radiant.multivariate/inst/app/tools/help/mds.md @@ -0,0 +1,43 @@ +> 基于（不）相似性数据的感知图可通过多维尺度分析（MDS）进行研究 + +### 示例 1 + +城市数据（`city`）包含美国 10 个主要城市之间以英里为单位的距离信息，提供了 45 对（10×9/2）出发 - 到达城市对的距离。这些数据用于说明 MDS 可利用简单的距离数据（或我们将看到的品牌不相似性数据）创建二维地图，准确呈现城市（或品牌）的相对位置。 + +要加载`city`数据，前往 “数据> 管理”，从 “加载数据类型（Load data of type）” 下拉菜单中选择`examples`，点击 “加载（Load）” 按钮，然后选择`city`数据集。在 “多元分析> 感知图 > （不）相似性分析” 中，选择`from`作为 ID 1，`to`作为 ID 2，`distance`作为不相似性度量。更改设置后，点击 “估计模型（Estimate model）” 按钮或按`CTRL-enter`（macOS 上为`CMD-enter`）生成结果。 + +原始距离以（下三角）矩阵形式显示在下方截图中。如果分析成功，我们预期距离近的城市（如华盛顿特区和纽约）在地图上的位置也较近，而距离远的城市（如西雅图和迈阿密）在地图上的位置也应较远。 + +MDS 的基本（不）拟合度量称为 “应力值（Stress）”。如果 MDS 无法创建准确描述原始数据的地图，会导致高应力值。应力值为 0.1 通常被认为尚可，0.05 为良好，0.01 或更低为极佳。高应力值表明需要三维（或更高维）才能准确呈现数据。城市数据的应力值为 0.02，属于良好。在 “摘要（Summary）” 标签页中，我们还能看到用于创建 “绘图（Plot）” 标签页中二维地图的坐标，以及还原的距离（即生成的地图中城市之间的 “距离”）。 + +

    + +在下方 “绘图” 标签页的截图中，洛杉矶、波士顿等城市的相对位置看起来有误。这是因为 MDS 程序没有南北东西的信息。我们可以 “翻转（flip）” 图表，看看地图是否更容易识别和解释。 + +

    + +要创建下方所示图表，勾选 “维度 1（dimension 1）” 和 “维度 2（dimension 2）” 的复选框。沿水平轴和垂直轴翻转图表后，我们看到城市的相对位置相当准确。注意，此地图是 “平面的”，即未校正地球曲率。 + +

    + +### 示例 2 + +下图基于一组牙膏品牌的相似性数据（`tpbrands`是示例数据集之一）。研究人员向受访者提出以下问题：“请根据相似性对以下每对牙膏品牌进行评分（1 = 非常相似，7 = 非常不相似）”，涉及 10 个品牌的所有成对组合，共 45 组比较。MDS 将尝试创建地图，尽可能准确地还原 50 名受访者提供的原始不相似性（或感知距离）。原始不相似性评分以（下三角）矩阵形式显示在下方图表中。从这些数据中我们已能看出，受访者认为某些品牌非常相似（如 Ultra Brite 和 Pepsodent 的平均不相似性得分为 1.11），而其他品牌则非常不相似（如 Crest 和 Sensodyne）。二维解决方案的应力值较为合理（0.058）。但正如预期，原始距离与还原距离的拟合度不如`city`数据。 + +

    + +“摘要” 标签页中显示的坐标用于在 “绘图” 标签页中以二维方式绘制品牌。在图表中，Aqua Fresh 与 Colgate、Ultra Brite 与 Pepsodent 的位置非常接近，这与原始数据一致。而 Sensodyne 和 Crest 则位于图表的两端，这也与原始数据一致，直观证实了 MDS 能够创建与数据拟合度较好的图表。 + +管理者从图表中可能会得出结论：地图上位置最接近的品牌被消费者视为密切替代品，因此在该细分市场的消费者心中是直接竞争对手。相反，Aqua Fresh 或 Macleans 的管理者在制定品牌竞争性定位计划时，可能较少关注 Sensodyne。基于（不）相似性数据的品牌地图的一个重要局限性是坐标轴难以解释。例如，为何 Close-up 和 Crest 沿水平轴位于两端？研究人员可要求受访者解释坐标轴的含义，或获取品牌的额外属性信息，将其与图表关联 / 叠加以辅助解释。不过，此类属性数据也可用于创建品牌地图，而无需（不）相似性评分（见 “多元分析> 感知图 > 属性分析”）。 + +

    + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +### R 函数 + +有关 Radiant 中用于生成品牌地图的相关 R 函数概述，请参见*多元分析 > 感知图*。 + +`mds`工具中使用的核心函数包括`stats`包中的`cmdscale`和`MASS`包中的`isoMDS`。 diff --git a/radiant.multivariate/inst/app/tools/help/pre_factor.md b/radiant.multivariate/inst/app/tools/help/pre_factor.md new file mode 100644 index 0000000000000000000000000000000000000000..522836cc229bc940d2792ad86fd161ca4ebe7312 --- /dev/null +++ b/radiant.multivariate/inst/app/tools/help/pre_factor.md @@ -0,0 +1,48 @@ +> 评估数据是否适合因子分析 + +因子分析（和主成分分析）的目标是通过识别和利用纳入分析的变量相关矩阵中的结构，在最小化信息损失的情况下降低数据维度。研究者通常会尝试将原始变量（或条目）与潜在因子关联，并为每个因子提供描述性标签。 + +### 示例：牙膏数据 + +首先，前往 “数据> 管理” 标签页，从 “加载数据类型（Load data of type）” 下拉菜单中选择**examples**，然后点击 “加载（Load）” 按钮。接着选择`toothpaste`数据集。该数据集包含 60 名消费者的信息，这些消费者被要求回答 6 个问题以确定他们对牙膏的态度。变量 v1-v6 所示的分数表示对陈述的同意程度，采用 7 分制，其中 1 = 强烈不同意，7 = 强烈同意。 + +因子分析的第一步是确定数据是否具有所需特征。变量间相关性有限或无相关性的数据不适合因子分析。我们将使用三个标准检验数据是否适合因子分析：巴特利特检验（Bartlett）、KMO 检验和每个变量的共线性。 + +KMO 检验和巴特利特检验共同评估所有可用数据。KMO 值大于 0.5 且巴特利特检验的显著性水平低于 0.05，表明数据中存在显著相关性。变量共线性表示单个变量与其他变量的相关强度，值大于 0.4 被认为是合适的。也可计算每个变量的 KMO 值，值大于 0.5 是可接受的。 + +从下方 “多元分析> 因子分析 > 预因子分析” 的输出中可以看出，巴特利特检验统计量大且显著（p 值接近 0），符合预期。凯泽 - 迈耶 - 奥尔金（KMO）度量大于 0.5，因此可接受。变量共线性值大于 0.4，且 KMO 值大于 0.5，因此所有变量均可用于分析。 + +要复现截图中的结果，请确保已加载`toothpaste`数据。然后选择变量`v1`至`v6`，点击 “估计（Estimate）” 按钮或按`CTRL-enter`（Mac 上为`CMD-enter`）生成结果。 + +

    + +下一步是确定捕捉数据潜在结构所需的因子数量。通常会忽略那些捕捉的方差甚至不超过随机预期方差的因子，这些因子在输出中的特征值 < 1。 + +另一个常用于确定因子数量的标准是碎石图（scree-plot），它按提取顺序绘制特征值与因子数量的关系。图中通常会出现一个断点或 “拐点（elbow）”，如果拐点及之前的因子特征值均大于 1，则选择这些因子进行进一步分析。通常认为，解释原始数据 70% 以上方差的一组因子是可接受的。上方显示了所有因子的特征值，只有两个因子的特征值大于 1。 + +乍看之下，下方的特征值碎石图似乎表明应提取 3 个因子（即寻找 “拐点”）。条形图也证实了这一点，即因子 1 和因子 2 之间的特征值变化较小，但从因子 2 到因子 3 的下降幅度大得多。然而，由于第三个因子的特征值小于 1，我们将只提取 2 个因子。 + +

    + +从 2 个因子增加到 3 个因子时，累积解释方差百分比的增幅相对较小（即从 82% 增至 90%）。因子 3 的特征值小于 1（0.44）也证实了这一点。因此，我们选择 2 个因子。前 2 个因子捕捉了原始数据 82% 的方差，这一结果非常好。 + +## 纳入分类变量 + +因子分析前置诊断通过主成分分析（PCA）计算。用于 PCA 的相关矩阵可基于`numeric`、`integer`、`date`和`factor`类型的变量计算。当纳入因子型变量时，应勾选 “调整分类变量（Adjust for categorical variables）” 框。进行调整后估计相关系数时，因子型变量将被视为（有序）分类变量，其他所有变量将被视为连续变量。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +如果已创建图表，可使用`ggplot2`命令或`gridExtra`进行自定义。详见下方示例和*数据 > 可视化*。 + +```r +plot(result, plots = "scree", custom = TRUE) + + labs(caption = "Data used from ...") +``` + +### R 函数 + +有关 Radiant 中用于进行因子分析的相关 R 函数概述，请参见*多元分析 > 因子分析*。 + +`pre_factor`工具中使用的核心函数包括`stats`包中的`cor`、`base`包中的`eigen`，以及`psych`包中的`cortest.bartlett`和`KMO`。 diff --git a/radiant.multivariate/inst/app/tools/help/prmap.md b/radiant.multivariate/inst/app/tools/help/prmap.md new file mode 100644 index 0000000000000000000000000000000000000000..5ea00de69998f4cf65c08eda1fd139adfd0f9b3e --- /dev/null +++ b/radiant.multivariate/inst/app/tools/help/prmap.md @@ -0,0 +1,49 @@ +> 基于属性数据创建感知图，为大型数值表格提供丰富的可视化摘要 + +### 示例 + +要加载`retailers`数据，前往 “数据> 管理”，从 “加载数据类型（Load data of type）” 下拉菜单中选择`examples`，点击 “加载（Load）” 按钮，然后选择`retailers`数据集。该数据集包含芝加哥地区一组零售商在 7 个属性上的消费者评价信息。除属性评价外，数据集还包含两个预定义消费者细分群体对每个零售商的偏好评分（1-9 分制）。 + +选择`retailer`变量作为 “品牌（Brand）” 属性，这只是零售商名称 / 标签的列表。然后在 “属性（Attributes）” 框中选择变量`good_value`至`cluttered`，在 “偏好（Preferences）” 框中选择`segment1`和`segment2`变量。更改设置后，点击 “估计（Estimate）” 按钮或按`CTRL-enter`（Mac 上为`CMD-enter`）生成结果。 + +“属性（Attributes）” 框中的变量将通过因子分析进行分析，结果在 “摘要（Summary）” 标签页中提供。我们从二维解决方案开始。第一个表格显示品牌的因子得分，本质上是原始属性数据的加权平均值，其中权重为因子载荷。换句话说，因子得分是通过因子分析创建的（两个）变量，用于汇总原始 7 个属性中包含的信息。第二个数值表格显示因子载荷，代表原始属性与导出的因子得分之间的相关性。 + +我们还获得了关于两个导出因子捕捉属性中信息比例的信息。第一个因子捕捉原始数据 56.4% 的变异，第二个因子捕捉 42% 的变异。两个因子共同覆盖 98.4% 的变异，即从 7 个属性降至两个因子的维度降低过程中，信息损失仅为 1.6%。添加第三个因子只会略微增加捕捉的方差，但会使地图解释更困难。因此，我们将重点关注二维品牌地图。 + +偏好相关性表明受访者提供的偏好评分与发现的因子得分之间的关联强度。`Segment 2`的偏好与因子 2 呈极强的正相关，因此我们可能预期该细分群体的偏好箭头几乎垂直向上。公因子方差表明细分群体偏好中可被两个因子解释的变异比例，数值非常好（即 Segment 1 为 97.5%，Segment 2 为 91.5%）。从这些数值中我们可以推断，研究中选择的属性很好地反映了消费者偏好，这是有用的品牌地图研究的关键特征。选择与客户偏好无关的属性会导致品牌地图对管理者价值有限。 + +最后一个表格显示属性公因子方差，这些数值表明每个属性数据中可被两个因子解释的变异比例。前面提到的累积方差是跨属性的整体度量。但我们也希望了解每个单独属性是否能被两个因子很好地代表。本示例中的数值整体表现优异（即均超过 90%）。 + +

    + +从仅显示品牌位置的地图开始会很有帮助。在 “绘图（Plot）” 标签页中勾选 “品牌（Brands）” 框创建地图。该图是因子 1 得分（水平轴）和因子 2 得分（垂直轴）的散点图。换句话说，品牌在因子 1 和因子 2 上的得分就是该品牌在地图中的坐标，零售商名称用作每个点的标签。 + +

    + +我们可以通过同时勾选 “品牌（Brands）” 和 “属性（Attributes）” 框，创建同时包含品牌位置（仍使用因子得分）和属性箭头（使用因子载荷）的品牌地图。箭头方向由属性与因子之间的相关程度（即因子载荷）决定。属性`Service`（服务）与因子 1 呈强正相关，因此主要指向因子 1 增值的方向（即向右）。由于`Service`与因子 2 的相关性略正，箭头向上而非向下。相反，属性`Convenience`（便利性）与因子 2 呈强正相关，因此主要指向因子 2 增值的方向（即向上）。由于其与因子 1 的相关性略正，箭头向右而非向左。箭头长度与 “摘要” 标签页中报告的公因子方差成比例，公因子方差越高，箭头越长。如果某个属性不能被导出的因子很好地汇总，其公因子方差会较低，该属性在品牌地图中的箭头会较短。 + +

    + +最后，我们可以通过勾选 “偏好（Preferences）” 框将偏好信息添加到地图中。细分群体偏好箭头的方向由因子得分与偏好得分之间的相关性决定。由于分配到细分群体 2 的受访者对零售商的偏好与因子 2 高度相关，箭头几乎垂直向上。细分群体 1 的偏好得分与因子 1 和因子 2 均呈负相关，因此箭头指向左下方向。 + +

    + +在图中，我们看到全食超市（Whole foods）和 Cub 食品超市在我们获取数据的属性上被感知为更具可比性，而例如全食超市和沃尔玛（Wal-Mart）则不然。管理者从图中可能会得出结论：地图上位置最接近的品牌被感知为密切替代品，因此在消费者心中是直接竞争对手。 + +没有属性信息的地图（例如基于（不）相似性数据的地图）的一个重要局限性是，难以解释品牌为何位置接近或疏远。如上图所示，通过向地图添加属性箭头，我们对地图中品牌位置的理解显著增强。例如，Jewel 和 Dominick's 在地图中位置较高，因为它们被感知为向消费者提供更高的便利性。同样，Cub 食品超市，尤其是全食超市，提供更高水平的客户服务和优质产品。我们还可以推断哪些可用属性与消费者偏好的关联最密切。细分群体 2 主要关注便利性，这可能解释了其对 Jewel 和 Dominick's 的较高偏好评分。同样，细分群体 2 最关注性价比（Good value），而对商品种类（Assortment）不太关注，该群体更喜欢在 Treasure Island 和沃尔玛购物。 + +## 纳入分类变量 + + + +基于属性的感知地图通过主成分分析（PCA）计算。用于 PCA 的相关矩阵目前仅可基于`numeric`、`integer`和`date`类型的变量计算。但偏好信息可以是`numeric`、`integer`、`date`和`factor`类型。当纳入因子型偏好变量时，因子得分与偏好数据之间的相关性将使用`polycor::hetcor`计算。因子型变量将被视为（有序）分类变量，其他所有变量将被视为连续变量。 + +### 报告 > Rmd + +通过点击屏幕左下角的图标或按键盘上的`ALT-enter`，向*报告 > Rmd*添加代码以（重新）创建分析。 + +### R 函数 + +有关 Radiant 中用于生成品牌地图的相关 R 函数概述，请参见*多元分析 > 感知图*。 + +`prmap`工具中使用的核心函数包括`stats`包中的`cor`和`cov`，以及`psych`包中的`principal`。 diff --git a/radiant.multivariate/inst/app/ui.R b/radiant.multivariate/inst/app/ui.R new file mode 100644 index 0000000000000000000000000000000000000000..cc8142123ea1c2e79a61db7dd815bbd6311f6a64 --- /dev/null +++ b/radiant.multivariate/inst/app/ui.R @@ -0,0 +1,13 @@ +## ui for multivariate menu in radiant +navbar_proj( + do.call( + navbarPage, + c( + "Radiant for R", + getOption("radiant.nav_ui"), + getOption("radiant.multivariate_ui"), + getOption("radiant.shared_ui"), + help_menu("help_multivariate_ui") + ) + ) +) diff --git a/radiant.multivariate/inst/app/www/js/store.js b/radiant.multivariate/inst/app/www/js/store.js new file mode 100644 index 0000000000000000000000000000000000000000..3e6b60e0d8e1a098b0e458b2b7d5b7d593b099de --- /dev/null +++ b/radiant.multivariate/inst/app/www/js/store.js @@ -0,0 +1,17 @@ +$(document).keydown(function(event) { + if ($("#pm_store_name").is(":focus") && event.keyCode == 13) { + $("#pm_store").click(); + } else if ($("#ff_store_name").is(":focus") && event.keyCode == 13) { + $("#ff_store").click(); + } else if ($("#hc_store_name").is(":focus") && event.keyCode == 13) { + $("#hc_store").click(); + } else if ($("#km_store_name").is(":focus") && event.keyCode == 13) { + $("#km_store").click(); + } else if ($("#ca_store_pred_name").is(":focus") && event.keyCode == 13) { + $("#ca_store_pred").click(); + } else if ($("#ca_store_pw_name").is(":focus") && event.keyCode == 13) { + $("#ca_store_pw").click(); + } else if ($("#ca_store_iw_name").is(":focus") && event.keyCode == 13) { + $("#ca_store_iw").click(); + } +}); diff --git a/radiant.multivariate/inst/translations/translation_zh.csv b/radiant.multivariate/inst/translations/translation_zh.csv new file mode 100644 index 0000000000000000000000000000000000000000..5fe6a28a15e5e27dea50102600b986d64bddb186 --- /dev/null +++ b/radiant.multivariate/inst/translations/translation_zh.csv @@ -0,0 +1,191 @@ +en,zh,source +Help,帮助,"global.R, radiant.R" +Keyboard shortcuts,键盘快捷键,global.R +None,无,conjoint_ui.R +2-way,双因素交互,conjoint_ui.R +3-way,三因素交互,conjoint_ui.R +Data,数据,conjoint_ui.R +Command,命令,conjoint_ui.R +Data & Command,数据与命令,conjoint_ui.R +Part-worths,部分效用,conjoint_ui.R +Importance-weights,重要性权重,conjoint_ui.R +Profile evaluations:,方案评价:,conjoint_ui.R +Attributes:,属性:,conjoint_ui.R +Interactions:,交互作用:,conjoint_ui.R +By:,按:,conjoint_ui.R +Show:,显示:,conjoint_ui.R +Estimate model,估计模型,conjoint_ui.R +Re-estimate model,重新估计模型,conjoint_ui.R +Store all PWs in a new dataset:,将所有部分效用存入新数据集:,conjoint_ui.R +Provide data name,请输入数据名称,conjoint_ui.R +Store,存储,conjoint_ui.R +Store all IWs in a new dataset:,将所有重要性权重存入新数据集:,conjoint_ui.R +Store predictions:,存储预测结果:,conjoint_ui.R +in new dataset:,到新数据集中:,conjoint_ui.R +Prediction data:,预测数据:,conjoint_ui.R +Prediction input type:,预测输入类型:,conjoint_ui.R +Prediction command:,预测命令:,conjoint_ui.R +Plot predictions,绘制预测图,conjoint_ui.R +Reverse evaluation scores,反转评分,conjoint_ui.R +Additional regression output,附加回归输出,conjoint_ui.R +VIF,VIF,conjoint_ui.R +Conjoint plots:,联合分析图:,conjoint_ui.R +Scale PW plots,缩放部分效用图,conjoint_ui.R +Conjoint,联合分析,conjoint_ui.R +Summary,摘要,conjoint_ui.R +Predict,预测,conjoint_ui.R +Plot,绘图,conjoint_ui.R +** Press the Estimate button to run the conjoint analysis **,** 点击“估计模型”按钮运行联合分析 **,conjoint_ui.R +"This analysis requires a response variable of type integer\nor numeric and one or more explanatory variables. +If these variables are not available please select another dataset.",此分析需要一个整数或数值型的响应变量以及一个或多个解释变量。\n如果这些变量不可用，请选择其他数据集。\n\n,conjoint_ui.R +"Please select one or more explanatory variables of type factor. +If none are available please choose another dataset",请选择一个或多个因子型解释变量。\n如果没有可用变量，请选择其他数据集\n\n,conjoint_ui.R +** Press the Estimate button to estimate the model **,** 点击“估计模型”按钮来估计模型 **,conjoint_ui.R +** Select prediction input **,** 请选择预测输入 **,conjoint_ui.R +** Select data for prediction **,** 请选择用于预测的数据 **,conjoint_ui.R +** Enter prediction commands **,** 请输入预测命令 **,conjoint_ui.R +Please select a conjoint plot from the drop-down menu,请从下拉菜单中选择一个联合分析图,conjoint_ui.R +Estimating model,正在估计模型,conjoint_ui.R +Generating predictions,正在生成预测结果,conjoint_ui.R +Generating prediction plot,正在生成预测图,conjoint_ui.R +Generating plots,正在生成图形,"conjoint_ui.R, kclus_ui.R" +Storing PWs,正在存储部分效用,conjoint_ui.R +Storing IWs,正在存储重要性权重,conjoint_ui.R +Storing predictions,正在存储预测结果,conjoint_ui.R +Storing predictions in new dataset,正在将预测结果存储到新数据集,conjoint_ui.R +No output available. Press the Estimate button to generate results,暂无输出结果。请点击“估计模型”按钮生成结果,conjoint_ui.R +Save part worths,保存部分效用,conjoint_ui.R +Save predictions,保存预测结果,conjoint_ui.R +Save conjoint prediction plot,保存联合分析预测图,conjoint_ui.R +Save conjoint plot,保存联合分析图,conjoint_ui.R +Multivariate > Conjoint,多变量 > 联合分析,conjoint_ui.R +Principal components,主成分,full_factor_ui.R +Maximum Likelihood,极大似然,full_factor_ui.R +Varimax,方差最大旋转,full_factor_ui.R +Quartimax,四次最大旋转,full_factor_ui.R +Equamax,均方最大旋转,full_factor_ui.R +Promax,Promax 旋转,full_factor_ui.R +Oblimin,Oblimin 旋转,full_factor_ui.R +Simplimax,简单最大旋转,full_factor_ui.R +Multivariate > Factor,多变量 > 因子分析,full_factor_ui.R +Factor,因子分析,full_factor_ui.R +Respondents,受访者,full_factor_ui.R +Method:,方法：,full_factor_ui.R +Adjust for {factor} variables,针对 {factor} 变量进行调整,full_factor_ui.R +Nr. of factors:,因子数量：,full_factor_ui.R +Cutt-off:,截断值：,full_factor_ui.R +Sort factor loadings,对因子载荷排序,full_factor_ui.R +rotation:,旋转：,full_factor_ui.R +Save factor loadings,保存因子载荷,full_factor_ui.R +** Press the Estimate button to generate factor analysis results **,** 请点击“估计模型”按钮以生成因子分析结果 **,full_factor_ui.R +Variables:,变量：,full_factor_ui.R +Store factor scores:,存储因子得分：,full_factor_ui.R +Provide single variable name,请输入单个变量名,full_factor_ui.R +Save factor plots,保存因子图,full_factor_ui.R +Please select two or more variables,请选择两个或以上变量,full_factor_ui.R +Provide a correlation cutoff value in the range from 0 to 1,请输入 0 到 1 范围内的相关性截断值,full_factor_ui.R +Estimating factor solution,正在估计因子解,full_factor_ui.R +Generating factor plots,正在生成因子图,full_factor_ui.R +Ward's,沃德法,hclus_ui.R +Single,单连接,hclus_ui.R +Complete,全连接,hclus_ui.R +Average,平均连接,hclus_ui.R +McQuitty,麦奎蒂法,hclus_ui.R +Median,中位数法,hclus_ui.R +Centroid,质心法,hclus_ui.R +Squared euclidean,平方欧几里得,hclus_ui.R +Binary,二元距离,hclus_ui.R +Canberra,堪培拉距离,hclus_ui.R +Euclidian,欧几里得距离,hclus_ui.R +Gower,高尔距离,hclus_ui.R +Manhattan,曼哈顿距离,hclus_ui.R +Maximum,最大距离,hclus_ui.R +Minkowski,闵可夫斯基距离,hclus_ui.R +Scree,碎石图,hclus_ui.R +Change,变化图,hclus_ui.R +Dendrogram,树状图,hclus_ui.R +Multivariate > Cluster,多变量 > 聚类,hclus_ui.R +Hierarchical,层次聚类,hclus_ui.R +Distance measure:,距离度量:,hclus_ui.R +Select plot(s),选择图表,hclus_ui.R +Plot(s):,图表:,hclus_ui.R +Plot cutoff:,图表截断值:,hclus_ui.R +Max cases:,最大案例数:,hclus_ui.R +Standardize,标准化,hclus_ui.R +Number of clusters:,聚类数:,hclus_ui.R +Store cluster membership:,保存聚类成员:,hclus_ui.R +Hierarchical cluster analysis,层次聚类分析,hclus_ui.R +Save hierarchical cluster plots,保存层次聚类图,hclus_ui.R +"This analysis requires one or more variables of type integer or numeric. +If these variable types are not available please select another dataset.",此分析需要一个或多个整数或数值型变量。\n如果这些变量类型不可用，请选择其他数据集。\n\n,hclus_ui.R +Generating cluster plot,正在生成聚类图,hclus_ui.R +Labels:,标签:,hclus_ui.R +Provide variable name,输入变量名称,hclus_ui.R +** Press the Estimate button to generate cluster solution **,** 点击“估计模型”按钮以生成聚类结果 **,hclus_ui.R +Estimating cluster solution,正在计算聚类结果,hclus_ui.R +Density,密度图,kclus_ui.R +Bar,条形图,kclus_ui.R +Scatter,散点图,kclus_ui.R +K-means,K-均值,kclus_ui.R +K-proto,K-原型,kclus_ui.R +K-clustering,K-聚类,kclus_ui.R +Algorithm:,算法：,kclus_ui.R +Initial centers from HC,使用层次聚类初始化中心,kclus_ui.R +Set random seed:,设置随机种子：,kclus_ui.R +Save clustering results ,保存聚类结果 ,kclus_ui.R +** Press the Estimate button to generate the cluster solution **,** 请点击“估计模型”按钮以生成聚类结果 **,kclus_ui.R +Lambda:,Lambda：,kclus_ui.R +"This analysis requires one or more variables of type numeric or integer. +If these variable types are not available please select another dataset.",此分析需要一个或多个数值型或整数型变量。\n如果这些变量类型不可用，请选择其他数据集。,kclus_ui.R +Save k-cluster plots,保存 K-聚类图,kclus_ui.R +Please select a plot type from the drop-down menu,请从下拉菜单中选择图表类型,kclus_ui.R +"This analysis requires multiple variables of type numeric or integer. +If these variables are not available please select another dataset.",该分析需要多个数值型或整数型变量。\n如果这些变量不可用，请选择其他数据集。,full_factor_ui.R +"Plot requires 2 or more factors. +Change the number of factors in the Summary tab and re-estimate",绘图需要 2 个或更多因子。\n请在“摘要”选项卡中更改因子数量并重新估计,full_factor_ui.R +2 dimensions,二维,mds_ui.R +3 dimensions,三维,mds_ui.R +metric,度量型,mds_ui.R +non-metric,非度量型,mds_ui.R +Multivariate > Maps,多变量 > 映射,mds_ui.R +(Dis)similarity,（不）相似性,mds_ui.R +Font size:,字体大小：,mds_ui.R +(Dis)similarity based brand maps (MDS),基于（不）相似性的品牌地图（MDS）,mds_ui.R +Save MDS coordinates,保存 MDS 坐标,mds_ui.R +** Press the Estimate button to generate maps **,** 请点击“估计模型”按钮以生成地图 **,mds_ui.R +ID 1:,ID 1：,mds_ui.R +ID 2:,ID 2：,mds_ui.R +Dissimilarity:,相异度：,mds_ui.R +Generating MDS solution,正在生成 MDS 解,mds_ui.R +Save MDS plot,保存 MDS 图,mds_ui.R +Reverse:,反向：,mds_ui.R +Pre-factor,预因子,pre_factor_ui.R +Pre-factor analysis,预因子分析,pre_factor_ui.R +** Press the Estimate button to generate factor analysis diagnostics **,** 请点击“估计模型”按钮以生成因子分析诊断 **,pre_factor_ui.R +Save pre-factor plot,保存预因子图,pre_factor_ui.R +Please select two or more numeric variables,请选择两个或更多数值变量,pre_factor_ui.R +Loadings cutoff:,因子载荷阈值：,prmap_ui.R +Attribute scale:,指标刻度：,prmap_ui.R +Attribute based brand maps,基于指标的机构感知图,prmap_ui.R +** Press the Estimate button to generate perceptual maps **,** 点击“估计模型”按钮生成感知图 **,prmap_ui.R +Brand:,机构变量：,prmap_ui.R +"This analysis requires a brand variable of type factor or character and multiple attribute variables +of type numeric or integer. If these variables are not available please select another dataset.",本分析需要一个因子型或字符型的机构变量，以及多个数值型或整型的指标变量。\n如果数据集中不包含这些变量，请选择其他数据集。\n\n,prmap_ui.R +Save preceptual map plot,保存感知图,prmap_ui.R +Brands,机构,prmap_ui.R +Preferences:,偏好：,prmap_ui.R +Preferences,偏好,prmap_ui.R +Please select two or more attribute variables,请选择两个或更多属性变量,prmap_ui.R +Generating perceptual map,正在生成感知地图,prmap_ui.R +Generating brand maps,正在生成机构地图,prmap_ui.R +Multivariate,多变量,init.R +Maps,感知图,init.R +(Dis)similarity,(不)相似性分析,init.R +Attributes,属性分析,init.R +Factor,因子分析,init.R +Pre-factor,因子分析准备,init.R +Cluster,聚类分析,init.R +Hierarchical,层次聚类,init.R +K-clustering,K均值聚类,init.R +Conjoint,联合分析,init.R +Conjoint,联合分析,init.R diff --git a/radiant.multivariate/man/carpet.Rd b/radiant.multivariate/man/carpet.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f3d23c67bd92e1107bc17246eb1c93962799236c --- /dev/null +++ b/radiant.multivariate/man/carpet.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{carpet} +\alias{carpet} +\title{Carpet cleaners} +\format{ +A data frame with 18 rows and 5 variables +} +\usage{ +data(carpet) +} +\description{ +Carpet cleaners +} +\details{ +Rankings reflect the evaluation of 18 alternative carpet cleaners by one respondent. Description provided in attr(carpet," description") +} +\keyword{datasets} diff --git a/radiant.multivariate/man/city.Rd b/radiant.multivariate/man/city.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a037f75e77af5e61a19f6dc2fb67e28621146116 --- /dev/null +++ b/radiant.multivariate/man/city.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{city} +\alias{city} +\title{City distances} +\format{ +A data frame with 45 rows and 3 variables +} +\usage{ +data(city) +} +\description{ +City distances +} +\details{ +Distance in miles between nine cities in the USA. The dataset is used to illustrate multi-dimensional scaling (MDS). Description provided in attr(city, "description") +} +\keyword{datasets} diff --git a/radiant.multivariate/man/city2.Rd b/radiant.multivariate/man/city2.Rd new file mode 100644 index 0000000000000000000000000000000000000000..ddc055200de50605ee2b2164a5570bd6b0c11153 --- /dev/null +++ b/radiant.multivariate/man/city2.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{city2} +\alias{city2} +\title{City distances 2} +\format{ +A data frame with 78 rows and 3 variables +} +\usage{ +data(city2) +} +\description{ +City distances 2 +} +\details{ +Distance in miles between 12 cities in the USA. The dataset is used to illustrate multi-dimensional scaling (MDS). Description provided in attr(city2, "description") +} +\keyword{datasets} diff --git a/radiant.multivariate/man/clean_loadings.Rd b/radiant.multivariate/man/clean_loadings.Rd new file mode 100644 index 0000000000000000000000000000000000000000..4a48a38b6ee63e785701c9475818f4f5a5720eff --- /dev/null +++ b/radiant.multivariate/man/clean_loadings.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/full_factor.R +\name{clean_loadings} +\alias{clean_loadings} +\title{Sort and clean loadings} +\usage{ +clean_loadings(floadings, cutoff = 0, fsort = FALSE, dec = 8, repl = NA) +} +\arguments{ +\item{floadings}{Data frame with loadings} + +\item{cutoff}{Show only loadings with (absolute) values above cutoff (default = 0)} + +\item{fsort}{Sort factor loadings} + +\item{dec}{Number of decimals to show} + +\item{repl}{Replace loadings below the cutoff by NA (or "")} +} +\description{ +Sort and clean loadings +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/full_factor.html} for an example in Radiant +} +\examples{ +result <- full_factor(shopping, "v1:v6", nr_fact = 2) +clean_loadings(result$floadings, fsort = TRUE, cutoff = .5, dec = 2) + +} diff --git a/radiant.multivariate/man/computer.Rd b/radiant.multivariate/man/computer.Rd new file mode 100644 index 0000000000000000000000000000000000000000..33204ff1a6a253a5cb90ed02313fdf015dc20c78 --- /dev/null +++ b/radiant.multivariate/man/computer.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{computer} +\alias{computer} +\title{Perceptions of computer (re)sellers} +\format{ +A data frame with 5 rows and 8 variables +} +\usage{ +data(computer) +} +\description{ +Perceptions of computer (re)sellers +} +\details{ +Perceptions of computer (re)sellers. The dataset is used to illustrate perceptual maps. Description provided in attr(computer, "description") +} +\keyword{datasets} diff --git a/radiant.multivariate/man/conjoint.Rd b/radiant.multivariate/man/conjoint.Rd new file mode 100644 index 0000000000000000000000000000000000000000..87d097f5ebbf41f2bdbb25f062fa357b0fc9e317 --- /dev/null +++ b/radiant.multivariate/man/conjoint.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/conjoint.R +\name{conjoint} +\alias{conjoint} +\title{Conjoint analysis} +\usage{ +conjoint( + dataset, + rvar, + evar, + int = "", + by = "none", + reverse = FALSE, + data_filter = "", + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{rvar}{The response variable (e.g., profile ratings)} + +\item{evar}{Explanatory variables in the regression} + +\item{int}{Interaction terms to include in the model} + +\item{by}{Variable to group data by before analysis (e.g., a respondent id)} + +\item{reverse}{Reverse the values of the response variable (`rvar`)} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{envir}{Environment to extract data from} +} +\value{ +A list with all variables defined in the function as an object of class conjoint +} +\description{ +Conjoint analysis +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/conjoint.html} for an example in Radiant +} +\examples{ +conjoint(mp3, rvar = "Rating", evar = "Memory:Shape") \%>\% str() + +} +\seealso{ +\code{\link{summary.conjoint}} to summarize results + +\code{\link{plot.conjoint}} to plot results +} diff --git a/radiant.multivariate/man/full_factor.Rd b/radiant.multivariate/man/full_factor.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a00084a7add1bb2bbd3ee31c76163caf2a98c1a6 --- /dev/null +++ b/radiant.multivariate/man/full_factor.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/full_factor.R +\name{full_factor} +\alias{full_factor} +\title{Factor analysis (PCA)} +\usage{ +full_factor( + dataset, + vars, + method = "PCA", + hcor = FALSE, + nr_fact = 1, + rotation = "varimax", + data_filter = "", + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{vars}{Variables to include in the analysis} + +\item{method}{Factor extraction method to use} + +\item{hcor}{Use polycor::hetcor to calculate the correlation matrix} + +\item{nr_fact}{Number of factors to extract} + +\item{rotation}{Apply varimax rotation or no rotation ("varimax" or "none")} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{envir}{Environment to extract data from} +} +\value{ +A list with all variables defined in the function as an object of class full_factor +} +\description{ +Factor analysis (PCA) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/full_factor.html} for an example in Radiant +} +\examples{ +full_factor(shopping, "v1:v6") \%>\% str() + +} +\seealso{ +\code{\link{summary.full_factor}} to summarize results + +\code{\link{plot.full_factor}} to plot results +} diff --git a/radiant.multivariate/man/hclus.Rd b/radiant.multivariate/man/hclus.Rd new file mode 100644 index 0000000000000000000000000000000000000000..5f08775e253b18d34e33c70abfb0fc0e101e5470 --- /dev/null +++ b/radiant.multivariate/man/hclus.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/hclus.R +\name{hclus} +\alias{hclus} +\title{Hierarchical cluster analysis} +\usage{ +hclus( + dataset, + vars, + labels = "none", + distance = "sq.euclidian", + method = "ward.D", + max_cases = 5000, + standardize = TRUE, + data_filter = "", + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{vars}{Vector of variables to include in the analysis} + +\item{labels}{A vector of labels for the leaves of the tree} + +\item{distance}{Distance} + +\item{method}{Method} + +\item{max_cases}{Maximum number of cases allowed (default is 1000). Set to avoid long-running analysis in the radiant web-interface} + +\item{standardize}{Standardized data (TRUE or FALSE)} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{envir}{Environment to extract data from} +} +\value{ +A list of all variables used in hclus as an object of class hclus +} +\description{ +Hierarchical cluster analysis +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/hclus.html} for an example in Radiant +} +\examples{ +hclus(shopping, vars = "v1:v6") \%>\% str() + +} +\seealso{ +\code{\link{summary.hclus}} to summarize results + +\code{\link{plot.hclus}} to plot results +} diff --git a/radiant.multivariate/man/kclus.Rd b/radiant.multivariate/man/kclus.Rd new file mode 100644 index 0000000000000000000000000000000000000000..cc6b11ce46dea22042b9f30d5dbfaf124525ba65 --- /dev/null +++ b/radiant.multivariate/man/kclus.Rd @@ -0,0 +1,65 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/kclus.R +\name{kclus} +\alias{kclus} +\title{K-clustering} +\usage{ +kclus( + dataset, + vars, + fun = "kmeans", + hc_init = TRUE, + distance = "sq.euclidian", + method = "ward.D", + seed = 1234, + nr_clus = 2, + standardize = TRUE, + lambda = NULL, + data_filter = "", + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{vars}{Vector of variables to include in the analysis} + +\item{fun}{Use either "kmeans" or "kproto" for clustering} + +\item{hc_init}{Use centers from hclus as the starting point} + +\item{distance}{Distance for hclus} + +\item{method}{Method for hclus} + +\item{seed}{Random see to use for k-clustering if hc_init is FALSE} + +\item{nr_clus}{Number of clusters to extract} + +\item{standardize}{Standardize data (TRUE or FALSE)} + +\item{lambda}{Parameter > 0 to trade off between Euclidean distance of numeric variables and simple matching coefficient between categorical variables. Also a vector of variable specific factors is possible where the order must correspond to the order of the variables in the data. In this case all variables' distances will be multiplied by their corresponding lambda value.} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{envir}{Environment to extract data from} +} +\value{ +A list of all variables used in kclus as an object of class kclus +} +\description{ +K-clustering +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/kclus.html} for an example in Radiant +} +\examples{ +kclus(shopping, c("v1:v6"), nr_clus = 3) \%>\% str() +} +\seealso{ +\code{\link{summary.kclus}} to summarize results + +\code{\link{plot.kclus}} to plot results + +\code{\link{store.kclus}} to add cluster membership to the selected dataset +} diff --git a/radiant.multivariate/man/mds.Rd b/radiant.multivariate/man/mds.Rd new file mode 100644 index 0000000000000000000000000000000000000000..9dee503a012d267b72b92f9fc9670572beb87516 --- /dev/null +++ b/radiant.multivariate/man/mds.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mds.R +\name{mds} +\alias{mds} +\title{(Dis)similarity based brand maps (MDS)} +\usage{ +mds( + dataset, + id1, + id2, + dis, + method = "metric", + nr_dim = 2, + seed = 1234, + data_filter = "", + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{id1}{A character variable or factor with unique entries} + +\item{id2}{A character variable or factor with unique entries} + +\item{dis}{A numeric measure of brand dissimilarity} + +\item{method}{Apply metric or non-metric MDS} + +\item{nr_dim}{Number of dimensions} + +\item{seed}{Random seed} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{envir}{Environment to extract data from} +} +\value{ +A list of all variables defined in the function as an object of class mds +} +\description{ +(Dis)similarity based brand maps (MDS) +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/mds.html} for an example in Radiant +} +\examples{ +mds(city, "from", "to", "distance") \%>\% str() +mds(diamonds, "clarity", "cut", "price") \%>\% str() + +} +\seealso{ +\code{\link{summary.mds}} to summarize results + +\code{\link{plot.mds}} to plot results +} diff --git a/radiant.multivariate/man/movie.Rd b/radiant.multivariate/man/movie.Rd new file mode 100644 index 0000000000000000000000000000000000000000..b3bffc0d58f3d339d04f9ffc6be4e4d0eb281849 --- /dev/null +++ b/radiant.multivariate/man/movie.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{movie} +\alias{movie} +\title{Conjoint data for Movie theaters} +\format{ +A data frame with 18 rows and 6 variables +} +\usage{ +data(movie) +} +\description{ +Conjoint data for Movie theaters +} +\details{ +Rankings reflect the evaluation of 18 alternative movie theaters by one respondent. Description provided in attr(movie, "description") +} +\keyword{datasets} diff --git a/radiant.multivariate/man/mp3.Rd b/radiant.multivariate/man/mp3.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f6acc09e4655f358d130a8404c8768770e8eb6e7 --- /dev/null +++ b/radiant.multivariate/man/mp3.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{mp3} +\alias{mp3} +\title{Conjoint data for MP3 players} +\format{ +A data frame with 18 rows and 6 variables +} +\usage{ +data(mp3) +} +\description{ +Conjoint data for MP3 players +} +\details{ +Ratings reflect the evaluation of 18 alternative MP3 players by one respondent. Description provided in attr(mp3, "description") +} +\keyword{datasets} diff --git a/radiant.multivariate/man/plot.conjoint.Rd b/radiant.multivariate/man/plot.conjoint.Rd new file mode 100644 index 0000000000000000000000000000000000000000..b529439345887022c1385c1710049edf3b972240 --- /dev/null +++ b/radiant.multivariate/man/plot.conjoint.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/conjoint.R +\name{plot.conjoint} +\alias{plot.conjoint} +\title{Plot method for the conjoint function} +\usage{ +\method{plot}{conjoint}( + x, + plots = "pw", + show = "", + scale_plot = FALSE, + shiny = FALSE, + custom = FALSE, + ... +) +} +\arguments{ +\item{x}{Return value from \code{\link{conjoint}}} + +\item{plots}{Show either the part-worth ("pw") or importance-weights ("iw") plot} + +\item{show}{Level in by variable to analyze (e.g., a specific respondent)} + +\item{scale_plot}{Scale the axes of the part-worth plots to the same range} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the conjoint function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/conjoint.html} for an example in Radiant +} +\examples{ +result <- conjoint(mp3, rvar = "Rating", evar = "Memory:Shape") +plot(result, scale_plot = TRUE) +plot(result, plots = "iw") + +} +\seealso{ +\code{\link{conjoint}} to generate results + +\code{\link{summary.conjoint}} to summarize results +} diff --git a/radiant.multivariate/man/plot.full_factor.Rd b/radiant.multivariate/man/plot.full_factor.Rd new file mode 100644 index 0000000000000000000000000000000000000000..6573879dbef661d9306a81a0eba74b545a7abcbd --- /dev/null +++ b/radiant.multivariate/man/plot.full_factor.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/full_factor.R +\name{plot.full_factor} +\alias{plot.full_factor} +\title{Plot method for the full_factor function} +\usage{ +\method{plot}{full_factor}(x, plots = "attr", shiny = FALSE, custom = FALSE, ...) +} +\arguments{ +\item{x}{Return value from \code{\link{full_factor}}} + +\item{plots}{Include attribute ("attr"), respondents ("resp") or both in the plot} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the full_factor function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/full_factor.html} for an example in Radiant +} +\examples{ +result <- full_factor(shopping, "v1:v6", nr_fact = 2) +plot(result) + +} +\seealso{ +\code{\link{full_factor}} to calculate results + +\code{\link{plot.full_factor}} to plot results +} diff --git a/radiant.multivariate/man/plot.hclus.Rd b/radiant.multivariate/man/plot.hclus.Rd new file mode 100644 index 0000000000000000000000000000000000000000..8cfce38bfbdcc7c0adc8eb15046ad05ad2d9565c --- /dev/null +++ b/radiant.multivariate/man/plot.hclus.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/hclus.R +\name{plot.hclus} +\alias{plot.hclus} +\title{Plot method for the hclus function} +\usage{ +\method{plot}{hclus}( + x, + plots = c("scree", "change"), + cutoff = 0.05, + shiny = FALSE, + custom = FALSE, + ... +) +} +\arguments{ +\item{x}{Return value from \code{\link{hclus}}} + +\item{plots}{Plots to return. "change" shows the percentage change in within-cluster heterogeneity as respondents are grouped into different number of clusters, "dendro" shows the dendrogram, "scree" shows a scree plot of within-cluster heterogeneity} + +\item{cutoff}{For large datasets plots can take time to render and become hard to interpret. By selection a cutoff point (e.g., 0.05 percent) the initial steps in hierarchical cluster analysis are removed from the plot} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the hclus function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/hclus.html} for an example in Radiant +} +\examples{ +result <- hclus(shopping, vars = c("v1:v6")) +plot(result, plots = c("change", "scree"), cutoff = .05) +plot(result, plots = "dendro", cutoff = 0) + +} +\seealso{ +\code{\link{hclus}} to generate results + +\code{\link{summary.hclus}} to summarize results +} diff --git a/radiant.multivariate/man/plot.kclus.Rd b/radiant.multivariate/man/plot.kclus.Rd new file mode 100644 index 0000000000000000000000000000000000000000..9d8dd9d2163e2fa15c04c44e404d4af4085813ff --- /dev/null +++ b/radiant.multivariate/man/plot.kclus.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/kclus.R +\name{plot.kclus} +\alias{plot.kclus} +\title{Plot method for kclus} +\usage{ +\method{plot}{kclus}(x, plots = "density", shiny = FALSE, custom = FALSE, ...) +} +\arguments{ +\item{x}{Return value from \code{\link{kclus}}} + +\item{plots}{One of "density", "bar", or "scatter")} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for kclus +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/kclus.html} for an example in Radiant +} +\examples{ +result <- kclus(shopping, vars = "v1:v6", nr_clus = 3) +plot(result) +} +\seealso{ +\code{\link{kclus}} to generate results + +\code{\link{summary.kclus}} to summarize results + +\code{\link{store.kclus}} to add cluster membership to the selected dataset +} diff --git a/radiant.multivariate/man/plot.mds.Rd b/radiant.multivariate/man/plot.mds.Rd new file mode 100644 index 0000000000000000000000000000000000000000..1e3fd9a9f11331a2ff574fbafe62713c6c865e5e --- /dev/null +++ b/radiant.multivariate/man/plot.mds.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mds.R +\name{plot.mds} +\alias{plot.mds} +\title{Plot method for the mds function} +\usage{ +\method{plot}{mds}(x, rev_dim = NULL, fontsz = 5, shiny = FALSE, custom = FALSE, ...) +} +\arguments{ +\item{x}{Return value from \code{\link{mds}}} + +\item{rev_dim}{Flip the axes in plots} + +\item{fontsz}{Font size to use in plots} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the mds function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/mds.html} for an example in Radiant +} +\examples{ +result <- mds(city, "from", "to", "distance") +plot(result, fontsz = 7) +plot(result, rev_dim = 1:2) + +} +\seealso{ +\code{\link{mds}} to calculate results + +\code{\link{summary.mds}} to plot results +} diff --git a/radiant.multivariate/man/plot.pre_factor.Rd b/radiant.multivariate/man/plot.pre_factor.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d45cb957786132beaaaf1ddff606c40d576f7720 --- /dev/null +++ b/radiant.multivariate/man/plot.pre_factor.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pre_factor.R +\name{plot.pre_factor} +\alias{plot.pre_factor} +\title{Plot method for the pre_factor function} +\usage{ +\method{plot}{pre_factor}( + x, + plots = c("scree", "change"), + cutoff = 0.2, + shiny = FALSE, + custom = FALSE, + ... +) +} +\arguments{ +\item{x}{Return value from \code{\link{pre_factor}}} + +\item{plots}{Plots to return. "change" shows the change in eigenvalues as variables are grouped into different number of factors, "scree" shows a scree plot of eigenvalues} + +\item{cutoff}{For large datasets plots can take time to render and become hard to interpret. By selection a cutoff point (e.g., eigenvalues of .8 or higher) factors with the least explanatory power are removed from the plot} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the pre_factor function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/pre_factor.html} for an example in Radiant +} +\examples{ +result <- pre_factor(shopping, "v1:v6") +plot(result, plots = c("change", "scree"), cutoff = .05) +} +\seealso{ +\code{\link{pre_factor}} to calculate results + +\code{\link{summary.pre_factor}} to summarize results +} diff --git a/radiant.multivariate/man/plot.prmap.Rd b/radiant.multivariate/man/plot.prmap.Rd new file mode 100644 index 0000000000000000000000000000000000000000..0ff7ceef86e34f962d5abe39010e6f5799d1966f --- /dev/null +++ b/radiant.multivariate/man/plot.prmap.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prmap.R +\name{plot.prmap} +\alias{plot.prmap} +\title{Plot method for the prmap function} +\usage{ +\method{plot}{prmap}( + x, + plots = "", + scaling = 2, + fontsz = 5, + seed = 1234, + shiny = FALSE, + custom = FALSE, + ... +) +} +\arguments{ +\item{x}{Return value from \code{\link{prmap}}} + +\item{plots}{Components to include in the plot ("brand", "attr"). If data on preferences is available use "pref" to add preference arrows to the plot} + +\item{scaling}{Arrow scaling in the brand map} + +\item{fontsz}{Font size to use in plots} + +\item{seed}{Random seed} + +\item{shiny}{Did the function call originate inside a shiny app} + +\item{custom}{Logical (TRUE, FALSE) to indicate if ggplot object (or list of ggplot objects) should be returned. This option can be used to customize plots (e.g., add a title, change x and y labels, etc.). See examples and \url{https://ggplot2.tidyverse.org/} for options.} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Plot method for the prmap function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/prmap.html} for an example in Radiant +} +\examples{ +result <- prmap(computer, brand = "brand", attr = "high_end:business") +plot(result, plots = "brand") +plot(result, plots = c("brand", "attr")) +plot(result, scaling = 1, plots = c("brand", "attr")) +prmap( + retailers, + brand = "retailer", + attr = "good_value:cluttered", + pref = c("segment1", "segment2") +) \%>\% plot(plots = c("brand", "attr", "pref")) + +} +\seealso{ +\code{\link{prmap}} to calculate results + +\code{\link{summary.prmap}} to plot results +} diff --git a/radiant.multivariate/man/pre_factor.Rd b/radiant.multivariate/man/pre_factor.Rd new file mode 100644 index 0000000000000000000000000000000000000000..086543b0815182124095b0d7f1889fa209b993e7 --- /dev/null +++ b/radiant.multivariate/man/pre_factor.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pre_factor.R +\name{pre_factor} +\alias{pre_factor} +\title{Evaluate if data are appropriate for PCA / Factor analysis} +\usage{ +pre_factor( + dataset, + vars, + hcor = FALSE, + data_filter = "", + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{vars}{Variables to include in the analysis} + +\item{hcor}{Use polycor::hetcor to calculate the correlation matrix} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{envir}{Environment to extract data from} +} +\value{ +A list with all variables defined in the function as an object of class pre_factor +} +\description{ +Evaluate if data are appropriate for PCA / Factor analysis +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/pre_factor.html} for an example in Radiant +} +\examples{ +pre_factor(shopping, "v1:v6") \%>\% str() + +} +\seealso{ +\code{\link{summary.pre_factor}} to summarize results + +\code{\link{plot.pre_factor}} to plot results +} diff --git a/radiant.multivariate/man/predict.conjoint.Rd b/radiant.multivariate/man/predict.conjoint.Rd new file mode 100644 index 0000000000000000000000000000000000000000..713409384cff72dc8fc0b99416075dbad769e732 --- /dev/null +++ b/radiant.multivariate/man/predict.conjoint.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/conjoint.R +\name{predict.conjoint} +\alias{predict.conjoint} +\title{Predict method for the conjoint function} +\usage{ +\method{predict}{conjoint}( + object, + pred_data = NULL, + pred_cmd = "", + conf_lev = 0.95, + se = FALSE, + interval = "confidence", + dec = 3, + envir = parent.frame(), + ... +) +} +\arguments{ +\item{object}{Return value from \code{\link{conjoint}}} + +\item{pred_data}{Provide the dataframe to generate predictions. The dataset must contain all columns used in the estimation} + +\item{pred_cmd}{Command used to generate data for prediction} + +\item{conf_lev}{Confidence level used to estimate confidence intervals (.95 is the default)} + +\item{se}{Logical that indicates if prediction standard errors should be calculated (default = FALSE)} + +\item{interval}{Type of interval calculation ("confidence" or "prediction"). Set to "none" if se is FALSE} + +\item{dec}{Number of decimals to show} + +\item{envir}{Environment to extract data from} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Predict method for the conjoint function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/conjoint.html} for an example in Radiant +} +\examples{ +result <- conjoint(mp3, rvar = "Rating", evar = "Memory:Shape") +predict(result, pred_data = mp3) + +} +\seealso{ +\code{\link{conjoint}} to generate the result + +\code{\link{summary.conjoint}} to summarize results + +\code{\link{plot.conjoint}} to plot results +} diff --git a/radiant.multivariate/man/predict_conjoint_by.Rd b/radiant.multivariate/man/predict_conjoint_by.Rd new file mode 100644 index 0000000000000000000000000000000000000000..6db04af79181e6c1a3afb26ea0acb00f9cd2e01c --- /dev/null +++ b/radiant.multivariate/man/predict_conjoint_by.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/conjoint.R +\name{predict_conjoint_by} +\alias{predict_conjoint_by} +\title{Predict method for the conjoint function when a by variables is used} +\usage{ +predict_conjoint_by( + object, + pfun, + pred_data = NULL, + pred_cmd = "", + conf_lev = 0.95, + se = FALSE, + dec = 3, + envir = parent.frame(), + ... +) +} +\arguments{ +\item{object}{Return value from \code{\link{conjoint}}} + +\item{pfun}{Function to use for prediction} + +\item{pred_data}{Name of the dataset to use for prediction} + +\item{pred_cmd}{Command used to generate data for prediction} + +\item{conf_lev}{Confidence level used to estimate confidence intervals (.95 is the default)} + +\item{se}{Logical that indicates if prediction standard errors should be calculated (default = FALSE)} + +\item{dec}{Number of decimals to show} + +\item{envir}{Environment to extract data from} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Predict method for the conjoint function when a by variables is used +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/conjoint.html} for an example in Radiant +} +\seealso{ +\code{\link{conjoint}} to generate the result + +\code{\link{summary.conjoint}} to summarize results + +\code{\link{plot.conjoint}} to plot results +} diff --git a/radiant.multivariate/man/print.conjoint.predict.Rd b/radiant.multivariate/man/print.conjoint.predict.Rd new file mode 100644 index 0000000000000000000000000000000000000000..bdc0f6f434b192f72c7989e8d20b7a71cc940178 --- /dev/null +++ b/radiant.multivariate/man/print.conjoint.predict.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/conjoint.R +\name{print.conjoint.predict} +\alias{print.conjoint.predict} +\title{Print method for predict.conjoint} +\usage{ +\method{print}{conjoint.predict}(x, ..., n = 20) +} +\arguments{ +\item{x}{Return value from prediction method} + +\item{...}{further arguments passed to or from other methods} + +\item{n}{Number of lines of prediction results to print. Use -1 to print all lines} +} +\description{ +Print method for predict.conjoint +} diff --git a/radiant.multivariate/man/prmap.Rd b/radiant.multivariate/man/prmap.Rd new file mode 100644 index 0000000000000000000000000000000000000000..b793a6ac9700bf5ea0e487e9690f8246b98cf554 --- /dev/null +++ b/radiant.multivariate/man/prmap.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prmap.R +\name{prmap} +\alias{prmap} +\title{Attribute based brand maps} +\usage{ +prmap( + dataset, + brand, + attr, + pref = "", + nr_dim = 2, + hcor = FALSE, + data_filter = "", + envir = parent.frame() +) +} +\arguments{ +\item{dataset}{Dataset} + +\item{brand}{A character variable with brand names} + +\item{attr}{Names of numeric variables} + +\item{pref}{Names of numeric brand preference measures} + +\item{nr_dim}{Number of dimensions} + +\item{hcor}{Use polycor::hetcor to calculate the correlation matrix} + +\item{data_filter}{Expression entered in, e.g., Data > View to filter the dataset in Radiant. The expression should be a string (e.g., "price > 10000")} + +\item{envir}{Environment to extract data from} +} +\value{ +A list of all variables defined in the function as an object of class prmap +} +\description{ +Attribute based brand maps +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/prmap.html} for an example in Radiant +} +\examples{ +prmap(computer, brand = "brand", attr = "high_end:business") \%>\% str() + +} +\seealso{ +\code{\link{summary.prmap}} to summarize results + +\code{\link{plot.prmap}} to plot results +} diff --git a/radiant.multivariate/man/radiant.multivariate.Rd b/radiant.multivariate/man/radiant.multivariate.Rd new file mode 100644 index 0000000000000000000000000000000000000000..8a8cc3a98783ad3ba1abad5d58327f59c1359b94 --- /dev/null +++ b/radiant.multivariate/man/radiant.multivariate.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R, R/radiant.R +\name{radiant.multivariate} +\alias{radiant.multivariate} +\title{radiant.multivariate} +\usage{ +radiant.multivariate(state, ...) +} +\arguments{ +\item{state}{Path to state file to load} + +\item{...}{additional arguments to pass to shiny::runApp (e.g, port = 8080)} +} +\description{ +Launch radiant.multivariate in the default web browser +} +\details{ +See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +} +\examples{ +\dontrun{ +radiant.multivariate() +} +} diff --git a/radiant.multivariate/man/radiant.multivariate_viewer.Rd b/radiant.multivariate/man/radiant.multivariate_viewer.Rd new file mode 100644 index 0000000000000000000000000000000000000000..045c7a9d3934a544e2af93121c944622a46f5be7 --- /dev/null +++ b/radiant.multivariate/man/radiant.multivariate_viewer.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{radiant.multivariate_viewer} +\alias{radiant.multivariate_viewer} +\title{Launch radiant.multivariate in the Rstudio viewer} +\usage{ +radiant.multivariate_viewer(state, ...) +} +\arguments{ +\item{state}{Path to state file to load} + +\item{...}{additional arguments to pass to shiny::runApp (e.g, port = 8080)} +} +\description{ +Launch radiant.multivariate in the Rstudio viewer +} +\details{ +See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +} +\examples{ +\dontrun{ +radiant.multivariate_viewer() +} +} diff --git a/radiant.multivariate/man/radiant.multivariate_window.Rd b/radiant.multivariate/man/radiant.multivariate_window.Rd new file mode 100644 index 0000000000000000000000000000000000000000..176f8d43a6d177ad7ed235712631e9e14fca18bb --- /dev/null +++ b/radiant.multivariate/man/radiant.multivariate_window.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{radiant.multivariate_window} +\alias{radiant.multivariate_window} +\title{Launch radiant.multivariate in an Rstudio window} +\usage{ +radiant.multivariate_window(state, ...) +} +\arguments{ +\item{state}{Path to state file to load} + +\item{...}{additional arguments to pass to shiny::runApp (e.g, port = 8080)} +} +\description{ +Launch radiant.multivariate in an Rstudio window +} +\details{ +See \url{https://radiant-rstats.github.io/docs/} for documentation and tutorials +} +\examples{ +\dontrun{ +radiant.multivariate_window() +} +} diff --git a/radiant.multivariate/man/retailers.Rd b/radiant.multivariate/man/retailers.Rd new file mode 100644 index 0000000000000000000000000000000000000000..e60a00a28f45d88e1eb514fd6388d46a9632c822 --- /dev/null +++ b/radiant.multivariate/man/retailers.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{retailers} +\alias{retailers} +\title{Perceptions of retailers} +\format{ +A data frame with 6 rows and 10 variables +} +\usage{ +data(retailers) +} +\description{ +Perceptions of retailers +} +\details{ +Consumer evaluations for a set of retailers in the Chicago area on 7 attributes. The dataset is used to illustrate perceptual maps. Description provided in attr(retailers, "description") +} +\keyword{datasets} diff --git a/radiant.multivariate/man/shopping.Rd b/radiant.multivariate/man/shopping.Rd new file mode 100644 index 0000000000000000000000000000000000000000..8ac9993caf095e39e68823be5ec4c07bff377a3b --- /dev/null +++ b/radiant.multivariate/man/shopping.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{shopping} +\alias{shopping} +\title{Shopping attitudes} +\format{ +A data frame with 20 rows and 7 variables +} +\usage{ +data(shopping) +} +\description{ +Shopping attitudes +} +\details{ +Attitudinal data on shopping for 20 consumers. Description provided in attr(shopping, "description") +} +\keyword{datasets} diff --git a/radiant.multivariate/man/store.conjoint.Rd b/radiant.multivariate/man/store.conjoint.Rd new file mode 100644 index 0000000000000000000000000000000000000000..07bcd60318ccd7ceccf32503aaf1ebf149aebebb --- /dev/null +++ b/radiant.multivariate/man/store.conjoint.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/conjoint.R +\name{store.conjoint} +\alias{store.conjoint} +\title{Store method for the Multivariate > Conjoint tab} +\usage{ +\method{store}{conjoint}(dataset, object, name, ...) +} +\arguments{ +\item{dataset}{Dataset} + +\item{object}{Return value from conjoint} + +\item{name}{Variable name(s) assigned to predicted values} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Store method for the Multivariate > Conjoint tab +} +\details{ +Store data frame with PWs or IWs in Radiant r_data list if available +} diff --git a/radiant.multivariate/man/store.conjoint.predict.Rd b/radiant.multivariate/man/store.conjoint.predict.Rd new file mode 100644 index 0000000000000000000000000000000000000000..88cf4705fcdf6471a3cfe4b0b000b0d703360202 --- /dev/null +++ b/radiant.multivariate/man/store.conjoint.predict.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/conjoint.R +\name{store.conjoint.predict} +\alias{store.conjoint.predict} +\title{Store predicted values generated in predict.conjoint} +\usage{ +\method{store}{conjoint.predict}(dataset, object, name = "prediction", ...) +} +\arguments{ +\item{dataset}{Dataset to add predictions to} + +\item{object}{Return value from model predict function} + +\item{name}{Variable name(s) assigned to predicted values} + +\item{...}{Additional arguments} +} +\description{ +Store predicted values generated in predict.conjoint +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/conjoint.html} for an example in Radiant +} +\examples{ +conjoint(mp3, rvar = "Rating", evar = "Memory:Shape") \%>\% + predict(mp3) \%>\% + store(mp3, ., name = "pred_pref") + +} diff --git a/radiant.multivariate/man/store.full_factor.Rd b/radiant.multivariate/man/store.full_factor.Rd new file mode 100644 index 0000000000000000000000000000000000000000..c583bbd9fc883ed17a0afc6d6f373d86d333bf78 --- /dev/null +++ b/radiant.multivariate/man/store.full_factor.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/full_factor.R +\name{store.full_factor} +\alias{store.full_factor} +\title{Store factor scores to active dataset} +\usage{ +\method{store}{full_factor}(dataset, object, name = "", ...) +} +\arguments{ +\item{dataset}{Dataset to append to factor scores to} + +\item{object}{Return value from \code{\link{full_factor}}} + +\item{name}{Name of factor score variables} + +\item{...}{Additional arguments} +} +\description{ +Store factor scores to active dataset +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/full_factor.html} for an example in Radiant +} +\examples{ +full_factor(shopping, "v1:v6", nr_fact = 3) \%>\% + store(shopping, .) \%>\% + head() + +} +\seealso{ +\code{\link{full_factor}} to generate results + +\code{\link{summary.full_factor}} to summarize results + +\code{\link{plot.full_factor}} to plot results +} diff --git a/radiant.multivariate/man/store.hclus.Rd b/radiant.multivariate/man/store.hclus.Rd new file mode 100644 index 0000000000000000000000000000000000000000..cafe303811b34ad39d3701a54ba32de5c1da0ff8 --- /dev/null +++ b/radiant.multivariate/man/store.hclus.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/hclus.R +\name{store.hclus} +\alias{store.hclus} +\title{Add a cluster membership variable to the active dataset} +\usage{ +\method{store}{hclus}(dataset, object, nr_clus = 2, name = "", ...) +} +\arguments{ +\item{dataset}{Dataset to append to cluster membership variable to} + +\item{object}{Return value from \code{\link{hclus}}} + +\item{nr_clus}{Number of clusters to extract} + +\item{name}{Name of cluster membership variable} + +\item{...}{Additional arguments} +} +\description{ +Add a cluster membership variable to the active dataset +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/hclus.html} for an example in Radiant +} +\examples{ +hclus(shopping, vars = "v1:v6") \%>\% + store(shopping, ., nr_clus = 3) \%>\% + head() +} +\seealso{ +\code{\link{hclus}} to generate results + +\code{\link{summary.hclus}} to summarize results + +\code{\link{plot.hclus}} to plot results +} diff --git a/radiant.multivariate/man/store.kclus.Rd b/radiant.multivariate/man/store.kclus.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a78f8d42c09acdf84fc804e881cfc30901f2c0d6 --- /dev/null +++ b/radiant.multivariate/man/store.kclus.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/kclus.R +\name{store.kclus} +\alias{store.kclus} +\title{Add a cluster membership variable to the active dataset} +\usage{ +\method{store}{kclus}(dataset, object, name = "", ...) +} +\arguments{ +\item{dataset}{Dataset to append to cluster membership variable to} + +\item{object}{Return value from \code{\link{kclus}}} + +\item{name}{Name of cluster membership variable} + +\item{...}{Additional arguments} +} +\description{ +Add a cluster membership variable to the active dataset +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/kclus.html} for an example in Radiant +} +\examples{ +kclus(shopping, vars = "v1:v6", nr_clus = 3) \%>\% + store(shopping, .) \%>\% + head() +} +\seealso{ +\code{\link{kclus}} to generate results + +\code{\link{summary.kclus}} to summarize results + +\code{\link{plot.kclus}} to plot results +} diff --git a/radiant.multivariate/man/summary.conjoint.Rd b/radiant.multivariate/man/summary.conjoint.Rd new file mode 100644 index 0000000000000000000000000000000000000000..0b98de6d9ff9aec90e277072025868c62435e61a --- /dev/null +++ b/radiant.multivariate/man/summary.conjoint.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/conjoint.R +\name{summary.conjoint} +\alias{summary.conjoint} +\title{Summary method for the conjoint function} +\usage{ +\method{summary}{conjoint}(object, show = "", mc_diag = FALSE, additional = FALSE, dec = 3, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{conjoint}}} + +\item{show}{Level in by variable to analyze (e.g., a specific respondent)} + +\item{mc_diag}{Shows multicollinearity diagnostics.} + +\item{additional}{Show additional regression results} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the conjoint function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/conjoint.html} for an example in Radiant +} +\examples{ +result <- conjoint(mp3, rvar = "Rating", evar = "Memory:Shape") +summary(result, mc_diag = TRUE) + +} +\seealso{ +\code{\link{conjoint}} to generate results + +\code{\link{plot.conjoint}} to plot results +} diff --git a/radiant.multivariate/man/summary.full_factor.Rd b/radiant.multivariate/man/summary.full_factor.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a0d455b33c5bfdf4e65777f46b0ab8e7583ad3ed --- /dev/null +++ b/radiant.multivariate/man/summary.full_factor.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/full_factor.R +\name{summary.full_factor} +\alias{summary.full_factor} +\title{Summary method for the full_factor function} +\usage{ +\method{summary}{full_factor}(object, cutoff = 0, fsort = FALSE, dec = 2, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{full_factor}}} + +\item{cutoff}{Show only loadings with (absolute) values above cutoff (default = 0)} + +\item{fsort}{Sort factor loadings} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the full_factor function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/full_factor.html} for an example in Radiant +} +\examples{ +result <- full_factor(shopping, "v1:v6", nr_fact = 2) +summary(result) +summary(result, cutoff = .5, fsort = TRUE) + +} +\seealso{ +\code{\link{full_factor}} to calculate results + +\code{\link{plot.full_factor}} to plot results +} diff --git a/radiant.multivariate/man/summary.hclus.Rd b/radiant.multivariate/man/summary.hclus.Rd new file mode 100644 index 0000000000000000000000000000000000000000..ce3084935200396f1d21c0f6bb51c7079f2f89f6 --- /dev/null +++ b/radiant.multivariate/man/summary.hclus.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/hclus.R +\name{summary.hclus} +\alias{summary.hclus} +\title{Summary method for the hclus function} +\usage{ +\method{summary}{hclus}(object, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{hclus}}} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the hclus function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/hclus.html} for an example in Radiant +} +\examples{ +result <- hclus(shopping, vars = c("v1:v6")) +summary(result) + +} +\seealso{ +\code{\link{hclus}} to generate results + +\code{\link{plot.hclus}} to plot results +} diff --git a/radiant.multivariate/man/summary.kclus.Rd b/radiant.multivariate/man/summary.kclus.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a0b5c5ed3216cebd94697c19b6a6d40a51a26dce --- /dev/null +++ b/radiant.multivariate/man/summary.kclus.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/kclus.R +\name{summary.kclus} +\alias{summary.kclus} +\title{Summary method for kclus} +\usage{ +\method{summary}{kclus}(object, dec = 2, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{kclus}}} + +\item{dec}{Number of decimals to show} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for kclus +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/kclus.html} for an example in Radiant +} +\examples{ +result <- kclus(shopping, vars = "v1:v6", nr_clus = 3) +summary(result) +} +\seealso{ +\code{\link{kclus}} to generate results + +\code{\link{plot.kclus}} to plot results + +\code{\link{store.kclus}} to add cluster membership to the selected dataset +} diff --git a/radiant.multivariate/man/summary.mds.Rd b/radiant.multivariate/man/summary.mds.Rd new file mode 100644 index 0000000000000000000000000000000000000000..c3baa25549b45c0e4609c5040aa2ae7d0adcee49 --- /dev/null +++ b/radiant.multivariate/man/summary.mds.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mds.R +\name{summary.mds} +\alias{summary.mds} +\title{Summary method for the mds function} +\usage{ +\method{summary}{mds}(object, dec = 2, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{mds}}} + +\item{dec}{Rounding to use for output (default = 2). +1 used for stress measure} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the mds function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/mds.html} for an example in Radiant +} +\examples{ +result <- mds(city, "from", "to", "distance") +summary(result, dec = 1) + +} +\seealso{ +\code{\link{mds}} to calculate results + +\code{\link{plot.mds}} to plot results +} diff --git a/radiant.multivariate/man/summary.pre_factor.Rd b/radiant.multivariate/man/summary.pre_factor.Rd new file mode 100644 index 0000000000000000000000000000000000000000..ec27be3ef9ae5c19c5c3c23fe8a7eb0911c1e8ff --- /dev/null +++ b/radiant.multivariate/man/summary.pre_factor.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pre_factor.R +\name{summary.pre_factor} +\alias{summary.pre_factor} +\title{Summary method for the pre_factor function} +\usage{ +\method{summary}{pre_factor}(object, dec = 2, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{pre_factor}}} + +\item{dec}{Rounding to use for output} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the pre_factor function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/pre_factor.html} for an example in Radiant +} +\examples{ +result <- pre_factor(shopping, "v1:v6") +summary(result) +pre_factor(computer, "high_end:business") \%>\% summary() +} +\seealso{ +\code{\link{pre_factor}} to calculate results + +\code{\link{plot.pre_factor}} to plot results +} diff --git a/radiant.multivariate/man/summary.prmap.Rd b/radiant.multivariate/man/summary.prmap.Rd new file mode 100644 index 0000000000000000000000000000000000000000..4871c218d66b6b646d8cf15cb335e7ac12712bb0 --- /dev/null +++ b/radiant.multivariate/man/summary.prmap.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prmap.R +\name{summary.prmap} +\alias{summary.prmap} +\title{Summary method for the prmap function} +\usage{ +\method{summary}{prmap}(object, cutoff = 0, dec = 2, ...) +} +\arguments{ +\item{object}{Return value from \code{\link{prmap}}} + +\item{cutoff}{Show only loadings with (absolute) values above cutoff (default = 0)} + +\item{dec}{Rounding to use for output} + +\item{...}{further arguments passed to or from other methods} +} +\description{ +Summary method for the prmap function +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/prmap.html} for an example in Radiant +} +\examples{ +result <- prmap(computer, brand = "brand", attr = "high_end:business") +summary(result) +summary(result, cutoff = .3) +prmap( + computer, + brand = "brand", attr = "high_end:dated", + pref = c("innovative", "business") +) \%>\% summary() + +} +\seealso{ +\code{\link{prmap}} to calculate results + +\code{\link{plot.prmap}} to plot results +} diff --git a/radiant.multivariate/man/the_table.Rd b/radiant.multivariate/man/the_table.Rd new file mode 100644 index 0000000000000000000000000000000000000000..0481b3738d148a5f2573e726370ad6f93e37dfff --- /dev/null +++ b/radiant.multivariate/man/the_table.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/conjoint.R +\name{the_table} +\alias{the_table} +\title{Function to calculate the PW and IW table for conjoint} +\usage{ +the_table(model, dataset, evar) +} +\arguments{ +\item{model}{Tidied model results (broom) output from \code{\link{conjoint}} passed on by summary.conjoint} + +\item{dataset}{Conjoint data} + +\item{evar}{Explanatory variables used in the conjoint regression} +} +\description{ +Function to calculate the PW and IW table for conjoint +} +\details{ +See \url{https://radiant-rstats.github.io/docs/multivariate/conjoint.html} for an example in Radiant +} +\examples{ +result <- conjoint(mp3, rvar = "Rating", evar = "Memory:Shape") +the_table(tidy(result$model_list[[1]][["model"]]), result$dataset, result$evar) + +} +\seealso{ +\code{\link{conjoint}} to generate results + +\code{\link{summary.conjoint}} to summarize results + +\code{\link{plot.conjoint}} to plot results +} diff --git a/radiant.multivariate/man/toothpaste.Rd b/radiant.multivariate/man/toothpaste.Rd new file mode 100644 index 0000000000000000000000000000000000000000..35e3b25acea155e993857633cd0eee94742abe10 --- /dev/null +++ b/radiant.multivariate/man/toothpaste.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{toothpaste} +\alias{toothpaste} +\title{Toothpaste attitudes} +\format{ +A data frame with 60 rows and 10 variables +} +\usage{ +data(toothpaste) +} +\description{ +Toothpaste attitudes +} +\details{ +Attitudinal data on toothpaste for 60 consumers. Description provided in attr(toothpaste, "description") +} +\keyword{datasets} diff --git a/radiant.multivariate/man/tpbrands.Rd b/radiant.multivariate/man/tpbrands.Rd new file mode 100644 index 0000000000000000000000000000000000000000..444c5e73018df653fa10a05f8b545e34f1dd5985 --- /dev/null +++ b/radiant.multivariate/man/tpbrands.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa.R +\docType{data} +\name{tpbrands} +\alias{tpbrands} +\title{Toothpaste brands} +\format{ +A data frame with 45 rows and 4 variables +} +\usage{ +data(tpbrands) +} +\description{ +Toothpaste brands +} +\details{ +Perceived (dis)similarity of a set of toothpaste brands. The dataset is used to illustrate multi-dimensional scaling (MDS). Description provided in attr(tpbrands, "description") +} +\keyword{datasets} diff --git a/radiant.multivariate/radiant.multivariate.Rproj b/radiant.multivariate/radiant.multivariate.Rproj new file mode 100644 index 0000000000000000000000000000000000000000..42b95bd6243af660d7206c76d29c8e5c759a530c --- /dev/null +++ b/radiant.multivariate/radiant.multivariate.Rproj @@ -0,0 +1,22 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: knitr +LaTeX: pdfLaTeX + +AutoAppendNewline: Yes +StripTrailingWhitespace: Yes + +BuildType: Package +PackageUseDevtools: Yes +PackageInstallArgs: --no-multiarch --with-keep.source +PackageCheckArgs: --as-cran +PackageRoxygenize: rd,collate,namespace,vignette diff --git a/radiant.multivariate/tests/testthat.R b/radiant.multivariate/tests/testthat.R new file mode 100644 index 0000000000000000000000000000000000000000..800f82e0163f47603477b04bb2202dcb4b641081 --- /dev/null +++ b/radiant.multivariate/tests/testthat.R @@ -0,0 +1,4 @@ +## use shift-cmd-t to run all tests +library(testthat) +test_check("radiant.multivariate") +# if (interactive() && !exists("coverage_test")) devtools::run_examples() diff --git a/radiant.multivariate/tests/testthat/test_stats.R b/radiant.multivariate/tests/testthat/test_stats.R new file mode 100644 index 0000000000000000000000000000000000000000..4282b3746f55adf034416e8c1e90fe1ee485491f --- /dev/null +++ b/radiant.multivariate/tests/testthat/test_stats.R @@ -0,0 +1,112 @@ +# library(radiant.multivariate) +# library(testthat) +trim <- function(x) gsub("^\\s+|\\s+$", "", x) + +context("Maps") + +test_that("City MDS points", { + result <- mds(city, "from", "to", "distance") + # str(result) + res1 <- result$res$points + # dput(result$res$points) + res2 <- structure(c( + -1348.66832957982, -1198.87410814714, -1076.98554040122, + -1226.93901099845, -428.454832718783, 1596.1594018405, 1697.22828135996, + 1464.04701004452, 522.48712860043, -462.400598146569, -306.546900234988, + -136.432035420421, 1013.62838366558, -174.603164807742, -639.307768963489, + 131.685862779591, 560.580459896188, 13.3957612318459 + ), .Dim = c( + 9L, + 2L + ), .Dimnames = list(c( + "Boston", "NY", "DC", "Miami", "Chicago", + "Seattle", "SF", "LA", "Denver" + ), NULL)) + expect_equal(abs(res1), abs(res2)) +}) + +test_that("Computer perceptual map", { + result <- prmap(computer, "brand", "high_end:business") + # str(result) + res1 <- result$fres$scores + # dput(result$res$points) + res2 <- structure(c( + 1.2990975042645, -0.318156927318684, -1.18661978839803, + -0.522421680770708, 0.728100892222923, 0.0936804393886441, -0.208948184854464, + -0.934302935231416, 1.64813821225715, -0.598567531559918 + ), .Dim = c( + 5L, + 2L + ), .Dimnames = list(c("Apple", "Dell", "Gateway", "HP", "Sony"), c("RC1", "RC2"))) + expect_equal(res1, res2) +}) + +context("Factor/PCA analysis") + +test_that("Pre nalysis for diamonds", { + result <- pre_factor(diamonds, c("price", "carat", "table")) + # str(result) + res1 <- result$pre_r2 + # dput(result$pre_r2) + res2 <- structure(list(Rsq = c(0.861258211951766, 0.86356619173057, 0.0450708598611924)), .Names = "Rsq", row.names = c("price", "carat", "table"), class = "data.frame") + expect_equal(res1, res2) +}) + +test_that("Factor/PCA analysis for diamonds", { + result <- full_factor(diamonds, c("price", "carat", "table")) + # str(result) + res1 <- result$floadings + # dput(result$floadings) + res2 <- structure(list(PC1 = c( + 0.964483176117948, 0.972902482025944, + 0.325710945731448 + )), .Names = "PC1", row.names = c( + "price", "carat", + "table" + ), class = "data.frame") + expect_equal(res1, res2) +}) + +context("Cluster analysis") + +test_that("Hierarchical cluster analysis", { + result <- hclus(shopping, vars = "v1:v6") + # str(result) + res1 <- result$hc_out$height + # dput(result$hc_out$height) + res2 <- c( + 0.693447070258665, 0.77981545158788, 1.19609257290417, 1.20263048421394, + 1.20263048421394, 1.25874249684769, 1.59728591646143, 1.76984887051771, + 1.88396035104441, 2.06113619040031, 3.37654118004185, 3.5167211043475, + 3.77286952167201, 5.26961961999936, 7.6948927428698, 9.4541210015406, + 12.7002828285666, 76.1882734993453, 92.3810886131668 + ) + expect_equal(res1, res2) +}) + +test_that("K-clustering", { + result <- kclus(shopping, vars = "v1:v6") + # str(result) + res1 <- result$clus_means + # dput(result$clus_means) + res2 <- structure(list(v1 = c(5.75, 2.58333333333333), v2 = c( + 3.625, + 4.41666666666667 + ), v3 = c(6, 2.58333333333333), v4 = c( + 3.125, + 4.75 + ), v5 = c(1.875, 4.5), v6 = c(3.875, 4.66666666666667)), class = "data.frame", row.names = c( + "Cluster 1", + "Cluster 2" + ), .Names = c("v1", "v2", "v3", "v4", "v5", "v6")) + expect_equal(res1, res2) +}) + +context("Conjoint analysis") + +test_that("Conjoint on mp3 data", { + result <- conjoint(mp3, rvar = "Rating", evar = "Memory:Shape") + res1 <- capture_output(summary(result)) + res2 <- "Conjoint analysis\nData : mp3 \nResponse variable : Rating \nExplanatory variables: Memory, Radio, Size, Price, Shape \n\nConjoint part-worths:\n Attributes Levels PW\n Memory 4GB 0.000\n Memory 6GB 7.667\n Memory 8GB 29.667\n Radio No 0.000\n Radio Yes 6.111\n Size Large 0.000\n Size Medium 6.333\n Size Small 8.500\n Price $50 0.000\n Price $100 -6.833\n Price $150 -33.833\n Shape Circular 0.000\n Shape Rectangular -27.833\n Shape Square -13.333\n Base utility ~ 58.111\n\nConjoint importance weights:\n Attributes IW\n Memory 0.280\n Radio 0.058\n Size 0.080\n Price 0.319\n Shape 0.263\n\nConjoint regression results:\n\n coefficient\n (Intercept) 58.111\n Memory|6GB 7.667\n Memory|8GB 29.667\n Radio|Yes 6.111\n Size|Medium 6.333\n Size|Small 8.500\n Price|$100 -6.833\n Price|$150 -33.833\n Shape|Rectangular -27.833\n Shape|Square -13.333\n" + expect_equal(res1, res2) +}) diff --git a/radiant.multivariate/vignettes/pkgdown/_conjoint.Rmd b/radiant.multivariate/vignettes/pkgdown/_conjoint.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..886bc1ddc0c3d0c2ed9d9ef6607d4f694a76feff --- /dev/null +++ b/radiant.multivariate/vignettes/pkgdown/_conjoint.Rmd @@ -0,0 +1,87 @@ +> Analyze responses from a conjoint survey + +To setup a conjoint study from scratch we need to determine the attributes and attributes levels that should be included. Once that has been done we would typically need to generate a fractional factorial design of conjoint profiles. This is a subset of all possible profiles that could be generated for the set of attributes and levels that were selected (see _Design > DOE > Design of Experiments_). + +Once data is available from respondents their evaluations are analyzed to determine Part Worths (PW) and Importance Weights (IW). + +To estimate a model select respondents ratings (or rankings) as the `Profile evaluations` and select the profile `Attributes`. Press the `Estimate` button or `CTRL-enter` (`CMD-enter` on mac) to generate results. + +### Example: Carpet cleaner + +A respondent was presented with 18 product profiles for a carpet cleaning product described on five attributes in a conjoint study. To access the `carpet` dataset go to _Data > Manage_, select `Examples` from the `Load data of type` dropdown, and press the `Load` button. Then select the `carpet` dataset. + +- design = Package Design (A, B, C) +- brand = Brand Name (K2R, Glory, Bissell) +- price = Price (1.19, 1.39, 1.59) +- seal = Good Housekeeping seal of approval (Yes or No) +- money_back = Money Back Guarantee (Yes or No) +- ranking = Respondent ranking of 18 attributes + +Design characteristics: + +

    + +Based on the attributes, 108 possible profiles could be created (i.e., 3x3x3x2x2 = 108). The respondent was given a set of 18 and was asked to rank the profiles from most preferred (rank 1) to least preferred (rank 18). The first five columns represent the five attributes and the last column is the respondent's ranking. + +a. Compute the Variance Inflation Factors (VIF) for the attribute variables. What do you notice? What does this say about the particular set of 18 profiles that was presented to the respondent? + +The VIF scores displayed below indicate that the attributes are perfectly orthogonal. In the fractional factorial design profiles were deliberately selected such that all attributes are uncorrelated. + + Multicollinearity diagnostics: + design brand price seal money_back + VIF 1 1 1 1 1 + Rsq 0 0 0 0 0 + +b. Estimate a conjoint model using the respondent's evaluations as the dependent variable and the attributes as the predictors. Show the complete list of part-worths and importance weights. + +

    +

    + +c. Calculate the predicted utilities for the following options: + +* Package A, K2R, $1.19, no GHKS, no MBG + - Predicted Utility based on PWs: 6.5 + 0 + 0 + 0 + 0 + 0 = 6.5 +* Package C, Bissell, $1.19, no GHKS, with MBG + - Predicted Utility based on PWs: 6.5 + 4.5 + 1.5 + 0 + 4.5 = 17 +* Package B, Bissell, $1.59, with GHKS, with MBG + - Predicted Utility based on PWs: 6.5 + 8.0 + 1.5 - 7.67 + 1.5 + 4.5 = 14.33 + +d. What is the highest predicted utility that can be obtained? What are the characteristics of that option? + +* The option with the highest (predicted) utility is: Package B, Bissell, $1.19, with GHKS, with MBG +* Predicted Utility based on PWs: 6.5 + 8.0 + 1.5 + 0 + 1.5 + 4.5 = 22 + +We can confirm this results in three steps: (1) Create a new dataset with all 36 profiles in _Data > Transform_ using `Expand grid`, (2) Predict the utility for each of the profiles by selecting the newly created dataset in the _Multivariate > Conjoint > Predict_ tab and storing the prediction in a new variable `predict_ca`, (3) Sort the new dataset on `predict_ca` in the _Data > View_ tab. These three steps are shown in the screen shots below + +#### Step 1: Create dataset + +

    + +#### Step 2: Predict utilities + +

    + +#### Step 3: Sort predictions + +

    + +## Multiple respondents + +If profile evaluations are available for multiple respondents and a respondent id variable is included in the dataset we can estimate conjoint results at the individual level by selecting the respondent id from the `By` dropdown. We can then save the Partworths and/or Importance weights for all respondents to a new dataset in Radiant and use that for segmentation using _Multivariate > K-clustering_. + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If a plot was created it can be customized using `ggplot2` commands or with `patchwork`. See example below and _Data > Visualize_ for details. + +```r +plot(result, plots = c("pw", "iw"), custom = TRUE) %>% + wrap_plots(plot_list, ncol = 2) + plot_annotation(title = "Conjoint Analysis") +``` + +### R-functions + +For an overview of related R-functions used by Radiant to estimate a conjoint model see _Multivariate > Conjoint_ + +The key functions used in the `conjoint` tool are `lm` from the `stats` package and `vif` from the `car` package. diff --git a/radiant.multivariate/vignettes/pkgdown/_footer.md b/radiant.multivariate/vignettes/pkgdown/_footer.md new file mode 100644 index 0000000000000000000000000000000000000000..05010f02dd76f9e82c3cb8a79ee3cfcec670384d --- /dev/null +++ b/radiant.multivariate/vignettes/pkgdown/_footer.md @@ -0,0 +1,2 @@ + +© Vincent Nijs (2023) Creative Commons License diff --git a/radiant.multivariate/vignettes/pkgdown/_full_factor.Rmd b/radiant.multivariate/vignettes/pkgdown/_full_factor.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..7b693b81a82db6380bbb31261ee5ca8f89d5cc0f --- /dev/null +++ b/radiant.multivariate/vignettes/pkgdown/_full_factor.Rmd @@ -0,0 +1,78 @@ +> Reduce data dimensionality without significant loss of information + +As stated in the documentation for pre-factor analysis (see _Multivariate > Factor > Pre-factor_), the goal of factor analysis is to reduce the dimensionality of the data without significant loss of information. The tool tries to achieve this goal by looking for structure in the correlation matrix of the variables included in the analysis. The researcher will often try to link the original variables (or _items_) to an underlying factor and provide a descriptive label for each. + +### Example: Toothpaste + +First, go to the _Data > Manage_ tab, select **examples** from the `Load data of type` dropdown, and press the `Load` button. Then select the `toothpaste` dataset. The dataset contains information from 60 consumers who were asked to respond to six questions to determine their attitudes towards toothpaste. The scores shown for variables v1-v6 indicate the level of agreement with statements on a 7-point scale where 1 = strongly disagree and 7 = strongly agree. + +Once we have determined the number of factors we can extract and rotate them. The factors are rotated to generate a solution where, to the extent possible, a variable has a high loading on only one factor. This is an important benefit because it makes it easier to interpret what the factor represents. While there are numerous algorithms to rotate a factor loadings matrix the most commonly used is Varimax rotation. + +To replicate the results shown in the screenshot below make sure you have the `toothpaste` data loaded. Then select variables `v1` through `v6`, set `Nr. of factors` to 2, and press the `Estimate` button or `CTRL-enter` (`CMD-enter` on mac) to generate results. + +

    + +The numbers in the `Factor loadings` table are the correlations of the six variables with the two factors. For example, variable `v1` has a correlation of .96 with factor 1 and a correlation of -.03 with factor 2. As such `v1` will play a big role in naming factor 1 but an insignificant role in naming factor 2. + +The rotated factor loadings can be used to determine labels or names for the different factors. We need to identify and highlight the highest factor loading, in absolute value, in each row. This is easily done by setting the `Cut-off` value to .4 and checking the `Sort factor loadings` box. The output is shown below. + +```r +Loadings: + RC1 RC2 +v1 0.96 +v5 -0.93 +v3 0.93 +v6 0.88 +v4 0.85 +v2 0.85 +``` + +Together, the variables shown in each column (i.e., for each factor) help us to understand what the factor represents. Questions 1, 3, and 5 reflect the importance of health issues while questions 2, 4, and 6 reflect aesthetics issues (see the data description in the _Data > Manage_ tab for a description of the variables). Plausible names for the factors might therefore be: + +* **Factor 1:** Health benefits +* **Factor 2:** Social benefits + +The best way to see what rotation does is to switch between `Varimax` and `None` in the `Rotation` dropdown and inspect what changes in the output after pressing the `Estimate model` button. Select `None` from the `Rotation` dropdown, switch to the _Plot_ tab, and press the `Estimate model` button to see updated results. The image shown below depicts the loadings of the variables on the two factors. Variable `v5` falls somewhat in between the axes for factor 1 and factor 2. When we select `Varimax` rotation, however, the label for `v5` lines up nicely with the horizontal axis (i.e., factor 2). This change in alignment is also reflected in the factor loadings. The unrotated factor loadings for `v5` are -0.87 for factor 1 and -0.35 for factor 2. The rotated factor loadings for `v5` are -0.93 for factor 1 and -0.08 for factor 2. + +

    + +The final step is to generate the factor scores. You can think of these scores as a weighted average of the variables that are linked to a factor. They approximate the scores that a respondent would have provided if we could have asked about the factor in a single question, i.e., the respondents inferred ratings on the factors. By clicking on the `Store` button two new variables will be added to the toothpaste data file (i.e., factor1 and factor2). You can see them by going to the _Data > View_ tab. We can use factor scores in other analyses (e.g., cluster analysis or regression). You can rename the new variables, e.g., to `health` and `social` through the _Data > Transform_ tab by selecting `Rename` from the `Transformation type` dropdown. + +To download the factor loadings to a csv-file click the download button on the top-right of the screen. + +### Summary + +1. Determine if the data are appropriate for factor analysis using Bartlett, KMO, and Collinearity (_Multivariate > Factor > Pre-factor_) +2. Determine the number of factors to extract using the scree-plot and eigenvalues > 1 criteria (_Multivariate > Factor > Pre-factor_) +3. Extract the (rotated) factor solution to produce: + - Factor loadings: Correlations between attributes and factors + - Factor scores: Inferred ratings on the new factors (i.e., new variables that summarize the original variables) +5. Identify the highest factor loading, in absolute value, in each row (i.e., for each variable) +4. Label the factors using the strongest factor loadings + +If you want more practice open the `shopping` data set and see if you can reproduce the results shown in the screen capture of the _Summary_ tab below. Use _Multivariate > Factor > Pre-factor_ to determine if the correct number of factors were selected. Do you agree? Why (not)? + +

    + +## Including categorical variables + +Output shown in _Multivariate > Factor_ is estimated using either Principal Components Analysis (PCA) or Maximum Likelihood (ML). The correlation matrix used as input for estimation can be calculated for variables of type `numeric`, `integer`, `date`, and `factor`. When variables of type factor are included the `Adjust for {factor} variables` box should be checked. When correlations are estimated with adjustment, variables that are of type `factor` will be treated as (ordinal) categorical variables and all other variables will be treated as continuous. + +It is important to note that estimated factor scores will be biased if a mixed of {factor} and numeric variables are used. If you want to use factor scores as input for further analysis, e.g., clustering, you should use either (1) all {factor} variables or (2) all numeric variables to avoid this bias. + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If a plot was created it can be customized using `ggplot2` commands or with `patchwork`. See example below and _Data > Visualize_ for details. + +```r +plot(result, custom = TRUE) %>% + wrap_plots(plot_list, ncol = 2) + plot_annotation(title = "Factor Analysis") +``` + +### R-functions + +For an overview of related R-functions used by Radiant to conduct factor analysis see _Multivariate > Factor_. + +The key functions from the `psych` packages used in the `full_factor` tool are `principal` and `fa` . diff --git a/radiant.multivariate/vignettes/pkgdown/_hclus.Rmd b/radiant.multivariate/vignettes/pkgdown/_hclus.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..8c616a90b2dca22c7c7662490b92ee28e930f828 --- /dev/null +++ b/radiant.multivariate/vignettes/pkgdown/_hclus.Rmd @@ -0,0 +1,48 @@ +> Determine the appropriate number of segments + +The goal of Cluster Analysis is to group respondents (e.g., consumers) into segments based on needs, benefits, and/or behaviors. The tool tries to achieve this goal by looking for respondents that are similar, putting them together in a cluster or segment, and separating them from other, dissimilar, respondents. The researcher compares the segments and provides a descriptive label for each. + +### Example: Toothpaste + +First, go to the _Data > Manage_ tab, select **examples** from the `Load data of type` dropdown, and press the `Load` button. Then select the `toothpaste` dataset. The dataset contains information from 60 consumers who were asked to respond to six questions to determine their attitudes towards toothpaste. The scores shown for variables v1-v6 indicate the level of agreement with statements on a 7-point scale where 1 = strongly disagree and 7 = strongly agree. + +We first establish the number of segments/clusters in the data using Hierarchical Cluster Analysis. Ward’s method with Squared Euclidean distance is often used to determine how (dis)similar individuals are. These are the default values in Radiant but they can be changed if desired. The most important information from this analysis is provide by the plots, so we will focus our attention there. + +Select variables v1 through v6 in the Variables box and click the `Estimate` button or press `CTRL-enter` (`CMD-enter` on mac) to generate results. Note that Hierarchical Cluster Analysis can be time-consuming and memory intensive for large datasets. If your dataset has more than 5,000 observations make sure to increase the value in the `Max cases` input to the appropriate number. The Dendrogram shown below provides information to help you determine the most appropriate number of clusters (or segments). + +Hierarchical cluster analysis starts with many segments, as many as there are respondents, and in a stepwise (i.e., hierarchical) process adds the most similar respondents or groups together until only one segment remains. To determine the appropriate number of segments look for a _jump_ along the vertical axis of the plot. At that point two dissimilar segments have been joined. The measure along the vertical axis indicates of the level of heterogeneity **within** the segments that have been formed. The purpose of clustering is to create homogeneous groups to avoid segments with heterogeneous characteristics, needs, etc. Since the most obvious _jump_ in heterogeneity occurs when we go from 3 to 2 segments we choose 3 segments (i.e., we avoid creating a heterogeneous segment). + +

    + +Another plot that can be used to determine the number of segments is a scree-plot. This is a plot of the within-cluster heterogeneity on the vertical axis and the number of segments on the horizontal axis. Again, Hierarchical cluster analysis starts with many segments and groups respondents together until only one segments is left. The scree plot is created by selecting `Scree` (and `Change`) from the `Plot(s)` dropdown menu. If `Plot cutoff` is set to 0 we see results for all possible cluster solutions. To make the plot easier to evaluate, we can set `Plot cutoff` to, for example, 0.05 (i.e. show only solutions that have `Within-cluster heterogeneity` above 5%). + +

    + +Reading the plot from left-to-right we see that within-segment heterogeneity increases sharply when we move from 3 to 2 segments. This is also clear from the `Change in within-cluster heterogeneity` plot (i.e., `Change`). To avoid creating a heterogeneous segment we, again, choose 3 segments. Now that we have determined the appropriate number of segments to extract we can use either _Cluster > Hierarchical_ or _Cluster > K-clustering_ to generate the final cluster solution. + +To download the plots click the download button on the top-right of the screen. + +## Additional options + +* By default, data will be standardized before it is analyzed. To pass data in its raw form to the estimation algorithm, make sure the `Standardize` box is un-checked +* Hierarchical cluster-analysis (HC) generates numerous clustering solutions. The highest number of clusters is equal to the number of observations in the data (e.g., ever respondent is treated as a separate cluster). The lowest number of clusters evaluated, is equal to 1 (e.g., all respondent are grouped together in a single cluster). Although, HC analysis is often used as a diagnostic tool before generating a final solution using, e.g., K-means, we can also store any specific clustering solution generated using HC. To accomplish this, first choose the `Number of clusters`, then provide a name for the variable that will contain cluster assignment information, and finally, press the `Store` button +* If the data to use for clustering includes variables of type "factor", the `gower` distance will automatically be selected. For more information on the gower distance and R-package see the package vignette + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If a plot was created it can be customized using `ggplot2` commands or with `gridExtra`. See example below and _Data > Visualize_ for details. + +```r +plot(result, plots = "change", custom = TRUE) + + labs(caption = "Data used from ...") +``` + +To add, for example, a sub-title to a dendrogram plot use `title(sub = "Data used from ...")`. See the R graphics documentation for additional information. + +### R-functions + +For an overview of related R-functions used by Radiant to conduct cluster analysis see _Multivariate > Cluster_ + +The key function from the `stats` package used in the `hclus` tool is `hclust`. diff --git a/radiant.multivariate/vignettes/pkgdown/_kclus.Rmd b/radiant.multivariate/vignettes/pkgdown/_kclus.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..461deb462e6d187c79bed81e8e2a232eab97d15b --- /dev/null +++ b/radiant.multivariate/vignettes/pkgdown/_kclus.Rmd @@ -0,0 +1,68 @@ +> Create segments using K-clustering + +The goal of Cluster Analysis is to group respondents (e.g., consumers) into segments based on needs, benefits, and/or behaviors. The tool tries to achieve this goal by looking for respondents that are similar, putting them together in a cluster or segment, and separating them from other, dissimilar, respondents. The researcher compares the segments and provides a descriptive label for each. + +### Example: Toothpaste + +First, go to the _Data > Manage_ tab, select **examples** from the `Load data of type` dropdown, and press the `Load` button. Then select the `toothpaste` dataset. The dataset contains information from 60 consumers who were asked to respond to six questions to determine their attitudes towards toothpaste. The scores shown for variables v1-v6 indicate the level of agreement with statements on a 7-point scale where 1 = strongly disagree and 7 = strongly agree. + +After determining the appropriate number of clusters to extract using Hierarchical cluster analysis we use K-clustering to create the final segments. The main advantage of this algorithm is it's flexibility and robustness in finding the most appropriate grouping of respondents. For marketing and business data we often use Hierarchical cluster analysis to select the number of segments and K-clustering to create the final segments. + +To apply K-clustering to the toothpaste data select `K-means` as the algorithm and variables v1 through v6 in the `Variables` box. Select 3 as the number of clusters. Because the data has relatively few observations we can use Hierarchical Cluster Analysis (HC) to provide the initial cluster centers. After the settings have been changed click the `Estimate` button or press `CTRL-enter` (`CMD-enter` on mac) to generate results. + +In the _Summary_ tab we use the `Cluster means` table to describe the individuals assigned to a segment. Each number in the table shows the average score on a variable for people in that segment. For example, segment 3 has an average score of 5.750 out of 7 on question v2. We are looking for either very high or very low mean values to help distinguish segments because we want to establish how one segment differs from the others. If there are no substantial differences in the mean value of a variable across different segments that variable is not very useful for interpretation. By highlighting the variables that most clearly distinguish the different segments we can generate a name or label that describes consumers in each segment and illustrates how the segments differ from one another. + +

    + +It can be useful to visualize how well the segments are separated by plotting the data for each segment and variable. The figures shown below are density plots. For variable v1 the clusters are nicely separated. The average response to the question 'It is important to buy a toothpaste that prevents cavities' for segment 2 (green) seems lower than for both segment 3 (blue) and segment 1 (pink). Segment 1, in turn stands out with a higher score on this question compared to the other two segments. For question v4 we see a different pattern. The average response to the question 'I prefer a toothpaste that freshens breath' for segments 1 (green) and 2 (pink) is very similar and the plots overlap. Segment 3 (blue), in turn, stands out with a higher score on this question compared to the other two segments. + +

    + +By reviewing the Cluster means table in the _Summary_ tab and the density plots in the _Plots_ tab we can derive the following labels: Segment 3 stands out with higher scores on questions v2, v4, and v6. We could call them the 'Cosmetic brushers'. Segment 1 stands out with higher scores on questions v1 and v3 and a lower score on v5. They seem to care most about the health benefits of toothpaste so we might call them the 'Therapeutic brushers'. Segment 2 scores lower in v1 and v3 and higher on v5, i.e., they seem to care little about the health benefits of toothpaste. Since their scores for the cosmetics benefits are middle-of-the-road we could label them the 'Uninvolved brushers'. To save the table of cluster means to a csv file press the download button on the top-right of your screen. + +Once we categorize the segments we can create a segment (or cluster) membership variable by clicking the `Store` button. A new variable is added to the toothpaste data showing which respondents were assigned to each cluster (i.e., cluster membership). We can change the created cluster variable to show the descriptive labels above through the _Data > Transform_ menu. Select the `kclus` variable in the Select column(s) box. Then select `Recode` from the `Transform type` dropdown. In the recode box type (or paste) the command below and press return: + +```r +1 = 'Therapeutic'; 2 = 'Uninvolved'; 3 = 'Cosmetic' +``` + +This should produce the output shown below. After verifying the results are as expected, click the `Store` button to add the recoded variable to the toothpaste dataset. + +

    + +We can profile these segments with demographic data using cross-tabs (e.g., gender vs segment membership). Go to _Basics > Tables > Cross-tabs_. Our null hypothesis and alternative hypothesis are: + +```r +H0: There is no relationship between gender and segment membership +Ha: There is a relationship between gender and segment membership +``` + +In the _Summary_ tab we see there is a significant association between these two variables. The p.value is .001 and there are no cells with expected values below 5 (see the help file for _Basics > Tables > Cross-tabs_ for a detailed discussion). + +

    + +For a graphical depiction of the association go to the _Plot_ tab. If we select `Deviation std.` we see that the `Uninvolved` segment has significantly more men than we would expect under the null of no-association. We could also argue that there are more women in the `Cosmetic` segment than we would expect under the null of no-association, although the significance level is marginal (i.e., < .1 but not < .05). In sum, in these data men seem more likely to belong to the `Uninvolved brushers` segment and women seem (marginally) more likely to be in the `Cosmetic brushers` segment. + +

    + +## Additional options + +* By default, data will be standardized before it is analyzed. To pass data in its raw form to the estimation algorithm, make sure the `Standardize` box is un-checked +* If the data to use for clustering includes variables of type "factor", the `K-proto` algorithm should be used. If `K-means` is selected, only numerical variables with be retained for analysis. For more information on the `kproto` function and the _clustMixType_ R-package see the R-journal article + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If a plot was created it can be customized using `ggplot2` commands or with `patchwork`. See example below and _Data > Visualize_ for details. + +```r +plot(result, plots = "bar", custom = TRUE) %>% + wrap_plots(plot_list, ncol = 2) + plot_annotation(title = "K-means Cluster Analysis") +``` + +### R-functions + +For an overview of related R-functions used by Radiant to conduct cluster analysis see _Multivariate > Cluster_. + +The key function from the `stats` package used in the `kclus` tool is `kmeans`. diff --git a/radiant.multivariate/vignettes/pkgdown/_mds.Rmd b/radiant.multivariate/vignettes/pkgdown/_mds.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..1bc46f0c5129f13dc723d1095257275736075a94 --- /dev/null +++ b/radiant.multivariate/vignettes/pkgdown/_mds.Rmd @@ -0,0 +1,44 @@ +> Brand maps based on (dis)similarity data can be analyzed using Multi-Dimensional Scaling (MDS) + +### Example 1 + +The city data (`city`) contains information on distances in miles between 10 major cities in the US. Distances for 45 (10 x 9 / 2) from-to city pairs are provided. These data are used to illustrate that MDS can take simple data on distances (or on brand dissimilarities as we will see) and create a 2-dimensional map that accurately depicts the relative city (or brand) positions. + +To load the `city` data go to _Data > Manage_, select `examples` from the `Load data of type` dropdown, and press the `Load` button. Then select the `city` dataset. In _Multivariate > Maps > (Dis)similarity_ select `from` as ID 1, `to` as ID 2, and `distance` as the Dissimilarity measure. After the settings have been changed click the `Estimate model` button or press `CTRL-enter` (`CMD-enter` on macOS) to generate results. + +The original distances are shown in (lower triangular) matrix form in the screenshot below. If the analysis is successful we expect cities that are close (e.g., Washington DC and New York) to also be located close together on the map. Cities that are far apart (e.g., Seattle and Miami) should also be positioned far apart in the map. + +The basic measure of (lack of) fit for MDS is called `Stress`. If MDS cannot create a map that accurately describes the original data this will result in high stress. Stress values of .1 are generally considered fair, .05 is good, and .01 or lower is excellent. High stress values indicate that a dimensionality of three (or higher) is needed to accurately depict the available data. For the city data the stress value is equal to .02 which is good. In the _Summary_ tab we also see the coordinates that will be used to create the two-dimensional map shown in the _Plot_ tab and the recovered distances (i.e., how _far_ the cities are apart in the generated map). + +

    + +In the screen shot from the _Plot_ tab shown below the relative locations of Los Angeles, Boston, etc. look wrong. This is due to the fact the MDS program has no information on North, South, East and West. We can _flip_ the plot to see if the map becomes easier to recognize and interpret. + +

    + +To create the plot shown below click the check-boxes for `dimension 1` and `dimension 2`. After _flipping_ the plot along both the horizontal and vertical axis we see that the relative locations of the cities look quite good. Note that this map is _flat_, i.e., there is no correction for the curvature of the earth. + +

    + +### Example 2 + +The following plot is based on similarity data for a set of toothpaste brands (`tpbrands` is available as one of the example datasets). Respondents were asked the following question: "Please rate the following pairs of toothpaste brands on the basis of their similarity (1 = very similar, 7 = very dissimilar)." for all pairwise combinations of 10 brands, i.e., 45 comparisons. MDS will try to create a map that reproduces, as accurately as possible, the original dissimilarities (or perceptual distances) provided by the 50 respondents. The original dissimilarity ratings are shown in (lower triangular) matrix form in the figure below. From these data we can already see that the respondents perceive some brands to be very similar (e.g., Ultra Brite and Pepsodent have an average dissimilarity score of 1.11) and others to be very dissimilar (e.g., Crest and Sensodyne). The stress value for a two-dimensional solution is reasonable (.058). As we might expect, however, the original and recovered distances show that the fit is not as good as for the `city` data. + +

    + +The coordinates shown in the _Summary_ tab are used to plot the brands in two dimensions in the _Plot_ tab. In the plot we see that Aqua Fresh and Colgate as well as Ultra Brite and Pepsodent are located very close together. This is consistent with the original data. Sensodyne and Crest, however, are positioned at opposite ends of the plot. Again, this is consistent with the original data and provides visual confirmation that MDS was able to create a plot that fits the data reasonably well. + +From the plot a manager might conclude that the brands that are closest together in the map are perceived by consumers as close substitutes and, hence, close competitors in the minds of consumers in this market segment. A manager for Aqua Fresh or Macleans, in contrast, might focus less on Sensodyne when developing a competitive positioning plan for her brand. An important limitation of brand maps based on (dis)similarity data is that the axes are difficult to interpret. For example, why are Close-up and Crest located at opposite ends along the horizontal axes? The researcher could ask respondents to explain the meaning of the axes or else obtain additional attribute information for the brands and correlate/overlay these on the plot to facilitate interpretation. Such attribute data could, however, also be used to create a brand map without the need for (dis)similarity ratings (see _Multivariate > Maps > Attributes_). + +

    + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + + +### R-functions + +For an overview of related R-functions used by Radiant to generate brand maps see _Multivariate > Maps_. + +The key functions used in the `mds` tool are `cmdscale` from the `stats` package and `isoMDS` from the `MASS` package. diff --git a/radiant.multivariate/vignettes/pkgdown/_pre_factor.Rmd b/radiant.multivariate/vignettes/pkgdown/_pre_factor.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..b04d1967d27f6138210b806ab22523e8474ba706 --- /dev/null +++ b/radiant.multivariate/vignettes/pkgdown/_pre_factor.Rmd @@ -0,0 +1,48 @@ +> Evaluate if data are appropriate for Factor analysis + +The goal of Factor Analysis (and Principal Components Analysis) is to reduce the dimensionality of the data with minimal loss of information by identifying and using the structure in the correlation matrix of the variables included in the analysis. The researcher will often try to link the original variables (or _items_) to an underlying factor and provide a descriptive label for each. + +### Example: Toothpaste + +First, go to the _Data > Manage_ tab, select **examples** from the `Load data of type` dropdown, and press the `Load` button. Then select the `toothpaste` dataset. The dataset contains information from 60 consumers who were asked to respond to six questions to determine their attitudes towards toothpaste. The scores shown for variables v1-v6 indicate the level of agreement with statements on a 7-point scale where 1 = strongly disagree and 7 = strongly agree. + +The first step in factor analysis is to determine if the data has the required characteristics. Data with limited or no correlation between the variables are not appropriate for factor analysis. We will use three criteria to test if the data are suitable for factor analysis: Bartlett, KMO, and Collinearity for each variable + +The KMO and Bartlett test evaluate all available data together. A KMO value over 0.5 and a significance level for the Bartlett’s test below 0.05 suggest there is substantial correlation in the data. Variable collinearity indicates how strongly a single variable is correlated with other variables. Values above 0.4 are considered appropriate. KMO measures can also be calculated for each variable. Values above 0.5 are acceptable. + +As can be seen in the output from _Multivariate > Factor > Pre-factor_ below, Bartlett's test statistic is large and significant (p.value close to 0) as desired. The Kaiser-Meyer-Olkin (KMO) measure is larger than .5 and thus acceptable. The variable collinearity values are above 0.4 and the KMO values are above 0.5 so all variables can be used in the analysis. + +To replicate the results shown in the screenshot make sure you have the `toothpaste` data loaded. Then select variables `v1` through `v6` and click the `Estimate` button or press `CTRL-enter` (`CMD-enter` on mac) to generate results. + +

    + +The next step is to determine the number of factors needed to capture the structure underlying the data. Factors that do not capture even as much variance as could be expected by chance are generally omitted from further consideration. These factors have eigenvalues < 1 in the output. + +A further criteria that is often used to determine the number of factors is the scree-plot. This is a plot of the eigenvalues against the number of factors, in order of extraction. Often a break or _elbow_ is visible in the plot. Factors up to and including this elbow are selected for further analysis if they all have eigenvalues above 1. A set of factors that explain more than 70% of the variance in the original data is generally considered acceptable. The eigenvalues for all factors are shown above. Only two factors have eigenvalues above 1. + +At first glance the scree-plot of the Eigenvalues shown below seems to suggest that 3 factors should be extracted (i.e., look for the _elbow_). The bar plot confirms this insight, i.e., the change in Eigenvalues between factors 1 and 2 is small but the drop-off from 2 to 3 is much larger. However, because the value for the third factor is less than one we will extract only 2 factors. + +

    + +The increase in cumulative % explained variance is relatively small going from 2 to 3 factors (i.e., from 82% to 90%). This is confirmed by the fact that the eigenvalue for factor 3 is smaller than 1 (0.44). Again, we choose 2 factors. The first 2 factors capture 82% of the variance in the original data which is excellent. + +## Including categorical variables + +The pre-factor analysis diagnostics are calculated using Principal Components Analysis (PCA). The correlation matrix used as input for PCA can be calculated for variables of type `numeric`, `integer`, `date`, and `factor`. When variables of type factor are included the `Adjust for categorical variables` box should be checked. When correlations are estimated with adjustment, variables that are of type `factor` will be treated as (ordinal) categorical variables and all other variables will be treated as continuous. + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +If a plot was created it can be customized using `ggplot2` commands or with `gridExtra`. See example below and _Data > Visualize_ for details. + +```r +plot(result, plots = "scree", custom = TRUE) + + labs(caption = "Data used from ...") +``` + +### R-functions + +For an overview of related R-functions used by Radiant to conduct factor analysis see _Multivariate > Factor_. + +The key functions used in the `pre_factor` tool are `cor` from the `stats` package, `eigen` from `base`, and `cortest.bartlett` and `KMO` from the `psych` package. diff --git a/radiant.multivariate/vignettes/pkgdown/_prmap.Rmd b/radiant.multivariate/vignettes/pkgdown/_prmap.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..484280be13bb054a0b151e89f62d3b4468fa72c9 --- /dev/null +++ b/radiant.multivariate/vignettes/pkgdown/_prmap.Rmd @@ -0,0 +1,49 @@ +> Create brand maps based on attribute data to provide a rich visual summary of large numeric tables + +### Example + +To load the `retailers` data go to _Data > Manage_, select `examples` from the `Load data of type` dropdown, and press the `Load` button. Then select the `retailers` dataset. The data set contains information on consumer evaluations for a set of retailers in the Chicago area on 7 attributes. In addition to attribute evaluations the dataset contains preference ratings on a scale from 1-9 for each retailer from two predefined consumer segments. + +Select the `retailer` variable as the `Brand` attribute. This is simply a list of retailer names/labels. Then select the variables `good_value` through `cluttered` in the `Attributes` box. Choose the `segment1` and `segment2` variables in the `Preferences` box. After the settings have been changed click the `Estimate` button or press `CTRL-enter` (`CMD-enter` on mac) to generate results. + +The variables in the `Attributes` box will be analyzed using factor analysis and the output is provided in the _Summary_ tab. We will start with a 2-dimensional solution. The first table shows the factor scores for the brands. In essence these are a weighted average of the original attribute data, where the weights are the factor loadings. In other words, the factor scores are (two) variables created by factor analysis to summarize the information contained in the original 7 attributes. The second table of numbers shows the factors loadings. These represent the correlations between the original attributes and the derived factor scores. + +We are also provided with information on how much of the information contained in the attributes is captured by the two derived factors. The first factor captures 56.4% and factor two captures 42% of the variation in the original data. Together the factors cover 98.4% of the variation, i.e., the information loss from reducing the dimensionality of the data from 7 attributes to two factors is only 1.6%. Adding a third factor will increase the captured variance only slightly but will make the interpretation of the map(s) more difficult. Therefore we will focus on the 2-dimension brand map. + +The preference correlations indicate how strongly the preference scores provided by respondents are linked to the uncovered factor scores. The preferences for `Segment 2` seems very strongly positively correlated with factor 2 so we might expect to see the preference arrow for this segment pointing almost straight up. The communalities indicate how much of the variation in the segment preferences can be explained by the two factors. The number are excellent (i.e., 97.5% for Segment 1 and 91.5% for Segment 2). We can infer from these numbers that the attributes selected in the study reflect consumers preferences well, a key feature of useful brand mapping research. Choosing attributes that are not linked to customer preferences leads to brand maps that will be of limited value to a manager. + +The final table shows the attribute communalities. These numbers indicate how much of the variation in the attributes data can be explained by the two factors. The cumulative variance mentioned earlier is an overall measure across attributes. However, we are also interested to see if each of the individual attributes is well represented by the two factors. The numbers in this example are excellent across the board (i.e., all over 90%). + +

    + +It is useful to start with a map showing only brand locations. Create the map in the _Plot_ tab by checking the ‘Brands’ box. The graph is a scatter plot of the scores for factor 1 (the horizontal axis) and factor 2 (the vertical axis). In other words the scores for a brand on factor 1 and factor 2 are the coordinates for that brand in the map. The retailer names are used to label each point. + +

    + +We can create a brand map with both the brand locations (again, using the factor scores) and the attribute arrows (using the factor loadings) by checking both the 'Brands' and 'Attributes' boxes. The orientation of the arrows is determined by the degree of correlation between attribute and factors, i.e., the factor loadings. The attribute `Service` has a strong positive loading on factor 1 and so it points, mostly, in the direction in which factor 1 increases in value (i.e., to the right). Since the correlation of `Service` with factor 2 is, slightly, positive the arrow points up rather than down. In contrast, the attribute `Convenience` has a strong positive loading on factor 2 and so it points, mostly, in the direction in which factor 2 increases in value (i.e., up). Since it's correlation with factor 1 is, slightly, positive the arrow points to the right rather than to the left. The length of the arrows is proportional to the communalities reported in the _Summary_ tab. The higher the communality, the longer the arrow. If an attribute is not well summarized in the derived factors it's communality will be low and the arrow in the brand map for that attribute will be short. + +

    + +Finally, we can add the preference information to the map by checking the 'Preferences' box. The orientation of the segment preference arrows is determined by the correlation between the factor scores and the preference scores. Since the preferences for the retailers expressed by respondents assigned to segment 2 are highly correlated with factor 2 the arrow points almost straight up. The negative correlations of the preference scores for segment 1 with both factor 1 and factor 2 ensure the arrow will point down and to the left. + +

    + +In the plot we see that Whole foods and Cub foods are perceived as more comparable on the attributes for which we have data than, for example, Whole foods and Wal-Mart. From the plot a manager might conclude that the brands that are closest together in the map are perceived as close substitutes and, hence, close competitors in the minds of consumers. + +An important limitation of a map without attribute information, e.g., based on (dis)similarity data, is that it is difficult to interpret why brands are located close together or far apart. By adding the attribute arrows to the map, as shown above, our understanding of the brand positions in the maps is significantly enhanced. For example, Jewel and Dominick's are positioned higher in the map because they are perceived to offer consumers higher levels of convenience. Similarly, Cub foods, and particularly Whole foods, offer higher levels of customer service and quality products. We can also infer which available attributes are most strongly linked to consumer preferences. Segment 2 is primarily concerned with Convenience which may explain the higher preference scores for Jewel and Dominick's. Similarly, Segment 2 cares most about Good value and very little for Assortment. This segment prefers to shop at Treasure Island and Wal-Mart. + +## Including categorical variables + + + +Attribute-based perceptual maps are calculated using Principal Components Analysis (PCA). The correlation matrix used as input for PCA can currently be calculated only for variables of type `numeric`, `integer`, and `date`. Preference information, however, can be of type `numeric`, `integer`, `date`, and `factor`. When preference variables of type {factor} are included, correlations between the factor scores and preference data will be calculated using `polycor::hetcor`. The {factor} variables will be treated as (ordinal) categorical variables and all other variables will be treated as continuous. + +### Report > Rmd + +Add code to _Report > Rmd_ to (re)create the analysis by clicking the icon on the bottom left of your screen or by pressing `ALT-enter` on your keyboard. + +### R-functions + +For an overview of related R-functions used by Radiant to generate brand maps see _Multivariate > Maps_. + +The key functions used in the `prmap` tool are `cor` and `cov` from the `stats` package and `principal` from the `psych` package. diff --git a/radiant.multivariate/vignettes/pkgdown/conjoint.Rmd b/radiant.multivariate/vignettes/pkgdown/conjoint.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..7f228b589fc7e53f33f26d704ee75462b5862fdd --- /dev/null +++ b/radiant.multivariate/vignettes/pkgdown/conjoint.Rmd @@ -0,0 +1,10 @@ +--- +title: "Multivariate > Conjoint" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_conjoint.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.multivariate/vignettes/pkgdown/full_factor.Rmd b/radiant.multivariate/vignettes/pkgdown/full_factor.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..46787ec73804013343f08ae48d947db1d61ae6eb --- /dev/null +++ b/radiant.multivariate/vignettes/pkgdown/full_factor.Rmd @@ -0,0 +1,10 @@ +--- +title: "Multivariate > Factor analysis" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_full_factor.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.multivariate/vignettes/pkgdown/hclus.Rmd b/radiant.multivariate/vignettes/pkgdown/hclus.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..3530a5630ed3c6b9236554de591d50b37db4d568 --- /dev/null +++ b/radiant.multivariate/vignettes/pkgdown/hclus.Rmd @@ -0,0 +1,10 @@ +--- +title: "Multivariate > Hierarchical cluster analysis" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_hclus.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.multivariate/vignettes/pkgdown/images/by-nc-sa.png b/radiant.multivariate/vignettes/pkgdown/images/by-nc-sa.png new file mode 100644 index 0000000000000000000000000000000000000000..76eb5da461b41405c500a557253eec5f65169519 Binary files /dev/null and b/radiant.multivariate/vignettes/pkgdown/images/by-nc-sa.png differ diff --git a/radiant.multivariate/vignettes/pkgdown/kclus.Rmd b/radiant.multivariate/vignettes/pkgdown/kclus.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..e32360e4e22a9b5ec23d2429cfdd82f30c52696c --- /dev/null +++ b/radiant.multivariate/vignettes/pkgdown/kclus.Rmd @@ -0,0 +1,10 @@ +--- +title: "Multivariate > Cluster analysis" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_kclus.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.multivariate/vignettes/pkgdown/mds.Rmd b/radiant.multivariate/vignettes/pkgdown/mds.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..cd1b6ebd6bb00110ab5b60f37b3ccdcd3f3cfe52 --- /dev/null +++ b/radiant.multivariate/vignettes/pkgdown/mds.Rmd @@ -0,0 +1,10 @@ +--- +title: "Multivariate > Brand maps (dis-similarity)" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_mds.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.multivariate/vignettes/pkgdown/pre_factor.Rmd b/radiant.multivariate/vignettes/pkgdown/pre_factor.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..25db2a01f5f2c84851245ad40e8f0112131a1a16 --- /dev/null +++ b/radiant.multivariate/vignettes/pkgdown/pre_factor.Rmd @@ -0,0 +1,10 @@ +--- +title: "Multivariate > Pre-Factor Analysis" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_pre_factor.Rmd"} +``` + +```{r child = "_footer.md"} +``` diff --git a/radiant.multivariate/vignettes/pkgdown/prmap.Rmd b/radiant.multivariate/vignettes/pkgdown/prmap.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..efcbe0a52f74dd57aea0d742a2bca02d3b00a58f --- /dev/null +++ b/radiant.multivariate/vignettes/pkgdown/prmap.Rmd @@ -0,0 +1,10 @@ +--- +title: "Multivariate > Brand maps (attributes)" +author: "Vincent R. Nijs, Rady School of Management (UCSD)" +--- + +```{r child = "_prmap.Rmd"} +``` + +```{r child = "_footer.md"} +```