[med-svn] [r-cran-rlumshiny] 03/05: New upstream version 0.2.0
Andreas Tille
tille at debian.org
Tue Oct 10 17:21:21 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-rlumshiny.
commit 531f3ed4cfc46e37ebe7b9e2885103ebc1ee5cec
Author: Andreas Tille <tille at debian.org>
Date: Tue Oct 10 19:19:58 2017 +0200
New upstream version 0.2.0
---
DESCRIPTION | 32 +-
LICENSE.note | 3 +-
MD5 | 124 +-
NAMESPACE | 6 +
NEWS | 37 +
R/RLumShiny.R | 12 +-
R/addin.R | 226 +++
R/app_RLum.R | 72 +-
R/chooser.R | 44 +
R/jscolor.R | 43 +-
R/popover.R | 44 +-
R/tooltip.R | 60 +-
inst/rstudio/addins.dcf | 4 +
inst/shiny/KDE/Global.R | 11 +
inst/shiny/KDE/server.R | 260 ++-
.../KDE/shiny_bookmarks/62408c76eac4976d/input.rds | Bin 0 -> 480 bytes
inst/shiny/KDE/ui.R | 571 ++++---
inst/shiny/KDE/www/file_containsHeader.png | Bin 41547 -> 0 bytes
inst/shiny/KDE/www/file_sep.png | Bin 46260 -> 0 bytes
inst/shiny/KDE/www/file_structure.png | Bin 42288 -> 0 bytes
inst/shiny/KDE/www/style.css | 3 -
inst/shiny/abanico/Global.R | 11 +
inst/shiny/abanico/server.R | 200 ++-
.../shiny_bookmarks/8027aaa9b994c7bd/input.rds | Bin 0 -> 1098 bytes
inst/shiny/abanico/ui.R | 1703 ++++++++++----------
inst/shiny/abanico/www/file_containsHeader.png | Bin 41547 -> 0 bytes
inst/shiny/abanico/www/file_sep.png | Bin 46260 -> 0 bytes
inst/shiny/abanico/www/file_structure.png | Bin 42288 -> 0 bytes
inst/shiny/abanico/www/style.css | 3 -
inst/shiny/cosmicdose/Global.R | 7 +
inst/shiny/cosmicdose/server.R | 8 +-
.../shiny_bookmarks/5a258b62777fa1b7/input.rds | Bin 0 -> 383 bytes
.../shiny_bookmarks/6584528eb04ada68/input.rds | Bin 0 -> 383 bytes
.../shiny_bookmarks/8b67ae595d1e31f0/input.rds | Bin 0 -> 398 bytes
inst/shiny/cosmicdose/ui.R | 230 +--
inst/shiny/cosmicdose/www/RL_Logo.png | Bin 29841 -> 0 bytes
inst/shiny/cosmicdose/www/RL_Logo_alpha.png | Bin 14950 -> 0 bytes
inst/shiny/cosmicdose/www/style.css | 2 -
inst/shiny/doserecovery/Global.R | 11 +
inst/shiny/doserecovery/server.R | 147 +-
inst/shiny/doserecovery/ui.R | 731 ++++-----
.../shiny/doserecovery/www/file_containsHeader.png | Bin 41547 -> 0 bytes
inst/shiny/doserecovery/www/file_sep.png | Bin 46260 -> 0 bytes
inst/shiny/doserecovery/www/file_structure.png | Bin 42288 -> 0 bytes
inst/shiny/doserecovery/www/style.css | 3 -
inst/shiny/filter/global.R | 32 +
inst/shiny/filter/server.R | 278 ++++
inst/shiny/filter/template/template.xlsx | Bin 0 -> 50502 bytes
inst/shiny/filter/ui.R | 188 +++
inst/shiny/histogram/Global.R | 12 +
inst/shiny/histogram/server.R | 144 +-
.../shiny_bookmarks/0e7f62cc161fbb36/input.rds | Bin 0 -> 1787 bytes
.../shiny_bookmarks/1c021999f0efd158/input.rds | Bin 0 -> 1841 bytes
.../shiny_bookmarks/223e820d2f46b516/input.rds | Bin 0 -> 471 bytes
inst/shiny/histogram/ui.R | 702 ++++----
inst/shiny/histogram/www/file_containsHeader.png | Bin 41547 -> 0 bytes
inst/shiny/histogram/www/file_sep.png | Bin 46260 -> 0 bytes
inst/shiny/histogram/www/file_structure.png | Bin 42288 -> 0 bytes
inst/shiny/histogram/www/style.css | 3 -
inst/shiny/radialplot/Global.R | 11 +
inst/shiny/radialplot/server.R | 314 ++--
.../shiny_bookmarks/1e0f5bee0eebca8d/input.rds | Bin 0 -> 812 bytes
inst/shiny/radialplot/ui.R | 1185 +++++++-------
inst/shiny/radialplot/www/file_containsHeader.png | Bin 41547 -> 0 bytes
inst/shiny/radialplot/www/file_sep.png | Bin 46260 -> 0 bytes
inst/shiny/radialplot/www/file_structure.png | Bin 42288 -> 0 bytes
inst/shiny/radialplot/www/style.css | 3 -
inst/shiny/transformCW/Global.R | 10 +
inst/shiny/transformCW/Server.R | 122 +-
inst/shiny/transformCW/UI.R | 457 +++---
.../shiny_bookmarks/0bba99060aa8d69f/input.rds | Bin 0 -> 356 bytes
.../shiny_bookmarks/211d00e884a92c90/input.rds | Bin 0 -> 354 bytes
.../shiny_bookmarks/383978aa9a560a09/input.rds | Bin 0 -> 354 bytes
.../shiny_bookmarks/99c9d1b8f309e36d/input.rds | Bin 0 -> 354 bytes
.../shiny_bookmarks/9d5d05362bf9b198/input.rds | Bin 0 -> 354 bytes
.../shiny_bookmarks/cad3028cccb4abdb/input.rds | Bin 0 -> 354 bytes
.../shiny_bookmarks/f0d30b74a68561f3/input.rds | Bin 0 -> 357 bytes
inst/shiny/transformCW/www/file_containsHeader.png | Bin 41547 -> 0 bytes
inst/shiny/transformCW/www/file_sep.png | Bin 46260 -> 0 bytes
inst/shiny/transformCW/www/file_structure.png | Bin 42288 -> 0 bytes
inst/shiny/transformCW/www/style.css | 3 -
inst/www/chooser_inputBinding.js | 86 +
inst/www/jscolor/demo.html | 24 +-
man/RLumShiny-package.Rd | 12 +-
man/RLumShinyAddin.Rd | 11 +
man/app_RLum.Rd | 34 +-
man/jscolorInput.Rd | 33 +-
man/popover.Rd | 25 +-
man/tooltip.Rd | 29 +-
89 files changed, 4683 insertions(+), 3643 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index c7e5f2f..c0868d6 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,17 +1,23 @@
Package: RLumShiny
Type: Package
Title: 'Shiny' Applications for the R Package 'Luminescence'
-Version: 0.1.1
-Date: 2016-07-20
+Version: 0.2.0
+Date: 2017-06-26
Author: Christoph Burow [aut, cre],
+ Urs Tilmann Wolpert [aut],
+ Sebastian Kreutzer [aut],
R Luminescence Package Team [ctb],
Jan Odvarko [cph] (jscolor.js in www/jscolor),
- AnalytixWare [cph] (ShinySky package)
+ AnalytixWare [cph] (ShinySky package),
+ RStudio [cph] (chooser_inputBinding.js in www/ and chooser.R in R/)
Authors at R: c(
person("Christoph", "Burow", role = c("aut", "cre"), email = "christoph.burow at uni-koeln.de"),
+ person("Urs Tilmann", "Wolpert", role = "aut"),
+ person("Sebastian", "Kreutzer", role = "aut"),
person(family = "R Luminescence Package Team", role = "ctb"),
person("Jan", "Odvarko", role = "cph", comment = "jscolor.js in www/jscolor"),
- person(family = "AnalytixWare", role = "cph", comment = "ShinySky package" )
+ person(family = "AnalytixWare", role = "cph", comment = "ShinySky package" ),
+ person(family = "RStudio", role = "cph", comment = "chooser_inputBinding.js in www/ and chooser.R in R/")
)
Maintainer: Christoph Burow <christoph.burow at uni-koeln.de>
Description: A collection of 'shiny' applications for the R package
@@ -20,14 +26,16 @@ Description: A collection of 'shiny' applications for the R package
further provides access to bootstraps tooltip and popover functionality and
contains the 'jscolor.js' library with a custom 'shiny' output binding.
License: GPL-3
-Depends: R (>= 3.3.0)
-Imports: Luminescence (>= 0.6.1), shiny (>= 0.13.0), googleVis
-URL: https://github.com/tzerk/RLumShiny
+Depends: R (>= 3.3.2)
+Imports: Luminescence (>= 0.7.3), shiny (>= 0.14.0), rhandsontable (>=
+ 0.3.4), data.table (>= 1.10.4), googleVis (>= 0.6.2),
+ shinydashboard (>= 0.5.3), readxl (>= 1.0.0)
+URL: https://tzerk.github.io/RLumShiny/
BugReports: https://github.com/tzerk/RLumShiny/issues
-Collate: 'app_RLum.R' 'jscolor.R' 'tooltip.R' 'popover.R' 'RLumShiny.R'
- 'zzz.R'
-RoxygenNote: 5.0.1
+Collate: 'app_RLum.R' 'addin.R' 'chooser.R' 'jscolor.R' 'tooltip.R'
+ 'popover.R' 'RLumShiny.R' 'zzz.R'
+RoxygenNote: 6.0.1
NeedsCompilation: no
-Packaged: 2016-07-20 11:44:33 UTC; C
+Packaged: 2017-06-26 13:03:41 UTC; burowc
Repository: CRAN
-Date/Publication: 2016-07-20 17:49:32
+Date/Publication: 2017-06-26 17:00:11 UTC
diff --git a/LICENSE.note b/LICENSE.note
index 22c6771..4d26c70 100644
--- a/LICENSE.note
+++ b/LICENSE.note
@@ -5,4 +5,5 @@ The RLumShiny package includes other open source software components. The follow
is a list of these components:
- JSColor, https://github.com/odvarko/jscolor, GPLv3 License
-- ShinySky, https://github.com/AnalytixWare/ShinySky, MIT license (YEAR: 2015, COPYRIGHT HOLDER: AnalytixWare)
\ No newline at end of file
+- ShinySky, https://github.com/AnalytixWare/ShinySky, MIT license (YEAR: 2015, COPYRIGHT HOLDER: AnalytixWare)
+- chooser-binding.js & chooser.R, https://github.com/rstudio/shiny-examples/tree/master/036-custom-input-control, MIT license (YEAR: 2016, COPYRIGHT HOLDER: RStudio)
\ No newline at end of file
diff --git a/MD5 b/MD5
index e77fd4f..0b61dae 100644
--- a/MD5
+++ b/MD5
@@ -1,75 +1,87 @@
-b31dad9d180f358e35c8090fdc67db6f *DESCRIPTION
-169bcfd11b1dec13dd628e79e62246e9 *LICENSE.note
-6e84e2cce040a76763339a1b0cddf348 *NAMESPACE
-85e91fcfd362a884e9fa1d582112165a *NEWS
-3d1bec88a71b4a8a0c4e5d7bd054b502 *R/RLumShiny.R
-21e88311767f846a476095d7b9f009e9 *R/app_RLum.R
-a878807dcc583adb8935a64c3e1d9822 *R/jscolor.R
-0bdb6871c2e699e059468161a966eae5 *R/popover.R
-03b8c4d68b292f24a2e73ef33476d13c *R/tooltip.R
+882e548eabdcc8bec6551b7b384c878f *DESCRIPTION
+6fbb53acfc07165c6ece0db954f33d0a *LICENSE.note
+3caef365403b885737019fb87dd14c0a *NAMESPACE
+c961edee54564972a3bd7fac99d2205a *NEWS
+914c8c5045956927299ce7f1a49f1c37 *R/RLumShiny.R
+e0f452661a235ea9878e3429e91c3c5c *R/addin.R
+35b8c95c6027fbf8941258ea6d8d9143 *R/app_RLum.R
+c311aadc456bd03bc1719726f2dd9921 *R/chooser.R
+52bc4bd492b595207b563160448d2518 *R/jscolor.R
+6deddc9fe3b00c150c36478be370a273 *R/popover.R
+4efb87fd14c30714a3f1c187c0aa7dcf *R/tooltip.R
dba18dc70f5abb65198f35e1796205c8 *R/zzz.R
-426cd9b7a3a4039aa3ee977f155b0b9c *inst/shiny/KDE/server.R
-8412263bf9f1a01a58bce253429407de *inst/shiny/KDE/ui.R
+706e85a626487748a7799a5055502ec3 *inst/rstudio/addins.dcf
+31c93652e3ad30cdcd044b066429efdc *inst/shiny/KDE/Global.R
+65fed988f9bca584ff7bc5f25e057063 *inst/shiny/KDE/server.R
+13ecd7b5173d2d7af24e48d42ef5ea34 *inst/shiny/KDE/shiny_bookmarks/62408c76eac4976d/input.rds
+6787611a59c2f6d585548b7f2cf12f9c *inst/shiny/KDE/ui.R
f87561b8bb354ef83b09a66e54f70e08 *inst/shiny/KDE/www/GitHub-Mark-32px.png
8e0ac7aba1d56a2372306a20f4ae37c2 *inst/shiny/KDE/www/RL_Logo.png
-8ddc3437553d0ef7626eff7aa244d2ff *inst/shiny/KDE/www/file_containsHeader.png
-a7956fba543bb0eff0b039ab1d47cea9 *inst/shiny/KDE/www/file_sep.png
-c05a4e64db3488e7db6618c89fb1a170 *inst/shiny/KDE/www/file_structure.png
-0484b200c6ca1d347c441a0bc4ec61ae *inst/shiny/KDE/www/style.css
-3571df6af15fe7e06c80a9202cf3d675 *inst/shiny/abanico/server.R
-6a9d977633cb10c48273c019ba4d1a92 *inst/shiny/abanico/ui.R
+e3a2deb2d5f93d6c5339bd7f8a018ccd *inst/shiny/KDE/www/style.css
+d124472141f34b394b08d16ca9a592f5 *inst/shiny/abanico/Global.R
+508ae5502f992b311817392f6cf59a5c *inst/shiny/abanico/server.R
+904d4bdf9df182f1784a0fb1757c70d2 *inst/shiny/abanico/shiny_bookmarks/8027aaa9b994c7bd/input.rds
+e48815537a789a2a6ca9404e3be43b49 *inst/shiny/abanico/ui.R
f87561b8bb354ef83b09a66e54f70e08 *inst/shiny/abanico/www/GitHub-Mark-32px.png
8e0ac7aba1d56a2372306a20f4ae37c2 *inst/shiny/abanico/www/RL_Logo.png
-8ddc3437553d0ef7626eff7aa244d2ff *inst/shiny/abanico/www/file_containsHeader.png
-a7956fba543bb0eff0b039ab1d47cea9 *inst/shiny/abanico/www/file_sep.png
-c05a4e64db3488e7db6618c89fb1a170 *inst/shiny/abanico/www/file_structure.png
-0484b200c6ca1d347c441a0bc4ec61ae *inst/shiny/abanico/www/style.css
-0e24f11677db867088c3e9ae3c834668 *inst/shiny/cosmicdose/server.R
-d52414852639bd46140bb66b46ef896d *inst/shiny/cosmicdose/ui.R
-8e0ac7aba1d56a2372306a20f4ae37c2 *inst/shiny/cosmicdose/www/RL_Logo.png
-6b1c92b7ba57d5fc11df0f953708d755 *inst/shiny/cosmicdose/www/RL_Logo_alpha.png
-c436a9168d2cad8d1ebffdb09b1b3cbd *inst/shiny/cosmicdose/www/style.css
-63955dd38d8f52c55ae7485905043652 *inst/shiny/doserecovery/server.R
-8a1e18aa108c10d4706cbfc6fc6b98df *inst/shiny/doserecovery/ui.R
+e3a2deb2d5f93d6c5339bd7f8a018ccd *inst/shiny/abanico/www/style.css
+23b741f412b9a2fd64a0db52464f16f6 *inst/shiny/cosmicdose/Global.R
+bac027923b1b5a4345a59456304bbcba *inst/shiny/cosmicdose/server.R
+aef6bc694aa61d3f3b74f2f6355c1062 *inst/shiny/cosmicdose/shiny_bookmarks/5a258b62777fa1b7/input.rds
+aef6bc694aa61d3f3b74f2f6355c1062 *inst/shiny/cosmicdose/shiny_bookmarks/6584528eb04ada68/input.rds
+8bf851e7038a88de19c04f81d563f58d *inst/shiny/cosmicdose/shiny_bookmarks/8b67ae595d1e31f0/input.rds
+0654e662d222d1b517f54059333884ea *inst/shiny/cosmicdose/ui.R
+c456256ab4f1384440d3fe8f6438d692 *inst/shiny/cosmicdose/www/style.css
+ddc7f6e07f044fe4699fe89e0a8d418b *inst/shiny/doserecovery/Global.R
+01c8eeffc144eb931814244edc02e6dc *inst/shiny/doserecovery/server.R
+c1cf9e67adb1b710790fc6bfa66fe16e *inst/shiny/doserecovery/ui.R
f87561b8bb354ef83b09a66e54f70e08 *inst/shiny/doserecovery/www/GitHub-Mark-32px.png
8e0ac7aba1d56a2372306a20f4ae37c2 *inst/shiny/doserecovery/www/RL_Logo.png
-8ddc3437553d0ef7626eff7aa244d2ff *inst/shiny/doserecovery/www/file_containsHeader.png
-a7956fba543bb0eff0b039ab1d47cea9 *inst/shiny/doserecovery/www/file_sep.png
-c05a4e64db3488e7db6618c89fb1a170 *inst/shiny/doserecovery/www/file_structure.png
-0484b200c6ca1d347c441a0bc4ec61ae *inst/shiny/doserecovery/www/style.css
-471df62e0a25e990b91a7f303da800b0 *inst/shiny/histogram/server.R
-40471ccdf272206260a4bd6d8f9c224c *inst/shiny/histogram/ui.R
+e3a2deb2d5f93d6c5339bd7f8a018ccd *inst/shiny/doserecovery/www/style.css
+7226cd5d011c60becebf27ece419a455 *inst/shiny/filter/global.R
+bc9b6cf298d5afad726c586750f9d77f *inst/shiny/filter/server.R
+1beaf2182b1cb5f9d28d95c2b989f5b2 *inst/shiny/filter/template/template.xlsx
+07b4a2cf19ef69c9e644d4357fd43e3c *inst/shiny/filter/ui.R
+9df65bd1b3068d93f2646edfc40d8d22 *inst/shiny/histogram/Global.R
+5879c3f68d1f038296ab71a99626ee1e *inst/shiny/histogram/server.R
+d76855193c964b7bccecbb1d2e7ef65a *inst/shiny/histogram/shiny_bookmarks/0e7f62cc161fbb36/input.rds
+8567db0e64ac6b942bf222360ce4109d *inst/shiny/histogram/shiny_bookmarks/1c021999f0efd158/input.rds
+f561bc0b0902e1ed530da36d1024aa54 *inst/shiny/histogram/shiny_bookmarks/223e820d2f46b516/input.rds
+bf1e2cf4dcb5be559d25b3dd50163d98 *inst/shiny/histogram/ui.R
f87561b8bb354ef83b09a66e54f70e08 *inst/shiny/histogram/www/GitHub-Mark-32px.png
8e0ac7aba1d56a2372306a20f4ae37c2 *inst/shiny/histogram/www/RL_Logo.png
-8ddc3437553d0ef7626eff7aa244d2ff *inst/shiny/histogram/www/file_containsHeader.png
-a7956fba543bb0eff0b039ab1d47cea9 *inst/shiny/histogram/www/file_sep.png
-c05a4e64db3488e7db6618c89fb1a170 *inst/shiny/histogram/www/file_structure.png
-4954811f0c422b9f6ad435dc2da40387 *inst/shiny/histogram/www/style.css
-1ce322c54d600b2285cfb1cbb96c3769 *inst/shiny/radialplot/server.R
-04507bc5e4eeeac559c39a6b8a1daf17 *inst/shiny/radialplot/ui.R
+e3a2deb2d5f93d6c5339bd7f8a018ccd *inst/shiny/histogram/www/style.css
+de0745eeb780725a3b3fdf7ab8d06b79 *inst/shiny/radialplot/Global.R
+e98b28404e169fa6b9bae238f1a00b70 *inst/shiny/radialplot/server.R
+4e7245255842778ae433cfaf21303aee *inst/shiny/radialplot/shiny_bookmarks/1e0f5bee0eebca8d/input.rds
+6dcd8a126f0c16d954b6e3023b2f3391 *inst/shiny/radialplot/ui.R
f87561b8bb354ef83b09a66e54f70e08 *inst/shiny/radialplot/www/GitHub-Mark-32px.png
8e0ac7aba1d56a2372306a20f4ae37c2 *inst/shiny/radialplot/www/RL_Logo.png
-8ddc3437553d0ef7626eff7aa244d2ff *inst/shiny/radialplot/www/file_containsHeader.png
-a7956fba543bb0eff0b039ab1d47cea9 *inst/shiny/radialplot/www/file_sep.png
-c05a4e64db3488e7db6618c89fb1a170 *inst/shiny/radialplot/www/file_structure.png
-0484b200c6ca1d347c441a0bc4ec61ae *inst/shiny/radialplot/www/style.css
-ace6cd681dc2f867c56ed3a2daf40c76 *inst/shiny/transformCW/Server.R
-2db6aa46a78d8476cefd417c321abee5 *inst/shiny/transformCW/UI.R
+e3a2deb2d5f93d6c5339bd7f8a018ccd *inst/shiny/radialplot/www/style.css
+47262ad26d07ca7ea00a03fa28096ab6 *inst/shiny/transformCW/Global.R
+1be50d8a062db0fac1c9ad5ff3b081d7 *inst/shiny/transformCW/Server.R
+2efe487ea4540e7de37d9608cef5fcac *inst/shiny/transformCW/UI.R
+ddb8828f02a95d6aec2c0c1e3567ade1 *inst/shiny/transformCW/shiny_bookmarks/0bba99060aa8d69f/input.rds
+5c246bf25960086aec1640b1f5b11f15 *inst/shiny/transformCW/shiny_bookmarks/211d00e884a92c90/input.rds
+5c246bf25960086aec1640b1f5b11f15 *inst/shiny/transformCW/shiny_bookmarks/383978aa9a560a09/input.rds
+5c246bf25960086aec1640b1f5b11f15 *inst/shiny/transformCW/shiny_bookmarks/99c9d1b8f309e36d/input.rds
+5c246bf25960086aec1640b1f5b11f15 *inst/shiny/transformCW/shiny_bookmarks/9d5d05362bf9b198/input.rds
+5c246bf25960086aec1640b1f5b11f15 *inst/shiny/transformCW/shiny_bookmarks/cad3028cccb4abdb/input.rds
+b23354fa46bd504ecaa66e0f87784821 *inst/shiny/transformCW/shiny_bookmarks/f0d30b74a68561f3/input.rds
f87561b8bb354ef83b09a66e54f70e08 *inst/shiny/transformCW/www/GitHub-Mark-32px.png
8e0ac7aba1d56a2372306a20f4ae37c2 *inst/shiny/transformCW/www/RL_Logo.png
-8ddc3437553d0ef7626eff7aa244d2ff *inst/shiny/transformCW/www/file_containsHeader.png
-a7956fba543bb0eff0b039ab1d47cea9 *inst/shiny/transformCW/www/file_sep.png
-c05a4e64db3488e7db6618c89fb1a170 *inst/shiny/transformCW/www/file_structure.png
-0484b200c6ca1d347c441a0bc4ec61ae *inst/shiny/transformCW/www/style.css
+e3a2deb2d5f93d6c5339bd7f8a018ccd *inst/shiny/transformCW/www/style.css
+207cae2b4946f89cf59dfe995b0c4b33 *inst/www/chooser_inputBinding.js
5034704a76cd55c1cbcbc58ea6bf523f *inst/www/jscolor/arrow.gif
ba9a274b9323753cd95bc3b1eb2f4e5f *inst/www/jscolor/cross.gif
-edf71251cb2be20322d2efb00aee86a6 *inst/www/jscolor/demo.html
+742abe680859d25a2052ac5be6b65203 *inst/www/jscolor/demo.html
fefa1a03d92ebad25c88dca94a0b63db *inst/www/jscolor/hs.png
990d71cada17da100653636cf8490884 *inst/www/jscolor/hv.png
a26701f49bf33da8dc48f3431e5f4f42 *inst/www/jscolor/jscolor.js
c6dfa9f374d4d64208939fcfdd2df004 *inst/www/jscolor_inputBinding.js
-49bda292d3795630535903a90d8e66bc *man/RLumShiny-package.Rd
-7306c9486450b8903d152dc759750ba1 *man/app_RLum.Rd
-faeb4e8e0fc6f9f8c07234c16d375ea3 *man/jscolorInput.Rd
-97df0a79b3b90002315fe6b89a352394 *man/popover.Rd
-835b706498806e9419cdb65830634f77 *man/tooltip.Rd
+bb333c898f746ba4168e23959e2d276c *man/RLumShiny-package.Rd
+c15fb522d378a93f6fb798bee4c4e389 *man/RLumShinyAddin.Rd
+1ad3215a6b0c7eaf865d7e253de022fe *man/app_RLum.Rd
+6d7c2d22877a4185b63b694d35f0d80d *man/jscolorInput.Rd
+547122d77a3889430f3b656e502494c7 *man/popover.Rd
+194e1423d5256f59909c0966e7662cb4 *man/tooltip.Rd
diff --git a/NAMESPACE b/NAMESPACE
index 5917f57..6bf0860 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,9 +1,15 @@
# Generated by roxygen2: do not edit by hand
+export(RLumShinyAddin)
export(app_RLum)
export(jscolorInput)
export(popover)
export(tooltip)
import(Luminescence)
+import(data.table)
import(googleVis)
+import(readxl)
+import(rhandsontable)
import(shiny)
+import(shinydashboard)
+importFrom(utils,citation)
diff --git a/NEWS b/NEWS
index 1ff17a4..29d62ff 100644
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,40 @@
+RLumShiny 0.2.0 (Release date: 2017-06-26)
+==============
+
+* Major overhaul of the data input panel for most applications. Uploaded text
+ files are now imported via 'data.table::fread()', which automatically
+ detects the delimiter and potential headers. Hence, all widgets related to
+ data import are no longer required and were removed (#14).
+
+* The input data can now be directly manipulated in the newly added spreadsheet(s)
+ in the data input panels. The spreadsheets also allow copy and pasting of data,
+ so uploading a file is no longer the only way to provide user data (#12).
+
+* New Dashboard addin added. The dashboard provides access to all available
+ applications in the package and can be accessed either (i) through the
+ addin dropdown menu in the RStudio IDE or (ii) by running 'app_RLum()' without
+ any keyword.
+
+* Implemented newest shiny feature (v0.14) to bookmark the current app state.
+ All apps now include a bookmark button, which returns a URL query string that
+ can be used to restore the app's state at any later time.
+
+* New application to plot filter combinations along with the optional
+ net transmission. Base function: `Luminescence::plot_FilterCombinations()`.
+ Keyword for `app_RLum()`: 'filter'. External contribution by Urs Tilmann
+ Wolpert (Justus-Liebig-University Giessen) and Sebastian Kreutzer
+ (Universite Bordeaux Montaigne).
+
+* New package dependencies: 'shinydashboard', 'rhandsontable', 'data.table', 'readxl'
+
+* transformCW-app:
+ + the plot now also shows the CW-OSL data curve
+ + improved error handling
+
+* Internal: R dcoumentation re-written in Markdown using 'roxygen2 >=6.0.0'
+
+* Several minor bugfixes.
+
RLumShiny 0.1.1 (Release date: 2016-07-20)
==============
diff --git a/R/RLumShiny.R b/R/RLumShiny.R
index 38db879..2ee4dfd 100644
--- a/R/RLumShiny.R
+++ b/R/RLumShiny.R
@@ -6,16 +6,18 @@
#' bootstraps tooltip and popover functionality as well as a binding to JSColor.
#'
#' In addition to its main purpose of providing convenient access to the Luminescence
-#' shiny applications (see \code{\link{app_RLum}}) this package also provides further functions to extend the
+#' shiny applications (see [`app_RLum`]) this package also provides further functions to extend the
#' functionality of shiny. From the Bootstrap framework the JavaScript tooltip and popover
-#' components can be added to any shiny application via \code{\link{tooltip}} and \code{\link{popover}}.
+#' components can be added to any shiny application via [`tooltip`] and [`popover`].
#' It further provides a custom input binding to the JavaScript/HTML color picker JSColor.
-#' Offering access to most options provided by the JSColor API the function \code{\link{jscolorInput}}
+#' Offering access to most options provided by the JSColor API the function [`jscolorInput`]
#' is easily implemented in a shiny app. RGB colors are returned as hex values and can be
#' directly used in R's base plotting functions without the need of any format conversion.
#'
#' @name RLumShiny-package
-#' @aliases RLumShiny
#' @docType package
-#' @import Luminescence shiny googleVis
+#' @import Luminescence shiny googleVis shinydashboard rhandsontable data.table readxl
+#' @importFrom utils citation
+#'
+#' @md
NULL
\ No newline at end of file
diff --git a/R/addin.R b/R/addin.R
new file mode 100644
index 0000000..3b1d111
--- /dev/null
+++ b/R/addin.R
@@ -0,0 +1,226 @@
+#' RLumShiny Dashboard Addin
+#'
+#' RLumShiny dashboard
+#'
+#' @export
+RLumShinyAddin <- function() {
+
+ ## GLOBAL --------------------------------------------------------------------
+ # List of applications available in RLumShiny
+ applications <- list(
+
+ "abanico" = list(title = "Abanico Plot",
+ keyword = "abanico",
+ category = "plot",
+ description = "A plot which allows comprehensive presentation of data precision and its dispersion around a central value as well as illustration of a kernel density estimate, histogram and/or dot plot of the dose values."),
+
+ "cosmic" = list(title = "Cosmic Dose Rate",
+ keyword = "cosmicdose",
+ category = "calc",
+ description = "This function calculates the cosmic dose rate taking into account the soft- and hard-component of the cosmic ray flux and allows corrections for geomagnetic latitude, altitude above sea-level and geomagnetic field changes."),
+
+ "kde" = list(title = "Kernel Density Estimate Plot",
+ keyword = "kde",
+ category = "plot",
+ description = "Plot a kernel density estimate of measurement values in combination with the actual values and associated error bars in ascending order."),
+
+ "doserecovery" = list(title = "Dose Recovery Test",
+ keyword = "doserecovery",
+ category = "plot",
+ description = "The function provides a standardised plot output for dose recovery test measurements."),
+
+ "radialplot" = list(title = "Radial Plot",
+ keyword = "radialplot",
+ category = "plot",
+ description = "A Galbraith's radial plot is produced on a logarithmic or a linear scale."),
+
+ "histogram" = list(title = "Histogram",
+ keyword = "histogram",
+ category = "plot",
+ description = "Function plots a predefined histogram with an accompanying error plot as suggested by Rex Galbraith at the UK LED in Oxford 2010."),
+
+ "transformCW" = list(title = "Transform CW-OSL curves",
+ keyword = "transformCW",
+ category = "misc",
+ description = "Transform a conventionally measured continuous-wave (CW) OSL-curve to a pseudo parabolic/hyperbolic/linearly modulated curve."),
+
+ "filter" = list(title = "Filter Combinations",
+ keyword = "filter",
+ category = "misc",
+ description = "Plot filter combinations along with the (optional) net transmission window.")
+
+ )
+
+ # HELPER FUNCTIONS ------------------
+ split_by_category <- function(x) {
+
+ # get unique categories
+ categories <- unique(sapply(x, function(el) el$category))
+
+ # for each unique category...
+ lst <- lapply(categories, function(cat) {
+
+ # ...get application
+ lst.sub <- lapply(x, function(el) {
+ if (el$category == cat)
+ return(el)
+ })
+
+ # remove NULL objects (ie. apps not within the category)
+ lst.sub[!sapply(lst.sub, is.null)]
+ })
+
+ # append category names
+ names(lst) <- categories
+
+ return(lst)
+ }
+
+
+ ## HEADER ----------------------------------------------------------------------
+ header <- dashboardHeader(
+ title = tags$p(style = "color:white; font-family:verdana;","RLumShiny"),
+ tags$li(class = "dropdown", tags$a(href = "https://github.com/tzerk/RLumShiny", icon("github"))),
+ tags$li(class = "dropdown", tags$a(href = "https://twitter.com/RLuminescence", icon("twitter"))),
+ tags$li(class = "dropdown", tags$a(href = "https://forum.r-luminescence.de/", icon("comments-o")))
+ )#EndOf:Header
+
+
+ ## SIDEBAR ---------------------------------------------------------------------
+ sidebar <- dashboardSidebar(
+
+ sidebarSearchForm(textId = "searchText", buttonId = "searchButton",
+ label = "Search..."),
+
+ # tabNames must have the categorial value (see globals.R)
+ sidebarMenu(id = "sidebar",
+ menuItem("Dashboard", icon = icon("dashboard"), tabName = ""),
+ menuItem("Plotting", icon = icon("bar-chart"), tabName = "plot"),
+ menuItem("Calculation", icon = icon("calculator"), tabName = "calc"),
+ menuItem("Miscellaneous", icon = icon("cogs"), tabName = "misc")
+ ),
+ tags$hr(),
+ tags$div(align = "left",
+ tags$p(style = "color: grey; margin-left: 10px; margin-right: 40px; font-size: 80%;",
+ attributes(unclass(citation("RLumShiny"))[[1]])$textVersion)
+ )
+
+ )#EndOf:Sidebar
+
+
+ ## BODY ------------------------------------------------------------------------
+ body <- dashboardBody(
+
+ ## custom CSS for shiny(dashboard) elements
+ # info-box
+ tags$head(tags$style(HTML('.info-box {min-height: 210px;} .info-box-icon {height: 100px; line-height: 100px;}'))),
+ # background of the dashboard body
+ tags$head(tags$style(HTML('.content-wrapper {height: 1400px;}'))),
+
+ # JavaScript code executed when clicking a href link; it will initialise
+ # the input$linkClicked variable that can be used within the server logic
+ tags$script(HTML("
+function clickFunction(link){
+alert('The following application will now be started: ' + link + '\\n\\nNote: This window will become unresponsive. \\nDo not close until done with the application!');
+Shiny.onInputChange('linkClicked', link);
+}
+")),
+
+ # The whole dashboard body is generated dynamically in the server logic
+ uiOutput("body")
+ )#EndOf:Body
+
+
+ ## RENDER PAGE -----------------------------------------------------------------
+ ui <- dashboardPage(header, sidebar, body)
+
+
+ ## SERVER LOGIC ----------------------------------------------------------------
+ server <- function(input, output, session) {
+
+ # FILTER -----------------------------------
+ get_Items <- reactive({
+
+ matches <- sapply(applications, function(el) {
+ # filter by search name & category
+ grepl(input$searchText, el$title, ignore.case = TRUE) &
+ grepl(input$sidebar, el$category)
+ })
+
+ # split by category (globals.R)
+ split_by_category(applications[matches])
+ })
+
+
+ # BODY -------------------------------------
+ output$body <- renderUI({
+
+ # get (filtered) list of available applications
+ items <- get_Items()
+
+ # create infoBoxes for each application
+ mainbody <- Map(function(apps, cat) {
+
+ category <- switch(cat,
+ "plot" = "Plotting",
+ "calc" = "Calculation",
+ "misc" = "Miscellaneous",
+ "stat" = "Statistics")
+
+ color <- switch(cat,
+ "plot" = "red",
+ "calc" = "light-blue",
+ "misc" = "green",
+ "stat" = "black")
+
+ icon <- switch(cat,
+ "plot" = icon("bar-chart"),
+ "calc" = icon("calculator"),
+ "misc" = icon("cogs"),
+ "stat" = icon("superscript"))
+
+ # all applications of a particular category are wrapped around with
+ # with collapsible box
+ box(title = category,
+ collapsible = TRUE,
+ width = 12, height = "100%",
+ # embed infoboxes for all applications of a category
+ Map(function(app, id) {
+
+ div(
+ infoBox(title = HTML("<b>", app$title, "</b><hr>"),
+ fill = TRUE,
+ subtitle = app$description,
+ color = color,
+ icon = icon,
+ href = "#"),
+ onclick = paste0("clickFunction('", app$keyword,"'); return false;"))
+
+ }, apps, 1:length(apps)))
+ }, items, names(items))
+
+ return(mainbody)
+ })
+
+
+ ## Start application
+ # workaround: clicking on any of the infoboxes causes the gadget to
+ # terminate, which triggers the custom onSessionEnded callback.
+ # We have to terminate the gadget first to make room for starting
+ # another shiny instance, i.e., the chosen app
+ observeEvent(input$linkClicked, {
+ stopApp(NULL)
+ })
+ session$onSessionEnded(function() {
+ isolate({
+ if (!is.null(input$linkClicked))
+ app_RLum(input$linkClicked)
+ })
+ })
+
+ }#EndOf:ServerLogic
+
+ viewer <- dialogViewer("RLumShiny Dashboard", width = 1400, height = 800)
+
+ runGadget(ui, server, viewer = viewer)
+}
\ No newline at end of file
diff --git a/R/app_RLum.R b/R/app_RLum.R
index 0795529..87edd25 100644
--- a/R/app_RLum.R
+++ b/R/app_RLum.R
@@ -1,34 +1,44 @@
#' Run Luminescence shiny apps
#'
-#' A wrapper for \code{\link{runApp}} to start interactive shiny apps for the R package Luminescence.
+#' A wrapper for [`runApp`] to start interactive shiny apps for the R package Luminescence.
#'
-#' The RLumShiny package provides a single function from which all shiny apps can be started: \code{app_RLum()}.
+#' The RLumShiny package provides a single function from which all shiny apps can be started: `app_RLum()`.
#' It essentially only takes one argument, which is a unique keyword specifying which application to start.
-#' See the table below for a list of available shiny apps and which keywords to use.
+#' See the table below for a list of available shiny apps and which keywords to use. If no keyword is used
+#' a dashboard will be started instead, from which an application can be started.
#'
#' \tabular{lcl}{
-#' \bold{Application name:} \tab \bold{Keyword:} \tab \bold{Function:} \cr
-#' Abanico Plot \tab \emph{abanico} \tab \code{\link{plot_AbanicoPlot}} \cr
-#' Histogram \tab \emph{histogram} \tab \code{\link{plot_Histogram}} \cr
-#' Kernel Density Estimate Plot \tab \emph{KDE} \tab \code{\link{plot_KDE}} \cr
-#' Radial Plot \tab \emph{radialplot} \tab \code{\link{plot_RadialPlot}} \cr
-#' Dose Recovery Test \tab \emph{doserecovery} \tab \code{\link{plot_DRTResults}} \cr
-#' Cosmic Dose Rate \tab \emph{cosmicdose} \tab \code{\link{calc_CosmicDoseRate}} \cr
-#' CW Curve Transformation \tab \emph{transformCW} \tab \code{\link{CW2pHMi}, \link{CW2pLM}, \link{CW2pLMi}, \link{CW2pPMi}}
+#' **Application name:** \tab **Keyword:** \tab **Function:** \cr
+#' Abanico Plot \tab *abanico* \tab [`plot_AbanicoPlot`] \cr
+#' Histogram \tab *histogram* \tab [`plot_Histogram`] \cr
+#' Kernel Density Estimate Plot \tab *KDE* \tab [`plot_KDE`] \cr
+#' Radial Plot \tab *radialplot* \tab [`plot_RadialPlot`] \cr
+#' Dose Recovery Test \tab *doserecovery* \tab [`plot_DRTResults`] \cr
+#' Cosmic Dose Rate \tab *cosmicdose* \tab [`calc_CosmicDoseRate`] \cr
+#' CW Curve Transformation \tab *transformCW* \tab [`CW2pHMi`], [`CW2pLM`], [`CW2pLMi`], [`CW2pPMi`] \cr
+#' Filter Combinations \tab *filter* \tab [`plot_FilterCombinations`]
#' }
#'
-#' The \code{app_RLum()} function is just a wrapper for \code{\link{runApp}}.
-#' Via the \code{...} argument further arguments can be directly passed to \code{\link{runApp}}.
-#' See \code{?shiny::runApp} for further details on valid arguments.
+#' The `app_RLum()` function is just a wrapper for [`runApp`].
+#' Via the `...` argument further arguments can be directly passed to [`runApp`].
+#' See `?shiny::runApp` for further details on valid arguments.
+#'
+#'
+#' @param app [`character`] (**required**):
+#' name of the application to start. See details for a list of available apps.
+#'
+#' @param ... further arguments to pass to [`runApp`]
#'
-#' @param app \code{\link{character}} (required): name of the application to start. See details for a list
-#' of available apps.
-#' @param ... further arguments to pass to \code{\link{runApp}}
#' @author Christoph Burow, University of Cologne (Germany)
-#' @seealso \code{\link{runApp}}
+#'
+#' @seealso [`runApp`]
+#'
#' @examples
#'
#' \dontrun{
+#' # Dashboard
+#' app_RLum()
+#'
#' # Plotting apps
#' app_RLum("abanico")
#' app_RLum("histogram")
@@ -38,10 +48,13 @@
#'
#' # Further apps
#' app_RLum("cosmicdose")
+#' app_RLum("transformCW")
+#' app_RLum("filter")
#' }
#'
+#' @md
#' @export app_RLum
-app_RLum <- function(app, ...) {
+app_RLum <- function(app = NULL, ...) {
valid_apps <- c("abanico",
"cosmicdose",
@@ -49,11 +62,22 @@ app_RLum <- function(app, ...) {
"histogram",
"KDE",
"radialplot",
- "transformCW")
-
- if (!app %in% valid_apps)
- return(message(paste0("Invalid app name: ", app, " \n Valid options are: ", paste(valid_apps, collapse = ", "))))
+ "transformCW",
+ "filter")
- app <- shiny::runApp(system.file(paste0("shiny/", app), package = "RLumShiny"), launch.browser = TRUE, ...)
+ if (is.null(app)) {
+
+ # start the RLumShiny Dashboard Addin
+ RLumShinyAddin()
+
+ } else {
+
+ # check if keyword is valid
+ if (!any(grepl(app, valid_apps, ignore.case = TRUE)))
+ return(message(paste0("Invalid app name: ", app, " \n Valid options are: ", paste(valid_apps, collapse = ", "))))
+
+ # start application
+ app <- shiny::runApp(system.file(paste0("shiny/", app), package = "RLumShiny"), launch.browser = TRUE, ...)
+ }
}
\ No newline at end of file
diff --git a/R/chooser.R b/R/chooser.R
new file mode 100644
index 0000000..629f93d
--- /dev/null
+++ b/R/chooser.R
@@ -0,0 +1,44 @@
+## +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+## 'chooser.R' taken from the shiny-examples repository
+## (https://github.com/rstudio/shiny-examples) under the MIT License
+##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+chooserInput <- function(inputId, leftLabel, rightLabel, leftChoices, rightChoices,
+ size = 5, multiple = FALSE) {
+
+ shiny::registerInputHandler("shinyjsexamples.chooser", function(data, ...) {
+ if (is.null(data))
+ NULL
+ else
+ list(left=as.character(data$left), right=as.character(data$right))
+ }, force = TRUE)
+
+ leftChoices <- lapply(leftChoices, tags$option)
+ rightChoices <- lapply(rightChoices, tags$option)
+
+ if (multiple)
+ multiple <- "multiple"
+ else
+ multiple <- NULL
+
+ tagList(
+ singleton(tags$head(
+ tags$head(tags$script(src = "RLumShiny/chooser_inputBinding.js")),
+ tags$style(type="text/css",
+ HTML(".chooser-container { display: inline-block; }")
+ )
+ )),
+ div(id=inputId, class="chooser",
+ div(class="chooser-container chooser-left-container",
+ tags$select(class="left", size=size, multiple=multiple, leftChoices)
+ ),
+ div(class="chooser-container chooser-center-container",
+ icon("arrow-circle-o-right", "right-arrow fa-3x"),
+ tags$br(),
+ icon("arrow-circle-o-left", "left-arrow fa-3x")
+ ),
+ div(class="chooser-container chooser-right-container",
+ tags$select(class="right", size=size, multiple=multiple, rightChoices)
+ )
+ )
+ )
+}
\ No newline at end of file
diff --git a/R/jscolor.R b/R/jscolor.R
index 9992b68..70ec8be 100644
--- a/R/jscolor.R
+++ b/R/jscolor.R
@@ -2,20 +2,35 @@
#'
#' Creates a JSColor (Javascript/HTML Color Picker) widget to be used in shiny applications.
#'
-#' @param inputId \code{\link{character}} (required): Specifies the input slot that will be used to access the value.
-#' @param label \code{\link{character}}: Display label for the control, or NULL for no label.
-#' @param value \code{\link{character}}: Initial RGB value of the color picker. Default is black ('#000000').
-#' @param position \code{\link{character}}: Position of the picker relative to the text input ('bottom', 'left', 'top', 'right').
-#' @param color \code{\link{character}}: Picker color scheme ('transparent' by default). Use RGB color coding ('000000').
-#' @param mode \code{\link{character}}: Mode of hue, saturation and value. Can either be 'HSV' or 'HVS'.
-#' @param slider \code{\link{logical}}: Show or hide the slider.
-#' @param close \code{\link{logical}}: Show or hide a close button.
+#' @param inputId [`character`] (**required**):
+#' Specifies the input slot that will be used to access the value.
+#'
+#' @param label [`character`] (*optional*):
+#' Display label for the control, or NULL for no label.
+#'
+#' @param value [`character`] (*optional*):
+#' Initial RGB value of the color picker. Default is black ('#000000').
+#'
+#' @param position [`character`] (*with default*):
+#' Position of the picker relative to the text input ('bottom', 'left', 'top', 'right').
+#'
+#' @param color [`character`] (*with default*):
+#' Picker color scheme ('transparent' by default). Use RGB color coding ('000000').
+#'
+#' @param mode [`character`] (*with default*):
+#' Mode of hue, saturation and value. Can either be 'HSV' or 'HVS'.
+#'
+#' @param slider [`logical`] (*with default*):
+#' Show or hide the slider.
+#'
+#' @param close [`logical`] (*with default*):
+#' Show or hide a close button.
#'
-#' @seealso Other input.elements: \code{\link{animationOptions}}, \code{\link{sliderInput}};
-#' \code{\link{checkboxGroupInput}}; \code{\link{checkboxInput}}; \code{\link{dateInput}};
-#' \code{\link{dateRangeInput}}; \code{\link{fileInput}}; \code{\link{numericInput}};
-#' \code{\link{passwordInput}}; \code{\link{radioButtons}}; \code{\link{selectInput}},
-#' \code{\link{selectizeInput}}; \code{\link{submitButton}}; \code{\link{textInput}}
+#' @seealso Other input.elements: [`animationOptions`], [`sliderInput`];
+#' [`checkboxGroupInput`]; [`checkboxInput`]; [`dateInput`];
+#' [`dateRangeInput`]; [`fileInput`]; [`numericInput`];
+#' [`passwordInput`]; [`radioButtons`]; [`selectInput`],
+#' [`selectizeInput`]; [`submitButton`]; [`textInput`]
#'
#' @examples
#' # html code
@@ -37,6 +52,8 @@
#' })
#' }
#' @import shiny
+#'
+#' @md
#' @export
jscolorInput <- function(inputId, label, value, position = 'bottom', color = 'transparent', mode = 'HSV', slider = TRUE, close = FALSE) {
tagList(
diff --git a/R/popover.R b/R/popover.R
index d286194..88a1aab 100644
--- a/R/popover.R
+++ b/R/popover.R
@@ -2,13 +2,29 @@
#'
#' Add small overlays of content for housing secondary information.
#'
-#' @param title \code{\link{character}} (required): Title of the button.
-#' @param content \code{\link{character}}: Text to be displayed in the popover.
-#' @param header \code{\link{character}}: Optional header in the popover.
-#' @param html \code{\link{logical}} Insert HTML into the popover.
-#' @param class \code{\link{logical}} Bootstrap button class (e.g. "btn btn-danger").
-#' @param placement \code{\link{character}}: How to position the popover - top | bottom | left | right | auto. When "auto" is specified, it will dynamically reorient the popover. For example, if placement is "auto left", the popover will display to the left when possible, otherwise it will display right.
-#' @param trigger \code{\link{character}}: How popover is triggered - click | hover | focus | manual.
+#' @param title [`character`] (**required**):
+#' Title of the button.
+#'
+#' @param content [`character`] (**required**):
+#' Text to be displayed in the popover.
+#'
+#' @param header [`character`] (*optional*):
+#' Optional header in the popover.
+#'
+#' @param html [`logical`] (*with default*):
+#' Insert HTML into the popover.
+#'
+#' @param class [`logical`] (*with default*):
+#' Bootstrap button class (e.g. "btn btn-danger").
+#'
+#' @param placement [`character`] (*with default*):
+#' How to position the popover - top | bottom | left | right | auto.
+#' When "auto" is specified, it will dynamically reorient the popover.
+#' For example, if placement is "auto left", the popover will display to the
+#' left when possible, otherwise it will display right.
+#'
+#' @param trigger [`character`] (*with default*):
+#' How popover is triggered - click | hover | focus | manual.
#'
#' @examples
#' # html code
@@ -31,11 +47,17 @@
#' })
#' }
#' @import shiny
+#'
+#' @md
#' @export
-popover <- function(title, content, header = NULL, html = TRUE,
- class = "btn btn-default",
- placement = c('right', 'top', 'left', 'bottom'),
- trigger = c('click', 'hover', 'focus', 'manual')) {
+popover <- function(
+ title,
+ content,
+ header = NULL,
+ html = TRUE,
+ class = "btn btn-default",
+ placement = c('right', 'top', 'left', 'bottom'),
+ trigger = c('click', 'hover', 'focus', 'manual')) {
tagList(
singleton(
diff --git a/R/tooltip.R b/R/tooltip.R
index 5c5759c..fc03788 100644
--- a/R/tooltip.R
+++ b/R/tooltip.R
@@ -2,14 +2,33 @@
#'
#' Create bootstrap tooltips for any HTML element to be used in shiny applications.
#'
-#' @param refId \code{\link{character}} (required): id of the element the tooltip is to be attached to.
-#' @param text \code{\link{character}}: Text to be displayed in the tooltip.
-#' @param attr \code{\link{character}}: Attach tooltip to all elements with attribute \code{attr='refId'}.
-#' @param animation \code{\link{logical}}: Apply a CSS fade transition to the tooltip.
-#' @param delay \code{\link{numeric}}: Delay showing and hiding the tooltip (ms).
-#' @param html \code{\link{logical}}: Insert HTML into the tooltip.
-#' @param placement \code{\link{character}}: How to position the tooltip - top | bottom | left | right | auto. When 'auto' is specified, it will dynamically reorient the tooltip. For example, if placement is 'auto left', the tooltip will display to the left when possible, otherwise it will display right.
-#' @param trigger \code{\link{character}}: How tooltip is triggered - click | hover | focus | manual. You may pass multiple triggers; separate them with a space.
+#' @param refId [`character`] (**required**):
+#' id of the element the tooltip is to be attached to.
+#'
+#' @param text [`character`] (**required**):
+#' Text to be displayed in the tooltip.
+#'
+#' @param attr [`character`] (*optional*):
+#' Attach tooltip to all elements with attribute `attr='refId'`.
+#'
+#' @param animation [`logical`] (*with default*):
+#' Apply a CSS fade transition to the tooltip.
+#'
+#' @param delay [`numeric`] (*with default*):
+#' Delay showing and hiding the tooltip (ms).
+#'
+#' @param html [`logical`] (*with default*):
+#' Insert HTML into the tooltip.
+#'
+#' @param placement [`character`] (*with default*):
+#' How to position the tooltip - `top` | `bottom` | `left` | `right` | `auto`.
+#' When 'auto' is specified, it will dynamically reorient the tooltip.
+#' For example, if placement is 'auto left', the tooltip will display to the
+#' left when possible, otherwise it will display right.
+#'
+#' @param trigger [`character`] (*with default*):
+#' How tooltip is triggered - `click` | `hover` | `focus` | `manual`.
+#' You may pass multiple triggers; separate them with a space.
#'
#' @examples
#' # javascript code
@@ -49,15 +68,34 @@
#' })
#' }
#' @import shiny
+#'
+#' @md
#' @export
-tooltip <- function(refId, text, attr = NULL, animation = TRUE, delay = 100, html = TRUE, placement = 'auto', trigger = 'hover') {
+tooltip <- function(
+ refId,
+ text,
+ attr = NULL,
+ animation = TRUE,
+ delay = 100,
+ html = TRUE,
+ placement = 'auto',
+ trigger = 'hover') {
+
if (is.null(attr))
el <- sprintf("'#%s'", refId)
else
el <- sprintf("\"[%s='%s']\"", attr, refId)
tagList(
- tags$head(tags$script(HTML(sprintf("$(window).load(function(){ $(%s).tooltip({ html: %s, trigger: '%s', title: '%s', animation: %s, delay: {'show': %i, 'hide': %i}, placement: '%s' }); })",
- el, tolower(html), trigger, text, tolower(animation), delay, delay, placement))))
+ tags$head(
+ tags$script(
+ HTML(
+ sprintf("$(window).load(function(){ $(%s).tooltip({ html: %s,
+ trigger: '%s', title: '%s', animation: %s, delay:
+ {'show': %i, 'hide': %i}, placement: '%s' }); })",
+ el, tolower(html), trigger, text, tolower(animation), delay, delay, placement)
+ )
+ )
+ )
)
}
\ No newline at end of file
diff --git a/inst/rstudio/addins.dcf b/inst/rstudio/addins.dcf
new file mode 100644
index 0000000..c0abbe5
--- /dev/null
+++ b/inst/rstudio/addins.dcf
@@ -0,0 +1,4 @@
+Name: RLumShiny dashboard
+Description: RLumShiny dashboard
+Binding: RLumShinyAddin
+Interactive: true
\ No newline at end of file
diff --git a/inst/shiny/KDE/Global.R b/inst/shiny/KDE/Global.R
new file mode 100644
index 0000000..9728420
--- /dev/null
+++ b/inst/shiny/KDE/Global.R
@@ -0,0 +1,11 @@
+## Server.R
+library(Luminescence)
+library(shiny)
+library(RLumShiny)
+library(data.table)
+library(rhandsontable)
+
+# load example data
+data(ExampleData.DeValues)
+
+enableBookmarking(store = "server")
\ No newline at end of file
diff --git a/inst/shiny/KDE/server.R b/inst/shiny/KDE/server.R
index f8ee75b..31257d7 100644
--- a/inst/shiny/KDE/server.R
+++ b/inst/shiny/KDE/server.R
@@ -1,110 +1,128 @@
-## Server.R
-library(Luminescence)
-library(shiny)
-
-# load example data
-data(ExampleData.DeValues)
-data <- list(ExampleData.DeValues$CA1, ExampleData.DeValues$CA1)
-
## MAIN FUNCTION
-shinyServer(function(input, output, session) {
+function(input, output, session) {
+
+ # input data (with default)
+ values <- reactiveValues(data_primary = ExampleData.DeValues$CA1,
+ data_secondary = setNames(as.data.frame(matrix(NA_real_, nrow = 5, ncol = 2)), c("x", "y")))
# check and read in file (DATA SET 1)
- datGet<- reactive({
+ observeEvent(input$file1, {
inFile<- input$file1
- if(is.null(inFile)) return(NULL) # if no file was uploaded return NULL
- return(read.table(file = inFile$datapath, # inFile[1] contains filepath
- sep = input$sep,
- quote = "",
- header = input$headers)) # else return file
+
+ if(is.null(inFile))
+ return(NULL) # if no file was uploaded return NULL
+
+ values$data_primary <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
})
# check and read in file (DATA SET 2)
- datGet2<- reactive({
- inFile2<- input$file2
- if(is.null(inFile2)) return(NULL) # if no file was uploaded return NULL
- return(read.table(file = inFile2$datapath, # inFile[1] contains filepath
- sep = input$sep,
- quote = "",
- header = input$headers)) # else return file
+ observeEvent(input$file2, {
+ inFile<- input$file2
+
+ if(is.null(inFile))
+ return(NULL) # if no file was uploaded return NULL
+
+ values$data_secondary <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
+ })
+
+
+ ### GET DATA SETS
+ Data<- reactive({
+
+ ### GET DATA
+ data <- list(values$data_primary, values$data_secondary)
+ data <- lapply(data, function(x) {
+ x_tmp <- x[complete.cases(x), ]
+ if (nrow(x_tmp) == 0) return(NULL)
+ else return(x_tmp)
+ })
+ data <- data[!sapply(data, is.null)]
+ data <- lapply(data, function(x) setNames(x, c("Dose", "Error")))
+
+ return(data)
+ })
+
+ output$table_in_primary <- renderRHandsontable({
+ rhandsontable(values$data_primary,
+ height = 300,
+ colHeaders = c("Dose", "Error"),
+ rowHeaders = NULL)
+ })
+
+ observeEvent(input$table_in_primary, {
+
+ # Workaround for rhandsontable issue #138
+ # https://github.com/jrowen/rhandsontable/issues/138
+ df_tmp <- input$table_in_primary
+ row_names <- as.list(as.character(seq_len(length(df_tmp$data))))
+
+ df_tmp$params$rRowHeaders <- row_names
+ df_tmp$params$rowHeaders <- row_names
+ df_tmp$params$rDataDim <- as.list(c(length(row_names),
+ length(df_tmp$params$columns)))
+
+ if (df_tmp$changes$event == "afterRemoveRow")
+ df_tmp$changes$event <- "afterChange"
+
+ if (!is.null(hot_to_r(df_tmp)))
+ values$data_primary <- hot_to_r(df_tmp)
+ })
+
+ output$table_in_secondary <- renderRHandsontable({
+
+ rhandsontable(values$data_secondary,
+ height = 300,
+ colHeaders = c("Dose", "Error"),
+ rowHeaders = NULL)
+ })
+
+
+ observeEvent(input$table_in_secondary, {
+
+ # Workaround for rhandsontable issue #138
+ # https://github.com/jrowen/rhandsontable/issues/138
+ df_tmp <- input$table_in_secondary
+ row_names <- as.list(as.character(seq_len(length(df_tmp$data))))
+ df_tmp$params$rRowHeaders <- row_names
+ df_tmp$params$rowHeaders <- row_names
+ df_tmp$params$rDataDim <- as.list(c(length(row_names),
+ length(df_tmp$params$columns)))
+ if (df_tmp$changes$event == "afterRemoveRow")
+ df_tmp$changes$event <- "afterChange"
+
+ if (!is.null(hot_to_r(df_tmp)))
+ values$data_secondary <- hot_to_r(df_tmp)
+
})
# dynamically inject sliderInput for x-axis range
output$xlim<- renderUI({
- # check if file is loaded
- # # case 1: yes -> slinderInput with custom values
- if(!is.null(datGet())) {
- if(!is.null(datGet2())) {
-
- data<- rbind(datGet(),datGet2())
-
- sliderInput(inputId = "xlim",
- label = "Range x-axis",
- min = min(data[,1])*0.25,
- max = max(data[,1])*1.75,
- value = c(min(data[,1])*0.9, max(data[,1])*1.1))
-
- } else {
- data<- datGet()
-
- sliderInput(inputId = "xlim",
- label = "Range x-axis",
- min = min(data[,1])*0.25,
- max = max(data[,1])*1.75,
- value = c(min(data[,1])*0.9, max(data[,1])*1.1))
- }
- }
+ data <- do.call(rbind, Data())
+
+ sliderInput(inputId = "xlim",
+ label = "Range x-axis",
+ min = min(data[,1])*0.25,
+ max = max(data[,1])*1.75,
+ value = c(min(data[,1])*0.9, max(data[,1])*1.1))
- else { #case 2: no -> sliderInput for example data
-
- sliderInput(inputId = "xlim",
- label = "Range x-axis",
- min = min(data[[1]][,1])*0.25,
- max = max(data[[1]][,1])*1.75,
- value = c(min(data[[1]][,1])*0.9, max(data[[1]][,1]))*1.05,
- step = 1, round = 0)
- }
})## EndOf::renderUI()
# dynamically inject sliderInput for KDE bandwidth
output$bw<- renderUI({
- # check if file is loaded
- # # case 1: yes -> slinderInput with custom values
- if(!is.null(datGet())) {
- if(!is.null(datGet2())) {
- data<- rbind(datGet(),datGet2())
-
- sliderInput(inputId = "bw",
- label = "KDE bandwidth",
- min = bw.nrd0(data[,1])/4,
- max = bw.nrd0(data[,1])*4,
- value = bw.nrd0(data[,1]))
-
- } else {
-
- data<- datGet()
-
- sliderInput(inputId = "bw",
- label = "KDE bandwidth",
- min = bw.nrd0(data[,1])/4,
- max = bw.nrd0(data[,1])*4,
- value = bw.nrd0(data[,1]))
- }
- }
+ data <- do.call(rbind, Data())
+
+ sliderInput(inputId = "bw",
+ label = "KDE bandwidth",
+ min = bw.nrd0(data[,1])/4,
+ max = bw.nrd0(data[,1])*4,
+ value = bw.nrd0(data[,1]))
- else { #case 2: no -> sliderInput for example data
- # logged data
-
- sliderInput(inputId = "bw",
- label = "KDE bandwidth",
- min = 1, max = 100,
- value = 15, step = 1)
- }
})## EndOf::renderUI()
+
output$main_plot <- renderPlot({
# refresh plot on button press
@@ -123,18 +141,7 @@ shinyServer(function(input, output, session) {
outputOptions(x = output, name = "bw", suspendWhenHidden = FALSE)
# check if file is loaded and overwrite example data
- if(!is.null(datGet())) {
- data<- list(datGet(), datGet())
- }
- if(!is.null(datGet2())) {
- data2<- datGet2()
- }
-
- if(is.null(datGet()) == FALSE && is.null(datGet2()) == FALSE) {
- data<- datGet()
- data2<- datGet2()
- data<- list(data, data2)
- }
+ data <- Data()
progress$set(value = 1)
progress$set(message = "Calculation in progress",
@@ -167,7 +174,7 @@ shinyServer(function(input, output, session) {
color<- input$color
}
- if(!is.null(datGet2())) {
+ if(!all(is.na(unlist(values$data_secondary)))) {
# if custom datapoint color get RGB code from separate input panel
if(input$color2 == "custom") {
color2<- input$rgb2
@@ -197,7 +204,7 @@ shinyServer(function(input, output, session) {
ylab = c(input$ylab1, input$ylab2),
main = input$main,
values.cumulative = input$cumulative,
- na.rm = input$naExclude,
+ na.rm = TRUE,
rug = input$rug,
boxplot = input$boxplot,
summary = summary,
@@ -211,22 +218,12 @@ shinyServer(function(input, output, session) {
# prepare code as text output
- if (is.null(input$sep))
- updateRadioButtons(session, "fileformat", selected = "\t")
-
- if(input$sep == "\t")
- verb.sep<- "\\t"
- else
- verb.sep<- input$sep
-
- str1 <- paste("data <- read.delim(file, header = ",input$headers, ", sep= '", verb.sep,"')",
- sep = "")
-
- if(!is.null(datGet2())) {
- str2 <- "file2<- file.choose()"
- str3 <- paste("data2 <- read.delim(file2, header = ",input$headers, ", sep= '", verb.sep,"')",
- sep= "")
- str4 <- "data<- list(data, data2)"
+ str1 <- "data <- data.table::fread(file, data.table = FALSE)"
+
+ if(!all(is.na(unlist(values$data_secondary)))) {
+ str2 <- "file2 <- file.choose()"
+ str3 <- "data2 <- data.table::fread(file2, data.table = FALSE)"
+ str4 <- "data <- list(data, data2)"
str1 <- paste(str1, str2, str3, str4, sep = "\n")
}
@@ -324,16 +321,11 @@ shinyServer(function(input, output, session) {
});
}",
{
- if(!is.null(datGet())) {
- data<- datGet()
- colnames(data)<- c("De","De error")
+
+ data <- Data()[[1]]
+ colnames(data) <- c("De","De error")
data
- } else {
- data<- data[[1]]
- colnames(data)<- c("De","De error")
- data
- }
})##EndOf::renterTable()
# renderTable() that prints the secondary data to the second tab
@@ -347,10 +339,12 @@ output$dataset2<- renderDataTable(
});
}",
{
- if(!is.null(datGet2())) {
- data<- datGet2()
- colnames(data)<- c("De","De error")
+ if(!all(is.na(unlist(values$data_secondary)))) {
+
+ data <- Data()[[2]]
+ colnames(data) <- c("De","De error")
data
+
} else {
}
})##EndOf::renterTable()
@@ -361,15 +355,9 @@ output$dataset2<- renderDataTable(
output$CAM<- renderDataTable(
options = list(pageLength = 10, autoWidth = FALSE),
{
- if(!is.null(datGet())) {
- if(!is.null(datGet2())) {
- data<- list(datGet(), datGet2())
- } else {
- data<- list(datGet())
- }
- } else {
- data<- list(data[[1]])
- }
+
+ data <- Data()
+
t<- as.data.frame(matrix(nrow = length(data), ncol = 7))
colnames(t)<- c("Data set","n", "log data", "Central dose", "SE abs.", "OD (%)", "OD error (%)")
res<- lapply(data, function(x) { calc_CentralDose(x, verbose = FALSE, plot = FALSE) })
@@ -382,4 +370,4 @@ output$CAM<- renderDataTable(
t
})##EndOf::renterTable()
-})##EndOf::shinyServer(function(input, output)
\ No newline at end of file
+}##EndOf::shinyServer(function(input, output)
\ No newline at end of file
diff --git a/inst/shiny/KDE/shiny_bookmarks/62408c76eac4976d/input.rds b/inst/shiny/KDE/shiny_bookmarks/62408c76eac4976d/input.rds
new file mode 100644
index 0000000..eb8ce52
Binary files /dev/null and b/inst/shiny/KDE/shiny_bookmarks/62408c76eac4976d/input.rds differ
diff --git a/inst/shiny/KDE/ui.R b/inst/shiny/KDE/ui.R
index 0c06e9d..2f12d71 100644
--- a/inst/shiny/KDE/ui.R
+++ b/inst/shiny/KDE/ui.R
@@ -1,300 +1,277 @@
-library(RLumShiny)
## UI.R
-
-# load example data
-data(ExampleData.DeValues)
-
-# pageWithSidebar contains three panels:
-# 1 - headerPanel: basically just for a header
-# 2 - sidebarPanel: data input
-# 3 - mainPanel: data output
-pageWithSidebar(
- # 1 - title = NULL -> Panel will not be shown
- headerPanel(title = NULL),
- # 2- width = 5 -> refers to twitters bootstrap grid system
- # where the the maximum width is 12 that is to be shared between all
- # elements
- sidebarPanel(width = 5,
- # include a tabs in the input panel for easier navigation
- tabsetPanel(id = "tabs", type = "pill", selected = "Data",
- # Tab 1: Data input
- tabPanel("Data",
- # informational text
- div(align = "center", h5("Data upload")),
-
- # file upload button (data set 1)
- fileInput(inputId = "file1",
- label = strong("Primary data set"),
- accept="text/plain"),
- tooltip(refId = "file1", text = tags$img(src='file_structure.png', width='250px')),
- # file upload button (data set 2)
- fileInput(inputId = "file2",
- label = strong("Secondary data set"),
- accept="text/plain"),
- tooltip(refId = "file2", text = tags$img(src='file_structure.png', width='250px')),
- # informational text
- div(align = "center", h5("Settings")),
- fluidRow(
- column(width = 6,
- # logical: should NA values be excluded?
- checkboxInput(inputId = "naExclude",
- label = "Exclude NA values",
- value = TRUE),
- tooltip(refId = "naExclude", text = "Exclude NA values from the data set prior to any further operations.")
- ),
- column(width = 6,
- # logical: file contains headers?
- checkboxInput(inputId = "headers",
- label = "File contains headers",
- value = FALSE),
- tooltip(refId = "headers", text = tags$img(src='file_containsHeader.png', width='250px'))
- )),
- # char: columns separated by tab, space, comma
- radioButtons("sep", "Separator", selected = "\t", inline = TRUE,
- c("Tab" = "\t",
- "Space" = " ",
- "Comma" = ",",
- "Semicolon" = ";")),
- tooltip(refId = "sep", text = tags$img(src='file_sep.png', width='400px'), placement = "auto left"),
- hr(),
- actionButton(inputId = "refresh", label = "Refresh", icon = icon("refresh")),
- tooltip(refId = "refresh", text = "Redraw the plot")
- ),##EndOf::Tab_1
-
- # Tab 2: Statistical information
- tabPanel("Statistics",
- div(align = "center", h5("Summary")),
- fluidRow(
- column(width = 6,
- checkboxInput(inputId = "summary",
- label = "Show summary",
- value = FALSE),
- tooltip(refId = "summary", text = "Adds numerical output to the plot")
- ),
- column(width = 6,
- selectInput(inputId = "sumpos",
- label = "Summary position",
- selected = "topleft",
- choices = list("Subtitle" = "sub",
- "Center" = "center",
- Top=c("Top" = "top",
- "Top left" = "topleft",
- "Top right"= "topright"),
- Bottom=c("Bottom" = "bottom",
- "Bottom left" = "bottomleft",
- "Bottom right" = "bottomright")
- )),
- tooltip(refId = "sumpos", attr = "for", text = "Position of the statistical summary. The keyword \"Subtitle\" will only work if no plot subtitle is used.")
- )
- ),
-
- selectInput(inputId = "summary.method",
- label = "Summary method",
- selected = "unweighted",
- choices = list("Unweighted" = "unweighted",
- "Weighted" = "weighted",
- "Monte Carlo" = "MCM")),
- tooltip(refId = "summary.method", attr = "for", text = "Keyword indicating the method used to calculate the statistic summary. See calc_Statistics for details."),
-
- checkboxGroupInput(inputId = "stats",
- label = "Parameters",
- selected = c("n","mean"),
- choices = c("n" = "n",
- "Mean" = "mean",
- "Median" = "median",
- "rel. Standard deviation" = "sd.rel",
- "abs. Standard deviation" = "sd.abs",
- "rel. Standard error" = "se.rel",
- "abs. Standard error" = "se.abs",
- "Skewness" = "skewness",
- "Kurtosis" = "kurtosis",
- "% in 2 sigma range" = "in.2s")),
- tooltip(refId = "stats", text = "Statistical parameters to be shown in the summary"),
- div(align = "center", h5("Additional options")),
-
- checkboxInput(inputId = "cumulative",
- label = "Show individual data",
- value = TRUE),
- tooltip(refId = "cumulative", text = "Show cumulative individual data.")
-
- ),##EndOf::Tab_2
-
- # Tab 3: input that refer to the plot rather than the data
- tabPanel("Plot",
- div(align = "center", h5("Title")),
-
- textInput(inputId = "main",
- label = "Title",
- value = "KDE Plot"),
-
- # inject sliderInput from Server.R
- uiOutput(outputId = "bw"),
- tooltip(refId = "bw", text = "Bin width of the kernel density estimate"),
- br(),
- div(align = "center", h5("Scaling")),
- sliderInput(inputId = "cex",
- label = "Scaling factor",
- min = 0.5, max = 2,
- value = 1.0, step = 0.1),
-
- div(align = "center", h5("Further options")),
- fluidRow(
- column(width = 6,
- checkboxInput(inputId = "rug",
- label = "Add rug",
- value = TRUE)
- ),
- column(width = 6,
- checkboxInput(inputId = "boxplot",
- label = "Add boxplot",
- value = TRUE))
- )
- ),##EndOf::Tab_3
-
- # Tab 4: modify axis parameters
- tabPanel("Axis",
- div(align = "center", h5("X-axis")),
- checkboxInput(inputId = "logx",
- label = "Logarithmic x-axis",
- value = FALSE),
- textInput(inputId = "xlab",
- label = "Label x-axis",
- value = "Equivalent dose [Gy]"),
- # inject sliderInput from Server.R
- uiOutput(outputId = "xlim"),
- br(),
- div(align = "center", h5("Y-axis")),
- fluidRow(
- column(width = 6,
- textInput(inputId = "ylab1",
- label = "Label y-axis (left)",
- value = "Density")
- ),
- column(width = 6,
- textInput(inputId = "ylab2",
- label = "Label y-axis (right)",
- value = "Cumulative frequency")
- )
- )
- ),##EndOf::Tab_4
-
- # Tab 5: modify data point representation
- tabPanel("Datapoints",
- div(align = "center", h5("Primary data set")),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "color", label = "Datapoint color",
- choices = list("Black" = "black",
- "Grey" = "grey50",
- "Red" = "#b22222",
- "Green" = "#6E8B3D",
- "Blue" = "#428bca",
- "Custom" = "custom"))
- ),
- column(width = 6,
- # show only if custom color is desired
- conditionalPanel(condition = "input.color == 'custom'",
- jscolorInput(inputId = "rgb",
- label = "Choose a color"))
- )
- ),
- div(align = "center", h5("Secondary data set")),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "color2", label = "Datapoint color",
- selected = "#b22222",
- choices = list("Black" = "black",
- "Grey" = "grey50",
- "Red" = "#b22222",
- "Green" = "#6E8B3D",
- "Blue" = "#428bca",
- "Custom" = "custom"))
- ),
- column(width = 6,
- # show only if custom color is desired
- conditionalPanel(condition = "input.color2 == 'custom'",
- jscolorInput(inputId = "rgb2",
- label = "Choose a color"))
- )
- )
- ),##EndOf::Tab_5
-
- # Tab 9: save plot as pdf, wmf or eps
- tabPanel("Export",
- radioButtons(inputId = "fileformat",
- label = "Fileformat",
- choices = c("PDF (Portable Document Format)" = "pdf",
- "SVG (Scalable Vector Graphics)" = "svg",
- "EPS (Encapsulated Postscript)" = "eps")),
- textInput(inputId = "filename",
- label = "Filename",
- value = "KDE Plot"),
- fluidRow(
- column(width = 6,
- numericInput(inputId = "imgheight",
- label = "Image height",
- value = 7)
- ),
- column(width = 6,
- numericInput(inputId = "imgwidth",
- label = "Image width",
- value = 7)
- )
- ),
- selectInput(inputId = "fontfamily",
- label = "Font",
- selected = "Helvetica",
- choices = c("Helvetica" = "Helvetica",
- "Helvetica Narrow" = "Helvetica Narrow",
- "Times" = "Times",
- "Courier" = "Courier",
- "Bookman" = "Bookman",
- "Palatino" = "Palatino")),
- tags$hr(),
- downloadButton(outputId = "exportFile",
- label = "Download plot"),
- tags$hr(),
- helpText("Additionally, you can download a corresponding .R file that contains",
- "a fully functional script to reproduce the plot in your R environment!"),
- downloadButton(outputId = "exportScript",
- label = "Download R script")
- ),##EndOf::Tab_8
-
- # Tab 10: further information
- tabPanel("About",
- hr(),
- div(align = "center",
- # HTML code to include a .png file in the tab; the image file must be in
- # a subfolder called "wwww"
- img(src="RL_Logo.png", height = 100, width = 100, alt = "R.Lum"),
- p("Links:"),
- a(href = "http://www.r-luminescence.de", "R.Luminescence project page", target="_blank"),
+function(request) {
+ fluidPage(
+ titlePanel(NULL, windowTitle = "RLumShiny - KDE"),
+ sidebarLayout(
+ # 2- width = 5 -> refers to twitters bootstrap grid system
+ # where the the maximum width is 12 that is to be shared between all
+ # elements
+ sidebarPanel(width = 5,
+ # include a tabs in the input panel for easier navigation
+ tabsetPanel(id = "tabs", type = "pill", selected = "Data",
+ # Tab 1: Data input
+ tabPanel("Data",
+ # informational text
+ div(align = "center", h5("Data upload")),
+
+ # file upload button (data set 1)
+ fileInput(inputId = "file1",
+ label = strong("Primary data set"),
+ accept="text/plain, .csv, text/csv"),
+ # file upload button (data set 2)
+ fileInput(inputId = "file2",
+ label = strong("Secondary data set"),
+ accept="text/plain, .csv, text/csv"),
+ # rhandsontable input/output
+ fluidRow(
+ column(width = 6,
+ rHandsontableOutput(outputId = "table_in_primary")
+ ),
+ column(width = 6,
+ rHandsontableOutput(outputId = "table_in_secondary"))
+ ),
+ hr(),
+ actionButton(inputId = "refresh", label = "Refresh", icon = icon("refresh")),
+ tooltip(refId = "refresh", text = "Redraw the plot")
+ ),##EndOf::Tab_1
+
+ # Tab 2: Statistical information
+ tabPanel("Statistics",
+ div(align = "center", h5("Summary")),
+ fluidRow(
+ column(width = 6,
+ checkboxInput(inputId = "summary",
+ label = "Show summary",
+ value = FALSE),
+ tooltip(refId = "summary", text = "Adds numerical output to the plot")
+ ),
+ column(width = 6,
+ selectInput(inputId = "sumpos",
+ label = "Summary position",
+ selected = "topleft",
+ choices = list("Subtitle" = "sub",
+ "Center" = "center",
+ Top=c("Top" = "top",
+ "Top left" = "topleft",
+ "Top right"= "topright"),
+ Bottom=c("Bottom" = "bottom",
+ "Bottom left" = "bottomleft",
+ "Bottom right" = "bottomright")
+ )),
+ tooltip(refId = "sumpos", attr = "for", text = "Position of the statistical summary. The keyword \"Subtitle\" will only work if no plot subtitle is used.")
+ )
+ ),
+
+ selectInput(inputId = "summary.method",
+ label = "Summary method",
+ selected = "unweighted",
+ choices = list("Unweighted" = "unweighted",
+ "Weighted" = "weighted",
+ "Monte Carlo" = "MCM")),
+ tooltip(refId = "summary.method", attr = "for", text = "Keyword indicating the method used to calculate the statistic summary. See calc_Statistics for details."),
+
+ checkboxGroupInput(inputId = "stats",
+ label = "Parameters",
+ selected = c("n","mean"),
+ choices = c("n" = "n",
+ "Mean" = "mean",
+ "Median" = "median",
+ "rel. Standard deviation" = "sd.rel",
+ "abs. Standard deviation" = "sd.abs",
+ "rel. Standard error" = "se.rel",
+ "abs. Standard error" = "se.abs",
+ "Skewness" = "skewness",
+ "Kurtosis" = "kurtosis",
+ "% in 2 sigma range" = "in.2s")),
+ tooltip(refId = "stats", text = "Statistical parameters to be shown in the summary"),
+ div(align = "center", h5("Additional options")),
+
+ checkboxInput(inputId = "cumulative",
+ label = "Show individual data",
+ value = TRUE),
+ tooltip(refId = "cumulative", text = "Show cumulative individual data.")
+
+ ),##EndOf::Tab_2
+
+ # Tab 3: input that refer to the plot rather than the data
+ tabPanel("Plot",
+ div(align = "center", h5("Title")),
+
+ textInput(inputId = "main",
+ label = "Title",
+ value = "KDE Plot"),
+
+ # inject sliderInput from Server.R
+ uiOutput(outputId = "bw"),
+ tooltip(refId = "bw", text = "Bin width of the kernel density estimate"),
br(),
- a(href = "https://forum.r-luminescence.de", "Message board", target="_blank"),
+ div(align = "center", h5("Scaling")),
+ sliderInput(inputId = "cex",
+ label = "Scaling factor",
+ min = 0.5, max = 2,
+ value = 1.0, step = 0.1),
+
+ div(align = "center", h5("Further options")),
+ fluidRow(
+ column(width = 6,
+ checkboxInput(inputId = "rug",
+ label = "Add rug",
+ value = TRUE)
+ ),
+ column(width = 6,
+ checkboxInput(inputId = "boxplot",
+ label = "Add boxplot",
+ value = TRUE))
+ )
+ ),##EndOf::Tab_3
+
+ # Tab 4: modify axis parameters
+ tabPanel("Axis",
+ div(align = "center", h5("X-axis")),
+ checkboxInput(inputId = "logx",
+ label = "Logarithmic x-axis",
+ value = FALSE),
+ textInput(inputId = "xlab",
+ label = "Label x-axis",
+ value = "Equivalent dose [Gy]"),
+ # inject sliderInput from Server.R
+ uiOutput(outputId = "xlim"),
br(),
- a(href = "http://zerk.canopus.uberspace.de/R.Lum", "Online application", target="_blank"),
- br(),hr(),
- img(src='GitHub-Mark-32px.png', width='32px', height='32px'),
- br(),
- a(href = "https://github.com/tzerk/RLumShiny/tree/master/inst/shiny/KDE", "See the code at GitHub!", target="_blank")
- )#/div
- )##EndOf::Tab_9
- )##EndOf::tabsetPanel
- ),##EndOf::sidebarPanel
-
- # 3 - output panel
- mainPanel(width = 7,
- # insert css code inside <head></head> of the generated HTML file:
- # allow open dropdown menus to reach over the container
- tags$head(tags$style(type="text/css",".tab-content {overflow: visible;}")),
- tags$head(includeCSS("www/style.css")),
- # divide output in separate tabs via tabsetPanel
- tabsetPanel(
- tabPanel("Plot", plotOutput(outputId = "main_plot", height = "500px")),
- tabPanel("Primary data set", dataTableOutput("dataset")),
- tabPanel("Secondary data set", dataTableOutput("dataset2")),
- tabPanel("Central Age Model", dataTableOutput("CAM")),
- tabPanel("R plot code", verbatimTextOutput("plotCode"))
- )###EndOf::tabsetPanel
- )##EndOf::mainPanel
-)##EndOf::shinyUI(pageWithSidebar)
\ No newline at end of file
+ div(align = "center", h5("Y-axis")),
+ fluidRow(
+ column(width = 6,
+ textInput(inputId = "ylab1",
+ label = "Label y-axis (left)",
+ value = "Density")
+ ),
+ column(width = 6,
+ textInput(inputId = "ylab2",
+ label = "Label y-axis (right)",
+ value = "Cumulative frequency")
+ )
+ )
+ ),##EndOf::Tab_4
+
+ # Tab 5: modify data point representation
+ tabPanel("Datapoints",
+ div(align = "center", h5("Primary data set")),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "color", label = "Datapoint color",
+ choices = list("Black" = "black",
+ "Grey" = "grey50",
+ "Red" = "#b22222",
+ "Green" = "#6E8B3D",
+ "Blue" = "#428bca",
+ "Custom" = "custom"))
+ ),
+ column(width = 6,
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.color == 'custom'",
+ jscolorInput(inputId = "rgb",
+ label = "Choose a color"))
+ )
+ ),
+ div(align = "center", h5("Secondary data set")),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "color2", label = "Datapoint color",
+ selected = "#b22222",
+ choices = list("Black" = "black",
+ "Grey" = "grey50",
+ "Red" = "#b22222",
+ "Green" = "#6E8B3D",
+ "Blue" = "#428bca",
+ "Custom" = "custom"))
+ ),
+ column(width = 6,
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.color2 == 'custom'",
+ jscolorInput(inputId = "rgb2",
+ label = "Choose a color"))
+ )
+ )
+ ),##EndOf::Tab_5
+
+ # Tab 9: save plot as pdf, wmf or eps
+ tabPanel("Export",
+ radioButtons(inputId = "fileformat",
+ label = "Fileformat",
+ choices = c("PDF (Portable Document Format)" = "pdf",
+ "SVG (Scalable Vector Graphics)" = "svg",
+ "EPS (Encapsulated Postscript)" = "eps")),
+ textInput(inputId = "filename",
+ label = "Filename",
+ value = "KDE Plot"),
+ fluidRow(
+ column(width = 6,
+ numericInput(inputId = "imgheight",
+ label = "Image height",
+ value = 7)
+ ),
+ column(width = 6,
+ numericInput(inputId = "imgwidth",
+ label = "Image width",
+ value = 7)
+ )
+ ),
+ selectInput(inputId = "fontfamily",
+ label = "Font",
+ selected = "Helvetica",
+ choices = c("Helvetica" = "Helvetica",
+ "Helvetica Narrow" = "Helvetica Narrow",
+ "Times" = "Times",
+ "Courier" = "Courier",
+ "Bookman" = "Bookman",
+ "Palatino" = "Palatino")),
+ tags$hr(),
+ downloadButton(outputId = "exportFile",
+ label = "Download plot"),
+ tags$hr(),
+ helpText("Additionally, you can download a corresponding .R file that contains",
+ "a fully functional script to reproduce the plot in your R environment!"),
+ downloadButton(outputId = "exportScript",
+ label = "Download R script")
+ ),##EndOf::Tab_8
+
+ # Tab 10: further information
+ tabPanel("About",
+ hr(),
+ div(align = "center",
+ # HTML code to include a .png file in the tab; the image file must be in
+ # a subfolder called "wwww"
+ img(src="RL_Logo.png", height = 100, width = 100, alt = "R.Lum"),
+ p("Links:"),
+ a(href = "http://www.r-luminescence.de", "R.Luminescence project page", target="_blank"),
+ br(),
+ a(href = "https://forum.r-luminescence.de", "Message board", target="_blank"),
+ br(),
+ a(href = "http://zerk.canopus.uberspace.de/R.Lum", "Online application", target="_blank"),
+ br(),hr(),
+ img(src='GitHub-Mark-32px.png', width='32px', height='32px'),
+ br(),
+ a(href = "https://github.com/tzerk/RLumShiny/tree/master/inst/shiny/KDE", "See the code at GitHub!", target="_blank")
+ )#/div
+ )##EndOf::Tab_9
+ )##EndOf::tabsetPanel
+ ),##EndOf::sidebarPanel
+
+ # 3 - output panel
+ mainPanel(width = 7,
+ # insert css code inside <head></head> of the generated HTML file:
+ # allow open dropdown menus to reach over the container
+ tags$head(tags$style(type="text/css",".tab-content {overflow: visible;}")),
+ tags$head(includeCSS("www/style.css")),
+ # divide output in separate tabs via tabsetPanel
+ tabsetPanel(
+ tabPanel("Plot", plotOutput(outputId = "main_plot", height = "500px")),
+ tabPanel("Primary data set", dataTableOutput("dataset")),
+ tabPanel("Secondary data set", dataTableOutput("dataset2")),
+ tabPanel("Central Age Model", dataTableOutput("CAM")),
+ tabPanel("R plot code", verbatimTextOutput("plotCode"))
+ )###EndOf::tabsetPanel
+ )##EndOf::mainPanel
+ ),##EndOf::sideBarLayout
+ bookmarkButton()
+ )#EndOf::fluidPage
+}
\ No newline at end of file
diff --git a/inst/shiny/KDE/www/file_containsHeader.png b/inst/shiny/KDE/www/file_containsHeader.png
deleted file mode 100644
index 7abe3d2..0000000
Binary files a/inst/shiny/KDE/www/file_containsHeader.png and /dev/null differ
diff --git a/inst/shiny/KDE/www/file_sep.png b/inst/shiny/KDE/www/file_sep.png
deleted file mode 100644
index 0297e61..0000000
Binary files a/inst/shiny/KDE/www/file_sep.png and /dev/null differ
diff --git a/inst/shiny/KDE/www/file_structure.png b/inst/shiny/KDE/www/file_structure.png
deleted file mode 100644
index 5e3b50a..0000000
Binary files a/inst/shiny/KDE/www/file_structure.png and /dev/null differ
diff --git a/inst/shiny/KDE/www/style.css b/inst/shiny/KDE/www/style.css
index 295b46c..e6a055a 100644
--- a/inst/shiny/KDE/www/style.css
+++ b/inst/shiny/KDE/www/style.css
@@ -20,7 +20,6 @@
h5, h6 {
color: #428bca;
- font-weight: 700;
}
.tooltip-inner {
@@ -38,7 +37,6 @@ h5, h6 {
label, body, input {
font-size: 12px;
- font-weight: 100 !important;
}
.label, .badge {
@@ -46,7 +44,6 @@ label, body, input {
padding: 4px 20px;
margin: 10px;
line-height: 18px;
- font-weight: 100 !important;
}
.label-info, .badge-info {
diff --git a/inst/shiny/abanico/Global.R b/inst/shiny/abanico/Global.R
new file mode 100644
index 0000000..d5ade66
--- /dev/null
+++ b/inst/shiny/abanico/Global.R
@@ -0,0 +1,11 @@
+## global.R ##
+library(Luminescence)
+library(RLumShiny)
+library(shiny)
+library(data.table)
+library(rhandsontable)
+
+# load example data
+data(ExampleData.DeValues, envir = environment())
+
+enableBookmarking(store = "server")
\ No newline at end of file
diff --git a/inst/shiny/abanico/server.R b/inst/shiny/abanico/server.R
index a123ff9..e51d7e6 100644
--- a/inst/shiny/abanico/server.R
+++ b/inst/shiny/abanico/server.R
@@ -1,35 +1,28 @@
## Server.R
-library(Luminescence)
-library(RLumShiny)
-library(shiny)
-
-# load example data
-data(ExampleData.DeValues, envir = environment())
-data <- ExampleData.DeValues$CA1
-
## MAIN FUNCTION
-shinyServer(function(input, output, session) {
+function(input, output, session) {
+
+ # input data (with default)
+ values <- reactiveValues(data_primary = ExampleData.DeValues$CA1,
+ data_secondary = setNames(as.data.frame(matrix(NA_real_, nrow = 5, ncol = 2)), c("x", "y")))
-
### GET DATA SETS
Data<- reactive({
- ### GET DATA
- if(!is.null(datGet())) {
- if(!is.null(datGet2())) {
- data<- list(datGet(), datGet2())
- } else {
- data<- list(datGet())
- }
- } else {
- data<- list(data)
- }
-
+ ### GET DATA
+ data <- list(values$data_primary, values$data_secondary)
+ data <- lapply(data, function(x) {
+ x_tmp <- x[complete.cases(x), ]
+ if (nrow(x_tmp) == 0) return(NULL)
+ else return(x_tmp)
+ })
+ data <- data[!sapply(data, is.null)]
+ data <- lapply(data, function(x) setNames(x, c("Dose", "Error")))
### DATA FILTER
input$exclude
- sub<- data
+ sub <- data
isolate({
filter.prim<- input$filter.prim
@@ -57,29 +50,96 @@ shinyServer(function(input, output, session) {
return(data)
})
+ output$table_in_primary <- renderRHandsontable({
+ rhandsontable(values$data_primary,
+ height = 300,
+ colHeaders = c("Dose", "Error"),
+ rowHeaders = NULL)
+ })
+
+ observeEvent(input$table_in_primary, {
+
+ # Workaround for rhandsontable issue #138
+ # https://github.com/jrowen/rhandsontable/issues/138
+ # Desc.: the rownames are not updated when copying values in the table
+ # that exceed the current number of rows; hence, we have to manually
+ # update the rownames before running hot_to_r(), which would crash otherwise
+
+ # to modify the rhandsontable we need to create a local non-reactive variable
+ df_tmp <- input$table_in_primary
+ row_names <- as.list(as.character(seq_len(length(df_tmp$data))))
+
+ # now overwrite the erroneous entries in the list: 'rRowHeaders', 'rowHeaders'
+ # and 'rDataDim'
+ df_tmp$params$rRowHeaders <- row_names
+ df_tmp$params$rowHeaders <- row_names
+ df_tmp$params$rDataDim <- as.list(c(length(row_names),
+ length(df_tmp$params$columns)))
+
+ # With the above workaround we run into the problem that the 'afterRemoveRow'
+ # event checked in rhandsontable:::toR also tries to remove the surplus rowname(s)
+ # For now, we can overwrite the event and handle the 'afterRemoveRow' as a usual
+ # 'afterChange' event
+ if (df_tmp$changes$event == "afterRemoveRow")
+ df_tmp$changes$event <- "afterChange"
+
+ if (!is.null(hot_to_r(df_tmp)))
+ values$data_primary <- hot_to_r(df_tmp)
+ })
+
+ output$table_in_secondary <- renderRHandsontable({
+
+ rhandsontable(values$data_secondary,
+ height = 300,
+ colHeaders = c("Dose", "Error"),
+ rowHeaders = NULL)
+ })
+
+
+ observeEvent(input$table_in_secondary, {
+
+ # Workaround for rhandsontable issue #138
+ # https://github.com/jrowen/rhandsontable/issues/138
+ # See detailed explanation above
+ df_tmp <- input$table_in_secondary
+ row_names <- as.list(as.character(seq_len(length(df_tmp$data))))
+ df_tmp$params$rRowHeaders <- row_names
+ df_tmp$params$rowHeaders <- row_names
+ df_tmp$params$rDataDim <- as.list(c(length(row_names),
+ length(df_tmp$params$columns)))
+ if (df_tmp$changes$event == "afterRemoveRow")
+ df_tmp$changes$event <- "afterChange"
+
+ if (!is.null(hot_to_r(df_tmp)))
+ values$data_secondary <- hot_to_r(df_tmp)
+
+ })
+
# check and read in file (DATA SET 1)
- datGet<- reactive({
+ observeEvent(input$file1, {
inFile<- input$file1
- if(is.null(inFile)) return(NULL) # if no file was uploaded return NULL
- return(read.table(file = inFile$datapath, # inFile[1] contains filepath
- sep = input$sep,
- quote = "",
- header = input$headers)) # else return file
+
+ if(is.null(inFile))
+ return(NULL) # if no file was uploaded return NULL
+
+ values$data_primary <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
})
# check and read in file (DATA SET 2)
- datGet2<- reactive({
- inFile2<- input$file2
- if(is.null(inFile2)) return(NULL) # if no file was uploaded return NULL
- return(read.table(file = inFile2$datapath, # inFile[1] contains filepath
- sep = input$sep,
- quote = "",
- header = input$headers)) # else return file
+ observeEvent(input$file2, {
+ inFile<- input$file2
+
+ if(is.null(inFile))
+ return(NULL) # if no file was uploaded return NULL
+
+ values$data_secondary <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
})
# dynamically inject sliderInput for x-axis range
output$xlim<- renderUI({
+
data<- Data()
+
if(input$logz == TRUE) {
sd<- unlist(lapply(data, function(x) x[,2]/x[,1]))
} else {
@@ -95,7 +155,9 @@ shinyServer(function(input, output, session) {
# dynamically inject sliderInput for z-axis range
output$zlim<- renderUI({
+
data<- unlist(lapply(Data(), function(x) x[,1]))
+
min<- min(data)
max<- max(data)
sliderInput(inputId = "zlim", sep="",
@@ -153,13 +215,12 @@ shinyServer(function(input, output, session) {
output$centralityNumeric<- renderUI({
- #update_centrality()
- if(!is.null(datGet())){
- data<- datGet()
- }
+
+ data <- Data()
+
numericInput(inputId = "centralityNumeric",
label = "Value",
- value = round(mean(data[,1]), 2),
+ value = round(mean(data[[1]][,1]), 2),
step = 0.01)
})
@@ -202,7 +263,7 @@ shinyServer(function(input, output, session) {
color<- input$color
}
- if(!is.null(datGet2())) {
+ if(!all(is.na(unlist(values$data_secondary)))) {
# if custom datapoint color get RGB code from separate input panel
if(input$color2 == "custom") {
if(input$jscol2 == "") {
@@ -318,7 +379,7 @@ shinyServer(function(input, output, session) {
legend<- c(NA,NA)
legend.pos<- c(-999,-999)
} else {
- if(!is.null(datGet2()))
+ if(!all(is.na(unlist(values$data_secondary))))
{
legend<- c(input$legendname, input$legendname2)
legend.pos<- input$legend.pos
@@ -387,7 +448,7 @@ shinyServer(function(input, output, session) {
grid.col = grid.col,
legend = legend,
legend.pos = legend.pos,
- na.rm = input$naExclude,
+ na.rm = TRUE,
lwd = c(input$lwd, input$lwd2),
xlab = c(input$xlab1, input$xlab2),
ylab = input$ylab,
@@ -406,34 +467,24 @@ shinyServer(function(input, output, session) {
progress$set(value = 5)
progress$set(message = "Calculation in progress",
detail = "Ready to plot")
-
+
# plot Abanico Plot
do.call(what = plot_AbanicoPlot, args = args)
# prepare code as text output
- if (is.null(input$sep))
- updateRadioButtons(session, "fileformat", selected = "\t")
-
- if(input$sep == "\t")
- verb.sep<- "\\t"
- else
- verb.sep<- input$sep
-
- str1 <- paste("data <- read.delim(file, header = ",input$headers, ", sep= '", verb.sep,"')",
- sep = "")
-
- if(!is.null(datGet2())) {
- str2 <- "file2<- file.choose()"
- str3 <- paste("data2 <- read.delim(file2, header = ",input$headers, ", sep= '", verb.sep,"')",
- sep= "")
- str4 <- "data<- list(data, data2)"
+ str1 <- "data <- data.table::fread(file, data.table = FALSE)"
+
+ if(!all(is.na(unlist(values$data_secondary)))) {
+ str2 <- "file2 <- file.choose()"
+ str3 <- "data2 <- data.table::fread(file2, data.table = FALSE)"
+ str4 <- "data <- list(data, data2)"
str1 <- paste(str1, str2, str3, str4, sep = "\n")
}
header <- paste("# To reproduce the plot in your local R environment",
"# copy and run the following code to your R console.",
"library(Luminescence)",
- "file<- file.choose()",
+ "file <- file.choose()",
str1,
"\n",
sep = "\n")
@@ -524,16 +575,10 @@ shinyServer(function(input, output, session) {
});
}",
{
- if(!is.null(datGet())) {
- data<- datGet()
- colnames(data)<- c("De","De error")
- data
-
- } else {
- colnames(data)<- c("De","De error")
- Selected()
- data
- }
+ data <- Data()
+ colnames(data[[1]])<- c("De","De error")
+ data[[1]]
+
})##EndOf::renterTable()
# renderTable() that prints the secondary data to the second tab
@@ -547,12 +592,11 @@ shinyServer(function(input, output, session) {
});
}",
{
- if(!is.null(datGet2())) {
- data<- datGet2()
- colnames(data)<- c("De","De error")
- data
- } else {
- }
+ if(!all(is.na(unlist(values$data_secondary)))) {
+ data <- Data()
+ colnames(data[[2]])<- c("De","De error")
+ data[[2]]
+ }
})##EndOf::renterTable()
# renderTable() to print the results of the
@@ -573,4 +617,4 @@ shinyServer(function(input, output, session) {
t
})##EndOf::renterTable()
-})##EndOf::shinyServer(function(input, output)
\ No newline at end of file
+}##EndOf::shinyServer(function(input, output)
\ No newline at end of file
diff --git a/inst/shiny/abanico/shiny_bookmarks/8027aaa9b994c7bd/input.rds b/inst/shiny/abanico/shiny_bookmarks/8027aaa9b994c7bd/input.rds
new file mode 100644
index 0000000..aaffe82
Binary files /dev/null and b/inst/shiny/abanico/shiny_bookmarks/8027aaa9b994c7bd/input.rds differ
diff --git a/inst/shiny/abanico/ui.R b/inst/shiny/abanico/ui.R
index 5c37ade..005c8ad 100644
--- a/inst/shiny/abanico/ui.R
+++ b/inst/shiny/abanico/ui.R
@@ -1,869 +1,842 @@
## UI.R
-library(RLumShiny)
-
-# load example data
-data(ExampleData.DeValues)
-
-# pageWithSidebar contains three panels:
-# 1 - headerPanel: basically just for a header
-# 2 - sidebarPanel: data input
-# 3 - mainPanel: data output
-
-pageWithSidebar(
- # 1 - title = NULL -> Panel will not be shown
- headerPanel(title = NULL),
-
- # 2- width = 5 -> refers to twitters bootstrap grid system
- # where the the maximum width is 12 that is to be shared between all
- # elements
- sidebarPanel(width = 5,
- # include a tabs in the input panel for easier navigation
- tabsetPanel(id = "tabs", type = "pill", selected = "Data",
- # Tab 1: Data input
- tabPanel("Data",
- # informational text
- div(align = "center", h5("Data upload")),
- # file upload button (data set 1)
- fileInput(inputId = "file1",
- label = strong("Primary data set"),
- accept="text/plain"),
- tooltip(refId = "file1", text = tags$img(src='file_structure.png', width='250px')),
- # file upload button (data set 2)
- fileInput(inputId = "file2",
- label = strong("Secondary data set"),
- accept="text/plain"),
- tooltip(refId = "file2", text = tags$img(src='file_structure.png', width='250px')),
- # informational text
- div(align = "center", h5("Settings")),
- fluidRow(
- column(width = 6,
- # logical: should NA values be excluded?
- checkboxInput(inputId = "naExclude",
- label = "Exclude NA values",
- value = TRUE),
- tooltip(refId = "naExclude", text = "Exclude NA values from the data set prior to any further operations.")
- ),
- column(width = 6,
- # logical: file contains headers?
- checkboxInput(inputId = "headers",
- label = "File contains headers",
- value = FALSE),
- tooltip(refId = "headers", text = tags$img(src='file_containsHeader.png', width='250px'))
- )
- ),
- # char: columns separated by tab, space, comma
- radioButtons("sep", "Separator", selected = "\t", inline = TRUE,
- c("Tab" = "\t",
- "Space" = " ",
- "Comma" = ",",
- "Semicolon" = ";")),
- tooltip(refId = "sep", text = tags$img(src='file_sep.png', width='400px'), placement = "auto left"),
- hr(),
-
- actionButton(inputId = "refresh", label = "Refresh", icon = icon("refresh")),
- tooltip(refId = "refresh", text = "Redraw the plot")
-
-
-
- ),##EndOf::Tab_1
-
-
- # Tab 2: Statistical information
- tabPanel("Statistics",
- div(align = "center", h5("Summary")),
- fluidRow(
- column(width = 6,
- checkboxInput(inputId = "summary",
- label = "Show summary",
- value = TRUE),
- tooltip(refId = "summary", text = "Adds numerical output to the plot")
- ),
- column(width = 6,
- selectInput(inputId = "sumpos",
- label = "Summary position",
- selected = "topleft",
- choices = list("Subtitle" = "sub",
- "Center" = "center",
- Top=c("Top" = "top",
- "Top left" = "topleft",
- "Top right"= "topright"),
- Bottom=c("Bottom" = "bottom",
- "Bottom left" = "bottomleft",
- "Bottom right" = "bottomright"))),
- tooltip(refId = "sumpos", attr = "for", text = "Position of the statistical summary. The keyword \"Subtitle\" will only work if no plot subtitle is used.")
- )
- ),
- selectInput(inputId = "summary.method",
- label = "Summary method",
- selected = "unweighted",
- choices = list("Unweighted" = "unweighted",
- "Weighted" = "weighted",
- "Monte Carlo" = "MCM")),
- tooltip(refId = "summary.method", attr = "for", text = "Keyword indicating the method used to calculate the statistic summary. See calc_Statistics for details."),
-
- checkboxGroupInput(inputId = "stats",
- label = "Parameters",
- selected = c("n","mean"),
- choices = c("n" = "n",
- "Mean" = "mean",
- "Median" = "median",
- "rel. Standard deviation" = "sd.rel",
- "abs. Standard deviation" = "sd.abs",
- "rel. Standard error" = "se.rel",
- "abs. Standard error" = "se.abs",
- "Skewness" = "skewness",
- "Kurtosis" = "kurtosis",
- "% in 2 sigma range" = "in.2s")),
- tooltip(refId = "stats", text = "Statistical parameters to be shown in the summary"),
- br(),
- div(align = "center", h5("Datapoint labels")),
- div(align = "center", checkboxGroupInput(inputId = "statlabels", inline = TRUE,
- label = NULL,
- choices = c("Min" = "min",
- "Max" = "max",
- "Median" = "median"))),
- tooltip(refId = "statlabels", text = "Additional labels of statistically important values in the plot."),
- br(),
- div(align = "center", h5("Error bars")),
- checkboxInput(inputId = "errorbars",
- label = "Show error bars",
- value = FALSE),
- tooltip(refId = "errorbars", text = "Option to show D<sub>e</sub>-errors as error bars on D<sub>e</sub>-points. Useful in combination with hidden y-axis and 2σ bar")
- ),##EndOf::Tab_2
-
- # Tab 3: input that refer to the plot rather than the data
- tabPanel("Plot",
- div(align = "center", h5("Title")),
- fluidRow(
- column(width = 6,
- textInput(inputId = "main",
- label = "Title",
- value = "Abanico Plot")
- ),
- column(width = 6,
- textInput(inputId = "mtext",
- label = "Subtitle",
- value = "")
- )
- ),
- div(align = "center", h5("Scaling")),
- # inject sliderInput from Server.R
- div(id="bwKDE",
- uiOutput(outputId = "bw")
- ),
- tooltip(refId = "bwKDE", text = "Bin width of the kernel density estimate"),
- fluidRow(
- column(width = 6,
- div(id="pratiodiv",
- sliderInput(inputId = "p.ratio",
- label = "Plot ratio",
- min=0.25, max=0.90,
- value=0.75, step=0.01, round= FALSE)
- ),
- tooltip(refId = "pratiodiv", text = "Relative space given to the radial versus the cartesian plot part, default is 0.75.")
- ),
- column(width = 6,
- sliderInput(inputId = "cex",
- label = "Scaling factor",
- min = 0.5, max = 2,
- value = 1.0, step = 0.1)
- )
- ),
- br(),
- div(align = "center", h5("Centrality")),
-
- # centrality can either be a keyword or numerical input
- selectInput(inputId = "centrality",
- label = "Central Value",
- list("Mean" = "mean",
- "Median" = "median",
- "Weighted mean" = "mean.weighted",
- "Custom value" = "custom")),
- tooltip(refId = "centrality", text = "User-defined central value, used for centering of data."),
-
- conditionalPanel(condition = "input.centrality == 'custom'",
- uiOutput("centralityNumeric")),
-
- div(align = "center", h5("Dispersion")),
-
- selectInput(inputId = "dispersion",
- label = "Measure of dispersion",
- list("Quartile range" = "qr",
- "1 sigma" = "sd",
- "2 sigma" = "2sd",
- "Custom percentile range" = "custom")),
- tooltip(refId = "dispersion", text = "Measure of dispersion, used for drawing the polygon that depicts the spread in the dose distribution."),
-
- conditionalPanel(condition = "input.dispersion == 'custom'",
- numericInput(inputId = "cinn",
- label = "x % percentile",
- value = 25,
- min = 0,
- max = 100,
- step = 1)),
-
- div(align = "center", HTML("<h5>2σ bar</h5>")),
-
- fluidRow(
- column(width = 6,
- checkboxInput(inputId = "customSigBar",
- label = HTML("Customise 2σ bar"),
- value = FALSE)
- ),
- column(width = 6,
- checkboxInput(inputId = "addBar",
- label = HTML("Second 2σ bar"),
- value = FALSE)
- )
- ),
-
-
- fluidRow(
- column(width = 6,
- conditionalPanel(condition = "input.customSigBar == true",
- numericInput(inputId = "sigmabar1",
- label = HTML("2σ bar 1"),
- min = 0, max = 100,
- value = 60)
- )
- ),
- column(width = 6,
- conditionalPanel(condition = "input.customSigBar == true",
- numericInput(inputId = "sigmabar2",
- label = HTML("2σ bar 2"),
- min = 0, max = 100,
- value = 100)
- )
- )
- ),
-
- div(align = "center", h5("Central line")),
-
- fluidRow(
- column(width = 6,
- numericInput(inputId = "lwd",
- label = "Line width #1",
- min = 0, max = 5,
- value = 1)
- ),
- column(width = 6,
- numericInput(inputId = "lwd2",
- label = "Line width #2",
- min = 0, max = 5,
- value = 1)
- )
- ),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "lty",
- label = "Line type",
- selected = 2,
- choices = list("Blank" = 0,
- "Solid" = 1,
- "Dashed" = 2,
- "Dotted" = 3,
- "Dot dash" = 4,
- "Long dash" = 5,
- "Two dash" = 6))
- ),
- column(width = 6,
- selectInput(inputId = "lty2",
- label = "Line type",
- selected = 2,
- choices = list("Blank" = 0,
- "Solid" = 1,
- "Dashed" = 2,
- "Dotted" = 3,
- "Dot dash" = 4,
- "Long dash" = 5,
- "Two dash" = 6))
-
- )
- ),
- div(align = "center", h5("Further options")),
- fluidRow(
- column(width = 6,
- checkboxInput(inputId = "rug",
- label = "Add rug",
- value = FALSE),
- tooltip(refId = "rug", text = "Option to add a rug to the KDE part, to indicate the location of individual values")
- ),
- column(width = 6,
- checkboxInput(inputId = "rotate",
- label = "Rotate plot",
- value = FALSE),
- tooltip(refId = "rotate", text = "Option to rotate the plot by 90°.")
- )
- ),
- checkboxInput(inputId = "boxplot", label = "Boxplot", value = FALSE),
- tooltip(refId = "boxplot", text = "Option to add a boxplot to the dispersion part."),
- checkboxInput(inputId = "kde", label = "KDE", value = TRUE),
- tooltip(refId = "kde", text = "Option to add a KDE plot to the dispersion part."),
- checkboxInput(inputId = "histogram", label = "Histogram", value = TRUE),
- tooltip(refId = "histogram", text = "Option to add a histogram to the dispersion part. Only meaningful when not more than one data set is plotted."),
- checkboxInput(inputId = "dots", label = "Dots", value = TRUE),
- tooltip(refId = "dots", text = "Option to add a dot plot to the dispersion part. If number of dots exceeds space in the dispersion part, a square indicates this.")
- ),##EndOf::Tab_3
-
- # Tab 4: modify axis parameters
- tabPanel("Axis",
- div(align = "center", h5("X-axis")),
- fluidRow(
- column(width = 6,
- textInput(inputId = "xlab1",
- label = "Label x-axis (upper)",
- value = "Relative error [%]")
- ),
- column(width = 6,
- textInput(inputId = "xlab2",
- label = "Label x-axis (lower)",
- value = "Precision")
- )
- ),
- # inject sliderInput from Server.R
- uiOutput(outputId = "xlim"),
- br(),
- div(align = "center", h5("Y-axis")),
- checkboxInput(inputId = "yaxis",
- label = "Show y-axis",
- value = TRUE),
- tooltip(refId = "yaxis", text = "Option to hide y-axis labels. Useful for data with small scatter."),
- textInput(inputId = "ylab",
- label = "Label y-axis",
- value = "Standardised estimate"),
- uiOutput("ylim"),
- br(),
- div(align = "center", h5("Z-axis")),
- checkboxInput(inputId = "logz",
- label = "Logarithmic z-axis",
- value = TRUE),
- tooltip(refId = "logz", text = "Option to display the z-axis in logarithmic scale."),
- textInput(inputId = "zlab",
- label = "Label z-axis",
- value = "Equivalent dose [Gy]"),
- # inject sliderInput from Server.R
- uiOutput(outputId = "zlim")
- ),##EndOf::Tab_4
-
- # Tab 5: modify data point representation
- tabPanel("Datapoints",
- div(align = "center", h5("Primary data set")),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "pch",
- label = "Style",
- selected = "17",
- choices = c("Square"= "1",
- "Circle"="2",
- "Triangle point up"="3",
- "Plus"="4",
- "Cross"="5",
- "Diamond"="6",
- "Triangle point down"="7",
- "Square cross"="8",
- "Star"="9",
- "Diamond plus"="10",
- "Circle plus"="11",
- "Triangles up and down"="12",
- "Square plus"="13",
- "Circle cross"="14",
- "Square and Triangle down"="15",
- "filled Square"="16",
- "filled Circle"="17",
- "filled Triangle point up"="18",
- "filled Diamond"="19",
- "solid Circle"="20",
- "Bullet (smaller Circle)"="21",
- "Custom"="custom"))
- ),
- column(width = 6,
- # show only if custom symbol is desired
- conditionalPanel(condition = "input.pch == 'custom'",
- textInput(inputId = "custompch",
- label = "Insert character",
- value = "?"))
- )
- ),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "color", label = "Datapoint color",
- choices = list("Black" = "black",
- "Grey" = "grey50",
- "Red" = "#b22222",
- "Green" = "#6E8B3D",
- "Blue" = "#428bca",
- "Custom" = "custom"))
- ),
- column(width = 6,
- # show only if custom color is desired
- conditionalPanel(condition = "input.color == 'custom'",
- HTML("Choose a color<br>"),
- jscolorInput(inputId = "jscol1"))
- )
- ),
- br(),
- div(align = "center", h5("Secondary data set")),
- fluidRow(
- column(width = 6,
- ## DATA SET 2
- selectInput(inputId = "pch2",
- label = "Style",
- selected = "17",
- choices = c("Square"= "1",
- "Circle"="2",
- "Triangle point up"="3",
- "Plus"="4",
- "Cross"="5",
- "Diamond"="6",
- "Triangle point down"="7",
- "Square cross"="8",
- "Star"="9",
- "Diamond plus"="10",
- "Circle plus"="11",
- "Triangles up and down"="12",
- "Square plus"="13",
- "Circle cross"="14",
- "Square and Triangle down"="15",
- "filled Square"="16",
- "filled Circle"="17",
- "filled Triangle point up"="18",
- "filled Diamond"="19",
- "solid Circle"="20",
- "Bullet (smaller Circle)"="21",
- "Custom"="custom"))
- ),
- column(width = 6,
- # show only if custom symbol is desired
- conditionalPanel(condition = "input.pch2 == 'custom'",
- textInput(inputId = "custompch2",
- label = "Insert character",
- value = "?"))
- )
- ),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "color2", label = "Datapoint color",
- selected = "#b22222",
- choices = list("Black" = "black",
- "Grey" = "grey50",
- "Red" = "#b22222",
- "Green" = "#6E8B3D",
- "Blue" = "#428bca",
- "Custom" = "custom"))
- ),
- column(width = 6,
- # show only if custom color is desired
- conditionalPanel(condition = "input.color2 == 'custom'",
- HTML("Choose a color<br>"),
- jscolorInput(inputId = "jscol2"))
- )
- )
- ),##EndOf::Tab_5
-
- # Tab 6: add additional lines to the plot
- tabPanel("Lines",
- helpText("Here you can add additional lines."),
- # options for custom lines:
- # 1 - z-value, 2 - color, 3 - label, 4 - line type
- # only the options for the first line are shown
- fluidRow(
- column(width = 6,
- numericInput(inputId = "line1",
- label = strong("Line #1"),
- value = NA, min = 0)
- ),
- tooltip(refId = "line1", text = "Numeric values of the additional lines to be added."),
- column(width = 6,
- selectInput(inputId = "linelty1",
- label = "Line type",
- selected = 1,
- choices = list("Blank" = 0,
- "Solid" = 1,
- "Dashed" = 2,
- "Dotted" = 3,
- "Dot dash" = 4,
- "Long dash" = 5,
- "Two dash" = 6))
- )
- ),
- fluidRow(
- column(width = 6,
- HTML("Choose a color<br>"),
- jscolorInput(inputId = "colline1")
- ),
- column(width = 6,
- textInput(inputId = "labline1",
- label = "Label",
- value = "")
- )
- ),
- # conditional chain: if valid input (i.e. the z-value is > 0) is provided
- # for the previous line, show options for a new line (currently up to eight)
- conditionalPanel(condition = "input.line1 > 0",
- fluidRow(
- column(width = 6, numericInput(inputId = "line2", strong("Line #2"), NA, min = 0)),
- column(width = 6, selectInput(inputId = "linelty2", label = "Line type",selected = 1,
- choices = list("Blank" = 0,
- "Solid" = 1,
- "Dashed" = 2,
- "Dotted" = 3,
- "Dot dash" = 4,
- "Long dash" = 5,
- "Two dash" = 6)))
- ),
- fluidRow(
- column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline2")),
- column(width = 6, textInput("labline2","Label",value = ""))
- )
- ),
- conditionalPanel(condition = "input.line2 > 0",
- fluidRow(
- column(width = 6, numericInput(inputId = "line3", strong("Line #3"), NA, min = 0)),
- column(width = 6, selectInput(inputId = "linelty3", label = "Line type",selected = 1,
- choices = list("Blank" = 0,
- "Solid" = 1,
- "Dashed" = 2,
- "Dotted" = 3,
- "Dot dash" = 4,
- "Long dash" = 5,
- "Two dash" = 6)))
- ),
- fluidRow(
- column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline3")),
- column(width = 6, textInput("labline3","Label",value = ""))
- )
- ),
- conditionalPanel(condition = "input.line3 > 0",
- fluidRow(
- column(width = 6, numericInput(inputId = "line4", strong("Line #4"), NA, min = 0)),
- column(width = 6, selectInput(inputId = "linelty4", label = "Line type",selected = 1,
- choices = list("Blank" = 0,
- "Solid" = 1,
- "Dashed" = 2,
- "Dotted" = 3,
- "Dot dash" = 4,
- "Long dash" = 5,
- "Two dash" = 6)))
- ),
- fluidRow(
- column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline4")),
- column(width = 6, textInput("labline4","Label",value = ""))
- )
- ),
- conditionalPanel(condition = "input.line4 > 0",
- fluidRow(
- column(width = 6, numericInput(inputId = "line5", strong("Line #5"), NA, min = 0)),
- column(width = 6, selectInput(inputId = "linelty5", label = "Line type",selected = 1,
- choices = list("Blank" = 0,
- "Solid" = 1,
- "Dashed" = 2,
- "Dotted" = 3,
- "Dot dash" = 4,
- "Long dash" = 5,
- "Two dash" = 6)))
- ),
- fluidRow(
- column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline5")),
- column(width = 6, textInput("labline5","Label",value = ""))
- )
- ),
- conditionalPanel(condition = "input.line5 > 0",
- fluidRow(
- column(width = 6, numericInput(inputId = "line6", strong("Line #6"), NA, min = 0)),
- column(width = 6, selectInput(inputId = "linelty6", label = "Line type",selected = 1,
- choices = list("Blank" = 0,
- "Solid" = 1,
- "Dashed" = 2,
- "Dotted" = 3,
- "Dot dash" = 4,
- "Long dash" = 5,
- "Two dash" = 6)))
- ),
- fluidRow(
- column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline6")),
- column(width = 6, textInput("labline6","Label",value = ""))
- )
- ),
- conditionalPanel(condition = "input.line6 > 0",
- fluidRow(
- column(width = 6, numericInput(inputId = "line7", strong("Line #7"), NA, min = 0)),
- column(width = 6, selectInput(inputId = "linelty7", label = "Line type",selected = 1,
- choices = list("Blank" = 0,
- "Solid" = 1,
- "Dashed" = 2,
- "Dotted" = 3,
- "Dot dash" = 4,
- "Long dash" = 5,
- "Two dash" = 6)))
- ),
- fluidRow(
- column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline7")),
- column(width = 6, textInput("labline7","Label",value = ""))
- )
- ),
- conditionalPanel(condition = "input.line7 > 0",
- fluidRow(
- column(width = 6, numericInput(inputId = "line8", strong("Line #8"), NA, min = 0)),
- column(width = 6, selectInput(inputId = "linelty8", label = "Line type",selected = 1,
- choices = list("Blank" = 0,
- "Solid" = 1,
- "Dashed" = 2,
- "Dotted" = 3,
- "Dot dash" = 4,
- "Long dash" = 5,
- "Two dash" = 6)))
- ),
- fluidRow(
- column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline8")),
- column(width = 6, textInput("labline8","Label",value = ""))
- )
- )
- ),##EndOf::Tab_6
-
- # Tab 7: modify the 2-sigma bar (radial plot), grid (both) and polygon (KDE)
- tabPanel("Bars & Grid",
- div(align = "center", h5("Dispersion bar")),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "polygon",
- label = "Dispersion bar color #1",
- choices = list("Grey" = "grey80",
- "Custom" = "custom",
- "None" = "none")),
- tooltip(refId = "polygon", attr = "for", text = "Colour of the polygon showing the dose dispersion around the central value.")
- ),
- column(width = 6,
- selectInput(inputId = "polygon2",
- label = "Dispersion bar color #2",
- choices = list("Grey" = "grey80",
- "Custom" = "custom",
- "None" = "none"))
- )
- ),
- fluidRow(
- column(width = 6,
- # show only if custom color is desired
- conditionalPanel(condition = "input.polygon == 'custom'",
- jscolorInput(inputId = "rgbPolygon",
- label = "Choose a color"))
- ),
- column(width = 6,
- # show only if custom color is desired
- conditionalPanel(condition = "input.polygon2 == 'custom'",
- jscolorInput(inputId = "rgbPolygon2",
- label = "Choose a color"))
- )
- ),
- sliderInput(inputId = "alpha.polygon",
- label = "Transparency",
- min = 0, max = 100,
- step = 1, value = 66),
- br(),
- div(align = "center", HTML("<h5>2σ bar</h5>")),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "bar", label = HTML("2σ bar color"),
- choices = list("Grey" = "grey50",
- "Custom" = "custom",
- "None" = "none")),
- tooltip(refId = "bar", attr = "for", text = "Colour of the bar showing the 2-sigma range of the dose error around the central value.")
- ),
- column(width = 6,
- selectInput(inputId = "bar2", label = HTML("2σ bar color #2"),
- choices = list("Grey" = "grey50",
- "Custom" = "custom",
- "None" = "none"))
- )
- ),
- fluidRow(
- column(width = 6,
- # show only if custom color is desired
- conditionalPanel(condition = "input.bar == 'custom'",
- jscolorInput(inputId = "rgbBar",
- label = "Choose a color"))
- ),
- column(width = 6,
- # show only if custom color is desired
- conditionalPanel(condition = "input.bar2 == 'custom'",
- jscolorInput(inputId = "rgbBar2",
- label = "Choose a color"))
- )
- ),
- sliderInput(inputId = "alpha.bar",
- label = "Transparency",
- min = 0, max = 100,
- step = 1, value = 66),
- br(),
- div(align = "center", h5("Grid")),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "grid", label = "Grid color",
- selected = "none",
- list("Grey" = "grey90",
- "Custom" = "custom",
- "None" = "none"))
- ),
- column(width = 6,
- # show only if custom color is desired
- conditionalPanel(condition = "input.grid == 'custom'",
- jscolorInput(inputId = "rgbGrid",
- label = "Choose a color"))
- )
- ),
- sliderInput(inputId = "alpha.grid",
- label = "Transparency",
- min = 0, max = 100,
- step = 1, value = 50),
-
- br(),
- div(align = "center", h5("Frame")),
- selectInput(inputId = "frame", label = "Frame", selected = 1,
- choices = list("No frame" = 0,
- "Origin at {0,0}" = 1,
- "Anchors at {0,-2}, {0,2}" = 2,
- "Rectangle" = 3))
- ),##EndOf::Tab_7
-
- # Tab 8: add and customize legend
- tabPanel("Legend",
- div(align = "center", h5("Legend")),
- fluidRow(
- column(width = 6,
- checkboxInput(inputId = "showlegend",
- label = "Show legend",
- value = FALSE),
- tooltip(refId = "showlegend", text = "Legend content to be added to the plot.")
- ),
- column(width = 6,
- selectInput(inputId = "legend.pos",
- label = "Legend position",
- selected = "bottomleft",
- choices = c("Top" = "top",
- "Top left" = "topleft",
- "Top right"= "topright",
- "Center" = "center",
- "Bottom" = "bottom",
- "Bottom left" = "bottomleft",
- "Bottom right" = "bottomright"))
- )
- ),
- fluidRow(
- column(width = 6,
- textInput(inputId = "legendname",
- label = "Primary data label",
- value = "primary data")
- ),
- column(width = 6,
- textInput(inputId = "legendname2",
- label = "Secondary data label",
- value = "secondary data")
- )
- )
- ),##EndOf::Tab_8
-
- # Tab 9: Filter data
- tabPanel("Filter",
- div(align = "center", h5("Primary data set")),
- selectInput(inputId = "filter.prim", label = "Choose values to exclude",
- choices = "", multiple = TRUE, selected = ""),
- div(align = "center", h5("Secondary data set")),
- selectInput(inputId = "filter.sec", label = "Choose values to exclude",
- choices = "", multiple = TRUE, selected = ""),
- actionButton(inputId = "exclude", label = "Exclude")
- ),##EndOf::Tab_9
-
- # Tab 10: Layout
- tabPanel("Layout",
- div(align = "center", h5("Layout")),
- div(id = "layout",
- selectInput(inputId = "layout",
- label = "Choose layout",
- selected = "default",
- choices = c("Default"="default",
- "Journal"="journal"))
- ),
- tooltip(refId = "layout", placement = "top",
- text = "The optional parameter layout allows to modify the entire plot more sophisticated. Each element of the plot can be addressed and its properties can be defined. This includes font type, size and decoration, colours and sizes of all plot items. To infer the definition of a specific layout style cf. get_Layout() or type eg. for the layout type \"journal\" get_Layout(\"journal\"). A layout type can be modified by the user by assigning new v [...]
- ),
-
- # Tab 10: save plot as pdf, wmf or eps
- tabPanel("Export",
- radioButtons(inputId = "fileformat",
- label = "Fileformat",
- selected = "pdf",
- choices = c("PDF (Portable Document Format)" = "pdf",
- "SVG (Scalable Vector Graphics)" = "svg",
- "EPS (Encapsulated Postscript)" = "eps")),
- textInput(inputId = "filename",
- label = "Filename",
- value = "Abanico Plot"),
- fluidRow(
- column(width = 6,
- numericInput(inputId = "imgheight",
- label = "Image height",
- value = 7)
- ),
- column(width = 6,
- numericInput(inputId = "imgwidth",
- label = "Image width",
- value = 7)
- )
- ),
- selectInput(inputId = "fontfamily",
- label = "Font",
- selected = "Helvetica",
- choices = c("Helvetica" = "Helvetica",
- "Helvetica Narrow" = "Helvetica Narrow",
- "Times" = "Times",
- "Courier" = "Courier",
- "Bookman" = "Bookman",
- "Palatino" = "Palatino")),
- tags$hr(),
- downloadButton(outputId = "exportFile",
- label = "Download plot"),
- tags$hr(),
- helpText("Additionally, you can download a corresponding .R file that contains",
- "a fully functional script to reproduce the plot in your R environment!"),
-
- downloadButton(outputId = "exportScript",
- label = "Download R script")
- ),##EndOf::Tab_8
-
- # Tab 10: further information
- tabPanel("About",
- hr(),
- div(align = "center",
- # HTML code to include a .png file in the tab; the image file must be in
- # a subfolder called "wwww"
- img(src="RL_Logo.png", height = 100, width = 100, alt = "R.Lum"),
- p("Links:"),
- a(href = "http://www.r-luminescence.de", "R.Luminescence project page", target="_blank"),
+function(request) {
+ fluidPage(
+ titlePanel(NULL, windowTitle = "RLumShiny - AbanicoPlot"),
+ sidebarLayout(
+ # 2- width = 5 -> refers to twitters bootstrap grid system
+ # where the the maximum width is 12 that is to be shared between all
+ # elements
+ sidebarPanel(width = 5,
+ # include a tabs in the input panel for easier navigation
+ tabsetPanel(id = "tabs", type = "pill", selected = "Data",
+ # Tab 1: Data input
+ tabPanel("Data",
+ # informational text
+ div(align = "center", h5("Data upload")),
+ # file upload button (data set 1)
+ fileInput(inputId = "file1",
+ label = strong("Primary data set"),
+ accept="text/plain, .csv, text/csv"),
+ # file upload button (data set 2)
+ fileInput(inputId = "file2",
+ label = strong("Secondary data set"),
+ accept="text/plain, .csv, text/csv"),
+ # rhandsontable input/output
+ fluidRow(
+ column(width = 6,
+ rHandsontableOutput(outputId = "table_in_primary")
+ ),
+ column(width = 6,
+ rHandsontableOutput(outputId = "table_in_secondary"))
+ ),
+ hr(),
+ actionButton(inputId = "refresh", label = "Refresh", icon = icon("refresh")),
+ tooltip(refId = "refresh", text = "Redraw the plot")
+
+
+
+ ),##EndOf::Tab_1
+
+
+ # Tab 2: Statistical information
+ tabPanel("Statistics",
+ div(align = "center", h5("Summary")),
+ fluidRow(
+ column(width = 6,
+ checkboxInput(inputId = "summary",
+ label = "Show summary",
+ value = TRUE),
+ tooltip(refId = "summary", text = "Adds numerical output to the plot")
+ ),
+ column(width = 6,
+ selectInput(inputId = "sumpos",
+ label = "Summary position",
+ selected = "topleft",
+ choices = list("Subtitle" = "sub",
+ "Center" = "center",
+ Top=c("Top" = "top",
+ "Top left" = "topleft",
+ "Top right"= "topright"),
+ Bottom=c("Bottom" = "bottom",
+ "Bottom left" = "bottomleft",
+ "Bottom right" = "bottomright"))),
+ tooltip(refId = "sumpos", attr = "for", text = "Position of the statistical summary. The keyword \"Subtitle\" will only work if no plot subtitle is used.")
+ )
+ ),
+ selectInput(inputId = "summary.method",
+ label = "Summary method",
+ selected = "unweighted",
+ choices = list("Unweighted" = "unweighted",
+ "Weighted" = "weighted",
+ "Monte Carlo" = "MCM")),
+ tooltip(refId = "summary.method", attr = "for", text = "Keyword indicating the method used to calculate the statistic summary. See calc_Statistics for details."),
+
+ checkboxGroupInput(inputId = "stats",
+ label = "Parameters",
+ selected = c("n","mean"),
+ choices = c("n" = "n",
+ "Mean" = "mean",
+ "Median" = "median",
+ "rel. Standard deviation" = "sd.rel",
+ "abs. Standard deviation" = "sd.abs",
+ "rel. Standard error" = "se.rel",
+ "abs. Standard error" = "se.abs",
+ "Skewness" = "skewness",
+ "Kurtosis" = "kurtosis",
+ "% in 2 sigma range" = "in.2s")),
+ tooltip(refId = "stats", text = "Statistical parameters to be shown in the summary"),
br(),
- a(href = "https://forum.r-luminescence.de", "Message board", target="_blank"),
+ div(align = "center", h5("Datapoint labels")),
+ div(align = "center", checkboxGroupInput(inputId = "statlabels", inline = TRUE,
+ label = NULL,
+ choices = c("Min" = "min",
+ "Max" = "max",
+ "Median" = "median"))),
+ tooltip(refId = "statlabels", text = "Additional labels of statistically important values in the plot."),
br(),
- a(href = "http://zerk.canopus.uberspace.de/R.Lum", "Online application", target="_blank"),
- br(),hr(),
- img(src='GitHub-Mark-32px.png', width='32px', height='32px'),
+ div(align = "center", h5("Error bars")),
+ checkboxInput(inputId = "errorbars",
+ label = "Show error bars",
+ value = FALSE),
+ tooltip(refId = "errorbars", text = "Option to show D<sub>e</sub>-errors as error bars on D<sub>e</sub>-points. Useful in combination with hidden y-axis and 2σ bar")
+ ),##EndOf::Tab_2
+
+ # Tab 3: input that refer to the plot rather than the data
+ tabPanel("Plot",
+ div(align = "center", h5("Title")),
+ fluidRow(
+ column(width = 6,
+ textInput(inputId = "main",
+ label = "Title",
+ value = "Abanico Plot")
+ ),
+ column(width = 6,
+ textInput(inputId = "mtext",
+ label = "Subtitle",
+ value = "")
+ )
+ ),
+ div(align = "center", h5("Scaling")),
+ # inject sliderInput from Server.R
+ div(id="bwKDE",
+ uiOutput(outputId = "bw")
+ ),
+ tooltip(refId = "bwKDE", text = "Bin width of the kernel density estimate"),
+ fluidRow(
+ column(width = 6,
+ div(id="pratiodiv",
+ sliderInput(inputId = "p.ratio",
+ label = "Plot ratio",
+ min=0.25, max=0.90,
+ value=0.75, step=0.01, round= FALSE)
+ ),
+ tooltip(refId = "pratiodiv", text = "Relative space given to the radial versus the cartesian plot part, default is 0.75.")
+ ),
+ column(width = 6,
+ sliderInput(inputId = "cex",
+ label = "Scaling factor",
+ min = 0.5, max = 2,
+ value = 1.0, step = 0.1)
+ )
+ ),
br(),
- a(href = "https://github.com/tzerk/RLumShiny/tree/master/inst/shiny/abanico", "See the code at GitHub!", target="_blank")
- )#/div
- )##EndOf::Tab_9
- )##EndOf::tabsetPanel
- ),##EndOf::sidebarPanel
-
- # 3 - output panel
- mainPanel(width = 7,
- # insert css code inside <head></head> of the generated HTML file:
- # allow open dropdown menus to reach over the container
- tags$head(tags$style(type="text/css",".tab-content {overflow: visible;}")),
- tags$head(includeCSS("www/style.css")),
- # divide output in separate tabs via tabsetPanel
- tabsetPanel(
- tabPanel("Plot", plotOutput(outputId = "main_plot", height = "500px")),
- tabPanel("Primary data set", fluidRow(column(width = 12, dataTableOutput("dataset")))),
- tabPanel("Secondary data set", dataTableOutput("dataset2")),
- tabPanel("Central Age Model", dataTableOutput("CAM")),
- tabPanel("R plot code", verbatimTextOutput("plotCode"))
- )###EndOf::tabsetPanel
- )##EndOf::mainPanel
-)##EndOf::shinyUI(pageWithSidebar)
\ No newline at end of file
+ div(align = "center", h5("Centrality")),
+
+ # centrality can either be a keyword or numerical input
+ selectInput(inputId = "centrality",
+ label = "Central Value",
+ list("Mean" = "mean",
+ "Median" = "median",
+ "Weighted mean" = "mean.weighted",
+ "Custom value" = "custom")),
+ tooltip(refId = "centrality", text = "User-defined central value, used for centering of data."),
+
+ conditionalPanel(condition = "input.centrality == 'custom'",
+ uiOutput("centralityNumeric")),
+
+ div(align = "center", h5("Dispersion")),
+
+ selectInput(inputId = "dispersion",
+ label = "Measure of dispersion",
+ list("Quartile range" = "qr",
+ "1 sigma" = "sd",
+ "2 sigma" = "2sd",
+ "Custom percentile range" = "custom")),
+ tooltip(refId = "dispersion", text = "Measure of dispersion, used for drawing the polygon that depicts the spread in the dose distribution."),
+
+ conditionalPanel(condition = "input.dispersion == 'custom'",
+ numericInput(inputId = "cinn",
+ label = "x % percentile",
+ value = 25,
+ min = 0,
+ max = 100,
+ step = 1)),
+
+ div(align = "center", HTML("<h5>2σ bar</h5>")),
+
+ fluidRow(
+ column(width = 6,
+ checkboxInput(inputId = "customSigBar",
+ label = HTML("Customise 2σ bar"),
+ value = FALSE)
+ ),
+ column(width = 6,
+ checkboxInput(inputId = "addBar",
+ label = HTML("Second 2σ bar"),
+ value = FALSE)
+ )
+ ),
+
+
+ fluidRow(
+ column(width = 6,
+ conditionalPanel(condition = "input.customSigBar == true",
+ numericInput(inputId = "sigmabar1",
+ label = HTML("2σ bar 1"),
+ min = 0, max = 100,
+ value = 60)
+ )
+ ),
+ column(width = 6,
+ conditionalPanel(condition = "input.customSigBar == true",
+ numericInput(inputId = "sigmabar2",
+ label = HTML("2σ bar 2"),
+ min = 0, max = 100,
+ value = 100)
+ )
+ )
+ ),
+
+ div(align = "center", h5("Central line")),
+
+ fluidRow(
+ column(width = 6,
+ numericInput(inputId = "lwd",
+ label = "Line width #1",
+ min = 0, max = 5,
+ value = 1)
+ ),
+ column(width = 6,
+ numericInput(inputId = "lwd2",
+ label = "Line width #2",
+ min = 0, max = 5,
+ value = 1)
+ )
+ ),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "lty",
+ label = "Line type",
+ selected = 2,
+ choices = list("Blank" = 0,
+ "Solid" = 1,
+ "Dashed" = 2,
+ "Dotted" = 3,
+ "Dot dash" = 4,
+ "Long dash" = 5,
+ "Two dash" = 6))
+ ),
+ column(width = 6,
+ selectInput(inputId = "lty2",
+ label = "Line type",
+ selected = 2,
+ choices = list("Blank" = 0,
+ "Solid" = 1,
+ "Dashed" = 2,
+ "Dotted" = 3,
+ "Dot dash" = 4,
+ "Long dash" = 5,
+ "Two dash" = 6))
+
+ )
+ ),
+ div(align = "center", h5("Further options")),
+ fluidRow(
+ column(width = 6,
+ checkboxInput(inputId = "rug",
+ label = "Add rug",
+ value = FALSE),
+ tooltip(refId = "rug", text = "Option to add a rug to the KDE part, to indicate the location of individual values")
+ ),
+ column(width = 6,
+ checkboxInput(inputId = "rotate",
+ label = "Rotate plot",
+ value = FALSE),
+ tooltip(refId = "rotate", text = "Option to rotate the plot by 90°.")
+ )
+ ),
+ checkboxInput(inputId = "boxplot", label = "Boxplot", value = FALSE),
+ tooltip(refId = "boxplot", text = "Option to add a boxplot to the dispersion part."),
+ checkboxInput(inputId = "kde", label = "KDE", value = TRUE),
+ tooltip(refId = "kde", text = "Option to add a KDE plot to the dispersion part."),
+ checkboxInput(inputId = "histogram", label = "Histogram", value = TRUE),
+ tooltip(refId = "histogram", text = "Option to add a histogram to the dispersion part. Only meaningful when not more than one data set is plotted."),
+ checkboxInput(inputId = "dots", label = "Dots", value = TRUE),
+ tooltip(refId = "dots", text = "Option to add a dot plot to the dispersion part. If number of dots exceeds space in the dispersion part, a square indicates this.")
+ ),##EndOf::Tab_3
+
+ # Tab 4: modify axis parameters
+ tabPanel("Axis",
+ div(align = "center", h5("X-axis")),
+ fluidRow(
+ column(width = 6,
+ textInput(inputId = "xlab1",
+ label = "Label x-axis (upper)",
+ value = "Relative error [%]")
+ ),
+ column(width = 6,
+ textInput(inputId = "xlab2",
+ label = "Label x-axis (lower)",
+ value = "Precision")
+ )
+ ),
+ # inject sliderInput from Server.R
+ uiOutput(outputId = "xlim"),
+ br(),
+ div(align = "center", h5("Y-axis")),
+ checkboxInput(inputId = "yaxis",
+ label = "Show y-axis",
+ value = TRUE),
+ tooltip(refId = "yaxis", text = "Option to hide y-axis labels. Useful for data with small scatter."),
+ textInput(inputId = "ylab",
+ label = "Label y-axis",
+ value = "Standardised estimate"),
+ uiOutput("ylim"),
+ br(),
+ div(align = "center", h5("Z-axis")),
+ checkboxInput(inputId = "logz",
+ label = "Logarithmic z-axis",
+ value = TRUE),
+ tooltip(refId = "logz", text = "Option to display the z-axis in logarithmic scale."),
+ textInput(inputId = "zlab",
+ label = "Label z-axis",
+ value = "Equivalent dose [Gy]"),
+ # inject sliderInput from Server.R
+ uiOutput(outputId = "zlim")
+ ),##EndOf::Tab_4
+
+ # Tab 5: modify data point representation
+ tabPanel("Datapoints",
+ div(align = "center", h5("Primary data set")),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "pch",
+ label = "Style",
+ selected = "17",
+ choices = c("Square"= "1",
+ "Circle"="2",
+ "Triangle point up"="3",
+ "Plus"="4",
+ "Cross"="5",
+ "Diamond"="6",
+ "Triangle point down"="7",
+ "Square cross"="8",
+ "Star"="9",
+ "Diamond plus"="10",
+ "Circle plus"="11",
+ "Triangles up and down"="12",
+ "Square plus"="13",
+ "Circle cross"="14",
+ "Square and Triangle down"="15",
+ "filled Square"="16",
+ "filled Circle"="17",
+ "filled Triangle point up"="18",
+ "filled Diamond"="19",
+ "solid Circle"="20",
+ "Bullet (smaller Circle)"="21",
+ "Custom"="custom"))
+ ),
+ column(width = 6,
+ # show only if custom symbol is desired
+ conditionalPanel(condition = "input.pch == 'custom'",
+ textInput(inputId = "custompch",
+ label = "Insert character",
+ value = "?"))
+ )
+ ),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "color", label = "Datapoint color",
+ choices = list("Black" = "black",
+ "Grey" = "grey50",
+ "Red" = "#b22222",
+ "Green" = "#6E8B3D",
+ "Blue" = "#428bca",
+ "Custom" = "custom"))
+ ),
+ column(width = 6,
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.color == 'custom'",
+ HTML("Choose a color<br>"),
+ jscolorInput(inputId = "jscol1"))
+ )
+ ),
+ br(),
+ div(align = "center", h5("Secondary data set")),
+ fluidRow(
+ column(width = 6,
+ ## DATA SET 2
+ selectInput(inputId = "pch2",
+ label = "Style",
+ selected = "17",
+ choices = c("Square"= "1",
+ "Circle"="2",
+ "Triangle point up"="3",
+ "Plus"="4",
+ "Cross"="5",
+ "Diamond"="6",
+ "Triangle point down"="7",
+ "Square cross"="8",
+ "Star"="9",
+ "Diamond plus"="10",
+ "Circle plus"="11",
+ "Triangles up and down"="12",
+ "Square plus"="13",
+ "Circle cross"="14",
+ "Square and Triangle down"="15",
+ "filled Square"="16",
+ "filled Circle"="17",
+ "filled Triangle point up"="18",
+ "filled Diamond"="19",
+ "solid Circle"="20",
+ "Bullet (smaller Circle)"="21",
+ "Custom"="custom"))
+ ),
+ column(width = 6,
+ # show only if custom symbol is desired
+ conditionalPanel(condition = "input.pch2 == 'custom'",
+ textInput(inputId = "custompch2",
+ label = "Insert character",
+ value = "?"))
+ )
+ ),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "color2", label = "Datapoint color",
+ selected = "#b22222",
+ choices = list("Black" = "black",
+ "Grey" = "grey50",
+ "Red" = "#b22222",
+ "Green" = "#6E8B3D",
+ "Blue" = "#428bca",
+ "Custom" = "custom"))
+ ),
+ column(width = 6,
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.color2 == 'custom'",
+ HTML("Choose a color<br>"),
+ jscolorInput(inputId = "jscol2"))
+ )
+ )
+ ),##EndOf::Tab_5
+
+ # Tab 6: add additional lines to the plot
+ tabPanel("Lines",
+ helpText("Here you can add additional lines."),
+ # options for custom lines:
+ # 1 - z-value, 2 - color, 3 - label, 4 - line type
+ # only the options for the first line are shown
+ fluidRow(
+ column(width = 6,
+ numericInput(inputId = "line1",
+ label = strong("Line #1"),
+ value = NA, min = 0)
+ ),
+ tooltip(refId = "line1", text = "Numeric values of the additional lines to be added."),
+ column(width = 6,
+ selectInput(inputId = "linelty1",
+ label = "Line type",
+ selected = 1,
+ choices = list("Blank" = 0,
+ "Solid" = 1,
+ "Dashed" = 2,
+ "Dotted" = 3,
+ "Dot dash" = 4,
+ "Long dash" = 5,
+ "Two dash" = 6))
+ )
+ ),
+ fluidRow(
+ column(width = 6,
+ HTML("Choose a color<br>"),
+ jscolorInput(inputId = "colline1")
+ ),
+ column(width = 6,
+ textInput(inputId = "labline1",
+ label = "Label",
+ value = "")
+ )
+ ),
+ # conditional chain: if valid input (i.e. the z-value is > 0) is provided
+ # for the previous line, show options for a new line (currently up to eight)
+ conditionalPanel(condition = "input.line1 > 0",
+ fluidRow(
+ column(width = 6, numericInput(inputId = "line2", strong("Line #2"), NA, min = 0)),
+ column(width = 6, selectInput(inputId = "linelty2", label = "Line type",selected = 1,
+ choices = list("Blank" = 0,
+ "Solid" = 1,
+ "Dashed" = 2,
+ "Dotted" = 3,
+ "Dot dash" = 4,
+ "Long dash" = 5,
+ "Two dash" = 6)))
+ ),
+ fluidRow(
+ column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline2")),
+ column(width = 6, textInput("labline2","Label",value = ""))
+ )
+ ),
+ conditionalPanel(condition = "input.line2 > 0",
+ fluidRow(
+ column(width = 6, numericInput(inputId = "line3", strong("Line #3"), NA, min = 0)),
+ column(width = 6, selectInput(inputId = "linelty3", label = "Line type",selected = 1,
+ choices = list("Blank" = 0,
+ "Solid" = 1,
+ "Dashed" = 2,
+ "Dotted" = 3,
+ "Dot dash" = 4,
+ "Long dash" = 5,
+ "Two dash" = 6)))
+ ),
+ fluidRow(
+ column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline3")),
+ column(width = 6, textInput("labline3","Label",value = ""))
+ )
+ ),
+ conditionalPanel(condition = "input.line3 > 0",
+ fluidRow(
+ column(width = 6, numericInput(inputId = "line4", strong("Line #4"), NA, min = 0)),
+ column(width = 6, selectInput(inputId = "linelty4", label = "Line type",selected = 1,
+ choices = list("Blank" = 0,
+ "Solid" = 1,
+ "Dashed" = 2,
+ "Dotted" = 3,
+ "Dot dash" = 4,
+ "Long dash" = 5,
+ "Two dash" = 6)))
+ ),
+ fluidRow(
+ column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline4")),
+ column(width = 6, textInput("labline4","Label",value = ""))
+ )
+ ),
+ conditionalPanel(condition = "input.line4 > 0",
+ fluidRow(
+ column(width = 6, numericInput(inputId = "line5", strong("Line #5"), NA, min = 0)),
+ column(width = 6, selectInput(inputId = "linelty5", label = "Line type",selected = 1,
+ choices = list("Blank" = 0,
+ "Solid" = 1,
+ "Dashed" = 2,
+ "Dotted" = 3,
+ "Dot dash" = 4,
+ "Long dash" = 5,
+ "Two dash" = 6)))
+ ),
+ fluidRow(
+ column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline5")),
+ column(width = 6, textInput("labline5","Label",value = ""))
+ )
+ ),
+ conditionalPanel(condition = "input.line5 > 0",
+ fluidRow(
+ column(width = 6, numericInput(inputId = "line6", strong("Line #6"), NA, min = 0)),
+ column(width = 6, selectInput(inputId = "linelty6", label = "Line type",selected = 1,
+ choices = list("Blank" = 0,
+ "Solid" = 1,
+ "Dashed" = 2,
+ "Dotted" = 3,
+ "Dot dash" = 4,
+ "Long dash" = 5,
+ "Two dash" = 6)))
+ ),
+ fluidRow(
+ column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline6")),
+ column(width = 6, textInput("labline6","Label",value = ""))
+ )
+ ),
+ conditionalPanel(condition = "input.line6 > 0",
+ fluidRow(
+ column(width = 6, numericInput(inputId = "line7", strong("Line #7"), NA, min = 0)),
+ column(width = 6, selectInput(inputId = "linelty7", label = "Line type",selected = 1,
+ choices = list("Blank" = 0,
+ "Solid" = 1,
+ "Dashed" = 2,
+ "Dotted" = 3,
+ "Dot dash" = 4,
+ "Long dash" = 5,
+ "Two dash" = 6)))
+ ),
+ fluidRow(
+ column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline7")),
+ column(width = 6, textInput("labline7","Label",value = ""))
+ )
+ ),
+ conditionalPanel(condition = "input.line7 > 0",
+ fluidRow(
+ column(width = 6, numericInput(inputId = "line8", strong("Line #8"), NA, min = 0)),
+ column(width = 6, selectInput(inputId = "linelty8", label = "Line type",selected = 1,
+ choices = list("Blank" = 0,
+ "Solid" = 1,
+ "Dashed" = 2,
+ "Dotted" = 3,
+ "Dot dash" = 4,
+ "Long dash" = 5,
+ "Two dash" = 6)))
+ ),
+ fluidRow(
+ column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline8")),
+ column(width = 6, textInput("labline8","Label",value = ""))
+ )
+ )
+ ),##EndOf::Tab_6
+
+ # Tab 7: modify the 2-sigma bar (radial plot), grid (both) and polygon (KDE)
+ tabPanel("Bars & Grid",
+ div(align = "center", h5("Dispersion bar")),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "polygon",
+ label = "Dispersion bar color #1",
+ choices = list("Grey" = "grey80",
+ "Custom" = "custom",
+ "None" = "none")),
+ tooltip(refId = "polygon", attr = "for", text = "Colour of the polygon showing the dose dispersion around the central value.")
+ ),
+ column(width = 6,
+ selectInput(inputId = "polygon2",
+ label = "Dispersion bar color #2",
+ choices = list("Grey" = "grey80",
+ "Custom" = "custom",
+ "None" = "none"))
+ )
+ ),
+ fluidRow(
+ column(width = 6,
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.polygon == 'custom'",
+ jscolorInput(inputId = "rgbPolygon",
+ label = "Choose a color"))
+ ),
+ column(width = 6,
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.polygon2 == 'custom'",
+ jscolorInput(inputId = "rgbPolygon2",
+ label = "Choose a color"))
+ )
+ ),
+ sliderInput(inputId = "alpha.polygon",
+ label = "Transparency",
+ min = 0, max = 100,
+ step = 1, value = 66),
+ br(),
+ div(align = "center", HTML("<h5>2σ bar</h5>")),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "bar", label = HTML("2σ bar color"),
+ choices = list("Grey" = "grey50",
+ "Custom" = "custom",
+ "None" = "none")),
+ tooltip(refId = "bar", attr = "for", text = "Colour of the bar showing the 2-sigma range of the dose error around the central value.")
+ ),
+ column(width = 6,
+ selectInput(inputId = "bar2", label = HTML("2σ bar color #2"),
+ choices = list("Grey" = "grey50",
+ "Custom" = "custom",
+ "None" = "none"))
+ )
+ ),
+ fluidRow(
+ column(width = 6,
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.bar == 'custom'",
+ jscolorInput(inputId = "rgbBar",
+ label = "Choose a color"))
+ ),
+ column(width = 6,
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.bar2 == 'custom'",
+ jscolorInput(inputId = "rgbBar2",
+ label = "Choose a color"))
+ )
+ ),
+ sliderInput(inputId = "alpha.bar",
+ label = "Transparency",
+ min = 0, max = 100,
+ step = 1, value = 66),
+ br(),
+ div(align = "center", h5("Grid")),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "grid", label = "Grid color",
+ selected = "none",
+ list("Grey" = "grey90",
+ "Custom" = "custom",
+ "None" = "none"))
+ ),
+ column(width = 6,
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.grid == 'custom'",
+ jscolorInput(inputId = "rgbGrid",
+ label = "Choose a color"))
+ )
+ ),
+ sliderInput(inputId = "alpha.grid",
+ label = "Transparency",
+ min = 0, max = 100,
+ step = 1, value = 50),
+
+ br(),
+ div(align = "center", h5("Frame")),
+ selectInput(inputId = "frame", label = "Frame", selected = 1,
+ choices = list("No frame" = 0,
+ "Origin at {0,0}" = 1,
+ "Anchors at {0,-2}, {0,2}" = 2,
+ "Rectangle" = 3))
+ ),##EndOf::Tab_7
+
+ # Tab 8: add and customize legend
+ tabPanel("Legend",
+ div(align = "center", h5("Legend")),
+ fluidRow(
+ column(width = 6,
+ checkboxInput(inputId = "showlegend",
+ label = "Show legend",
+ value = FALSE),
+ tooltip(refId = "showlegend", text = "Legend content to be added to the plot.")
+ ),
+ column(width = 6,
+ selectInput(inputId = "legend.pos",
+ label = "Legend position",
+ selected = "bottomleft",
+ choices = c("Top" = "top",
+ "Top left" = "topleft",
+ "Top right"= "topright",
+ "Center" = "center",
+ "Bottom" = "bottom",
+ "Bottom left" = "bottomleft",
+ "Bottom right" = "bottomright"))
+ )
+ ),
+ fluidRow(
+ column(width = 6,
+ textInput(inputId = "legendname",
+ label = "Primary data label",
+ value = "primary data")
+ ),
+ column(width = 6,
+ textInput(inputId = "legendname2",
+ label = "Secondary data label",
+ value = "secondary data")
+ )
+ )
+ ),##EndOf::Tab_8
+
+ # Tab 9: Filter data
+ tabPanel("Filter",
+ div(align = "center", h5("Primary data set")),
+ selectInput(inputId = "filter.prim", label = "Choose values to exclude",
+ choices = "", multiple = TRUE, selected = ""),
+ div(align = "center", h5("Secondary data set")),
+ selectInput(inputId = "filter.sec", label = "Choose values to exclude",
+ choices = "", multiple = TRUE, selected = ""),
+ actionButton(inputId = "exclude", label = "Exclude")
+ ),##EndOf::Tab_9
+
+ # Tab 10: Layout
+ tabPanel("Layout",
+ div(align = "center", h5("Layout")),
+ div(id = "layout",
+ selectInput(inputId = "layout",
+ label = "Choose layout",
+ selected = "default",
+ choices = c("Default"="default",
+ "Journal"="journal"))
+ ),
+ tooltip(refId = "layout", placement = "top",
+ text = "The optional parameter layout allows to modify the entire plot more sophisticated. Each element of the plot can be addressed and its properties can be defined. This includes font type, size and decoration, colours and sizes of all plot items. To infer the definition of a specific layout style cf. get_Layout() or type eg. for the layout type \"journal\" get_Layout(\"journal\"). A layout type can be modified by the user by assigning n [...]
+ ),
+
+ # Tab 10: save plot as pdf, wmf or eps
+ tabPanel("Export",
+ radioButtons(inputId = "fileformat",
+ label = "Fileformat",
+ selected = "pdf",
+ choices = c("PDF (Portable Document Format)" = "pdf",
+ "SVG (Scalable Vector Graphics)" = "svg",
+ "EPS (Encapsulated Postscript)" = "eps")),
+ textInput(inputId = "filename",
+ label = "Filename",
+ value = "Abanico Plot"),
+ fluidRow(
+ column(width = 6,
+ numericInput(inputId = "imgheight",
+ label = "Image height",
+ value = 7)
+ ),
+ column(width = 6,
+ numericInput(inputId = "imgwidth",
+ label = "Image width",
+ value = 7)
+ )
+ ),
+ selectInput(inputId = "fontfamily",
+ label = "Font",
+ selected = "Helvetica",
+ choices = c("Helvetica" = "Helvetica",
+ "Helvetica Narrow" = "Helvetica Narrow",
+ "Times" = "Times",
+ "Courier" = "Courier",
+ "Bookman" = "Bookman",
+ "Palatino" = "Palatino")),
+ tags$hr(),
+ downloadButton(outputId = "exportFile",
+ label = "Download plot"),
+ tags$hr(),
+ helpText("Additionally, you can download a corresponding .R file that contains",
+ "a fully functional script to reproduce the plot in your R environment!"),
+
+ downloadButton(outputId = "exportScript",
+ label = "Download R script")
+ ),##EndOf::Tab_8
+
+ # Tab 10: further information
+ tabPanel("About",
+ hr(),
+ div(align = "center",
+ # HTML code to include a .png file in the tab; the image file must be in
+ # a subfolder called "wwww"
+ img(src="RL_Logo.png", height = 100, width = 100, alt = "R.Lum"),
+ p("Links:"),
+ a(href = "http://www.r-luminescence.de", "R.Luminescence project page", target="_blank"),
+ br(),
+ a(href = "https://forum.r-luminescence.de", "Message board", target="_blank"),
+ br(),
+ a(href = "http://zerk.canopus.uberspace.de/R.Lum", "Online application", target="_blank"),
+ br(),hr(),
+ img(src='GitHub-Mark-32px.png', width='32px', height='32px'),
+ br(),
+ a(href = "https://github.com/tzerk/RLumShiny/tree/master/inst/shiny/abanico", "See the code at GitHub!", target="_blank")
+ )#/div
+ )##EndOf::Tab_9
+ )##EndOf::tabsetPanel
+ ),##EndOf::sidebarPanel
+
+ # 3 - output panel
+ mainPanel(width = 7,
+ # insert css code inside <head></head> of the generated HTML file:
+ # allow open dropdown menus to reach over the container
+ tags$head(tags$style(type="text/css",".tab-content {overflow: visible;}")),
+ tags$head(includeCSS("www/style.css")),
+ # divide output in separate tabs via tabsetPanel
+ tabsetPanel(
+ tabPanel("Plot", plotOutput(outputId = "main_plot", height = "500px")),
+ tabPanel("Primary data set", fluidRow(column(width = 12, dataTableOutput("dataset")))),
+ tabPanel("Secondary data set", dataTableOutput("dataset2")),
+ tabPanel("Central Age Model", dataTableOutput("CAM")),
+ tabPanel("R plot code", verbatimTextOutput("plotCode"))
+ )###EndOf::tabsetPanel
+ )##EndOf::mainPanel
+ ),##EndOf::sideBarLayout
+ bookmarkButton()
+ )##EndOf::fluidPage
+}
\ No newline at end of file
diff --git a/inst/shiny/abanico/www/file_containsHeader.png b/inst/shiny/abanico/www/file_containsHeader.png
deleted file mode 100644
index 7abe3d2..0000000
Binary files a/inst/shiny/abanico/www/file_containsHeader.png and /dev/null differ
diff --git a/inst/shiny/abanico/www/file_sep.png b/inst/shiny/abanico/www/file_sep.png
deleted file mode 100644
index 0297e61..0000000
Binary files a/inst/shiny/abanico/www/file_sep.png and /dev/null differ
diff --git a/inst/shiny/abanico/www/file_structure.png b/inst/shiny/abanico/www/file_structure.png
deleted file mode 100644
index 5e3b50a..0000000
Binary files a/inst/shiny/abanico/www/file_structure.png and /dev/null differ
diff --git a/inst/shiny/abanico/www/style.css b/inst/shiny/abanico/www/style.css
index 295b46c..e6a055a 100644
--- a/inst/shiny/abanico/www/style.css
+++ b/inst/shiny/abanico/www/style.css
@@ -20,7 +20,6 @@
h5, h6 {
color: #428bca;
- font-weight: 700;
}
.tooltip-inner {
@@ -38,7 +37,6 @@ h5, h6 {
label, body, input {
font-size: 12px;
- font-weight: 100 !important;
}
.label, .badge {
@@ -46,7 +44,6 @@ label, body, input {
padding: 4px 20px;
margin: 10px;
line-height: 18px;
- font-weight: 100 !important;
}
.label-info, .badge-info {
diff --git a/inst/shiny/cosmicdose/Global.R b/inst/shiny/cosmicdose/Global.R
new file mode 100644
index 0000000..9f60f57
--- /dev/null
+++ b/inst/shiny/cosmicdose/Global.R
@@ -0,0 +1,7 @@
+## global.R ##
+library(Luminescence)
+library(shiny)
+library(googleVis)
+library(RLumShiny)
+
+enableBookmarking(store = "server")
\ No newline at end of file
diff --git a/inst/shiny/cosmicdose/server.R b/inst/shiny/cosmicdose/server.R
index 72d1661..47d6c42 100644
--- a/inst/shiny/cosmicdose/server.R
+++ b/inst/shiny/cosmicdose/server.R
@@ -1,10 +1,6 @@
## Server.R
-library(Luminescence)
-library(shiny)
-library(googleVis)
-
## MAIN FUNCTION
-shinyServer(function(input, output, session) {
+function(input, output, session) {
# function to convert coordinates to degree decimal format
coord_conv<- function(x, id) {
@@ -121,4 +117,4 @@ shinyServer(function(input, output, session) {
table
}
}, options=list(autoWidth = FALSE, paging = FALSE, processing = TRUE)) # jQuery DataTables options (http://datatables.net)
-})
\ No newline at end of file
+}
\ No newline at end of file
diff --git a/inst/shiny/cosmicdose/shiny_bookmarks/5a258b62777fa1b7/input.rds b/inst/shiny/cosmicdose/shiny_bookmarks/5a258b62777fa1b7/input.rds
new file mode 100644
index 0000000..6051252
Binary files /dev/null and b/inst/shiny/cosmicdose/shiny_bookmarks/5a258b62777fa1b7/input.rds differ
diff --git a/inst/shiny/cosmicdose/shiny_bookmarks/6584528eb04ada68/input.rds b/inst/shiny/cosmicdose/shiny_bookmarks/6584528eb04ada68/input.rds
new file mode 100644
index 0000000..6051252
Binary files /dev/null and b/inst/shiny/cosmicdose/shiny_bookmarks/6584528eb04ada68/input.rds differ
diff --git a/inst/shiny/cosmicdose/shiny_bookmarks/8b67ae595d1e31f0/input.rds b/inst/shiny/cosmicdose/shiny_bookmarks/8b67ae595d1e31f0/input.rds
new file mode 100644
index 0000000..4a0e46a
Binary files /dev/null and b/inst/shiny/cosmicdose/shiny_bookmarks/8b67ae595d1e31f0/input.rds differ
diff --git a/inst/shiny/cosmicdose/ui.R b/inst/shiny/cosmicdose/ui.R
index 4d6f5be..ab3e64c 100644
--- a/inst/shiny/cosmicdose/ui.R
+++ b/inst/shiny/cosmicdose/ui.R
@@ -1,123 +1,125 @@
-library(RLumShiny)
-
-shinyUI(fluidPage(
- includeCSS("./www/style.css"),
- fluidRow(
- column(width = 3,
- div(align = "center", span(class="label label-info", "Site")),
- wellPanel(
- numericInput(inputId = "altitude", label = p(class="h","Altitude (m asl)"), value = 124, step = 1),
- tooltip(refId = "altitude", text = "Altitude (m above sea-level)"),
- selectInput(inputId = "coords", label = "Coordinates", selected = "decDeg",
- choices = c("Decimal degrees" = "decDeg",
- "Degrees decimal minutes" = "degDecMin",
- "Degrees minutes seconds" = "degMinSec")),
-
- conditionalPanel(condition = "input.coords == 'decDeg'",
- numericInput(inputId = "decDegN", label = p(class="h","North"), value = 50.926903, step = 0.000001),
- numericInput(inputId = "decDegE", label = p(class="h","East"), value = 6.937453, step = 0.000001)
- ),
- conditionalPanel(condition = "input.coords == 'degDecMin'",
- fluidRow(
- column(width = 4,
- numericInput(inputId = "degN_1", label = p(class="h","N: \uB0"), value = 50, step = 1),
- numericInput(inputId = "degE_1", label = p(class="h","E: \uB0"), value = 6, step = 1)
- ),
- column(width = 4, offset = 2,
- numericInput(inputId = "decMinN", label = p(class="h","Decimal \u27"), value = 55.61417, step = 0.000001),
- numericInput(inputId = "decMinE", label = p(class="h","Decimal \u27"), value = 56.24717, step = 0.000001)
+function(request) {
+ fluidPage(
+ titlePanel(NULL, windowTitle = "RLumShiny - CosmicDose"),
+ includeCSS("./www/style.css"),
+ fluidRow(
+ column(width = 3,
+ div(align = "center", span(class="label label-info", "Site")),
+ wellPanel(
+ numericInput(inputId = "altitude", label = p(class="h","Altitude (m asl)"), value = 124, step = 1),
+ tooltip(refId = "altitude", text = "Altitude (m above sea-level)"),
+ selectInput(inputId = "coords", label = "Coordinates", selected = "decDeg",
+ choices = c("Decimal degrees" = "decDeg",
+ "Degrees decimal minutes" = "degDecMin",
+ "Degrees minutes seconds" = "degMinSec")),
+
+ conditionalPanel(condition = "input.coords == 'decDeg'",
+ numericInput(inputId = "decDegN", label = p(class="h","North"), value = 50.926903, step = 0.000001),
+ numericInput(inputId = "decDegE", label = p(class="h","East"), value = 6.937453, step = 0.000001)
+ ),
+ conditionalPanel(condition = "input.coords == 'degDecMin'",
+ fluidRow(
+ column(width = 4,
+ numericInput(inputId = "degN_1", label = p(class="h","N: \uB0"), value = 50, step = 1),
+ numericInput(inputId = "degE_1", label = p(class="h","E: \uB0"), value = 6, step = 1)
+ ),
+ column(width = 4, offset = 2,
+ numericInput(inputId = "decMinN", label = p(class="h","Decimal \u27"), value = 55.61417, step = 0.000001),
+ numericInput(inputId = "decMinE", label = p(class="h","Decimal \u27"), value = 56.24717, step = 0.000001)
+ )
)
- )
- ),
- conditionalPanel(condition = "input.coords == 'degMinSec'",
- fluidRow(
- column(width = 3, offset = 0,
- numericInput(inputId = "degN_2", label = p(class="h","N: \uB0"), value = 50, step = 1),
- numericInput(inputId = "degE_2", label = p(class="h","E: \uB0"), value = 6, step = 1)
- ),
- column(width = 3, offset = 1,
- numericInput(inputId = "minN", label = p(class="h","\u27"), value = 55, step = 1),
- numericInput(inputId = "minE", label = p(class="h","\u27"), value = 56, step = 1)
- ),
- column(width = 3, offset = 1,
- numericInput(inputId = "secN", label = p(class="h","\u27\u27"), value = 36.85, step = 0.01),
- numericInput(inputId = "secE", label = p(class="h","\u27\u27"), value = 14.83, step = 0.01)
+ ),
+ conditionalPanel(condition = "input.coords == 'degMinSec'",
+ fluidRow(
+ column(width = 3, offset = 0,
+ numericInput(inputId = "degN_2", label = p(class="h","N: \uB0"), value = 50, step = 1),
+ numericInput(inputId = "degE_2", label = p(class="h","E: \uB0"), value = 6, step = 1)
+ ),
+ column(width = 3, offset = 1,
+ numericInput(inputId = "minN", label = p(class="h","\u27"), value = 55, step = 1),
+ numericInput(inputId = "minE", label = p(class="h","\u27"), value = 56, step = 1)
+ ),
+ column(width = 3, offset = 1,
+ numericInput(inputId = "secN", label = p(class="h","\u27\u27"), value = 36.85, step = 0.01),
+ numericInput(inputId = "secE", label = p(class="h","\u27\u27"), value = 14.83, step = 0.01)
+ )
)
- )
+ )
)
- )
- ),
- column(width = 3,
- div(align = "center", span(class="label label-info", "Sediment")),
-
- wellPanel(
- numericInput(inputId = "density_1", label = p(class="h","Density (g/cm\uB3)"), value = 2.0, step = 0.1),
- tooltip(refId = "density_1", text = "Average overburden density (g/cm\uB3)."),
+ ),
+ column(width = 3,
+ div(align = "center", span(class="label label-info", "Sediment")),
- conditionalPanel(condition = "input.mode == 'xAsS'",
- numericInput(inputId = "density_2", label = p(class="h","Density (g/cm\uB3)"), value = NULL, step = 0.1),
- numericInput(inputId = "density_3", label = p(class="h","Density (g/cm\uB3)"), value = NULL, step = 0.1),
- numericInput(inputId = "density_4", label = p(class="h","Density (g/cm\uB3)"), value = NULL, step = 0.1),
- numericInput(inputId = "density_5", label = p(class="h","Density (g/cm\uB3)"), value = NULL, step = 0.1)
+ wellPanel(
+ numericInput(inputId = "density_1", label = p(class="h","Density (g/cm\uB3)"), value = 2.0, step = 0.1),
+ tooltip(refId = "density_1", text = "Average overburden density (g/cm\uB3)."),
+
+ conditionalPanel(condition = "input.mode == 'xAsS'",
+ numericInput(inputId = "density_2", label = p(class="h","Density (g/cm\uB3)"), value = NULL, step = 0.1),
+ numericInput(inputId = "density_3", label = p(class="h","Density (g/cm\uB3)"), value = NULL, step = 0.1),
+ numericInput(inputId = "density_4", label = p(class="h","Density (g/cm\uB3)"), value = NULL, step = 0.1),
+ numericInput(inputId = "density_5", label = p(class="h","Density (g/cm\uB3)"), value = NULL, step = 0.1)
+ )
+
)
+ ),
+ column(width = 3,
+ div(align = "center", span(class="label label-info", "Samples")),
- )
- ),
- column(width = 3,
- div(align = "center", span(class="label label-info", "Samples")),
-
- wellPanel(
- numericInput(inputId = "depth_1", label = p(class="h","Depth (m)"), value = 1.00, step = 0.01),
- tooltip("depth_1", text = "Depth of overburden (m)."),
-
- conditionalPanel(condition = "input.mode == 'sAxS' || input.mode == 'xAsS'",
- numericInput(inputId = "depth_2", label = p(class="h","Depth (m)"), value = NULL, step = 0.01),
- numericInput(inputId = "depth_3", label = p(class="h","Depth (m)"), value = NULL, step = 0.01),
- numericInput(inputId = "depth_4", label = p(class="h","Depth (m)"), value = NULL, step = 0.01),
- numericInput(inputId = "depth_5", label = p(class="h","Depth (m)"), value = NULL, step = 0.01)
+ wellPanel(
+ numericInput(inputId = "depth_1", label = p(class="h","Depth (m)"), value = 1.00, step = 0.01),
+ tooltip("depth_1", text = "Depth of overburden (m)."),
+
+ conditionalPanel(condition = "input.mode == 'sAxS' || input.mode == 'xAsS'",
+ numericInput(inputId = "depth_2", label = p(class="h","Depth (m)"), value = NULL, step = 0.01),
+ numericInput(inputId = "depth_3", label = p(class="h","Depth (m)"), value = NULL, step = 0.01),
+ numericInput(inputId = "depth_4", label = p(class="h","Depth (m)"), value = NULL, step = 0.01),
+ numericInput(inputId = "depth_5", label = p(class="h","Depth (m)"), value = NULL, step = 0.01)
+ )
)
- )
+ ),
+ column(width = 3,
+ div(align = "center", span(class="label label-info", "Options")),
+
+ wellPanel(
+ checkboxInput(inputId = "corr", label = p(class="h","Correct for geomagnetic field changes"), value = FALSE),
+ tooltip(refId = "corr", text = "Correct for geomagnetic field changes after Prescott & Hutton (1994). Apply only when justified by the data."),
+ numericInput(inputId = "estage", label = p(class="h","Estimated age"), value = 30, step = 1, min = 0, max = 80),
+ tooltip(refId = "estage", text = "Estimated age range (ka) for geomagnetic field change correction (0-80 ka allowed)."),
+ checkboxInput(inputId = "half", label = p(class="h","Use half the depth"), value = FALSE),
+ tooltip(refId = "half", text = " How to overcome with varying overburden thickness. If TRUE only half the depth is used for calculation. Apply only when justified, i.e. when a constant sedimentation rate can safely be assumed."),
+ numericInput(inputId = "error", label = p(class="h","General error (%)"), value = 10, step = 1),
+ tooltip(refId = "error", text = "General error (percentage) to be implemented on corrected cosmic dose rate estimate"),
+ selectInput(inputId = "mode", label = "Mode", selected = "sAsS",
+ choices = c("1 absorber, 1 sample" = "sAsS",
+ "x absorber, 1 sample" = "xAsS",
+ "1 absorber, x samples" = "sAxS"))
+ ),
+
+ actionButton(inputId = "refresh", label = "", icon = icon("refresh")),
+ tooltip(refId = "refresh", text = "Reload app"),
+ bookmarkButton()
+
+ )
),
- column(width = 3,
- div(align = "center", span(class="label label-info", "Options")),
-
- wellPanel(
- checkboxInput(inputId = "corr", label = p(class="h","Correct for geomagnetic field changes"), value = FALSE),
- tooltip(refId = "corr", text = "Correct for geomagnetic field changes after Prescott & Hutton (1994). Apply only when justified by the data."),
- numericInput(inputId = "estage", label = p(class="h","Estimated age"), value = 30, step = 1, min = 0, max = 80),
- tooltip(refId = "estage", text = "Estimated age range (ka) for geomagnetic field change correction (0-80 ka allowed)."),
- checkboxInput(inputId = "half", label = p(class="h","Use half the depth"), value = FALSE),
- tooltip(refId = "half", text = " How to overcome with varying overburden thickness. If TRUE only half the depth is used for calculation. Apply only when justified, i.e. when a constant sedimentation rate can safely be assumed."),
- numericInput(inputId = "error", label = p(class="h","General error (%)"), value = 10, step = 1),
- tooltip(refId = "error", text = "General error (percentage) to be implemented on corrected cosmic dose rate estimate"),
- selectInput(inputId = "mode", label = "Mode", selected = "sAsS",
- choices = c("1 absorber, 1 sample" = "sAsS",
- "x absorber, 1 sample" = "xAsS",
- "1 absorber, x samples" = "sAxS"))
- ),
-
- actionButton(inputId = "refresh", label = "", icon = icon("refresh")),
- tooltip(refId = "refresh", text = "Reload app")
-
- )
- ),
- fluidRow(
- column(width = 6,
- div(id="gmap",
- htmlOutput("map")
- )
+ fluidRow(
+ column(width = 6,
+ div(id="gmap",
+ htmlOutput("map")
+ )
+ ),
+ column(width = 6,
+ div(align = "center", h6("Results")),
+ conditionalPanel(condition = "input.mode == 'sAsS' || input.mode == 'xAsS'",
+ wellPanel(
+ htmlOutput("results")
+ )),
+ conditionalPanel(condition = "input.mode == 'sAxS'",
+
+ dataTableOutput("resultsTable")
+ )
+ )
),
- column(width = 6,
- div(align = "center", h6("Results")),
- conditionalPanel(condition = "input.mode == 'sAsS' || input.mode == 'xAsS'",
- wellPanel(
- htmlOutput("results")
- )),
- conditionalPanel(condition = "input.mode == 'sAxS'",
-
- dataTableOutput("resultsTable")
- )
- )
- ),
- includeCSS("./www/style.css")
-))
\ No newline at end of file
+ includeCSS("./www/style.css")
+ )
+}
\ No newline at end of file
diff --git a/inst/shiny/cosmicdose/www/RL_Logo.png b/inst/shiny/cosmicdose/www/RL_Logo.png
deleted file mode 100644
index ac0551b..0000000
Binary files a/inst/shiny/cosmicdose/www/RL_Logo.png and /dev/null differ
diff --git a/inst/shiny/cosmicdose/www/RL_Logo_alpha.png b/inst/shiny/cosmicdose/www/RL_Logo_alpha.png
deleted file mode 100644
index 064777f..0000000
Binary files a/inst/shiny/cosmicdose/www/RL_Logo_alpha.png and /dev/null differ
diff --git a/inst/shiny/cosmicdose/www/style.css b/inst/shiny/cosmicdose/www/style.css
index 97ea611..47a3979 100644
--- a/inst/shiny/cosmicdose/www/style.css
+++ b/inst/shiny/cosmicdose/www/style.css
@@ -21,7 +21,6 @@
h5 {
color: #428bca;
font-family:"Lucida Console", Monaco, monospace;
- font-weight: 700;
}
h6 {
@@ -55,7 +54,6 @@ h6 {
padding: 4px 20px;
margin: 10px;
line-height: 36px;
- font-weight: 100 !important;
}
.label-info, .badge-info {
diff --git a/inst/shiny/doserecovery/Global.R b/inst/shiny/doserecovery/Global.R
new file mode 100644
index 0000000..27aa470
--- /dev/null
+++ b/inst/shiny/doserecovery/Global.R
@@ -0,0 +1,11 @@
+## global.R ##
+library(Luminescence)
+library(shiny)
+library(RLumShiny)
+library(data.table)
+library(rhandsontable)
+
+## read example data set and misapply them for this plot type
+data(ExampleData.DeValues, envir = environment())
+
+enableBookmarking(store = "server")
\ No newline at end of file
diff --git a/inst/shiny/doserecovery/server.R b/inst/shiny/doserecovery/server.R
index e02cb18..f8de15a 100644
--- a/inst/shiny/doserecovery/server.R
+++ b/inst/shiny/doserecovery/server.R
@@ -1,56 +1,107 @@
-## Server.R
-library(Luminescence)
-library(shiny)
-
-## read example data set and misapply them for this plot type
-data(ExampleData.DeValues, envir = environment())
-ExampleData.DeValues <- ExampleData.DeValues$BT998
-
##############################################################################
### MAIN PROGRAM ###
##############################################################################
-
-shinyServer(function(input, output, session) {
+function(input, output, session) {
+
+ # input data (with default)
+ values <- reactiveValues(data_primary = ExampleData.DeValues$BT998[7:11,],
+ data_secondary = setNames(as.data.frame(matrix(NA_real_, nrow = 5, ncol = 2)), c("x", "y")))
# check and read in file (DATA SET 1)
- datGet<- reactive({
+ observeEvent(input$file1, {
inFile<- input$file1
- if(is.null(inFile)) return(NULL) # if no file was uploaded return NULL
- return(read.table(file = inFile$datapath, # inFile[1] contains filepath
- sep = input$sep,
- quote = "",
- header = input$headers)) # else return file
+
+ if(is.null(inFile))
+ return(NULL) # if no file was uploaded return NULL
+
+ values$data_primary <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
})
# check and read in file (DATA SET 2)
- datGet2<- reactive({
- inFile2<- input$file2
- if(is.null(inFile2)) return(NULL) # if no file was uploaded return NULL
- return(read.table(file = inFile2$datapath, # inFile[1] contains filepath
- sep = input$sep,
- quote = "",
- header = input$headers)) # else return file
+ observeEvent(input$file2, {
+ inFile<- input$file2
+
+ if(is.null(inFile))
+ return(NULL) # if no file was uploaded return NULL
+
+ values$data_secondary <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
})
### GET DATA SETS
Data<- reactive({
- if(!is.null(datGet())) {
- if(!is.null(datGet2())) {
- data<- list(datGet(), datGet2())
- } else {
- data<- list(datGet())
- }
- } else {
- x.1 <- ExampleData.DeValues[7:11,]
- x.2 <- ExampleData.DeValues[7:11,] * c(runif(5, 0.9, 1.1), 1)
- data<- list(x.1, x.2)
- }
+
+ data <- list(values$data_primary, values$data_secondary)
+ data <- lapply(data, function(x) {
+ x_tmp <- x[complete.cases(x), ]
+ if (nrow(x_tmp) == 0) return(NULL)
+ else return(x_tmp)
+ })
+ data <- data[!sapply(data, is.null)]
+ data <- lapply(data, function(x) setNames(x, c("Dose", "Error")))
+
+ return(data)
+ })
+
+ output$table_in_primary <- renderRHandsontable({
+ rhandsontable(values$data_primary,
+ height = 300,
+ colHeaders = c("Dose", "Error"),
+ rowHeaders = NULL)
+ })
+
+ observeEvent(input$table_in_primary, {
+
+ # Workaround for rhandsontable issue #138
+ # https://github.com/jrowen/rhandsontable/issues/138
+ df_tmp <- input$table_in_primary
+ row_names <- as.list(as.character(seq_len(length(df_tmp$data))))
+
+ df_tmp$params$rRowHeaders <- row_names
+ df_tmp$params$rowHeaders <- row_names
+ df_tmp$params$rDataDim <- as.list(c(length(row_names),
+ length(df_tmp$params$columns)))
+
+ if (df_tmp$changes$event == "afterRemoveRow")
+ df_tmp$changes$event <- "afterChange"
+
+ if (!is.null(hot_to_r(df_tmp)))
+ values$data_primary <- hot_to_r(df_tmp)
+ })
+
+
+ output$table_in_secondary <- renderRHandsontable({
+
+ rhandsontable(values$data_secondary,
+ height = 300,
+ colHeaders = c("Dose", "Error"),
+ rowHeaders = NULL)
+ })
+
+ observeEvent(input$table_in_secondary, {
+
+ # Workaround for rhandsontable issue #138
+ # https://github.com/jrowen/rhandsontable/issues/138
+ # See detailed explanation above
+ df_tmp <- input$table_in_secondary
+ row_names <- as.list(as.character(seq_len(length(df_tmp$data))))
+ df_tmp$params$rRowHeaders <- row_names
+ df_tmp$params$rowHeaders <- row_names
+ df_tmp$params$rDataDim <- as.list(c(length(row_names),
+ length(df_tmp$params$columns)))
+ if (df_tmp$changes$event == "afterRemoveRow")
+ df_tmp$changes$event <- "afterChange"
+
+ if (!is.null(hot_to_r(df_tmp)))
+ values$data_secondary <- hot_to_r(df_tmp)
+
})
output$xlim<- renderUI({
+
data<- Data()
- n<- nrow(data[[1]])
+
+ n <- max(sapply(data, nrow))
sliderInput(inputId = "xlim", label = "Range x-axis",
min = 0, max = n*2,
@@ -157,29 +208,19 @@ shinyServer(function(input, output, session) {
# prepare code as text output
- if (is.null(input$sep))
- updateRadioButtons(session, "fileformat", selected = "\t")
-
- if(input$sep == "\t")
- verb.sep<- "\\t"
- else
- verb.sep<- input$sep
-
- str1 <- paste("data <- read.delim(file, header = ",input$headers, ", sep= '", verb.sep,"')",
- sep = "")
-
- if(!is.null(datGet2())) {
- str2 <- "file2<- file.choose()"
- str3 <- paste("data2 <- read.delim(file2, header = ",input$headers, ", sep= '", verb.sep,"')",
- sep= "")
- str4 <- "data<- list(data, data2)"
+ str1 <- "data <- data.table::fread(file, data.table = FALSE)"
+
+ if(!all(is.na(unlist(values$data_secondary)))) {
+ str2 <- "file2 <- file.choose()"
+ str3 <- "data2 <- data.table::fread(file2, data.table = FALSE)"
+ str4 <- "data <- list(data, data2)"
str1 <- paste(str1, str2, str3, str4, sep = "\n")
}
header <- paste("# To reproduce the plot in your local R environment",
"# copy and run the following code to your R console.",
"library(Luminescence)",
- "file<- file.choose()",
+ "file <- file.choose()",
str1,
"\n",
sep = "\n")
@@ -279,4 +320,4 @@ output$dataset2<- renderDataTable(
}
})##EndOf::renterTable()
-})
+}
diff --git a/inst/shiny/doserecovery/ui.R b/inst/shiny/doserecovery/ui.R
index 76872e8..fccd53a 100644
--- a/inst/shiny/doserecovery/ui.R
+++ b/inst/shiny/doserecovery/ui.R
@@ -1,380 +1,359 @@
-library(RLumShiny)
-# Define UI
-pageWithSidebar(
-
- # Application title
- headerPanel(title = NULL),
-
- # 2- width = 5 -> refers to twitters bootstrap grid system
- # where the the maximum width is 12 that is to be shared between all
- # elements
- sidebarPanel(width = 5,
-
- # include a tabs in the input panel for easier navigation
- tabsetPanel(id = "tabs", type = "pill", selected = "Data",
- # Tab 1: Data input
- tabPanel("Data",
- # informational text
- div(align = "center", h5("Data upload")),
- # file upload button (data set 1)
- fileInput(inputId = "file1",
- label = strong("Primary data set"),
- accept="text/plain"),
- tooltip(refId = "file1", text = tags$img(src='file_structure.png', width='250px')),
- # file upload button (data set 2)
- fileInput(inputId = "file2",
- label = strong("Secondary data set"),
- accept="text/plain"),
- tooltip(refId = "file2", text = tags$img(src='file_structure.png', width='250px')),
- # informational text
- div(align = "center", h5("Settings")),
-
- fluidRow(
- column(width = 6,
- # logical: should NA values be excluded?
- checkboxInput(inputId = "naExclude",
- label = "Exclude NA values",
- value = TRUE),
- tooltip(refId = "naExclude", text = "Exclude NA values from the data set prior to any further operations.")
- ),
- column(width = 6,
- # logical: file contains headers?
- checkboxInput(inputId = "headers",
- label = "File contains headers",
- value = FALSE),
- tooltip(refId = "headers", text = tags$img(src='file_containsHeader.png', width='250px'))
- )),
- # char: columns separated by tab, space, comma
- radioButtons("sep", "Separator", selected = "\t", inline = TRUE,
- c("Tab" = "\t",
- "Space" = " ",
- "Comma" = ",",
- "Semicolon" = ";")),
- tooltip(refId = "sep", text = tags$img(src='file_sep.png', width='400px'), placement = "auto left"),
- hr(),
- actionButton(inputId = "refresh", label = "Refresh", icon = icon("refresh")),
- tooltip(refId = "refresh", text = "Redraw the plot")
- ),##EndOf::Tab_1
-
- # Tab 2: Statistical information
- tabPanel("Statistics",
- div(align = "center", h5("Summary")),
- selectInput(inputId = "sumpos",
- label = "Summary position",
- selected = "topleft",
- choices = list("Subtitle" = "sub",
- "Center" = "center",
- Top=c("Top" = "top",
- "Top left" = "topleft",
- "Top right"= "topright"),
- Bottom=c("Bottom" = "bottom",
- "Bottom left" = "bottomleft",
- "Bottom right" = "bottomright"))),
- tooltip(refId = "sumpos", attr = "for", text = "Position of the statistical summary. The keyword \"Subtitle\" will only work if no plot subtitle is used."),
- checkboxGroupInput(inputId = "stats",
- label = "Parameters",
- selected = c("n","mean"),
- choices = c("n" = "n",
- "Mean" = "mean",
- "weighted Mean" = "mean.weighted",
- "Median" = "median",
- #"weighted Median" = "median.weighted",
- "rel. Standard deviation" = "sdrel",
- "abs. Standard deviation" = "sdabs",
- "rel. Standard error" = "serel",
- "abs. Standard error" = "seabs",
- #"25 % Quartile" = "q25", #not implemented yet
- #"75 % Quartile" = "q75", #not implemented yet
- "Skewness" = "skewness", #not implemented yet
- "Kurtosis" = "kurtosis", #not implemented yet
- "Confidence interval" = "in.ci")),
- tooltip(refId = "stats", text = "Statistical parameters to be shown in the summary"),
- br(),
- div(align = "center", h5("Error range")),
- numericInput(inputId = "error",
- label = "Symmetric error range (%)",
- value = 10, min = 0, max = 100, step = 1),
- tooltip(refId = "error", text = "Symmetric error range in percent will be shown as dashed lines in the plot. Set error.range to 0 to void plotting of error ranges.")
- ),##EndOf::Tab_2
-
- # Tab 3: input that refer to the plot rather than the data
- tabPanel("DRT Details",
- div(align = "center", h5("Experimental details")),
- numericInput(inputId = "dose", label = "Given dose (primary data set)", value = 2800),
- tooltip(refId = "dose", text = "Given dose used for the dose recovery test to normalise data. If only one given dose is provided this given dose is valid for all input data sets (i.e., values is a list). Otherwise a given dose for each input data set has to be provided (e.g., given.dose = c(100,200)). If no given.dose values are plotted without normalisation (might be useful for preheat plateau tests). Note: Unit has to be the same as from the input va [...]
- numericInput(inputId = "dose2", label = "Given dose (secondary data set)", value = 3000),
- div(align = "center", h5("Preheat temperatures")),
- checkboxInput(inputId = "preheat", label = "Group values by preheat temperature", FALSE),
- tooltip(refId = "preheat", text = "Optional preheat temperatures to be used for grouping the De values. If specified, the temperatures are assigned to the x-axis."),
- conditionalPanel(condition = 'input.preheat == true',
- numericInput(inputId = "ph1", "PH Temperature #1", 180, min = 0),
- numericInput(inputId = "ph2", "PH Temperature #2", 200, min = 0),
- numericInput(inputId = "ph3", "PH Temperature #3", 220, min = 0),
- numericInput(inputId = "ph4", "PH Temperature #4", 240, min = 0),
- numericInput(inputId = "ph5", "PH Temperature #5", 260, min = 0),
- numericInput(inputId = "ph6", "PH Temperature #6", 280, min = 0),
- numericInput(inputId = "ph7", "PH Temperature #7", 300, min = 0),
- numericInput(inputId = "ph8", "PH Temperature #8", 320, min = 0)
- )
- ),##EndOf::Tab_3
-
- # Tab 3: input that refer to the plot rather than the data
- tabPanel("Plot",
- div(align = "center", h5("Title")),
- fluidRow(
- column(width = 6,
- textInput(inputId = "main",
- label = "Title",
- value = "DRT Plot")
- ),
- column(width = 6,
- textInput(inputId = "mtext",
- label = "Subtitle",
- value = "")
- )
- ),
- div(align = "center", h5("Boxplot")),
- checkboxInput(inputId = "boxplot", label = "Plot as boxplot", value = FALSE),
- tooltip(refId = "boxplot", text = "Optionally plot values, that are grouped by preheat temperature as boxplots. Only possible when preheat vector is specified."),
- div(align = "center", h5("Scaling")),
- sliderInput(inputId = "cex",
- label = "Scaling factor",
- min = 0.5, max = 2,
- value = 1.0, step = 0.1)
- ),##EndOf::Tab_3
-
- # Tab 4: modify axis parameters
- tabPanel("Axis",
- div(align = "center", h5("X-axis")),
- textInput(inputId = "xlab",
- label = "Label x-axis",
- value = "# Aliquot"),
- # inject sliderInput from Server.R
- uiOutput(outputId = "xlim"),
- br(),
- div(align = "center", h5("Y-axis")),
- textInput(inputId = "ylab",
- label = "Label y-axis",
- value = "Normalised De"),
- sliderInput(inputId = "ylim", label = "Range y-axis",
- min = 0, max = 3,
- value = c(0.75, 1.25),
- step = 0.01)
- ),##EndOf::Tab_4
-
- tabPanel("Datapoints",
- div(align = "center", h5("Primary data set")),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "pch",
- label = "Style",
- selected = "17",
- choices = c("Square"= "1",
- "Circle"="2",
- "Triangle point up"="3",
- "Plus"="4",
- "Cross"="5",
- "Diamond"="6",
- "Triangle point down"="7",
- "Square cross"="8",
- "Star"="9",
- "Diamond plus"="10",
- "Circle plus"="11",
- "Triangles up and down"="12",
- "Square plus"="13",
- "Circle cross"="14",
- "Square and Triangle down"="15",
- "filled Square"="16",
- "filled Circle"="17",
- "filled Triangle point up"="18",
- "filled Diamond"="19",
- "solid Circle"="20",
- "Bullet (smaller Circle)"="21",
- "Custom"="custom"))
- ),
- column(width = 6,
- # show only if custom symbol is desired
- conditionalPanel(condition = "input.pch == 'custom'",
- textInput(inputId = "custompch",
- label = "Insert character",
- value = "?"))
- )
- ),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "color", label = "Datapoint color",
- choices = list("Black" = "black",
- "Grey" = "grey50",
- "Red" = "#b22222",
- "Green" = "#6E8B3D",
- "Blue" = "#428bca",
- "Custom" = "custom"))
- ),
- column(width = 6,
- # show only if custom color is desired
- conditionalPanel(condition = "input.color == 'custom'",
- jscolorInput(inputId = "rgb",
- label = "Choose a color"))
- )
- ),
- br(),
- div(align = "center", h5("Secondary data set")),
- fluidRow(
- column(width = 6,
- ## DATA SET 2
- selectInput(inputId = "pch2",
- label = "Style",
- selected = "17",
- choices = c("Square"= "1",
- "Circle"="2",
- "Triangle point up"="3",
- "Plus"="4",
- "Cross"="5",
- "Diamond"="6",
- "Triangle point down"="7",
- "Square cross"="8",
- "Star"="9",
- "Diamond plus"="10",
- "Circle plus"="11",
- "Triangles up and down"="12",
- "Square plus"="13",
- "Circle cross"="14",
- "Square and Triangle down"="15",
- "filled Square"="16",
- "filled Circle"="17",
- "filled Triangle point up"="18",
- "filled Diamond"="19",
- "solid Circle"="20",
- "Bullet (smaller Circle)"="21",
- "Custom"="custom"))
- ),
- column(width = 6,
- # show only if custom symbol is desired
- conditionalPanel(condition = "input.pch2 == 'custom'",
- textInput(inputId = "custompch2",
- label = "Insert character",
- value = "?"))
- )
- ),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "color2", label = "Datapoint color",
- selected = "#b22222",
- choices = list("Black" = "black",
- "Grey" = "grey50",
- "Red" = "#b22222",
- "Green" = "#6E8B3D",
- "Blue" = "#428bca",
- "Custom" = "custom"))
- ),
- column(width = 6,
- # show only if custom color is desired
- conditionalPanel(condition = "input.color2 == 'custom'",
- jscolorInput(inputId = "rgb2",
- label = "Choose a color"))
- )
- )
- ),##EndOf::Tab_5
-
- # Tab xy: add and customize legend
- tabPanel("Legend",
- div(align = "center", h5("Legend")),
- fluidRow(
- column(width = 6,
- textInput(inputId = "legendname",
- label = "Primary data label",
- value = "primary data")
- ),
- column(width = 6,
- textInput(inputId = "legendname2",
- label = "Secondary data label",
- value = "secondary data")
- )
- ),
- selectInput(inputId = "legend.pos",
- label = "Legend position",
- selected = "bottomleft",
- choices = c("Top" = "top",
- "Top left" = "topleft",
- "Top right"= "topright",
- "Center" = "center",
- "Bottom" = "bottom",
- "Bottom left" = "bottomleft",
- "Bottom right" = "bottomright"))
- ),##EndOf::Tab_xy
-
- # Tab xy: save plot as pdf, wmf or eps
- tabPanel("Export",
- radioButtons(inputId = "fileformat",
- label = "Fileformat",
- selected = "pdf",
- choices = c("PDF (Portable Document Format)" = "pdf",
- "SVG (Scalable Vector Graphics)" = "svg",
- "EPS (Encapsulated Postscript)" = "eps")),
- textInput(inputId = "filename",
- label = "Filename",
- value = "DRT Plot"),
- fluidRow(
- column(width = 6,
- numericInput(inputId = "imgheight",
- label = "Image height",
- value = 7)
- ),
- column(width = 6,
- numericInput(inputId = "imgwidth",
- label = "Image width",
- value = 7)
- )
- ),
- selectInput(inputId = "fontfamily",
- label = "Font",
- selected = "Helvetica",
- choices = c("Helvetica" = "Helvetica",
- "Helvetica Narrow" = "Helvetica Narrow",
- "Times" = "Times",
- "Courier" = "Courier",
- "Bookman" = "Bookman",
- "Palatino" = "Palatino")),
- tags$hr(),
- downloadButton(outputId = "exportFile",
- label = "Download plot")
- ),##EndOf::Tab_
-
- # Tab xy: further information
- tabPanel("About",
- hr(),
- div(align = "center",
- # HTML code to include a .png file in the tab; the image file must be in
- # a subfolder called "wwww"
- img(src="RL_Logo.png", height = 100, width = 100, alt = "R.Lum"),
- p("Links:"),
- a(href = "http://www.r-luminescence.de", "R.Luminescence project page", target="_blank"),
+function(request) {
+ fluidPage(
+ titlePanel(NULL, windowTitle = "RLumShiny - DRT"),
+ sidebarLayout(
+ sidebarPanel(width = 5,
+
+ # include a tabs in the input panel for easier navigation
+ tabsetPanel(id = "tabs", type = "pill", selected = "Data",
+ # Tab 1: Data input
+ tabPanel("Data",
+ # informational text
+ div(align = "center", h5("Data upload")),
+ # file upload button (data set 1)
+ fileInput(inputId = "file1",
+ label = strong("Primary data set"),
+ accept="text/plain, .csv, text/csv"),
+ # file upload button (data set 2)
+ fileInput(inputId = "file2",
+ label = strong("Secondary data set"),
+ accept="text/plain, .csv, text/csv"),
+ # rhandsontable input/output
+ fluidRow(
+ column(width = 6,
+ rHandsontableOutput(outputId = "table_in_primary")
+ ),
+ column(width = 6,
+ rHandsontableOutput(outputId = "table_in_secondary"))
+ ),
+ hr(),
+
+ actionButton(inputId = "refresh", label = "Refresh", icon = icon("refresh")),
+ tooltip(refId = "refresh", text = "Redraw the plot")
+ ),##EndOf::Tab_1
+
+ # Tab 2: Statistical information
+ tabPanel("Statistics",
+ div(align = "center", h5("Summary")),
+ selectInput(inputId = "sumpos",
+ label = "Summary position",
+ selected = "topleft",
+ choices = list("Subtitle" = "sub",
+ "Center" = "center",
+ Top=c("Top" = "top",
+ "Top left" = "topleft",
+ "Top right"= "topright"),
+ Bottom=c("Bottom" = "bottom",
+ "Bottom left" = "bottomleft",
+ "Bottom right" = "bottomright"))),
+ tooltip(refId = "sumpos", attr = "for", text = "Position of the statistical summary. The keyword \"Subtitle\" will only work if no plot subtitle is used."),
+ checkboxGroupInput(inputId = "stats",
+ label = "Parameters",
+ selected = c("n","mean"),
+ choices = c("n" = "n",
+ "Mean" = "mean",
+ "weighted Mean" = "mean.weighted",
+ "Median" = "median",
+ #"weighted Median" = "median.weighted",
+ "rel. Standard deviation" = "sdrel",
+ "abs. Standard deviation" = "sdabs",
+ "rel. Standard error" = "serel",
+ "abs. Standard error" = "seabs",
+ #"25 % Quartile" = "q25", #not implemented yet
+ #"75 % Quartile" = "q75", #not implemented yet
+ "Skewness" = "skewness", #not implemented yet
+ "Kurtosis" = "kurtosis", #not implemented yet
+ "Confidence interval" = "in.ci")),
+ tooltip(refId = "stats", text = "Statistical parameters to be shown in the summary"),
br(),
- a(href = "https://forum.r-luminescence.de", "Message board", target="_blank"),
+ div(align = "center", h5("Error range")),
+ numericInput(inputId = "error",
+ label = "Symmetric error range (%)",
+ value = 10, min = 0, max = 100, step = 1),
+ tooltip(refId = "error", text = "Symmetric error range in percent will be shown as dashed lines in the plot. Set error.range to 0 to void plotting of error ranges.")
+ ),##EndOf::Tab_2
+
+ # Tab 3: input that refer to the plot rather than the data
+ tabPanel("DRT Details",
+ div(align = "center", h5("Experimental details")),
+ numericInput(inputId = "dose", label = "Given dose (primary data set)", value = 2800),
+ tooltip(refId = "dose", text = "Given dose used for the dose recovery test to normalise data. If only one given dose is provided this given dose is valid for all input data sets (i.e., values is a list). Otherwise a given dose for each input data set has to be provided (e.g., given.dose = c(100,200)). If no given.dose values are plotted without normalisation (might be useful for preheat plateau tests). Note: Unit has to be the same as from the inpu [...]
+ numericInput(inputId = "dose2", label = "Given dose (secondary data set)", value = 3000),
+ div(align = "center", h5("Preheat temperatures")),
+ checkboxInput(inputId = "preheat", label = "Group values by preheat temperature", FALSE),
+ tooltip(refId = "preheat", text = "Optional preheat temperatures to be used for grouping the De values. If specified, the temperatures are assigned to the x-axis."),
+ conditionalPanel(condition = 'input.preheat == true',
+ numericInput(inputId = "ph1", "PH Temperature #1", 180, min = 0),
+ numericInput(inputId = "ph2", "PH Temperature #2", 200, min = 0),
+ numericInput(inputId = "ph3", "PH Temperature #3", 220, min = 0),
+ numericInput(inputId = "ph4", "PH Temperature #4", 240, min = 0),
+ numericInput(inputId = "ph5", "PH Temperature #5", 260, min = 0),
+ numericInput(inputId = "ph6", "PH Temperature #6", 280, min = 0),
+ numericInput(inputId = "ph7", "PH Temperature #7", 300, min = 0),
+ numericInput(inputId = "ph8", "PH Temperature #8", 320, min = 0)
+ )
+ ),##EndOf::Tab_3
+
+ # Tab 3: input that refer to the plot rather than the data
+ tabPanel("Plot",
+ div(align = "center", h5("Title")),
+ fluidRow(
+ column(width = 6,
+ textInput(inputId = "main",
+ label = "Title",
+ value = "DRT Plot")
+ ),
+ column(width = 6,
+ textInput(inputId = "mtext",
+ label = "Subtitle",
+ value = "")
+ )
+ ),
+ div(align = "center", h5("Boxplot")),
+ checkboxInput(inputId = "boxplot", label = "Plot as boxplot", value = FALSE),
+ tooltip(refId = "boxplot", text = "Optionally plot values, that are grouped by preheat temperature as boxplots. Only possible when preheat vector is specified."),
+ div(align = "center", h5("Scaling")),
+ sliderInput(inputId = "cex",
+ label = "Scaling factor",
+ min = 0.5, max = 2,
+ value = 1.0, step = 0.1)
+ ),##EndOf::Tab_3
+
+ # Tab 4: modify axis parameters
+ tabPanel("Axis",
+ div(align = "center", h5("X-axis")),
+ textInput(inputId = "xlab",
+ label = "Label x-axis",
+ value = "# Aliquot"),
+ # inject sliderInput from Server.R
+ uiOutput(outputId = "xlim"),
br(),
- a(href = "http://zerk.canopus.uberspace.de/R.Lum", "Online application", target="_blank"),
- br(),hr(),
- img(src='GitHub-Mark-32px.png', width='32px', height='32px'),
+ div(align = "center", h5("Y-axis")),
+ textInput(inputId = "ylab",
+ label = "Label y-axis",
+ value = "Normalised De"),
+ sliderInput(inputId = "ylim", label = "Range y-axis",
+ min = 0, max = 3,
+ value = c(0.75, 1.25),
+ step = 0.01)
+ ),##EndOf::Tab_4
+
+ tabPanel("Datapoints",
+ div(align = "center", h5("Primary data set")),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "pch",
+ label = "Style",
+ selected = "17",
+ choices = c("Square"= "1",
+ "Circle"="2",
+ "Triangle point up"="3",
+ "Plus"="4",
+ "Cross"="5",
+ "Diamond"="6",
+ "Triangle point down"="7",
+ "Square cross"="8",
+ "Star"="9",
+ "Diamond plus"="10",
+ "Circle plus"="11",
+ "Triangles up and down"="12",
+ "Square plus"="13",
+ "Circle cross"="14",
+ "Square and Triangle down"="15",
+ "filled Square"="16",
+ "filled Circle"="17",
+ "filled Triangle point up"="18",
+ "filled Diamond"="19",
+ "solid Circle"="20",
+ "Bullet (smaller Circle)"="21",
+ "Custom"="custom"))
+ ),
+ column(width = 6,
+ # show only if custom symbol is desired
+ conditionalPanel(condition = "input.pch == 'custom'",
+ textInput(inputId = "custompch",
+ label = "Insert character",
+ value = "?"))
+ )
+ ),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "color", label = "Datapoint color",
+ choices = list("Black" = "black",
+ "Grey" = "grey50",
+ "Red" = "#b22222",
+ "Green" = "#6E8B3D",
+ "Blue" = "#428bca",
+ "Custom" = "custom"))
+ ),
+ column(width = 6,
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.color == 'custom'",
+ jscolorInput(inputId = "rgb",
+ label = "Choose a color"))
+ )
+ ),
br(),
- a(href = "https://github.com/tzerk/RLumShiny/tree/master/inst/shiny/doserecovery", "See the code at GitHub!", target="_blank")
- )#/div
- )##EndOf::Tab_xy
- )
- ),
-
-
- # Show a plot of the generated distribution
- mainPanel(width = 7,
- # insert css code inside <head></head> of the generated HTML file:
- # allow open dropdown menus to reach over the container
- tags$head(tags$style(type="text/css",".tab-content {overflow: visible;}")),
- tags$head(includeCSS("www/style.css")),
- # divide output in separate tabs via tabsetPanel
- tabsetPanel(
- tabPanel("Plot", plotOutput(outputId = "main_plot", height = "400px")),
- tabPanel("Primary data set", fluidRow(column(width = 12, dataTableOutput("dataset")))),
- tabPanel("Secondary data set", dataTableOutput("dataset2")),
- tabPanel("R plot code", verbatimTextOutput("plotCode"))
- )
+ div(align = "center", h5("Secondary data set")),
+ fluidRow(
+ column(width = 6,
+ ## DATA SET 2
+ selectInput(inputId = "pch2",
+ label = "Style",
+ selected = "17",
+ choices = c("Square"= "1",
+ "Circle"="2",
+ "Triangle point up"="3",
+ "Plus"="4",
+ "Cross"="5",
+ "Diamond"="6",
+ "Triangle point down"="7",
+ "Square cross"="8",
+ "Star"="9",
+ "Diamond plus"="10",
+ "Circle plus"="11",
+ "Triangles up and down"="12",
+ "Square plus"="13",
+ "Circle cross"="14",
+ "Square and Triangle down"="15",
+ "filled Square"="16",
+ "filled Circle"="17",
+ "filled Triangle point up"="18",
+ "filled Diamond"="19",
+ "solid Circle"="20",
+ "Bullet (smaller Circle)"="21",
+ "Custom"="custom"))
+ ),
+ column(width = 6,
+ # show only if custom symbol is desired
+ conditionalPanel(condition = "input.pch2 == 'custom'",
+ textInput(inputId = "custompch2",
+ label = "Insert character",
+ value = "?"))
+ )
+ ),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "color2", label = "Datapoint color",
+ selected = "#b22222",
+ choices = list("Black" = "black",
+ "Grey" = "grey50",
+ "Red" = "#b22222",
+ "Green" = "#6E8B3D",
+ "Blue" = "#428bca",
+ "Custom" = "custom"))
+ ),
+ column(width = 6,
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.color2 == 'custom'",
+ jscolorInput(inputId = "rgb2",
+ label = "Choose a color"))
+ )
+ )
+ ),##EndOf::Tab_5
+
+ # Tab xy: add and customize legend
+ tabPanel("Legend",
+ div(align = "center", h5("Legend")),
+ fluidRow(
+ column(width = 6,
+ textInput(inputId = "legendname",
+ label = "Primary data label",
+ value = "primary data")
+ ),
+ column(width = 6,
+ textInput(inputId = "legendname2",
+ label = "Secondary data label",
+ value = "secondary data")
+ )
+ ),
+ selectInput(inputId = "legend.pos",
+ label = "Legend position",
+ selected = "bottomleft",
+ choices = c("Top" = "top",
+ "Top left" = "topleft",
+ "Top right"= "topright",
+ "Center" = "center",
+ "Bottom" = "bottom",
+ "Bottom left" = "bottomleft",
+ "Bottom right" = "bottomright"))
+ ),##EndOf::Tab_xy
+
+ # Tab xy: save plot as pdf, wmf or eps
+ tabPanel("Export",
+ radioButtons(inputId = "fileformat",
+ label = "Fileformat",
+ selected = "pdf",
+ choices = c("PDF (Portable Document Format)" = "pdf",
+ "SVG (Scalable Vector Graphics)" = "svg",
+ "EPS (Encapsulated Postscript)" = "eps")),
+ textInput(inputId = "filename",
+ label = "Filename",
+ value = "DRT Plot"),
+ fluidRow(
+ column(width = 6,
+ numericInput(inputId = "imgheight",
+ label = "Image height",
+ value = 7)
+ ),
+ column(width = 6,
+ numericInput(inputId = "imgwidth",
+ label = "Image width",
+ value = 7)
+ )
+ ),
+ selectInput(inputId = "fontfamily",
+ label = "Font",
+ selected = "Helvetica",
+ choices = c("Helvetica" = "Helvetica",
+ "Helvetica Narrow" = "Helvetica Narrow",
+ "Times" = "Times",
+ "Courier" = "Courier",
+ "Bookman" = "Bookman",
+ "Palatino" = "Palatino")),
+ tags$hr(),
+ downloadButton(outputId = "exportFile",
+ label = "Download plot")
+ ),##EndOf::Tab_
+
+ # Tab xy: further information
+ tabPanel("About",
+ hr(),
+ div(align = "center",
+ # HTML code to include a .png file in the tab; the image file must be in
+ # a subfolder called "wwww"
+ img(src="RL_Logo.png", height = 100, width = 100, alt = "R.Lum"),
+ p("Links:"),
+ a(href = "http://www.r-luminescence.de", "R.Luminescence project page", target="_blank"),
+ br(),
+ a(href = "https://forum.r-luminescence.de", "Message board", target="_blank"),
+ br(),
+ a(href = "http://zerk.canopus.uberspace.de/R.Lum", "Online application", target="_blank"),
+ br(),hr(),
+ img(src='GitHub-Mark-32px.png', width='32px', height='32px'),
+ br(),
+ a(href = "https://github.com/tzerk/RLumShiny/tree/master/inst/shiny/doserecovery", "See the code at GitHub!", target="_blank")
+ )#/div
+ )##EndOf::Tab_xy
+ )
+ ),
+
+
+ # Show a plot of the generated distribution
+ mainPanel(width = 7,
+ # insert css code inside <head></head> of the generated HTML file:
+ # allow open dropdown menus to reach over the container
+ tags$head(tags$style(type="text/css",".tab-content {overflow: visible;}")),
+ tags$head(includeCSS("www/style.css")),
+ # divide output in separate tabs via tabsetPanel
+ tabsetPanel(
+ tabPanel("Plot", plotOutput(outputId = "main_plot", height = "400px")),
+ tabPanel("Primary data set", fluidRow(column(width = 12, dataTableOutput("dataset")))),
+ tabPanel("Secondary data set", dataTableOutput("dataset2")),
+ tabPanel("R plot code", verbatimTextOutput("plotCode"))
+ )
+ )
+ ),
+ bookmarkButton()
)
-)
\ No newline at end of file
+}
\ No newline at end of file
diff --git a/inst/shiny/doserecovery/www/file_containsHeader.png b/inst/shiny/doserecovery/www/file_containsHeader.png
deleted file mode 100644
index 7abe3d2..0000000
Binary files a/inst/shiny/doserecovery/www/file_containsHeader.png and /dev/null differ
diff --git a/inst/shiny/doserecovery/www/file_sep.png b/inst/shiny/doserecovery/www/file_sep.png
deleted file mode 100644
index 0297e61..0000000
Binary files a/inst/shiny/doserecovery/www/file_sep.png and /dev/null differ
diff --git a/inst/shiny/doserecovery/www/file_structure.png b/inst/shiny/doserecovery/www/file_structure.png
deleted file mode 100644
index 5e3b50a..0000000
Binary files a/inst/shiny/doserecovery/www/file_structure.png and /dev/null differ
diff --git a/inst/shiny/doserecovery/www/style.css b/inst/shiny/doserecovery/www/style.css
index 295b46c..e6a055a 100644
--- a/inst/shiny/doserecovery/www/style.css
+++ b/inst/shiny/doserecovery/www/style.css
@@ -20,7 +20,6 @@
h5, h6 {
color: #428bca;
- font-weight: 700;
}
.tooltip-inner {
@@ -38,7 +37,6 @@ h5, h6 {
label, body, input {
font-size: 12px;
- font-weight: 100 !important;
}
.label, .badge {
@@ -46,7 +44,6 @@ label, body, input {
padding: 4px 20px;
margin: 10px;
line-height: 18px;
- font-weight: 100 !important;
}
.label-info, .badge-info {
diff --git a/inst/shiny/filter/global.R b/inst/shiny/filter/global.R
new file mode 100644
index 0000000..7a42a8c
--- /dev/null
+++ b/inst/shiny/filter/global.R
@@ -0,0 +1,32 @@
+## +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+## Title: Filter_app
+## Authors: Urs Tilmann Wolpert, Department of Geography, Justus-Liebig-University Giessen
+## Sebastian Kreutzer, IRAMAT-CRP2A, Universite Bordeaux Montaigne (France)
+## Contact: urs.t.wolpert at geogr.uni-giessen.de
+## Date: Thu June 22 2017
+##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+library(shiny)
+library(Luminescence)
+library(readxl)
+library(RLumShiny)
+
+##check whether a real database exists or the template should be loaded
+if(dir.exists("Data")){
+ ##set to first file
+ database_path <- list.files("Data/", full.names = TRUE)[1]
+
+ ##check whether this is a real XLSX file
+ if(rev(strsplit(database_path, split = ".", fixed = TRUE)[[1]])[1] != "xlsx"){
+ stop("The filter database file needs to be of type 'xlsx'!")
+
+ }
+
+}else{
+ database_path <- "template/template.xlsx"
+
+}
+
+# ##load data and cleanup filter list
+filters <- readxl::excel_sheets(database_path)
+filters <- filters[!grepl(pattern = "Main List", x = filters, fixed = TRUE)]
+
diff --git a/inst/shiny/filter/server.R b/inst/shiny/filter/server.R
new file mode 100644
index 0000000..5a36e46
--- /dev/null
+++ b/inst/shiny/filter/server.R
@@ -0,0 +1,278 @@
+## +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+## Title: Filter_app
+## Authors: Urs Tilmann Wolpert, Department of Geography, Justus-Liebig-University Giessen
+## Sebastian Kreutzer, IRAMAT-CRP2A, Universite Bordeaux Montaigne (France)
+## Contact: urs.t.wolpert at geogr.uni-giessen.de
+## Date: Thu June 22 2017
+##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+shinyServer(function(input, output, session) {
+
+ #check for own set filter dataset
+ output$filters <- renderUI({
+
+ if(!is.null(input$own_file)){
+
+ ##rename file in path
+ file.rename(
+ from = input$own_file$datapath,
+ to = paste0(input$own_file$datapath,input$own_file$name))
+
+ ##set new datapath
+ database_path <<- paste0(input$own_file$datapath,input$own_file$name)
+
+ ##set new filter list ... and do not filter them, we have no idea
+ filters <- readxl::excel_sheets(database_path)
+
+ ##update input for optical density
+ updateSelectInput(session, "opticaldensity", choices = filters)
+
+ }
+
+ ##create chooser output
+ RLumShiny:::chooserInput("filterInput", "Filters available:", "Filters chosen:", filters, c(),
+ multiple = TRUE, size = 5)
+
+ })
+
+ # Transmission: Prepare data + plot
+ output$filterPlot <- renderPlot({
+
+ if (length(input$filterInput$right) != 0) {
+ data <- lapply(input$filterInput$right, function(x) {
+ as.matrix(readxl::read_excel(
+ path = database_path,
+ sheet = x,
+ skip = 14
+ ))
+
+ })
+
+ filter.matrix <- plot_FilterCombinations(filters = data,
+ xlim = input$range,
+ main = input$main,
+ legend = input$legend,
+ legend.text = input$filterInput$right,
+ interactive = FALSE)
+ if(input$stimulationInput == "NA"){
+ NA}
+ if(input$stimulationInput == "violett"){
+ rect(402, 0, 408, 1, col = "purple", lty = 0)}
+ if(input$stimulationInput == "green"){
+ rect(505, 0, 545, 1, col = "green", lty = 0)}
+ if(input$stimulationInput == "blue"){
+ rect(455, 0, 462, 1, col = "blue", lty = 0)}
+ if(input$stimulationInput == "infrared"){
+ rect(847, 0, 853, 1, col = "red", lty = 0)}
+
+ }
+ })
+
+ # Optical Density: Prepare data + plot
+ output$densityPlot <- renderPlot({
+ data <- as.matrix(readxl::read_excel(
+ path = database_path,
+ sheet = input$opticaldensity,
+ skip = 14
+ ))
+ data[is.na(data[,3]),3] <- max(data[,3],na.rm = TRUE)
+ plot(data[,c(1,3)], type = "l",
+ xlim = input$rangeOD,
+ xlab = "Wavelength [nm]",
+ ylab = "Optical Density [a. u.]",
+ main = input$mainOD)
+
+ })
+ # Metadata
+ output$metadata <- renderTable({
+ if (length(input$filterInput$right) != 0) {
+ data <- lapply(input$filterInput$right, function(x) {
+ data <- as.data.frame(t(readxl::read_excel(
+ path = database_path,
+ sheet = x,
+ col_names = FALSE,
+ n_max = 7)),
+ stringsAsFactors = FALSE)
+
+ ##change column names & remove unwanted characters
+ colnames(data) <- gsub(pattern = ":", replacement = "", x = as.character(data[1,]), fixed = TRUE)
+
+ ##remove first row
+ data <- data[-1,]
+
+ ##remove NA values
+ data <- data[!sapply(data[,1],is.na),]
+
+ ##remove row with "BACK to Filterlist"
+ data <- data[!grepl(pattern = "Back to Filterlist", x = data[,1]), ]
+
+ })
+
+
+ data.table::rbindlist(data)
+
+
+
+ }
+ })
+
+ # Transmission: plot download
+ output$exportPlot <- downloadHandler(
+ filename = function() {
+ paste(input$filename, ".pdf", sep = "")
+ },
+ content = function(file) {
+ pdf(file,
+ width = input$widthInput,
+ height = input$heightInput,
+ paper = "special")
+ if (length(input$filterInput$right) != 0) {
+ data <- lapply(input$filterInput$right, function(x) {
+ as.matrix(readxl::read_excel(
+ path = database_path,
+ sheet = x,
+ skip = 14))
+ })
+ plot_FilterCombinations(filters = data,
+ d = input$thicknessInput,
+ P = input$reflectionInput,
+ xlim = input$range,
+ main = input$main,
+ legend = input$legend,
+ legend.text = input$filterInput$right,
+ interactive = FALSE)
+ if(input$stimulationInput == "NA"){
+ NA}
+ if(input$stimulationInput == "violett"){
+ rect(402, 0, 408, 1, col = "purple", lty = 0)}
+ if(input$stimulationInput == "green"){
+ rect(505, 0, 545, 1, col = "green", lty = 0)}
+ if(input$stimulationInput == "blue"){
+ rect(455, 0, 462, 1, col = "blue", lty = 0)}
+ if(input$stimulationInput == "infrared"){
+ rect(847, 0, 853, 1, col = "red", lty = 0)}
+
+
+ }
+ dev.off()
+ }
+ )
+ # Transmission: data-table download
+ output$exportTable <- downloadHandler(
+ filename = function(){
+ paste(input$filename, ".csv", sep = "")
+ },
+ content = function(file) {
+ if (length(input$filterInput$right) != 0) {
+ data <- lapply(input$filterInput$right, function(x) {
+ as.matrix(readxl::read_excel(
+ path = database_path,
+ sheet = x,
+ skip = 14
+ ))
+
+ })
+
+ filter.matrix <- plot_FilterCombinations(filters = data,
+ xlim = input$range,
+ main = input$main,
+ legend = input$legend,
+ legend.text = input$filterInput$right,
+ interactive = FALSE)
+
+ write.csv(filter.matrix$filter_matrix, file)
+ }
+ }
+ )
+
+ # Optical Density: plot download
+ output$exportPlotOD <- downloadHandler(
+ filename = function() {
+ paste(input$filenameOD, ".pdf", sep = "")
+ },
+ content = function(file) {
+ pdf(file,
+ width = input$widthInputOD,
+ height = input$heightInputOD,
+ paper = "special")
+ data <- as.matrix(readxl::read_excel(
+ path = database_path,
+ sheet = input$opticaldensity,
+ skip = 14
+ ))
+ data[is.na(data[,3]),3] <- max(data[,3],na.rm = TRUE)
+ plot(data[,c(1,3)], type = "l",
+ xlim = input$rangeOD,
+ xlab = "Wavelength [nm]",
+ ylab = "Optical Density [a. u.]",
+ main = input$mainOD)
+
+ dev.off()
+ }
+ )
+
+ # Optical Density: data table download
+ output$exportTableOD <- downloadHandler(
+ filename = function(){
+ paste(input$filenameOD, ".csv", sep = "")
+ },
+ content = function(file) {
+ data <- as.matrix(readxl::read_excel(
+ path = database_path,
+ sheet = input$opticaldensity,
+ skip = 14
+ ))
+
+ write.csv(data, file)
+
+ }
+ )
+
+
+ # Download Filterdatabase Master File
+output$MasterFile <- downloadHandler(
+ filename = "Filterdatabase.xlsx",
+ content = function(file){
+ file.copy(database_path, file)
+
+ })
+
+ ##set warning for template data
+ ##Transmission Tab
+ output$warningtext <- renderUI({
+
+ if(is.null(input$own_file)){
+ if (grepl(pattern = "template", x = database_path, fixed = TRUE)){
+ div(
+ "Attention: Template data set. No real filter data!",
+ style = "color:red; font-size:15px",
+ align = "center"
+ )
+ }
+
+ }else{
+ div(paste0("Using custom filter database: ", basename(database_path)), align = "center")
+
+ }
+ })
+
+ ##Optical Density Tab
+ output$warningtextOD <- renderUI({
+
+ if(is.null(input$own_file)){
+ if (grepl(pattern = "template", x = database_path, fixed = TRUE)){
+ div(
+ "Attention: Template data set. No real filter data!",
+ style = "color:red; font-size:15px",
+ align = "center"
+ )
+ }
+
+ }else{
+ div(paste0("Using custom filter database: ", basename(database_path)), align = "center")
+ }
+ })
+
+
+}
+)
+
diff --git a/inst/shiny/filter/template/template.xlsx b/inst/shiny/filter/template/template.xlsx
new file mode 100644
index 0000000..18a2a1e
Binary files /dev/null and b/inst/shiny/filter/template/template.xlsx differ
diff --git a/inst/shiny/filter/ui.R b/inst/shiny/filter/ui.R
new file mode 100644
index 0000000..f0c1ad5
--- /dev/null
+++ b/inst/shiny/filter/ui.R
@@ -0,0 +1,188 @@
+## +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+## Title: Filter_app
+## Authors: Urs Tilmann Wolpert, Department of Geography, Justus-Liebig-University Giessen
+## Sebastian Kreutzer, IRAMAT-CRP2A, Universite Bordeaux Montaigne (France)
+## Contact: urs.t.wolpert at geogr.uni-giessen.de
+## Date: Thu June 22 2017
+##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+shinyUI(
+ navbarPage("Filter_app",
+ tabPanel("Transmission",
+ sidebarLayout(
+ sidebarPanel(
+ # tabs on sidebar panel
+ tabsetPanel(type = "pills", selected = "Data",
+ # Tab 1: Data Transmission
+ tabPanel("Data",
+ tags$hr(),
+ strong("Select filters"),
+ uiOutput(outputId = "filters"),
+ tags$hr(),
+ radioButtons(
+ "stimulationInput",
+ label = "Show stimulation wavelength",
+ choices =
+ c("None" = "NA",
+ "Violet: 405 \u0394 3 nm " = "violett",
+ "Blue: 458 \u0394 3 nm" = "blue",
+ "Green: 525 \u0394 20 nm" = "green",
+ "Infrared: 850 \u0394 3 nm" = "infrared")
+ )
+ ), # End Tab 1
+
+ # Tab 2: Plot Options Transmission
+ tabPanel("Plot Options",
+ tags$hr(),
+ textInput("main",
+ label = "Plot title",
+ value = "Filter Combinations"),
+ tags$hr(),
+ sliderInput("range",
+ "Wavelength range",
+ min = 200,
+ max = 1000,
+ value = c(200, 1000)),
+ checkboxInput(inputId = "legend",
+ label = "Show legend",
+ value = TRUE)
+
+
+ ), # End Tab 2
+
+ # Tab 3: Export plots + datatable Transmission
+ tabPanel("Export",
+ tags$hr(),
+ textInput(
+ "filename",
+ label = "Filename",
+ value = "Enter filename..."),
+ tags$hr(),
+ fluidRow(
+ column(6,
+ numericInput(
+ "widthInput",
+ label = "Image width",
+ value = 7
+ )),
+ column(6,
+ numericInput(
+ "heightInput",
+ label = "Image height",
+ value = 7
+ ))),
+ downloadButton("exportPlot", label = "Download plot as PDF"),
+ tags$hr(),
+ downloadButton("exportTable", label = "Download raw data as CSV")
+ ) # End Tab 3
+
+
+
+ )),
+
+
+
+ mainPanel(uiOutput(outputId = "warningtext"),
+ plotOutput("filterPlot"),
+ tableOutput("metadata")
+ )
+ )
+ ),
+ tabPanel("Optical Density",
+ sidebarLayout(
+ sidebarPanel(
+ # tabs on sidebar Panel
+ tabsetPanel(type = "pills", selected = "Data & Plot Options",
+ # Tab 1: Data Optical Density
+ tabPanel("Data & Plot Options",
+ tags$hr(),
+ selectInput("opticaldensity", label = "Select filters",
+ choices = filters),
+ tags$hr(),
+ textInput("mainOD",
+ label = "Plot title",
+ value = "Filter"),
+ sliderInput("rangeOD",
+ "Wavelength range",
+ min = 200,
+ max = 1000,
+ value = c(200, 1000))
+
+
+
+ ), # End Tab 1
+ # Tab 2: Plot Options Optical Density
+ tabPanel("Export",
+ tags$hr(),
+ textInput(
+ "filenameOD",
+ label = "Filename",
+ value = "Enter filename..."),
+ fluidRow(
+ column(width = 6,
+ numericInput(
+ "widthInputOD",
+ label = "Image width",
+ value = 7)
+ ),
+ column(width = 6,
+ numericInput(
+ "heightInputOD",
+ label = "Image height",
+ value = 7)
+ )
+ ),
+ downloadButton("exportPlotOD", label = "Download plot as PDF"),
+ tags$hr(),
+ downloadButton("exportTableOD", label = "Download raw data as CSV")
+ )
+ )
+ ),
+ mainPanel(
+ uiOutput(outputId = "warningtextOD"),
+ plotOutput("densityPlot")
+
+ )
+ )
+ ),
+
+ tabPanel("Advanced",
+ fileInput("own_file", accept = "*.xlsx", label = "Upload individual filter data"),
+ helpText("A '.xlsx' file containing one's individual filter data can be temporarily uploaded here."),
+ helpText(strong("Note to keep the exact same data structure as in the template '.xlsx' file, which can be downloaded below.")),
+ tags$hr(),
+ downloadButton("MasterFile",label = "Download Filterdatabase", icon = "download"),
+ br(),
+ br(),
+ helpText("The currently used '.xlsx' file of the app (template or individual) can be downloaded here.")
+
+
+ ),
+
+ tabPanel("About",
+ h5("Authors"),
+ p("Urs Tilmann Wolpert, Department of Geography, Justus-Liebig-University Giessen (Germany)"),
+ p("Sebastian Kreutzer, IRAMAT-CRP2A, Universite Bordeaux Montaigne (France)"),
+ h5("Contact"),
+ p("urs.t.wolpert at geogr.uni-giessen.de"),
+ tags$hr(),
+ p("This application was developed in framework of an
+ internship at the IRAMAT-CRP2A at the Université Bordeaux Montaigne, France."),
+ p(strong("Due to legal restrictions the app itself comes without any filter data.")),
+ br(),
+ h5("License"),
+ p("This program is free software: you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as
+ published by the Free Software Foundation, either version 3 of
+ the License, or any later version."),
+ p("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",
+ a("GNU General Public License", href = "https://github.com/LaikaNo2/Filter_app/blob/master/LICENSE"),
+ "for more details."),
+ p("The 'chooser.R' R-script and 'chooser-binding.js' Java Script used in this program are taken from the",
+ a("shiny-example", href = "https://github.com/rstudio/shiny-examples"),
+ "repository under the", a("MIT License", href = "https://github.com/rstudio/shiny-examples/blob/master/LICENSE"), ".")
+ )
+)
+)
+
diff --git a/inst/shiny/histogram/Global.R b/inst/shiny/histogram/Global.R
new file mode 100644
index 0000000..4064501
--- /dev/null
+++ b/inst/shiny/histogram/Global.R
@@ -0,0 +1,12 @@
+## global.R ##
+library(Luminescence)
+library(shiny)
+library(RLumShiny)
+library(rhandsontable)
+library(data.table)
+
+# load example data
+data(ExampleData.DeValues)
+data <- ExampleData.DeValues$CA1
+
+enableBookmarking(store = "server")
\ No newline at end of file
diff --git a/inst/shiny/histogram/server.R b/inst/shiny/histogram/server.R
index 7664de0..dc5efc9 100644
--- a/inst/shiny/histogram/server.R
+++ b/inst/shiny/histogram/server.R
@@ -1,22 +1,18 @@
## Server.R
-library(Luminescence)
-library(shiny)
-
-# load example data
-data(ExampleData.DeValues)
-data <- ExampleData.DeValues$CA1
-
## MAIN FUNCTION
-shinyServer(function(input, output, session) {
+function(input, output, session) {
+
+ # input data (with default)
+ values <- reactiveValues(data = ExampleData.DeValues$CA1)
# check and read in file (DATA SET 1)
- datGet<- reactive({
+ observeEvent(input$file1, {
inFile<- input$file1
- if(is.null(inFile)) return(NULL) # if no file was uploaded return NULL
- return(read.table(file = inFile$datapath, # inFile[1] contains filepath
- sep = input$sep,
- quote = "",
- header = input$headers)) # else return file
+
+ if(is.null(inFile))
+ return(NULL) # if no file was uploaded return NULL
+
+ values$data <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
})
@@ -25,30 +21,40 @@ shinyServer(function(input, output, session) {
# check if file is loaded
# # case 1: yes -> slinderInput with custom values
- if(!is.null(datGet())) {
-
- data<- datGet()
- xlim.plot<- range(hist(data[,1], plot = FALSE)$breaks)
-
- sliderInput(inputId = "xlim",
- label = "Range x-axis",
- min = xlim.plot[1]*0.5,
- max = xlim.plot[2]*1.5,
- value = c(xlim.plot[1], xlim.plot[2]), round=FALSE, step=0.0001)
- }
+ xlim.plot<- range(hist(values$data[,1], plot = FALSE)$breaks)
+
+ sliderInput(inputId = "xlim",
+ label = "Range x-axis",
+ min = xlim.plot[1]*0.5,
+ max = xlim.plot[2]*1.5,
+ value = c(xlim.plot[1], xlim.plot[2]), round=FALSE, step=0.0001)
- else { #case 2: no -> sliderInput for example data
-
- xlim.plot<- range(hist(data[,1], plot = FALSE)$breaks)
-
- sliderInput(inputId = "xlim",
- label = "Range x-axis",
- min = xlim.plot[1]*0.5,
- max = xlim.plot[2]*1.5,
- value = c(xlim.plot[1], xlim.plot[2]), round=FALSE, step=0.0001)
- }
})## EndOf::renderUI()
+ output$table_in_primary <- renderRHandsontable({
+ rhandsontable(values$data,
+ height = 300,
+ colHeaders = c("Dose", "Error"),
+ rowHeaders = NULL)
+ })
+
+ observeEvent(input$table_in_primary, {
+
+ # Workaround for rhandsontable issue #138
+ # https://github.com/jrowen/rhandsontable/issues/138
+ # See detailed explanation in abanico application
+ df_tmp <- input$table_in_primary
+ row_names <- as.list(as.character(seq_len(length(df_tmp$data))))
+ df_tmp$params$rRowHeaders <- row_names
+ df_tmp$params$rowHeaders <- row_names
+ df_tmp$params$rDataDim <- as.list(c(length(row_names),
+ length(df_tmp$params$columns)))
+ if (df_tmp$changes$event == "afterRemoveRow")
+ df_tmp$changes$event <- "afterChange"
+
+ if (!is.null(hot_to_r(df_tmp)))
+ values$data <- hot_to_r(df_tmp)
+ })
output$main_plot <- renderPlot({
@@ -66,11 +72,6 @@ shinyServer(function(input, output, session) {
# not available
outputOptions(x = output, name = "xlim", suspendWhenHidden = FALSE)
- # check if file is loaded and overwrite example data
- if(!is.null(datGet())) {
- data<- datGet()
- }
-
progress$set(value = 1)
progress$set(message = "Calculation in progress",
detail = "Get values")
@@ -136,8 +137,8 @@ shinyServer(function(input, output, session) {
progress$set(message = "Calculation in progress",
detail = "Ready to plot")
- args <- list(data = data,
- na.rm = input$naExclude,
+ args <- list(data = values$data,
+ na.rm = TRUE,
cex.global = input$cex,
pch = pch,
xlim = input$xlim,
@@ -155,22 +156,12 @@ shinyServer(function(input, output, session) {
do.call(plot_Histogram, args = args)
# prepare code as text output
- if (is.null(input$sep))
- updateRadioButtons(session, "fileformat", selected = "\t")
-
- if(input$sep == "\t")
- verb.sep<- "\\t"
- else
- verb.sep<- input$sep
-
- str1 <- paste("data <- read.delim(file, header = ",input$headers, ", sep= '", verb.sep,"')",
- sep = "")
-
header <- paste("# To reproduce the plot in your local R environment",
"# copy and run the following code to your R console.",
"library(Luminescence)",
+ "library(data.table)",
"file<- file.choose()",
- str1,
+ "data <- data.table::fread(file, data.table = FALSE)",
"\n",
sep = "\n")
@@ -254,16 +245,9 @@ shinyServer(function(input, output, session) {
table.rows('.selected').data().toArray());
});
}",
-{
- if(!is.null(datGet())) {
- data<- datGet()
- colnames(data)<- c("De","De error")
- data
- } else {
- colnames(data)<- c("De","De error")
- data
- }
- })##EndOf::renterTable()
+ {
+ setNames(values$data, c("De", "De error"))
+ })##EndOf::renterTable()
# reactive function for gVis plots that allow for dynamic input!
@@ -279,22 +263,18 @@ shinyServer(function(input, output, session) {
# central age model (CAM)
output$CAM<- renderDataTable(
options = list(pageLength = 10, autoWidth = FALSE),
-{
- if(!is.null(datGet())) {
- data<- list(datGet())
- } else {
- data<- list(data)
- }
- t<- as.data.frame(matrix(nrow = length(data), ncol = 7))
- colnames(t)<- c("Data set","n", "log data", "Central dose", "SE abs.", "OD (%)", "OD error (%)")
- res<- lapply(data, function(x) { calc_CentralDose(x, verbose = FALSE, plot = FALSE) })
- for(i in 1:length(res)) {
- t[i,1]<- ifelse(i==1,"pimary","secondary")
- t[i,2]<- length(res[[i]]@data$data[,1])
- t[i,3]<- res[[i]]@data$args$log
- t[i,4:7]<- round(res[[i]]@data$summary[1:4],2)
- }
- t
-})##EndOf::renterTable()
+ {
-})##EndOf::shinyServer(function(input, output)
\ No newline at end of file
+ t<- as.data.frame(matrix(nrow = length(list(values$data)), ncol = 7))
+ colnames(t)<- c("Data set","n", "log data", "Central dose", "SE abs.", "OD (%)", "OD error (%)")
+ res<- lapply(list(values$data), function(x) { calc_CentralDose(x, verbose = FALSE, plot = FALSE) })
+ for(i in 1:length(res)) {
+ t[i,1]<- ifelse(i==1,"pimary","secondary")
+ t[i,2]<- length(res[[i]]@data$data[,1])
+ t[i,3]<- res[[i]]@data$args$log
+ t[i,4:7]<- round(res[[i]]@data$summary[1:4],2)
+ }
+ t
+ })##EndOf::renterTable()
+
+}##EndOf::function(input, output)
\ No newline at end of file
diff --git a/inst/shiny/histogram/shiny_bookmarks/0e7f62cc161fbb36/input.rds b/inst/shiny/histogram/shiny_bookmarks/0e7f62cc161fbb36/input.rds
new file mode 100644
index 0000000..bb09c7d
Binary files /dev/null and b/inst/shiny/histogram/shiny_bookmarks/0e7f62cc161fbb36/input.rds differ
diff --git a/inst/shiny/histogram/shiny_bookmarks/1c021999f0efd158/input.rds b/inst/shiny/histogram/shiny_bookmarks/1c021999f0efd158/input.rds
new file mode 100644
index 0000000..2776f5f
Binary files /dev/null and b/inst/shiny/histogram/shiny_bookmarks/1c021999f0efd158/input.rds differ
diff --git a/inst/shiny/histogram/shiny_bookmarks/223e820d2f46b516/input.rds b/inst/shiny/histogram/shiny_bookmarks/223e820d2f46b516/input.rds
new file mode 100644
index 0000000..bb8003d
Binary files /dev/null and b/inst/shiny/histogram/shiny_bookmarks/223e820d2f46b516/input.rds differ
diff --git a/inst/shiny/histogram/ui.R b/inst/shiny/histogram/ui.R
index a251bd1..0bdbc0f 100644
--- a/inst/shiny/histogram/ui.R
+++ b/inst/shiny/histogram/ui.R
@@ -1,361 +1,345 @@
-library(RLumShiny)
-## UI.R
-# load example data
-data(ExampleData.DeValues)
-
-# pageWithSidebar contains three panels:
-# 1 - headerPanel: basically just for a header
-# 2 - sidebarPanel: data input
-# 3 - mainPanel: data output
-pageWithSidebar(
- # 1 - title = NULL -> Panel will not be shown
- headerPanel(title = NULL),
- sidebarPanel(width = 5,
-
- # include a tabs in the input panel for easier navigation
- tabsetPanel(id = "tabs", type = "pill", selected = "Data",
- # Tab 1: Data input
- tabPanel("Data",
- # informational text
- div(align = "center", h5("Data upload")),
- # file upload button (data set 1)
- fileInput(inputId = "file1",
- label = strong("Primary data set"),
- accept="text/plain"),
- tooltip(refId = "file1", text = tags$img(src='file_structure.png', width='250px')),
- # logical: should NA values be excluded?
- checkboxInput(inputId = "naExclude",
- label = "Exclude NA values",
- value = TRUE),
- tooltip(refId = "naExclude", text = "Exclude NA values from the data set prior to any further operations."),
- # logical: file contains headers?
- checkboxInput(inputId = "headers",
- label = "File contains headers",
- value = FALSE),
- tooltip(refId = "headers", text = tags$img(src='file_containsHeader.png', width='250px')),
- # char: columns separated by tab, space, comma
- radioButtons("sep", "Separator", selected = "\t", inline = TRUE,
- c("Tab" = "\t",
- "Space" = " ",
- "Comma" = ",",
- "Semicolon" = ";")),
- tooltip(refId = "sep", text = tags$img(src='file_sep.png', width='400px'), placement = "auto left"),
- hr(),
- actionButton(inputId = "refresh", label = "Refresh", icon = icon("refresh")),
- tooltip(refId = "refresh", text = "Redraw the plot")
- ),##EndOf::Tab_1
-
- # Tab 2: Statistical information
- tabPanel("Statistics",
- fluidRow(
- column(width = 6,
- checkboxInput(inputId = "summary",
- label = "Show summary",
- value = FALSE),
- tooltip(refId = "summary", text = "Adds numerical output to the plot")
- ),
- column(width = 6,
- selectInput(inputId = "sumpos",
- label = "Summary position",
- selected = "topleft",
- choices = list("Subtitle" = "sub",
- "Center" = "center",
- Top=c("Top" = "top",
- "Top left" = "topleft",
- "Top right"= "topright"),
- Bottom=c("Bottom" = "bottom",
- "Bottom left" = "bottomleft",
- "Bottom right" = "bottomright")
- )),
- tooltip(refId = "sumpos", attr = "for", text = "Position of the statistical summary. The keyword \"Subtitle\" will only work if no plot subtitle is used.")
- )
- ),
-
- ## ARG 'SUMMARY.METHOD' NOT YET IMPLEMENTED
- ##
- # selectInput(inputId = "summary.method",
- # label = "Summary method",
- # selected = "unweighted",
- # choices = list("Unweighted" = "unweighted",
- # "Weighted" = "weighted",
- # "Monte Carlo" = "MCM")),
- # tooltip(refId = "summary.method", attr = "for", text = "Keyword indicating the method used to calculate the statistic summary. See calc_Statistics for details."),
-
- checkboxGroupInput(inputId = "stats",
- label = "Parameters",
- selected = c("n","mean"),
- choices = c("n" = "n",
- "Mean" = "mean",
- "Median" = "median",
- "rel. Standard deviation" = "sdrel",
- "abs. Standard deviation" = "sdabs",
- "rel. Standard error" = "serel",
- "abs. Standard error" = "seabs",
- "Skewness" = "skewness",
- "Kurtosis" = "kurtosis"
- # "% in 2 sigma range" = "in.2s"
- )
- ),
- tooltip(refId = "stats", text = "Statistical parameters to be shown in the summary"),
- div(align = "center", h5("Error bars")),
- checkboxInput(inputId = "errorBars",
- label = "Show standard error points",
- value = TRUE),
- tooltip(refId = "errorBars", text = "Plot the standard error points over the histogram.")
- ),##EndOf::Tab_2
-
- # Tab 1: Data input
- tabPanel("Plot",
- div(align = "center", h5("Title")),
- fluidRow(
- column(width = 6,
- textInput(inputId = "main",
- label = "Title",
- value = "Histogram")
- ),
- column(width = 6,
- textInput(inputId = "mtext",
- label = "Subtitle",
- value = "")
- )
- ),
- div(align = "center", h5("Histogram bars")),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "barsColor", label = "Bar color",
- selected = "grey80",
- choices = list("White" = "white",
- "Black" = "black",
- "Grey" = "grey80",
- "Red" = "#b22222",
- "Green" = "#6E8B3D",
- "Blue" = "#428bca",
- "Custom" = "custom"))
- ),
- column(width = 6,
- # show only if custom color is desired
- conditionalPanel(condition = "input.barsColor == 'custom'",
- jscolorInput(inputId = "barsRgb",
- label = "Choose a color"))
- )
- ),
- sliderInput(inputId = "alpha.bars",
- label = "Bar transparency",
- min = 0, max = 100,
- step = 1, value = 66),
- br(),
- div(align = "center", h5("Normal curve")),
- checkboxInput(inputId = "norm",
- label = "Add normal curve",
- value = FALSE),
- tooltip(refId = "norm", text = "Add a normal curve to the histogram. Mean and standard deviation are calculated from the input data. If the normal curve is added, the y-axis in the histogram will show the probability density"),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "normalColor", label = "Normal curve color",
- selected = "red",
- choices = list("Black" = "black",
- "Grey" = "grey50",
- "Red" = "#b22222",
- "Green" = "#6E8B3D",
- "Blue" = "#428bca",
- "Custom" = "custom"))
- ),
- column(width = 6,
- # show only if custom color is desired
- conditionalPanel(condition = "input.normalColor == 'custom'",
- jscolorInput(inputId = "normalRgb",
- label = "Choose a color"))
- )
- ),
- div(align = "center", h5("Scaling")),
- sliderInput(inputId = "cex",
- label = "Scaling factor",
- min = 0.5, max = 2,
- value = 1.0, step = 0.1),
- br(),
- div(align = "center", h5("Rugs")),
- checkboxInput(inputId = "rugs",
- label = "Add rugs",
- value = TRUE),
- tooltip(refId = "rugs", text = "Option to add a rug to the KDE part, to indicate the location of individual values"),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "rugsColor", label = "Rugs color",
- choices = list("Black" = "black",
- "Grey" = "grey50",
- "Red" = "#b22222",
- "Green" = "#6E8B3D",
- "Blue" = "#428bca",
- "Custom" = "custom"))
- ),
- column(width = 6,
- # show only if custom color is desired
- conditionalPanel(condition = "input.rugsColor == 'custom'",
- jscolorInput(inputId = "rugsRgb",
- label = "Choose a color"))
- )
- )
- ),##EndOf::Tab_9
-
- # Tab 4: modify axis parameters
- tabPanel("Axis",
- div(align = "center", h5("X-axis")),
- textInput(inputId = "xlab",
- label = "Label x-axis",
- value = "Equivalent dose [Gy]"),
- # inject sliderInput from Server.R
- uiOutput(outputId = "xlim"),
- div(align = "center", h5("Y-axis")),
- fluidRow(
- column(width = 6,
- textInput(inputId = "ylab1",
- label = "Label y-axis (left)",
- value = "Counts")
- ),
- column(width = 6,
- textInput(inputId = "ylab2",
- label = "Label y-axis (right)",
- value = "Error")
- )
- )
- ),##EndOf::Tab_4
-
- # Tab 5: modify data point representation
- tabPanel("Datapoints",
- div(align = "center", h5("Primary data set")),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "pch",
- label = "Style",
- selected = "17",
- choices = c("Square"= "1",
- "Circle"="2",
- "Triangle point up"="3",
- "Plus"="4",
- "Cross"="5",
- "Diamond"="6",
- "Triangle point down"="7",
- "Square cross"="8",
- "Star"="9",
- "Diamond plus"="10",
- "Circle plus"="11",
- "Triangles up and down"="12",
- "Square plus"="13",
- "Circle cross"="14",
- "Square and Triangle down"="15",
- "filled Square"="16",
- "filled Circle"="17",
- "filled Triangle point up"="18",
- "filled Diamond"="19",
- "solid Circle"="20",
- "Bullet (smaller Circle)"="21",
- "Custom"="custom"))
- ),
- column(width = 6,
- # show only if custom symbol is desired
- conditionalPanel(condition = "input.pch == 'custom'",
- textInput(inputId = "custompch",
- label = "Insert character",
- value = "?"))
- )
- ),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "pchColor", label = "Datapoint color",
- choices = list("Black" = "black",
- "Grey" = "grey50",
- "Red" = "#b22222",
- "Green" = "#6E8B3D",
- "Blue" = "#428bca",
- "Custom" = "custom"))
- ),
- column(width = 6,
- # show only if custom color is desired
- conditionalPanel(condition = "input.pchColor == 'custom'",
- jscolorInput(inputId = "pchRgb",
- label = "Choose a color"))
- )
- )
- ),##EndOf::Tab_5
-
-
- # Tab 9: save plot as pdf, wmf or eps
- tabPanel("Export",
- radioButtons(inputId = "fileformat",
- label = "Fileformat",
- selected = "pdf",
- choices = c("PDF (Portable Document Format)" = "pdf",
- "SVG (Scalable Vector Graphics)" = "svg",
- "EPS (Encapsulated Postscript)" = "eps")),
- textInput(inputId = "filename",
- label = "Filename",
- value = "Histogram"),
- fluidRow(
- column(width = 6,
- numericInput(inputId = "imgheight",
- label = "Image height",
- value = 7)
- ),
- column(width = 6,
- numericInput(inputId = "imgwidth",
- label = "Image width",
- value = 7)
- )
- ),
- selectInput(inputId = "fontfamily",
- label = "Font",
- selected = "Helvetica",
- choices = c("Helvetica" = "Helvetica",
- "Helvetica Narrow" = "Helvetica Narrow",
- "Times" = "Times",
- "Courier" = "Courier",
- "Bookman" = "Bookman",
- "Palatino" = "Palatino")),
- tags$hr(),
- downloadButton(outputId = "exportFile",
- label = "Download plot"),
- tags$hr(),
- helpText("Additionally, you can download a corresponding .R file that contains",
- "a fully functional script to reproduce the plot in your R environment!"),
- downloadButton(outputId = "exportScript",
- label = "Download R script")
- ),##EndOf::Tab_8
-
- # Tab 10: further information
- tabPanel("About",
- hr(),
- div(align = "center",
- # HTML code to include a .png file in the tab; the image file must be in
- # a subfolder called "wwww"
- img(src="RL_Logo.png", height = 100, width = 100, alt = "R.Lum"),
- p("Links:"),
- a(href = "http://www.r-luminescence.de", "R.Luminescence project page", target="_blank"),
+function(request) {
+ fluidPage(
+ titlePanel(NULL, windowTitle = "RLumShiny - Histogram"),
+ sidebarLayout(
+ sidebarPanel(width = 5,
+
+ # include a tabs in the input panel for easier navigation
+ tabsetPanel(id = "tabs", type = "pill", selected = "Data",
+ # Tab 1: Data input
+ tabPanel("Data",
+ # informational text
+ div(align = "center", h5("Data upload")),
+ # file upload button (data set 1)
+ fileInput(inputId = "file1",
+ label = strong("Primary data set"),
+ accept="text/plain, .csv, text/csv"),
+ # rhandsontable input/output
+ fluidRow(
+ column(width = 6,
+ rHandsontableOutput(outputId = "table_in_primary")
+ ),
+ column(width = 6)
+ ),
+ hr(),
+ actionButton(inputId = "refresh", label = "Refresh", icon = icon("refresh")),
+ tooltip(refId = "refresh", text = "Redraw the plot")
+ ),##EndOf::Tab_1
+
+ # Tab 2: Statistical information
+ tabPanel("Statistics",
+ fluidRow(
+ column(width = 6,
+ checkboxInput(inputId = "summary",
+ label = "Show summary",
+ value = FALSE),
+ tooltip(refId = "summary", text = "Adds numerical output to the plot")
+ ),
+ column(width = 6,
+ selectInput(inputId = "sumpos",
+ label = "Summary position",
+ selected = "topleft",
+ choices = list("Subtitle" = "sub",
+ "Center" = "center",
+ Top=c("Top" = "top",
+ "Top left" = "topleft",
+ "Top right"= "topright"),
+ Bottom=c("Bottom" = "bottom",
+ "Bottom left" = "bottomleft",
+ "Bottom right" = "bottomright")
+ )),
+ tooltip(refId = "sumpos", attr = "for", text = "Position of the statistical summary. The keyword \"Subtitle\" will only work if no plot subtitle is used.")
+ )
+ ),
+
+ ## ARG 'SUMMARY.METHOD' NOT YET IMPLEMENTED
+ ##
+ # selectInput(inputId = "summary.method",
+ # label = "Summary method",
+ # selected = "unweighted",
+ # choices = list("Unweighted" = "unweighted",
+ # "Weighted" = "weighted",
+ # "Monte Carlo" = "MCM")),
+ # tooltip(refId = "summary.method", attr = "for", text = "Keyword indicating the method used to calculate the statistic summary. See calc_Statistics for details."),
+
+ checkboxGroupInput(inputId = "stats",
+ label = "Parameters",
+ selected = c("n","mean"),
+ choices = c("n" = "n",
+ "Mean" = "mean",
+ "Median" = "median",
+ "rel. Standard deviation" = "sdrel",
+ "abs. Standard deviation" = "sdabs",
+ "rel. Standard error" = "serel",
+ "abs. Standard error" = "seabs",
+ "Skewness" = "skewness",
+ "Kurtosis" = "kurtosis"
+ # "% in 2 sigma range" = "in.2s"
+ )
+ ),
+ tooltip(refId = "stats", text = "Statistical parameters to be shown in the summary"),
+ div(align = "center", h5("Error bars")),
+ checkboxInput(inputId = "errorBars",
+ label = "Show standard error points",
+ value = TRUE),
+ tooltip(refId = "errorBars", text = "Plot the standard error points over the histogram.")
+ ),##EndOf::Tab_2
+
+ # Tab 1: Data input
+ tabPanel("Plot",
+ div(align = "center", h5("Title")),
+ fluidRow(
+ column(width = 6,
+ textInput(inputId = "main",
+ label = "Title",
+ value = "Histogram")
+ ),
+ column(width = 6,
+ textInput(inputId = "mtext",
+ label = "Subtitle",
+ value = "")
+ )
+ ),
+ div(align = "center", h5("Histogram bars")),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "barsColor", label = "Bar color",
+ selected = "grey80",
+ choices = list("White" = "white",
+ "Black" = "black",
+ "Grey" = "grey80",
+ "Red" = "#b22222",
+ "Green" = "#6E8B3D",
+ "Blue" = "#428bca",
+ "Custom" = "custom"))
+ ),
+ column(width = 6,
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.barsColor == 'custom'",
+ jscolorInput(inputId = "barsRgb",
+ label = "Choose a color"))
+ )
+ ),
+ sliderInput(inputId = "alpha.bars",
+ label = "Bar transparency",
+ min = 0, max = 100,
+ step = 1, value = 66),
br(),
- a(href = "https://forum.r-luminescence.de", "Message board", target="_blank"),
+ div(align = "center", h5("Normal curve")),
+ checkboxInput(inputId = "norm",
+ label = "Add normal curve",
+ value = FALSE),
+ tooltip(refId = "norm", text = "Add a normal curve to the histogram. Mean and standard deviation are calculated from the input data. If the normal curve is added, the y-axis in the histogram will show the probability density"),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "normalColor", label = "Normal curve color",
+ selected = "red",
+ choices = list("Black" = "black",
+ "Grey" = "grey50",
+ "Red" = "#b22222",
+ "Green" = "#6E8B3D",
+ "Blue" = "#428bca",
+ "Custom" = "custom"))
+ ),
+ column(width = 6,
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.normalColor == 'custom'",
+ jscolorInput(inputId = "normalRgb",
+ label = "Choose a color"))
+ )
+ ),
+ div(align = "center", h5("Scaling")),
+ sliderInput(inputId = "cex",
+ label = "Scaling factor",
+ min = 0.5, max = 2,
+ value = 1.0, step = 0.1),
br(),
- a(href = "http://zerk.canopus.uberspace.de/R.Lum", "Online application", target="_blank"),
- br(),hr(),
- img(src='GitHub-Mark-32px.png', width='32px', height='32px'),
- br(),
- a(href = "https://github.com/tzerk/RLumShiny/tree/master/inst/shiny/histogram", "See the code at GitHub!", target="_blank")
- )#/div
- )##EndOf::Tab_9
- )##EndOf::tabsetPanel
- ),##EndOf::sidebarPanel
-
-
- # 3 - output panel
- mainPanel(width = 7,
- # insert css code inside <head></head> of the generated HTML file:
- # allow open dropdown menus to reach over the container
- tags$head(tags$style(type="text/css",".tab-content {overflow: visible;}")),
- tags$head(includeCSS("www/style.css")),
- # divide output in separate tabs via tabsetPanel
- tabsetPanel(
- tabPanel("Plot", plotOutput(outputId = "main_plot", height = "500px")),
- tabPanel("Data set", dataTableOutput("dataset")),
- tabPanel("Central Age Model", dataTableOutput("CAM")),
- tabPanel("R plot code", verbatimTextOutput("plotCode"))
- )###EndOf::tabsetPanel
- )##EndOf::mainPanel
-)##EndOf::shinyUI(pageWithSidebar)
\ No newline at end of file
+ div(align = "center", h5("Rugs")),
+ checkboxInput(inputId = "rugs",
+ label = "Add rugs",
+ value = TRUE),
+ tooltip(refId = "rugs", text = "Option to add a rug to the KDE part, to indicate the location of individual values"),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "rugsColor", label = "Rugs color",
+ choices = list("Black" = "black",
+ "Grey" = "grey50",
+ "Red" = "#b22222",
+ "Green" = "#6E8B3D",
+ "Blue" = "#428bca",
+ "Custom" = "custom"))
+ ),
+ column(width = 6,
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.rugsColor == 'custom'",
+ jscolorInput(inputId = "rugsRgb",
+ label = "Choose a color"))
+ )
+ )
+ ),##EndOf::Tab_9
+
+ # Tab 4: modify axis parameters
+ tabPanel("Axis",
+ div(align = "center", h5("X-axis")),
+ textInput(inputId = "xlab",
+ label = "Label x-axis",
+ value = "Equivalent dose [Gy]"),
+ # inject sliderInput from Server.R
+ uiOutput(outputId = "xlim"),
+ div(align = "center", h5("Y-axis")),
+ fluidRow(
+ column(width = 6,
+ textInput(inputId = "ylab1",
+ label = "Label y-axis (left)",
+ value = "Counts")
+ ),
+ column(width = 6,
+ textInput(inputId = "ylab2",
+ label = "Label y-axis (right)",
+ value = "Error")
+ )
+ )
+ ),##EndOf::Tab_4
+
+ # Tab 5: modify data point representation
+ tabPanel("Datapoints",
+ div(align = "center", h5("Primary data set")),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "pch",
+ label = "Style",
+ selected = "17",
+ choices = c("Square"= "1",
+ "Circle"="2",
+ "Triangle point up"="3",
+ "Plus"="4",
+ "Cross"="5",
+ "Diamond"="6",
+ "Triangle point down"="7",
+ "Square cross"="8",
+ "Star"="9",
+ "Diamond plus"="10",
+ "Circle plus"="11",
+ "Triangles up and down"="12",
+ "Square plus"="13",
+ "Circle cross"="14",
+ "Square and Triangle down"="15",
+ "filled Square"="16",
+ "filled Circle"="17",
+ "filled Triangle point up"="18",
+ "filled Diamond"="19",
+ "solid Circle"="20",
+ "Bullet (smaller Circle)"="21",
+ "Custom"="custom"))
+ ),
+ column(width = 6,
+ # show only if custom symbol is desired
+ conditionalPanel(condition = "input.pch == 'custom'",
+ textInput(inputId = "custompch",
+ label = "Insert character",
+ value = "?"))
+ )
+ ),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "pchColor", label = "Datapoint color",
+ choices = list("Black" = "black",
+ "Grey" = "grey50",
+ "Red" = "#b22222",
+ "Green" = "#6E8B3D",
+ "Blue" = "#428bca",
+ "Custom" = "custom"))
+ ),
+ column(width = 6,
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.pchColor == 'custom'",
+ jscolorInput(inputId = "pchRgb",
+ label = "Choose a color"))
+ )
+ )
+ ),##EndOf::Tab_5
+
+
+ # Tab 9: save plot as pdf, wmf or eps
+ tabPanel("Export",
+ radioButtons(inputId = "fileformat",
+ label = "Fileformat",
+ selected = "pdf",
+ choices = c("PDF (Portable Document Format)" = "pdf",
+ "SVG (Scalable Vector Graphics)" = "svg",
+ "EPS (Encapsulated Postscript)" = "eps")),
+ textInput(inputId = "filename",
+ label = "Filename",
+ value = "Histogram"),
+ fluidRow(
+ column(width = 6,
+ numericInput(inputId = "imgheight",
+ label = "Image height",
+ value = 7)
+ ),
+ column(width = 6,
+ numericInput(inputId = "imgwidth",
+ label = "Image width",
+ value = 7)
+ )
+ ),
+ selectInput(inputId = "fontfamily",
+ label = "Font",
+ selected = "Helvetica",
+ choices = c("Helvetica" = "Helvetica",
+ "Helvetica Narrow" = "Helvetica Narrow",
+ "Times" = "Times",
+ "Courier" = "Courier",
+ "Bookman" = "Bookman",
+ "Palatino" = "Palatino")),
+ tags$hr(),
+ downloadButton(outputId = "exportFile",
+ label = "Download plot"),
+ tags$hr(),
+ helpText("Additionally, you can download a corresponding .R file that contains",
+ "a fully functional script to reproduce the plot in your R environment!"),
+ downloadButton(outputId = "exportScript",
+ label = "Download R script")
+ ),##EndOf::Tab_8
+
+ # Tab 10: further information
+ tabPanel("About",
+ hr(),
+ div(align = "center",
+ # HTML code to include a .png file in the tab; the image file must be in
+ # a subfolder called "wwww"
+ img(src="RL_Logo.png", height = 100, width = 100, alt = "R.Lum"),
+ p("Links:"),
+ a(href = "http://www.r-luminescence.de", "R.Luminescence project page", target="_blank"),
+ br(),
+ a(href = "https://forum.r-luminescence.de", "Message board", target="_blank"),
+ br(),
+ a(href = "http://zerk.canopus.uberspace.de/R.Lum", "Online application", target="_blank"),
+ br(),hr(),
+ img(src='GitHub-Mark-32px.png', width='32px', height='32px'),
+ br(),
+ a(href = "https://github.com/tzerk/RLumShiny/tree/master/inst/shiny/histogram", "See the code at GitHub!", target="_blank")
+ )#/div
+ )##EndOf::Tab_9
+ )##EndOf::tabsetPanel
+ ),##EndOf::sidebarPanel
+
+
+ # 3 - output panel
+ mainPanel(width = 7,
+ # insert css code inside <head></head> of the generated HTML file:
+ # allow open dropdown menus to reach over the container
+ tags$head(tags$style(type="text/css",".tab-content {overflow: visible;}")),
+ tags$head(includeCSS("www/style.css")),
+ # divide output in separate tabs via tabsetPanel
+ tabsetPanel(
+ tabPanel("Plot", plotOutput(outputId = "main_plot", height = "500px")),
+ tabPanel("Data set", dataTableOutput("dataset")),
+ tabPanel("Central Age Model", dataTableOutput("CAM")),
+ tabPanel("R plot code", verbatimTextOutput("plotCode"))
+ )###EndOf::tabsetPanel
+ )##EndOf::mainPanel
+ ),##EndOf::sideBarLayout
+ bookmarkButton()
+ )##EndOf::fluidPage
+}
\ No newline at end of file
diff --git a/inst/shiny/histogram/www/file_containsHeader.png b/inst/shiny/histogram/www/file_containsHeader.png
deleted file mode 100644
index 7abe3d2..0000000
Binary files a/inst/shiny/histogram/www/file_containsHeader.png and /dev/null differ
diff --git a/inst/shiny/histogram/www/file_sep.png b/inst/shiny/histogram/www/file_sep.png
deleted file mode 100644
index 0297e61..0000000
Binary files a/inst/shiny/histogram/www/file_sep.png and /dev/null differ
diff --git a/inst/shiny/histogram/www/file_structure.png b/inst/shiny/histogram/www/file_structure.png
deleted file mode 100644
index 5e3b50a..0000000
Binary files a/inst/shiny/histogram/www/file_structure.png and /dev/null differ
diff --git a/inst/shiny/histogram/www/style.css b/inst/shiny/histogram/www/style.css
index 1f85dfc..e6a055a 100644
--- a/inst/shiny/histogram/www/style.css
+++ b/inst/shiny/histogram/www/style.css
@@ -20,7 +20,6 @@
h5, h6 {
color: #428bca;
- font-weight: 700;
}
.tooltip-inner {
@@ -38,7 +37,6 @@ h5, h6 {
label, body, input {
font-size: 12px;
- font-weight: 100 !important;
}
.label, .badge {
@@ -46,7 +44,6 @@ label, body, input {
padding: 4px 20px;
margin: 10px;
line-height: 18px;
- font-weight: 100 !important;
}
.label-info, .badge-info {
diff --git a/inst/shiny/radialplot/Global.R b/inst/shiny/radialplot/Global.R
new file mode 100644
index 0000000..55a7e10
--- /dev/null
+++ b/inst/shiny/radialplot/Global.R
@@ -0,0 +1,11 @@
+## global.R ##
+library(Luminescence)
+library(RLumShiny)
+library(shiny)
+library(data.table)
+library(rhandsontable)
+
+# load example data
+data(ExampleData.DeValues)
+
+enableBookmarking(store = "server")
\ No newline at end of file
diff --git a/inst/shiny/radialplot/server.R b/inst/shiny/radialplot/server.R
index be7ba7e..d76413f 100644
--- a/inst/shiny/radialplot/server.R
+++ b/inst/shiny/radialplot/server.R
@@ -1,156 +1,145 @@
## Server.R
-library(Luminescence)
-library(shiny)
-
-# load example data
-data(ExampleData.DeValues)
-data <- ExampleData.DeValues$CA1
-
## MAIN FUNCTION
-shinyServer(function(input, output, session) {
+function(input, output, session) {
+
+ # input data (with default)
+ values <- reactiveValues(data_primary = ExampleData.DeValues$CA1,
+ data_secondary = setNames(as.data.frame(matrix(NA_real_, nrow = 5, ncol = 2)), c("x", "y")))
# check and read in file (DATA SET 1)
- datGet<- reactive({
+ observeEvent(input$file1, {
inFile<- input$file1
- if(is.null(inFile)) return(NULL) # if no file was uploaded return NULL
- return(read.table(file = inFile$datapath, # inFile[1] contains filepath
- sep = input$sep,
- quote = "",
- header = input$headers)) # else return file
+
+ if(is.null(inFile))
+ return(NULL) # if no file was uploaded return NULL
+
+ values$data_primary <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
})
# check and read in file (DATA SET 2)
- datGet2<- reactive({
- inFile2<- input$file2
- if(is.null(inFile2)) return(NULL) # if no file was uploaded return NULL
- return(read.table(file = inFile2$datapath, # inFile[1] contains filepath
- sep = input$sep,
- quote = "",
- header = input$headers)) # else return file
+ observeEvent(input$file2, {
+ inFile<- input$file2
+
+ if(is.null(inFile))
+ return(NULL) # if no file was uploaded return NULL
+
+ values$data_secondary <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
+ })
+
+ ### GET DATA SETS
+ Data<- reactive({
+
+ ### GET DATA
+ data <- list(values$data_primary, values$data_secondary)
+ data <- lapply(data, function(x) {
+ x_tmp <- x[complete.cases(x), ]
+ if (nrow(x_tmp) == 0) return(NULL)
+ else return(x_tmp)
+ })
+ data <- data[!sapply(data, is.null)]
+ data <- lapply(data, function(x) setNames(x, c("Dose", "Error")))
+
+ return(data)
})
+ output$table_in_primary <- renderRHandsontable({
+ rhandsontable(values$data_primary,
+ height = 300,
+ colHeaders = c("Dose", "Error"),
+ rowHeaders = NULL)
+ })
+
+ observeEvent(input$table_in_primary, {
+
+ # Workaround for rhandsontable issue #138
+ # https://github.com/jrowen/rhandsontable/issues/138
+ df_tmp <- input$table_in_primary
+ row_names <- as.list(as.character(seq_len(length(df_tmp$data))))
+
+ df_tmp$params$rRowHeaders <- row_names
+ df_tmp$params$rowHeaders <- row_names
+ df_tmp$params$rDataDim <- as.list(c(length(row_names),
+ length(df_tmp$params$columns)))
+
+ if (df_tmp$changes$event == "afterRemoveRow")
+ df_tmp$changes$event <- "afterChange"
+
+ if (!is.null(hot_to_r(df_tmp)))
+ values$data_primary <- hot_to_r(df_tmp)
+ })
+
+ output$table_in_secondary <- renderRHandsontable({
+
+ rhandsontable(values$data_secondary,
+ height = 300,
+ colHeaders = c("Dose", "Error"),
+ rowHeaders = NULL)
+ })
+
+
+ observeEvent(input$table_in_secondary, {
+
+ # Workaround for rhandsontable issue #138
+ # https://github.com/jrowen/rhandsontable/issues/138
+ df_tmp <- input$table_in_secondary
+ row_names <- as.list(as.character(seq_len(length(df_tmp$data))))
+ df_tmp$params$rRowHeaders <- row_names
+ df_tmp$params$rowHeaders <- row_names
+ df_tmp$params$rDataDim <- as.list(c(length(row_names),
+ length(df_tmp$params$columns)))
+ if (df_tmp$changes$event == "afterRemoveRow")
+ df_tmp$changes$event <- "afterChange"
+
+ if (!is.null(hot_to_r(df_tmp)))
+ values$data_secondary <- hot_to_r(df_tmp)
+
+ })
# dynamically inject sliderInput for central value
output$centValue<- renderUI({
- # check if file is loaded
- # # case 1: yes -> slinderInput with custom values
- if(!is.null(datGet())) {
- if(!is.null(datGet2())) {
- centValue.data<- rbind(datGet(),datGet2())
- sliderInput(inputId = "centValue",
- label = "Central Value",
- min = min(centValue.data[,1])*0.9,
- max = max(centValue.data[,1])*1.1,
- value = mean(centValue.data[,1]))
- } else {
- data<- datGet()
- sliderInput(inputId = "centValue",
- label = "Central Value",
- min = min(data[,1])*0.9,
- max = max(data[,1])*1.1,
- value = mean(data[,1]))
- }
-
- }
- else { #case 2: no -> sliderInput for example data
- sliderInput(inputId = "centValue",
- label = "Central Value",
- min = min(data[,1])*0.9,
- max = max(data[,1])*1.1,
- value = mean(data[,1]),
- step = 1, round = 0)
- }
+ centValue.data <- do.call(rbind, Data())
+
+ sliderInput(inputId = "centValue",
+ label = "Central Value",
+ min = min(centValue.data[,1])*0.9,
+ max = max(centValue.data[,1])*1.1,
+ value = mean(centValue.data[,1]))
})## EndOf::renderUI()
# dynamically inject sliderInput for z-axis range
output$xlim<- renderUI({
- # check if file is loaded
- # # case 1: yes -> slinderInput with custom values
- if(!is.null(datGet())) {
- if(!is.null(datGet2())) {
-
- xlim.data<- rbind(datGet(),datGet2())
-
- if(input$logz == TRUE) {
- sd<- xlim.data[,2] / xlim.data[,1]
- } else {
- sd<- xlim.data[,2]
- }
- prec<- 1/sd
-
- sliderInput(inputId = "xlim",
- label = "Range x-axis",
- min = 0,
- max = max(prec)*2,
- value = c(0, max(prec)*1.05), round=FALSE, step=0.0001)
- } else {
- data<- datGet()
-
- if(input$logz == TRUE) {
- sd<- data[,2] / data[,1]
- } else {
- sd<- data[,2]
- }
- prec<- 1/sd
-
- sliderInput(inputId = "xlim",
- label = "Range x-axis",
- min = 0,
- max = max(prec)*2,
- value = c(0, max(prec)*1.05), round=FALSE, step=0.0001)
- }
+ xlim.data<- do.call(rbind, Data())
+
+ if(input$logz == TRUE) {
+ sd<- xlim.data[,2] / xlim.data[,1]
+ } else {
+ sd<- xlim.data[,2]
}
- else { #case 2: no -> sliderInput for example data
- if(input$logz == TRUE) {
- sd<- data[,2] / data[,1]
- } else {
- sd<- data[,2]
+
+ prec<- 1/sd
+
+ sliderInput(inputId = "xlim",
+ label = "Range x-axis",
+ min = 0,
+ max = max(prec)*2,
+ value = c(0, max(prec)*1.05), round=FALSE, step=0.0001)
- }
- prec<- 1/sd
-
- sliderInput(inputId = "xlim",
- label = "Range x-axis",
- min = 0,
- max = max(prec)*2,
- value = c(0, max(prec)*1.05), round=FALSE, step=0.0001)
- }
})## EndOf::renderUI()
# dynamically inject sliderInput for z-axis range
output$zlim<- renderUI({
- # check if file is loaded
- # # case 1: yes -> slinderInput with custom values
- if(!is.null(datGet())) {
- if(!is.null(datGet2())) {
- zlim.data<- rbind(datGet(),datGet2())
- sliderInput(inputId = "zlim",
- label = "Range z-axis",
- min = min(zlim.data[,1])*0.25,
- max = max(zlim.data[,1])*1.75,
- value = c(min(zlim.data[,1])*0.8, max(zlim.data[,1])*1.2))
- } else {
- data<- datGet()
- sliderInput(inputId = "zlim",
- label = "Range z-axis",
- min = min(data[,1])*0.25,
- max = max(data[,1])*1.75,
- value = c(min(data[,1])*0.8, max(data[,1])*1.2))
- }
- }
- else { #case 2: no -> sliderInput for example data
- sliderInput(inputId = "zlim",
- label = "Range z-axis",
- min = min(data[,1])*0.25,
- max = max(data[,1])*1.75,
- value = c(min(data[,1])*0.8, max(data[,1]))*1.2,
- step = 1, round = 0)
- }
+ zlim.data<- do.call(rbind, Data())
+ sliderInput(inputId = "zlim",
+ label = "Range z-axis",
+ min = min(zlim.data[,1])*0.25,
+ max = max(zlim.data[,1])*1.75,
+ value = c(min(zlim.data[,1])*0.8, max(zlim.data[,1])*1.2))
+
})## EndOf::renderUI()
# render Radial Plot
@@ -173,18 +162,7 @@ shinyServer(function(input, output, session) {
outputOptions(x = output, name = "xlim", suspendWhenHidden = FALSE)
# check if file is loaded and overwrite example data
- if(!is.null(datGet())) {
- data<- datGet()
- }
- if(!is.null(datGet2())) {
- data2<- datGet2()
- }
-
- if(is.null(datGet()) == FALSE && is.null(datGet2()) == FALSE) {
- data<- datGet()
- data2<- datGet2()
- data<- list(data, data2)
- }
+ data <- Data()
progress$set(value = 1)
progress$set(message = "Calculation in progress",
@@ -204,7 +182,7 @@ shinyServer(function(input, output, session) {
color<- input$color
}
- if(!is.null(datGet2())) {
+ if(!all(is.na(unlist(values$data_secondary)))) {
# if custom datapoint color get RGB code from separate input panel
if(input$color2 == "custom") {
color2<- input$rgb2
@@ -316,7 +294,7 @@ shinyServer(function(input, output, session) {
legend<- c(NA,NA)
legend.pos<- c(-999,-999)
} else {
- if(!is.null(datGet2()))
+ if(!all(is.na(unlist(values$data_secondary))))
{
legend<- c(input$legendname, input$legendname2)
legend.pos<- input$legend.pos
@@ -363,7 +341,7 @@ shinyServer(function(input, output, session) {
summary.pos = input$sumpos,
legend = legend,
legend.pos = legend.pos,
- na.rm = input$naExclude,
+ na.rm = TRUE,
central.value = input$centValue,
centrality = input$centrality,
lwd = c(input$lwd, input$lwd2),
@@ -373,29 +351,19 @@ shinyServer(function(input, output, session) {
do.call(plot_RadialPlot, args = args)
# prepare code as text output
- if (is.null(input$sep))
- updateRadioButtons(session, "fileformat", selected = "\t")
-
- if(input$sep == "\t")
- verb.sep<- "\\t"
- else
- verb.sep<- input$sep
-
- str1 <- paste("data <- read.delim(file, header = ",input$headers, ", sep= '", verb.sep,"')",
- sep = "")
-
- if(!is.null(datGet2())) {
- str2 <- "file2<- file.choose()"
- str3 <- paste("data2 <- read.delim(file2, header = ",input$headers, ", sep= '", verb.sep,"')",
- sep= "")
- str4 <- "data<- list(data, data2)"
+ str1 <- "data <- data.table::fread(file, data.table = FALSE)"
+
+ if(!all(is.na(unlist(values$data_secondary)))) {
+ str2 <- "file2 <- file.choose()"
+ str3 <- "data2 <- data.table::fread(file2, data.table = FALSE)"
+ str4 <- "data <- list(data, data2)"
str1 <- paste(str1, str2, str3, str4, sep = "\n")
}
header <- paste("# To reproduce the plot in your local R environment",
"# copy and run the following code to your R console.",
"library(Luminescence)",
- "file<- file.choose()",
+ "file <- file.choose()",
str1,
"\n",
sep = "\n")
@@ -480,15 +448,11 @@ shinyServer(function(input, output, session) {
table.rows('.selected').data().toArray());
});
}",
-{
- if(!is.null(datGet())) {
- data<- datGet()
- colnames(data)<- c("De","De error")
- data
- } else {
- colnames(data)<- c("De","De error")
- data
- }
+ {
+ data<- Data()[[1]]
+ colnames(data)<- c("De","De error")
+
+ data
})##EndOf::renterTable()
# renderTable() that prints the secondary data to the second tab
@@ -502,8 +466,8 @@ output$dataset2<- renderDataTable(
});
}",
{
- if(!is.null(datGet2())) {
- data<- datGet2()
+ if(!all(is.na(unlist(values$data_secondary)))) {
+ data<- Data()[[2]]
colnames(data)<- c("De","De error")
data
} else {
@@ -516,15 +480,9 @@ output$dataset2<- renderDataTable(
output$CAM<- renderDataTable(
options = list(pageLength = 10, autoWidth = FALSE),
{
- if(!is.null(datGet())) {
- if(!is.null(datGet2())) {
- data<- list(datGet(), datGet2())
- } else {
- data<- list(datGet())
- }
- } else {
- data<- list(data)
- }
+
+ data <- Data()
+
t<- as.data.frame(matrix(nrow = length(data), ncol = 7))
colnames(t)<- c("Data set","n", "log data", "Central dose", "SE abs.", "OD (%)", "OD error (%)")
res<- lapply(data, function(x) { calc_CentralDose(x, verbose = FALSE, plot = FALSE) })
@@ -537,4 +495,4 @@ output$dataset2<- renderDataTable(
t
})##EndOf::renterTable()
-})##EndOf::shinyServer(function(input, output)
\ No newline at end of file
+}##EndOf::shinyServer(function(input, output)
\ No newline at end of file
diff --git a/inst/shiny/radialplot/shiny_bookmarks/1e0f5bee0eebca8d/input.rds b/inst/shiny/radialplot/shiny_bookmarks/1e0f5bee0eebca8d/input.rds
new file mode 100644
index 0000000..3b7dbfd
Binary files /dev/null and b/inst/shiny/radialplot/shiny_bookmarks/1e0f5bee0eebca8d/input.rds differ
diff --git a/inst/shiny/radialplot/ui.R b/inst/shiny/radialplot/ui.R
index cb005f0..9949d21 100644
--- a/inst/shiny/radialplot/ui.R
+++ b/inst/shiny/radialplot/ui.R
@@ -1,606 +1,583 @@
-library(RLumShiny)
## UI.R
-
-# load example data
-data(ExampleData.DeValues)
-
-# pageWithSidebar contains three panels:
-# 1 - headerPanel: basically just for a header
-# 2 - sidebarPanel: data input
-# 3 - mainPanel: data output
-pageWithSidebar(
- # 1 - title = NULL -> Panel will not be shown
- headerPanel(title = NULL),
- # 2- width = 5 -> refers to twitters bootstrap grid system
- # where the the maximum width is 12 that is to be shared between all
- # elements
- sidebarPanel(width = 5,
- # include a tabs in the input panel for easier navigation
- tabsetPanel(id = "tabs", type = "pill", selected = "Data",
- # Tab 1: Data input
- tabPanel("Data",
- # informational text
- div(align = "center", h5("Data upload")),
- # file upload button (data set 1)
- fileInput(inputId = "file1",
- label = strong("Primary data set"),
- accept="text/plain"),
- tooltip(refId = "file1", text = tags$img(src='file_structure.png', width='250px')),
- # file upload button (data set 2)
- fileInput(inputId = "file2",
- label = strong("Secondary data set"),
- accept="text/plain"),
- tooltip(refId = "file2", text = tags$img(src='file_structure.png', width='250px')),
- # informational text
- div(align = "center", h5("Settings")),
- fluidRow(
- column(width = 6,
- # logical: should NA values be excluded?
- checkboxInput(inputId = "naExclude",
- label = "Exclude NA values",
- value = TRUE),
- tooltip(refId = "naExclude", text = "Exclude NA values from the data set prior to any further operations.")
- ),
- column(width = 6,
- # logical: file contains headers?
- checkboxInput(inputId = "headers",
- label = "File contains headers",
- value = FALSE),
- tooltip(refId = "headers", text = tags$img(src='file_containsHeader.png', width='250px'))
- )),
- # char: columns separated by tab, space, comma
- radioButtons("sep", "Separator", selected = "\t", inline = TRUE,
- c("Tab" = "\t",
- "Space" = " ",
- "Comma" = ",",
- "Semicolon" = ";")),
- tooltip(refId = "sep", text = tags$img(src='file_sep.png', width='400px'), placement = "auto left"),
- hr(),
- actionButton(inputId = "refresh", label = "Refresh", icon = icon("refresh")),
- tooltip(refId = "refresh", text = "Redraw the plot")
- ),##EndOf::Tab_1
-
- # Tab 2: Statistical information
- tabPanel("Statistics",
- div(align = "center", h5("Summary")),
- fluidRow(
- column(width = 6,
- checkboxInput(inputId = "summary",
- label = "Show summary",
- value = FALSE),
- tooltip(refId = "summary", text = "Adds numerical output to the plot")
- ),
- column(width = 6,
- selectInput(inputId = "sumpos",
- label = "Summary position",
- selected = "topleft",
- choices = list("Subtitle" = "sub",
- "Center" = "center",
- Top=c("Top" = "top",
- "Top left" = "topleft",
- "Top right"= "topright"),
- Bottom=c("Bottom" = "bottom",
- "Bottom left" = "bottomleft",
- "Bottom right" = "bottomright")
- )),
- tooltip(refId = "sumpos", attr = "for", text = "Position of the statistical summary. The keyword \"Subtitle\" will only work if no plot subtitle is used.")
- )
- ),
- checkboxGroupInput(inputId = "stats",
- label = "Parameters",
- selected = c("n","mean"),
- choices = c("n" = "n",
- "Mean" = "mean",
- "weighted Mean" = "mean.weighted",
- "Median" = "median",
- "weighted Median" = "median.weighted",
- "rel. Standard deviation" = "sdrel",
- "abs. Standard deviation" = "sdabs",
- "rel. Standard error" = "serel",
- "abs. Standard error" = "seabs",
- #"25 % Quartile" = "q25", #not implemented yet
- #"75 % Quartile" = "q75", #not implemented yet
- "KDEmax" = "kdemax",
- "Skewness" = "skewness",
- "Kurtosis" = "kurtosis"
- )),
- tooltip(refId = "stats", text = "Statistical parameters to be shown in the summary"),
- br(),
- div(align = "center", h5("Datapoint labels")),
- div(align = "center", checkboxGroupInput(inputId = "statlabels", inline = TRUE,
- label = NULL,
- choices = c("Min" = "min",
- "Max" = "max",
- "Median" = "median"))),
- tooltip(refId = "statlabels", text = "Additional labels of statistically important values in the plot.")
- ),##EndOf::Tab_2
-
- # Tab 3: input that refer to the plot rather than the data
- tabPanel("Plot",
- div(align = "center", h5("Title")),
- fluidRow(
- column(width = 6,
- textInput(inputId = "main",
- label = "Title",
- value = "Radial Plot")
- ),
- column(width = 6,
- textInput(inputId = "mtext",
- label = "Subtitle",
- value = "")
- )
- ),
- div(align = "center", h5("Scaling")),
- fluidRow(
- column(width = 6,
- # inject sliderInput from Server.R
- uiOutput(outputId = "centValue"),
- tooltip(refId = "centValue", text = "User-defined central value, primarily used for horizontal centering of the z-axis")
- ),
- column(width = 6,
- sliderInput(inputId = "cex",
- label = "Scaling factor",
- min = 0.5, max = 2,
- value = 1.0, step = 0.1)
- )
- ),
- selectInput(inputId = "centrality",
- label = "Centrality",
- list("Mean" = "mean",
- "Median" = "median",
- "Weighted mean" = "mean.weighted",
- "Weighted median" = "median.weighted")),
- tooltip(refId = "centrality", attr = "for", text = "Measure of centrality, used for the standardisation, centering the plot and drawing the central line.")
- ),##EndOf::Tab_3
-
- # Tab 4: modify axis parameters
- tabPanel("Axis",
- div(align = "center", h5("X-axis")),
- fluidRow(
- column(width = 6,
- textInput(inputId = "xlab1",
- label = "Label x-axis (upper)",
- value = "Relative error [%]")
- ),
- column(width = 6,
- textInput(inputId = "xlab2",
- label = "Label x-axis (lower)",
- value = "Precision")
- )
- ),
- # inject sliderInput from Server.R
- uiOutput(outputId = "xlim"),
- div(align = "center", h5("Y-axis")),
- checkboxInput(inputId = "yticks",
- label = HTML("Show ±2σ label"),
- value = TRUE),
- tooltip(refId = "yticks", text = "Option to hide y-axis labels."),
- textInput(inputId = "ylab",
- label = "Label y-axis",
- value = "Standardised estimate"),
- div(align = "center", h5("Z-axis")),
- checkboxInput(inputId = "logz",
- label = "Logarithmic z-axis",
- value = TRUE),
- tooltip(refId = "logz", text = "Option to display the z-axis in logarithmic scale."),
- textInput(inputId = "zlab",
- label = "Label z-axis",
- value = "Equivalent dose [Gy]"),
- # inject sliderInput from Server.R
- uiOutput(outputId = "zlim"),
- sliderInput('curvature', 'Z-axis curvature',
- min=0, max=3,
- value=4.5/5.5, step=0.01, round=FALSE),
- tooltip(refId = "curvature", attr = "for", text = "User-defined plot area ratio (i.e. curvature of the z-axis). If omitted, the default value (4.5/5.5) is used and modified automatically to optimise the z-axis curvature. The parameter should be decreased when data points are plotted outside the z-axis or when the z-axis gets too elliptic.")
- ),##EndOf::Tab_4
-
- # Tab 5: modify data point representation
- tabPanel("Datapoints",
- div(align = "center", h5("Primary data set")),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "pch",
- label = "Style",
- selected = "17",
- choices = c("Square"= "1",
- "Circle"="2",
- "Triangle point up"="3",
- "Plus"="4",
- "Cross"="5",
- "Diamond"="6",
- "Triangle point down"="7",
- "Square cross"="8",
- "Star"="9",
- "Diamond plus"="10",
- "Circle plus"="11",
- "Triangles up and down"="12",
- "Square plus"="13",
- "Circle cross"="14",
- "Square and Triangle down"="15",
- "filled Square"="16",
- "filled Circle"="17",
- "filled Triangle point up"="18",
- "filled Diamond"="19",
- "solid Circle"="20",
- "Bullet (smaller Circle)"="21",
- "Custom"="custom"))
- ),
- column(width = 6,
- # show only if custom symbol is desired
- conditionalPanel(condition = "input.pch == 'custom'",
- textInput(inputId = "custompch",
- label = "Insert character",
- value = "?"))
- )
- ),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "color", label = "Datapoint color",
- choices = list("Black" = "black",
- "Grey" = "grey50",
- "Red" = "#b22222",
- "Green" = "#6E8B3D",
- "Blue" = "#428bca",
- "Custom" = "custom"))
- ),
- column(width = 6,
- # show only if custom color is desired
- conditionalPanel(condition = "input.color == 'custom'",
- jscolorInput(inputId = "rgb",
- label = "Choose a color"))
- )
- ),
- div(align = "center", h5("Secondary data set")),
- fluidRow(
- column(width = 6,
- ## DATA SET 2
- selectInput(inputId = "pch2",
- label = "Style",
- selected = "17",
- choices = c("Square"= "1",
- "Circle"="2",
- "Triangle point up"="3",
- "Plus"="4",
- "Cross"="5",
- "Diamond"="6",
- "Triangle point down"="7",
- "Square cross"="8",
- "Star"="9",
- "Diamond plus"="10",
- "Circle plus"="11",
- "Triangles up and down"="12",
- "Square plus"="13",
- "Circle cross"="14",
- "Square and Triangle down"="15",
- "filled Square"="16",
- "filled Circle"="17",
- "filled Triangle point up"="18",
- "filled Diamond"="19",
- "solid Circle"="20",
- "Bullet (smaller Circle)"="21",
- "Custom"="custom"))
- ),
- column(width = 6,
- # show only if custom symbol is desired
- conditionalPanel(condition = "input.pch2 == 'custom'",
- textInput(inputId = "custompch2",
- label = "Insert character",
- value = "?"))
- )
- ),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "color2", label = "Datapoint color",
- selected = "#b22222",
- choices = list("Black" = "black",
- "Grey" = "grey50",
- "Red" = "#b22222",
- "Green" = "#6E8B3D",
- "Blue" = "#428bca",
- "Custom" = "custom"))
- ),
- column(width = 6,
- # show only if custom color is desired
- conditionalPanel(condition = "input.color2 == 'custom'",
- jscolorInput(inputId = "rgb2",
- label = "Choose a color"))
- )
- )
- ),##EndOf::Tab_5
-
- # Tab 6: add additional lines to the plot
- tabPanel("Lines",
- helpText("Here you can add additional lines."),
- # options for custom lines:
- # 1 - z-value, 2 - color, 3 - label
- # only the options for the first line are shown
- numericInput(inputId = "line1",
- label = strong("Line #1"),
- value = NA, min = 0),
- tooltip(refId = "line1", text = "Numeric values of the additional lines to be added."),
- fluidRow(
- column(width = 6,
- HTML("Choose a color<br>"),
- jscolorInput(inputId = "colline1")
- ),
- column(width = 6,
- textInput(inputId = "labline1",
- label = "Label",
- value = "")
- )
- ),
- # conditional chain: if valid input (i.e. the z-value is > 0) is provided
- # for the previous line, show options for a new line (currently up to eight)
- conditionalPanel(condition = "input.line1 > 0",
- numericInput(inputId = "line2", strong("Line #2"), NA, min = 0),
- fluidRow(
- column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline2")),
- column(width = 6, textInput("labline2","Label",value = ""))
- )
- ),
- conditionalPanel(condition = "input.line2 > 0",
- numericInput(inputId = "line3", strong("Line #3"), NA, min = 0),
- fluidRow(
- column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline3")),
- column(width = 6, textInput("labline3","Label",value = ""))
- )
- ),
-
- conditionalPanel(condition = "input.line3 > 0",
- numericInput(inputId = "line4", strong("Line #4"), NA, min = 0),
- fluidRow(
- column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline4")),
- column(width = 6, textInput("labline4","Label",value = ""))
- )
- ),
-
- conditionalPanel(condition = "input.line4 > 0",
- numericInput(inputId = "line5", strong("Line #5"), NA, min = 0),
- fluidRow(
- column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline5")),
- column(width = 6, textInput("labline5","Label",value = ""))
- )
- ),
-
- conditionalPanel(condition = "input.line5 > 0",
- numericInput(inputId = "line6", strong("Line #6"), NA, min = 0),
- fluidRow(
- column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline6")),
- column(width = 6, textInput("labline6","Label",value = ""))
- )
- ),
-
- conditionalPanel(condition = "input.line6 > 0",
- numericInput(inputId = "line7", strong("Line #7"), NA, min = 0),
- fluidRow(
- column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline7")),
- column(width = 6, textInput("labline7","Label",value = ""))
- )
- ),
-
- conditionalPanel(condition = "input.line7 > 0",
- numericInput(inputId = "line8", strong("Line #8"), NA, min = 0),
- fluidRow(
- column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline8")),
- column(width = 6, textInput("labline8","Label",value = ""))
- )
- )
-
- ),##EndOf::Tab_6
-
- # Tab 7: modify the 2-sigma bar (radial plot), grid (both) and polygon (KDE)
- tabPanel("Bars & Grid",
- div(align = "center", h5("Central line")),
- fluidRow(
- column(width = 6,
- numericInput(inputId = "lwd",
- label = "Central line width #1",
- min = 0, max = 5,
- value = 1)
- ),
- column(width = 6,
- numericInput(inputId = "lwd2",
- label = "Central line width #2",
- min = 0, max = 5,
- value = 1)
- )
- ),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "lty",
- label = "Line type",
- selected = 2,
- choices = list("Blank" = 0,
- "Solid" = 1,
- "Dashed" = 2,
- "Dotted" = 3,
- "Dot dash" = 4,
- "Long dash" = 5,
- "Two dash" = 6))
- ),
- column(width = 6,
- selectInput(inputId = "lty2",
- label = "Line type",
- selected = 2,
- choices = list("Blank" = 0,
- "Solid" = 1,
- "Dashed" = 2,
- "Dotted" = 3,
- "Dot dash" = 4,
- "Long dash" = 5,
- "Two dash" = 6))
-
- )
- ),
- div(align = "center", HTML("<h5>2σ bar</h5>")),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "bar", label = HTML("2σ bar color"),
- choices = list("Grey" = "grey50",
- "Custom" = "custom",
- "None" = "none"))
- ),
- column(width = 6,
- selectInput(inputId = "bar2", label = HTML("2σ bar color #2"),
- choices = list("Grey" = "grey50",
- "Custom" = "custom",
- "None" = "none"))
- )
- ),
- fluidRow(
- column(width = 6,
- # show only if custom color is desired
- conditionalPanel(condition = "input.bar == 'custom'",
- jscolorInput(inputId = "rgbBar",
- label = "Choose a color"))
- ),
- column(width = 6,
-
- # show only if custom color is desired
- conditionalPanel(condition = "input.bar2 == 'custom'",
- jscolorInput(inputId = "rgbBar2",
- label = "Choose a color"))
- )
- ),
- sliderInput(inputId = "alpha.bar",
- label = "Transparency",
- min = 0, max = 100,
- step = 1, value = 66),
- div(align = "center", h5("Grid")),
- fluidRow(
- column(width = 6,
- selectInput("grid", "Grid color",
- list("Grey" = "grey",
- "Custom" = "custom",
- "None" = "none")),
- tooltip(refId = "grid", attr = "for", text = "colour of the grid lines (originating at [0,0] and stretching to the z-scale). To disable grid lines, use \"none\".")
- ),
- column(width = 6,
- # show only if custom color is desired
- conditionalPanel(condition = "input.grid == 'custom'",
- jscolorInput(inputId = "rgbGrid",
- label = "Choose a color"))
- )
- ),
- sliderInput(inputId = "alpha.grid",
- label = "Transparency",
- min = 0, max = 100,
- step = 1, value = 100)
- ),##EndOf::Tab_7
-
- tabPanel("Legend",
- div(align = "center", h5("Legend")),
- fluidRow(
- column(width = 6,
- checkboxInput(inputId = "showlegend",
- label = "Show legend",
- value = FALSE),
- tooltip(refId = "showlegend", text = "Legend content to be added to the plot.")
- ),
- column(width = 6,
- selectInput(inputId = "legend.pos",
- label = "Legend position",
- selected = "bottomleft",
- choices = c("Top" = "top",
- "Top left" = "topleft",
- "Top right"= "topright",
- "Center" = "center",
- "Bottom" = "bottom",
- "Bottom left" = "bottomleft",
- "Bottom right" = "bottomright"))
- )
- ),
- fluidRow(
- column(width = 6,
- textInput(inputId = "legendname",
- label = "Primary data label",
- value = "primary data")
- ),
- column(width = 6,
- textInput(inputId = "legendname2",
- label = "Secondary data label",
- value = "secondary data")
- )
- )
- ),##EndOf::Tab_8
-
- # Tab 9: save plot as pdf, wmf or eps
- tabPanel("Export",
- radioButtons(inputId = "fileformat",
- label = "Fileformat",
- selected = "pdf",
- choices = c("PDF (Portable Document Format)" = "pdf",
- "SVG (Scalable Vector Graphics)" = "svg",
- "EPS (Encapsulated Postscript)" = "eps")),
- textInput(inputId = "filename",
- label = "Filename",
- value = "Radial Plot"),
- fluidRow(
- column(width = 6,
- numericInput(inputId = "imgheight",
- label = "Image height",
- value = 7)
- ),
- column(width = 6,
- numericInput(inputId = "imgwidth",
- label = "Image width",
- value = 7)
- )
- ),
- selectInput(inputId = "fontfamily",
- label = "Font",
- selected = "Helvetica",
- choices = c("Helvetica" = "Helvetica",
- "Helvetica Narrow" = "Helvetica Narrow",
- "Times" = "Times",
- "Courier" = "Courier",
- "Bookman" = "Bookman",
- "Palatino" = "Palatino")),
- tags$hr(),
- downloadButton(outputId = "exportFile",
- label = "Download plot"),
- tags$hr(),
- helpText("Additionally, you can download a corresponding .R file that contains",
- "a fully functional script to reproduce the plot in your R environment!"),
- downloadButton(outputId = "exportScript",
- label = "Download R script")
- ),##EndOf::Tab_8
-
- # Tab 10: further information
- tabPanel("About",
- hr(),
- div(align = "center",
- # HTML code to include a .png file in the tab; the image file must be in
- # a subfolder called "wwww"
- img(src="RL_Logo.png", height = 100, width = 100, alt = "R.Lum"),
- p("Links:"),
- a(href = "http://www.r-luminescence.de", "R.Luminescence project page", target="_blank"),
+function(request) {
+ fluidPage(
+ titlePanel(NULL, windowTitle = "RLumShiny - RadialPlot"),
+ sidebarLayout(
+ # 2- width = 5 -> refers to twitters bootstrap grid system
+ # where the the maximum width is 12 that is to be shared between all
+ # elements
+ sidebarPanel(width = 5,
+ # include a tabs in the input panel for easier navigation
+ tabsetPanel(id = "tabs", type = "pill", selected = "Data",
+ # Tab 1: Data input
+ tabPanel("Data",
+ # informational text
+ div(align = "center", h5("Data upload")),
+ # file upload button (data set 1)
+ fileInput(inputId = "file1",
+ label = strong("Primary data set"),
+ accept="text/plain, .csv, text/csv"),
+ # file upload button (data set 2)
+ fileInput(inputId = "file2",
+ label = strong("Secondary data set"),
+ accept="text/plain, .csv, text/csv"),
+ # rhandsontable input/output
+ fluidRow(
+ column(width = 6,
+ rHandsontableOutput(outputId = "table_in_primary")
+ ),
+ column(width = 6,
+ rHandsontableOutput(outputId = "table_in_secondary"))
+ ),
+ hr(),
+ actionButton(inputId = "refresh", label = "Refresh", icon = icon("refresh")),
+ tooltip(refId = "refresh", text = "Redraw the plot")
+ ),##EndOf::Tab_1
+
+ # Tab 2: Statistical information
+ tabPanel("Statistics",
+ div(align = "center", h5("Summary")),
+ fluidRow(
+ column(width = 6,
+ checkboxInput(inputId = "summary",
+ label = "Show summary",
+ value = FALSE),
+ tooltip(refId = "summary", text = "Adds numerical output to the plot")
+ ),
+ column(width = 6,
+ selectInput(inputId = "sumpos",
+ label = "Summary position",
+ selected = "topleft",
+ choices = list("Subtitle" = "sub",
+ "Center" = "center",
+ Top=c("Top" = "top",
+ "Top left" = "topleft",
+ "Top right"= "topright"),
+ Bottom=c("Bottom" = "bottom",
+ "Bottom left" = "bottomleft",
+ "Bottom right" = "bottomright")
+ )),
+ tooltip(refId = "sumpos", attr = "for", text = "Position of the statistical summary. The keyword \"Subtitle\" will only work if no plot subtitle is used.")
+ )
+ ),
+ checkboxGroupInput(inputId = "stats",
+ label = "Parameters",
+ selected = c("n","mean"),
+ choices = c("n" = "n",
+ "Mean" = "mean",
+ "weighted Mean" = "mean.weighted",
+ "Median" = "median",
+ "weighted Median" = "median.weighted",
+ "rel. Standard deviation" = "sdrel",
+ "abs. Standard deviation" = "sdabs",
+ "rel. Standard error" = "serel",
+ "abs. Standard error" = "seabs",
+ #"25 % Quartile" = "q25", #not implemented yet
+ #"75 % Quartile" = "q75", #not implemented yet
+ "KDEmax" = "kdemax",
+ "Skewness" = "skewness",
+ "Kurtosis" = "kurtosis"
+ )),
+ tooltip(refId = "stats", text = "Statistical parameters to be shown in the summary"),
br(),
- a(href = "https://forum.r-luminescence.de", "Message board", target="_blank"),
- br(),
- a(href = "http://zerk.canopus.uberspace.de/R.Lum", "Online application", target="_blank"),
- br(),hr(),
- img(src='GitHub-Mark-32px.png', width='32px', height='32px'),
- br(),
- a(href = "https://github.com/tzerk/RLumShiny/tree/master/inst/shiny/radialplot", "See the code at GitHub!", target="_blank")
- )#/div
- )##EndOf::Tab_9
- )##EndOf::tabsetPanel
- ),##EndOf::sidebarPanel
-
- # 3 - output panel
- mainPanel(width = 7,
- # insert css code inside <head></head> of the generated HTML file:
- # allow open dropdown menus to reach over the container
- tags$head(tags$style(type="text/css",".tab-content {overflow: visible;}")),
- tags$head(includeCSS("www/style.css")),
- # divide output in separate tabs via tabsetPanel
- tabsetPanel(
- tabPanel("Plot", plotOutput(outputId = "main_plot", height = "500px")),
- tabPanel("Primary data set", dataTableOutput("dataset")),
- tabPanel("Secondary data set", dataTableOutput("dataset2")),
- tabPanel("Central Age Model", dataTableOutput("CAM")),
- tabPanel("R plot code", verbatimTextOutput("plotCode"))
- )###EndOf::tabsetPanel
- )##EndOf::mainPanel
-)##EndOf::shinyUI(pageWithSidebar)
\ No newline at end of file
+ div(align = "center", h5("Datapoint labels")),
+ div(align = "center", checkboxGroupInput(inputId = "statlabels", inline = TRUE,
+ label = NULL,
+ choices = c("Min" = "min",
+ "Max" = "max",
+ "Median" = "median"))),
+ tooltip(refId = "statlabels", text = "Additional labels of statistically important values in the plot.")
+ ),##EndOf::Tab_2
+
+ # Tab 3: input that refer to the plot rather than the data
+ tabPanel("Plot",
+ div(align = "center", h5("Title")),
+ fluidRow(
+ column(width = 6,
+ textInput(inputId = "main",
+ label = "Title",
+ value = "Radial Plot")
+ ),
+ column(width = 6,
+ textInput(inputId = "mtext",
+ label = "Subtitle",
+ value = "")
+ )
+ ),
+ div(align = "center", h5("Scaling")),
+ fluidRow(
+ column(width = 6,
+ # inject sliderInput from Server.R
+ uiOutput(outputId = "centValue"),
+ tooltip(refId = "centValue", text = "User-defined central value, primarily used for horizontal centering of the z-axis")
+ ),
+ column(width = 6,
+ sliderInput(inputId = "cex",
+ label = "Scaling factor",
+ min = 0.5, max = 2,
+ value = 1.0, step = 0.1)
+ )
+ ),
+ selectInput(inputId = "centrality",
+ label = "Centrality",
+ list("Mean" = "mean",
+ "Median" = "median",
+ "Weighted mean" = "mean.weighted",
+ "Weighted median" = "median.weighted")),
+ tooltip(refId = "centrality", attr = "for", text = "Measure of centrality, used for the standardisation, centering the plot and drawing the central line.")
+ ),##EndOf::Tab_3
+
+ # Tab 4: modify axis parameters
+ tabPanel("Axis",
+ div(align = "center", h5("X-axis")),
+ fluidRow(
+ column(width = 6,
+ textInput(inputId = "xlab1",
+ label = "Label x-axis (upper)",
+ value = "Relative error [%]")
+ ),
+ column(width = 6,
+ textInput(inputId = "xlab2",
+ label = "Label x-axis (lower)",
+ value = "Precision")
+ )
+ ),
+ # inject sliderInput from Server.R
+ uiOutput(outputId = "xlim"),
+ div(align = "center", h5("Y-axis")),
+ checkboxInput(inputId = "yticks",
+ label = HTML("Show ±2σ label"),
+ value = TRUE),
+ tooltip(refId = "yticks", text = "Option to hide y-axis labels."),
+ textInput(inputId = "ylab",
+ label = "Label y-axis",
+ value = "Standardised estimate"),
+ div(align = "center", h5("Z-axis")),
+ checkboxInput(inputId = "logz",
+ label = "Logarithmic z-axis",
+ value = TRUE),
+ tooltip(refId = "logz", text = "Option to display the z-axis in logarithmic scale."),
+ textInput(inputId = "zlab",
+ label = "Label z-axis",
+ value = "Equivalent dose [Gy]"),
+ # inject sliderInput from Server.R
+ uiOutput(outputId = "zlim"),
+ sliderInput('curvature', 'Z-axis curvature',
+ min=0, max=3,
+ value=4.5/5.5, step=0.01, round=FALSE),
+ tooltip(refId = "curvature", attr = "for", text = "User-defined plot area ratio (i.e. curvature of the z-axis). If omitted, the default value (4.5/5.5) is used and modified automatically to optimise the z-axis curvature. The parameter should be decreased when data points are plotted outside the z-axis or when the z-axis gets too elliptic.")
+ ),##EndOf::Tab_4
+
+ # Tab 5: modify data point representation
+ tabPanel("Datapoints",
+ div(align = "center", h5("Primary data set")),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "pch",
+ label = "Style",
+ selected = "17",
+ choices = c("Square"= "1",
+ "Circle"="2",
+ "Triangle point up"="3",
+ "Plus"="4",
+ "Cross"="5",
+ "Diamond"="6",
+ "Triangle point down"="7",
+ "Square cross"="8",
+ "Star"="9",
+ "Diamond plus"="10",
+ "Circle plus"="11",
+ "Triangles up and down"="12",
+ "Square plus"="13",
+ "Circle cross"="14",
+ "Square and Triangle down"="15",
+ "filled Square"="16",
+ "filled Circle"="17",
+ "filled Triangle point up"="18",
+ "filled Diamond"="19",
+ "solid Circle"="20",
+ "Bullet (smaller Circle)"="21",
+ "Custom"="custom"))
+ ),
+ column(width = 6,
+ # show only if custom symbol is desired
+ conditionalPanel(condition = "input.pch == 'custom'",
+ textInput(inputId = "custompch",
+ label = "Insert character",
+ value = "?"))
+ )
+ ),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "color", label = "Datapoint color",
+ choices = list("Black" = "black",
+ "Grey" = "grey50",
+ "Red" = "#b22222",
+ "Green" = "#6E8B3D",
+ "Blue" = "#428bca",
+ "Custom" = "custom"))
+ ),
+ column(width = 6,
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.color == 'custom'",
+ jscolorInput(inputId = "rgb",
+ label = "Choose a color"))
+ )
+ ),
+ div(align = "center", h5("Secondary data set")),
+ fluidRow(
+ column(width = 6,
+ ## DATA SET 2
+ selectInput(inputId = "pch2",
+ label = "Style",
+ selected = "17",
+ choices = c("Square"= "1",
+ "Circle"="2",
+ "Triangle point up"="3",
+ "Plus"="4",
+ "Cross"="5",
+ "Diamond"="6",
+ "Triangle point down"="7",
+ "Square cross"="8",
+ "Star"="9",
+ "Diamond plus"="10",
+ "Circle plus"="11",
+ "Triangles up and down"="12",
+ "Square plus"="13",
+ "Circle cross"="14",
+ "Square and Triangle down"="15",
+ "filled Square"="16",
+ "filled Circle"="17",
+ "filled Triangle point up"="18",
+ "filled Diamond"="19",
+ "solid Circle"="20",
+ "Bullet (smaller Circle)"="21",
+ "Custom"="custom"))
+ ),
+ column(width = 6,
+ # show only if custom symbol is desired
+ conditionalPanel(condition = "input.pch2 == 'custom'",
+ textInput(inputId = "custompch2",
+ label = "Insert character",
+ value = "?"))
+ )
+ ),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "color2", label = "Datapoint color",
+ selected = "#b22222",
+ choices = list("Black" = "black",
+ "Grey" = "grey50",
+ "Red" = "#b22222",
+ "Green" = "#6E8B3D",
+ "Blue" = "#428bca",
+ "Custom" = "custom"))
+ ),
+ column(width = 6,
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.color2 == 'custom'",
+ jscolorInput(inputId = "rgb2",
+ label = "Choose a color"))
+ )
+ )
+ ),##EndOf::Tab_5
+
+ # Tab 6: add additional lines to the plot
+ tabPanel("Lines",
+ helpText("Here you can add additional lines."),
+ # options for custom lines:
+ # 1 - z-value, 2 - color, 3 - label
+ # only the options for the first line are shown
+ numericInput(inputId = "line1",
+ label = strong("Line #1"),
+ value = NA, min = 0),
+ tooltip(refId = "line1", text = "Numeric values of the additional lines to be added."),
+ fluidRow(
+ column(width = 6,
+ HTML("Choose a color<br>"),
+ jscolorInput(inputId = "colline1")
+ ),
+ column(width = 6,
+ textInput(inputId = "labline1",
+ label = "Label",
+ value = "")
+ )
+ ),
+ # conditional chain: if valid input (i.e. the z-value is > 0) is provided
+ # for the previous line, show options for a new line (currently up to eight)
+ conditionalPanel(condition = "input.line1 > 0",
+ numericInput(inputId = "line2", strong("Line #2"), NA, min = 0),
+ fluidRow(
+ column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline2")),
+ column(width = 6, textInput("labline2","Label",value = ""))
+ )
+ ),
+ conditionalPanel(condition = "input.line2 > 0",
+ numericInput(inputId = "line3", strong("Line #3"), NA, min = 0),
+ fluidRow(
+ column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline3")),
+ column(width = 6, textInput("labline3","Label",value = ""))
+ )
+ ),
+
+ conditionalPanel(condition = "input.line3 > 0",
+ numericInput(inputId = "line4", strong("Line #4"), NA, min = 0),
+ fluidRow(
+ column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline4")),
+ column(width = 6, textInput("labline4","Label",value = ""))
+ )
+ ),
+
+ conditionalPanel(condition = "input.line4 > 0",
+ numericInput(inputId = "line5", strong("Line #5"), NA, min = 0),
+ fluidRow(
+ column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline5")),
+ column(width = 6, textInput("labline5","Label",value = ""))
+ )
+ ),
+
+ conditionalPanel(condition = "input.line5 > 0",
+ numericInput(inputId = "line6", strong("Line #6"), NA, min = 0),
+ fluidRow(
+ column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline6")),
+ column(width = 6, textInput("labline6","Label",value = ""))
+ )
+ ),
+
+ conditionalPanel(condition = "input.line6 > 0",
+ numericInput(inputId = "line7", strong("Line #7"), NA, min = 0),
+ fluidRow(
+ column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline7")),
+ column(width = 6, textInput("labline7","Label",value = ""))
+ )
+ ),
+
+ conditionalPanel(condition = "input.line7 > 0",
+ numericInput(inputId = "line8", strong("Line #8"), NA, min = 0),
+ fluidRow(
+ column(width = 6, HTML("Choose a color<br>"),jscolorInput(inputId = "colline8")),
+ column(width = 6, textInput("labline8","Label",value = ""))
+ )
+ )
+
+ ),##EndOf::Tab_6
+
+ # Tab 7: modify the 2-sigma bar (radial plot), grid (both) and polygon (KDE)
+ tabPanel("Bars & Grid",
+ div(align = "center", h5("Central line")),
+ fluidRow(
+ column(width = 6,
+ numericInput(inputId = "lwd",
+ label = "Central line width #1",
+ min = 0, max = 5,
+ value = 1)
+ ),
+ column(width = 6,
+ numericInput(inputId = "lwd2",
+ label = "Central line width #2",
+ min = 0, max = 5,
+ value = 1)
+ )
+ ),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "lty",
+ label = "Line type",
+ selected = 2,
+ choices = list("Blank" = 0,
+ "Solid" = 1,
+ "Dashed" = 2,
+ "Dotted" = 3,
+ "Dot dash" = 4,
+ "Long dash" = 5,
+ "Two dash" = 6))
+ ),
+ column(width = 6,
+ selectInput(inputId = "lty2",
+ label = "Line type",
+ selected = 2,
+ choices = list("Blank" = 0,
+ "Solid" = 1,
+ "Dashed" = 2,
+ "Dotted" = 3,
+ "Dot dash" = 4,
+ "Long dash" = 5,
+ "Two dash" = 6))
+
+ )
+ ),
+ div(align = "center", HTML("<h5>2σ bar</h5>")),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "bar", label = HTML("2σ bar color"),
+ choices = list("Grey" = "grey50",
+ "Custom" = "custom",
+ "None" = "none"))
+ ),
+ column(width = 6,
+ selectInput(inputId = "bar2", label = HTML("2σ bar color #2"),
+ choices = list("Grey" = "grey50",
+ "Custom" = "custom",
+ "None" = "none"))
+ )
+ ),
+ fluidRow(
+ column(width = 6,
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.bar == 'custom'",
+ jscolorInput(inputId = "rgbBar",
+ label = "Choose a color"))
+ ),
+ column(width = 6,
+
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.bar2 == 'custom'",
+ jscolorInput(inputId = "rgbBar2",
+ label = "Choose a color"))
+ )
+ ),
+ sliderInput(inputId = "alpha.bar",
+ label = "Transparency",
+ min = 0, max = 100,
+ step = 1, value = 66),
+ div(align = "center", h5("Grid")),
+ fluidRow(
+ column(width = 6,
+ selectInput("grid", "Grid color",
+ list("Grey" = "grey",
+ "Custom" = "custom",
+ "None" = "none")),
+ tooltip(refId = "grid", attr = "for", text = "colour of the grid lines (originating at [0,0] and stretching to the z-scale). To disable grid lines, use \"none\".")
+ ),
+ column(width = 6,
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.grid == 'custom'",
+ jscolorInput(inputId = "rgbGrid",
+ label = "Choose a color"))
+ )
+ ),
+ sliderInput(inputId = "alpha.grid",
+ label = "Transparency",
+ min = 0, max = 100,
+ step = 1, value = 100)
+ ),##EndOf::Tab_7
+
+ tabPanel("Legend",
+ div(align = "center", h5("Legend")),
+ fluidRow(
+ column(width = 6,
+ checkboxInput(inputId = "showlegend",
+ label = "Show legend",
+ value = FALSE),
+ tooltip(refId = "showlegend", text = "Legend content to be added to the plot.")
+ ),
+ column(width = 6,
+ selectInput(inputId = "legend.pos",
+ label = "Legend position",
+ selected = "bottomleft",
+ choices = c("Top" = "top",
+ "Top left" = "topleft",
+ "Top right"= "topright",
+ "Center" = "center",
+ "Bottom" = "bottom",
+ "Bottom left" = "bottomleft",
+ "Bottom right" = "bottomright"))
+ )
+ ),
+ fluidRow(
+ column(width = 6,
+ textInput(inputId = "legendname",
+ label = "Primary data label",
+ value = "primary data")
+ ),
+ column(width = 6,
+ textInput(inputId = "legendname2",
+ label = "Secondary data label",
+ value = "secondary data")
+ )
+ )
+ ),##EndOf::Tab_8
+
+ # Tab 9: save plot as pdf, wmf or eps
+ tabPanel("Export",
+ radioButtons(inputId = "fileformat",
+ label = "Fileformat",
+ selected = "pdf",
+ choices = c("PDF (Portable Document Format)" = "pdf",
+ "SVG (Scalable Vector Graphics)" = "svg",
+ "EPS (Encapsulated Postscript)" = "eps")),
+ textInput(inputId = "filename",
+ label = "Filename",
+ value = "Radial Plot"),
+ fluidRow(
+ column(width = 6,
+ numericInput(inputId = "imgheight",
+ label = "Image height",
+ value = 7)
+ ),
+ column(width = 6,
+ numericInput(inputId = "imgwidth",
+ label = "Image width",
+ value = 7)
+ )
+ ),
+ selectInput(inputId = "fontfamily",
+ label = "Font",
+ selected = "Helvetica",
+ choices = c("Helvetica" = "Helvetica",
+ "Helvetica Narrow" = "Helvetica Narrow",
+ "Times" = "Times",
+ "Courier" = "Courier",
+ "Bookman" = "Bookman",
+ "Palatino" = "Palatino")),
+ tags$hr(),
+ downloadButton(outputId = "exportFile",
+ label = "Download plot"),
+ tags$hr(),
+ helpText("Additionally, you can download a corresponding .R file that contains",
+ "a fully functional script to reproduce the plot in your R environment!"),
+ downloadButton(outputId = "exportScript",
+ label = "Download R script")
+ ),##EndOf::Tab_8
+
+ # Tab 10: further information
+ tabPanel("About",
+ hr(),
+ div(align = "center",
+ # HTML code to include a .png file in the tab; the image file must be in
+ # a subfolder called "wwww"
+ img(src="RL_Logo.png", height = 100, width = 100, alt = "R.Lum"),
+ p("Links:"),
+ a(href = "http://www.r-luminescence.de", "R.Luminescence project page", target="_blank"),
+ br(),
+ a(href = "https://forum.r-luminescence.de", "Message board", target="_blank"),
+ br(),
+ a(href = "http://zerk.canopus.uberspace.de/R.Lum", "Online application", target="_blank"),
+ br(),hr(),
+ img(src='GitHub-Mark-32px.png', width='32px', height='32px'),
+ br(),
+ a(href = "https://github.com/tzerk/RLumShiny/tree/master/inst/shiny/radialplot", "See the code at GitHub!", target="_blank")
+ )#/div
+ )##EndOf::Tab_9
+ )##EndOf::tabsetPanel
+ ),##EndOf::sidebarPanel
+
+ # 3 - output panel
+ mainPanel(width = 7,
+ # insert css code inside <head></head> of the generated HTML file:
+ # allow open dropdown menus to reach over the container
+ tags$head(tags$style(type="text/css",".tab-content {overflow: visible;}")),
+ tags$head(includeCSS("www/style.css")),
+ # divide output in separate tabs via tabsetPanel
+ tabsetPanel(
+ tabPanel("Plot", plotOutput(outputId = "main_plot", height = "500px")),
+ tabPanel("Primary data set", dataTableOutput("dataset")),
+ tabPanel("Secondary data set", dataTableOutput("dataset2")),
+ tabPanel("Central Age Model", dataTableOutput("CAM")),
+ tabPanel("R plot code", verbatimTextOutput("plotCode"))
+ )###EndOf::tabsetPanel
+ )##EndOf::mainPanel
+ ),##EndOf::sideBarLayout
+ bookmarkButton()
+ )##EndOf::fluidPage
+}
\ No newline at end of file
diff --git a/inst/shiny/radialplot/www/file_containsHeader.png b/inst/shiny/radialplot/www/file_containsHeader.png
deleted file mode 100644
index 7abe3d2..0000000
Binary files a/inst/shiny/radialplot/www/file_containsHeader.png and /dev/null differ
diff --git a/inst/shiny/radialplot/www/file_sep.png b/inst/shiny/radialplot/www/file_sep.png
deleted file mode 100644
index 0297e61..0000000
Binary files a/inst/shiny/radialplot/www/file_sep.png and /dev/null differ
diff --git a/inst/shiny/radialplot/www/file_structure.png b/inst/shiny/radialplot/www/file_structure.png
deleted file mode 100644
index 5e3b50a..0000000
Binary files a/inst/shiny/radialplot/www/file_structure.png and /dev/null differ
diff --git a/inst/shiny/radialplot/www/style.css b/inst/shiny/radialplot/www/style.css
index 295b46c..e6a055a 100644
--- a/inst/shiny/radialplot/www/style.css
+++ b/inst/shiny/radialplot/www/style.css
@@ -20,7 +20,6 @@
h5, h6 {
color: #428bca;
- font-weight: 700;
}
.tooltip-inner {
@@ -38,7 +37,6 @@ h5, h6 {
label, body, input {
font-size: 12px;
- font-weight: 100 !important;
}
.label, .badge {
@@ -46,7 +44,6 @@ label, body, input {
padding: 4px 20px;
margin: 10px;
line-height: 18px;
- font-weight: 100 !important;
}
.label-info, .badge-info {
diff --git a/inst/shiny/transformCW/Global.R b/inst/shiny/transformCW/Global.R
new file mode 100644
index 0000000..338861c
--- /dev/null
+++ b/inst/shiny/transformCW/Global.R
@@ -0,0 +1,10 @@
+## global.R ##
+library(Luminescence)
+library(RLumShiny)
+library(shiny)
+library(data.table)
+library(rhandsontable)
+
+data("ExampleData.CW_OSL_Curve", envir = environment())
+
+enableBookmarking(store = "server")
\ No newline at end of file
diff --git a/inst/shiny/transformCW/Server.R b/inst/shiny/transformCW/Server.R
index 81bed5a..0b729ca 100644
--- a/inst/shiny/transformCW/Server.R
+++ b/inst/shiny/transformCW/Server.R
@@ -1,42 +1,49 @@
## Server.R
-library(Luminescence)
-library(RLumShiny)
-library(shiny)
-
-data("ExampleData.CW_OSL_Curve", envir = environment())
-data <- ExampleData.CW_OSL_Curve
-
## MAIN FUNCTION
-shinyServer(function(input, output, session) {
+function(input, output, session) {
+
+ # input data (with default)
+ values <- reactiveValues(data_primary = ExampleData.CW_OSL_Curve,
+ tdata = NULL)
- # RECEIVE USER DATA ----
- datGet<- reactive({
+ # check and read in file (DATA SET 1)
+ observeEvent(input$file, {
inFile<- input$file
- if(is.null(inFile))
- return(NULL)
- t <- tryCatch(read.table(file = inFile$datapath,
- sep = input$sep,
- quote = "",
- header = input$headers),
- error = function(e) {
- return(NULL)
- })
+ if(is.null(inFile))
+ return(NULL) # if no file was uploaded return NULL
- if (is.null(t))
- return(NULL)
+ values$data_primary <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
+ })
+
+ output$table_in_primary <- renderRHandsontable({
+ rhandsontable(values$data_primary,
+ height = 300,
+ colHeaders = c("Time", "Signal"),
+ rowHeaders = NULL)
+ })
+
+ observeEvent(input$table_in_primary, {
- if (ncol(t) == 1)
- return(NULL)
+ # Workaround for rhandsontable issue #138
+ # https://github.com/jrowen/rhandsontable/issues/138
+ # See detailed explanation in abanico application
+ df_tmp <- input$table_in_primary
+ row_names <- as.list(as.character(seq_len(length(df_tmp$data))))
+ df_tmp$params$rRowHeaders <- row_names
+ df_tmp$params$rowHeaders <- row_names
+ df_tmp$params$rDataDim <- as.list(c(length(row_names),
+ length(df_tmp$params$columns)))
+ if (df_tmp$changes$event == "afterRemoveRow")
+ df_tmp$changes$event <- "afterChange"
- return(t)
+ if (!is.null(hot_to_r(df_tmp)))
+ values$data_primary <- hot_to_r(df_tmp)
})
# TRANSFORM DATA
observe({
- if (!is.null(datGet()))
- data <- datGet()
-
+
P <- input$p
delta <- input$delta
@@ -61,7 +68,7 @@ shinyServer(function(input, output, session) {
}
- args <- list(data)
+ args <- list(values$data_primary)
if (input$method == "CW2pHMi")
if (delta >= 1)
args <- append(args, delta)
@@ -69,33 +76,52 @@ shinyServer(function(input, output, session) {
if (P >= 1)
args <- append(args, P)
- tdata <<- do.call(input$method, args)
+ values$tdata <- try(do.call(input$method, args))
})
output$main_plot <- renderPlot({
# be reactive on method changes
- datGet()
input$method
input$delta
input$p
- pargs <- list(tdata[ ,1], tdata[ ,2],
+ if (inherits(values$tdata, "try-error")) {
+ plot(1, type="n", axes=F, xlab="", ylab="")
+ text(1, labels = paste(values$tdata, collapse = "\n"))
+ return()
+ }
+
+ pargs <- list(values$tdata[,1], values$tdata[ ,2],
log = paste0(ifelse(input$logx, "x", ""), ifelse(input$logy, "y", "")),
main = input$main,
xlab = input$xlab,
- ylab = input$ylab,
- cex = input$cex,
+ ylab = input$ylab1,
type = input$type,
pch = ifelse(input$pch != "custom", as.integer(input$pch) - 1, input$custompch),
- col = ifelse(input$color != "custom", input$color, input$jscol1))
+ col = ifelse(input$color != "custom", input$color, input$jscol1),
+ bty = "n")
+ par(mar=c(5,4,4,5)+.1, cex = input$cex)
do.call(plot, pargs)
+ if (input$showCW) {
+ par(new = TRUE)
+ plot(values$data_primary,
+ axes = FALSE,
+ xlab = NA,
+ ylab = NA,
+ col = "red",
+ type = input$type,
+ log = paste0(ifelse(input$logx, "x", ""), ifelse(input$logy, "y", "")))
+ axis(side = 4, col = "red", col.axis = "red")
+ mtext(input$ylab2, side = 4, line = 3, col = "red")
+ }
+
output$exportScript <- downloadHandler(
filename = function() { paste(input$filename, ".", "txt", sep="") },
content = function(file) {
- write.table(tdata, file, sep = ",", quote = FALSE, row.names = FALSE)
+ write.table(values$tdata, file, sep = ",", quote = FALSE, row.names = FALSE)
},#EO content =,
contentType = "text"
)#EndOf::dowmloadHandler()
@@ -130,7 +156,20 @@ shinyServer(function(input, output, session) {
}
# plot curve
+ par(mar=c(5,4,4,5)+.1, cex = input$cex)
do.call(plot, args = pargs)
+ if (input$showCW) {
+ par(new = TRUE)
+ plot(values$data_primary,
+ axes = FALSE,
+ xlab = NA,
+ ylab = NA,
+ col = "red",
+ type = input$type,
+ log = paste0(ifelse(input$logx, "x", ""), ifelse(input$logy, "y", "")))
+ axis(side = 4, col = "red", col.axis = "red")
+ mtext(input$ylab2, side = 4, line = 3, col = "red")
+ }
dev.off()
},#EO content =,
@@ -139,16 +178,9 @@ shinyServer(function(input, output, session) {
})
output$dataset <- renderDataTable({
- # be reactive on method changes
- datGet()
- input$method
- input$delta
- input$p
-
- if (exists("tdata")){
- tdata
- }
+ if (!is.null(values$tdata))
+ values$tdata
})
-})##EndOf::shinyServer(function(input, output)
\ No newline at end of file
+}##EndOf::function(input, output)
\ No newline at end of file
diff --git a/inst/shiny/transformCW/UI.R b/inst/shiny/transformCW/UI.R
index e91006d..0aa4508 100644
--- a/inst/shiny/transformCW/UI.R
+++ b/inst/shiny/transformCW/UI.R
@@ -1,237 +1,226 @@
## UI.R
-library(RLumShiny)
-
-pageWithSidebar(
- # 1 - title = NULL -> Panel will not be shown
- headerPanel(title = NULL),
-
- # 2- width = 5 -> refers to twitters bootstrap grid system
- # where the the maximum width is 12 that is to be shared between all
- # elements
- sidebarPanel(width = 5,
- # include a tabs in the input panel for easier navigation
- tabsetPanel(id = "tabs", type = "pill", selected = "Data",
- # Tab 1: Data input
- tabPanel("Data",
- # informational text
- div(align = "center", h5("Data upload")),
- # file upload button (data set 1)
- fileInput(inputId = "file",
- label = strong("Primary data set"),
- accept="text/plain"),
- tooltip(refId = "file1", text = tags$img(src='file_structure.png', width='250px')),
- # informational text
- div(align = "center", h5("Settings")),
- fluidRow(
- column(width = 6,
- # logical: should NA values be excluded?
- checkboxInput(inputId = "naExclude",
- label = "Exclude NA values",
- value = TRUE),
- tooltip(refId = "naExclude", text = "Exclude NA values from the data set prior to any further operations.")
- ),
- column(width = 6,
- # logical: file contains headers?
- checkboxInput(inputId = "headers",
- label = "File contains headers",
- value = FALSE),
- tooltip(refId = "headers", text = tags$img(src='file_containsHeader.png', width='250px'))
- )
- ),
- # char: columns separated by tab, space, comma
- radioButtons("sep", "Separator", selected = "\t", inline = TRUE,
- c("Tab" = "\t",
- "Space" = " ",
- "Comma" = ",",
- "Semicolon" = ";")),
- tooltip(refId = "sep", text = tags$img(src='file_sep.png', width='400px'), placement = "auto left")
- ),##EndOf::Tab_1
-
- tabPanel("Method",
- hr(),
- div(align = "center", h5("Transformation settings")),
- radioButtons("method", "Method", selected = "CW2pHMi",
- choices = c("Hyperbolic" = "CW2pHMi",
- "Linear" = "CW2pLM",
- "Linear (interpolated)" = "CW2pLMi",
- "Parabolic" = "CW2pPMi")
- ),
- conditionalPanel(condition = "input.method == 'CW2pHMi'",
- numericInput("delta", "Delta", value = 1, min = 0)),
- conditionalPanel(condition = "input.method == 'CW2pLMi' || input.method == 'CW2pPMi'",
- numericInput("p", "P", value = 1, min = 0))
- ),
-
- tabPanel("Plot",
- div(align = "center", h5("Title")),
-
- textInput(inputId = "main",
- label = "Title",
- value = "CW Curve Transfomation"),
-
- radioButtons("type", "Type", selected = "l", inline = TRUE,
- choices = c("Line" = "l",
- "Points" = "p")),
-
- fluidRow(
- column(width = 6,
- selectInput(inputId = "pch",
- label = "Style",
- selected = "17",
- choices = c("Square"= "1",
- "Circle"="2",
- "Triangle point up"="3",
- "Plus"="4",
- "Cross"="5",
- "Diamond"="6",
- "Triangle point down"="7",
- "Square cross"="8",
- "Star"="9",
- "Diamond plus"="10",
- "Circle plus"="11",
- "Triangles up and down"="12",
- "Square plus"="13",
- "Circle cross"="14",
- "Square and Triangle down"="15",
- "filled Square"="16",
- "filled Circle"="17",
- "filled Triangle point up"="18",
- "filled Diamond"="19",
- "solid Circle"="20",
- "Bullet (smaller Circle)"="21",
- "Custom"="custom"))
- ),
- column(width = 6,
- # show only if custom symbol is desired
- conditionalPanel(condition = "input.pch == 'custom'",
- textInput(inputId = "custompch",
- label = "Insert character",
- value = "?"))
- )
- ),
- fluidRow(
- column(width = 6,
- selectInput(inputId = "color", label = "Datapoint color",
- choices = list("Black" = "black",
- "Grey" = "grey50",
- "Red" = "#b22222",
- "Green" = "#6E8B3D",
- "Blue" = "#428bca",
- "Custom" = "custom"))
- ),
- column(width = 6,
- # show only if custom color is desired
- conditionalPanel(condition = "input.color == 'custom'",
- HTML("Choose a color<br>"),
- jscolorInput(inputId = "jscol1"))
- )
- ),
-
-
- br(),
- div(align = "center", h5("Scaling")),
- sliderInput(inputId = "cex",
- label = "Scaling factor",
- min = 0.5, max = 2,
- value = 1.0, step = 0.1)
- ),##EndOf::Tab_3
-
- # Tab 4: modify axis parameters
- tabPanel("Axis",
- div(align = "center", h5("X-axis")),
- checkboxInput(inputId = "logx",
- label = "Logarithmic x-axis",
- value = TRUE),
- textInput(inputId = "xlab",
- label = "Label x-axis",
- value = "t [s]"),
- # inject sliderInput from Server.R
- br(),
- div(align = "center", h5("Y-axis")),
- checkboxInput(inputId = "logy",
- label = "Logarithmic y-axis",
- value = FALSE),
- textInput(inputId = "ylab",
- label = "Label y-axis (left)",
- value = "pseudo OSL [cts/s]")
- ),##EndOf::Tab_4
-
- # Tab 10: save plot as pdf, wmf or eps
- tabPanel("Export",
- radioButtons(inputId = "fileformat",
- label = "Fileformat",
- selected = "pdf",
- choices = c("PDF (Portable Document Format)" = "pdf",
- "SVG (Scalable Vector Graphics)" = "svg",
- "EPS (Encapsulated Postscript)" = "eps")),
- textInput(inputId = "filename",
- label = "Filename",
- value = "transformed CW"),
- fluidRow(
- column(width = 6,
- numericInput(inputId = "imgheight",
- label = "Image height",
- value = 7)
- ),
- column(width = 6,
- numericInput(inputId = "imgwidth",
- label = "Image width",
- value = 7)
- )
- ),
- selectInput(inputId = "fontfamily",
- label = "Font",
- selected = "Helvetica",
- choices = c("Helvetica" = "Helvetica",
- "Helvetica Narrow" = "Helvetica Narrow",
- "Times" = "Times",
- "Courier" = "Courier",
- "Bookman" = "Bookman",
- "Palatino" = "Palatino")),
- tags$hr(),
- downloadButton(outputId = "exportFile",
- label = "Download plot"),
- tags$hr(),
- helpText("The transformed CW curve data can be downloaded as a comma separated
- ASCII file."),
-
- downloadButton(outputId = "exportScript",
- label = "Download transformed data")
- ),##EndOf::Tab_8
-
- # Tab 10: further information
- tabPanel("About",
- hr(),
- div(align = "center",
- # HTML code to include a .png file in the tab; the image file must be in
- # a subfolder called "wwww"
- img(src="RL_Logo.png", height = 100, width = 100, alt = "R.Lum"),
- p("Links:"),
- a(href = "http://www.r-luminescence.de", "R.Luminescence project page", target="_blank"),
- br(),
- a(href = "https://forum.r-luminescence.de", "Message board", target="_blank"),
+function(request) {
+ fluidPage(
+ titlePanel(NULL, windowTitle = "RLumShiny - transformCW"),
+ sidebarLayout(
+ # 2- width = 5 -> refers to twitters bootstrap grid system
+ # where the the maximum width is 12 that is to be shared between all
+ # elements
+ sidebarPanel(width = 5,
+ # include a tabs in the input panel for easier navigation
+ tabsetPanel(id = "tabs", type = "pill", selected = "Data",
+ # Tab 1: Data input
+ tabPanel("Data",
+
+ # informational text
+ div(align = "center", h5("Data upload")),
+ # file upload button (data set 1)
+ fileInput(inputId = "file",
+ label = strong("Primary data set"),
+ accept="text/plain, .csv, text/csv"),
+ # rhandsontable input/output
+ fluidRow(
+ column(width = 6,
+ rHandsontableOutput(outputId = "table_in_primary")
+ ),
+ column(width = 6)
+ )
+
+ ),##EndOf::Tab_1
+
+ tabPanel("Method",
+ hr(),
+ div(align = "center", h5("Transformation settings")),
+ radioButtons("method", "Method", selected = "CW2pHMi",
+ choices = c("Hyperbolic" = "CW2pHMi",
+ "Linear" = "CW2pLM",
+ "Linear (interpolated)" = "CW2pLMi",
+ "Parabolic" = "CW2pPMi")
+ ),
+ conditionalPanel(condition = "input.method == 'CW2pHMi'",
+ numericInput("delta", "Delta", value = 1, min = 0)),
+ conditionalPanel(condition = "input.method == 'CW2pLMi' || input.method == 'CW2pPMi'",
+ numericInput("p", "P", value = 1, min = 0))
+ ),
+
+ tabPanel("Plot",
+ div(align = "center", h5("Title")),
+
+ textInput(inputId = "main",
+ label = "Title",
+ value = "CW Curve Transfomation"),
+
+ radioButtons("type", "Type", selected = "l", inline = TRUE,
+ choices = c("Line" = "l",
+ "Points" = "p")),
+
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "pch",
+ label = "Style",
+ selected = "17",
+ choices = c("Square"= "1",
+ "Circle"="2",
+ "Triangle point up"="3",
+ "Plus"="4",
+ "Cross"="5",
+ "Diamond"="6",
+ "Triangle point down"="7",
+ "Square cross"="8",
+ "Star"="9",
+ "Diamond plus"="10",
+ "Circle plus"="11",
+ "Triangles up and down"="12",
+ "Square plus"="13",
+ "Circle cross"="14",
+ "Square and Triangle down"="15",
+ "filled Square"="16",
+ "filled Circle"="17",
+ "filled Triangle point up"="18",
+ "filled Diamond"="19",
+ "solid Circle"="20",
+ "Bullet (smaller Circle)"="21",
+ "Custom"="custom"))
+ ),
+ column(width = 6,
+ # show only if custom symbol is desired
+ conditionalPanel(condition = "input.pch == 'custom'",
+ textInput(inputId = "custompch",
+ label = "Insert character",
+ value = "?"))
+ )
+ ),
+ fluidRow(
+ column(width = 6,
+ selectInput(inputId = "color", label = "Datapoint color",
+ choices = list("Black" = "black",
+ "Grey" = "grey50",
+ "Red" = "#b22222",
+ "Green" = "#6E8B3D",
+ "Blue" = "#428bca",
+ "Custom" = "custom"))
+ ),
+ column(width = 6,
+ # show only if custom color is desired
+ conditionalPanel(condition = "input.color == 'custom'",
+ HTML("Choose a color<br>"),
+ jscolorInput(inputId = "jscol1"))
+ )
+ ),
+
+
br(),
- a(href = "http://zerk.canopus.uberspace.de/R.Lum", "Online application", target="_blank"),
- br(),hr(),
- img(src='GitHub-Mark-32px.png', width='32px', height='32px'),
+ checkboxInput(inputId = "showCW",
+ label = "Show CW-OSL curve",
+ value = TRUE),
+ div(align = "center", h5("Scaling")),
+ sliderInput(inputId = "cex",
+ label = "Scaling factor",
+ min = 0.5, max = 2,
+ value = 1.0, step = 0.1)
+ ),##EndOf::Tab_3
+
+ # Tab 4: modify axis parameters
+ tabPanel("Axis",
+ div(align = "center", h5("X-axis")),
+ checkboxInput(inputId = "logx",
+ label = "Logarithmic x-axis",
+ value = TRUE),
+ textInput(inputId = "xlab",
+ label = "Label x-axis",
+ value = "t [s]"),
+ # inject sliderInput from Server.R
br(),
- a(href = "https://github.com/tzerk/RLumShiny/tree/master/inst/shiny/transformCW", "See the code at GitHub!", target="_blank")
- )#/div
- )##EndOf::Tab_9
- )##EndOf::tabsetPanel
- ),##EndOf::sidebarPanel
-
-
- # 3 - output panel
- mainPanel(width = 7,
- # insert css code inside <head></head> of the generated HTML file:
- # allow open dropdown menus to reach over the container
- tags$head(tags$style(type="text/css",".tab-content {overflow: visible;}")),
- tags$head(includeCSS("www/style.css")),
- # divide output in separate tabs via tabsetPanel
- tabsetPanel(
- tabPanel("Plot", plotOutput(outputId = "main_plot", height = "500px")),
- tabPanel("Output table", fluidRow(column(width = 12, dataTableOutput("dataset"))))
- )###EndOf::tabsetPanel
- )##EndOf::mainPanel
-)##EndOf::shinyUI(pageWithSidebar)
\ No newline at end of file
+ div(align = "center", h5("Y-axis")),
+ checkboxInput(inputId = "logy",
+ label = "Logarithmic y-axis",
+ value = FALSE),
+ textInput(inputId = "ylab1",
+ label = "Label y-axis (left)",
+ value = "pseudo OSL [cts/s]"),
+ textInput(inputId = "ylab2",
+ label = "Label y-axis (right)",
+ value = "CW-OSL [cts/s]")
+ ),##EndOf::Tab_4
+
+ # Tab 10: save plot as pdf, wmf or eps
+ tabPanel("Export",
+ radioButtons(inputId = "fileformat",
+ label = "Fileformat",
+ selected = "pdf",
+ choices = c("PDF (Portable Document Format)" = "pdf",
+ "SVG (Scalable Vector Graphics)" = "svg",
+ "EPS (Encapsulated Postscript)" = "eps")),
+ textInput(inputId = "filename",
+ label = "Filename",
+ value = "transformed CW"),
+ fluidRow(
+ column(width = 6,
+ numericInput(inputId = "imgheight",
+ label = "Image height",
+ value = 7)
+ ),
+ column(width = 6,
+ numericInput(inputId = "imgwidth",
+ label = "Image width",
+ value = 7)
+ )
+ ),
+ selectInput(inputId = "fontfamily",
+ label = "Font",
+ selected = "Helvetica",
+ choices = c("Helvetica" = "Helvetica",
+ "Helvetica Narrow" = "Helvetica Narrow",
+ "Times" = "Times",
+ "Courier" = "Courier",
+ "Bookman" = "Bookman",
+ "Palatino" = "Palatino")),
+ tags$hr(),
+ downloadButton(outputId = "exportFile",
+ label = "Download plot"),
+ tags$hr(),
+ helpText("The transformed CW curve data can be downloaded as a comma separated
+ ASCII file."),
+
+ downloadButton(outputId = "exportScript",
+ label = "Download transformed data")
+ ),##EndOf::Tab_8
+
+ # Tab 10: further information
+ tabPanel("About",
+ hr(),
+ div(align = "center",
+ # HTML code to include a .png file in the tab; the image file must be in
+ # a subfolder called "wwww"
+ img(src="RL_Logo.png", height = 100, width = 100, alt = "R.Lum"),
+ p("Links:"),
+ a(href = "http://www.r-luminescence.de", "R.Luminescence project page", target="_blank"),
+ br(),
+ a(href = "https://forum.r-luminescence.de", "Message board", target="_blank"),
+ br(),
+ a(href = "http://zerk.canopus.uberspace.de/R.Lum", "Online application", target="_blank"),
+ br(),hr(),
+ img(src='GitHub-Mark-32px.png', width='32px', height='32px'),
+ br(),
+ a(href = "https://github.com/tzerk/RLumShiny/tree/master/inst/shiny/transformCW", "See the code at GitHub!", target="_blank")
+ )#/div
+ )##EndOf::Tab_9
+ )##EndOf::tabsetPanel
+ ),##EndOf::sidebarPanel
+
+ # 3 - output panel
+ mainPanel(width = 7,
+ # insert css code inside <head></head> of the generated HTML file:
+ # allow open dropdown menus to reach over the container
+ tags$head(tags$style(type="text/css",".tab-content {overflow: visible;}")),
+ tags$head(includeCSS("www/style.css")),
+ # divide output in separate tabs via tabsetPanel
+ tabsetPanel(
+ tabPanel("Plot", plotOutput(outputId = "main_plot", height = "500px")),
+ tabPanel("Output table", fluidRow(column(width = 12, dataTableOutput("dataset"))))
+ )###EndOf::tabsetPanel
+ )##EndOf::mainPanel
+ ),##EndOf::sideBarLayout
+ bookmarkButton()
+ )##EndOf::fluidPage
+}
\ No newline at end of file
diff --git a/inst/shiny/transformCW/shiny_bookmarks/0bba99060aa8d69f/input.rds b/inst/shiny/transformCW/shiny_bookmarks/0bba99060aa8d69f/input.rds
new file mode 100644
index 0000000..5c13d70
Binary files /dev/null and b/inst/shiny/transformCW/shiny_bookmarks/0bba99060aa8d69f/input.rds differ
diff --git a/inst/shiny/transformCW/shiny_bookmarks/211d00e884a92c90/input.rds b/inst/shiny/transformCW/shiny_bookmarks/211d00e884a92c90/input.rds
new file mode 100644
index 0000000..d472b43
Binary files /dev/null and b/inst/shiny/transformCW/shiny_bookmarks/211d00e884a92c90/input.rds differ
diff --git a/inst/shiny/transformCW/shiny_bookmarks/383978aa9a560a09/input.rds b/inst/shiny/transformCW/shiny_bookmarks/383978aa9a560a09/input.rds
new file mode 100644
index 0000000..d472b43
Binary files /dev/null and b/inst/shiny/transformCW/shiny_bookmarks/383978aa9a560a09/input.rds differ
diff --git a/inst/shiny/transformCW/shiny_bookmarks/99c9d1b8f309e36d/input.rds b/inst/shiny/transformCW/shiny_bookmarks/99c9d1b8f309e36d/input.rds
new file mode 100644
index 0000000..d472b43
Binary files /dev/null and b/inst/shiny/transformCW/shiny_bookmarks/99c9d1b8f309e36d/input.rds differ
diff --git a/inst/shiny/transformCW/shiny_bookmarks/9d5d05362bf9b198/input.rds b/inst/shiny/transformCW/shiny_bookmarks/9d5d05362bf9b198/input.rds
new file mode 100644
index 0000000..d472b43
Binary files /dev/null and b/inst/shiny/transformCW/shiny_bookmarks/9d5d05362bf9b198/input.rds differ
diff --git a/inst/shiny/transformCW/shiny_bookmarks/cad3028cccb4abdb/input.rds b/inst/shiny/transformCW/shiny_bookmarks/cad3028cccb4abdb/input.rds
new file mode 100644
index 0000000..d472b43
Binary files /dev/null and b/inst/shiny/transformCW/shiny_bookmarks/cad3028cccb4abdb/input.rds differ
diff --git a/inst/shiny/transformCW/shiny_bookmarks/f0d30b74a68561f3/input.rds b/inst/shiny/transformCW/shiny_bookmarks/f0d30b74a68561f3/input.rds
new file mode 100644
index 0000000..2abb6ee
Binary files /dev/null and b/inst/shiny/transformCW/shiny_bookmarks/f0d30b74a68561f3/input.rds differ
diff --git a/inst/shiny/transformCW/www/file_containsHeader.png b/inst/shiny/transformCW/www/file_containsHeader.png
deleted file mode 100644
index 7abe3d2..0000000
Binary files a/inst/shiny/transformCW/www/file_containsHeader.png and /dev/null differ
diff --git a/inst/shiny/transformCW/www/file_sep.png b/inst/shiny/transformCW/www/file_sep.png
deleted file mode 100644
index 0297e61..0000000
Binary files a/inst/shiny/transformCW/www/file_sep.png and /dev/null differ
diff --git a/inst/shiny/transformCW/www/file_structure.png b/inst/shiny/transformCW/www/file_structure.png
deleted file mode 100644
index 5e3b50a..0000000
Binary files a/inst/shiny/transformCW/www/file_structure.png and /dev/null differ
diff --git a/inst/shiny/transformCW/www/style.css b/inst/shiny/transformCW/www/style.css
index 295b46c..e6a055a 100644
--- a/inst/shiny/transformCW/www/style.css
+++ b/inst/shiny/transformCW/www/style.css
@@ -20,7 +20,6 @@
h5, h6 {
color: #428bca;
- font-weight: 700;
}
.tooltip-inner {
@@ -38,7 +37,6 @@ h5, h6 {
label, body, input {
font-size: 12px;
- font-weight: 100 !important;
}
.label, .badge {
@@ -46,7 +44,6 @@ label, body, input {
padding: 4px 20px;
margin: 10px;
line-height: 18px;
- font-weight: 100 !important;
}
.label-info, .badge-info {
diff --git a/inst/www/chooser_inputBinding.js b/inst/www/chooser_inputBinding.js
new file mode 100644
index 0000000..5fbc419
--- /dev/null
+++ b/inst/www/chooser_inputBinding.js
@@ -0,0 +1,86 @@
+/* 'chooser-binding.js' taken from the shiny-examples repository (https://github.com/rstudio/shiny-examples) under the MIT License */
+
+(function() {
+
+ function updateChooser(chooser) {
+ chooser = $(chooser);
+ var left = chooser.find("select.left");
+ var right = chooser.find("select.right");
+ var leftArrow = chooser.find(".left-arrow");
+ var rightArrow = chooser.find(".right-arrow");
+
+ var canMoveTo = (left.val() || []).length > 0;
+ var canMoveFrom = (right.val() || []).length > 0;
+
+ leftArrow.toggleClass("muted", !canMoveFrom);
+ rightArrow.toggleClass("muted", !canMoveTo);
+ }
+
+ function move(chooser, source, dest) {
+ chooser = $(chooser);
+ var selected = chooser.find(source).children("option:selected");
+ var dest = chooser.find(dest);
+ dest.children("option:selected").each(function(i, e) {e.selected = false;});
+ dest.append(selected);
+ updateChooser(chooser);
+ chooser.trigger("change");
+ }
+
+ $(document).on("change", ".chooser select", function() {
+ updateChooser($(this).parents(".chooser"));
+ });
+
+ $(document).on("click", ".chooser .right-arrow", function() {
+ move($(this).parents(".chooser"), ".left", ".right");
+ });
+
+ $(document).on("click", ".chooser .left-arrow", function() {
+ move($(this).parents(".chooser"), ".right", ".left");
+ });
+
+ $(document).on("dblclick", ".chooser select.left", function() {
+ move($(this).parents(".chooser"), ".left", ".right");
+ });
+
+ $(document).on("dblclick", ".chooser select.right", function() {
+ move($(this).parents(".chooser"), ".right", ".left");
+ });
+
+ var binding = new Shiny.InputBinding();
+
+ binding.find = function(scope) {
+ return $(scope).find(".chooser");
+ };
+
+ binding.initialize = function(el) {
+ updateChooser(el);
+ };
+
+ binding.getValue = function(el) {
+ return {
+ left: $.makeArray($(el).find("select.left option").map(function(i, e) { return e.value; })),
+ right: $.makeArray($(el).find("select.right option").map(function(i, e) { return e.value; }))
+ }
+ };
+
+ binding.setValue = function(el, value) {
+ // TODO: implement
+ };
+
+ binding.subscribe = function(el, callback) {
+ $(el).on("change.chooserBinding", function(e) {
+ callback();
+ });
+ };
+
+ binding.unsubscribe = function(el) {
+ $(el).off(".chooserBinding");
+ };
+
+ binding.getType = function() {
+ return "shinyjsexamples.chooser";
+ };
+
+ Shiny.inputBindings.register(binding, "shinyjsexamples.chooser");
+
+})();
diff --git a/inst/www/jscolor/demo.html b/inst/www/jscolor/demo.html
index cb86066..5f8840a 100644
--- a/inst/www/jscolor/demo.html
+++ b/inst/www/jscolor/demo.html
@@ -1,12 +1,12 @@
-<html>
-<head>
- <title>jscolor demo</title>
-</head>
-<body>
-
- <script type="text/javascript" src="jscolor.js"></script>
-
- Click here: <input class="color" value="66ff00">
-
-</body>
-</html>
+<html>
+<head>
+ <title>jscolor demo</title>
+</head>
+<body>
+
+ <script type="text/javascript" src="jscolor.js"></script>
+
+ Click here: <input class="color" value="66ff00">
+
+</body>
+</html>
diff --git a/man/RLumShiny-package.Rd b/man/RLumShiny-package.Rd
index d835c6e..2a7f5f5 100644
--- a/man/RLumShiny-package.Rd
+++ b/man/RLumShiny-package.Rd
@@ -2,23 +2,21 @@
% Please edit documentation in R/RLumShiny.R
\docType{package}
\name{RLumShiny-package}
-\alias{RLumShiny}
\alias{RLumShiny-package}
\title{Shiny Applications for the R Package Luminescence}
\description{
-A collection of shiny applications for the R package Luminescence.
-These mainly, but not exclusively, include applications for plotting chronometric
-data from e.g. luminescence or radiocarbon dating. It further provides access to
+A collection of shiny applications for the R package Luminescence.
+These mainly, but not exclusively, include applications for plotting chronometric
+data from e.g. luminescence or radiocarbon dating. It further provides access to
bootstraps tooltip and popover functionality as well as a binding to JSColor.
}
\details{
In addition to its main purpose of providing convenient access to the Luminescence
-shiny applications (see \code{\link{app_RLum}}) this package also provides further functions to extend the
+shiny applications (see \code{\link{app_RLum}}) this package also provides further functions to extend the
functionality of shiny. From the Bootstrap framework the JavaScript tooltip and popover
components can be added to any shiny application via \code{\link{tooltip}} and \code{\link{popover}}.
It further provides a custom input binding to the JavaScript/HTML color picker JSColor.
Offering access to most options provided by the JSColor API the function \code{\link{jscolorInput}}
-is easily implemented in a shiny app. RGB colors are returned as hex values and can be
+is easily implemented in a shiny app. RGB colors are returned as hex values and can be
directly used in R's base plotting functions without the need of any format conversion.
}
-
diff --git a/man/RLumShinyAddin.Rd b/man/RLumShinyAddin.Rd
new file mode 100644
index 0000000..f4fa01b
--- /dev/null
+++ b/man/RLumShinyAddin.Rd
@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/addin.R
+\name{RLumShinyAddin}
+\alias{RLumShinyAddin}
+\title{RLumShiny Dashboard Addin}
+\usage{
+RLumShinyAddin()
+}
+\description{
+RLumShiny dashboard
+}
diff --git a/man/app_RLum.Rd b/man/app_RLum.Rd
index 9461706..f9900d4 100644
--- a/man/app_RLum.Rd
+++ b/man/app_RLum.Rd
@@ -4,11 +4,11 @@
\alias{app_RLum}
\title{Run Luminescence shiny apps}
\usage{
-app_RLum(app, ...)
+app_RLum(app = NULL, ...)
}
\arguments{
-\item{app}{\code{\link{character}} (required): name of the application to start. See details for a list
-of available apps.}
+\item{app}{\code{\link{character}} (\strong{required}):
+name of the application to start. See details for a list of available apps.}
\item{...}{further arguments to pass to \code{\link{runApp}}}
}
@@ -16,28 +16,33 @@ of available apps.}
A wrapper for \code{\link{runApp}} to start interactive shiny apps for the R package Luminescence.
}
\details{
-The RLumShiny package provides a single function from which all shiny apps can be started: \code{app_RLum()}.
-It essentially only takes one argument, which is a unique keyword specifying which application to start.
-See the table below for a list of available shiny apps and which keywords to use.
+The RLumShiny package provides a single function from which all shiny apps can be started: \code{app_RLum()}.
+It essentially only takes one argument, which is a unique keyword specifying which application to start.
+See the table below for a list of available shiny apps and which keywords to use. If no keyword is used
+a dashboard will be started instead, from which an application can be started.
\tabular{lcl}{
-\bold{Application name:} \tab \bold{Keyword:} \tab \bold{Function:} \cr
+\strong{Application name:} \tab \strong{Keyword:} \tab \strong{Function:} \cr
Abanico Plot \tab \emph{abanico} \tab \code{\link{plot_AbanicoPlot}} \cr
Histogram \tab \emph{histogram} \tab \code{\link{plot_Histogram}} \cr
Kernel Density Estimate Plot \tab \emph{KDE} \tab \code{\link{plot_KDE}} \cr
Radial Plot \tab \emph{radialplot} \tab \code{\link{plot_RadialPlot}} \cr
Dose Recovery Test \tab \emph{doserecovery} \tab \code{\link{plot_DRTResults}} \cr
Cosmic Dose Rate \tab \emph{cosmicdose} \tab \code{\link{calc_CosmicDoseRate}} \cr
-CW Curve Transformation \tab \emph{transformCW} \tab \code{\link{CW2pHMi}, \link{CW2pLM}, \link{CW2pLMi}, \link{CW2pPMi}}
+CW Curve Transformation \tab \emph{transformCW} \tab \code{\link{CW2pHMi}}, \code{\link{CW2pLM}}, \code{\link{CW2pLMi}}, \code{\link{CW2pPMi}} \cr
+Filter Combinations \tab \emph{filter} \tab \code{\link{plot_FilterCombinations}}
}
-The \code{app_RLum()} function is just a wrapper for \code{\link{runApp}}.
-Via the \code{...} argument further arguments can be directly passed to \code{\link{runApp}}.
+The \code{app_RLum()} function is just a wrapper for \code{\link{runApp}}.
+Via the \code{...} argument further arguments can be directly passed to \code{\link{runApp}}.
See \code{?shiny::runApp} for further details on valid arguments.
}
\examples{
\dontrun{
+# Dashboard
+app_RLum()
+
# Plotting apps
app_RLum("abanico")
app_RLum("histogram")
@@ -47,13 +52,14 @@ app_RLum("doserecovery")
# Further apps
app_RLum("cosmicdose")
+app_RLum("transformCW")
+app_RLum("filter")
}
}
-\author{
-Christoph Burow, University of Cologne (Germany)
-}
\seealso{
\code{\link{runApp}}
}
-
+\author{
+Christoph Burow, University of Cologne (Germany)
+}
diff --git a/man/jscolorInput.Rd b/man/jscolorInput.Rd
index cb9f6b6..d76fac2 100644
--- a/man/jscolorInput.Rd
+++ b/man/jscolorInput.Rd
@@ -8,21 +8,29 @@ jscolorInput(inputId, label, value, position = "bottom",
color = "transparent", mode = "HSV", slider = TRUE, close = FALSE)
}
\arguments{
-\item{inputId}{\code{\link{character}} (required): Specifies the input slot that will be used to access the value.}
+\item{inputId}{\code{\link{character}} (\strong{required}):
+Specifies the input slot that will be used to access the value.}
-\item{label}{\code{\link{character}}: Display label for the control, or NULL for no label.}
+\item{label}{\code{\link{character}} (\emph{optional}):
+Display label for the control, or NULL for no label.}
-\item{value}{\code{\link{character}}: Initial RGB value of the color picker. Default is black ('#000000').}
+\item{value}{\code{\link{character}} (\emph{optional}):
+Initial RGB value of the color picker. Default is black ('#000000').}
-\item{position}{\code{\link{character}}: Position of the picker relative to the text input ('bottom', 'left', 'top', 'right').}
+\item{position}{\code{\link{character}} (\emph{with default}):
+Position of the picker relative to the text input ('bottom', 'left', 'top', 'right').}
-\item{color}{\code{\link{character}}: Picker color scheme ('transparent' by default). Use RGB color coding ('000000').}
+\item{color}{\code{\link{character}} (\emph{with default}):
+Picker color scheme ('transparent' by default). Use RGB color coding ('000000').}
-\item{mode}{\code{\link{character}}: Mode of hue, saturation and value. Can either be 'HSV' or 'HVS'.}
+\item{mode}{\code{\link{character}} (\emph{with default}):
+Mode of hue, saturation and value. Can either be 'HSV' or 'HVS'.}
-\item{slider}{\code{\link{logical}}: Show or hide the slider.}
+\item{slider}{\code{\link{logical}} (\emph{with default}):
+Show or hide the slider.}
-\item{close}{\code{\link{logical}}: Show or hide a close button.}
+\item{close}{\code{\link{logical}} (\emph{with default}):
+Show or hide a close button.}
}
\description{
Creates a JSColor (Javascript/HTML Color Picker) widget to be used in shiny applications.
@@ -48,10 +56,9 @@ server = function(input, output) {
}
}
\seealso{
-Other input.elements: \code{\link{animationOptions}}, \code{\link{sliderInput}};
-\code{\link{checkboxGroupInput}}; \code{\link{checkboxInput}}; \code{\link{dateInput}};
-\code{\link{dateRangeInput}}; \code{\link{fileInput}}; \code{\link{numericInput}};
-\code{\link{passwordInput}}; \code{\link{radioButtons}}; \code{\link{selectInput}},
+Other input.elements: \code{\link{animationOptions}}, \code{\link{sliderInput}};
+\code{\link{checkboxGroupInput}}; \code{\link{checkboxInput}}; \code{\link{dateInput}};
+\code{\link{dateRangeInput}}; \code{\link{fileInput}}; \code{\link{numericInput}};
+\code{\link{passwordInput}}; \code{\link{radioButtons}}; \code{\link{selectInput}},
\code{\link{selectizeInput}}; \code{\link{submitButton}}; \code{\link{textInput}}
}
-
diff --git a/man/popover.Rd b/man/popover.Rd
index 041c735..1a619fb 100644
--- a/man/popover.Rd
+++ b/man/popover.Rd
@@ -9,19 +9,29 @@ popover(title, content, header = NULL, html = TRUE,
"bottom"), trigger = c("click", "hover", "focus", "manual"))
}
\arguments{
-\item{title}{\code{\link{character}} (required): Title of the button.}
+\item{title}{\code{\link{character}} (\strong{required}):
+Title of the button.}
-\item{content}{\code{\link{character}}: Text to be displayed in the popover.}
+\item{content}{\code{\link{character}} (\strong{required}):
+Text to be displayed in the popover.}
-\item{header}{\code{\link{character}}: Optional header in the popover.}
+\item{header}{\code{\link{character}} (\emph{optional}):
+Optional header in the popover.}
-\item{html}{\code{\link{logical}} Insert HTML into the popover.}
+\item{html}{\code{\link{logical}} (\emph{with default}):
+Insert HTML into the popover.}
-\item{class}{\code{\link{logical}} Bootstrap button class (e.g. "btn btn-danger").}
+\item{class}{\code{\link{logical}} (\emph{with default}):
+Bootstrap button class (e.g. "btn btn-danger").}
-\item{placement}{\code{\link{character}}: How to position the popover - top | bottom | left | right | auto. When "auto" is specified, it will dynamically reorient the popover. For example, if placement is "auto left", the popover will display to the left when possible, otherwise it will display right.}
+\item{placement}{\code{\link{character}} (\emph{with default}):
+How to position the popover - top | bottom | left | right | auto.
+When "auto" is specified, it will dynamically reorient the popover.
+For example, if placement is "auto left", the popover will display to the
+left when possible, otherwise it will display right.}
-\item{trigger}{\code{\link{character}}: How popover is triggered - click | hover | focus | manual.}
+\item{trigger}{\code{\link{character}} (\emph{with default}):
+How popover is triggered - click | hover | focus | manual.}
}
\description{
Add small overlays of content for housing secondary information.
@@ -47,4 +57,3 @@ server = function(input, output) {
})
}
}
-
diff --git a/man/tooltip.Rd b/man/tooltip.Rd
index 6690d73..50d1a9d 100644
--- a/man/tooltip.Rd
+++ b/man/tooltip.Rd
@@ -8,21 +8,33 @@ tooltip(refId, text, attr = NULL, animation = TRUE, delay = 100,
html = TRUE, placement = "auto", trigger = "hover")
}
\arguments{
-\item{refId}{\code{\link{character}} (required): id of the element the tooltip is to be attached to.}
+\item{refId}{\code{\link{character}} (\strong{required}):
+id of the element the tooltip is to be attached to.}
-\item{text}{\code{\link{character}}: Text to be displayed in the tooltip.}
+\item{text}{\code{\link{character}} (\strong{required}):
+Text to be displayed in the tooltip.}
-\item{attr}{\code{\link{character}}: Attach tooltip to all elements with attribute \code{attr='refId'}.}
+\item{attr}{\code{\link{character}} (\emph{optional}):
+Attach tooltip to all elements with attribute \code{attr='refId'}.}
-\item{animation}{\code{\link{logical}}: Apply a CSS fade transition to the tooltip.}
+\item{animation}{\code{\link{logical}} (\emph{with default}):
+Apply a CSS fade transition to the tooltip.}
-\item{delay}{\code{\link{numeric}}: Delay showing and hiding the tooltip (ms).}
+\item{delay}{\code{\link{numeric}} (\emph{with default}):
+Delay showing and hiding the tooltip (ms).}
-\item{html}{\code{\link{logical}}: Insert HTML into the tooltip.}
+\item{html}{\code{\link{logical}} (\emph{with default}):
+Insert HTML into the tooltip.}
-\item{placement}{\code{\link{character}}: How to position the tooltip - top | bottom | left | right | auto. When 'auto' is specified, it will dynamically reorient the tooltip. For example, if placement is 'auto left', the tooltip will display to the left when possible, otherwise it will display right.}
+\item{placement}{\code{\link{character}} (\emph{with default}):
+How to position the tooltip - \code{top} | \code{bottom} | \code{left} | \code{right} | \code{auto}.
+When 'auto' is specified, it will dynamically reorient the tooltip.
+For example, if placement is 'auto left', the tooltip will display to the
+left when possible, otherwise it will display right.}
-\item{trigger}{\code{\link{character}}: How tooltip is triggered - click | hover | focus | manual. You may pass multiple triggers; separate them with a space.}
+\item{trigger}{\code{\link{character}} (\emph{with default}):
+How tooltip is triggered - \code{click} | \code{hover} | \code{focus} | \code{manual}.
+You may pass multiple triggers; separate them with a space.}
}
\description{
Create bootstrap tooltips for any HTML element to be used in shiny applications.
@@ -65,4 +77,3 @@ server = function(input, output) {
})
}
}
-
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-rlumshiny.git
More information about the debian-med-commit
mailing list