RLumShiny/0000755000176200001440000000000014175713406012154 5ustar liggesusersRLumShiny/NAMESPACE0000644000176200001440000000103614175252447013376 0ustar liggesusers# 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(RCarb,model_DoseRate) importFrom(RCarb,write_InputTemplate) importFrom(grDevices,dev.off) importFrom(grDevices,pdf) importFrom(grDevices,postscript) importFrom(grDevices,svg) importFrom(markdown,markdownToHTML) importFrom(utils,citation) RLumShiny/LICENSE.note0000644000176200001440000000106214175060542014120 0ustar liggesusersThe RLumShiny package as a whole is distributed under GPL-3 (GNU GENERAL PUBLIC LICENSE version 3). The RLumShiny package includes other open source software components. The following 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) - chooser-binding.js & chooser.R, https://github.com/rstudio/shiny-examples/tree/master/036-custom-input-control, MIT license (YEAR: 2016, COPYRIGHT HOLDER: RStudio)RLumShiny/man/0000755000176200001440000000000014175252574012733 5ustar liggesusersRLumShiny/man/jscolorInput.Rd0000644000176200001440000000444714175060542015716 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/jscolor.R \name{jscolorInput} \alias{jscolorInput} \title{Create a JSColor picker input widget} \usage{ jscolorInput( inputId, label, value, position = "bottom", color = "transparent", mode = "HSV", slider = TRUE, close = FALSE ) } \arguments{ \item{inputId}{\code{\link{character}} (\strong{required}): Specifies the input slot that will be used to access the value.} \item{label}{\code{\link{character}} (\emph{optional}): Display label for the control, or NULL for no label.} \item{value}{\code{\link{character}} (\emph{optional}): Initial RGB value of the color picker. Default is black ('#000000').} \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}} (\emph{with default}): Picker color scheme ('transparent' by default). Use RGB color coding ('000000').} \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}} (\emph{with default}): Show or hide the slider.} \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. } \examples{ # html code jscolorInput("col", "Color", "21BF6B", slider = FALSE) # example app \dontrun{ shinyApp( ui = fluidPage( jscolorInput(inputId = "col", label = "JSColor Picker", value = "21BF6B", position = "right", mode = "HVS", close = TRUE), plotOutput("plot") ), server = function(input, output) { output$plot <- renderPlot({ plot(cars, col = input$col, cex = 2, pch = 16) }) }) } } \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}} } RLumShiny/man/RLumShiny-package.Rd0000644000176200001440000000244614175060542016503 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RLumShiny.R \docType{package} \name{RLumShiny-package} \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 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 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 directly used in R's base plotting functions without the need of any format conversion. } RLumShiny/man/tooltip.Rd0000644000176200001440000000541314175060542014707 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tooltip.R \name{tooltip} \alias{tooltip} \title{Create a bootstrap tooltip} \usage{ tooltip( refId, text, attr = NULL, animation = TRUE, delay = 100, html = TRUE, placement = "auto", trigger = "hover" ) } \arguments{ \item{refId}{\code{\link{character}} (\strong{required}): id of the element the tooltip is to be attached to.} \item{text}{\code{\link{character}} (\strong{required}): Text to be displayed in the tooltip.} \item{attr}{\code{\link{character}} (\emph{optional}): Attach tooltip to all elements with attribute \code{attr='refId'}.} \item{animation}{\code{\link{logical}} (\emph{with default}): Apply a CSS fade transition to the tooltip.} \item{delay}{\code{\link{numeric}} (\emph{with default}): Delay showing and hiding the tooltip (ms).} \item{html}{\code{\link{logical}} (\emph{with default}): Insert HTML into the tooltip.} \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}} (\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. } \examples{ # javascript code tt <- tooltip("elementId", "This is a tooltip.") str(tt) # example app \dontrun{ shinyApp( ui = fluidPage( jscolorInput(inputId = "col", label = "JSColor Picker", value = "21BF6B", position = "right", mode = "HVS", close = TRUE), tooltip("col", "This is a JScolor widget"), checkboxInput("cbox", "Checkbox", FALSE), tooltip("cbox", "This is a checkbox"), checkboxGroupInput("cboxg", "Checkbox group", selected = "a", choices = c("a" = "a", "b" = "b", "c" = "c")), tooltip("cboxg", "This is a checkbox group", html = TRUE), selectInput("select", "Selectinput", selected = "a", choices = c("a"="a", "b"="b")), tooltip("select", "This is a text input field", attr = "for", placement = "right"), passwordInput("pwIn", "Passwordinput"), tooltip("pwIn", "This is a password input field"), plotOutput("plot") ), server = function(input, output) { output$plot <- renderPlot({ plot(cars, col = input$col, cex = 2, pch = 16) }) }) } } RLumShiny/man/app_RLum.Rd0000644000176200001440000000562314175060542014737 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/app_RLum.R \name{app_RLum} \alias{app_RLum} \title{Run Luminescence shiny apps} \usage{ app_RLum(app = NULL, ...) } \arguments{ \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}}} } \description{ 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. If no keyword is used a dashboard will be started instead, from which an application can be started. \tabular{lcl}{ \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}}, \code{\link{CW2pLM}}, \code{\link{CW2pLMi}}, \code{\link{CW2pPMi}} \cr Filter Combinations \tab \emph{filter} \tab \code{\link{plot_FilterCombinations}} \cr Fast Ratio \tab \emph{fastratio} \tab \code{\link{calc_FastRatio}} \cr Fading Correction \tab \emph{fading} \tab \code{\link{analyse_FadingMeasurement}}, \code{\link{calc_FadingCorr}} \cr Test Stimulation Power \tab \emph{teststimulationpower} \tab \code{\link{plot_RLum}} \cr Scale Gamma Dose Rate \tab \emph{scalegamma} \tab \code{scale_GammaDose} \cr RCarb app \tab \emph{RCarb} \tab \link[RCarb:model_DoseRate]{RCarb::model_DoseRate} } 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") app_RLum("KDE") app_RLum("radialplot") app_RLum("doserecovery") # Further apps app_RLum("cosmicdose") app_RLum("transformCW") app_RLum("filter") app_RLum("fastratio") app_RLum("fading") app_RLum("surfaceexposure") app_RLum("teststimulationpower") app_RLum("scalegamma") app_RLum("RCarb") } } \seealso{ \code{\link{runApp}} } \author{ Christoph Burow, University of Cologne (Germany) } RLumShiny/man/figures/0000755000176200001440000000000014175060542014367 5ustar liggesusersRLumShiny/man/figures/jscolor.png0000644000176200001440000004647314175060542016566 0ustar liggesusersPNG  IHDR?LtsRGBgAMA a pHYsodtEXtSoftwarepaint.net 4.0.5e2eLIDATx^ TTg,],;,2aaap7C3MfMItth t MHiBD$A ъ"DDѲCR(‚C4I$9sRu[uSoF"""nDD H/DDGz}$">ҋ#5@^D"HDd }Lx^F?e/=xAUiC;>˗g(l)-.]zEK|tmY7} >gVhLzM4;Knp[Z#H/#-ɋIUM7ݍOl*lJJ8XtgT&I.־OjEK-xa'ÎBaOz6KϷb'حk_7x?HlxQPIҷ^7/'nM= Uu.2]F!o+(H/Ѥ|Ӌ 46lڭs $:9,\ Aړ} ,oڡ}.kewn,OrYΏgݓhQxw{ߵ[ãl\R ϼ] ?ri7{r1]Fso+(H/b!MvҴtckF ), ^L.xZz{{<ʝ,wgɺ#wd.lgW%OhZ-lv3q,|Ee5>sK _ ͗y&S[{ǹϰ֖+rk+n-qNtYDE H/DDGz}$"<>yҭ5A>V(2L*RjwiE}#GڳI/m+5Rj$*[#G7p9v[[7n,Z##832(p|}H*.m"b04bY1gvͼxk ^}0wϊY&J}p>Ҿk"떏j>iXOO꣱Wky?U1!QK%Kw<=&fehhH+"6 t ;Ԧnܰ14CQٝ-}m߿kKGbF|mFZo?ۼPD:NDKU٘T;zVW˄)ZSwhyq/k^%e2"Hވ> ܅^)vl٢^9Y^Q!sԒ :! ;YRliZqbiyT>&#sդܜVx\Y-ҡ]\o݂%z},nUseKO!Έ>/XS^1q(3)Wi{[m Wd͵[J*2|4bN\ tvд2ye`KlGtraaǙڅ}+Ol)oUOMr5݇\Uޱ71wG|~4s2e֓Zk1Ѐ ew~HVI_QFZ蘼\䭉+&ob9\i![ժ2fO.o&feDCeO4P@T+$d["aӱ ׅ,^HG_ h~tzVK,@tu~sSv\''u 'gϔ )[wxeﾱIǂbs)g47*ߖJdKV`^QtJ]}t7##ѝ >i-sSeO݊pAQ-Nv.|_ՑW;#hy31+"nD=ދًS##ݣoyt/s]裻}x>*}*ZԶx(طeDAl+'f>ܟ5¥;z,]'%WuU]([+授> A薏^ݺ- JX_M߹xZ}ܜn#R0m&U#OGw#>QՆ}ȕ׳Ŭ>aن@;Zip-h]Gg \{HEVCXuG5ڻxD/uD|}#~^F!h]G7[>"G"/OFmki14[+&[E|S*ig݌3ǧs kg@˷PFZD߯G""k#>YDE H/DDGz}$">ҋ#5@^D"HDd }G""kcٛ7oNMM .X#D}{ȷwyg ]¥,y!Xz*Yz2GވlFnF|ψ`De F$bğfD(5Bb#N!5J#F 1e=0H I1:$b gW޳t=-J?ü{yqҋ#=rJ'r ʽ}E1f1Әq7˘'1!4SL9`QSNrΔ\5ǔ!SLt !L{0ELazӣ O0L Li2،r3*8jI3df͸jFCfLfC`v39f2NbvJ1+#,4̒1{ ͘Ebٿa$f?{mo1kfEhJ]ze _gcj}UEmce91wsyœ3s19sbI0l5msr)0g9{9h1s̑#79= 3eSaރU0o1ߋn 0m̷bG09̟g'0s̿-VBuY` XZȣC͂mX|o ,i hA)[[ӂO-ʂZ NYpނKtXk`10Xt`q X¢*,*X;XcE"/b[,i,bX &4^ ؀E<:YZbc%גd%?ߒ K~nI%іY%[gKY%XRaI%%,鰤גaK-ra,{yt>֊Xl+gxҊy+HbVd[g.+Jg!+[qڊ&+.YaEVL[4VXbՁ%:qavaU6VXm* xXzb=6`wklҫ뫊#>Gkwkyš[l/55 k޴f5;ؚ=5u֜5Z3lʹ5XOc=u/֝X+n4uXz?{XoMXX_b~k/ݱ;klҢDllW'FviFpISNp:IT>1N8V^)86+~ӿ8}BuY` Xa|t_Ū"H6qsf3쌟3?qgҙHgwwμΤ;{|L3w348sΙ δ9rϙgypV܆܀s-·pޏs)E8{8gᜎ8p~Hp ~83qvkl_꣥;:D|%.|] Os.lv.$Ņ? .|'.|ą.w 2.B .0.3ҏK7.\E)\r . .ᒋ;hl% p i\~?.>|klҭeD|%]W~ ei56`^D|%эvύFvcqnHs-7N7vQ7Qi7λ!wCFn1n3֏[7nq;ip;qۍNpێ[G^-M0~Opq(4~p^Ei坥X:w^g_anl^*Dn#ݝrw~yt><yt>yO= WD{' ${I'xɇyǓ}TyrԓzOx%Ozr͓OF=yt>^?i/"ҋ罈"ы?zś^d{^|g^ʋc^{q֋f/^\Bŀc^x ^cx *^ :W=^k?^ ^xW6^o╆J+x+^?klҫ/~]>#oo~M7Oyͳ̇0~C/I>l!݇}xׇ>ۇr>}hAC}Au||𹎏|.ӂ|s)g7>]|'-$>/ϯ gklҢD|}yҗ __"}yޗ8_^%ٗT_2|yǗ|e/%/վ/|i/rݗ1_f|w1|ۃom=o5݋o =|7T|}8|7g} |klҢDGf?xŏHM?G~Ǐ ?*8Gq+~tu?_~]~2NW*o~E}_.~{4^ی_~߿c]{K?wwi Gz> yȪ"H6 'ğ_kyIuO?>ԟ}Ɵ/9̟ \ӟ3ό??u{ / / g'_? h/?Ph.KK>ytdddS<~r 'vPg*1\ -z `<%`Az "'%|F@1; # 3$2qpA LMAȃhBDoA1A4HP/A* DNTKa>'h/A%i|HP.AEVRJ"%^ (_ AO ei56`(WG"ٿ?l0|0qLr0[I`A0'`S`9Ls0iF&`ƃ Y $XCv/LY>Np5 xE ~tL<,BuY` XZcɌOLTUU/CU !6^ !BFY!ŽvPBiB8‘BhABKBP AP!̆@,! !DEK"%:Br}RLNBv.!Yd!$B %䷄_ ei56`iG":Dh(&MK$P e[(䇲+ݡ?PjB"S %E(PCф2x(:K8Cj&TIBz/!]K6B$t+)&/.4^ ؀E<"|Ưˆ cs #10Ffx?8O(Cơ0q"ah C0 c(0f l †#)k%LFiNv0m a}JDŽ}Dm',t¶LX"a#l3aQJh|W/]`l^~o*D8rD)}8Z8oNV89SNQ8{΁ps,pÑs!\ Z8} 3l8>A}_#* @F ?Fa=^@x9gAFDxx]6Xc}$" .lE^;"(8*":NFp&\J\/&"Y"&&kDtq D' '%J"*(%B"vۈxDNH ""벴#Gɓ'$:H~+1H#Ɍd{$Ga$"IY$#9ɑHGr24Er1+tD?H&"Y"'&H5D^!"MD%RljDD%zџDG6"ODo!:D㉎ !pE<_ˤ&&^^1l>aW c,}1Tp8c1t bhR 1t@ #1L01sL3B1=tN%bZ9GibNsTψM.b>$}bgb 5b^%%b릴p|diG"1-@Kb,ɱlek,oN,ƒKA,i,e`,Gb9K},biE2Xzbe$Xb!vIbG .b*m%VFl#'Ol1.&[Bl2 MiȐ 8ҢDx)Wx-7H#38rȏcgı'qH⨊&8Nq&q\C2Uq 1dsq7G$q# K8%q .w3ĝ$⪈=}BN%.L- 5^%%z(.N0j篳Gz>YUDFQ|<$z<[y3xr xJ㩈@<94s6x.s9z<#L3sO?Bu{W_ 7G?D+/%~7!>7J'(4~LKeG56H>yt>JH^KL`[%#4%P@u8 4'p1+ \M;MM`2H#aQ!$\!" $HI8E PMB% H(#SH( a LIxHxUh֪pE<:%&lM$#D'~"&I"{)ODD$RH}"9Hs"D$ґHw"D'2d"s8G$$^'QCb7$^!QNb3HK"ϓ8DMuIL1 Y-I\J-$%Ib0$K9H%i$ IH$K$$#$ՑTC!>'HM$}DRILIzׄ릴p|d7cU}$rGlIfk2d%=dٙLQ2%ɔ%/d's4/iHL2iMR2t&s-dMf*dH#yQI#ɝ$|Vϓ| (ɇI$ye$\DNI%y;Y$g-BuSZ8t>2dc#GࣔH)d-wSKvPBi {Sp0#)Ԧp"S)HShJB )tN/RJa.RH"e!RHQE)Hi"EJ)RNRKR"!e/)H#]RIBiܧ4Ô>{{3#-H!(5?f*YlO%7TvRʧ|JE*R9JM*SOt*RiNb*SQҕJO* 2T*s:GcOj]*ILERI=GiRI=Nj H=@j)E$5\REꛤIhnJ 'Gll}$|ƟLc[撚GiJ8=i?4q44Nј,4i\Ij4zOc(4ҘK9ҦH#m~zHSv+Ik!MFZ#i'I#(iI$m?i!]}DZiLt*Xp|da6HG~}U}$rG鼕;~:L(O,t>O*#Ԧs"SM|:\J-tMg tәNg>I&}aH%HDz+I?K)O^KҫH ?#SҋHIz>C;%4^7L#C66H>yt> 3x/ >`WdP dp( gP 4eК 2Ƞ; 2`< 3 ci2&c^2 KdDdԓq2q}dQBF1<2##벴#GLeg3L>ͤ4H29Iu&G3d&ˤ9 (2iϤ3kh2d8L3τy2's25d^#v2d^ sd6y:2YMA2%d%O,"s'dOfۄ벴#G࣬,gŎ,>bWYdQž,dQő,j8ECgeђ,.g̢+kYhHYLg1YdM5NYҐu.d]&"Y-d:CVY'Ȫ%YUd kYedUL.>"kYdmklҫ"H6y/0ei6FMe69l9lgӚ<+\ͦ+u6}\f$lφyɞ {d&d_![Nv+>Ki>NQ]Id)Ed$C? =,m,HU 6l|wԫEXtNTe6Y##('sϡ s(aOe9@U9X_p2ДÅ.ЖT9З`#9L0|̓3M9# GN9*rF%r.D9r9I#9U g9e!) '벴c#yaMe!lƍ[;g7l} @Qn.y|Ka.i.7I.Υ&㹜T.grҜ\ґKw.=2h.2 ΐ;A(Cn7䶓 "=C)rO{r[Iܽ~F~Bn!'4^ ؀'$6D/ݛlzA9:~vƄCunQ-hVTؤSࣼ<>cgEyΣ4+%o7yE$C]t_^}5]\a]W37*i%ltB\(K-BzEm5zr1$JSt[")|)ɧ,|$p>5D> 4s.|Zϕ|ts-|g4|fχygȟ$!%]+ɿB%[o"7אKȯ ,m,XHF~l%$yksGzaMo}vy|T\LI1(bs4XŴsE1m\-k_`1#Ō3Ul1 P@,SSJRx]6Xc~| է?x)[d!Ry)K9TʑRRWJ}) 4"-|)-\(R)WJQYu)RJ*eRJ-eJ(tqJG(tR jJUvR (@i )RHiQz# Sr,m,|$%er#)C)h99QrNsY9M崖#/GQN[9W*r(gr&ʙ*gr(_|)'(|(.ʯRFr9孔7Q.,)?I ʏS~#r 벴j}~|#࣊ $TVPUAuG+ NVp3H+8_AK*T +@U z+zV0Qt,T@TLS1A(T\^*Qv*Pq TPq )g8EI*TTSQEE%,m,-H!H"RBj 5j%I QTLBV r m:%$%h$K0,aL„i $ Y@2d1$H# Q#Q!DD҆DDI3)F$ H!ERIJ,gRRK>yt>ÕTrJNTPJVrJZ*XɥJT^J*鮤M% V2RX%LW2WB%T.P9G4TQ9B Tj졲.*RN*/Qy*cUs՜L5jd4WZj.UsjVUMw5j4WsjFfjY稞zqG:TkVSMuWn ՗Hu+T˨R}STuTFh.KK>yt>X u5d jhAZZjXå.VT5\M 5 0\h 5L0S\ 5P@53LQ3N(5 R3@jQ%5m\5i5Rj9EIjNPSG1,m,-H!ZNrS4"EVKS--\E^+(k騥ZԵW@-C2VD-S2WB-.P;G SNP;FCPGm/jjZ%WUP+-6Q+VJm#=I j벴#Gࣺ:NqSu4!CVGS-u\C^+uq:Tu\Mu\c:꘨c:X樛n ƨnSkԩ*u]NA ԵPD:)uԝ$u'w>8>{wi Gz>G B&IEVCX. !zNsi=zi\r=m(騧zW@= 3Zx=L3[|=7R?M$ԏR?L QKn껨^I}DE[ozRP,m,H{455i4mE&CXVI8 hj.6p 5lT \kM \o`Fo`foF4ܠaYiaQFh: 4hh *hAIC iDEZih RpZh.KK?F>ҾkϙD vx4kF6rY#M4r\jr#m(Hg#F5Ho#} 42P##52T#Ӎ62ȍFhA<4N8Ec48D 4KchTIU4xK4^-46(g벴c#832(pRI9/YJ RR.I,MRU)RTRJHr]ʐa)RƥLH2#eVʼR@:t )HǑ"F::~HHv"T eʑ^@ڂy벴j}?VUHB^ d4h* 2d(e\)KF 2d 1"cLƸIS2fdɘqC!A6l81d#Ȇ "@֏LY7.dȮ"S"kCvEdȚ5 ei56`iG.Gʹ4s\jF̕fښQ6sfnZ3=hkf 53h3cL43t3353̍fhA54|nh*JhBK4_-BuY` XZѷQk+[r˭\ie+tjkJ_+\oeVFZmeVZneVZ 7h]uYZiuqZGiuAZOkznZUvAvZzKi(4^ ؀י:ʢ3zCfd]7 k){m~_٭ťۇf}$sIB9mrr%G%[ZN^9}r 3$gDΨ19r&Lə3+gN΂r@|,S'O C>|A!Eރ\ yW+!\cKl 8ҫU*S/|4Ӓe1ݝϖu<G W)hWTСSAk zh)W0`Pa# +P0`ZY P(fQ̠F1b8ڗV1bA(QРAFq EN((Q"4^ ؀ב~hhԵ[m.֎"3ejg?LGg7hC[O ޻c))3[ܬS|ٳ߿^{V6m\m6Tmtq6zдFm 1p#m1DmL1lsm̷ƍ6hAm6K4mSM6A8m6Lm O[mzimݴh뢭)ikkln~;ĝ7P|*`'0vjN3څ7KC7lhq/w֓k㫇6oԮgJU_&#-k#qUI.%*%J)Q+QҫD_ɀJ )V2dTɘq%JL+Q2dNɼ%7Ǚ(P΢A9r $qc(GQF9ru(QjPAFy e7J.( ei56`o;vjgjIC:B7d.]w[enf"~]Jee}IW'N;։Nz;tI'\dN;dN;dN;dN;YF'tޠsy:蜥si:蜤sq:sa::tG^:{Tyn:Utv ei56`߬*G塕&>+c>hQ^zRWJEk**zTШSѯb@u*T eTŘq*&ULV1bVŜy *nMT7P-G5j iTS&QMG5jՈ.èP jU?>TTzPQ]C-4^ ؀y>ھ1J`v+g4´Em~4s2eqjs<`ٿ&J2Ҳ>RQӫFK~5jT3˰5jԌ2fR͔i53jfuS3fA 57P2zIuC=z0!]Q_G=uj.{벴7GG2\Ԓ>= W|{eO->Nl`/yLjF#OC]k0˰ i0aR) ft0a^ 74Ԁ&h2f͌.hL2fQ]F eu4[^KK|5!7\w!^!I-W0 (^-kY,ݿ_j?}?6z? 2ψ.2τ.L2ό.2ς.77A.2K.O2I.2J.2Hut_ ؀WתH䫲>2 #26ȸ.L2˴.32 d. 38ˬ.3 N2$2.# 38z-m,-hx]Fue\ ]&ueZ]fue^]nrso2|C]ueV]ueR ]ueT]gi56`iG.GccBƗ3ˤ.S˙eF2rnrSnrC2rftej9L2]Z0 X1G &3,gv9s˙_rn,.Lr3.gf9˙Zr&gi56`?ZUV#! Z^߇^̮̊܊̯ŠXarnŠ̯܊̮̊,wW X1[lCRû=;=' =ygygnܓ{2O,}W]m]u646`GZg \{HEVCصG zr!r/ˍ=]=]rzsW9߽/||$"rVê"H6H{@<%O<eDKg2DDGz}$">ҋ#5@^D"HDd }G""k#>YDE H/DDGz}$">ҋ#5@^D?WRIENDB`RLumShiny/man/figures/logo.png0000644000176200001440000003656114175060542016050 0ustar liggesusersPNG  IHDRuXE pHYs.#.#x?vtEXtSoftwareAdobe ImageReadyqe<w,5ctyWu:ޮRQ/Shb<fZoGt(,~9Y`񋨇Q̱G_ɷ?M#ň9"b/4Agj?@`I̱p ,r9/c X"^ i1o=$o.%빢7b%.@rQwC}ڏ%.3Eԋt_,qxEQw*X,~u+1 h9|{Dߘ:ߘ:O_MؿG̱R);uu,qˁ:,~C$XS O헁P!u,qTl9Qkj?!eu?-qOd[VQ$eu,q\i9ʐoUԙA!:Tf빨c aG5^d<u,q lH uQgj?0[&X@+%.DY$鼹D˽:J@oQΛȌ2 ( Q EP-_SD_[QWLa$Hb%.@"c P$>Ze+Ĝ.P.ߊc >ZSr@¼QjXcXxo$tEi!o`*}zfj%.spMԱ(7-~KV`TN9ߢEK\0K-XԱ\xۋ, tA",J : : )9es.SS&իgOnUghD :LSL\4ܙ^tz|wIĒ©cqgyhǹv:\r" rCլɅo9JqٌEz6ϾI}3+"ץy_#';.A_:²k.AW֢JQdeU_ g^[/bo1EFNQgdf-jWپVDO^'tՆ-]!)\nWܡ{89"D`?EZOW]=Sj_wlv7crW|vWW,@Ћt>.ȓ';l!_>w% 9HK r 1 3dPj@4n ?D=|k#Qgza_:cQ]zNJ[$ !ԩ..V=9.\c3X(OXT+" M}#;fWsu/I~w`x )+qa؆3R-Sϕ ]2Q\%De@ԪY.rJ]Udzr"v`ƹ$4ub(ECW^yTϵOȝy1VL"nkNLsiʤ:tƅ"z/ti!erk70.jCn{D^>ntԦ&) 'QoNBcDVTJߐs +il`Htw;p8[ǯcA۟/(4C+\hteO-aE1](VA?ە9i+o']]u.nL7&ɾxr/l_#&dn!VݕM˅t,EXDRc۱vȭ!=$Jt,r5e_R'NR0O8v'+w]iS'mcqu? ^)Qiٛ t}RtyX7q"2*vHgFmYV Vߝs #C]@AW*{Si,@-%ޟS*PK##U/~ζnB-:@ B z)ߣ1H.y*ǯWXDr v|D=`=Wtn]7/cJ'H$U#)e,Ԛ;vk٥sEQ3ಙ.깎At H&& 2J:0ce:XxĢ!#)-Bmy'ߓO"'˔ICi ѡו1q䫅+evwV}y]6;Yr0^uxsS`'C تZ!;B֫ln ]Pa7J@u29K:76pcXdInmY?s7,3^c/rXM0kt'C1 .pzlbaw26-ytf *e”ˬ5IF!~/p{U$'~QUy)셴iP 97f>-ٖ1@0fc'r7.t|m+R N,&U"v0[&-ABgjy.XyiY*^"+;9N0WN֒;$raT滱,bmO = V)+jy(ݪW؂HR,rapn* ^@b)UN R'A\S1~0vK>l/rA#J[8$mdue7s^(&]uI@7F;o(&]u'55…Ŝ[2OF_|&Jzuַ:BPQ]А( FJRX> ]!&Wr"U+X<n4,ˆDV)2(wNԅ?8u cn|6c%IcA;?(wRԝJȠ /̰bS s%n|Av.Lq_I9I%[6uq%Pd\eNóNl?D][ ʌ2ݨI-!|f(S0D<=Rgnn+mA] ˏN8'oֺ-;t!(E2$Z֔h]`Jg(f!<:DR-\9W$5#ʑz-`hώң0VR Yz`+h]n˃R*H6S1a7wZʌfR]ۭM<&b(bmWu鈤z+d͸^mdQhp*a4 v2r9#*fm 'yԤsl/pUHٔmDnZ JO,f۲Jw!o%Z_G4nŗi#y;] OGxc'ab0{\oވ/ַնѶ%]X}h!a΂Yje2jڻ[()|I9B;bAJXGvukЗҺR*1j0-|߳mBݹh wV)UI9]tQzOtEo-$|erƃ}#U|IA0\zQWQ$ʞ: ob5^.DbCTE v]eoD"[Oq5Q2B [DߛQH/hc yL>H VU-bu3 :  @ NGőnU?~{,;:͓Zo:!Ua<ݧmoOTMLsL_[F]hmuNvB!mnQu g qq;{H9`$K NQ?EڜB<ҭǓDJ3u;sG`tt:lSl1jV*FGT d{a$#NCFIPi)#*1ԫ}6!ڡW]N!vhbD^Y'5du=)RЮ)&_5أik^Ln|,Q|`ʬI*5Mj`y#B؄ S4UQye8:}:tD={hERn:Գ+_6p>שw}:'NHFEԳY<Qw5R1 h0S̱jii7=_'VXDH=+*p2Hب1/^g;H!zqQzV}:'Xx>V\B}jɪF-]Tח6`hhȕ٭$SWD`>[v}^gF"uD!lٲE߄OxD~ozPj~D@7D4hCKQׯd. "PLd `@ԉBʄRb*`(;b ;E։ģauqH:+bN4>%+Tޭ_AB}1"W mPIy!LX5c ^_uDh!^'%w0+I Q/Lq =W'R'Bт_$i<]d2JU[NȜ~{+*qx!%*@_DHMdjddijcYfWm@uZs&uo%T>ҜWuPQIn.k0A.klD7N WX#R+5"ꮞPz(IdUPQH?00ΕKڜZHchN5t G}"~c+grs?DV>24:O E7TÕzXȿ89Eߙ=/VYQxOt<`"Ҭc@ ;ȩD7vP:OSS>hl+kC4 DB2"9o{/{OD•A&X_,^3y&>充2u(Eu% =ve^6)ǚf8d[[Bb|LIxUtߓ_un~7d5VCʺK 5jϧ!n/W=ozEUu"dQbQ'RHzDꀨ;R7G;1 uP,x<:@XhjıuH TE_QD=ܷI^:g)Q[S35L}soR gMSꂷ.W#iOSu_+/c+ \ Qp̙)SDZ H?ppˍj0-ꒂ^=$2߈:/*"(M 2W7D\S}Mj3)ݣ?~{*Wi0o&xxic@R?}8"Hf|zs^e^N؇=Ea7/ɡ=MctV,:gwɯeX~McK5 KH=2{Z2uGM |N|̒3*~џuW> g|{Qus_p65t:scj=-=|_ '"ڥwg+nvoOEr0ZQPvsƗF{K{Aws4\E]f<ZG )b1׬QKTG|W0D Ѻ6`틝^M0OH4f<'-oͷk{߲4\3/+n]ZGfXHu!g|Ȕ[?Z׉/L ?ȱE]>Yu g$iG_:4uz*kk ?tJ?ubQ(7Oܶ8c˿h c%1; !{BC2h*n>!m9sjɷlTC2=!{DY׶=>38>9n5{[1DյY.Ľ{.vo>JJu?~II|7%&AS%%3Ģր zE z3{ ~?9#UosԷP P-_L-[vSV,:W9Cإ=ڢ>&,Zq&ۍvdMS8"D{N ,^Ocuwu +USS늙ccgMjb!cfUS> us<ЩN>N]?>򑏨U>ޘs?I{:5ݙ.Os!_/MՁ.5/SɿyH%Ѹk"/)ܧ>g*+8e~XH.nD=.WJ]2Qu JK{/n|h"ޡ]$BA7V7w=j}1VYmiúT],]yģ],}E;d$?5KfCo<~Uwݦ\8AфE2ZbG 'с/?rNꢕ<}jP-ܪo"֭S6m'XoS\rZuUW d l?~2U6I KWϯ;3"R%#0CW,J٤FĽJr BT̟[kFhT .Hn_.iVW\Qb{7/C܍Ԍl=sfɣ&"ẅލ􌈻 kXxNf|c=՜Ԓzw۶xdTjƴ_Ƴ^#D=|^"ZW~jfu.jj}ۿ(=f@D;h% _=f#/uXC&2ozwc$U$dm$RG%W=ϜVNAԡ,G%5֨]>ӥ]*d6mڨ.i|"~VnMo;A ee%N詭W_>}s.oj(o'*)!Ԡڦܭ;;km`iD]wV\=GNlڳ{O^7ѻލ;m=c$.O&.U62IH. sRMY"y`!g?ЯjknY(eF.] kD"ӧOWcB"nι޳hjeYuiRԨnZ|59mW6wj.5U{zw*1ƙTPYcSjkj16~K _U6=kڬ:*yw]냸ǎS}KfrA!]*dJ- "&QC=WbOzEUKTBoSMɉ-^m6~5o@*^V5^{}Wj.&D}Fk3?ZZ1J$}MrIoAmS[IhL]MJ+BDȵm߻ZiUê*"?#Ö*O 2aS_v}Of{B-j?O}tkcQ-s(4;&%#*Z}'HzNk":,[-w{{լoW5Ѥ嵊CdY4VO[⧔Ϝ:9MzԾ~5iGnn­YNfJǐMUHEOPXx^-$3|u8k)耨RΝ l%su?GARY^w.CqWW^#!߽rb0 C.ƸČ3u 2_ф7ؘleW^Q;xh`w?uqF*^y%uJTf̘_C/د^{u;_LHFr9e {?A#@q5קmdEE"jwWw{QT١zK]0[5^OhjJ]]Hҡg뮿q 9Mѡ/Ķ}Ց zNQz>\Mg5Uʑ!TFÿbIWL AO?c.AvϢ@07 Ⱶ /Pڵ+v~.d(:vZ5#HEL?ƾHAy]T|Xyj5445k>>}Ͻ}Li'N>d{0N qH\r '%թ2܈_ʗ|uacٲk5׼ϕ-Ξ=j/wx"Bbi^LYu UQYN ]WR 249iJ.4I\ymvOw~X9#EZ)ŋ/֣A_]7-??P!ߝԬ~ڷ/Ter@%zrɜPlۧkg 蓚o7CU%-B1v /Μ9l٪/#G2s2 .P-iI&iK}VtI."Y%Uhcܠg$oCjhгG^"#۵kͳNɷ/X ql?jus}r|ֶ b͏t+DiMл/O[Eiɐ^ E u2\}j[挮&H$/i+eڴhs GE2ģ)OSN2"41c=]b[\wQIɴzid0UrKՓ[%?~} 3RU ܹS]s5sϵ|ݬYԙ3$2~?etޮm41W2 :گ;q9hAcybb+֮}Vy2e z2=(f^jzss< ɛIiyv7[vhZ.;{k׫e@fjܔUUup<˫7d$jhbWWZFZVF_0Eίǁ疽V]L$r묗o#u17Zqq)o %d;zt0q J]K+OD}b E+vة3[ @eƫQ_2l~i7{țKMTiMܟRVSZ[GNDm2D}T:. dTԮ/]zz>WUCwKJpQ/KgK ѬN[>6Jɸ^)uJ%.*䨪bul(ܪEVȌlQ~B_{7mTKQ:*\i՗~QFyX.-oڰ/#>RP s ?Ol_'TW\{= 5xU[? ԛwN|G_Т'ҢIO/| skPZugHtRIZ2_F6yn ߾G %._[=*ȷ]0;{ 5\gQ߽w0ydG@-?O:$b" *QkQ7@JJfW![}oSwuꫢyuAèa5q=-d$.^%1_R-6-]am(||{#|;@K{\A毆^ƑL ajӑ( aH\"s?kb_OY s<}$%S@K\j!oED= NQN}KrGK\D{q/@Taj?f+n+R٦<*sfN!V`SoO{W/@Q-dj z7ߠR.8Dܱ(,q0;6`Qܱ°ej?Va z-X"Qw,~!69?z_4>ZQEرȁ%.NRY{H oQ/#`/Xb9%.΅%=bQ_ X"c eØ/16z\,qu^ܱQ_pɛSu(c %%.v,hE!/8ǩX"Pc yW1QW_K\@/MiWaXo.X=q70苻/X,qQXF,qQc!D q7H\AO4"ys}G!<@up"X,qQB"ys@~@ԡXq7` :-X,qQ/_qj?:\ܱ-qۘ:|;CP1 jK\@!hŽo0ubv,qQX),~3uckCT=7ޞ>/ߦ=-Q=VXqH[b :Q#i+ys1bj? Wq/dS@7%n۱DZCc~,qQP {-~}mDub9 FaN,~Dq//x#[8כ{7JLDb'X]rXK d0!XG=u`#X%. EЮD$qXಸ{nSQD}MAa :/ޒ{v%. ew7-~D ^ůt m(a/r`u@v%. |m K\@B+%.D/s8&-IENDB`RLumShiny/man/figures/twitter.png0000644000176200001440000000224514175060542016602 0ustar liggesusersPNG  IHDR tEXtSoftwareAdobe ImageReadyqe<$iTXtXML:com.adobe.xmp tddIDATxb?54)R (eB ~ ķ8fA @FA _bdo a@ |+ TCS c) bQx'q/u 4)@F\X@92 ᷰ2 "2S^ -4 I CPB+mhu fg=#@'\<ϰ:@a8@tZ02ڀJx%ASޒ {}IENDB`RLumShiny/man/figures/tooltip.png0000644000176200001440000004663714175060542016607 0ustar liggesusersPNG  IHDRlsRGBgAMA a pHYsodtEXtSoftwarepaint.net 4.0.5e2eMIDATx^Xyb46XbbÆbI؍-*cAQS$E%@Ei lHμ{q ʁ}uz|۝J%K{,YE2Zdhɒ^$%K{Ql uBT' OLw} =XESVջ% PU2*+GJGc;q75ufkC.WsXbb|ݹs',9(w\LH6_@]8`#71(D5X[!.ORJڕHjh2q/|1_V"wd+Z:2\†=q> @&dRXEm`F.r!+<>I.0yV+ C*jCPF7DGap-ZFɩ BdG'@]dnMONһ<@IxCcW8+%%+2&Fv|%T2$Y$Q_;i㑯t.:FQ.rSZ73"du[ڈ-%KCk赔W+M>r*ܱy@=Ued唦Oc=`< q wh+]k) 'o@, 1$K1C XCZkWF% }Mz\1qsyȂ\eWV<AG'M0j aǗf(%L:ZEF܌rd &j*?d(:%KV鐌,YE2Zdhɒ^$%K{,YE2Zdhɒ^$%K{QZ}>\E›(ЊL̔CǠwB+"1SE2Z L9!h} *v3OXj$/r E9}8< G6)%VV@saJk7y ݁lcvJ AF=3RJX0'QԬ_9C=lr.D^9up9iY sv퀌Bc2eZZ˜nu-sKdm|ơZvB~c{^ݦ2H8l"RH=ͫJ^]R3Z3J[1Ͽzz97y7}yrzQʕV+msj%Ƃ:, @FW"@f!\1 YY uj 7[l5*iQ:P0Zf@B΁P]SN Y|YWZ>!j;1NXRE#А9ż@ɖ㊱u|NS\scW8QHd-any粳C9k:PZ.QDltz)"eh.bD[ OL9!V^?%qAcT-χLxks꾾HzUX"FԗVUM۸pTk= K/Ѕ~ ʊ]$jKFlI61 SAT|BO"13#?< NMĈ*۠IW+S@+CΧod HԖVّ^> YZs19D?UK$jKF,QC?nIMpEףԾӶ׼PDmhŚB 'c/8ON׻"F/Ҫ-:zWe -/Wz)o'g_;]Ĉ*}jм]KiCfo/2$.odL|;cFՋN1dJr fFz'免92pou0̏G*׸y=/bTE R633+_:W]HԖn͍,/l@0.Z hc,ᅦKDmhi0kcA8/^iHpˆG^:GL+7TEG[/:Y^=1d4Mu LZ-jԦ`x8Ђro6~ Q[2Zf=F*7߷> .~aVH[%i&]$jKFK3T>1/PK{Su굢1dJX - r.&/c*a_(g}x:ztU]Ĉ*I5j?d{>2K9/ܮӊﮑKDmhHItŧso~I^ _(vzV0zWQ_բK&.4Ral^&St*Jzݥ.<8xaÁ Oy-1y%@B뻣>w/~x'}. ]}]oTuUPD OKLNION}琒{g?zcQ_ju &\ۆnB-#tSLtE,fezcQ_jmJZ:;Vt}<4gu)Nof4iw3TUJıE 6+bD}ݥGx%ES(+r"_71u@j߽f=Gi'4PAǴ9YPR"ј7$1(8ط oߞped&oVEdU]6Z}BX$}#.f+`1o*"H5@ "#ٽ*L[ ZZ^EIMKi4)K]*r!'bhHSDi=qqq)$3qJb["{tBVzRldDxxxDTlC$Z4SYXzhW-_\Umc&TV[[gTZy;Ҁ:? ܹ}gWV}ia>+m>f`S{FdFG5tf#oSQ_Tڰ~H3A&&ZŶ2Ξg6 {By5JJNB3SbWB%%rߚ/U\ـ,VoPZ)J!6ZlfklocccO<չS` 6{xb]{Ɖ#>%%[\]]_|v.]Q O |=}rVS`DCb5zvf[Y+2R⣹X3ӄ i̔И_~YtR:ԸЈ8)ukVV\UխQ\OV\\j\JBNJ}V6?QHfPBjՐUdT+%U+PYz]r_SPj-檭]rXWL~*w%&Ѣ{[n '\Q] zBR $Kuĩ>"nS[<4`-LV-/Ihea3ED \0q8nɱqmzBdxD|3'DG&!CVQq7{G'3'9&%gdfŅ}N֕WUKjvM#$(!6\TVF"#ɒjgiܢF}ZC0mVGM^1ϻQ0jӴ)Ӓٯa즥"BR1X@棇|8)O*-w.w?ddnoÆ G4j9+Oy"W\*KL#qNQZ< IN2cƒe$GClBaaaQI쯞-jըV2wd b)֪=kjU>:jZA!b|Ϫkvx+ehAwSf5jrM YK Ho?vN)G6f0I6-Ǻ (W4 -(+=%{2FډHV!ۨi~V%Rɪ0k-rybuX"G޻r*D_AI8FGGv>|^z!eSSY,{ bNϞ9n@c*Mh .4I*!Y=(j*ZpWZ 9c ~4yxL`\0o˶mخӚUkF+.Z_`̮79sIğ'?nCQԆ_dh13f $u*hŋ§I^R2SL !IHPBUiZ Y?6Z4p߻߭sw@p=@xCtAje"ԍi1y7o)Z!x^xՠ[a-c#cg'gDFP`bqG !Bq|v @=msE"" ";=b33P+Tՠq//* Z δuQ#,fYf_f2}_N\r$Qgמ֭ڐ#WC5S6B"N,.`ÆZm˶i_O?|~)V_GEEWJ}`jvxGC !X!.ftVn~B+`j”O.]r4#9nsP*Ah/RRQDDŽ$DDZ9`6G^qĶk8(3 "#σQmbb4SZXTS[hwĥ6Z(gI f{2GTH5K54uQpp0"$!G>2ee=wܾ䩘>y%ً'/ !FYh"#mxeԗ{oٺO·(%npۄ^f6nVƢrzQR^1jm~vB5R-r?+/wvrvrrif>j> ڷw_LL.^8xА ofia P'9jP9c֪= Y`(R¤PI UabCNoH;DhŦiqTR*h!>oݺ%dp߇ի|9 qӖdNMI;{{||+帯KK #C#9U BȏJp_O`PN#~ys{gΡݣʪ%\A>XH~(6]]L RiDDtIӧ1OU/PҲ*W`: ~!>9m;#m=nފwͥa]2ۙ˨;]|lI|QſSPO VfD[e<ՑN ZUj֩YRj,:V'=&.*"LDAI‘HERH}WaRshD̔x-PDD-Dؑgd*Ahkѝ?9nuS]+1ݮ!|b6dQhNK ZtTbh5xU(B$ٟD1e&#""HAh'(QU2זhݣ iZĤ$DKs.O0`b+% c]^ YUml7urǵk^~WFQ.&/#*YPlFJ\xpP```HhT/׆שX]6[JDKUZ ?ժ\%ԮUOլIj,n*YnO"1*W^ OR5mX]'-S?R$JW7 zbϪ'%ʊHx'p ca̞εdfjBLDW7oz<~l! MONNLHH R>D(k_JҒBXġȸ"B@Ǖq,U-ty$2yo6&'Z8,;y$⻮ ^~ąh!?jsz!pm4(BU@C?AQp?ZU˗\ {VBO9*ڟd1*D[qIEfi}Z]W0Za $;5O<Z+](j+Tac= s%ZU+(6QVD{>2SVzb֌t̵#~aCM0a{IfE|ڼ5 rZbTllMff_[ vtb" O(Jq_}ϒwcgn6j1}{;w ;j_0ń6JtY9)yİb\rrUpVc]$^K@s71 fzRtPd WJMm؆u~Zze!xZȸ @Fj+r@NZɣЪXb9Blk(G3GT@QEo| Lxϳ}wܝmWHL#ߣlHdLJll||a|$.:9($[NRV^lȉ>DSSS[T*OI` EDdzG20/zu-$*A{wna. ,ǯZaڷCLHLJfjRlJTThf~wC?zFGGHZ(9# ׭Y%xt5F׮q:l$m8 dQ!ZxbA_9z'fzb ZwzLJaUW@|K[b [qjSu.Hr{zu4"x+NwdrX'EF$*ЊOT@K!Uw|F#aWVJyU)/LXV6 RZ$ `D\PAh))" >hǔ64O,¢(35.(,n欹SL|~ڌk֬KOIA.p#3PN KJMŴ0mʍCLsS'zpb[Pz? ,Zj-hȡǎ1|$-n-UH#L݀a\ 3:7l>3vZytVGLvmZ{ՂLͮ]vx ^i€-GlhIlKBiʩHP^5O*U]"ҭz$m6Z4$] MM'ޑѲIsk)) ':5k޽;mn|Ow?)fF>}&-%>"Ӌ Lt8zo$:ux`T cxB*}^++5>*4$ ֹ6| c'\x }xG= .^}tYY~E0q/N1ȌKJ RғRҿ=|k8=I5a7_?uDbjzFJZ(+r8{-nƖC':a "tg={Gmy 풐dwnͪ5˖ 8`}Lozzѽ'|Q3(˳+ @w1)5}>E80_#z? 񺹭]0（D|!a;Je.xŢ~ SEǧv)Da%l~[>x ;ٮ-7lB|p!h͛~DC>~^}g\uԾSiB1]Gȹ#lzH32ć9Żڜ|>~df6,蚴+19 jNvEE$yu<}@^]U1n\rYֳ iffW0ٺePNHHhݪ ݙO׸棱Aw5FBʃZh` nP!z~}cϸgX\J-f`T(ɸJB p<` 6v-=/.<*C .3ɉ?y$r;Hm 1M7(Ull,텆 P ȈH z?~;=dPTʠZT!EGE";:(t"#oar2(@ Dsk#}kC6_y + x\zu#)"&~a?^Ef[,0 qIm9ˆ,LOFG!Y5[;[*=8J'WEU= qjIKAUGYYaRr-y-tnf>x*OߊNLE Hx>o[ndOYyVЦILEqtwOն3SaТT]Aq ;1fhDFcPvJ/ʏ0/0B M7GD⪥h6|nJ#{sU 7ٿ/ُd90Dl/< ~樂W;=ePFk76(KUw *עSQJH3G ETU[Qgn _!7aʖ[7lq=xd+2Ѩ߁q3<6)oqe* +` -k¬Jf۬&\*,,x ^K/hvZq#U#ؾOX8pTGI铧K,n,^j -# +kֺ^g/u^_<@swЭמ>z{8 #8}DYֵw_Fq7u~0t!.*\Js;-ɣԗhaF7~nsf:+^h73{ّf#F7pB"r/-0ؿ]{폠u4A> :U }[:E;_Dh!YG< _۞Oñ L, 0V_1<7Spn(9ИHj k6u_\%ZY#41414HjEx?J1#~|סmx TH~ѣG#\sIbqϪw]JD0?{6anGG؛",`(n`Cb6hE O3E0[z?Sb#,fXSfA ( y-j L< a(h6eYn}THmv_MSgY^n=H1::{v4x'G'Ӿ ĪVO(eK]x)$$b='0҇^^^ -u7VXnaГ{#Nɒk#vP@E#Z"b 'G$?o( !Т7nKމZ-k]s߲ e{Q PA0=rT v*ǭtQbo;Ξ;rA-| 6؄4ќXŃ 14sə a6HA7xw֒\ƨתHك+BH\|EFS`˨~A*<8>~}7ox!wuuu8`PP`PLL̦ N6BDIs;"#7ԨW# J"6퐏'wα;i#*$BKZ6aoIETj?9p׮>>|/^9vpbUX_Nf%t E(J:QGLAu~My4V?*½@. A(kJ63DHV-HaWVgΡACO>MrFG`P%&%EFFVTT4x_K(V戈ıJMawKv>[\kb VY+i ,e@ߴZ*Nj.^f@?)V_'$$׺Uî=l޲z {􆽍~\XyfV դɁǑ2-nߺ8;qæm;ARhH^C=GWFo\sQi ZP8.x*XtQc؎N7_G$](T(6nޢй YD WbB(ڟ=}wOXlasO{rssGC`x{yLD{9U[ewneVfp;;!7u9oooJeՐy-[Jl^Yx AM 'aBTW]ՉN|{D9ՙEF '& B^tCEw ]8& Zn-7oتp0^RD*0&c8"N#^tVH_xx8%AB*EpD $jH4R" :xH)!0&öqmJJh2_tL E@ E qd)8"J(ňHMS"\E4 -H:ݢqVv {ICwz:ci;Ekoܬp"(2fBT'O_-[>M?$TX$<,7} 귻w>nzpuuokd8]_@*X':8oh 3vȠ6^~ݩźPtՍ2PqP 43-3w,Fng{HA"#}_ _SU})vHM G41J8)R-x;~Dq4yv7 F6#C7n’Uc>!Ϧ f|3u(J1 A֮_%T!r7fPP,*hA=Eo>8po~o,`Cఱ':rLN>ɸ 'y#h/' 4aܗkWC)PDܹՠ 7G||i涭i?@+o`fj&޼a1y373G=v}("w!ֆJ SW-F$E oݲ 4Am>}fM6oņT*[%c$JHSC-}0KˆF щ[ϰxa/.< 챱`` ~0RH5˚դ65t!:xm6j Kuk~v /aq0"VJZR%Ÿ}DD0hV=!RU i̾a٧T"~~~; xCF@vu%99:v0 IA ޾pѭ'mTX˂JZ@%F Tj5WTTԣGlV=3w]{{Ǐޣ]>,ZImuLL  (KC6u\R-` +Ξ9 M?}tϮ=m:;ȣdMh)Qx-~`$XaZ2^O3AQLG0c?O{^}mنvzzw1kiZB&)))8nڰiw5˱_FӦL生 (-%*);KZDGGc*8b$BqPlWF@)֬(bԄq_ <`7rؐVadp&nHP&Lm9mtZYQCYϰrWcBiNFK4: 71 MhaBl ڵsaWè(]>x`P`DmDx}{[xRBAԶkq^uqttrsu##h:x3t4x!UKFK4- 4Ѣ1d0Y!: py{{w`@{`SQ|W,^EZԇ-ˤ"xu풱qPT--%lrtC=D6Zرk8:qYkW7MFBrHy\-^De=vDBZ|I&-kw2d:pAzFfJZ:Rӱ,-?ԠyzMZ '%+B>H3/7oHJnڧWߘa"y-" #="H~ڊ4fџC9fΝ;HEC6Q2hdapt2uWV^59a.ɇhAH QQQ!!!AAA=~6ۂS{g.D1ED +j`b.@ l4rbɠ5kϵ_u ;xM5?xfKoӖ^A 3o@y3Ǐ#-[+ik_t2AN.W]U!C`صGOp':ѣ[O1h7mA$SɠUaK5;4SE}УQX '>-Gx/eԳ pu߻Xb͟`ޜyѣ M}IYϰCz˯)"E:o/o-\ ?]ie@?f*Tbh`4@؂֩H0?uBN$R 'N݉SDi= hBFc^x-J DFHDB\7蔒RYGDQfHlK:lA*Q!Oo9ůBzb8?d*$nf=G_g.-?8Z"N"%.ںժiW]vj:j 漪ۨ۰I5t#KNuztLM4h%ծYA>W F<w>I+d*CIV|O>Wx*5u3@bz:&53^7T,REq5+H:QQyj::|1CtrFVYN>?.t?ɑ,: :B JВ*xutI*TMG4Bd2mdʔgմkaKNΊk(9mи~3hUeڵx+?SIӺNzu Zi1@+I" hbk&(*cQPf8NUQS3NT-Me#j?%  Zo3ZNѨU*!DJ%jTP"5-U6U[GXkU*inmhͶwi h1WMsDu⣚)55-$$Teq1$ĕhh!bbuBZdT&R ,q\kUWFCFKՄ0DFWsep߻swwF;1x @DŋQt:ܽðgXX3.B2ZeIJ.6Te4VyCq1b}Er@}46͞$W2kZ=19*uϭQ Ξt:cWV{:rAԓ/_9'>4a^:rK2ZeK8~pT{j:fmOg9Osz-?pd_f(B1B]){=1=sV.h4d\T[4edUNeNc v&EI PF&,tZҟxՉ#(FX?oy %-YET-3KZGu;-+ @e!y{^ZEOSh`/UK)>ISVRO/L#r6̧gQ5f)ם55Rň* gۍ:Oi+S(G-̦=reIY !%xdB_ԗ/Q,| ,/.̶4)ʽYߤ |_v@ᰣΓ ! iKr LgSllB , h }`YP^}wiI TkhZ=(Ծn6*zr,׼(.@_Ϥ[c8I3VFDjj~\/ {ipdsޒbMћF)8-f^ey8o4LM!4޹6S.( &ޙF5Og#uV?2k笿U4^ 1/.~$\;3bpt#~3ig_g'o}S]?|VH;,B(e`2wհ,wW+i.L@)0Va^"kXD!q2 %,u^X[FeI.xݣ)aKx qeil9^c߽ @ i*Gf4D }gr^yMΥ6;v"|jzi[3| SlیߚoU^`7|+ y? 1|6vF~G iBv ,>,}KSV4òzkifDz37D-ܷ۪W_?|VH; ,Vo/x% ߓѽBcVְk`oΤWʴ{P%wt7Ε5c[=V-rӚ+_ԧB*DVa ,@1]`Ⴝ^'mVOxU\`-etW pFPnPS;=ѹ5~ k;Fm[Beiٯ#GsGvяb -iͼݠ|&'âjKkvLX?;Zȷ|oF !4Xt-+=~Z@3N#L< a!tRM|T.Mǫ+R\Uוh;-vE]||6:bhy"3׬~bF,VM]Y .رvE!\~S ;CF|@>+ 4g9D`I/,dzD C @Y tF !4,5,:!% H,=C!KzA`X:X{C  tF !4,@:@``BhX  t3"UyaM6}s{h^XմB^W={hłp{ܝiDuSw1**6ZJW%֙5;O9`, *ׯ"JLvI{ۛg's9OE/0Oޒ}% H ,+UtOfF{e5œߓ2Sg2?_)`BuO'l'QNv;T7K;OZqҁ.#V j7+ۯݮF[H_GeS}7<$^k|Ф}FǑgTNL 4,%QhA`I/,AVGM?PO6*P轵{vne KZ=n)?_Lo@RUCnB +**Bgc8C=F]OQJZIe3P}|󿾆zn.>JՑn9mSٰT4;8l2X'ڞ i >;RǨ%gI<@ dG`d`s;ϤsTLoއ%g)s,@:Ȏت,UCJl9iXmz9u#N" 9Tl6=6xhog:PCNz7SǕ/5r`Q" of[5q2m޴V;m3X=غm#+ˋ{f|̅tϢƁ%vS7A3m5,qw>MAk9V)A,~Wubo^Sه,{L賣aCE`̇-K ;wӷ<_G ۳3o3m`"^YK~n2vS7R;ZՍ\ W"%*>iƼEa3ɷT+^G1<=rΤT1l3ꗲϸcsSk~\(a1ϛ ;q2m*}YnkXab~93o0;E`Kkt&_;L )Z\R-f,@``BhX3"5g9D`KktBs!0,=C! `>X:X{C| tF !4,-W  !e/m[2~J%Ъմ[m=T1*6d0Er9ix:_mrIV=b>m"4yeh_xߙ^wBZ#HﯕdHw< ,yjj?v!eRA)FYK(҉k# (TݶO#_[/Q8y+UHYF|FLU$IZIώ)I7{CH#VT6ҋ뚾E߰>s۝r.Τ}IU9IsfP eJ[ޮV {6b%-lDax\a9tؚxE7qZ3X۽j=.cG$|f+L5ix^i*yy6@36]3|ύ>iHM`K`yLXdZ'7{CpRlU4~:o2}G)0^i% Q)9uovCqP)r-ηv2V|_w.cCfӷ4tzqʴĸ , Az39|O # -=x) ˶4^ 5,|f)5/HD/^ K$\?g9Sv], {Cp{{AXZ>$SH»6(3p&K#DhHvZ@kKtMkQ#}Y.mΣ9=OSÒDͅ*m8~Vͣ[hIAOn_',[]t8q 26}%z~~],) fBm2JMyD}ՠ$ ,N*A4 B}T`Y1q:׉VӹגDϽjݴk~ט`~]GaKQgg65|=i `yX Pj:zRy,r>?xT(} v[9mcjCzU"MxkNpUojX݃͹ShKT,M߳I^ZCfBM_bQD/^`֎hi @E)+Q¶&+hHP}CԾjU[eL ]ZM£~[%&<4c4h֨\ZlZ܃Ea{29ע-H@oSx@XBA܃zaM4?X!!X P!"%+5 h.Xa&cd55׹j.(h4.R^O%y 5rWoѺ43lHg]Zm,w`Y_CggT*7XoI(\υg? ݢ.t\G"hKXa8ֈy,.o6ܟ'דt*_C̷먲l*r- ?}rj\{t5I?PCpEj`SYfe Wkf8,N9x37R<3ɯl= ;k٬.ÂXF^d%R7RON5,5+ȫm5*uXYI'?+?yfq=ݳ2}g,o`k\YHez+̑UTlX&LM44HQ@]anF<\g*y՛~5^q%勦^~r , y@o]fxjϚM>ų"æ% [YVR(a Yn5 6 iR9^4.Dsh3$^rBijP ֊E"TÒL`hg-L>װ)]MukK}}=BU&=K;O&ׄUJxYBÇ)n4 ladzefiL_JuA5q!#o}=qh}%m'/CaT$ ,γ֘}Fsip2yN4}gȧ KvT0U1ְ4JR7MN_<#XEsQ2mmb;bâ\T^s(Z#^L "2?(F{֍|\/%]]E5+LX_}V}KϞY;{E`̇};ö/C"P| @0,B(E` JX!R| @0,B(E` JX!Rظq#~ԩS'ի\a׮]b9۞tysh=裩_~okYn_~K!R3fL~!#*$vMC؞\gu>bZ JXh{}>OQ }X5-  B,D&L+ oY- t衇1CѦOtq'uUW]E .裏SNM.6\r%U3{DŽ>Jz8iFFJ$Kqm&yt.u{ŋ@`B) |Qi%;w뵅:.r:رc6=z'|2Ӈ."1gcsrrDmm> }޽[nbqƉe]toQ7xCn^jzwb(t.WuO?r@j @^z(db^-xO0Ak b[o%;<1߷o_NK,k֬5'c|WbYx\\#p-:~g6my7B= WQ=b̹}x@@`B) ׹͡!e=X޷o.Mi޽{5r1\k6u j-ΦMļ~)Y^.wuC+bqLF-ɞK݇!"@4bĈh![a֬v$^a@_veӦM_Wp->DO->_<ג}!"@?YO_<7s!RXBD *n;+"Zy,<>\x7 ey59o&!  3jGx'Ϗ?^n^atɜ.:,B(E`?/ =bhlݺUL<1Xk׮e̙ba?{.M8Q|' , ܹ2yg62k&oá_^9R ,ɜgχK(K!R| @0,B(E` JX!R| @0,B(E` [|4,ҁɡ1gLjL5OqYlMT:/X54ZWPÍXY|dI`Q)@ Yf9h:nlWI%cuʲl䧢ɐS !N\nQIy,kp=ULE37[zeZ ˵ε3A*k4eU)!35hYk*.>PI>˄TEޏߏ=mi:s^Cw%3~~r,ȪHX_CJ\4JuO%HY&g8SٰTT=ȧ*r U jJ~Sm!v2zLNH25 =S#UCnB Sip2ʹp , *eȳPY9i1wGܴL0)X5}XW/kQnHiMdQNkzk^:J)wRX &6^{ښנgi Τ@Agը=r8ZCT'ׅgijXN|u? <ϧzmߵvZXRy&0%X%5,?PcJAJt|$O.%hmv3PGvTLo$lU5=JqV \\ZK%$5듒%X ,kb4L sh6]S"Uޛg礽ΘkT LI|dOn5L.oV)%2*W7 |p%xb7̨$Gb9S9yH}X ,e]i ܴnJ` jXNb礽T LI|dM K>4>RڏT}&-XD ,S>.rlJXHk29G*4E4m]Ou3f*TdΘUTH aT>Ej&]  ?'m`sS>j LI|dMO%yIG1SE-z.7+)ێJ})$+ĭSf%M(f=ޝNYk W\TqTYfQ~*6WWP?w6Z0lݷOzV R35#~XxSjeΩd LI|4@*G6D` ̼R0% ͥxBC؎"B,@`B) `>X P!"B,@`B) `>X P!"B,@`B) `>X P!"B,@`B) `>X P!"B,@`B) `>X P!"B,@`B) `>X P!"B,@`iwlgςE`̇Mb*8Ju7|ugh>3= -<Ԩ]j.(]fxP/ `>XU -gbg!]_CggT*,obD`؁۷͛) _^z))zfǰlR3ÿxmuRÎ5ѵLXM'5ʗ*Wq37rs$*;s1ʺAU4E3=3*=mumg+|`<XVfŊTRRBs\.zbL:u#r?=QsJm7NLԢ&mg+|`<Xf6ԧOzWED3pq2|pĺI>p_!^W}$?O=T1 ZG9=J;J2 =l*a~ӆDDaOJwF*Nj)Nq2i e>L>UT4&/JeПLB y>+Bh`2&({g`&-Z$:ls=4c eXޏ 6mKI:zd?x`1?'Au`7ֿ#TyT|J!T)Tu#C׫ãI9VBz,sug–V@5LŶ?P݄d锣l3|h~Kbg3*G =^L-YD`dnFQyZn\<,?OMѬ?4wܔN5p7;G{Ʀ nV ut0O IxhڵrMށIr!tRIuA`B) 5^z)O>~I Xig䢋.̨a,B,d&^ӦMB*..%K5# rJ:#ot7;,B,4b1$oA;wkCGޣ|f;~tWH!R@< Of# MN>dڼy\bNZ[S wWO?h=,B(E`TWWSEZ./,ɓEwyG̛tnJ999t 'P=hӦMr h ,B(E`>ڵz-QHh”͙3G.,m , @C>ctwl,yݛNZSʥ @iO@x!bYMš7ٍ6Z?ne#,]YYCW}5eE|~d-\ks A @& Fh>X-/tuщ'خ#q gM}vX(M!lmo}Ko7 զS-M!D @o{cZ 1M" mp}T XX??tahf]X4^`5 [Tf.^G֑KXZGokQB2/q`2+µ"[Zϊ+Dţ~aHa44436g3ϔsMpmPݩK.}AցA`R=faB }ֶp{Z>e|nXy~[UE9i\iX^CO~$lbZl6kftmЪ"\/{SGdG{饗њz+0~X;}\ZX*++EQ`9iٲeb: )"D@ @qf|z-őisE!_*ZZe[ن $Wʤif ׌͆VʧbXc7I\fXc$4 ,$&нKEEETSS#(tA&\.=3] ט1cX2X#4ׯf!Rp d+=\pu=v , vܹs&2Xx:DM65ׁA`B) &xU/:7?c@|CXzXnN;4X@fA`B) ^xA^z-ڵk\Z(d!]1Ž )((K"X***DDbr),B(E`v믿&MjB:CF:ǎ={o%ɓ'GE;k!R`7o.^קO9rd4= L{-Oqk`a)zh #e,B(E`v @wuxSw/ktu+J9]v, JX! IOڵk?^:ɴq> :Eu^ѴYgΜI]tG}T2$fxr-k!R`E3y!?v zJ{im,cX>+<A`B) kڴiItR}Bthcgl,P.1xb'uA`B) 0;pF!"更sNႡVо5 ;c 1߳gϘmod|>| @`0Ht! ҃Q:fK`Q̙H԰X!"3' MZ]Ĩܞf[`ڵ+]q1ˍD`.,B(E`f`ɒ%T\\LJ$Q!9f[`[O~v^bRC/"?dGne;x} ( X㣒E`⧟~O>n6zꩧhr h \՚ f3rGN[a/"XRH|~[t`{{"f͚5b#~w wwt4Q7Jތ V1be_z%X&NH/۱,E eE֦ gI%5jkXd8()+\2C.oU(GY-&_]8z_"G9.'uM(V+(:o]y_1ujTuS$&|2G q>IRlhZ,#|EeTlt/Mw~\Z7+ޗQfc`oLFźX+T4)84 Q̎0UD n7) sf ق0/B2ydg}v믿.q}~*,&a^P^״A`TFj"BBMȐ ڄ: %'W]gtDbZ]/*̇+=MwNw[Z*)RHԠDu^ Ab"`ܹԿiry0*'"m;}U{uv6[ {嗋,mTQb]X47^ '>E  >2'x)_6u5Σ"eO%5Pb,kJtN}H0&ogCE:Q,UiU B, ]ڵƏ/$~ir9[Bm(l2 7&Lb]XXjy: XQDg1sp1jۈ0Gޚȼ%9ux[!(|e;"5* XX@[Yl=ct]w$և=6afs`a]K}ۗ dP[ѶB%lX~i:#i1[X]H?pU6l@ݻw.]7nk@#\Ce9z'Kix1=xE=* k-"6T~u兑]^ia&TKiBWV4XC+G x)6US9\aRaݺu3ψ!? I)R +UI^l7m<aO]t [X9ꫯo:4Yy>0:** A+Kj'LGq]xᅴpB̘1Q@Yh\z3dU}mc.WUUJآ:FzߚrI'w47eBr)bMqPC~BW9,X@3fۆꫯ!yhTB0F}X>ѶnO65 C/^y|k]nVwޑnc~eԩr ~G?@ӹsg1  JXq?rhtȹՉ}O觟~[t4k,}T3htmmͦ!Ӽy3,))7|N86lx>wZ .@?G2ӟH`QrpA`i?X P:yqq1%Fr >K}QRw醴~[ IwXGZ}aD]cK-9!DZk6XZ$C M`8hC 7 [|柧zB,%5 YbN:Bnu׋>ma__mZR=vG\ߔO?M;~kh>4ׯBV ,|?iʕtw֭[0`]y啴dmd"^\C7x#kۙAF-C[e8VM47F LsB`}o# ,|-v+<nf֣Gڴi\  JX󩴴Tp @)TBGc-B_H4U3Lj ,۫U^5炞~YZՂc*&/X"r3K̷&s!R+:JtT>ZL'O=TLQ-tD`x<]yyyb!md!#6l2۵.1SQ mSN>Z"4#yF`.,B(b`pͳH5Ŵh…K41pz2Q]`덶no]F婪?X-Oo>yd/F`.,B(b`ٳx'm6ѼbEXX\߮2pԨp;j z6q˵-g*۲U[FMh miʙg)O˯~+DlҤI/,B(b`Yz(sRYΥ=HG`yDh}UkO cѺt<ɜ_kWM~]e_kQ5.j D`i\\rgioSъ2|>h~wZY+s=WNEwH[ u 7e]&FšvԨ@ieɪ=N23ڞ5ڶ-9}4CbڮM~ɩcELXxh^XR`8c|yV^MEʶҽ=NR握n/Ҍ򘋼tuAj|l}^Z$n(>A78V+>ۉTe :A4Ct ]]$A*>䭎s= /=bj TYuSQYM5eT [G_<&8KALtb,WY+ץ@hiV ,{GK$8 Ȗ-[&Cr)b:@ڻwo_3$Q u8Os?~<~4m4Znd/%'O6lg7Պ&l~.Q R_%ZY{PepeX4qC~XL+AǨ'^`ItD5^q8"tɫbjt}TӫlPb{s8XV_ +;jțGJ.7R4~juڌ,lGuDb^וQ  "ݎ:*sPy2Ǚ[OWDnw 5Qy -^kgsaiV ,Nx >}:,^#haΝt"^z%6#=PQ(ޕK2gu(hhs7s`[Tu?12۷7˟{90`=OGMP]fB{d8x"4yI'E]$o}d,]cN4M: , xbnB.t?AB4O e*ӕ(TǸ>NwyBϔ?AA6>B۲Kz9^Oo3#-bM6 ,5^R:QC\,B-|kEc)TQtDR0Q)(:9$wMN0UzeTWB^k1z"U+_90p?.p(?B>/%nUxf_F7G M rnNơ!%%%"p;[yyE9D JmPRsRShPSIONsQʾO+?徭:v]*sƶXJJk䮈4yra[4[* K@0ՔQ>7r˕=_]E)#E_Iה4m'5)YJ~E> 5TP R&r^+KZb`$$lbۤۂڇfa\WC^\GM8dp0%n%}mP8p`4(q_],mԠMV<;-jPR0#!Ah_ޖ嚨W^y%cFhxmUx"D{%XN\.. ,ׯ$*Q~%b3*tTK׻u>:]5Wјox,#7cN%4I<ѱ>wӧ"떾N/>Wѧw_L#?Cח|1Ttw^sjsRTU{8XCJکeS'ܪP)#M:$8Vpz515"M2uZ4 54_C5+T^ .^W丼M׊"ƀӭE 0mPIQj ۪FAxC%}Հÿ75(qS&o?^(c]ІSX5(iQ׵t:B}<,oװ5|}v9X=,j_G+cñE$|Ѵlt]dȲJJezW4*֣+aOO!g+}D7gu~Ch:oW)!јKNgS/:И뺊uʺZ%PSZ"\]^rUW]EGWUiΝ"6RW1t`Q W "(<\'R%XC+R ykBS;"msMJ!J`qEhi8qaL4Sne^{ 5"ۨ”b`߬`pm+ 'P=D ,;#SOd5*YIhD{dnܳgOQ˹)><%Mh_rf7pCFI JN JFRy<X"rSZ{Mݺvλ|t?DNk>2^j ߉ϊqMv]i?hELX 0Z1gZT #q\mF3FKU3Mk:M/Ƙ

ŴA`B)-Z`LCkFhjT3R~mZFr_gjdO?Tlǵ,FU8GCjkkcgzi׮]ky'Dw uiVBV ,?z4zh|ע_ .hmO v,hykSFA 5ZߑݏXxtuZ[$ wZo 7 [|柧z$={'m6Q;ăX!Z1p5kķG9cZ zUV% Z;^:k]:mF$Ukd76<($Q޽{ւ㢋.k",g~t&Yzu{]b`p!na_^ fϞ-d0*j: ɘ0bf8; F&<^Oŋ5afN=zЦMnX Pjm9UoK/\ ߄rw: Qmh9qL- k mM`vm&!R+z #Fs3iF[τX.\(fŭbf,B(E`>}z衇 7Az1*0vV 0 #?3] #@Ԋ׎o5H+r\bDо"Mmj ef>`QK]ޒXLBV ,v}qGÝwo&Q k][{`_*:[[2]A`B]j 6oLrK̛AcTLd{CZmXx w}%#uA`B ;8S ⸰WQQ!3`TYfG\]ˢE褓N/Bo:~=%&L.{qF1i; !R+8p2d5J.fC_jTP5}Knn8'0|}sr4i~-ZP%c6԰pcYAA\k]X Pjb׷wy}Q fB~Fl5,|j@:w,:%k6n&5*vE; JX@/A ̃QPaZAK%fyfc`i]D`F,Yz-^CKaB[`bN)XxD0~K:fC` ,B(b`o Uxݺur M;T 72#<"Me6!R+.FϗkAG~z1… 1*DV,\.**Y)駟NӦMkߊ ,B(b`ٰady8K^:nvS%$/d&~;#tz㏧{fϞ-®' @ԊAl4vX^}A;mZ5r-0T1c\@=K&67SG!ÿc;!R+իWW\!Sp=܃N&eU 광FNm kGZ$￧<9^<jÆ rIǓ W\Iwy-e#Rv}2XTk_r(jMu>rDߙ뎭iםKN2$GW8GB7\ ~!\9xޒe9T^'ϧJr|A ʩN@ٯy|2n|r]TдyO{L&jX;w.r-.X2Xx` ~q̐ %??J'W. ,~*agAlY n+fgy]R̸D #C.`4q?ʵkm95 P WFszyE`faժUb1O/V.䒌7w̆}~_ȑ ,"0,6$+yPpGACs,6.5:*/PͅoY(woMHh:f8M;(+#4cGSdH)7F׋iu4 qը+~A ij=oh7X.#ٶmz4k,'v7dSΝmTȆᄃ6CwAvpQyhKyZo@sGjN6i|!NXOR|e:u5M6Fx*A`>>@$Vk^WS@tPN԰$z,nZeȐ!t<+"ߔ>C%=ЇgUXI'$>f KϞ=iĉ3_zQ>}ZbA)Ls>R`|o\o^h]hO[QSyE9^E9TŨ9osDm 3NXݴb`GڵKܹ;89 /@=FVX+c2h ,! i kVK,tWhKRrMp8}*D<9_aPpҼ}XK$r2]@euJPڌKQs0akϩ;{$VcWyNTF'42*[;V׊C׮ˀ|Կڳg\Kt˗XVV&dl,vŤ5, Q݊G In/ͼn0~Q¢exĮp Q:Jix]* k-"~u兑]^ia&T+{o=eZU+~AaaaIw!Fd٢y,AzKXaR ,=*]MX?\yXm"I2°90sZ1; nFQao馌?u޽Ot`M%|7͞޽;uEܸq\ KiL`ab`9éQ΁la˖-5.d`.BFk ?.}G?ElќrG&?`16 7ivJ+VshOȵBV ,0|(${[T`yW3m_8:ś{%I<*++)''':2Q`Qqp1C`73x qbA`B]+7<d"76?&a%%%yU-7 Sz$Nx >}:,vx7 JX^nG744% I5 h,5pDndܖQ;y1,޽{`w:2ˢ~l, 8i$ӧ_jiuLX|>F; 0sL1z tT`/J@v<7;X~ X /}li Q`g.]*F[f\JGz>`ӾwEO6cW\Aկ;/ ,[l&Q.X|4|ؑ ,\>V!5\C~!ܹS.,U"@;j!C!y8M{W^yE9 ?'ؓx6 6Pn?Mo{2c w}iٲerɦ&avô%q }x)+ 5hou0z=|JtxKJ* jeNrB lQJAu`jC.D"5趁Ik£ڵKΑV Ğz)16h;2L/p >W_mW^)jax/SN9Eu]'v ,9{ǢFZSG\@V]1n&ouIx}14Ǐcr%D>V(&'b'˨&,k benu:ș릲p;שl;>KQoR8#'j)^^He>Hby6t7X5O bkUgQL:}4(Z.e_BKb`o8 6e~~\ @TVVҝwiH"M{tkuM`T*]?J y:/No˰i=8^WQCO؉ k/qEޫWޛ*W/9|/c5<)\OKql188)4VvԐ7?<\Ho@i>9YX.vOJ<+s)"0EruT*:e: 3_Fey9 DKkj@ m|k.Z8">PVX6l@7x(7tX@*,^X n:QHQX~GH+)g: ,< ?1Y|!ew! 2_  gsJuy|{xӪ?~O4s] M]1xy(;{hc{+4O-kxξAHמS{=-?1R`oxsrr/yFJhXT"1ezÍ(j:Fw{)SWz&^'F*=ʲR*+CxQ rZXҪ PPP@r H}P5Sg`x(͛7%!jXÇӫ*XI2Ii:[)O T|9NR`tFݻ;0BezR0qbbEa?r< ߇=o *pDNNj˕O%=]:]XFOT*>@g?ukub`) (tup"IȅmlI,d7 ,qEc TSVD܄˙K.W~~uTCy|&m\SҴnפ<g)y(PAEÃ#PJyޚȱZ{,iՊG5 Đ vg`DZ"}~=%~\jo駟.笋i c$*Q3.1WQާ<^M/[1ؖ|ەPWeyCWu*I剎->]Y4ոt=}<>bKeK%-SsJץrcıtR N-:VJ=fiҁ%1r͆oi7yQհ$&Y)JTdp"mZVЊ׿5-X@vSRR"^@I{UVeV$p)?auLXE$|Ѵlt]dȲJJezW4N>'trK~s\7vBbnt6cXWU?%b/h5(_~]uUt[y:]u܉Ω/"a.{#IŐM|P-RXSuy)U%1r+ʸω*D<+F=>פ".Wov4Sne^{ 5"ۨ”b`oάX,\B `^eС~gZdcΝ;ӳ>+ZgDJ.sѰj RNꪬ?͉w4Q>뮢 te'cgch?P5ѱQԭk'꼛GW iAtD/˃Mr70ZOtNuNtNdU{8X"#e9驌g UѴxfcbc"I96A) !uԭW(GO4 7 z%F +}]0PO@ӿ'&XZj2zhtŒӧ%aBUHw`~Lr =sr5Ɇ/ҽ+^ACOs= d,ЎZ1<3~E ' ǏKIw`={|rԚdC`o~Cvsʏ;89g]LX5AheXvJ+Vߨ'|BG}LJ?7c!{f6T_ҥ. ,B X:(^'g!ОL4os UN O%%K^DM6 ˓k  JX8_OWE?қoY3jPjfR ,{fqvxAm6p8L};>`kŠVBV ,>uYg޽;tA,tܯ]t\b?a53Dzti9k Ů @Ԋ3vKUUUrrGЃ>(笍] Eԯ",B(b`9sT{',8xw`¤+|>ɓkb]X Pjr7+D^pr+:W_}Utb#]Gw}G;b]X Pj뮻NN`***Q.I ,BV , bD0NYdÏҪUr2 {) %#HG`rΓK] Z @*gϞ4hР `EEEsN*--J, l۶\.7,Ǐ/KÁw : @*ݽ{kw_^r~Yf⧟~zH7?_/m ~t 'W\?v*jm„ =4,B(J`N귃'1lݺ56t$Ç}I[эFNصIX6!RƓݾ}pȐ!b97s(,,}0+~)׏#tzjQ {b]X PjR__O]tuܙ.1 79k 6-0'gg 5|ԥKwN X!Z%`V\I{˗% ]5 =zsź @hq飭 8P!R:,Җ?w:}gr}@`.,B(E` s 6^x9B[ vqu%ź @µ,>:{w4m ,xr^ X!"yf͚EzxhQQ;)??_ !RݫW/QӖ~Z !R[ns% YZX&Mvź @sh~+  ,k֬vź @s2tPz饗hG-uA`B) 楼yڻw\׎oWA`.,B(E`p!r > ,bXib]X PYtA Vj`9cqGƍvź @kyf*((AsR , 5-ļA`.,B(E`:޽^8q\TZXx{,#,B,X_~z)5j\c ' uA`B) ֤`1Ikˀ/vź @RUUE~;m߾].^ZXzI+,B,XŋS޽iڵrIvҚҭ[79r+&L? R`X PٰaAV.>R ,?uܙ ƞź @{k.*,,l$^`kH`=_/\dXl2=A`.,B(E`>b 1c%CrW`2wܨ֭5+\òg=A`.,B(E`~H?\bJ=*virξ X!"`OONwy'ܹS.7z׿9b]X P}Yp(ؗT m{}A`.,B(E`p -^L# 6L!R7 aL̮X;0}A`.,B(E` ;7ސKE*eӦMbٳb]X P@v1zh11l'R ,b7;,ݍ7ҕ/ ckimn%ޮ[hYǯm L,d~.IJ`0atAr XFiHPq74p{k7Kh81Za@vR[[+:oܸQ.6#G{9goX  l뾥Ge@f2;*acrzmY3@j0i=)dlE5RZ^z}ٵc6h}7_:f0kD` {Yf ݛ/^,XTˀGr X6KIQПCWhu۬G6Uʺt>9+,@o]5W%p=YzhK`@v}v۩J.&Y{X  la91k}A2&RA(R50#&c6 XYF^:aofd-\MSfUyckf`Vػw/[o%XT%\"X  LI5Bm"5UH[e)>_mvXSs-m>0kD`5z)K J`oK7,ieTfR^1̋ퟒ\`aôo魷f/˨$f,-9w}{n$X8p>YPpZij[.;m '!-K=$$L֕s K0[D`?yf$X֯_/͛'fX Cׄ# :7`l8ZXv(E=F^ 57hGE KV0.Ջ-[&dF XvyArD5<{]7\!… 'FZXW/2mٵKŗ6"m6r\Al$X&MD￿: $L&ȑĦhR@"x~}Ĝ$Xx :A`.,FYj=vXK/ѳ>+GeȐ!t9b]X_JC5WP# Y>SׯryH6ߟ9gX  JX0gӧa$XnF*,,s5N>d:# / 5D6lݻS.]ύ75 @*V#-_\.</8krϤXB* ,3&f~GiO JX￧[of͚%dܹs\s0tPXMF<#ھ}xѦ ??uk7rB,O?у>H\9믿^{Gعsg:sZS^^.v饗^xAM W\\,^"~E0ٳG @V=CE2宻_q`˰3,B,Äm۶%%r 7, @QB!1p{I&VG`B,߲εrIzH&}O K!R@G{nŠ $X~ /, JX_~!CШQ䒶L`9hر, @IyzG\}ԠVC+,jnkͬ,!?,ħ2b,C=Fi2R, k,"\F?=q\-hiI4!=D`;R`/XSThkMn_H7yݹt8)]F5a^s% וSq9._ 92ͱuQ#MrњXQGJIh)!orr溩&k [T5mC{F5PeK,wSQY r0;-׭['4W_,%˓O>I+Vm ,LQWz.1*wCBhL`!oSF +Du[^GJ>vdSHߌktQi R`lXP*AW'K5u5G`Ig/Σ +=ki̥|f+"fx,쨣2WASȷ,+~z1… XZ ,[nXق;#|˘~&dGH)Kإ)וSRx q _΋mk  lm쓟٧Y` +z?ܗ%<2Xb?W tx=r1iq7U;b³sˆ)TQԴ]s<!}XVaΝTXXHSNKX8pk׮t'\@.K?,Re˖-"?6ea-X&kMT]QZx0j uۊu®A2ۥ\cHX Sif:鰽KJ5,}-|>}u"QUOX/LuT#;z|uhG8p ;V./ҽ{w?!f,ԁCu]'ʹ+'X */*|[˵5"Zꚾ!o7 qBuq49OjK y[ET 4I`Ib fxkG眛AX46hxgaXVO,yMiDXEs0f^ ,fFHϭ]"${a0Ze?MyXCe!_ Qqk:J6*~ 32 paGMXuF\= Xn5)jH7SI` '"6k.8"וR?RPK7(J%龅VwRqOM0T!|uF\R_ȻWF$jqCsŤ~＝g2 h rR%<9EGE~&uO9E91D0}1 ֊xD}źIhh6Si` a{hGXV;>Eg{,Fhnf 7 0y=ǥm %LF,;#m޼pviԨQbhdlp)+aK,0Xa,a2s0 ,jt}nZ8"tB3% `>X P!"HK ~Y#>* `>XD`-bKXaJܾ貺ֈ醀ܹNSgj‘Q} n5!?y\91.\*K]t#'j(\*ؙ[L:a~.|uTr\-- ,)JJu9a|Z+ `>l_|N* *Ӎ~*v<ٮ̥HI:Ԑ7?<)POb\Tٮ\T^'\80R>>"N3_S`IpLy-J|k,0Q@,&2;&|)TQD ,5^R.B*o^R0G񹐟+Os.cr*P>kuD⦊V,HEsA t"4 55MX|.}5,E , ,hg/%XeG\ye\S Dk Z E<* p-`r帥Fq#lCR^i@[*FWKEϝ*w%kg"#;ˎ:*/ph!*>*R }m]0UPB~`#7E4Rr|r7s!Toss'#9sGs;Zk,Ȓ!-!"B,@`B) `>X P!"B,@`B) `>X P!"B,@`B) `>X P!"B,@`B) `>X P!"B,@`B) `>X P!"B,0g`i(rr8sK2b|E3@% `>LX,In_||nr:=̈́A*uX ,0_`i |!94 C~rpRj S-%_E1:_sܹNe?9sTVWD%%1sJ)xbC - %u@) `>LXHb'9 "Hu 2TDUK~y*Ķ|r׉Ҁ*kS2e+s]A 1mSµA!eZ4DŽ^|}#UGcoKyy^Q J!AS;#G[F U)!ħ ,n0jVXʩQJu[q-oTBhJXa5L 5eJ&YZe!}!a)+e{g.\/cksfDŽ]|.+=T<2Jtp89 }f^zeF$(Q53NOCY'/$6$ `>W|TA@tϧ@>#MDHp>,jࠓ n:XCey^ >ph[X [ÂD`̇9i£o,Ї% m0,B(E`INhgM3gΔ[$Oc&Q(KS]]-}+@aD`gzWE;-_~rSDgGݺu꣏>˘e˖ѠA\,X!"Ĩ{nQے TXW׿e/Bwum߾]kA`ڴ_0 ."D_2j(իgϞtG oFLEOgqWc9*_wubs=W̫\s54vX1<㏷xNdmt7߸q#K wb~_-W_s'pXVVVF'Oz@1c6Le/BhX@G8M>]+Bpsg}򗿈u orYgѸqcji۩~8>O?ѱ+j,Z:J2֭[ln￟v%BZ~DhQE'kfyzÆ "tCd1B|f,X@￿\@˴_0 ."D_E pѪ-i_ҿ/bMܹSƬ_&M9Um۶ɹ.]P8͛sxŽ|tqljZ&T* ~' iA`EБ8ha 7Ϥ Xr?77n7}_v];C>}&eLKTI!B[ls$ /Sh7|SLsS1n&[L$:&}&h6ZX vt$ lﾛz!b8p "dh?i͚5ͧ~*b~Zkd.B:E,srmvp->$բ_;}3Gu 9T$:&}&h6ZX vt$ lGyuVE!;vmbv9O>)o8:餓Ĵv{?\9UR6F;9*8lڴI\'x,Y">c11C$:&}&h6ZX vsB. X!"`nXNlXQR lGɴ Sߏ3 h0.l S+Lr\Q`;D`p`/^,$otu1u`={6X ?ym *Ҡ:1,Ih79 ۚtRw1,\G>\uͶH|2466rchJXa…TWK4zhc Kn*29DAjTCnrʛ 0HbR`. 5 É?}+:YT0GJ^H|rűcΛi}"ɗIJi=.p3;xɥv 14,0]`f@ͺZ! Kgu o6Bp#*BOX45JX }5R]e9yd?f/ ͮ_JQJ6lT·|TPe+kY<ЄOoߨLePօ|P^d_gvb^д"t.ps gAzjTWC oF%L5eEr0jK5L 5e5"',% reM<2MD5JᚥVnCӊp}QцU^vq˅I]`Z' 2, 7멪Hĵz*u#`W(1'oY < 'gMM⴦y&4DV|.(Qf`F3oot.)X.6PAP. j_ N}DR|TBqS[s[U) D b jd&b)l0ʋr([#iKKg * `>eG%-+X&! `>LXGq8Y>*VKSL_ ^SUn}5?y̓z_EQB!T,X@ 3W%.vW\aXΆSOwA?=tm5'OSLպuC?_W !"Lb*((Koh={PΝŴ1 ,<@***?9kS~:-]T.IlL1)77,YB[nZ`VX P:XnT%*.dfs`sg}_͒^{5:c,Ndg1\i=rfEE\*(Ҿl1 uaU E`>W^yW7Y|2cT̆_v-9p3xߨ_WrJ$y3?W`Pߋd"v;SMNavt3f̠?_stOL ϡwKqE]$D>'Z|Mw5dg***[n 8o]fҁ%6T(a|!94 C~rpRj #_BN9 J_WCemHqS?v%-sS._Oj‘u¸"Gₔ^nN8zA6mkU9Z?ӟhrMgr׊/e[C6~3`5+z_sca$}/l$S TV}_ /ylJYF^'!_MܑSWN.*iYLQI|*w4(5=c5?K۩ʺXq}6[qSE`EXaJ2vqTÕrx*e{ TTYPzik!i Ҵհ @,l`}+o'j8HSRBLS?J!ALm"֚"DWSTAiÂa"5,Zaᑷ\i:߇*\ѮkU`QK_A`;0!R|X6(al0 ,lz!vXa7C^`jjjTvZwҥK3=v%Kȹcݴxb9*7>*ܱGh:c exg%O?t &БGixl  JX2 7&I 4 .,B(E`,,XXTX uA`B)KfA`^X  JX2 Kb]X PYX" !R̂E% X!"dcڵk\2d9L>^{99.-[L5f>l`=X P!"B,@`B) `>X P!"t%CaJ-i,@ JX!R| @0,B(E` 6lݻS.]ύ75_L:uz53}N\p5445>@ǃ!Rp}?, 糍_~:(Zzoc=.>%$AEjރEUКH@RBĐ@oJ47!H|9EcOL<-X^<*jR,Jottՙ'k?fwϚt}ZkcC͉'fݺu2uT&꡻TDOVX!s̑Yr̞=n]BB~!,ψ#d޽o>9r)˸qde֥7oM66 hHLo̘1k.Snjjޔx%> ! ,ɡrIS>u 0Ӊm۶ɴiӤJdܹrۭAP0zk#2os=W.\h~;VV7@X!aIڠІ thtARzЖ۵^Fe'~իW!vk׮- ,nB ’tƁLY5ʔӉ-[x?~\ b҃a:^]Fe'~CfSVi!w ,nB ’teLY.XӉ=zw,Y"=ݚ5 ڈ6R.㽟2[߬Y746X~LhP fϜ9IO'xmDCw]VޏwA4iyĉeϞ=vK+ ,bB!6 { ,bB!6 { ,bB!6 { ,bB!6 { ,br1rٺu+I ZWZgZwAuJˮdgNFMQ5=  6o.[=T\ب Lΐs2znz*.HKapE{ CN0n9{V$Ř9sAX9azV:֝aPݦsT\Ys{!==]C0n9:?$H \s{!=R:K&_lٲnwG"@Ǎ'|3t3-**>Ȕʻk Y ,)$RCԩSf#-s=gKm>yɓ'eӦMr7|cv?nM/ܝr; .0?HT[%^w}| 7ܹs5˫jZk /˞={ Lyɒ%HC劊 ͏ݻהULFi~KyꩧHSSs9v)J233M_ˌ3LCA@XbD@* AF-}ޮ AmN:UJJJLcP\R߃>h0]]vc=ǠA3GOfY`Ozz{v xwg>[%^*^?oݔUEqQ~K/d/y^o6c#*ZF{U} 0Pyg塇kZѿW_}vMxș $ث8',5R:ٮL/$WXAa , 5dFSF.5\u>MYzzSV8zWCcCՓ%gr[gxeoTTP(z:T>LYiرڻkͼիW믿.fhTXTT=xRZZj=C-\.aɥ Ks,ϕ d/yRZ]-䍈^ Y WX&.ΗL}2 u%R0aU謺 W_M!h ;"{GS}AX 7*o׆^8駟L?ӠTk Dm>s}n3:m!LP=<{ǔ}Jzo3Uٳg˺uGiZ*]_*'ڃh_|ac6-8pQLُW}RUUeFC yJHW{qCXj #$tVTKMun\*B*@X"օ`?]"̗D=MWmFю@*ƿ}޼yf6P1#s1۴b sW\xڐqUW.okt*>z^p!oHi>I{>ӈlxgh1Q9]v444uL[ƌlxghGBI*6AsB/{t5^fKlze~HHuRa9^ǮGXlH-aZ$ŕYR(<}陱V¢sJO5B#_kP8uur)!a ?i a, moCRrHI_5AX#E%C /o}qf+#2WdA, \RxHYa^o!a4Ga yRIN{w^$-ke4QxJX_16+􍥒o t|[ݳ ,霰$7Kapa B K a!ap%AXbD’ ,AXH"AXaIA ,$ , KlH@XR%6 I$ {8',bEN0n91U*(.FU9轐  Kee>|:JMMàM_XvM(.fe9轐  ˱cLJ =-uuuT {ZTV\ ,ᜰhh]i!+mGd@燸=7=Gd%9AXIa!dapBl@X!apBl@X!apBl@X!apBl@X!apBl@X!apBl@X!apBl@X!apBlaihhO!})]Eȑ#RWWǟBRjkkwCܑTiah!/FTTL,,BH_~!+- ,("UIOVl?IENDB`RLumShiny/man/popover.Rd0000644000176200001440000000357014175060542014711 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/popover.R \name{popover} \alias{popover} \title{Create a bootstrap button with popover} \usage{ popover( title, content, header = NULL, html = TRUE, class = "btn btn-default", placement = c("right", "top", "left", "bottom"), trigger = c("click", "hover", "focus", "manual") ) } \arguments{ \item{title}{\code{\link{character}} (\strong{required}): Title of the button.} \item{content}{\code{\link{character}} (\strong{required}): Text to be displayed in the popover.} \item{header}{\code{\link{character}} (\emph{optional}): Optional header in the popover.} \item{html}{\code{\link{logical}} (\emph{with default}): Insert HTML into the popover.} \item{class}{\code{\link{logical}} (\emph{with default}): Bootstrap button class (e.g. "btn btn-danger").} \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}} (\emph{with default}): How popover is triggered - click | hover | focus | manual.} } \description{ Add small overlays of content for housing secondary information. } \examples{ # html code popover("title", "Some content") # example app \dontrun{ shinyApp( ui = fluidPage( jscolorInput(inputId = "col", label = "JSColor Picker", value = "21BF6B", position = "right", mode = "HVS", close = TRUE), popover(title = "Help!", content = "Call 911"), plotOutput("plot") ), server = function(input, output) { output$plot <- renderPlot({ plot(cars, col = input$col, cex = 2, pch = 16) }) }) } } RLumShiny/man/RLumShinyAddin.Rd0000644000176200001440000000035714175060542016051 0ustar liggesusers% 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 } RLumShiny/DESCRIPTION0000644000176200001440000000440614175713406013666 0ustar liggesusersPackage: RLumShiny Type: Package Title: 'Shiny' Applications for the R Package 'Luminescence' Version: 0.2.3 Date: 2022-01-29 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), RStudio [cph] (chooser_inputBinding.js in www/ and chooser.R in R/) Authors@R: c( person("Christoph", "Burow", role = c("aut", "cre"), email = "christoph.burow@gmx.net", comment = c(ORCID = "0000-0002-5023-4046")), person("Urs Tilmann", "Wolpert", role = "aut"), person("Sebastian", "Kreutzer", role = "aut", comment = c(ORCID = "0000-0002-0734-2199")), 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 = "RStudio", role = "cph", comment = "chooser_inputBinding.js in www/ and chooser.R in R/") ) Maintainer: Christoph Burow 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 bootstraps tooltip and popover functionality and contains the 'jscolor.js' library with a custom 'shiny' output binding. License: GPL-3 Encoding: UTF-8 Depends: R (>= 4.0) Imports: Luminescence (>= 0.9.17), shiny (>= 1.7.0), rhandsontable (>= 0.3.8), data.table (>= 1.14.2), googleVis (>= 0.6.11), shinydashboard (>= 0.7.2), RCarb (>= 0.1.4), markdown (>= 1.1), readxl (>= 1.3.1), DT (>= 0.20), knitr (>= 1.37) URL: https://tzerk.github.io/RLumShiny/ BugReports: https://github.com/tzerk/RLumShiny/issues Collate: 'app_RLum.R' 'addin.R' 'chooser.R' 'jscolor.R' 'tooltip.R' 'popover.R' 'RLumShiny.R' 'module_aboutTab.R' 'module_exportTab.R' 'module_printCode.R' 'zzz.R' RoxygenNote: 7.1.2 NeedsCompilation: no Packaged: 2022-01-29 14:55:56 UTC; Fury Repository: CRAN Date/Publication: 2022-01-31 08:00:06 UTC RLumShiny/R/0000755000176200001440000000000014175252574012361 5ustar liggesusersRLumShiny/R/jscolor.R0000644000176200001440000000546314175060542014157 0ustar liggesusers#' Create a JSColor picker input widget #' #' Creates a JSColor (Javascript/HTML Color Picker) widget to be used in shiny applications. #' #' @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: [`animationOptions`], [`sliderInput`]; #' [`checkboxGroupInput`]; [`checkboxInput`]; [`dateInput`]; #' [`dateRangeInput`]; [`fileInput`]; [`numericInput`]; #' [`passwordInput`]; [`radioButtons`]; [`selectInput`], #' [`selectizeInput`]; [`submitButton`]; [`textInput`] #' #' @examples #' # html code #' jscolorInput("col", "Color", "21BF6B", slider = FALSE) #' #' # example app #' \dontrun{ #' shinyApp( #' ui = fluidPage( #' jscolorInput(inputId = "col", label = "JSColor Picker", #' value = "21BF6B", position = "right", #' mode = "HVS", close = TRUE), #' plotOutput("plot") #' ), #' server = function(input, output) { #' output$plot <- renderPlot({ #' plot(cars, col = input$col, cex = 2, pch = 16) #' }) #' }) #' } #' @import shiny #' #' @md #' @export jscolorInput <- function(inputId, label, value, position = 'bottom', color = 'transparent', mode = 'HSV', slider = TRUE, close = FALSE) { tagList( singleton(tags$head(tags$script(src = "RLumShiny/jscolor_inputBinding.js"))), singleton(tags$head(tags$script(src = "RLumShiny/jscolor/jscolor.js"))), if (missing(label)) { tags$p(" ") } else if (!is.null(label)) { tags$p(label) }, tags$input(id = inputId, value = ifelse(!missing(value), value, "#000000"), class = sprintf("color {hash:true, pickerPosition:'%s', pickerBorderColor:'transparent', pickerFaceColor:'%s', pickerMode:'%s', slider:%s, pickerClosable:%s} shiny-bound-input", position, color, mode, tolower(slider), tolower(close)), onchange = sprintf("$('#%s').trigger('afterChange')", inputId)), tags$script(sprintf("$('#%s').trigger('afterChange')", inputId)) ) }RLumShiny/R/zzz.R0000644000176200001440000000067514175060542013341 0ustar liggesusers# add libraries to ressource path .onLoad <- function(libname, pkgname) { shiny::addResourcePath("RLumShiny", system.file("www", package = "RLumShiny")) } # Dependencies in the shiny apps are currently not registered by R CMD check --as-cran .satisfyCheck <- function() { x <- TRUE if (x) return(x) Luminescence::sTeve() googleVis::renderGvis() tmp <- DT::datatable(data.frame(1)) knitr::normal_print("") rm(tmp) }RLumShiny/R/popover.R0000644000176200001440000000473714175060542014201 0ustar liggesusers#' Create a bootstrap button with popover #' #' Add small overlays of content for housing secondary information. #' #' @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 #' popover("title", "Some content") #' #' # example app #' \dontrun{ #' shinyApp( #' ui = fluidPage( #' jscolorInput(inputId = "col", label = "JSColor Picker", #' value = "21BF6B", position = "right", #' mode = "HVS", close = TRUE), #' popover(title = "Help!", content = "Call 911"), #' plotOutput("plot") #' ), #' server = function(input, output) { #' output$plot <- renderPlot({ #' plot(cars, col = input$col, cex = 2, pch = 16) #' }) #' }) #' } #' @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')) { tagList( singleton( tags$head( tags$script("$(function() { $(\"[data-toggle='popover']\").popover(); })") ) ), tags$a( tabindex = "0", href = NULL, role = "button", class = class, `data-toggle` = "popover", title = header, `data-content` = content, `data-animation` = TRUE, html = html, `data-placement` = match.arg(placement, several.ok=TRUE)[1], `data-trigger` = match.arg(trigger, several.ok=TRUE)[1], title ) ) } # helpPopup Button by Winston Chang from RStudio: # https://gist.github.com/jcheng5/5913297 # Documentation: http://getbootstrap.com/javascript/#popovers-usageRLumShiny/R/addin.R0000644000176200001440000002542214175060542013560 0ustar liggesusers#' 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."), "fastratio" = list(title = "Calculate Fast Ratio", keyword = "fastratio", category = "calc", description = "Calculate the fast ratio of quartz CW-OSL single grain or single aliquot curves after Durcan & Duller (2011)."), "fading" = list(title = "Estimate g-value and Fading Correction", keyword = "fading", category = "calc", description = "Estimate the g-value from a table of Lx/Tx values with corresponding times since irradiation and apply a fading correction after Huntley & Lamothe (2001)."), "surfaceexposure" = list(title = "Fit model to OSL surface exposure data", keyword = "surfaceexposure", category = "calc", description = "Determine the (weighted) least-squares estimates of the parameters of eq. 1 in Sohbati et al. (2012a) or eq. 12 in Sohbati et al. (2012b) for a given OSL surface exposure data set."), "teststimulationpower" = list(title = "Test OSL/IRSL Stimulation Power", keyword = "teststimulationpower", category = "misc", description = "Compares the OSL/IRSL stimulation power of measurements performed on Freiberg Instruments lexsyg devices and returns a message if a mismatch is detected, i.e. the stimulation power was not stable of the sequence.RLum"), "scalegamma" = list(title = "Gamma Dose Rate Scaling", keyword = "scalegamma", category = "calc", description = "Scale the gamma dose rate considering variations in soil radioactivity."), "rcarb" = list(title = "Dose Rate Modelling of Carbonate-Rich Samples", keyword = "rcarb", category = "calc", description = "This app models the dose rate evolution in carbonate enrich environments.") ) # 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("", app$title, "

"), 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) } RLumShiny/R/app_RLum.R0000644000176200001440000000701114175060542014212 0ustar liggesusers#' Run Luminescence shiny apps #' #' 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: `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}{ #' **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`] \cr #' Fast Ratio \tab *fastratio* \tab [`calc_FastRatio`] \cr #' Fading Correction \tab *fading* \tab [`analyse_FadingMeasurement`], [`calc_FadingCorr`] \cr #' Test Stimulation Power \tab *teststimulationpower* \tab [`plot_RLum`] \cr #' Scale Gamma Dose Rate \tab *scalegamma* \tab `scale_GammaDose` \cr #' RCarb app \tab *RCarb* \tab [RCarb::model_DoseRate] #' } #' #' 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`] #' #' @author Christoph Burow, University of Cologne (Germany) #' #' @seealso [`runApp`] #' #' @examples #' #' \dontrun{ #' # Dashboard #' app_RLum() #' #' # Plotting apps #' app_RLum("abanico") #' app_RLum("histogram") #' app_RLum("KDE") #' app_RLum("radialplot") #' app_RLum("doserecovery") #' #' # Further apps #' app_RLum("cosmicdose") #' app_RLum("transformCW") #' app_RLum("filter") #' app_RLum("fastratio") #' app_RLum("fading") #' app_RLum("surfaceexposure") #' app_RLum("teststimulationpower") #' app_RLum("scalegamma") #' app_RLum("RCarb") #' } #' #' @md #' @export app_RLum app_RLum <- function(app = NULL, ...) { valid_apps <- c("abanico", "cosmicdose", "doserecovery", "histogram", "KDE", "radialplot", "transformCW", "filter", "fastratio", "fading", "surfaceexposure", "teststimulationpower", "scalegamma", "RCarb" ) 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, ...) } } RLumShiny/R/module_exportTab.R0000644000176200001440000000704614175060542016020 0ustar liggesusersexportCodeHandler <- function(input, output, session, code) { output$exportScript <- downloadHandler( filename = function() { paste(input$filename, ".", "R", sep="") }, content = function(file) { write(code, file) },#EO content =, contentType = "text" )#EndOf::dowmloadHandler() } exportPlotHandler <- function(input, output, session, fun, args) { output$exportFile <- downloadHandler( filename = function() { paste(input$filename, ".", input$fileformat, sep="") }, content = function(file) { # determine desired fileformat and set arguments if(input$fileformat == "pdf") { pdf(file, width = input$imgwidth, height = input$imgheight, paper = "special", useDingbats = FALSE, family = input$fontfamily) } if(input$fileformat == "svg") { svg(file, width = input$imgwidth, height = input$imgheight, family = input$fontfamily) } if(input$fileformat == "eps") { postscript(file, width = input$imgwidth, height = input$imgheight, paper = "special", family = input$fontfamily) } # plot do.call(fun, args) dev.off() },#EO content =, contentType = "image" )#EndOf::dowmloadHandler() } exportTab <- function(id, filename) { # Create a namespace function using the provided id ns <- NS(id) tabPanel("Export", radioButtons(inputId = ns("fileformat"), label = "Fileformat", selected = "pdf", choices = c("PDF (Portable Document Format)" = "pdf", "SVG (Scalable Vector Graphics)" = "svg", "EPS (Encapsulated Postscript)" = "eps")), textInput(inputId = ns("filename"), label = "Filename", value = filename), fluidRow( column(width = 6, numericInput(inputId = ns("imgheight"), label = "Image height", value = 7) ), column(width = 6, numericInput(inputId = ns("imgwidth"), label = "Image width", value = 7) ) ), selectInput(inputId = ns("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 = ns("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 = ns("exportScript"), label = "Download R script") ) }RLumShiny/R/module_printCode.R0000644000176200001440000000254614175060542015777 0ustar liggesusersprintCode <- function(input, output, session, n_input, fun, args) { # prepare code as text output str1 <- "data <- data.table::fread(file, data.table = FALSE)" if (n_input == 2) { 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()", str1, "\n", sep = "\n") names <- names(args) if (is.null(names)) names <- rep(NA, length(args)) names[which(names == "")] <- NA verb.arg <- paste(mapply(function(name, arg) { if (all(inherits(arg, "character"))) arg <- paste0("'", arg, "'") if (length(arg) > 1) arg <- paste0("c(", paste(arg, collapse = ", "), ")") if (is.null(arg)) arg <- "NULL" if (!is.na(name)) paste(name, "=", arg) else arg }, names[-1], args[-1]), collapse = ",\n") funCall <- paste0(fun, "\n", verb.arg, ")") code.output <- paste0(header, funCall, collapse = "\n") return(code.output) }RLumShiny/R/RLumShiny.R0000644000176200001440000000266514175060542014377 0ustar liggesusers#' Shiny Applications for the R Package Luminescence #' #' 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. #' #' In addition to its main purpose of providing convenient access to the Luminescence #' 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 [`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 [`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 #' @docType package #' @import Luminescence shiny googleVis shinydashboard rhandsontable data.table readxl #' @importFrom RCarb model_DoseRate write_InputTemplate #' @importFrom markdown markdownToHTML #' @importFrom utils citation #' @importFrom grDevices dev.off pdf postscript svg #' #' @md NULL RLumShiny/R/module_aboutTab.R0000644000176200001440000000176014175060542015606 0ustar liggesusersaboutTab <- function(id, subdir) { # Create a namespace function using the provided id ns <- NS(id) 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 = "http://rlum.geographie.uni-koeln.de/", "Online application", target="_blank"), br(),hr(), img(src='GitHub-Mark-32px.png', width='32px', height='32px'), br(), a(href = paste0("https://github.com/tzerk/RLumShiny/tree/master/inst/shiny/", subdir), "See the code at GitHub!", target="_blank") )#/div ) } RLumShiny/R/chooser.R0000644000176200001440000000326614175060542014145 0ustar liggesusers## +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ## '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("fas fa-arrow-alt-circle-right", "right-arrow fa-2x"), tags$br(), icon("fas fa-arrow-alt-circle-left", "left-arrow fa-2x") ), div(class = "chooser-container chooser-right-container", tags$select(class="right", size=size, multiple=multiple, rightChoices) ) ) ) } RLumShiny/R/tooltip.R0000644000176200001440000000632714175060542014176 0ustar liggesusers#' Create a bootstrap tooltip #' #' Create bootstrap tooltips for any HTML element to be used in shiny applications. #' #' @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 #' tt <- tooltip("elementId", "This is a tooltip.") #' str(tt) #' #' # example app #' \dontrun{ #' shinyApp( #' ui = fluidPage( #' jscolorInput(inputId = "col", label = "JSColor Picker", #' value = "21BF6B", position = "right", #' mode = "HVS", close = TRUE), #' tooltip("col", "This is a JScolor widget"), #' #' checkboxInput("cbox", "Checkbox", FALSE), #' tooltip("cbox", "This is a checkbox"), #' #' checkboxGroupInput("cboxg", "Checkbox group", selected = "a", #' choices = c("a" = "a", #' "b" = "b", #' "c" = "c")), #' tooltip("cboxg", "This is a checkbox group", html = TRUE), #' #' selectInput("select", "Selectinput", selected = "a", choices = c("a"="a", "b"="b")), #' tooltip("select", "This is a text input field", attr = "for", placement = "right"), #' #' passwordInput("pwIn", "Passwordinput"), #' tooltip("pwIn", "This is a password input field"), #' #' plotOutput("plot") #' ), #' server = function(input, output) { #' output$plot <- renderPlot({ #' plot(cars, col = input$col, cex = 2, pch = 16) #' }) #' }) #' } #' @import shiny #' #' @md #' @export 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) ) ) ) ) }RLumShiny/NEWS.md0000644000176200001440000001261714175251611013254 0ustar liggesusers ## RLumShiny 0.2.3 (Release date: 2022-01-29) **This package version requires R \> 4.0!** - Updated `surfaceexposure` app now allows considering multiple mu values when using the global fit functionality. - The `filter` did not work anymore after changes in `'shiny'`; fixed. - The filter selector icons were deprecated, causing a warning in the terminal; fixed. - The app `RCarb App` did not work anymore after changes in `'shiny'`; fixed. - The app `scalegamma` started with an error message, because one option for a chosen conversion factor was wrong; fixed. ## RLumShiny 0.2.2 (Release date: 2019-01-11) - **PREVIEW**: New application that scales the gamma dose rate considering layer-to-layer variations in soil radioactivity. Base function: `Luminescence::scale_GammaDose()`. Keyword for `app_RLum()`: ‘scalegamma’. **NOTE**: This application will only start if the development version 0.9.x of the R package `Luminescence` is installed as the function `scale_GammaDose()` is still under development. - New application to support the new R package `RCarb`. Base function `RCarb::model_DoseRate()`. Keyword for `app_RLum()`: ‘RCarb’ - Removed and updated deprecated links from the “About”-tab in all applications. ## RLumShiny 0.2.1 (Release date: 2018-06-18) - New application that compares the OSL/IRSL stimulation power of measurements performed on Freiberg Instruments lexsyg devices to check the stability of the stimulation power (Contributed by Sebastian Kreutzer). Keyword for `app_RLum()`: ‘teststimulationpower’. - New application to calculate the fast ratio of CW-OSL curves after Durcan and Duller (2011). Base function: `Luminescence::calc_FastRatio()`. Keyword for `app_RLum()`: ‘fastratio’. - New application to estimate the g-value from a table of Lx/Tx values with corresponding waiting times since irradiation and to apply a fading after Huntley & Lamothe (2001). Base functions: `Luminescence::analyse_FadingMeasurement()`, `Luminescence::calc_FadingCorr()`. Keyword for `app_RLum()`: ‘fading’. - New application to fit eq. 1 of Sohbati et al. (2012a) or eq. 12 of Sohbati et al. (2012b) to OSL surface exposure data. Base function: `Luminescence::fit_SurfaceExposure()`. Keyword for `app_RLum()`: ‘surfaceexposure’. - Output panel showing the R code to reproduce the plot/calculation is now properly responsive and updates as soon as input widgets change. - Internal: server logic of most applications simplified. - Several minor bugfixes. ## 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) - New application to transform CW OSL curves (keyword ‘transformCW’) using the functions ‘CW2pHMi’, ‘CW2pLM’, ‘CW2pLMi’ and ‘CW2pPMi’ of the R package ‘Luminescence’. - Removed UI elements that used now deprecated function arguments. - Added new UI elements for arguments added to functions after version 0.4.2 of the ‘Luminescence’ package. - Removed the database feature in the abanico plot application. - Removed dependencies on ‘digest’ and ‘RCurl’. - Removed all ‘Exit’ buttons. - Code output to reproduce the plots is now generated dynamically and should be more reliable. - R Luminescence Package Team now properly mentioned as contributors. - Fixed many typos. ## RLumShiny 0.1.0 (Release date: 2015-03-31) - Initial release RLumShiny/MD50000644000176200001440000001623714175713406012475 0ustar liggesusersff3a43ad6f2fcab4722a6b6dbf3fb287 *DESCRIPTION 6fbb53acfc07165c6ece0db954f33d0a *LICENSE.note 231711692a6306d1ce4b7b093e92838b *NAMESPACE f28e506595e77db4ae0ca5134d5b5d0e *NEWS.md 8667aea35a6546ccb25759d2c01b2a44 *R/RLumShiny.R f63b0c8b824028754ac6873613feea5e *R/addin.R b13c0ce786c30ccf854d1d1f521aebc2 *R/app_RLum.R 32d3b1214bc6307e4aba90d3c7c2c833 *R/chooser.R 52bc4bd492b595207b563160448d2518 *R/jscolor.R 9c181e65a61d5310ebc219b090fa0f16 *R/module_aboutTab.R 1a913c121888da7d0646676d3b846dc9 *R/module_exportTab.R dc17222138e029e6a854bc7671332755 *R/module_printCode.R 6deddc9fe3b00c150c36478be370a273 *R/popover.R 4efb87fd14c30714a3f1c187c0aa7dcf *R/tooltip.R f58f09d6ca2aee6e054bbf8404385991 *R/zzz.R 706e85a626487748a7799a5055502ec3 *inst/rstudio/addins.dcf 31c93652e3ad30cdcd044b066429efdc *inst/shiny/KDE/Global.R 55e476100960bf1b9e45669d30a5bc24 *inst/shiny/KDE/server.R fa4fc27123e08b612827003e811a2bd3 *inst/shiny/KDE/ui.R f87561b8bb354ef83b09a66e54f70e08 *inst/shiny/KDE/www/GitHub-Mark-32px.png 8e0ac7aba1d56a2372306a20f4ae37c2 *inst/shiny/KDE/www/RL_Logo.png e3a2deb2d5f93d6c5339bd7f8a018ccd *inst/shiny/KDE/www/style.css 0f3ff89c38b44d0ce21fe08fc99f0e3b *inst/shiny/RCarb/global.R db094b37cf86111c77ea1b6de5083191 *inst/shiny/RCarb/server.R bcbd5ed9bbf26a7e5f06102594c49bed *inst/shiny/RCarb/ui.R d124472141f34b394b08d16ca9a592f5 *inst/shiny/abanico/Global.R ed1b704ec1e99fe45c01d26150b48859 *inst/shiny/abanico/server.R 3793a00944bd4142cb2c02dbd4ec3c59 *inst/shiny/abanico/ui.R f87561b8bb354ef83b09a66e54f70e08 *inst/shiny/abanico/www/GitHub-Mark-32px.png 8e0ac7aba1d56a2372306a20f4ae37c2 *inst/shiny/abanico/www/RL_Logo.png e3a2deb2d5f93d6c5339bd7f8a018ccd *inst/shiny/abanico/www/style.css aea961c57ebd9d6c99c5e1574e45d45d *inst/shiny/convert/global.R c6c5aa6e316b1be324828ed179ee0de0 *inst/shiny/convert/select.R e2dcf14c86c53edafd503cf91fa37775 *inst/shiny/convert/server.R 5296993938a7d55eb911b741297062a1 *inst/shiny/convert/ui.R f87561b8bb354ef83b09a66e54f70e08 *inst/shiny/convert/www/GitHub-Mark-32px.png 8e0ac7aba1d56a2372306a20f4ae37c2 *inst/shiny/convert/www/RL_Logo.png e3a2deb2d5f93d6c5339bd7f8a018ccd *inst/shiny/convert/www/style.css 23b741f412b9a2fd64a0db52464f16f6 *inst/shiny/cosmicdose/Global.R 88b82404211d8ae2c83175c4e2744059 *inst/shiny/cosmicdose/server.R affbc44a93b01debdabde4dd058483da *inst/shiny/cosmicdose/ui.R c456256ab4f1384440d3fe8f6438d692 *inst/shiny/cosmicdose/www/style.css ddc7f6e07f044fe4699fe89e0a8d418b *inst/shiny/doserecovery/Global.R 5e9a2e3a7eb1938fca35628e71a5ea34 *inst/shiny/doserecovery/server.R f34f05f7280ae1789602fadebb119318 *inst/shiny/doserecovery/ui.R f87561b8bb354ef83b09a66e54f70e08 *inst/shiny/doserecovery/www/GitHub-Mark-32px.png 8e0ac7aba1d56a2372306a20f4ae37c2 *inst/shiny/doserecovery/www/RL_Logo.png e3a2deb2d5f93d6c5339bd7f8a018ccd *inst/shiny/doserecovery/www/style.css 31ebafee7e828c2e3405e66418b87ec9 *inst/shiny/fading/global.R 12fe291bb3b368558bffaf87bc728182 *inst/shiny/fading/server.R 1e7d9636c61f3a77ddc520928cde8eb9 *inst/shiny/fading/ui.R f87561b8bb354ef83b09a66e54f70e08 *inst/shiny/fading/www/GitHub-Mark-32px.png 8e0ac7aba1d56a2372306a20f4ae37c2 *inst/shiny/fading/www/RL_Logo.png e3a2deb2d5f93d6c5339bd7f8a018ccd *inst/shiny/fading/www/style.css 47262ad26d07ca7ea00a03fa28096ab6 *inst/shiny/fastratio/Global.R 95de2728e8d03d0a1f5e155ad1992655 *inst/shiny/fastratio/Server.R 2e59934d7607d98aa1707463b7f98727 *inst/shiny/fastratio/UI.R f87561b8bb354ef83b09a66e54f70e08 *inst/shiny/fastratio/www/GitHub-Mark-32px.png 8e0ac7aba1d56a2372306a20f4ae37c2 *inst/shiny/fastratio/www/RL_Logo.png e3a2deb2d5f93d6c5339bd7f8a018ccd *inst/shiny/fastratio/www/style.css 7226cd5d011c60becebf27ece419a455 *inst/shiny/filter/global.R 48158872ce5bf185a8f68dce24a18bcc *inst/shiny/filter/server.R 1beaf2182b1cb5f9d28d95c2b989f5b2 *inst/shiny/filter/template/template.xlsx aca5e53679bae18c1237ebe887a2ace9 *inst/shiny/filter/ui.R 9df65bd1b3068d93f2646edfc40d8d22 *inst/shiny/histogram/Global.R 3e35d0d511892df8bc1266ec89ceeb70 *inst/shiny/histogram/server.R da1c804946052c5a948dd35738849429 *inst/shiny/histogram/ui.R f87561b8bb354ef83b09a66e54f70e08 *inst/shiny/histogram/www/GitHub-Mark-32px.png 8e0ac7aba1d56a2372306a20f4ae37c2 *inst/shiny/histogram/www/RL_Logo.png e3a2deb2d5f93d6c5339bd7f8a018ccd *inst/shiny/histogram/www/style.css de0745eeb780725a3b3fdf7ab8d06b79 *inst/shiny/radialplot/Global.R d9fbe9cdaf6953fa487426c6dd43f565 *inst/shiny/radialplot/server.R dbab65ee85e05049fc6503123af926d1 *inst/shiny/radialplot/ui.R f87561b8bb354ef83b09a66e54f70e08 *inst/shiny/radialplot/www/GitHub-Mark-32px.png 8e0ac7aba1d56a2372306a20f4ae37c2 *inst/shiny/radialplot/www/RL_Logo.png e3a2deb2d5f93d6c5339bd7f8a018ccd *inst/shiny/radialplot/www/style.css aa5b9b93ac1e44dc0547e14d33aea068 *inst/shiny/scalegamma/global.R 7660f75e9ff9e7eae4ce5fba38aa72ed *inst/shiny/scalegamma/server.R 6074f6dd6c5e6f7aebd122741631d54c *inst/shiny/scalegamma/ui.R f87561b8bb354ef83b09a66e54f70e08 *inst/shiny/scalegamma/www/GitHub-Mark-32px.png 8e0ac7aba1d56a2372306a20f4ae37c2 *inst/shiny/scalegamma/www/RL_Logo.png e3a2deb2d5f93d6c5339bd7f8a018ccd *inst/shiny/scalegamma/www/style.css d32a3c7a63fb1e902d77e100b629697c *inst/shiny/surfaceexposure/global.R 0fa1f95c74f22c8809f8c21b750a16b5 *inst/shiny/surfaceexposure/server.R 9aac3ee7811aa8af52884c3089ca7534 *inst/shiny/surfaceexposure/ui.R f87561b8bb354ef83b09a66e54f70e08 *inst/shiny/surfaceexposure/www/GitHub-Mark-32px.png 8e0ac7aba1d56a2372306a20f4ae37c2 *inst/shiny/surfaceexposure/www/RL_Logo.png ae4c67317ee0fd2aa19fc75ff69371c7 *inst/shiny/surfaceexposure/www/style.css 6e556e416411f4c94d5eb9c2e2a4cc29 *inst/shiny/teststimulationpower/global.R abea4878d802bd8631be2a39caf6c22d *inst/shiny/teststimulationpower/server.R 34e20332f3c8283021d872e9dfdcb099 *inst/shiny/teststimulationpower/ui.R 47262ad26d07ca7ea00a03fa28096ab6 *inst/shiny/transformCW/Global.R e2eec4c848d268f32b82687ceb155c48 *inst/shiny/transformCW/Server.R bfea3e59d4f5f784fb8bc4713400cc2b *inst/shiny/transformCW/UI.R f87561b8bb354ef83b09a66e54f70e08 *inst/shiny/transformCW/www/GitHub-Mark-32px.png 8e0ac7aba1d56a2372306a20f4ae37c2 *inst/shiny/transformCW/www/RL_Logo.png e3a2deb2d5f93d6c5339bd7f8a018ccd *inst/shiny/transformCW/www/style.css 003266e63930139ada48e32243a63b38 *inst/www/chooser_inputBinding.js 5034704a76cd55c1cbcbc58ea6bf523f *inst/www/jscolor/arrow.gif ba9a274b9323753cd95bc3b1eb2f4e5f *inst/www/jscolor/cross.gif 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 bb333c898f746ba4168e23959e2d276c *man/RLumShiny-package.Rd c15fb522d378a93f6fb798bee4c4e389 *man/RLumShinyAddin.Rd 0342e59699c72b83c1ff6afb0945d364 *man/app_RLum.Rd f0ae056f57404450709b883d3e970164 *man/figures/abanico.png e323e8a7e9afc3a63746d4c00fd693f9 *man/figures/jscolor.png 3d133fafd95be814f50269b17913bad0 *man/figures/logo.png 3a976fde51474d44bfcba9a959569268 *man/figures/tooltip.png fd6b9a5be21ff2b587dae251ec4cbf2b *man/figures/twitter.png c704b8f1be92bb5c95a4eed832598d78 *man/jscolorInput.Rd 5e91be716513fbf58441401ff5bedd92 *man/popover.Rd 071f47015a6c85c8ddc4653537201ec7 *man/tooltip.Rd RLumShiny/inst/0000755000176200001440000000000014175252574013135 5ustar liggesusersRLumShiny/inst/rstudio/0000755000176200001440000000000014175060542014616 5ustar liggesusersRLumShiny/inst/rstudio/addins.dcf0000644000176200001440000000014714175060542016540 0ustar liggesusersName: RLumShiny dashboard Description: RLumShiny dashboard Binding: RLumShinyAddin Interactive: trueRLumShiny/inst/www/0000755000176200001440000000000014175060542013751 5ustar liggesusersRLumShiny/inst/www/chooser_inputBinding.js0000644000176200001440000000651014175060542020465 0ustar liggesusers/* 'chooser-binding.js' taken from the shiny-examples repository (https://github.com/rstudio/shiny-examples) under the MIT License Modified by: sebastian.kreutzer@u-bordeaux-montaigne.fr Date: 2017-07-28 Modification: > http://api.jquery.com/clone/ states: > As shown in the discussion for .append(), normally when an element is inserted somewhere in the DOM, > it is moved from its old location. However, this is not what we want ... not really, thus we modify the functions and now we have a clone() for left to right and a remove() for right to left. */ (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; //returns only true or false var canMoveFrom = (right.val() || []).length > 0; //returns only true or false //this mutes the arrow, if nothing is left on one or the other side leftArrow.toggleClass("muted", !canMoveFrom); rightArrow.toggleClass("muted", !canMoveTo); } function remove(chooser, source, dest) { chooser = $(chooser); var selected = chooser.find(source).children("option:selected"); selected.remove(); updateChooser(chooser); chooser.trigger("change"); } function copy(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;}); selected.clone().appendTo(dest); updateChooser(chooser); chooser.trigger("change"); } $(document).on("change", ".chooser select", function() { updateChooser($(this).parents(".chooser")); }); $(document).on("click", ".chooser .right-arrow", function() { copy($(this).parents(".chooser"), ".left", ".right"); }); $(document).on("click", ".chooser .left-arrow", function() { remove($(this).parents(".chooser"), ".right", ".left"); }); $(document).on("dblclick", ".chooser select.left", function() { copy($(this).parents(".chooser"), ".left", ".right"); }); $(document).on("dblclick", ".chooser select.right", function() { remove($(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"); })(); RLumShiny/inst/www/jscolor/0000755000176200001440000000000014175060542015424 5ustar liggesusersRLumShiny/inst/www/jscolor/jscolor.js0000644000176200001440000007303614175060542017446 0ustar liggesusers/** * jscolor, JavaScript Color Picker * * @version 1.4.4 * @license GNU Lesser General Public License, http://www.gnu.org/copyleft/lesser.html * @author Jan Odvarko, http://odvarko.cz * @created 2008-06-15 * @updated 2014-12-09 * @link http://jscolor.com */ var jscolor = { dir : '', // location of jscolor directory (leave empty to autodetect) bindClass : 'color', // class name binding : true, // automatic binding via preloading : true, // use image preloading? install : function() { jscolor.addEvent(window, 'load', jscolor.init); }, init : function() { if(jscolor.binding) { jscolor.bind(); } if(jscolor.preloading) { jscolor.preload(); } }, getDir : function() { if(!jscolor.dir) { var detected = jscolor.detectDir(); jscolor.dir = detected!==false ? detected : 'jscolor/'; } return jscolor.dir; }, detectDir : function() { var base = location.href; var e = document.getElementsByTagName('base'); for(var i=0; i vs[a] ? (-vp[a]+tp[a]+ts[a]/2 > vs[a]/2 && tp[a]+ts[a]-ps[a] >= 0 ? tp[a]+ts[a]-ps[a] : tp[a]) : tp[a], -vp[b]+tp[b]+ts[b]+ps[b]-l+l*c > vs[b] ? (-vp[b]+tp[b]+ts[b]/2 > vs[b]/2 && tp[b]+ts[b]-l-l*c >= 0 ? tp[b]+ts[b]-l-l*c : tp[b]+ts[b]-l+l*c) : (tp[b]+ts[b]-l+l*c >= 0 ? tp[b]+ts[b]-l+l*c : tp[b]+ts[b]-l-l*c) ]; } drawPicker(pp[a], pp[b]); } }; this.importColor = function() { if(!valueElement) { this.exportColor(); } else { if(!this.adjust) { if(!this.fromString(valueElement.value, leaveValue)) { styleElement.style.backgroundImage = styleElement.jscStyle.backgroundImage; styleElement.style.backgroundColor = styleElement.jscStyle.backgroundColor; styleElement.style.color = styleElement.jscStyle.color; this.exportColor(leaveValue | leaveStyle); } } else if(!this.required && /^\s*$/.test(valueElement.value)) { valueElement.value = ''; styleElement.style.backgroundImage = styleElement.jscStyle.backgroundImage; styleElement.style.backgroundColor = styleElement.jscStyle.backgroundColor; styleElement.style.color = styleElement.jscStyle.color; this.exportColor(leaveValue | leaveStyle); } else if(this.fromString(valueElement.value)) { // OK } else { this.exportColor(); } } }; this.exportColor = function(flags) { if(!(flags & leaveValue) && valueElement) { var value = this.toString(); if(this.caps) { value = value.toUpperCase(); } if(this.hash) { value = '#'+value; } valueElement.value = value; } if(!(flags & leaveStyle) && styleElement) { styleElement.style.backgroundImage = "none"; styleElement.style.backgroundColor = '#'+this.toString(); styleElement.style.color = 0.213 * this.rgb[0] + 0.715 * this.rgb[1] + 0.072 * this.rgb[2] < 0.5 ? '#FFF' : '#000'; } if(!(flags & leavePad) && isPickerOwner()) { redrawPad(); } if(!(flags & leaveSld) && isPickerOwner()) { redrawSld(); } }; this.fromHSV = function(h, s, v, flags) { // null = don't change if(h !== null) { h = Math.max(0.0, this.minH, Math.min(6.0, this.maxH, h)); } if(s !== null) { s = Math.max(0.0, this.minS, Math.min(1.0, this.maxS, s)); } if(v !== null) { v = Math.max(0.0, this.minV, Math.min(1.0, this.maxV, v)); } this.rgb = HSV_RGB( h===null ? this.hsv[0] : (this.hsv[0]=h), s===null ? this.hsv[1] : (this.hsv[1]=s), v===null ? this.hsv[2] : (this.hsv[2]=v) ); this.exportColor(flags); }; this.fromRGB = function(r, g, b, flags) { // null = don't change if(r !== null) { r = Math.max(0.0, Math.min(1.0, r)); } if(g !== null) { g = Math.max(0.0, Math.min(1.0, g)); } if(b !== null) { b = Math.max(0.0, Math.min(1.0, b)); } var hsv = RGB_HSV( r===null ? this.rgb[0] : r, g===null ? this.rgb[1] : g, b===null ? this.rgb[2] : b ); if(hsv[0] !== null) { this.hsv[0] = Math.max(0.0, this.minH, Math.min(6.0, this.maxH, hsv[0])); } if(hsv[2] !== 0) { this.hsv[1] = hsv[1]===null ? null : Math.max(0.0, this.minS, Math.min(1.0, this.maxS, hsv[1])); } this.hsv[2] = hsv[2]===null ? null : Math.max(0.0, this.minV, Math.min(1.0, this.maxV, hsv[2])); // update RGB according to final HSV, as some values might be trimmed var rgb = HSV_RGB(this.hsv[0], this.hsv[1], this.hsv[2]); this.rgb[0] = rgb[0]; this.rgb[1] = rgb[1]; this.rgb[2] = rgb[2]; this.exportColor(flags); }; this.fromString = function(hex, flags) { var m = hex.match(/^\W*([0-9A-F]{3}([0-9A-F]{3})?)\W*$/i); if(!m) { return false; } else { if(m[1].length === 6) { // 6-char notation this.fromRGB( parseInt(m[1].substr(0,2),16) / 255, parseInt(m[1].substr(2,2),16) / 255, parseInt(m[1].substr(4,2),16) / 255, flags ); } else { // 3-char notation this.fromRGB( parseInt(m[1].charAt(0)+m[1].charAt(0),16) / 255, parseInt(m[1].charAt(1)+m[1].charAt(1),16) / 255, parseInt(m[1].charAt(2)+m[1].charAt(2),16) / 255, flags ); } return true; } }; this.toString = function() { return ( (0x100 | Math.round(255*this.rgb[0])).toString(16).substr(1) + (0x100 | Math.round(255*this.rgb[1])).toString(16).substr(1) + (0x100 | Math.round(255*this.rgb[2])).toString(16).substr(1) ); }; function RGB_HSV(r, g, b) { var n = Math.min(Math.min(r,g),b); var v = Math.max(Math.max(r,g),b); var m = v - n; if(m === 0) { return [ null, 0, v ]; } var h = r===n ? 3+(b-g)/m : (g===n ? 5+(r-b)/m : 1+(g-r)/m); return [ h===6?0:h, m/v, v ]; } function HSV_RGB(h, s, v) { if(h === null) { return [ v, v, v ]; } var i = Math.floor(h); var f = i%2 ? h-i : 1-(h-i); var m = v * (1 - s); var n = v * (1 - s*f); switch(i) { case 6: case 0: return [v,n,m]; case 1: return [n,v,m]; case 2: return [m,v,n]; case 3: return [m,n,v]; case 4: return [n,m,v]; case 5: return [v,m,n]; } } function removePicker() { delete jscolor.picker.owner; document.getElementsByTagName('body')[0].removeChild(jscolor.picker.boxB); } function drawPicker(x, y) { if(!jscolor.picker) { jscolor.picker = { box : document.createElement('div'), boxB : document.createElement('div'), pad : document.createElement('div'), padB : document.createElement('div'), padM : document.createElement('div'), sld : document.createElement('div'), sldB : document.createElement('div'), sldM : document.createElement('div'), btn : document.createElement('div'), btnS : document.createElement('span'), btnT : document.createTextNode(THIS.pickerCloseText) }; for(var i=0,segSize=4; i:Q0 ~Ɔ~r0hob z~Hy μ>zkU{C(aȅ^ [hvu c׈G{"?23:R z3 vF AZ~3n=R EZɱI"uXy~@0DMbw5Fw71=?ʦS,:tq03fb޹2jS @aD9&e,1C4$ONttB_lAEQ4Gilt1ڀHvhob>g&_Hen/kSzHK,_frǛ]3$\υIZ _ڀtقR~lB[?AWhh%\Yۓ'/+2΀v% _TQ3ݘ<ڛXYVןvV^g_( 8՟>:ޮ_ΪU)~]ԯ3B8=y#h↵X+9F~^' Ias!]h"č[9kY@0L1Q0?ڛM<*pTB*f$lz3W4[I]OZ'o%co7mhv0)a@eBj]UQ/|4߮CoZv]Ruv]);5,t[Ю'_;' Ў'__O/ .fm.%9b>MzyBꩼ D A/k-;oQubmm,yC A/qNboZI"(F}ef(j*CP^'f\?(eZ_W&{c6 ӡMivBh_6lPebp\VuwrHbU,̹>s]%0muB//ς O{-(Zgqā=:y{.Gia! { 'QBz5Iq's 7 KxV۠G> Q}ͯz?A{BGͽШ΅G*,>{J AKk w0O%PVtMKz@iy7d:4@KjN:SwUml R_T#t1Ewb ҳtGmi Ů]0hWb #G0< j0b T0SG]B5cwn!JV ~#c<isa/Vq>q;PR?g/`ͣXà0h! | QٯRz1_Tmum$s11JҾMv00b_*&sЦ;#Bc>>-M'F7i)dLW m%NqP?6{MGr30{ib=LAw~Lg@GA'w_>Mh Nv"vCuZw|Ho^cg/i9kU"9ڕؑI·hJU׮@'+QQwtjAϾ`x+qtIENDB`RLumShiny/inst/www/jscolor/cross.gif0000644000176200001440000000012314175060542017240 0ustar liggesusersGIF89a! ,$ǝRQg/,@))qڤp jscolor demo Click here: RLumShiny/inst/www/jscolor/hs.png0000644000176200001440000000517414175060542016553 0ustar liggesusersPNG  IHDRe5 CIDATxr#+ Ea?%yH.qzj ,=;<*숽"}GԩuwaxkձҏgC2qosEK4 8 ڙ֏˪uu"hb{ŸKlXcU\cwRǟ; z 14QV x=sυKlGY+c$݈=0<= z;4EK 7FFC@"]VݿO aiFG"(€!G48F t@$ Ca_"\_2v&v&^2TaO?z 1tJ7#fʠ|F?$.#6lS`U?zt[:1neh$NWYн.# Z1`=ڟZ8[J`zAA]|t}0Gj{vU=MIsI1Јn{ "-͟v >p[c #`+N SjʕY~(_B~P-н[k_RVܿ}.?=t]*7`13]k_/Ov&vfΡnIdzC#.TX|5V? }4B W%(0-D? #n q8km*&khgb W`d*,-9o 秏HlM2g6|7$fzy [ ,(:DfJ'ҏx4CFF K4uY_?j,y"tRYQ"ÜQ}=*z OhfH=aD.D81Ҵ?ĊBxZYhD#\qtwS4&? ٞ>ϻ/zGthb{hEePZW͎vC]{#c8aEj$-Ь} _Թ8ړ 2J؆4GDi4@ K7iivlk1UgDgl#5t~'Q҄y# tbmUU6>ڟݿR9f܀gtBl FVFI_lW?Hlcn B;BK6wgTPwBGg:U?El =G2b6x?=Tle4ȯ]Q%\z @hrjA< {E_{ `y]^~0hVA6RHxE0-ʠ˚}y.j.nQ 8ڟlEY@σBl q cZ9-a6bwlѽO_w#v4Ƕ=Ԥ/ЏX$Rܭ\{/(,H4ҏC@J¬n22U=6p?=} zV8 I3A[Rяà] s WoxuS @-Ѕ~L 묌L`]Z?N$#(dnyLd .1WZ%z0G֏@}R2:A+_DO.sÇ%҅~P,ٛ+|"us[:ڟbDMez(gٗ |F#W1л-kB 0wB2#9ڍT4跏c7A@Jr5Țĩ̹q Ol }_@x2)Sz|8ڟIk2+|MFp&' tGuj؆oxFb3Z?(s̗{t݂܉Nה[FdꚜLdbӡn.е~0_>ҼȖ d'Jv }?>Ė! -H: KIENDB`RLumShiny/inst/www/jscolor/arrow.gif0000644000176200001440000000010214175060542017236 0ustar liggesusersGIF89a  1) { color2 <- ifelse(input$color2 == "custom", input$rgb2, input$color2) } else { color2 <- ifelse(input$preheat, color, "white") } if (length(values$data) == 1){ given.dose<- input$dose legend<- input$legendname } else { given.dose<- c(input$dose, input$dose2) legend<- c(input$legendname, input$legendname2) } # save all arguments in a list values$args<- list( values = values$data, error.range = input$error, given.dose = given.dose, summary = input$stats, summary.pos = input$sumpos, boxplot = input$boxplot, legend = legend, legend.pos = input$legend.pos, main = input$main, mtext = input$mtext, col = c(color, color2), pch = c(pch, pch2), xlab = input$xlab, ylab = input$ylab, xlim = input$xlim, ylim = input$ylim, cex = input$cex) if (input$preheat) { n<- length(values$data[[1]][,1]) ph<- c(input$ph1, input$ph2, input$ph3, input$ph4, input$ph5, input$ph6, input$ph7, input$ph8) ph<- ph[1:n] isolate({ values$args<- c(values$args, "preheat" = NA) values$args$preheat<- ph values$args$pch<- rep(values$args$pch, n) values$args$col<- rep(values$args$col, n) }) } }) #### PLOT #### output$main_plot <- renderPlot({ validate( need(expr = input$xlim, message = 'Waiting for data... Please wait!') ) # plot DRT Results do.call(what = plot_DRTResults, args = values$args) }) observe({ # nested renderText({}) for code output on "R plot code" tab code.output <- callModule(RLumShiny:::printCode, "printCode", n_input = 2, fun = "plot_DRTResults(data,", args = values$args) output$plotCode<- renderText({ code.output })##EndOf::renderText({}) callModule(RLumShiny:::exportCodeHandler, "export", code = code.output) callModule(RLumShiny:::exportPlotHandler, "export", fun = "plot_DRTResults", args = values$args) }) # renderTable() that prints the data to the second tab output$dataset<- renderDataTable( options = list(pageLength = 10, autoWidth = FALSE), callback = "function(table) { table.on('click.dt', 'tr', function() { $(this).toggleClass('selected'); Shiny.onInputChange('rows', table.rows('.selected').values$data.toArray()); });}", { data<- values$data colnames(data[[1]])<- c("De", "De error") data[[1]] })##EndOf::renterTable() # renderTable() that prints the data to the second tab output$dataset2<- renderDataTable( options = list(pageLength = 10, autoWidth = FALSE), callback = "function(table) { table.on('click.dt', 'tr', function() { $(this).toggleClass('selected'); Shiny.onInputChange('rows', table.rows('.selected').values$data.toArray()); });}", { data<- values$data if(length(data)>1) { colnames(data[[2]])<- c("De", "De error") data[[2]] } })##EndOf::renterTable() } RLumShiny/inst/shiny/doserecovery/www/0000755000176200001440000000000014175060542017614 5ustar liggesusersRLumShiny/inst/shiny/doserecovery/www/RL_Logo.png0000644000176200001440000007222114175060542021623 0ustar liggesusersPNG  IHDR pHYs.#.#x?v OiCCPPhotoshop ICC profilexڝSgTS=BKKoR RB&*! J!QEEȠQ, !{kּ> H3Q5 B.@ $pd!s#~<<+"x M0B\t8K@zB@F&S`cbP-`'{[! eDh;VEX0fK9-0IWfH  0Q){`##xFW<+*x<$9E[-qWW.(I+6aa@.y24x6_-"bbϫp@t~,/;m%h^ uf@Wp~<5j>{-]cK'Xto(hw?G%fIq^D$.Tʳ?D*A, `6B$BB dr`)B(Ͱ*`/@4Qhp.U=pa( Aa!ڈbX#!H$ ɈQ"K5H1RT UH=r9\F;2G1Q= C7F dt1r=6Ыhڏ>C03l0.B8, c˱" VcϱwE 6wB aAHXLXNH $4 7 Q'"K&b21XH,#/{C7$C2'ITFnR#,4H#dk9, +ȅ3![ b@qS(RjJ4e2AURݨT5ZBRQ4u9̓IKhhitݕNWGw Ljg(gwLӋT071oUX**| J&*/Tު UUT^S}FU3S ԖUPSSg;goT?~YYLOCQ_ cx,!k u5&|v*=9C3J3WRf?qtN (~))4L1e\kXHQG6EYAJ'\'GgSSݧ M=:.kDwn^Loy}/TmG X $ <5qo</QC]@Caaᄑ.ȽJtq]zۯ6iܟ4)Y3sCQ? 0k߬~OCOg#/c/Wװwa>>r><72Y_7ȷOo_C#dz%gA[z|!?:eAAA!h쐭!ΑiP~aa~ 'W?pX15wCsDDDޛg1O9-J5*>.j<74?.fYXXIlK9.*6nl {/]py.,:@LN8A*%w% yg"/6шC\*NH*Mz쑼5y$3,幄'L Lݛ:v m2=:1qB!Mggfvˬen/kY- BTZ(*geWf͉9+̳ې7ᒶKW-X潬j9(xoʿܔĹdff-[n ڴ VE/(ۻCɾUUMfeI?m]Nmq#׹=TR+Gw- 6 U#pDy  :v{vg/jBFS[b[O>zG499?rCd&ˮ/~јѡ򗓿m|x31^VwwO| (hSЧc3-gAMA|Q cHRMz%u0`:o_FiIDATx}td%! )+7ږJ["\wKIQl7YWtFuftZǙ]=8n-Ot) q\p7ab SZMM@z K[yӧO?_7n\ pw~ \i$eo .<_: @IpB^D=c,JN+߻jժ8|()ٞ /MMM#g̙d\]w5f߾}}vP2.^zTq㢯ψ˼W馛FGN#P.NȦG"suhll4(E%>F]]Q~o=6mdPcbŊZ|ب˼xaPl."o,۷o7.E˼۷… K;|XRJw}~(T_u^^矏F?mƼ|>{WkΜ9 sl瞲^O$y1qIJƍ>?qZ*/,YR߳?8F-uy۷o VOF8GrWXQIU\VZ~OVײo߾ؾ}>F$yӧW4nܸ2oΜ9U5GN? [/o .گ矏F?Uc^]]]U}G9{`]vEL:)de1!Ҭ!UVǴi?Y>K苧鍈m{N}?SJ_m[2#@%6 qw;4T>u>o_ODPVbcލ7X3_}b5502|eXV"c?9E__H6;OYO?{P+z{{cժU̙30Q>= v@$&-Y$1ߔؾ}{x~BA"1oo߾D}c.\~B^GeqHDļ\.oΊ+S Z~OϸRc^O7gժU>p۾/zNDx0c^>^oЍ7~RDz_ž>`j:s=۷/={VSOHl;|pZ*ߤn)5ɿ "٘w;=c?:tƇO,P^|@ }XpaYO-P5<6 KKf"žhf5Yr\*YsO<~j~VTHż/SZjUٟY o Mg߁}wBy/B{ｩ-Y$%Oxt T̻뮻R ۷o_l߾=nF?@Ѹ 5>ߑ"~. 1ZJjb^.(+V<`('o<{<J*b^(UV?hll4P>ܰ5"ؾϣ1H o։y@<<BБczf@by@ܻ?:7l@y@"?H41i|>6u툮m{<Oj@y@MH31 O["%UMC%U%ǃ_vU<*xT'q"νsֈ!F@G=O5#B;tX^9zNxp~۱G"Z(1( /s̳ŗlr (1|>+ /2xPb0lV>>*Aŗ^U_Gj<`H!gZ>b R KNζ=GE<Rb<\|i;!@ sŮj)5 j)PqEsܰUÑ" <(5m <8G\}'<<8/r7e!(yc-Pnb¡#⾕ y@Yy0B; [<3 T<5m]=BP1b Tmq)7^\|QL0..ln_a$H01Bo1S.yCןuuugZ 'A\}'<EګrlH71`0=?0pN^.0 "57b4B0g qascwZHpw)154qG y._y\Eb%Amk5Gfx, <1T NwY q'A x%OƧ%p[hO|o<(m[ ̾WJ7?54raA8Ẹ:r,qGmkR $QU|ܷ!!Txڣ $QU> yHyT޾ D<FḲ*<@\yT#D<Ẹ|NI%Plbm{|N35.>%raA(1y͏#1D<JṂ"Kk6 y$ָܶh\s|%1Id<*scCP涵FD_{A(91;tX15mK(|>|ԬrP @ىyʯ|Cȣ& ~.GOo*Ḅl~d8xԜm+/f *J̣,|Zj-]:7luGUp@y̓_G ^}}q Q 6WyEQWWg81asGmk2scc*8< Z yP<s25^+E23-yP|bcWw!5!JC5a>Wy#o~% ;7"@y¦o#!qJw#q[\1"sZ!D#""|8x ָܶ+cc@yDD} <m|!//涵nH1/|^^]FFH!Wy\b^8x)*IK_z)*MK'z/RU$PORU$P]!e涵u4$@FH2s`b^?KmNK'2O\p! ļ'"sZchļz$#@ y w)[b^y#ܶhb^>wܛlSq^|)"%sM;:n20ORbn[k̼l! Eļ&|30dfH1/A6=7BJ<H/1/A~p>/MK˼47RLKggxӔ)&Abb^Be^*44RLK5B]>} <ozF\=-Fk#$ <d yP涵F}@کP#)'@ !ᮻ #b^R'O!ZyP+<\|1j yP+<b1j5B!@FyP#<bԀ_7KK9W_ayNbԘ=RHK7Mhرq#@ y R__fN7D WK/RFK:# )#%̕o))#%7]b-0s)Q[H1/a]8)Q[H1/a6])_RBK#ؾm{;RBK٭o1Ba#@ y tٛh! ļ4q`a@:y 42{b~pb^BaFH>t1$P_sRfwwOt}o! ļsF۱u$Po2K0Ru$P FH)y\b^]KB ļ[0wRu$`3/sRu$`Z!\@y !\@y w˂9FHOtl۱Pļ-'63T11/CJD5گ1[({ >7Q-<(xԖsBOb^[!8'AϿ0#R{{;ޮg[?1`<:b/ z0 bg:b z{1`" c\aޥqQA zg;c ΣTvw?x`7Bc|v'/^z PǰΣԺ+>yߚ/g 1"(=Wޛn f[1\1b\Qr//|-e0#{ ( _*>TsǨym۱|m)c?01[[[o!(nz>RvwCϟ#G5 QT3N2 W߉P<06{bՃ#>J&Qt !QuXcjGI_UaYz~z od>}'?yTx\pQzb%3eldo!"BУ*=ӧܒqKfQjb%' AU۱:@U({/-Uo0WqWYuuuy%&xܖ1?wĕO3 UC̣,l<*b-7=?4-#%Qu|~i#0\bUVz[^iNJom}sdo!"|~sz{hweo뮙uuuH91' Aj F=15n̉mPo:Tp̚9/VkOeG26>t;sVA~Ջ{ڷ^\ _?]x]wѱx~\d^'NGpOE㎎˧ A%n-|q*D#xpX|q(#1074?G%rc'GkƧ%&G\2iB|wD熭Pb~UT@w5W˦z+.9H,A*ފ;59=.|#G_Uw!OЃ|+CsZq͑;;̾;V}[qQ5eԘ Ώ?Y\@ XOzUN!߽4> 2cd/*kxAT'18d:r,[PD1[`H3NrGo<`XuŲw(@x]ns-<`zJe0j__;36u툮m{\@y?" b-qQQJMø>OJgEt\%~U1Y-<=(y@Ųc>tLJ!߽4?eQol2g}.fdIH|wMo 0LbP13N6T̡#Ǣ!`D__Ƌ/|*E}@y@xx sLݟ.^"%/uԵCȣ\6 *|u_}'"A-ChinY3gbn+CE߱g#O?/C V~((KHN};o~X?N>q|S&A?547 O^}}7ힾ#ⷱO?k&A]U岙fCT W?ypБc)yRmvGAlԣT1RБcwtblCT1R辕ʣ\6 y2;7Cjok=)ӹa< e37UJ̃ٸQ#PP.E)kWy iFbbĦB岙fCT91Rŗ^m{ AA-͍1cdCT91R`W*rLܾd!j d8x'M0@  WyfFy`޾S&ئ1b$u]QP.yP?yUCjokuPc]e-͍1k C$5fW*rLܾd!J̃d8x'M0@ByPC֮*rLq!L̃q1Wy iꔉq `bԈ6ʣ\6K7@‰yP9}' AAW]1-61@‰yP\1\6 m{ f͜a"B̃ԵU岙x )bTHRKscL4"A]U岙}C bT3>5M2U!A|iFWyfb5<(CGEo CP)clCbu]QP.ws!8#1hR{[k3:7luGAl&2f<({rLܺ`N<(|>*aΕF`HbB岙XnJ̃ѵm!(1f͜aJ̃[oʣ\6/Y`Ẽ?~21C5s( 1F`SWyfw,6%#0?*!47I @Ɉy0LkoqGAl&n_̳ŁG AASLt@ɉy0 _ZU岙Xx!(91Бcw4u4gzfWyf]\hB̃!ܻUCjok_:CPb sVWyf"3o!(1 عw((ĭ D}}1(1 ϻns(+1`S!rLt,j7e'ڶf0e'7\QP.ۗ,0!iZc "<8[\Q<*M̃9t䘫<4uDWyTzfWyfb<^0]uŴ4T*岙6TGܻUCjokzCPqb׹a< e37T1Tζ=F\6]P5<4k #Xb5cS! m{ f͜aRỊl*rLq!H-1<3M6%Q5֮*rLܾd!H51d8x4uĘwY4Z#i<*bS!rLt,j7Gڶf0G=oʣ\6/Y`81?~2vuZc 3(뷸ʣ Wy0419tX8x4uDWy01Yn< e3t|C<Бcw4u401pPrLܙpb%s~Wy 5 g!Qrʣ\6y  QRٶfcQ<&1G]1Y3gỊd6u(h*>1[*FḤ$V~((KFḤZc (뷸ʣ\6wtl1:t䘫<4uĸhQ(6ʣ\6K7G:r,zNZclC(y}+rGAl&2f΁GQܻ 5 @̣(:7luGAl&C98g7?j e3ѱ=HڶUC5s<ɦB岙fC@yZѵm!(1fLl(1Q[~< e3q"'Ƙ:7luǐn5M2UGA_ZU岙Xx!<Бcw4u4PFbgzfWyf-2x{cHmQ__o(31ܰU岙̛m1Wζ=F\6.**D|>o~UCaΕF 8eS!rLt,j7TGD*# 1f͜a 1Xoʣ\6/Y`01?~2 []1_k!b^Bm!QP.E#%P>m{ f͜a1b^=oʣ\6c!y d147I 5HK뷸ʣ\6/Y`Qb^m{\1Y3gR@̫rvyfΎ )!U_z9147ƌi>B̫b-Wyf% )"U'Ƙm{ f͜aH91 |UÑQe3ѱ$aL>=VX/Af0jժhjj5ƨBbB.ۗ,0c}vcT1F1&O`?.\mmmk*  m'N+VD>7Hy0BSLt@*Z*~~/1*D̃e3t|C}?~|<(31F+ئ1 ꫯx R&b S.m ٷo_455Ŋ+Qb S{[k`ժUQWW۷o7F y0 l&2fb…1~8|1J@̃e3ѱU SL>=r+21aFzG)>cCF{<"`-͍c…΁䲙}C@۷/O+Vyz A-͍1yC@ Z*sM1F@̃3e3e %}ypSLMc epdb󴵞qP٪z*Su+4^)RkߥЉtB&!dfD1cV0dd/0ɽM$>>>zm>|36cuu5v\\\h'#7+rt4#<@x ,C3jZk{<֭[1ݻggg0k>|Ƞpj5v ̃xT*idXӉR~{4D^Z'''Z0k>| f<z4HMȨ5ATx"k-M&I^pߏz7w&kMВ$n[[[\0I4cmm-Wrv;...r.atbyy97y>Z~!q܌o.yp8h W0Bt:Q*{05 (ͨjq||Zyxɓ(J3U0>^GVL#KX__v=yz<Nj5^쾘[ <4MG?<$I(AT*!K>ߍhsEj<og%/M8< ]qxx+++~On`a%I^/Aa jnF*̚y,Vxpk73iZa{  Ӓ$n[㴟-UĹx3i4JE3>  3$pXxqLz1y0W;;;1LŻl4Mw v0SIQ A5 nFЌ+ qV+ϣlh7XRDLiK4ceeE3<.Iz1 yS$`vh4-͘2aSj4ok"iښfܰ<`p-IDuvvvvślF{{{QT4cvJ?}'W$ph.ޜ9f /1yqW""ZVL&h41?4~o.^9f @Dwtt@ :E[L>y煋0 L|10?f@|v]k /\9f ōui]ug@nΕ7l`|?\+o+OvVՃ}UV:Ws-7m+Ov}sVJ!cSY+rfjY9@L5/+g@X@7rDypcXyQ  n<,l&4nȉnb[z,D]z,[X{dIXxs{Zf/s6ٙIENDB`RLumShiny/inst/shiny/doserecovery/www/style.css0000644000176200001440000000242714175060542021473 0ustar liggesusers.custom-modal { padding-left: 10px; padding-top: 10px; padding-bottom: 10px; padding-right: 10px; line-height: 200%; background-color: #fff; overflow: visible; position: absolute; z-index: 999; border-radius: 10px; border-style: solid; border-color: #428bca; } .h { font-size: 11px; margin: 0 0 0px; } h5, h6 { color: #428bca; } .tooltip-inner { max-width: 450px; } .control-label, .selectize-dropdown, .item, .btn, .uneditable-input, .sorting, .odd, .even, .dataTables-info, .fa, .fa-refresh { font-size: 12px; } .selectize-input { padding: 0px 10px; min-height: 20px; } label, body, input { font-size: 12px; } .label, .badge { font-size: 12px; padding: 4px 20px; margin: 10px; line-height: 18px; } .label-info, .badge-info { background-color: #428bca; } input[type="text"],input[type="number"],input[type="email"],input[type="url"],input[type="search"],input[type="tel"],input[type="color"],.uneditable-input{ display:inline-block; height:18px; padding:0px 0px 0px 7px; margin-bottom:10px; font-size: 11px; line-height: 1.5; color:#555; vertical-align:middle; -webkit-border-radius:4px; -moz-border-radius:4px; border-radius:4px } input,textarea,.uneditable-input{ width: auto; } RLumShiny/inst/shiny/doserecovery/www/GitHub-Mark-32px.png0000644000176200001440000000326214175060542023171 0ustar liggesusersPNG  IHDR szztEXtSoftwareAdobe ImageReadyqe<$iTXtXML:com.adobe.xmp $IDATxėmhayL30A+R#f>IHکy(M)_o5 0+0Ėl&o{i^]u<{Yws}=uC>$L, }<w}8^ AO?p! xaяPKI3`'B>0QT1<+`}^nvkp^ƅF|1"Gp.*oO׀Vp ]߅jc8K$q 8jV`#`vmpGѢu!#}#:U_?_yhE $=;c*xNOo+&w)%K-R%6n'o">j/t³qoGW7j%2q GX?woibCÐAzbǰt \14|S.DZ]# b|H$(ʕohmqͱRP셣$,0Z20 tNvRW3K8Xk2 IO6 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() ) } RLumShiny/inst/shiny/surfaceexposure/0000755000176200001440000000000014175060542017502 5ustar liggesusersRLumShiny/inst/shiny/surfaceexposure/global.R0000644000176200001440000000056714175060542021075 0ustar liggesusers## global.R ## library(Luminescence) library(RLumShiny) library(shiny) library(data.table) library(rhandsontable) data("ExampleData.SurfaceExposure") tmp <- Map(function(x, i) { x$error <- 0.001 x$group <- i return(x) }, ExampleData.SurfaceExposure$set_1, LETTERS[1:4]) example_data <- do.call(rbind, tmp) rm(tmp) enableBookmarking(store = "server")RLumShiny/inst/shiny/surfaceexposure/server.R0000644000176200001440000002364714175060542021147 0ustar liggesusers## Server.R ## MAIN FUNCTION function(input, output, session) { # input data (with default) values <- reactiveValues(data = example_data, data_used = NULL, args = NULL, results = NULL, error = NULL) observe({ # make sure that input panels are registered on non-active tabs. # by default tabs are suspended and input variables are hence # not available outputOptions(x = output, name = "global_fit_ages", suspendWhenHidden = FALSE) outputOptions(x = output, name = "global_fit_mus", suspendWhenHidden = FALSE) }) session$onSessionEnded(function() { stopApp() }) # check and read in file (DATA SET 1) observeEvent(input$file, { inFile<- input$file if(is.null(inFile)) return(NULL) # if no file was uploaded return NULL data <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath if (ncol(data) == 2) { data$error <- 0.0001 data$group <- "A" } else if (ncol(data) == 3) { data$group <- "A" } colnames(data) <- c("x", "y", "error", "group") updateCheckboxInput(session, "global_fit", value = FALSE) values$data <- data }) output$table_in_primary <- renderRHandsontable({ rhandsontable(values$data, height = 300, colHeaders = c("Depth", "Signal", "Error", "Group"), 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))) { if (nrow(hot_to_r(df_tmp)) > 0) { tryCatch({ values$data <- hot_to_r(df_tmp) }, error = function(e) { values$error <- e values$results <- NULL }) } } values$data <- hot_to_r(df_tmp) }) output$global_fit_ages <- renderUI({ if (input$global_fit && inherits(values$data_used, "list")) { lapply(1:length(values$data_used), function(i) { numericInput(paste0("age_", i), paste("Age", i), value = 10^(2+i)) }) } }) output$global_fit_mus <- renderUI({ if (input$global_fit && inherits(values$data_used, "list") && input$override_mu) { if (input$individual_mus) n <- length(values$data_used) else n <- 1 lapply(1:n, function(i) { numericInput(paste0("mus_", i), paste("\\( \\mu \\)", i), value = 0.9, step = 0.1) }) } }) observeEvent(input$coord_flip, { tmp <- isolate(input$xlab) updateTextInput(session, "xlab", value = isolate(input$ylab)) updateTextInput(session, "ylab", value = tmp) }, ignoreInit = TRUE) # update for log values observe({ data <- values$data[complete.cases(values$data), ] if (nrow(data) == 0) return(NULL) if (input$logy) updateSliderInput(session, "ylim", value = c(0.1, isolate(input$ylim[2])), min = 0.1) else updateSliderInput(session, "ylim", min = min(data[ ,2]) - diff(range(data[ ,2])) / 2, max = max(data[ ,2]) + diff(range(data[ ,2])) / 2, value = range(pretty(data[ ,2]))) }) # update for log values observe({ data <- values$data[complete.cases(values$data), ] if (nrow(data) == 0) return(NULL) if (input$logx) updateSliderInput(session, "xlim", value = c(0.1, isolate(input$xlim[2])), min = 0.1) else updateSliderInput(session, "xlim", min = min(data[ ,1]) - diff(range(data[ ,1])) / 2, max = max(data[ ,1]) + diff(range(data[ ,1])) / 2, value = range(pretty(data[ ,1]))) }) observe({ if (input$global_fit) { # split data frame to list if (!all(is.na(values$data$group))) { data <- values$data[complete.cases(values$data), ] NA_index <- which(data$group == "") if (length(NA_index) > 0) data <- data[-NA_index, ] if (nrow(data) == 0) { values$error <- simpleError("No or invalid data. Please check your input table or file.") values$results <- NULL return(NULL) } if (is.factor(data$group)) data$group <- droplevels(data$group) # remove line feeds that might be copied from the clipboard data$group <- gsub("\r", "", data$group) data$group <- gsub("\n", "", data$group) data <- split(data, data$group) # remove any list element with data.frames with 0 rows data <- lapply(data, function(x) if (nrow(x) != 0) x else NULL ) data[sapply(data, is.null)] <- NULL values$data_used <- lapply(data, function(x) x[ ,1:2]) } } else { data <- values$data[complete.cases(values$data), ] values$data_used <- data } # Age if (input$global_fit) { age <- sapply(1:length(values$data_used), function(i) as.numeric(input[[paste0("age_", i)]])) } else { if (input$override_age) age <- input$age else age <- NULL } # Mu if (input$global_fit) { if (input$individual_mus && input$override_mu) mu <- sapply(1:length(values$data_used), function(i) as.numeric(input[[paste0("mus_", i)]])) else if (input$override_mu) mu <- as.numeric(input[["mus_1"]]) else mu <- NULL } else { if (input$override_mu) mu <- input$mu else mu <- NULL } # fitting line color if (input$line_col == "custom") line_col <- input$jscol else if (input$line_col == "default") line_col <- NULL else line_col <- input$line_col args <- list( data = values$data_used, age = age, weights = if (input$global_fit) FALSE else input$weights, sigmaphi = if (input$override_sigmaphi) input$sigmaphi_base * 10^-(abs(input$sigmaphi_exp)) else NULL, mu = mu, Ddot = if (input$doserate) input$ddot else NULL, D0 = if (input$doserate) input$d0 else NULL, verbose = FALSE, pch = ifelse(input$pch == "custom", input$custompch, as.numeric(input$pch) - 1), bg = ifelse(input$color == "custom", input$jscol1, input$color), cex = input$cex, legend = input$legend, main = input$main, line_col = line_col, line_lty = as.numeric(input$lty), line_lwd = as.numeric(input$lwd), xlab = input$xlab, ylab = input$ylab, log = paste0("", ifelse(input$logx, "x", ""), ifelse(input$logy, "y", "")), coord_flip = input$coord_flip, error_bars = input$error_bars, xlim = if (!input$coord_flip) input$xlim else input$ylim, ylim = if (!input$coord_flip) input$ylim else rev(input$xlim)) # sanitise final list by removing all NULL elements args[sapply(args, is.null)] <- NULL # return values$args <- args }) observe({ # nested renderText({}) for code output on "R plot code" tab code.output <- callModule(RLumShiny:::printCode, "printCode", n_input = 1, fun = paste0("fit_SurfaceExposure(data,"), args = values$args) output$plotCode<- renderText({ code.output })##EndOf::renderText({}) callModule(RLumShiny:::exportCodeHandler, "export", code = code.output) callModule(RLumShiny:::exportPlotHandler, "export", fun = "fit_SurfaceExposure", args = values$args) }) ## ERROR HANDLING ---- output$error <- renderText({ # invalidate all reactive values if (!is.null(values$error)) { values$results <- NULL HTML(paste0( tags$br(), tags$p("ERROR!", style = "color:red; font-size:20px;"), values$error$message )) } }) ## MAIN ---- output$main_plot <- renderPlot({ tryCatch({ values$results <- do.call(fit_SurfaceExposure, values$args) }, error = function(e) { values$error <- e values$results <- NULL }) }) output$console <- renderText({ if (is.null(values$results)) return(NULL) values$error <- NULL if (!input$global_fit) { res <- as.data.frame(t(signif(unlist(get_RLum(values$results)), 3))) HTML(paste0( tags$b("Age (a): "), res$age, " ± ", res$age_error, tags$em(ifelse(input$override_age, "(fixed)", "")), tags$br(), tags$b("sigmaPhi: "), res$sigmaphi, " ± ", res$sigmaphi_error, tags$em(ifelse(input$override_sigmaphi, "(fixed)", "")), tags$br(), tags$b("mu: "), res$mu, " ± ", res$mu_error, tags$em(ifelse(input$override_mu, "\t(fixed)", "")), tags$br() )) } else { res <- as.data.frame(get_RLum(values$results)) HTML(paste0( tags$b("Ages (a): "), paste(res$age, collapse = ", "), tags$em(" (fixed)"), tags$br(), tags$b("sigmaPhi: "), signif(unique(res$sigmaphi), 3), " ± ", signif(unique(res$sigmaphi_error), 3), tags$em(ifelse(input$override_sigmaphi, "(fixed)", "")), tags$br(), tags$b("mu: "), signif(unique(res$mu), 3), " ± ", signif(unique(res$mu_error), 3), tags$em(ifelse(input$override_mu, "\t(fixed)", "")), tags$br() )) } }) }##EndOf::function(input, output)RLumShiny/inst/shiny/surfaceexposure/www/0000755000176200001440000000000014175060542020326 5ustar liggesusersRLumShiny/inst/shiny/surfaceexposure/www/RL_Logo.png0000644000176200001440000007222114175060542022335 0ustar liggesusersPNG  IHDR pHYs.#.#x?v OiCCPPhotoshop ICC profilexڝSgTS=BKKoR RB&*! J!QEEȠQ, !{kּ> H3Q5 B.@ $pd!s#~<<+"x M0B\t8K@zB@F&S`cbP-`'{[! eDh;VEX0fK9-0IWfH  0Q){`##xFW<+*x<$9E[-qWW.(I+6aa@.y24x6_-"bbϫp@t~,/;m%h^ uf@Wp~<5j>{-]cK'Xto(hw?G%fIq^D$.Tʳ?D*A, `6B$BB dr`)B(Ͱ*`/@4Qhp.U=pa( Aa!ڈbX#!H$ ɈQ"K5H1RT UH=r9\F;2G1Q= C7F dt1r=6Ыhڏ>C03l0.B8, c˱" VcϱwE 6wB aAHXLXNH $4 7 Q'"K&b21XH,#/{C7$C2'ITFnR#,4H#dk9, +ȅ3![ b@qS(RjJ4e2AURݨT5ZBRQ4u9̓IKhhitݕNWGw Ljg(gwLӋT071oUX**| J&*/Tު UUT^S}FU3S ԖUPSSg;goT?~YYLOCQ_ cx,!k u5&|v*=9C3J3WRf?qtN (~))4L1e\kXHQG6EYAJ'\'GgSSݧ M=:.kDwn^Loy}/TmG X $ <5qo</QC]@Caaᄑ.ȽJtq]zۯ6iܟ4)Y3sCQ? 0k߬~OCOg#/c/Wװwa>>r><72Y_7ȷOo_C#dz%gA[z|!?:eAAA!h쐭!ΑiP~aa~ 'W?pX15wCsDDDޛg1O9-J5*>.j<74?.fYXXIlK9.*6nl {/]py.,:@LN8A*%w% yg"/6шC\*NH*Mz쑼5y$3,幄'L Lݛ:v m2=:1qB!Mggfvˬen/kY- BTZ(*geWf͉9+̳ې7ᒶKW-X潬j9(xoʿܔĹdff-[n ڴ VE/(ۻCɾUUMfeI?m]Nmq#׹=TR+Gw- 6 U#pDy  :v{vg/jBFS[b[O>zG499?rCd&ˮ/~јѡ򗓿m|x31^VwwO| (hSЧc3-gAMA|Q cHRMz%u0`:o_FiIDATx}td%! )+7ږJ["\wKIQl7YWtFuftZǙ]=8n-Ot) q\p7ab SZMM@z K[yӧO?_7n\ pw~ \i$eo .<_: @IpB^D=c,JN+߻jժ8|()ٞ /MMM#g̙d\]w5f߾}}vP2.^zTq㢯ψ˼W馛FGN#P.NȦG"suhll4(E%>F]]Q~o=6mdPcbŊZ|ب˼xaPl."o,۷o7.E˼۷… K;|XRJw}~(T_u^^矏F?mƼ|>{WkΜ9 sl瞲^O$y1qIJƍ>?qZ*/,YR߳?8F-uy۷o VOF8GrWXQIU\VZ~OVײo߾ؾ}>F$yӧW4nܸ2oΜ9U5GN? [/o .گ矏F?Uc^]]]U}G9{`]vEL:)de1!Ҭ!UVǴi?Y>K苧鍈m{N}?SJ_m[2#@%6 qw;4T>u>o_ODPVbcލ7X3_}b5502|eXV"c?9E__H6;OYO?{P+z{{cժU̙30Q>= v@$&-Y$1ߔؾ}{x~BA"1oo߾D}c.\~B^GeqHDļ\.oΊ+S Z~OϸRc^O7gժU>p۾/zNDx0c^>^oЍ7~RDz_ž>`j:s=۷/={VSOHl;|pZ*ߤn)5ɿ "٘w;=c?:tƇO,P^|@ }XpaYO-P5<6 KKf"žhf5Yr\*YsO<~j~VTHż/SZjUٟY o Mg߁}wBy/B{ｩ-Y$%Oxt T̻뮻R ۷o_l߾=nF?@Ѹ 5>ߑ"~. 1ZJjb^.(+V<`('o<{<J*b^(UV?hll4P>ܰ5"ؾϣ1H o։y@<<BБczf@by@ܻ?:7l@y@"?H41i|>6u툮m{<Oj@y@MH31 O["%UMC%U%ǃ_vU<*xT'q"νsֈ!F@G=O5#B;tX^9zNxp~۱G"Z(1( /s̳ŗlr (1|>+ /2xPb0lV>>*Aŗ^U_Gj<`H!gZ>b R KNζ=GE<Rb<\|i;!@ sŮj)5 j)PqEsܰUÑ" <(5m <8G\}'<<8/r7e!(yc-Pnb¡#⾕ y@Yy0B; [<3 T<5m]=BP1b Tmq)7^\|QL0..ln_a$H01Bo1S.yCןuuugZ 'A\}'<EګrlH71`0=?0pN^.0 "57b4B0g qascwZHpw)154qG y._y\Eb%Amk5Gfx, <1T NwY q'A x%OƧ%p[hO|o<(m[ ̾WJ7?54raA8Ẹ:r,qGmkR $QU|ܷ!!Txڣ $QU> yHyT޾ D<FḲ*<@\yT#D<Ẹ|NI%Plbm{|N35.>%raA(1y͏#1D<JṂ"Kk6 y$ָܶh\s|%1Id<*scCP涵FD_{A(91;tX15mK(|>|ԬrP @ىyʯ|Cȣ& ~.GOo*Ḅl~d8xԜm+/f *J̣,|Zj-]:7luGUp@y̓_G ^}}q Q 6WyEQWWg81asGmk2scc*8< Z yP<s25^+E23-yP|bcWw!5!JC5a>Wy#o~% ;7"@y¦o#!qJw#q[\1"sZ!D#""|8x ָܶ+cc@yDD} <m|!//涵nH1/|^^]FFH!Wy\b^8x)*IK_z)*MK'z/RU$PORU$P]!e涵u4$@FH2s`b^?KmNK'2O\p! ļ'"sZchļz$#@ y w)[b^y#ܶhb^>wܛlSq^|)"%sM;:n20ORbn[k̼l! Eļ&|30dfH1/A6=7BJ<H/1/A~p>/MK˼47RLKggxӔ)&Abb^Be^*44RLK5B]>} <ozF\=-Fk#$ <d yP涵F}@کP#)'@ !ᮻ #b^R'O!ZyP+<\|1j yP+<b1j5B!@FyP#<bԀ_7KK9W_ayNbԘ=RHK7Mhرq#@ y R__fN7D WK/RFK:# )#%̕o))#%7]b-0s)Q[H1/a]8)Q[H1/a6])_RBK#ؾm{;RBK٭o1Ba#@ y tٛh! ļ4q`a@:y 42{b~pb^BaFH>t1$P_sRfwwOt}o! ļsF۱u$Po2K0Ru$P FH)y\b^]KB ļ[0wRu$`3/sRu$`Z!\@y !\@y w˂9FHOtl۱Pļ-'63T11/CJD5گ1[({ >7Q-<(xԖsBOb^[!8'AϿ0#R{{;ޮg[?1`<:b/ z0 bg:b z{1`" c\aޥqQA zg;c ΣTvw?x`7Bc|v'/^z PǰΣԺ+>yߚ/g 1"(=Wޛn f[1\1b\Qr//|-e0#{ ( _*>TsǨym۱|m)c?01[[[o!(nz>RvwCϟ#G5 QT3N2 W߉P<06{bՃ#>J&Qt !QuXcjGI_UaYz~z od>}'?yTx\pQzb%3eldo!"BУ*=ӧܒqKfQjb%' AU۱:@U({/-Uo0WqWYuuuy%&xܖ1?wĕO3 UC̣,l<*b-7=?4-#%Qu|~i#0\bUVz[^iNJom}sdo!"|~sz{hweo뮙uuuH91' Aj F=15n̉mPo:Tp̚9/VkOeG26>t;sVA~Ջ{ڷ^\ _?]x]wѱx~\d^'NGpOE㎎˧ A%n-|q*D#xpX|q(#1074?G%rc'GkƧ%&G\2iB|wD熭Pb~UT@w5W˦z+.9H,A*ފ;59=.|#G_Uw!OЃ|+CsZq͑;;̾;V}[qQ5eԘ Ώ?Y\@ XOzUN!߽4> 2cd/*kxAT'18d:r,[PD1[`H3NrGo<`XuŲw(@x]ns-<`zJe0j__;36u툮m{\@y?" b-qQQJMø>OJgEt\%~U1Y-<=(y@Ųc>tLJ!߽4?eQol2g}.fdIH|wMo 0LbP13N6T̡#Ǣ!`D__Ƌ/|*E}@y@xx sLݟ.^"%/uԵCȣ\6 *|u_}'"A-ChinY3gbn+CE߱g#O?/C V~((KHN};o~X?N>q|S&A?547 O^}}7ힾ#ⷱO?k&A]U岙fCT W?ypБc)yRmvGAlԣT1RБcwtblCT1R辕ʣ\6 y2;7Cjok=)ӹa< e37UJ̃ٸQ#PP.E)kWy iFbbĦB岙fCT91Rŗ^m{ AA-͍1cdCT91R`W*rLܾd!j d8x'M0@  WyfFy`޾S&ئ1b$u]QP.yP?yUCjokuPc]e-͍1k C$5fW*rLܾd!J̃d8x'M0@ByPC֮*rLq!L̃q1Wy iꔉq `bԈ6ʣ\6K7@‰yP9}' AAW]1-61@‰yP\1\6 m{ f͜a"B̃ԵU岙x )bTHRKscL4"A]U岙}C bT3>5M2U!A|iFWyfb5<(CGEo CP)clCbu]QP.ws!8#1hR{[k3:7luGAl&2f<({rLܺ`N<(|>*aΕF`HbB岙XnJ̃ѵm!(1f͜aJ̃[oʣ\6/Y`Ẽ?~21C5s( 1F`SWyfw,6%#0?*!47I @Ɉy0LkoqGAl&n_̳ŁG AASLt@ɉy0 _ZU岙Xx!(91Бcw4u4gzfWyf]\hB̃!ܻUCjok_:CPb sVWyf"3o!(1 عw((ĭ D}}1(1 ϻns(+1`S!rLt,j7e'ڶf0e'7\QP.ۗ,0!iZc "<8[\Q<*M̃9t䘫<4uDWyTzfWyfb<^0]uŴ4T*岙6TGܻUCjokzCPqb׹a< e37T1Tζ=F\6]P5<4k #Xb5cS! m{ f͜aRỊl*rLq!H-1<3M6%Q5֮*rLܾd!H51d8x4uĘwY4Z#i<*bS!rLt,j7Gڶf0G=oʣ\6/Y`81?~2vuZc 3(뷸ʣ Wy0419tX8x4uDWy01Yn< e3t|C<Бcw4u401pPrLܙpb%s~Wy 5 g!Qrʣ\6y  QRٶfcQ<&1G]1Y3gỊd6u(h*>1[*FḤ$V~((KFḤZc (뷸ʣ\6wtl1:t䘫<4uĸhQ(6ʣ\6K7G:r,zNZclC(y}+rGAl&2f΁GQܻ 5 @̣(:7luGAl&C98g7?j e3ѱ=HڶUC5s<ɦB岙fC@yZѵm!(1fLl(1Q[~< e3q"'Ƙ:7luǐn5M2UGA_ZU岙Xx!<Бcw4u4PFbgzfWyf-2x{cHmQ__o(31ܰU岙̛m1Wζ=F\6.**D|>o~UCaΕF 8eS!rLt,j7TGD*# 1f͜a 1Xoʣ\6/Y`01?~2 []1_k!b^Bm!QP.E#%P>m{ f͜a1b^=oʣ\6c!y d147I 5HK뷸ʣ\6/Y`Qb^m{\1Y3gR@̫rvyfΎ )!U_z9147ƌi>B̫b-Wyf% )"U'Ƙm{ f͜aH91 |UÑQe3ѱ$aL>=VX/Af0jժhjj5ƨBbB.ۗ,0c}vcT1F1&O`?.\mmmk*  m'N+VD>7Hy0BSLt@*Z*~~/1*D̃e3t|C}?~|<(31F+ئ1 ꫯx R&b S.m ٷo_455Ŋ+Qb S{[k`ժUQWW۷o7F y0 l&2fb…1~8|1J@̃e3ѱU SL>=r+21aFzG)>cCF{<"`-͍c…΁䲙}C@۷/O+Vyz A-͍1yC@ Z*sM1F@̃3e3e %}ypSLMc epdb󴵞qP٪z*Su+4^)RkߥЉtB&!dfD1cV0dd/0ɽM$>>>zm>|36cuu5v\\\h'#7+rt4#<@x ,C3jZk{<֭[1ݻggg0k>|Ƞpj5v ̃xT*idXӉR~{4D^Z'''Z0k>| f<z4HMȨ5ATx"k-M&I^pߏz7w&kMВ$n[[[\0I4cmm-Wrv;...r.atbyy97y>Z~!q܌o.yp8h W0Bt:Q*{05 (ͨjq||Zyxɓ(J3U0>^GVL#KX__v=yz<Nj5^쾘[ <4MG?<$I(AT*!K>ߍhsEj<og%/M8< ]qxx+++~On`a%I^/Aa jnF*̚y,Vxpk73iZa{  Ӓ$n[㴟-UĹx3i4JE3>  3$pXxqLz1y0W;;;1LŻl4Mw v0SIQ A5 nFЌ+ qV+ϣlh7XRDLiK4ceeE3<.Iz1 yS$`vh4-͘2aSj4ok"iښfܰ<`p-IDuvvvvślF{{{QT4cvJ?}'W$ph.ޜ9f /1yqW""ZVL&h41?4~o.^9f @Dwtt@ :E[L>y煋0 L|10?f@|v]k /\9f ōui]ug@nΕ7l`|?\+o+OvVՃ}UV:Ws-7m+Ov}sVJ!cSY+rfjY9@L5/+g@X@7rDypcXyQ  n<,l&4nȉnb[z,D]z,[X{dIXxs{Zf/s6ٙIENDB`RLumShiny/inst/shiny/surfaceexposure/www/style.css0000644000176200001440000000252514175060542022204 0ustar liggesusers.custom-modal { padding-left: 10px; padding-top: 10px; padding-bottom: 10px; padding-right: 10px; line-height: 200%; background-color: #fff; overflow: visible; position: absolute; z-index: 999; border-radius: 10px; border-style: solid; border-color: #428bca; } .h { font-size: 11px; margin: 0 0 0px; } h5, h6 { color: #428bca; } .tooltip-inner { max-width: 450px; } .control-label, .selectize-dropdown, .item, .btn, .uneditable-input, .sorting, .odd, .even, .dataTables-info, .fa, .fa-refresh { font-size: 12px; } .selectize-input { padding: 0px 10px; min-height: 20px; } label, body, input { font-size: 12px; } .label, .badge { font-size: 12px; padding: 4px 20px; margin: 10px; line-height: 18px; } .label-info, .badge-info { background-color: #428bca; } input[type="text"],input[type="number"],input[type="email"],input[type="url"],input[type="search"],input[type="tel"],input[type="color"],.uneditable-input{ display:inline-block; height:18px; padding:0px 0px 0px 7px; margin-bottom:10px; font-size: 11px; line-height: 1.5; color:#555; vertical-align:middle; -webkit-border-radius:4px; -moz-border-radius:4px; border-radius:4px } input,textarea,.uneditable-input{ width: auto; } .help-block { margin-top: 13px; margin-bottom: 0px; } RLumShiny/inst/shiny/surfaceexposure/www/GitHub-Mark-32px.png0000644000176200001440000000326214175060542023703 0ustar liggesusersPNG  IHDR szztEXtSoftwareAdobe ImageReadyqe<$iTXtXML:com.adobe.xmp $IDATxėmhayL30A+R#f>IHکy(M)_o5 0+0Ėl&o{i^]u<{Yws}=uC>$L, }<w}8^ AO?p! xaяPKI3`'B>0QT1<+`}^nvkp^ƅF|1"Gp.*oO׀Vp ]߅jc8K$q 8jV`#`vmpGѢu!#}#:U_?_yhE $=;c*xNOo+&w)%K-R%6n'o">j/t³qoGW7j%2q GX?woibCÐAzbǰt \14|S.DZ]# b|H$(ʕohmqͱRP셣$,0Z20 tNvRW3K8Xk2 IO6 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 rHandsontableOutput(outputId = "table_in_primary"), helpText(HTML(paste0( tags$b("NOTE: "), "The uploaded file must have at least two columns (Depth, Signal). ", "If the file contains three columns, it is automatically assumed that the third column ", "is the error on the signal. The fourth column (Group) is only required for global fitting ", "of multiple data sets.") )) ),##EndOf::Tab_1 tabPanel("Parameters", fluidRow( column(width = 6, checkboxInput(inputId = "global_fit", "Global fit", TRUE) ), column(width = 6, checkboxInput(inputId = "individual_mus", "Individual \\( \\mu \\) values", TRUE) ) ), conditionalPanel(condition = "input.global_fit == true", helpText(HTML(paste(tags$b("NOTE:"), "Weighting is not available for global fitting."))) ), fluidRow( column(width = 6, uiOutput("global_fit_ages") ), column(width=6, uiOutput("global_fit_mus") ) ), conditionalPanel(condition = "input.global_fit == false", checkboxInput(inputId = "weights", HTML("Error weighted fitting (1/σ2)"), FALSE) ), hr(), conditionalPanel( condition = "input.global_fit == false", fluidRow( column(1, checkboxInput(inputId = "override_age", "", value = FALSE)), column(10, numericInput(inputId = "age", "Age (a)", value = 1000, min = 0) ) ) ), fluidRow( column(1, checkboxInput(inputId = "override_sigmaphi", "", value = TRUE)), column(10, fluidRow( column(width = 6, numericInput(inputId = "sigmaphi_base", "\\( \\overline{\\sigma\\varphi_0} \\) (base)", value = 5.0, step = 0.1) ), column(width = 6, numericInput(inputId = "sigmaphi_exp", "\\( \\overline{\\sigma\\varphi_0} \\) (exponent)", value = 10, step = 1) ) ) ) ), fluidRow( column(1, checkboxInput(inputId = "override_mu", "", value = TRUE)), column(10, conditionalPanel(condition = "input.global_fit == false", numericInput(inputId = "mu", "\\( \\mu \\)", value = 0.90, step = 0.01) ), conditionalPanel(condition = "input.global_fit == true", helpText(paste("Provide \\( \\mu \\) values")) ) ) ) ), tabPanel("Dose rate", checkboxInput("doserate", "Consider dose rate", FALSE), helpText(HTML(paste( "This will fit eq. 12 in Sohbati et al. (2012b) to the data. Note, however,", "that here the dose rate is assumed constant, i.e., it is independent of sample depth." ))), withMathJax(), helpText("$$L(x) = \\frac{\\overline{\\sigma\\varphi _0}e^{-\\mu x}e^{-t[\\overline{\\sigma\\varphi _0}e^{-\\mu x} + \\frac{\\dot{D}}{D_0}]}+ \\frac{\\dot{D}}{D_0}} {\\overline{\\sigma\\varphi _0}e^{-\\mu x} + \\frac{\\dot{D}}{D_0}}$$"), numericInput("ddot", "Dose rate, \\(\\dot{D} (Gy/ka)\\)", value = 1.5, min = 0, step = 0.01), numericInput("d0", "Characteristic saturation dose, \\(D_0\\) (Gy)", value = 40, min = 0, step = 1), hr(), helpText(HTML(paste(tags$b("Reference:"), "Sohbati, R., Jain, M., Murray, A.S., 2012b. Surface exposure dating of non-terrestial bodies using optically stimulated luminescence: A new method. Icarus 221, 160-166."))) ), tabPanel("Plot", div(align = "center", h5("Title")), textInput(inputId = "main", label = "Title", value = "OSL Surface Exposure Dating"), fluidRow( column(width = 6, selectInput(inputId = "pch", label = "Datapoint style", selected = "22", 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", "filled Circle w/ outline" = "22", "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", selected = "red", choices = list("Black" = "black", "Grey" = "grey50", "Red" = "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
"), jscolorInput(inputId = "jscol1")) ) ), fluidRow( column(width = 6, selectInput(inputId = "lty", "Fitting line style", selected = 1, choices = list("Blank" = 0, "Solid" = 1, "Dashed" = 2, "Dotted" = 3, "Dot dash" = 4, "Long dash" = 5, "Two dash" = 6)) ), column(width = 6, numericInput(inputId = "lwd", label = "Line width", min = 0, max = 5, value = 1) ) ), fluidRow( column(width = 6, selectInput(inputId = "line_col", label = "Fitting line color", selected = "default", choices = list("Default" = "default", "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.line_col == 'custom'", HTML("Choose a color
"), jscolorInput(inputId = "jscol2")) ) ), br(), fluidRow( column(width = 4, checkboxInput(inputId = "legend", label = "Show legend", value = TRUE) ), column(width = 4, checkboxInput(inputId = "coord_flip", label = "Flip coordinate system", value = FALSE) ), column(width = 4, checkboxInput(inputId = "error_bars", label = "Show error bars", value = TRUE) ) ), div(align = "center", h5("Scaling")), sliderInput(inputId = "cex", label = "Scaling factor", min = 0.5, max = 2, value = 1.1, 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 = FALSE), textInput(inputId = "xlab", label = "Label x-axis", value = "Depth (mm)"), # inject sliderInput from Server.R sliderInput(inputId = "xlim", "X-axis limits", min = -15, max = 20, value = c(-0, 10), step = 0.1), 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 = "OSL intensity (Ln/Tn)"), sliderInput(inputId = "ylim", "Y-axis limits", min = -1, max = 2, value = c(-0.1, 1.1), step = 0.1) ),##EndOf::Tab_4 RLumShiny:::exportTab("export", filename = "surfaceexposure"), RLumShiny:::aboutTab("about", "surfaceExposure") )##EndOf::tabsetPanel ),##EndOf::sidebarPanel # 3 - output panel mainPanel(width = 7, # insert css code inside 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", htmlOutput("error"), plotOutput(outputId = "main_plot", height = "500px"), htmlOutput(outputId = "console")), tabPanel("R code", verbatimTextOutput("plotCode")) )###EndOf::tabsetPanel )##EndOf::mainPanel ),##EndOf::sideBarLayout bookmarkButton() )##EndOf::fluidPage } RLumShiny/inst/shiny/fading/0000755000176200001440000000000014175060542015507 5ustar liggesusersRLumShiny/inst/shiny/fading/global.R0000644000176200001440000000032214175060542017067 0ustar liggesusers## global.R ## library(Luminescence) library(RLumShiny) library(shiny) library(data.table) library(rhandsontable) data("ExampleData.Fading", envir = environment()) enableBookmarking(store = "server")RLumShiny/inst/shiny/fading/server.R0000644000176200001440000001330614175060542017143 0ustar liggesusers## Server.R ## MAIN FUNCTION function(input, output, session) { # input data (with default) values <- reactiveValues(data_primary = if ("startData" %in% names(.GlobalEnv)) startData else ExampleData.Fading$fading.data$IR50, data = NULL, args = NULL, args_corr = NULL, results = NULL, results_corr = NULL) session$onSessionEnded(function() { stopApp() }) # check and read in file (DATA SET 1) observeEvent(input$file, { inFile<- input$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 }) output$table_in_primary <- renderRHandsontable({ rhandsontable(values$data_primary, height = 300, colHeaders = c("LxTx", "LxTx error", "Time since irradiation"), 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_primary <- hot_to_r(df_tmp) }) # Arguments observe({ values$data <- values$data_primary values$args <- list( object = values$data, structure = c("Lx", "Tx"), t_star = "half", n.MC = 100, verbose = FALSE, plot = TRUE, plot.single = 3 ) }) # MAIN (analyse_FadingMeasurement) ---- output$main_plot <- renderPlot({ values$results <- try(do.call(analyse_FadingMeasurement, values$args)) }) # MAIN (calc_FadingCorr) ---- observe({ if (!input$override_gval) if (is.null(values$results)) return(NULL) if (inherits(values$results, "try-error")) return(NULL) values$results@originator <- "analyse_FadingMeasurement" values$args_corr <- list( age.faded = c(input$age_faded, input$age_error_faded), g_value = if (input$override_gval) c(input$g_value, input$g_value_error) else values$results, tc = input$tc, tc.g_value = input$tc_gval, verbose = FALSE, txtProgressBar = FALSE, n.MC = 1000 ) values$results_corr <- try(do.call(calc_FadingCorr, values$args_corr)) }) observe({ # nested renderText({}) for code output on "R plot code" tab code.output <- callModule(RLumShiny:::printCode, "printCode", n_input = 1, fun = "analyse_FadingMeasurement(data,", args = values$args) output$plotCode<- renderText({ code.output })##EndOf::renderText({}) callModule(RLumShiny:::exportCodeHandler, "export", code = code.output) callModule(RLumShiny:::exportPlotHandler, "export", fun = "analyse_FadingMeasurement", args = values$args) }) output$corrCode <- renderText({ if (input$override_gval) { gval <- values$args_corr$g_value tc <- input$tc } else { gval <- c(values$results@data$fading_results$FIT, values$results@data$fading_results$SD) tc <- values$results@data$fading_results$TC } paste( "# To reproduce the plot in your local R environment", "# copy and run the following code to your R console.", "library(Luminescence)", "\n", "calc_FadingCorr(", paste0("age.faded = c(", values$args_corr$age.faded[1], ", ", values$args_corr$age.faded[2], "),"), paste0("g_value = c(", gval[1], ", ", gval[2], "),"), paste0("tc = ", tc, ", "), paste0("tc.g_value = ", input$tc_gval, ","), paste0("n.MC = 1000)"), sep = "\n") }) output$results <- renderText({ if (is.null(values$results)) return(NULL) if (inherits(values$results, "try-error")) return(NULL) gval <- get_RLum(values$results) rho <- get_RLum(values$results, "rho_prime") HTML(paste0( tags$hr(), tags$b("g-value: "), signif(gval$FIT, 3), " ± ", signif(gval$SD, 3), " %/decade", tags$br(), tags$b("g-value"), tags$sub("2days"), ": ", signif(gval$G_VALUE_2DAYS, 3), " ± ", signif(gval$G_VALUE_2DAYS.ERROR, 3), " %/decade", tags$br(), tags$b("t"), tags$sub("c"), ": ", gval$TC, tags$br(), " ρ': ", signif(rho$MEAN, 3), " ± ", signif(rho$SD, 3), tags$br(), " » log10(ρ'): ", signif(log10(rho$MEAN), 3), " ± ", signif(rho$SD / (rho$MEAN * log(10, base = exp(1))), 3) )) }) output$results_corr <- renderText({ if (is.null(values$results_corr) || inherits(values$results_corr, "try-error")) res <- data.frame(AGE = NA, AGE.ERROR = NA) else res <- get_RLum(values$results_corr) HTML(paste0( tags$hr(), tags$b("Age "), tags$em("(faded): "), input$age_faded, " ± ", input$age_error_faded, " ka", tags$br(), tags$b("Age "), tags$em("(corrected): "), signif(res$AGE, 3), " ± ", signif(res$AGE.ERROR, 3), " ka" )) }) }##EndOf::function(input, output)RLumShiny/inst/shiny/fading/www/0000755000176200001440000000000014175060542016333 5ustar liggesusersRLumShiny/inst/shiny/fading/www/RL_Logo.png0000644000176200001440000007222114175060542020342 0ustar liggesusersPNG  IHDR pHYs.#.#x?v OiCCPPhotoshop ICC profilexڝSgTS=BKKoR RB&*! J!QEEȠQ, !{kּ> H3Q5 B.@ $pd!s#~<<+"x M0B\t8K@zB@F&S`cbP-`'{[! eDh;VEX0fK9-0IWfH  0Q){`##xFW<+*x<$9E[-qWW.(I+6aa@.y24x6_-"bbϫp@t~,/;m%h^ uf@Wp~<5j>{-]cK'Xto(hw?G%fIq^D$.Tʳ?D*A, `6B$BB dr`)B(Ͱ*`/@4Qhp.U=pa( Aa!ڈbX#!H$ ɈQ"K5H1RT UH=r9\F;2G1Q= C7F dt1r=6Ыhڏ>C03l0.B8, c˱" VcϱwE 6wB aAHXLXNH $4 7 Q'"K&b21XH,#/{C7$C2'ITFnR#,4H#dk9, +ȅ3![ b@qS(RjJ4e2AURݨT5ZBRQ4u9̓IKhhitݕNWGw Ljg(gwLӋT071oUX**| J&*/Tު UUT^S}FU3S ԖUPSSg;goT?~YYLOCQ_ cx,!k u5&|v*=9C3J3WRf?qtN (~))4L1e\kXHQG6EYAJ'\'GgSSݧ M=:.kDwn^Loy}/TmG X $ <5qo</QC]@Caaᄑ.ȽJtq]zۯ6iܟ4)Y3sCQ? 0k߬~OCOg#/c/Wװwa>>r><72Y_7ȷOo_C#dz%gA[z|!?:eAAA!h쐭!ΑiP~aa~ 'W?pX15wCsDDDޛg1O9-J5*>.j<74?.fYXXIlK9.*6nl {/]py.,:@LN8A*%w% yg"/6шC\*NH*Mz쑼5y$3,幄'L Lݛ:v m2=:1qB!Mggfvˬen/kY- BTZ(*geWf͉9+̳ې7ᒶKW-X潬j9(xoʿܔĹdff-[n ڴ VE/(ۻCɾUUMfeI?m]Nmq#׹=TR+Gw- 6 U#pDy  :v{vg/jBFS[b[O>zG499?rCd&ˮ/~јѡ򗓿m|x31^VwwO| (hSЧc3-gAMA|Q cHRMz%u0`:o_FiIDATx}td%! )+7ږJ["\wKIQl7YWtFuftZǙ]=8n-Ot) q\p7ab SZMM@z K[yӧO?_7n\ pw~ \i$eo .<_: @IpB^D=c,JN+߻jժ8|()ٞ /MMM#g̙d\]w5f߾}}vP2.^zTq㢯ψ˼W馛FGN#P.NȦG"suhll4(E%>F]]Q~o=6mdPcbŊZ|ب˼xaPl."o,۷o7.E˼۷… K;|XRJw}~(T_u^^矏F?mƼ|>{WkΜ9 sl瞲^O$y1qIJƍ>?qZ*/,YR߳?8F-uy۷o VOF8GrWXQIU\VZ~OVײo߾ؾ}>F$yӧW4nܸ2oΜ9U5GN? [/o .گ矏F?Uc^]]]U}G9{`]vEL:)de1!Ҭ!UVǴi?Y>K苧鍈m{N}?SJ_m[2#@%6 qw;4T>u>o_ODPVbcލ7X3_}b5502|eXV"c?9E__H6;OYO?{P+z{{cժU̙30Q>= v@$&-Y$1ߔؾ}{x~BA"1oo߾D}c.\~B^GeqHDļ\.oΊ+S Z~OϸRc^O7gժU>p۾/zNDx0c^>^oЍ7~RDz_ž>`j:s=۷/={VSOHl;|pZ*ߤn)5ɿ "٘w;=c?:tƇO,P^|@ }XpaYO-P5<6 KKf"žhf5Yr\*YsO<~j~VTHż/SZjUٟY o Mg߁}wBy/B{ｩ-Y$%Oxt T̻뮻R ۷o_l߾=nF?@Ѹ 5>ߑ"~. 1ZJjb^.(+V<`('o<{<J*b^(UV?hll4P>ܰ5"ؾϣ1H o։y@<<BБczf@by@ܻ?:7l@y@"?H41i|>6u툮m{<Oj@y@MH31 O["%UMC%U%ǃ_vU<*xT'q"νsֈ!F@G=O5#B;tX^9zNxp~۱G"Z(1( /s̳ŗlr (1|>+ /2xPb0lV>>*Aŗ^U_Gj<`H!gZ>b R KNζ=GE<Rb<\|i;!@ sŮj)5 j)PqEsܰUÑ" <(5m <8G\}'<<8/r7e!(yc-Pnb¡#⾕ y@Yy0B; [<3 T<5m]=BP1b Tmq)7^\|QL0..ln_a$H01Bo1S.yCןuuugZ 'A\}'<EګrlH71`0=?0pN^.0 "57b4B0g qascwZHpw)154qG y._y\Eb%Amk5Gfx, <1T NwY q'A x%OƧ%p[hO|o<(m[ ̾WJ7?54raA8Ẹ:r,qGmkR $QU|ܷ!!Txڣ $QU> yHyT޾ D<FḲ*<@\yT#D<Ẹ|NI%Plbm{|N35.>%raA(1y͏#1D<JṂ"Kk6 y$ָܶh\s|%1Id<*scCP涵FD_{A(91;tX15mK(|>|ԬrP @ىyʯ|Cȣ& ~.GOo*Ḅl~d8xԜm+/f *J̣,|Zj-]:7luGUp@y̓_G ^}}q Q 6WyEQWWg81asGmk2scc*8< Z yP<s25^+E23-yP|bcWw!5!JC5a>Wy#o~% ;7"@y¦o#!qJw#q[\1"sZ!D#""|8x ָܶ+cc@yDD} <m|!//涵nH1/|^^]FFH!Wy\b^8x)*IK_z)*MK'z/RU$PORU$P]!e涵u4$@FH2s`b^?KmNK'2O\p! ļ'"sZchļz$#@ y w)[b^y#ܶhb^>wܛlSq^|)"%sM;:n20ORbn[k̼l! Eļ&|30dfH1/A6=7BJ<H/1/A~p>/MK˼47RLKggxӔ)&Abb^Be^*44RLK5B]>} <ozF\=-Fk#$ <d yP涵F}@کP#)'@ !ᮻ #b^R'O!ZyP+<\|1j yP+<b1j5B!@FyP#<bԀ_7KK9W_ayNbԘ=RHK7Mhرq#@ y R__fN7D WK/RFK:# )#%̕o))#%7]b-0s)Q[H1/a]8)Q[H1/a6])_RBK#ؾm{;RBK٭o1Ba#@ y tٛh! ļ4q`a@:y 42{b~pb^BaFH>t1$P_sRfwwOt}o! ļsF۱u$Po2K0Ru$P FH)y\b^]KB ļ[0wRu$`3/sRu$`Z!\@y !\@y w˂9FHOtl۱Pļ-'63T11/CJD5گ1[({ >7Q-<(xԖsBOb^[!8'AϿ0#R{{;ޮg[?1`<:b/ z0 bg:b z{1`" c\aޥqQA zg;c ΣTvw?x`7Bc|v'/^z PǰΣԺ+>yߚ/g 1"(=Wޛn f[1\1b\Qr//|-e0#{ ( _*>TsǨym۱|m)c?01[[[o!(nz>RvwCϟ#G5 QT3N2 W߉P<06{bՃ#>J&Qt !QuXcjGI_UaYz~z od>}'?yTx\pQzb%3eldo!"BУ*=ӧܒqKfQjb%' AU۱:@U({/-Uo0WqWYuuuy%&xܖ1?wĕO3 UC̣,l<*b-7=?4-#%Qu|~i#0\bUVz[^iNJom}sdo!"|~sz{hweo뮙uuuH91' Aj F=15n̉mPo:Tp̚9/VkOeG26>t;sVA~Ջ{ڷ^\ _?]x]wѱx~\d^'NGpOE㎎˧ A%n-|q*D#xpX|q(#1074?G%rc'GkƧ%&G\2iB|wD熭Pb~UT@w5W˦z+.9H,A*ފ;59=.|#G_Uw!OЃ|+CsZq͑;;̾;V}[qQ5eԘ Ώ?Y\@ XOzUN!߽4> 2cd/*kxAT'18d:r,[PD1[`H3NrGo<`XuŲw(@x]ns-<`zJe0j__;36u툮m{\@y?" b-qQQJMø>OJgEt\%~U1Y-<=(y@Ųc>tLJ!߽4?eQol2g}.fdIH|wMo 0LbP13N6T̡#Ǣ!`D__Ƌ/|*E}@y@xx sLݟ.^"%/uԵCȣ\6 *|u_}'"A-ChinY3gbn+CE߱g#O?/C V~((KHN};o~X?N>q|S&A?547 O^}}7ힾ#ⷱO?k&A]U岙fCT W?ypБc)yRmvGAlԣT1RБcwtblCT1R辕ʣ\6 y2;7Cjok=)ӹa< e37UJ̃ٸQ#PP.E)kWy iFbbĦB岙fCT91Rŗ^m{ AA-͍1cdCT91R`W*rLܾd!j d8x'M0@  WyfFy`޾S&ئ1b$u]QP.yP?yUCjokuPc]e-͍1k C$5fW*rLܾd!J̃d8x'M0@ByPC֮*rLq!L̃q1Wy iꔉq `bԈ6ʣ\6K7@‰yP9}' AAW]1-61@‰yP\1\6 m{ f͜a"B̃ԵU岙x )bTHRKscL4"A]U岙}C bT3>5M2U!A|iFWyfb5<(CGEo CP)clCbu]QP.ws!8#1hR{[k3:7luGAl&2f<({rLܺ`N<(|>*aΕF`HbB岙XnJ̃ѵm!(1f͜aJ̃[oʣ\6/Y`Ẽ?~21C5s( 1F`SWyfw,6%#0?*!47I @Ɉy0LkoqGAl&n_̳ŁG AASLt@ɉy0 _ZU岙Xx!(91Бcw4u4gzfWyf]\hB̃!ܻUCjok_:CPb sVWyf"3o!(1 عw((ĭ D}}1(1 ϻns(+1`S!rLt,j7e'ڶf0e'7\QP.ۗ,0!iZc "<8[\Q<*M̃9t䘫<4uDWyTzfWyfb<^0]uŴ4T*岙6TGܻUCjokzCPqb׹a< e37T1Tζ=F\6]P5<4k #Xb5cS! m{ f͜aRỊl*rLq!H-1<3M6%Q5֮*rLܾd!H51d8x4uĘwY4Z#i<*bS!rLt,j7Gڶf0G=oʣ\6/Y`81?~2vuZc 3(뷸ʣ Wy0419tX8x4uDWy01Yn< e3t|C<Бcw4u401pPrLܙpb%s~Wy 5 g!Qrʣ\6y  QRٶfcQ<&1G]1Y3gỊd6u(h*>1[*FḤ$V~((KFḤZc (뷸ʣ\6wtl1:t䘫<4uĸhQ(6ʣ\6K7G:r,zNZclC(y}+rGAl&2f΁GQܻ 5 @̣(:7luGAl&C98g7?j e3ѱ=HڶUC5s<ɦB岙fC@yZѵm!(1fLl(1Q[~< e3q"'Ƙ:7luǐn5M2UGA_ZU岙Xx!<Бcw4u4PFbgzfWyf-2x{cHmQ__o(31ܰU岙̛m1Wζ=F\6.**D|>o~UCaΕF 8eS!rLt,j7TGD*# 1f͜a 1Xoʣ\6/Y`01?~2 []1_k!b^Bm!QP.E#%P>m{ f͜a1b^=oʣ\6c!y d147I 5HK뷸ʣ\6/Y`Qb^m{\1Y3gR@̫rvyfΎ )!U_z9147ƌi>B̫b-Wyf% )"U'Ƙm{ f͜aH91 |UÑQe3ѱ$aL>=VX/Af0jժhjj5ƨBbB.ۗ,0c}vcT1F1&O`?.\mmmk*  m'N+VD>7Hy0BSLt@*Z*~~/1*D̃e3t|C}?~|<(31F+ئ1 ꫯx R&b S.m ٷo_455Ŋ+Qb S{[k`ժUQWW۷o7F y0 l&2fb…1~8|1J@̃e3ѱU SL>=r+21aFzG)>cCF{<"`-͍c…΁䲙}C@۷/O+Vyz A-͍1yC@ Z*sM1F@̃3e3e %}ypSLMc epdb󴵞qP٪z*Su+4^)RkߥЉtB&!dfD1cV0dd/0ɽM$>>>zm>|36cuu5v\\\h'#7+rt4#<@x ,C3jZk{<֭[1ݻggg0k>|Ƞpj5v ̃xT*idXӉR~{4D^Z'''Z0k>| f<z4HMȨ5ATx"k-M&I^pߏz7w&kMВ$n[[[\0I4cmm-Wrv;...r.atbyy97y>Z~!q܌o.yp8h W0Bt:Q*{05 (ͨjq||Zyxɓ(J3U0>^GVL#KX__v=yz<Nj5^쾘[ <4MG?<$I(AT*!K>ߍhsEj<og%/M8< ]qxx+++~On`a%I^/Aa jnF*̚y,Vxpk73iZa{  Ӓ$n[㴟-UĹx3i4JE3>  3$pXxqLz1y0W;;;1LŻl4Mw v0SIQ A5 nFЌ+ qV+ϣlh7XRDLiK4ceeE3<.Iz1 yS$`vh4-͘2aSj4ok"iښfܰ<`p-IDuvvvvślF{{{QT4cvJ?}'W$ph.ޜ9f /1yqW""ZVL&h41?4~o.^9f @Dwtt@ :E[L>y煋0 L|10?f@|v]k /\9f ōui]ug@nΕ7l`|?\+o+OvVՃ}UV:Ws-7m+Ov}sVJ!cSY+rfjY9@L5/+g@X@7rDypcXyQ  n<,l&4nȉnb[z,D]z,[X{dIXxs{Zf/s6ٙIENDB`RLumShiny/inst/shiny/fading/www/style.css0000644000176200001440000000242714175060542020212 0ustar liggesusers.custom-modal { padding-left: 10px; padding-top: 10px; padding-bottom: 10px; padding-right: 10px; line-height: 200%; background-color: #fff; overflow: visible; position: absolute; z-index: 999; border-radius: 10px; border-style: solid; border-color: #428bca; } .h { font-size: 11px; margin: 0 0 0px; } h5, h6 { color: #428bca; } .tooltip-inner { max-width: 450px; } .control-label, .selectize-dropdown, .item, .btn, .uneditable-input, .sorting, .odd, .even, .dataTables-info, .fa, .fa-refresh { font-size: 12px; } .selectize-input { padding: 0px 10px; min-height: 20px; } label, body, input { font-size: 12px; } .label, .badge { font-size: 12px; padding: 4px 20px; margin: 10px; line-height: 18px; } .label-info, .badge-info { background-color: #428bca; } input[type="text"],input[type="number"],input[type="email"],input[type="url"],input[type="search"],input[type="tel"],input[type="color"],.uneditable-input{ display:inline-block; height:18px; padding:0px 0px 0px 7px; margin-bottom:10px; font-size: 11px; line-height: 1.5; color:#555; vertical-align:middle; -webkit-border-radius:4px; -moz-border-radius:4px; border-radius:4px } input,textarea,.uneditable-input{ width: auto; } RLumShiny/inst/shiny/fading/www/GitHub-Mark-32px.png0000644000176200001440000000326214175060542021710 0ustar liggesusersPNG  IHDR szztEXtSoftwareAdobe ImageReadyqe<$iTXtXML:com.adobe.xmp $IDATxėmhayL30A+R#f>IHکy(M)_o5 0+0Ėl&o{i^]u<{Yws}=uC>$L, }<w}8^ AO?p! xaяPKI3`'B>0QT1<+`}^nvkp^ƅF|1"Gp.*oO׀Vp ]߅jc8K$q 8jV`#`vmpGѢu!#}#:U_?_yhE $=;c*xNOo+&w)%K-R%6n'o">j/t³qoGW7j%2q GX?woibCÐAzbǰt \14|S.DZ]# b|H$(ʕohmqͱRP셣$,0Z20 tNvRW3K8Xk2 IO6 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 rHandsontableOutput(outputId = "table_in_primary"), hr(), helpText(HTML(paste( tags$b("PLEASE NOTE:"), "Estimation of the g-value and correcting for fading using the approach after Huntley & Lamothe (2001) is computationally expensive, which is why the number of Monte Carlo simulations is fixed to 100 and 1000, respectively. Consider running the code given in the R code panels with a higher number of MC iterations in a local R environment." ))) ),##EndOf::Tab_1 # Tab 2: Fading correction tabPanel("Age correction", div(align = "center", h5("Fading correction after Huntley & Lamothe (2001)")), hr(), fluidRow( column(width = 6, numericInput(inputId = "age_faded", HTML("Age (ka)", "(faded)"), min = 0, step = 1, value = 10)), column(width = 6, numericInput(inputId = "age_error_faded", "Age error", min = 0, step = 1, value = 1)) ), checkboxInput(inputId = "override_gval", "Manual g-value", FALSE), conditionalPanel("input.override_gval == true", fluidRow( column(width = 6, numericInput(inputId = "g_value", "g-value (%/decade)", min = 0, step = 0.01, value = 5.18)), column(width = 6, numericInput(inputId = "g_value_error", "g-value error", min = 0, step = 0.01, value = 0.75)) ), helpText(HTML( "Tc = time in seconds between irradiation and the prompt measurement (cf. Huntley & Lamothe 2001).

", "Tc, g-value = the time in seconds between irradiation and the prompt measurement used for estimating the g-value. If the g-value was normalised to, e.g., 2 days, this time in seconds (i.e., 172800) should be given here. This time should be identical to tc, which is usually case for g-values obtained using the SAR method and g-values that had been not normalised to 2 days.")), fluidRow( column(width = 6, numericInput(inputId = "tc", HTML("Tc"), min = 0, step = 1, value = 378)), column(width = 6, numericInput(inputId = "tc_gval", HTML("Tc, g-value"), min = 0, step = 1, value = 172800)) ) ) ), # Tab 4: modify axis parameters RLumShiny:::exportTab("export", filename = "analyseFading"), RLumShiny:::aboutTab("about", "fading") )##EndOf::tabsetPanel ),##EndOf::sidebarPanel # 3 - output panel mainPanel(width = 7, # insert css code inside 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 = "450px"), fluidRow( column(6, htmlOutput(outputId = "results")), column(6, htmlOutput(outputId = "results_corr")) )), tabPanel("R code (g-value)", verbatimTextOutput("plotCode")), tabPanel("R code (age correction)", verbatimTextOutput("corrCode")) )###EndOf::tabsetPanel )##EndOf::mainPanel ),##EndOf::sideBarLayout bookmarkButton() )##EndOf::fluidPage }RLumShiny/inst/shiny/teststimulationpower/0000755000176200001440000000000014175252574020614 5ustar liggesusersRLumShiny/inst/shiny/teststimulationpower/global.R0000644000176200001440000000125114175060542022166 0ustar liggesusers## +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ## Title: Test Stimulation Power App ## Authors: Sebastian Kreutzer, IRAMAT-CRP2A, Universite Bordeaux Montaigne (France) ## Contact: sebastian.kreutzer@u-bordeaux-montainge.fr ## Date: 2017-11-22 ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ##load needed packages library(shiny) library(Luminescence) library(DT) library(knitr) ##Shiny settings options(shiny.maxRequestSize=100*1024^2) enableBookmarking(store = "server") ##initialise data file_data <- NULL file_info <- NULL xrange <- c(0,0) yrange <- c(0,0) RLumShiny/inst/shiny/teststimulationpower/server.R0000644000176200001440000002064614175060542022245 0ustar liggesusers## +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ## Title: Test Stimulation Power App ## Authors: Sebastian Kreutzer, IRAMAT-CRP2A, Universite Bordeaux Montaigne (France) ## Contact: sebastian.kreutzer@u-bordeaux-montainge.fr ## Initial date: 2017-11-22 ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ shinyServer(function(input, output, session) { # TABPANEL Import ---------------------------------------------------------------------------- ##reset observeEvent(input$ClearButton, { file_data <- NULL file_info <- NULL ##clear plot and text output$curves <- renderPlot({NULL}) output$text <- renderText({NULL}) output$df <- renderDataTable(NULL) updateRadioButtons(session, inputId = "SelectedCurves", choices = "none") }) ##import data observeEvent(input$file_data, { ##data import file_data <<- read_XSYG2R( file = as.list(input$file_data$datapath), fastForward = TRUE, verbose = FALSE ) ##import info file_info <<- read_XSYG2R( file = as.list(input$file_data$datapath), fastForward = TRUE, verbose = FALSE, import = FALSE ) ##update radio buttons with the curve types display_curves <- unique(unlist(lapply(file_data, names))) display_curves <- display_curves[grepl(x = display_curves, pattern = "SL (NA)", fixed = TRUE)] ##update ratio buttons updateRadioButtons(session, inputId = "SelectedCurves", choices = display_curves, selected = display_curves[1] ) ##grep wanted curves curves <- get_RLum(file_data, recordType = display_curves[1], curveType = "measured", drop = FALSE) ##sort out all heating curves curves <- lapply(curves, function(c){ if(length(c@records) == 0) return(NULL) records <- lapply(c@records, function(r){ if(r@info$stimulator == "heating element"){ return(NULL) }else{ r } }) ##remove NULL data records <- records[!sapply(records, is.null)] ##construct new RLum.Analysis object set_RLum(class = "RLum.Analysis", records = records) }) ##remove NULL from list curves_rm <- !sapply(curves, is.null) file_info <- file_info[curves_rm,] curves <- curves[curves_rm] ##get structure and set slider xrange <- range(structure_RLum(merge_RLum(curves))[,c("x.min", "x.max")]) yrange <- range(structure_RLum(merge_RLum(curves))[,c("y.min", "y.max")]) updateSliderInput(session, inputId = "xrange", value = xrange, min = min(xrange), max = max(xrange)) updateSliderInput(session, inputId = "yrange", value = yrange, min = min(yrange), max = max(yrange)) ##create plot output$curves <- renderPlot({ records <- Luminescence:::.unlist_RLum(get_RLum(curves)) plot_RLum( set_RLum("RLum.Analysis", records = records), xlab = "Stimulation time [s]", ylab = "Stimulation power [mW/cm^2]", xlim = input$xrange, ylim = input$yrange, log = paste0(input$xaxislog, input$yaxislog), main = "Control Plot", legend = FALSE, col = rgb(0,0,0,.8), mtext = paste(length(records), "curves are displayed"), combine = TRUE) }) ##create table with affected values df <- as.data.frame(t(vapply(1:length(curves), function(x){ y_values <- structure_RLum(curves[[x]])[["y.max"]] pos <- curves[[x]]@records[[1]]@info[["position"]] test <- which(y_values < max(y_values) * 0.95) if(length(test) == 0){ return(c(NA_character_,NA_character_,NA_character_, NA_character_)) }else{ return(c("",x,pos,paste(test, collapse = ","))) } }, character(4)))) ##remove NA df[,1] <- file_info$name df <- na.exclude(df) if(nrow(df) > 0){ colnames(df) <- c("FILE","ALQ", "POSITION", "ID AFFECTED CURVE(S)") rownames(df) <- NULL output$df <- renderDataTable(df) output$text <- renderText({"Stimulation power mismatch detected!"}) }else{ output$text <- renderText({"Everything looks OK"}) } }) ##modify curves observeEvent(input$Display, { if(input$SelectedCurves != "none"){ ##grep wanted curves curves <- get_RLum(file_data, recordType = input$SelectedCurves, curveType = "measured", drop = FALSE) ##sort out all heating curves curves <- lapply(curves, function(c){ if(length(c@records) == 0) return(NULL) records <- lapply(c@records, function(r){ if(r@info$stimulator == "heating element"){ return(NULL) }else{ r } }) ##remove NULL data records <- records[!sapply(records, is.null)] ##construct new RLum.Analysis object set_RLum(class = "RLum.Analysis", records = records) }) ##remove NULL from list curves_rm <- !sapply(curves, is.null) file_info <- file_info[curves_rm,] curves <- curves[curves_rm] ##update slider xrange <- range(structure_RLum(merge_RLum(curves))[,c("x.min", "x.max")]) yrange <- range(structure_RLum(merge_RLum(curves))[,c("y.min", "y.max")]) updateSliderInput(session, inputId = "xrange", value = xrange, min = min(xrange), max = max(xrange)) updateSliderInput(session, inputId = "yrange", value = yrange, min = min(yrange), max = max(yrange)) ##create plot output$curves <- renderPlot({ records <- Luminescence:::.unlist_RLum(get_RLum(curves)) plot_RLum( set_RLum("RLum.Analysis", records = records), xlab = "Stimulation time [s]", ylab = "Stimulation power [mW/cm^2]", main = "Control Plot", xlim = input$xrange, ylim = input$yrange, log = paste0(input$xaxislog, input$yaxislog), legend = FALSE, col = rgb(0,0,0,.8), mtext = paste(length(records), "curves are displayed"), combine = TRUE) }) ##create table with affected values df <- as.data.frame(t(vapply(1:length(curves), function(x){ y_values <- structure_RLum(curves[[x]])[["y.max"]] test <- which(y_values < max(y_values) * 0.95) if(length(test) == 0){ return(c(NA_character_,NA_character_,NA_character_)) }else{ return(c("",x,paste(test, collapse = ","))) } }, character(3)))) ##remove NA df[,1] <- file_info$name df <- na.exclude(df) if(nrow(df) > 0){ colnames(df) <- c("FILE","ALQ", "ID AFFECTED CURVE(S)") rownames(df) <- NULL output$df <- renderDataTable(df) output$text <- renderText({"Stimulation power mismatch detected!"}) }else{ output$text <- renderText({"Everything looks OK"}) } } }) # Static pages -------------------------------------------------------------------------------- output$about <- renderUI({ HTML(markdown::markdownToHTML(knit('static/about.Rmd', quiet = TRUE, output = tempfile()), fragment.only = TRUE)) }) }) RLumShiny/inst/shiny/teststimulationpower/ui.R0000644000176200001440000000627114175060542021352 0ustar liggesusers## +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ## Title: Test Stimulation Power App ## Authors: Sebastian Kreutzer, IRAMAT-CRP2A, Universite Bordeaux Montaigne (France) ## Contact: sebastian.kreutzer@u-bordeaux-montainge.fr ## Initial date: 2017-11-22 ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ fluidPage( tags$head(tags$style(".centerAlign{text-align: center;}")), tags$head( tags$style(HTML('#Display{background-color:lightgreen}')) ), titlePanel("Test Stimulation Power"), sidebarLayout( sidebarPanel( # PANEL File input ---------------------------------------------------------------------------- tabsetPanel( tabPanel("File input", icon = icon("upload", lib = "glyphicon"), br(), fileInput("file_data", accept = "*.xsyg", label = "Select XSYG-files containing your measurement data...", multiple = TRUE), radioButtons("SelectedCurves", "Stimulation curves to display ...", "none"), div( actionButton(inputId = "Display", "Update curves!", col = "green", icon = icon("fas fa-sync")), actionButton(inputId = "ClearButton", "Reset!") , align = "center") ), # PANEL Modify plot --------------------------------------------------------------------------- tabPanel("Modify plot", icon = icon("equalizer", lib = "glyphicon"), h4("x-axis"), sliderInput("xrange", "", value = c(0,0), min = min(xrange), max = max(xrange)), div( radioButtons("xaxislog", label = "", selected = "", inline = TRUE, choiceNames = c("linear", "log"), choiceValues = c("", "x")), align = "center" ), hr(), h4("y-axis"), sliderInput("yrange", "", value = c(0,0), min = min(yrange), max = max(yrange)), div( radioButtons("yaxislog", label = "", selected = "", inline = TRUE, choiceNames = c("linear", "log"), choiceValues = c("", "y")), align = "center" ) ),id = "InputPanel", # PANEL About --------------------------------------------------------------------------------- tabPanel("About", icon = icon("info-sign", lib = "glyphicon"), uiOutput('about'), id = "AboutPanel") ), #end tabsetPanel br(), fluidRow( column(width = 12, wellPanel( h4( textOutput("text") ), class = 'centerAlign'))), tags$hr(style="border-color: darkred;"), p(HTML("This software comes WITHOUT ANY WARRANTY."), align = "center") ), # MAINPANEL ----------------------------------------------------------------------------------- mainPanel( plotOutput("curves"), DT::dataTableOutput("df") ) )##sidebarLayout )##fluidPage RLumShiny/inst/shiny/fastratio/0000755000176200001440000000000014175060542016253 5ustar liggesusersRLumShiny/inst/shiny/fastratio/UI.R0000644000176200001440000004360214175060542016720 0ustar liggesusers## UI.R function(request) { fluidPage( titlePanel(NULL, windowTitle = "RLumShiny - Fast Ratio"), 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", div(align = "center", h5("Input data preprocessing")), sliderInput(inputId = "deadchannels", "Dead channels", value = c(1, 1000), min = 1, max = 1000, step = 1, dragRange = TRUE), div(align = "center", h5("Simulation source")), # Stimulation power and wavelength fluidRow( column(width = 6, numericInput(inputId = "stimpow", label = "Irradiance (W/cm^2)", value = 30.6, min = 0.1, step = 0.1) ), column(width = 6, numericInput(inputId = "wavelength", label = "Wavelength (nm)", value = 470, min = 1, step = 1) ) ), div(align = "center", h5("Photoionisation cross-sections (cm^2)")), # Photoionisation cross-sections fluidRow( column(width = 6, HTML("Fast component"), fluidRow( column(width = 6, numericInput(inputId = "cs1base", label = "Base value", value = 2.60, min = 0.01, step = 0.1) ), column(width = 6, numericInput(inputId = "cs1exp", label = "Exponent", value = 17, min = 1, step = 1) ) ) ), column(width = 6, HTML("Medium component"), fluidRow( column(width = 6, numericInput(inputId = "cs2base", label = "Base value", value = 4.28, min = 0.01, step = 0.01) ), column(width = 6, numericInput(inputId = "cs2exp", label = "Exponent", value = 18, min = 1, step = 1) ) ) ) ), div(align = "center", h5("Channels")), # L1 checkboxInput(inputId = "overrideL1", "Override channel for L1", value = FALSE), conditionalPanel("input.overrideL1 == true", # TODO: call updateSlider in Server.R to update max range sliderInput(inputId = "L1", "Channel L1", value = 1, min = 1, max = 1000, step = 1)), # L2 checkboxInput(inputId = "overrideL2", "Override channel for L2", value = FALSE), conditionalPanel("input.overrideL2 == true", # TODO: call updateSlider in Server.R to update max range sliderInput(inputId = "L2", "Channel L2", value = 50, min = 1, max = 1000, step = 1)), # L3 checkboxInput(inputId = "overrideL3", "Override channels for L3", value = FALSE), conditionalPanel("input.overrideL3 == true", # TODO: call updateSlider in Server.R to update max range sliderInput(inputId = "L3", "Channel L3", value = c(400, 600), min = 1, max = 1000, step = 1, dragRange = TRUE)), div(align = "center", h5("% of signal remaining")), fluidRow( column(width = 6, numericInput(inputId = "x", label = "...from the fast component", value = 1, min = 0.1, max = 100, step = 0.1) ), column(width = 6, numericInput(inputId = "x1", label = "...from the medium component", value = 0.1, min = 0.1, max = 100, step = 0.1) ) ) ), tabPanel("Experimental", div(align = "center", h5("Curve fitting")), checkboxInput(inputId = "fitCWsigma", label = "Calculate and use photoionisaton cross-sections", value = FALSE), checkboxInput(inputId = "fitCWcurve", label = "Derive fast ratio from fitted OSL curve", value = FALSE) ), tabPanel("Plot", div(align = "center", h5("Title")), textInput(inputId = "main", label = "Title", value = "Fast Ratio"), radioButtons("type", "Type", selected = "b", inline = TRUE, choices = c("Line" = "l", "Points" = "p", "Line+Points" = "b")), fluidRow( column(width = 6, selectInput(inputId = "pch", label = "Style", selected = "1", 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
"), 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 = FALSE), 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 = "Signal (cts)") ),##EndOf::Tab_4 RLumShiny:::exportTab("export", filename = "fast ratio"), RLumShiny:::aboutTab("about", "fastratio") )##EndOf::tabsetPanel ),##EndOf::sidebarPanel # 3 - output panel mainPanel(width = 7, # insert css code inside 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 fluidRow( tabsetPanel( tabPanel("Results", plotOutput(outputId = "main_plot", height = "500px"), htmlOutput(outputId = "results") ), tabPanel("R code", verbatimTextOutput("plotCode")) ) ) )##EndOf::mainPanel ),##EndOf::sideBarLayout bookmarkButton() )##EndOf::fluidPage }RLumShiny/inst/shiny/fastratio/Server.R0000644000176200001440000001336614175060542017655 0ustar liggesusers## Server.R ## MAIN FUNCTION function(input, output, session) { # input data (with default) values <- reactiveValues(data_primary = if ("startData" %in% names(.GlobalEnv)) startData else ExampleData.CW_OSL_Curve, args = NULL, results = NULL) session$onSessionEnded(function() { stopApp() }) # check and read in file (DATA SET 1) observeEvent(input$file, { inFile<- input$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 updateSliderInput(session, "deadchannels", value = c(1, nrow(values$data_primary)), max = nrow(values$data_primary)) }) output$table_in_primary <- renderRHandsontable({ rhandsontable(values$data_primary, height = 300, colHeaders = c("Time", "Signal"), rowHeaders = NULL) }) observeEvent(input$fitCWsigma, { # restore default values (Durcan and Duller, 2011) Map(function(id, val) { updateNumericInput(session, id, value = val) }, c("cs1base", "cs1exp", "cs2base", "cs2exp"), c(2.60, 17, 4.28, 18)) }) 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_primary <- hot_to_r(df_tmp) }) observeEvent(input$overrideL1, { updateSliderInput(session, "L1", max = nrow(values$data_primary)) }) observeEvent(input$overrideL2, { updateSliderInput(session, "L2", max = nrow(values$data_primary)) }) observeEvent(input$overrideL1, { updateSliderInput(session, "L3", max = nrow(values$data_primary)) }) observe({ values$args <- list( # calc_FastRatio arguments object = values$data_primary[input$deadchannels[1]:input$deadchannels[2], ], stimulation.power = input$stimpow, wavelength = input$wavelength, sigmaF = input$cs1base * 10^-input$cs1exp, sigmaM = input$cs2base * 10^-input$cs2exp, Ch_L1 = ifelse(input$overrideL1, input$L1, 1), x = input$x, x2 = input$x1, fitCW.sigma = input$fitCWsigma, fitCW.curve = input$fitCWcurve, verbose = FALSE, # generic plot arguments main = input$main, type = input$type, pch = ifelse(input$pch == "custom", input$custompch, as.numeric(input$pch)), col = ifelse(input$color == "custom", input$jscol1, input$color), cex = input$cex, xlab = input$xlab, ylab = input$ylab, log = paste0("", ifelse(input$logx, "x", ""), ifelse(input$logy, "y", "")) ) if (input$overrideL2) values$args <- modifyList(isolate(values$args), list(Ch_L2 = input$L2)) if (input$overrideL3) values$args <- modifyList(isolate(values$args), list(Ch_L3 = range(as.numeric(input$L3)))) }) output$main_plot <- renderPlot({ values$results <- do.call(calc_FastRatio, values$args) }) # update numeric input with photoionisation cross-sections calculated # by fit_CWCurve() observeEvent(values$results, { if (input$fitCWsigma) { updateNumericInput(session, "cs1base", value = as.numeric(strsplit(as.character(values$results@data$summary$sigmaF), "e-")[[1]][1])) updateNumericInput(session, "cs1exp", value = as.numeric(strsplit(as.character(values$results@data$summary$sigmaF), "e-")[[1]][2])) updateNumericInput(session, "cs2base", value = as.numeric(strsplit(as.character(values$results@data$summary$sigmaM), "e-")[[1]][1])) updateNumericInput(session, "cs2exp", value = as.numeric(strsplit(as.character(values$results@data$summary$sigmaM), "e-")[[1]][2])) } }) # Render numeric results in a data table output$results <- renderUI({ res <- get_RLum(values$results) HTML(paste0( tags$b("Fast ratio: "), signif(res$fast.ratio, 2), " ± ", signif(res$fast.ratio.se, 2), tags$i("(", signif(res$fast.ratio.rse, 2), "% rel. error)"), tags$br(), tags$br(), tags$b(" Time (s) | Channel | Counts:"), tags$br(), tags$b("L1: "), signif(res$t_L1, 2), " / ", res$Ch_L1, " / ", signif(res$Cts_L1, 2), tags$br(), tags$b("L2: "), signif(res$t_L2, 2), " / ", res$Ch_L2, " / ", signif(res$Cts_L2, 2), tags$br(), tags$b("L3 start: "), signif(res$t_L3_start, 2), " / ", res$Ch_L3_start, " /", tags$br(), tags$b("L3 end: "), signif(res$t_L3_end, 2), " / ", res$Ch_L3_end, " / ", signif(res$Cts_L3, 2) )) }) observe({ # nested renderText({}) for code output on "R plot code" tab code.output <- callModule(RLumShiny:::printCode, "printCode", n_input = 1, fun = "calc_FastRatio(data,", args = values$args) output$plotCode<- renderText({ code.output })##EndOf::renderText({}) callModule(RLumShiny:::exportCodeHandler, "export", code = code.output) callModule(RLumShiny:::exportPlotHandler, "export", fun = "calc_FastRatio", args = values$args) }) }##EndOf::function(input, output)RLumShiny/inst/shiny/fastratio/Global.R0000644000176200001440000000033014175060542017572 0ustar liggesusers## global.R ## library(Luminescence) library(RLumShiny) library(shiny) library(data.table) library(rhandsontable) data("ExampleData.CW_OSL_Curve", envir = environment()) enableBookmarking(store = "server")RLumShiny/inst/shiny/fastratio/www/0000755000176200001440000000000014175060542017077 5ustar liggesusersRLumShiny/inst/shiny/fastratio/www/RL_Logo.png0000644000176200001440000007222114175060542021106 0ustar liggesusersPNG  IHDR pHYs.#.#x?v OiCCPPhotoshop ICC profilexڝSgTS=BKKoR RB&*! J!QEEȠQ, !{kּ> H3Q5 B.@ $pd!s#~<<+"x M0B\t8K@zB@F&S`cbP-`'{[! eDh;VEX0fK9-0IWfH  0Q){`##xFW<+*x<$9E[-qWW.(I+6aa@.y24x6_-"bbϫp@t~,/;m%h^ uf@Wp~<5j>{-]cK'Xto(hw?G%fIq^D$.Tʳ?D*A, `6B$BB dr`)B(Ͱ*`/@4Qhp.U=pa( Aa!ڈbX#!H$ ɈQ"K5H1RT UH=r9\F;2G1Q= C7F dt1r=6Ыhڏ>C03l0.B8, c˱" VcϱwE 6wB aAHXLXNH $4 7 Q'"K&b21XH,#/{C7$C2'ITFnR#,4H#dk9, +ȅ3![ b@qS(RjJ4e2AURݨT5ZBRQ4u9̓IKhhitݕNWGw Ljg(gwLӋT071oUX**| J&*/Tު UUT^S}FU3S ԖUPSSg;goT?~YYLOCQ_ cx,!k u5&|v*=9C3J3WRf?qtN (~))4L1e\kXHQG6EYAJ'\'GgSSݧ M=:.kDwn^Loy}/TmG X $ <5qo</QC]@Caaᄑ.ȽJtq]zۯ6iܟ4)Y3sCQ? 0k߬~OCOg#/c/Wװwa>>r><72Y_7ȷOo_C#dz%gA[z|!?:eAAA!h쐭!ΑiP~aa~ 'W?pX15wCsDDDޛg1O9-J5*>.j<74?.fYXXIlK9.*6nl {/]py.,:@LN8A*%w% yg"/6шC\*NH*Mz쑼5y$3,幄'L Lݛ:v m2=:1qB!Mggfvˬen/kY- BTZ(*geWf͉9+̳ې7ᒶKW-X潬j9(xoʿܔĹdff-[n ڴ VE/(ۻCɾUUMfeI?m]Nmq#׹=TR+Gw- 6 U#pDy  :v{vg/jBFS[b[O>zG499?rCd&ˮ/~јѡ򗓿m|x31^VwwO| (hSЧc3-gAMA|Q cHRMz%u0`:o_FiIDATx}td%! )+7ږJ["\wKIQl7YWtFuftZǙ]=8n-Ot) q\p7ab SZMM@z K[yӧO?_7n\ pw~ \i$eo .<_: @IpB^D=c,JN+߻jժ8|()ٞ /MMM#g̙d\]w5f߾}}vP2.^zTq㢯ψ˼W馛FGN#P.NȦG"suhll4(E%>F]]Q~o=6mdPcbŊZ|ب˼xaPl."o,۷o7.E˼۷… K;|XRJw}~(T_u^^矏F?mƼ|>{WkΜ9 sl瞲^O$y1qIJƍ>?qZ*/,YR߳?8F-uy۷o VOF8GrWXQIU\VZ~OVײo߾ؾ}>F$yӧW4nܸ2oΜ9U5GN? [/o .گ矏F?Uc^]]]U}G9{`]vEL:)de1!Ҭ!UVǴi?Y>K苧鍈m{N}?SJ_m[2#@%6 qw;4T>u>o_ODPVbcލ7X3_}b5502|eXV"c?9E__H6;OYO?{P+z{{cժU̙30Q>= v@$&-Y$1ߔؾ}{x~BA"1oo߾D}c.\~B^GeqHDļ\.oΊ+S Z~OϸRc^O7gժU>p۾/zNDx0c^>^oЍ7~RDz_ž>`j:s=۷/={VSOHl;|pZ*ߤn)5ɿ "٘w;=c?:tƇO,P^|@ }XpaYO-P5<6 KKf"žhf5Yr\*YsO<~j~VTHż/SZjUٟY o Mg߁}wBy/B{ｩ-Y$%Oxt T̻뮻R ۷o_l߾=nF?@Ѹ 5>ߑ"~. 1ZJjb^.(+V<`('o<{<J*b^(UV?hll4P>ܰ5"ؾϣ1H o։y@<<BБczf@by@ܻ?:7l@y@"?H41i|>6u툮m{<Oj@y@MH31 O["%UMC%U%ǃ_vU<*xT'q"νsֈ!F@G=O5#B;tX^9zNxp~۱G"Z(1( /s̳ŗlr (1|>+ /2xPb0lV>>*Aŗ^U_Gj<`H!gZ>b R KNζ=GE<Rb<\|i;!@ sŮj)5 j)PqEsܰUÑ" <(5m <8G\}'<<8/r7e!(yc-Pnb¡#⾕ y@Yy0B; [<3 T<5m]=BP1b Tmq)7^\|QL0..ln_a$H01Bo1S.yCןuuugZ 'A\}'<EګrlH71`0=?0pN^.0 "57b4B0g qascwZHpw)154qG y._y\Eb%Amk5Gfx, <1T NwY q'A x%OƧ%p[hO|o<(m[ ̾WJ7?54raA8Ẹ:r,qGmkR $QU|ܷ!!Txڣ $QU> yHyT޾ D<FḲ*<@\yT#D<Ẹ|NI%Plbm{|N35.>%raA(1y͏#1D<JṂ"Kk6 y$ָܶh\s|%1Id<*scCP涵FD_{A(91;tX15mK(|>|ԬrP @ىyʯ|Cȣ& ~.GOo*Ḅl~d8xԜm+/f *J̣,|Zj-]:7luGUp@y̓_G ^}}q Q 6WyEQWWg81asGmk2scc*8< Z yP<s25^+E23-yP|bcWw!5!JC5a>Wy#o~% ;7"@y¦o#!qJw#q[\1"sZ!D#""|8x ָܶ+cc@yDD} <m|!//涵nH1/|^^]FFH!Wy\b^8x)*IK_z)*MK'z/RU$PORU$P]!e涵u4$@FH2s`b^?KmNK'2O\p! ļ'"sZchļz$#@ y w)[b^y#ܶhb^>wܛlSq^|)"%sM;:n20ORbn[k̼l! Eļ&|30dfH1/A6=7BJ<H/1/A~p>/MK˼47RLKggxӔ)&Abb^Be^*44RLK5B]>} <ozF\=-Fk#$ <d yP涵F}@کP#)'@ !ᮻ #b^R'O!ZyP+<\|1j yP+<b1j5B!@FyP#<bԀ_7KK9W_ayNbԘ=RHK7Mhرq#@ y R__fN7D WK/RFK:# )#%̕o))#%7]b-0s)Q[H1/a]8)Q[H1/a6])_RBK#ؾm{;RBK٭o1Ba#@ y tٛh! ļ4q`a@:y 42{b~pb^BaFH>t1$P_sRfwwOt}o! ļsF۱u$Po2K0Ru$P FH)y\b^]KB ļ[0wRu$`3/sRu$`Z!\@y !\@y w˂9FHOtl۱Pļ-'63T11/CJD5گ1[({ >7Q-<(xԖsBOb^[!8'AϿ0#R{{;ޮg[?1`<:b/ z0 bg:b z{1`" c\aޥqQA zg;c ΣTvw?x`7Bc|v'/^z PǰΣԺ+>yߚ/g 1"(=Wޛn f[1\1b\Qr//|-e0#{ ( _*>TsǨym۱|m)c?01[[[o!(nz>RvwCϟ#G5 QT3N2 W߉P<06{bՃ#>J&Qt !QuXcjGI_UaYz~z od>}'?yTx\pQzb%3eldo!"BУ*=ӧܒqKfQjb%' AU۱:@U({/-Uo0WqWYuuuy%&xܖ1?wĕO3 UC̣,l<*b-7=?4-#%Qu|~i#0\bUVz[^iNJom}sdo!"|~sz{hweo뮙uuuH91' Aj F=15n̉mPo:Tp̚9/VkOeG26>t;sVA~Ջ{ڷ^\ _?]x]wѱx~\d^'NGpOE㎎˧ A%n-|q*D#xpX|q(#1074?G%rc'GkƧ%&G\2iB|wD熭Pb~UT@w5W˦z+.9H,A*ފ;59=.|#G_Uw!OЃ|+CsZq͑;;̾;V}[qQ5eԘ Ώ?Y\@ XOzUN!߽4> 2cd/*kxAT'18d:r,[PD1[`H3NrGo<`XuŲw(@x]ns-<`zJe0j__;36u툮m{\@y?" b-qQQJMø>OJgEt\%~U1Y-<=(y@Ųc>tLJ!߽4?eQol2g}.fdIH|wMo 0LbP13N6T̡#Ǣ!`D__Ƌ/|*E}@y@xx sLݟ.^"%/uԵCȣ\6 *|u_}'"A-ChinY3gbn+CE߱g#O?/C V~((KHN};o~X?N>q|S&A?547 O^}}7ힾ#ⷱO?k&A]U岙fCT W?ypБc)yRmvGAlԣT1RБcwtblCT1R辕ʣ\6 y2;7Cjok=)ӹa< e37UJ̃ٸQ#PP.E)kWy iFbbĦB岙fCT91Rŗ^m{ AA-͍1cdCT91R`W*rLܾd!j d8x'M0@  WyfFy`޾S&ئ1b$u]QP.yP?yUCjokuPc]e-͍1k C$5fW*rLܾd!J̃d8x'M0@ByPC֮*rLq!L̃q1Wy iꔉq `bԈ6ʣ\6K7@‰yP9}' AAW]1-61@‰yP\1\6 m{ f͜a"B̃ԵU岙x )bTHRKscL4"A]U岙}C bT3>5M2U!A|iFWyfb5<(CGEo CP)clCbu]QP.ws!8#1hR{[k3:7luGAl&2f<({rLܺ`N<(|>*aΕF`HbB岙XnJ̃ѵm!(1f͜aJ̃[oʣ\6/Y`Ẽ?~21C5s( 1F`SWyfw,6%#0?*!47I @Ɉy0LkoqGAl&n_̳ŁG AASLt@ɉy0 _ZU岙Xx!(91Бcw4u4gzfWyf]\hB̃!ܻUCjok_:CPb sVWyf"3o!(1 عw((ĭ D}}1(1 ϻns(+1`S!rLt,j7e'ڶf0e'7\QP.ۗ,0!iZc "<8[\Q<*M̃9t䘫<4uDWyTzfWyfb<^0]uŴ4T*岙6TGܻUCjokzCPqb׹a< e37T1Tζ=F\6]P5<4k #Xb5cS! m{ f͜aRỊl*rLq!H-1<3M6%Q5֮*rLܾd!H51d8x4uĘwY4Z#i<*bS!rLt,j7Gڶf0G=oʣ\6/Y`81?~2vuZc 3(뷸ʣ Wy0419tX8x4uDWy01Yn< e3t|C<Бcw4u401pPrLܙpb%s~Wy 5 g!Qrʣ\6y  QRٶfcQ<&1G]1Y3gỊd6u(h*>1[*FḤ$V~((KFḤZc (뷸ʣ\6wtl1:t䘫<4uĸhQ(6ʣ\6K7G:r,zNZclC(y}+rGAl&2f΁GQܻ 5 @̣(:7luGAl&C98g7?j e3ѱ=HڶUC5s<ɦB岙fC@yZѵm!(1fLl(1Q[~< e3q"'Ƙ:7luǐn5M2UGA_ZU岙Xx!<Бcw4u4PFbgzfWyf-2x{cHmQ__o(31ܰU岙̛m1Wζ=F\6.**D|>o~UCaΕF 8eS!rLt,j7TGD*# 1f͜a 1Xoʣ\6/Y`01?~2 []1_k!b^Bm!QP.E#%P>m{ f͜a1b^=oʣ\6c!y d147I 5HK뷸ʣ\6/Y`Qb^m{\1Y3gR@̫rvyfΎ )!U_z9147ƌi>B̫b-Wyf% )"U'Ƙm{ f͜aH91 |UÑQe3ѱ$aL>=VX/Af0jժhjj5ƨBbB.ۗ,0c}vcT1F1&O`?.\mmmk*  m'N+VD>7Hy0BSLt@*Z*~~/1*D̃e3t|C}?~|<(31F+ئ1 ꫯx R&b S.m ٷo_455Ŋ+Qb S{[k`ժUQWW۷o7F y0 l&2fb…1~8|1J@̃e3ѱU SL>=r+21aFzG)>cCF{<"`-͍c…΁䲙}C@۷/O+Vyz A-͍1yC@ Z*sM1F@̃3e3e %}ypSLMc epdb󴵞qP٪z*Su+4^)RkߥЉtB&!dfD1cV0dd/0ɽM$>>>zm>|36cuu5v\\\h'#7+rt4#<@x ,C3jZk{<֭[1ݻggg0k>|Ƞpj5v ̃xT*idXӉR~{4D^Z'''Z0k>| f<z4HMȨ5ATx"k-M&I^pߏz7w&kMВ$n[[[\0I4cmm-Wrv;...r.atbyy97y>Z~!q܌o.yp8h W0Bt:Q*{05 (ͨjq||Zyxɓ(J3U0>^GVL#KX__v=yz<Nj5^쾘[ <4MG?<$I(AT*!K>ߍhsEj<og%/M8< ]qxx+++~On`a%I^/Aa jnF*̚y,Vxpk73iZa{  Ӓ$n[㴟-UĹx3i4JE3>  3$pXxqLz1y0W;;;1LŻl4Mw v0SIQ A5 nFЌ+ qV+ϣlh7XRDLiK4ceeE3<.Iz1 yS$`vh4-͘2aSj4ok"iښfܰ<`p-IDuvvvvślF{{{QT4cvJ?}'W$ph.ޜ9f /1yqW""ZVL&h41?4~o.^9f @Dwtt@ :E[L>y煋0 L|10?f@|v]k /\9f ōui]ug@nΕ7l`|?\+o+OvVՃ}UV:Ws-7m+Ov}sVJ!cSY+rfjY9@L5/+g@X@7rDypcXyQ  n<,l&4nȉnb[z,D]z,[X{dIXxs{Zf/s6ٙIENDB`RLumShiny/inst/shiny/fastratio/www/style.css0000644000176200001440000000242714175060542020756 0ustar liggesusers.custom-modal { padding-left: 10px; padding-top: 10px; padding-bottom: 10px; padding-right: 10px; line-height: 200%; background-color: #fff; overflow: visible; position: absolute; z-index: 999; border-radius: 10px; border-style: solid; border-color: #428bca; } .h { font-size: 11px; margin: 0 0 0px; } h5, h6 { color: #428bca; } .tooltip-inner { max-width: 450px; } .control-label, .selectize-dropdown, .item, .btn, .uneditable-input, .sorting, .odd, .even, .dataTables-info, .fa, .fa-refresh { font-size: 12px; } .selectize-input { padding: 0px 10px; min-height: 20px; } label, body, input { font-size: 12px; } .label, .badge { font-size: 12px; padding: 4px 20px; margin: 10px; line-height: 18px; } .label-info, .badge-info { background-color: #428bca; } input[type="text"],input[type="number"],input[type="email"],input[type="url"],input[type="search"],input[type="tel"],input[type="color"],.uneditable-input{ display:inline-block; height:18px; padding:0px 0px 0px 7px; margin-bottom:10px; font-size: 11px; line-height: 1.5; color:#555; vertical-align:middle; -webkit-border-radius:4px; -moz-border-radius:4px; border-radius:4px } input,textarea,.uneditable-input{ width: auto; } RLumShiny/inst/shiny/fastratio/www/GitHub-Mark-32px.png0000644000176200001440000000326214175060542022454 0ustar liggesusersPNG  IHDR szztEXtSoftwareAdobe ImageReadyqe<$iTXtXML:com.adobe.xmp $IDATxėmhayL30A+R#f>IHکy(M)_o5 0+0Ėl&o{i^]u<{Yws}=uC>$L, }<w}8^ AO?p! xaяPKI3`'B>0QT1<+`}^nvkp^ƅF|1"Gp.*oO׀Vp ]߅jc8K$q 8jV`#`vmpGѢu!#}#:U_?_yhE $=;c*xNOo+&w)%K-R%6n'o">j/t³qoGW7j%2q GX?woibCÐAzbǰt \14|S.DZ]# b|H$(ʕohmqͱRP셣$,0Z20 tNvRW3K8Xk2 IO6& ih4hX<{KA#K&ۉW΄s")_%9dT`Y9! [ vu5RL/& ŇH -JrYd<%@u۬s񏓑Ǧ1H(|&pG<~/?(s0l4`0r.<%EߵOpH夤'&t;zjSGBCj{GJËW M*P-< PK!U0#L _rels/.rels (MO0 HݐBKwAH!T~I$ݿ'TG~PK!ࢾxl/workbook.xmlTێ0}@~gBl.mm^+ئi{(lW x93LռQ n\dQAd!A_WY`B 3INʣB'(7;&9XȒ KűP]*3Sjx;3:z  I*N@-:g8y X6+9d>𮀲k/a3{sPNGEx^Wtg}dpY~¼@VYf,A1D}PUy[v0]L/Vl{V6t.~ \֖~{tOLx7V-6}L^ &G|:Us9eB,%hSCy NJiƿF$hwN>~`lB~d"?GPv 8B(wۦCaՅ<m|60{͸ jyMY VAZ]r9p\|=C QVj ȃD R)}6i3%` ,ڷ^8bގ` <9ی#gԏX/3UaqQ ψF~GEK};W~}? Q^'ġ5o3xH^X`Z jN_'PK!xl/theme/theme1.xmlYn6wtZ%l[hnmZbCH'5{a7v؞=)"cO tb 9wӔ:8e=qs؜dq}8:戲 5?DS@< 8o Hk9)7=/d[, ׆8s7G3JبD5h#s9u(>\OÛutPVbO]X j3F}?־PG(S4AO .v3K*-aa5@ x ` i_ |o{6+PBIvmz,mwn+d6d }',@)$szhi!J9qI@-Q8{MoIE`Ֆ )|>R/A#&2+[UFQ5^?}ϯ_|_4zugeojz[/Mu;w9K4J\(VO I$5'˭#<BP;nc=0pqT'g+"-aaPϘc,*V;a|ɶ56/ܓʽ`[{ QvښWX7dw!5fhYH77P=] 4 &[WmT`R~x.Tl+sLg 6PE+]join& - 4ev&nRtf4T4ڝk)"fR̹a+CZ1]BpE4Sȋ>ʲ̹"WSAJJҞ+) QMO\dS#A7 <zص WU&[AO3 9p(9'p*.ML*rD *g] -Vi,'u4ѬLCUiӏ7kI`UH6JDW̺o1!hԪ j K.KMj׸ <vz}g~w9kYWW7> B 79E_q~\ \#“I}}?jQZ'j h5FAabIۖ1Buyw]9ۍKLݫquhZ]Wq,l u[q:nj0j(t]\~+Q6懞~?/1B>J_{PK!P5A^xl/worksheets/sheet2.xmlY\G ;|XwKH ْg`l^_-bHQ&۷d]"2#ɬFb%ndFN~O_>}~wgO~_{?>?o?_<}_ŋo}O7|?7?>_o~ۧ?~|O}7_xϿvov|?-/H7}ۗ>~zn|vw??{珿|pe^_/ ٟ}zܽ_ϻ}>gϯc_˟~SOo>?˯LfO/ݟ¿.ħy?-.GgiN)=m23ٟ>ۿ|m77 ƹA7\n`|܀?2x1IE=ןᓢ˛oXU^v|ek6*ԍ;̼Ѝ߽+/_f.K^3tiQovч<;79}8eG=ǼOc^/J>^iqtz}1jx%F4eynx/DZ][\10B.MOhn̺>nܹ?Ɯ"wk&n֓tu<2WA}ARqtaڴ#Ilp/]?s\j7t0¯w{w/~.p 4,0K$y>8I1nuR L]hD^zZ$PRo>=B^w7fw `/òƱqYVoۮu5ڨmNx"fxw]A7/]D)qm^0,u-4ȴv۵[5|>]2"]LkU6 uv)md!2M"yqzHpFAݮiXV3ꤓŒ]A~ x[Ɠ ⊚LmYi]_L{1Jz2M־1on lx_W|Y}t](+3 <P|^5?44$ ;Ⱥ2nûº=r*Ӹ,V:Dzhi enPǛf;.iu,/˕_YBL]F9^044aP / L5Xt̫\{  FGo _y[a=`2am&q,C,,X4nP' /@+zt}W<|hiIOeiwA3kg`SlA;6v=*wleLq<<Ҍc" YUVbɬ*Za zCaYI(qMaa%"d͖BAeԱ8LSwcsn3@ ,A@x˺^o ;uXkMHC*M!62-#(m@L&0NAV%!uf4Vܙn~PoSTmrEU~A1غ^)qM`a1d :lve 3|qT 8#XNP&02My@Lft`OaB?-%ݍ;1 ,ѧU:d->mMuƵP6zx/5tM(aу(; Iv8Fc*:^ y:BXHAMxaz̙3 W5uíQa؄Ӥ_hs}× n.f\EN/PBm$!my<.qt +f0W:Y&0ٌ:\a/9;&']#⊚="_uj iIK$K&Wʎ[ w8ڍ`4Q4>Mg!6KI @P !Ll6&@0وJ6''Lp[q2mŎe6@Mx`rQ~6 d%&G,;Jx9ЄXM >Rϲ{ji %3gggƘԘ&DFd/$h` Na7zXT{SnniVS6dv83(3 J  \hlnδ&0;0;m[4;mi9,{Ԡ`|Q@F"s Hzn6_idMYؔhAOu4"&bfK'L^'=T쒹f`M=F5_PU杛`@}R9n,^\F eժՑs!Lx4AA ,ރ&bT{=}hO44X.u&>pa?jSOz *éڹ&0;p?~3I,oԃ[S!UDG MQ;b/6s36+>ܷ*J]Al`R&LFdp AS.x9\Qq v[AmCqL c8B\Uad<5kM`q`P2r-77:-7Dt$S:ljy d44 *7one- UWTebc-?; M@^uPxMopb{̺48a8_UDݖ&Fzb\J| v AuxqEUO`uK55v1 f&U"~w` anLTD&F>P~\hRCܹ(*|K:H0#70sDNp<~/Te"79E3V!>DV{7䢙s)!pJz哎+2:=9K6~nMx!62ag 2y3熃LUKY$C {-+ĘWmB+OD(ĭ CFN|:nJ2 *ԋLez E[H$Z<A\u%K8tʂݝzc1ݚD}W]۲#-H%?~o+j(R"9&Qքh#Hy/a9;|-dMzԵ4asX(Xq 9F&hk9XbOj3 RS92)N-@.ݚCmdR/> \+BCq<ք$@+TW@O죍 @,"&*&d IYns?Te¥ VٮMq4Pe'G,QcQʹ* Jls\,}ȮM!> 3DJVe_a] kP]E+YTB)m]HÍ8 r)qqC ;'E F"XEmqbxB˖Q.ġ{s q$2>Mq63e~{#kHy|x@zPkŀ"rϑ1C~L\UfߎفR x 2q;rF6 -l@䠍F_AJj $>j@r-R ќpd|В2nh)`oR)r[fjQÖ Zjq "SMZ@cgDo G@mĪAĂR=T.Sj"G=:Z1n7M3%'ǶuF3Y*®:q_$G>9ͻHǎGTΕShI7L2* N/J A;mgq?4ҨJ ׈@մXE=/>К'@ĩBsKG $%(&]*AN-KR 8EH|uI%p I ,"l4o('vXupEᢺ0n#J'n hI,*(Zj v@=s 冏qd !̆maCrhRSebyeBAQKu0PDjjC M;hAjr-QtX8u82j=4XRFI= rv<'WB$m_}j*掄FDAmbټbP"vQb\ v& zJEnJ Eʑ|t#]++Ti2KgKqfBjT}0M$QRˊEI Y =' #Y6Aڐ" {ysH:3^b-xP:|P%)0Z_cmlެeD,qREXҽzy1 l8J5 feΎ4$)Zʰ4q<lGwYKH]L Z}<@gJ(m؎ bƑ4.8Jit ?|@yN*9JcCp^0 Cthg)@~p>_1fq7UlCaI`Ȉ˽?̮:YBi1EkLE]O6І}~A6C`xҁЅdY2=! &5` T$NʰG":Cۮ5y@B"D+(h,E/3x%-ħ.eM6 cӦk C>B{2qP" !/~ EKBWLHjRbmMX.A%VFܸ$>@`0%8Z` lNj7 3*\)Ct.Hن.=(X cSXAJ)֐8b)"%j-M2aǩ$١FFvK$la#9I(0xv*uJNoj-o 7H!=;^b)!PŮ-ڡ ϑ%ԩQX^gώG,xD{Uk"TS@h) 8GD rFJ[x@񣴇XvQ$ mAUdc, EXIE A4tm?MFE$ rSKUWp6C :EZy>Ն*GeϹ)~YbێWt40$[<FR ! GGZo3U@BJ9TJkyL,Rf71eʓXӉu" U8Jґ)YYB;Єw>|mC*k'TJ$&K+KޛS/sxY"~WT=D8AFH}%vmōBQ&P5z ="6m9t:_$p0$?B #XB- ^ -6ph,{1A x$ eVi,K-F5C@dXr0 ñWUD-3YRGXXRM eIYR"@f  + .sZb-' I*Lm>^oJaGO#0`$vDO9>>Gi78*8#egI. jBt* Zjr@ʆώGYeuIeRCYbߤ΂dˋ@E%;tD%/0;RSxߞTspєBqa1E"l6d+Y7I5V*S[E |biu얈 BEy;mSìT%WG"(eA@pO낺XxS4NbuImڶҁ=D +Hb5imk]P\A$X683G݉|;'$'=C9ec1)M*[8Ӂ:JgYlh{SJ{TՃS4e@&mqf" FkIG%J{4|>T]阎k#ϤlEf,vxLBdL㸲 Ö3Os6@ A\LDy&uvV,hމϟ,Q"oz7Uihe32$H4 "0'"uD:P wEQcEۮkSL>:O!zp:ئ1 2 7L8nF x 䘴A"6U{3i]&&ǨI[$s<~,kfxkg>uGrC{u;m$tymԉxώI܂-[2+aX@`#) ;:DPLfx3i1ib'S0_$4e^z.9z&xuR%E 2=I,\䢍hmdH<=&>8b zyZ)'`"UQcvb ;^ԧ NE2?I,/.׫1$PwP܀MQ T' ESUcRif6Gk-Fx2GN*;_aRXX<0"&GyJän"l0N@küdk"Flᡤ|}NQb!NmZj$+mw} de n^r (e"҂EM*lXmpei$闥8<_&s%g}/$.H֑ƗIOE6T3 3z2ڽS_&|,)(F7M"wYSQ[ɄD k$yxL*ˈp3D12UC0C)M+Y e^]0>Ï5VG&[ݢ OہA`mV&+'ix6RM+YTXx F,6b M5l+V`ljQ,Jhǃ)Ђq=fLkL'IF&ηX]3c"QBLIQNq,}֜8K &@ZS5:J,)SkQMGB|`mPÑkNNG<9䚊~1̚pAfA\VmPk"hP4z^M @d AaTRVS&\/vq'U@5X x:P82*?qFUFְ\9w '% ;&zWa㱸p'`++h4Wkfs@^ʧ+ Ne(PKjDL悵pDSU5 stDfh!Ni!VmL% <&it~>(Pf!T@ uQŊjd/)L<Ŧjx(3L $Q1m$|[/Ԝ~YXޓl I6wƴ,V4p< ڞ\0 ? Ou>тIQXwXC`"i52MuٶTQ}ɗDuWΤm~w. o=& t<~'Y=I) ki8Mҡo8d4ePшU`uȟ`I+ ˞)E)IM5Ӑ< p%iMҡ3d6`6Gf.JxMU^sK#? jP!Y+yJ``p42X0ogYF-Qv㱂to7 ֘(-v,Z(ٷsqJR?e^DGW44"JeB`MTc- ڏn4'P3X)O7<`DF#(e;MSs&/rS3=wﮢk@ZN|gm{W xW>xٶ֬@JPYU( 4P`fE,EƧYE4M\ <&,Pͫ*˥ 5OzT{M$ x F`Gd6v =>`.:'M0}.iP4VL 1[1q~ewYcxdB4^5A%uPIS7&AK=)֘t1 /|D}d@F4+1h0/6> $kNiwP2 @^5C-d6MB7^"23adx9:)2;>^}d }K 5quf|SM0豪9v߂T^{DCS݉.mϬasOb.1<ʸ&k(9gh婍IuYzJN w^l_.Sr!R VJ;[`i,耹dSQ7.xujkX&o_csZ5JAڳt2(dE^Js2B]nUůlk 98>ycEH2Uɖ|#Jaĥ٠"1~YSuLU;[Y߹& 3$@G nE6:{0{WyQQMNv B֐ jq5n*/*a G9ӝr"BO׉D[uEEVӸwo/_toֽ{ٺ?*qC5O31n6LUWxЗ^ГfT! B"[άڎphT4[Y0SzNh s.) a jH=;X3IPJ$Vԓ-3*G^΅<8Zg[QŠдQ;Vυ㉐Sҳz|@Iˬ'D< %"]ۤ!8~s"3# V&U-5f?:Z&͘ B1&?i{R8(xT: L;Gem4$=)'{b@wԈ%o+{e:ϓ<*p (hS0)xx'dyC6|:xxbjR$nƅr*)=;^6|yhIǮ AyD Rn.MHn,ybi;?kw$q\U`(|C$UP0`zXH Avl邔jf'Nf<ɬw .Y Xא xf Ȅd)|Ú'Jl4ꗭ*r DcN̊k RiYk8Sėo+\^/窊{ {_~ƬpIhwȁ}7m m.NSU ѵ.0aWbyn'݄6An<ֹ{NY5?.'"H#,К÷;UtUNOE5sUd@DbPx3;|k037Ux/MSíp|S$ódY#4j&ȜWŸ^3N !\-4'#wX2k--ѩw2+R.Θ^,g:6tF̌T ִ;SF0ԳYgnm)ff@ۛJlm _;;h=;7Mj ='SmZydOs _w+:?!wfza1!nmZz'2@PfVj_>( (ѬsXR)j v ɱMCsu(殃5VY5-fsec. Cl™ th"J™Q7z]N܁=s.9A>cVhiL~뙫s%#ҡN&}E/žNˈѨ\6U q NxaTf]^#ˍPe'RYSDˇh$!0to FtB̒ !f7L!ڵ,АBK VD8=ƅz} AZc.yl_mꢩ|GoMVoUfLn}"1 ?B/"ot_TbMӵݚE^߼V뙕s͸ ;scB!Y&7=YΟPe7Ӧ8|6q ۀZJ LE7m H q-ϩu|4Y-`X,e[ǧW/ޝ4"l: EUOMZfѤCƌ\o0K*#<u5Mlު;%5x^l )x?p*'&i6UzrWImӕ2x- {ޣ iUl:G!Dx5r W&ɦ_^hSY3*C\_8zxs҉~=65k=Mr5q%#z)5yS4QUr~?/^`V"53q]pC_gcӂ1.":i{7h\=JYbFգ0v 5}M0vÃw]Hx` TP)n] f5*>z4yV":UM.vvqt45W] V,ܜKeAa mXsG׭g2RaY7]KgكG[%٭@L=]=^>fIVyCg֥aaj+|kG)Ͽ_[3W5ܮws^[䅦[Ez oe{W0͗v4Y6r 7YrYxjNZ8 mB{*kt mϽ5#S=U7sp x)ha.V#v:L\f5S Gj½ vK &s7֖ΰd喞o m{Rv f{[^E%{7XkYc'mQK߼7,ZoO0vosIZ 7V|q֤7p2o>fIピ\z0+#NXPS~e7#|Ե=5HDv0Q;V#%TfNvYZp'לamN镺9k8dN >`L,]HUO| A0m?Wg"Ykʨ#x=U|3?.dT"u^h3v U7;sG vE- g E'+;(_"9zKNUez5+¶9<șV (1&" .)2k =l:G,j|^AE NdCM>D=URD s/NO󁞻K^^O\Gsߔj y9tVȊQӵt8**84Y.TnMC[R TlB'sN,<#\KOk2ߩXC /sc#"Ã6zny:lQN8F;յGݍ9ZX-kvXk> _nS3'O\\.%Wjt%)ߕ:Lfv' MDZg`\&{ZM˳͝V!J0]pϏf}>H& OC'*Mup(pUVX:{,".PjD5oP;m$f9W f ^g9j=RUt*=L,sxE+X"L.syhWesMRnwJRꉽku+L>n; S6 t+Zej{[Ҏ SW\rM&ݷR5J\ظV†] +T?msp zL]orKt[~5ʇ庽\I>pYTn.Xy=zKu)V~^^U׮OR\Ƒ.\0+ hh ݯ}X-ۛNppub%q3 ҳl0YC S+GN֮<7JȾFܕn .tJ O[":F!DëNGNMۇS?kVyRfSy+UfweCnPy<=<]tPh'c,s] TSv3VN0D~cѱhOkJ S bp_+U┱ ._B@֎U]i[~()zЮ)Z^CgV3d[Gv.ZSTIw9Dv ]8.9!x%&wZFk5zk" !J#x*aG f{KmڕC/䠜*>z#GXaqcQʬ"D/${7Rx^R~k.^ƂnI]ӡp{bN mѳ0!*KWCrd?yNrpnSSQfd<ZӢ4eC(^uZ:c2دBj] EZ2k-jKY@q({s׮G$mtΊt3e 51KXc~UV22{#uFi@BSeMk{ i {?.✝6=xZzF%ѵŵkX0Hꀮ#ZJ78]m˯RF]h3'Mw%v؆X/Sr$7/';KRꅈ@z[vMaWH4}*IJ.Ք1bgOUh+ux@暕]q3#F, PõQs8E ~LOR"e+`QI?IeDz7'[N+\CJ%گ5JR*K <\eѭ]ONO]@C& LgɕMkro4 ؕN-1p=:GѨwaP 6j-ъY 59EҮ2j0)Pj|H2k `1Vv}fM~`hDt]ٵ&kj/b층שÐn=ժ$&b.lyl׽^ GCiZIBdCYkׇ̿\{*Gvp2lTuO5eKj_ ;<^Cm]8;OŎsgncmyNA¬Kj[ZDv5`\0GJ/(+gT5eK(m2I]6Y4BdiwmyolX֤-ޮm6 p]o~ Zgq\rKa,.rDוM#]ږpBE~> 6J5ViMRº߯Np]p8{q.QlT. [W\k*~.BfTnY,Ou3jT!aWHQ!z8nYo̫ʭ][0lD ~]2߯;kɹ g\rHXN93jcٶj+(yfј.dB?6ͅ.wsb;ݥ*[;BUwеhD :~kɋVRQ؞_^-#sPcE'Yfe1phG>XMׄb̎s~Oy%eLX#ab#OCQɈ]t׮ QKd ):~2heԠ0ZҞk$:3 C0NՓk7I-xFg8!ު\OO3vav_!U|`']Gʖ]o{t>pwӞüv:\4LVVZX@FBZX6w/seU8 gRkՁ 2SNPbs%fL >7Pa^пfO"$".Y_>8$(B1f}i0,O\V25: !Wh5S.cV&~:puc|&kvgqӣWttԦMr}4u*إEoW-eW75T<#XAIJv I ("'d\P<޺A#F:[󝮯u=^MIh~ϪB_mڡDyGo:>_zovMSљ] R *aͮf9G4լe4R  )R(st..L6Gz/dkkf\r>'"ieh.'RM7Z?JUD2s]sݬ41N0b)?p*vJ]Q5v=}<^b/iC엫*(KW+`p-OC|O}g~]dMȜd`ThpS\p ܎ñkK ^NO9Psh,yMTkAn@z[;Gޣ5DJXƖ %=fRnvŹ$&B}!(v[zZXɐxt}7tf7sݚD"-˚%^tIŶw$-=B5D uDT5Ktp ׮O1Ua?6%QėAK+Ms׵3ץ(hcґdE;o&]/n0ur*XɾۊTGЀ1gHp x^5Wr_Nqb5Az1{4, "Rbc1k@U1I1 j9D$C#o (zƮRa*]49ң%u@=/_ i>pԮ3HrqT}o?Oo~o|˧?|D>:?~vo?|?~}w?_Փӻͻ_׻~o˻?|͟Ӈ'?{)S;೺?2~y/?~7뛟o?oo~ϟ>\߯7y[W/91᷿mPK!/?-xl/worksheets/sheet3.xml[sIe>a\1d  @wO{A:җ_ݾg/on?^=cw_ۻ_?v'}|x/Vp{/w>ݜgg^v?^i!mnws`?^[tu>]?_~buN>]ϟo.xym퇇綹$ӋS/a?}x/݋uq<~͍=Lv`t{fw7+Ko?oݑNwϻ.wooovz~כu]NϗɆG?~_١15Ϲ?O>]9fC{߿V=iwڷOyzl c؀;oaϏ;viwUf{үEg,IzdkGՎo/%;\v_f'o/^=u}]%ݲOڟoth[z8oƧ~S5d=]\; ږ.OkV%ȵsk?%o7D7'{M;2_l2:#H{mv?xp9y'xLzN8XoqQ.׫Mq[o+m0?䕞i7iGV}IRao}tg;}o_~?NT>8v}gHoیֳ|۽vox_/I/&ߗ~tNIO:O'v[!.hu~Ng䖳(l~MERH]fWWC;H]OR0~S%)n-eW=Ձ"ݖ"}"x>~K kۂ:NbEV<ʒ?@ꂬ%Vi춬@Y1H-+Pت󭗾"zdvRe .ȊAbmY bXak'u4+·:+۲ +v-+P uix4+( +vRe .ȊAbm( +vRe .ȊQbmYVo=rG%VIݖ( +FvRe .ȊQbmY bXak'uD<;#XoY] [{a# .ȊQbmY bXak'u[V@ꂬ%VIݖ( +&vRe [u5;I-+P uAVL+ln H] [;۲Rd$N궬@Y1I: ʷ*$VL`Ÿe 4vAVL+lu-+P uAVk?s-+P uAVL+ln H] [;۲:z䪘%VIݖ( +fvRe .ȊYbmY bXak'u[V@ꂬ%VIݖ( +fnڲRd,N궬@Y1K-+P uAV+ln H] [;۲:z [;۲Rd"N궬@YH-+P uAV,+ln H]>mn H] [{U7oY bXak'uR\%)z"b+-+P bXak۲RdIݖ(l#G\bmYb}Uym>Vl_;z;\"oIiCyIlnKHN"9H2oICI$9I-IP u{Hr:$ ɲ% nIR'$Y$A!A$$˖$(=$9HDsdْR$fzGY$Aaη^#A$\$˖$(=I+-+P uAV\HӑݲRdŅ [;۲RduIݖ( +.$Vګ-+P uAV\H-+P uAV\H-+P uAV\H-+P uAVtg,||l;;'[b + 2;'[j + r;'[r + ;'[z + ;'[ + 2; ⫯ /VHw&WO + ;`'CyҝI@ՓB Lph'TH ĔNcSPaQtSl +2C \SlCFiLSPaQ|8?;g[=)$ L1~Ĕ(SD816S,(pFLA0PPĔጘR3#":L}4ĔQ|A({R0gĔYjLS3b *tB)gĔiAS`Έ)xg˃ y ,1by lǻܗP*>}yPw#/*ԘS*fνf'`8b(OjLu|)SyjL}|)cyB)1>wAC+`#_U <8S`%:bJd޹=v5N>ϼ}yPXʇ)y^jL|iR1wg)ԘkS*=!|iR1' 5b>a]-} zaNfYק&1bZ_wP;OS1a Tc 5> Ĝyso|Hf_`SbN*Ԙ0 Ĝs|Lxڇ1{*¾>}yp y ,yۻݗjL}9y1Va$TL{C 5{;0S*FwDPXڇR1wڇR1w)Ԙk0S*=1S`oFbJ޹>Pc ,HL;jL} {W1B)S*&=1Ԙ0S*F}1S`y&bJ ߹>Pw1bOjL})S|jL})c|B)1b{S16xk6Q1w)Ԙ+0S*&=1S`'U{_}UH>\aAWO bg v%[ a)Փ-SrVOk h7'Z{͇﫧S;'WO 9Bim?\s*>|Dac(cz n􏍡l~ T|Bim?\s*>|DP4ɇ+g76U>{4GΧ8/dix+|}uG2JITBߏ30NR)N#H\)#T;q'{yTJ ڤL}6:ZHHH> R}B$G_SR56?~TCA }6dTV!>; R}VBv_ڈVn?𨮕R5Z!`> 6( ZQB Rc "9 <@ ZQ@B Rʃ ;PڈVhH(2ϑ hTЊPڈVqH(D! h)L)M!W Z?z *FUsZi!URFW77Ҩ6 ( ZQB J˩⭅ߙ{E8r2SW<0AS@3Jds"CO)lLo*R5!ah>G3ivTfHb) E!UF kQ)]vE!UFJmsjCaT4;BF34"tZCrrp!D!UbF tsZi!UFJvsCAjfGF39爇0RC R3"aЇ>>63(R1>?64(R1>@65(R1<>A66(R1`>C6#!b\)jLhQ=!Fȕ[}##eF93ObT5Z!"b>G6"#+b\)hi ''8¨6>(RA+ʕsDAj#Zy">L6A(RA+JsDAj#Zy""ȉ>GNYjȣ\;@֕W #PʏRTVuJiṰO6xRx F -WO++QmC+ܫ*hu5 jچVW ZQbo& &FWjRʚjRAmo& &؆YjRJKpuJ~ k \)Im3ƿ r,|C`UV)Z W6O%: Zd >bT5Z!b k.\F iT&ʺ.Uhe]XSUDYR4ETH4Qօj#ZYx$51i k@\ڈVZօ @f]4XD2H(ZFu e]XoFs+F51i kR\ڈVQ!IM(ºW6[YD$51i k[\ڈVQ!I(W6ETHRA+ʺFUhe]Xt_\)uLF+$ZLuaڈVZօu*ƨP)j9B1hв.|uLu+%VZօ.TzJIj#ZiYRI *%he]X7cH*%he]X[cH'6uxe]JIj#ZiYRI *%D~m[ O4\6_o~8,0|C/kh6ZcM*^I-LeaXd D3T 'H9  YeaXڨ'a]1D3TJZͽx1Q5VjfGH^H( :,WivTm,0rUjfGH^˜( z.WivTm,0rUjquTVH( ú0W!U/&°vUheaXt_,\)WYjYֆRwjFLZYHeaX VZHhċ0esUj#ZiY֡'ͽY3-FU/&°&QmD+- z6Q,\)J°͐JsjFL@/&°, kQ0Y3 FU°ΐJs+T j9 Ca !hUHi1x1QPHR5Z!b, k]J eaXWFs+- Ú@\',ͭx1Qj#ZiY:*eaJfhneaXhHwY3-Nmnċ0th4Ҳ0c4FhJ(gaҲ0u4Y3 Nؗu/ ˫awl}Ξ?_ܽz! $>BF+$^LamkZi!U-&ʺ~Uhee]XFs+bnEYց*,B ZQօJmD+Vua=Rͭ,Be]XsFҲ.uREhUκieAʨ"b kW]rR-&ʺU~ iTe]XFO-B'u1T.RX k\ˊVլR5Z!bu*-jBDYC5"UZHhD.jE e] լTi U˺u1QEhUκe] Ⱥ("WJR !U-&ʺYhD.jE Ye] NFs+-b@DYRhne]XVʺȕFs+-š`C*nUͺHiqjBDY'%p e]X6sϬ|Vʺ>WS%>Zj''RJJG5CokVoڟ''KB>ZClM*^I-ν*gپ+H#JO 6n^RZRNR) #WJR4;B4ِY!UφZRZ|RxTf?RoaJIjfT- gCw\)H-ga!U0 *%ŹR5Z!b, ]C@9 x1Qu֮JmD+- g\%ZU0g| ᡦφTU5 #}TVH) :ko_^~j֗O;ٟ~/3Aj b 56!b ]Qh;)ԐX/}vE P˹ثHs.GwS!3[Xz~FLdW̔ja=+ m1nY1SƮ(js"$U̔aa+ m1\P1St5®(jLA.L0-š[ UmL)5|VeI(_r>1S,5(S4 `1$4Q-WC!MjP;)Ԙ'o9{0-rTc ce4aݩf.9i0-`šRC!MXr)2E˕^I!J (S8 kA 0-IFDXi($Rea pRe a}3! };4(\FLQc Qh #r枘 Ha) !Bc~ QXLL.];<a3;UI) SO6` Y}Cw;S௟/)yOcef&zĔl'Q & _Qh> n| L1{4 짊ޗ)p/䳟*>{_S' }>C~y/\)p/ |)Ԙ7B>{[Qe1LXg?U|{k[9Q=^:i6~}yp y | 쭥ne L|S)f_ۗ泷6PH?Q|kT'헞R'bc' }mfA>\aQh> n| L| sFbyeB>Pc m)n])S_ȇok+ L|֛6]>L| sF-Ɛ )?軍ß_ȇ+0+wO/]˚(L1tߗPc l)nemB>|-[Qe÷ƱZ&~yeß_FbJŇe͇?mOjL~!TB ߗjL~!TBmB>|k[B)p/䳷Q=^ 짊ޗPc 짊ޗjϾ_g?U|{kZQe%:VF-kې>Wne1ij/[F +Ɛ~OA0g?g>WH>AL|| sF*6%WXa)fW[;qYO/(S472o"8S_g?U|{_S' ]|1EO/Veg+0+L~!Ty/ob'/O| sxs.y?Q[STXPc| jk,S1n )jTO/O/)ƤW_ϕ핲 rZcRM!5>*[JƬ)p;=9ZƤ7|Py cS(=>ocd5&L!o|ce ]|m4 B>\a{1)ԘB>o(S*>|DP/*ԘB>|en뗟vw?nnOnloR_>?n?rl퓛۫ˇϯ/?_x_ Ďm]M4;&zΛ˫_NnO]>/ PK!° 9xl/worksheets/sheet1.xml[rH}߈yhB؞h[6`cnl EOVU e6ҍRJCA]}|Ͷ"__uIb|NQ֏eή?u-~.^Puq})͸//jVMwjVҟ~fG7h''l!1@o`؋0$+D=*]7ľWYVqʍ^h7ɬ]_noHb3g4hW&fˎh^uc҉&V̜)7L!%vHSn($ (vEAHSʩʙ|jO Z8g^s Ua٨aN[@Dr`&1{'҅2D].mU,or`DKӯX-j<gn1+~f?d0e.`DG n;ް{ީk{b)ދJZQ23{q?_h~{Jȅk!F KbWUph=!Op|7;A~D'ȿMI=.OX:8AV #qhl;A&x܆@[]x灺-{tc_݄jWm= j= 1V}F6H< H= S`Ȼ[ := :RCXEU jC jC :dL=U[vQT݌I3"jgDHʈ(8SFh>p#oM/Έ뎓0G 9R'Y1aJqpS4Hh{NL؅5@F~#r Hq!gʜZq/@eueN*F?k#I *{ZE2AV|gTϝaD8 si%\}Hq!gʜZu~0"k);$̒cN\#Ry̑c`xl _ԊsQF^}cl`#{@i@]aHE@D3< #E%@i nV`}|&#d? (Zc#`7a`ߏ9R};q+E9Rc {HSaHJƭBEK9R0̑{}( &ֱ `HhA+EQXBH 2G<H>O8x'AKf! #Ȓx SF;#iPBI!IE `9R.Bׁ&d' 8CEo1$E CH`ð -E Cd ͿЫ~N|6.B)BFA'=5{#<BFA:n] p ! 0&gzJ2  k!@)BFA:FX+qPQ |2~5į2 72y7J2 O72G!@FA:-wD@ q=qi "d38''""d3{^1 2 R x@;"B)BFA:#66DtuC<$#~xHG2 "d! `3a3D(H'P7C^8^QN$p_"d[! `';D(H'pT'a'D(E(H%pzT'tl J2  O""d8b'D(E(H'pT'Ys$,RgmQ3ϿSC4 * p⟢1@q'јޯ˽|ɶ3۽p2}Wݟ2vcbOf9A[ a zX46y.:ɝqNz7=t녎=fT;HyPK!Nxl/sharedStrings.xml|ώ0Hȧrئ]UIV,mY u8q-w$މw!x8ps7nz֎ 1O )մ/8BYI j QPϲUVH윷2Oϸ(\!kef&5 ╀Mo(seʥ6=I0?˳PYK 5v:58rRUҎˋ&?~:JkBfTwYX#ͿVoHD Qhq-U8f(ܠ1q#`TͬΥࠛhkjvRƣO7eL#)I_4 R3}["x-켳d_?jnU:hu:px3_|ꓫ/_)X==~{l-PK! C{ xl/styles.xmlY[o8~_ir BFH#ͮFjWWLjN2{lp&mƗϱ_69pYVD}a.bFkGE(+poq۴[o0lQT~jbUrsT].KqKZXSӱ,)zI $Gze$,_!N{ZL- VEQ'ȡg$)Y2~,Hc DIl{NgZNMlWZtD8/"@&z=k6~iˆi(+5Zm1R3.% naNʧe αNy䞗Gg{ֺK :)w <~x/\."=-s:^J;&W̦M8.jMv*6zg/KoQ _^v-1')օac;|RxH :]߁? v~#(}' l $Ϗm~I]=!L9+SH,TpC)'Y .gӔ%+qIHI"=)YpZ!њ&@nCO1Px#b_)$YL+yo`"t&X{ӬVw " Vt:_2IXmǙM81%PwWHI?PK!0$5YrdocProps/core.xml (_O M -!m7'MFv#Kv~W]`*C$Qk!6C/:EuL Vi:E* ',Mv5cwP3ybM͜?-n`[Iq a3 )lc,&?^>蕑NcGqpY9۶I'mW v`N|#V.x,K!S-(&#WъY/%!_Erotߚ9N笼NVILnxyAt6}K|OALt:dL<>/ɿPK!3ՒsdocProps/app.xml (n0 d(@VQ+zhq{Wd:&KɞgomɟͱY 1 6,}eܾ`W%TR;( ?M"HYTbXqf$;Rj=um4yڀCkGWAuFC68Z_/@R-M2 蓯1v`_S1MV+ kM @u(-ZcOe;,XQ k>!aqQp>~0(l .9Kz"{9I=SXJH8W!;or'Ѹ9N!-(] vmg>(] ,_tC&5ϯEPK!zW, Rxl/calcChain.xmlln}A~ɕTE>Al9} ep~tǯ>󧛸\/?﮾^_}|sݯ>D+^&+O+L#a9<<<<<<<<<<<<<<<<<<<<| A2d>| -o|K[2ߒ̷d%-o|G;2ߑwd#|G;2ߓd'=|O{2ߓBv!u].o ۅ".7777777űc Ӈa0}x"Td&M)T6lbԲe&M1d6lTf&M9t6lԳg&MA6 m"Th&MI6-mbԴi&MQ6MmTj&MY6mmԵk&Ma6m"Tl&Mi6}l솴666666666666666666NѳNVTkCkCkCkCk!ڮݾkmڮ]kvZ۵kmڮ]kvZ۵kmڮ]k}mڮ]kvZOnOO.>>>>>ڮ]kvZ۵kmڮ]kvZ۵kmڮ]kvZ۵kmڮ]kvZ۵kmڮ]kvZ۵kmڮ]kvZ۵kmڮ]kvZ۵kmڮ]kvZ;vhڡCkZ;vhڡCkZ;vhڡCkZ;vhڡCkZ;kZ;vh8zg׳~x=zWZ;vhڡCkZ;vhڡCkZ;vhڡCkZ;vhڡCkZ;vhڡCkZ;vhڡCkZ;vjکSkNZ;vjکSkNZ;vjکSkNZ;vjکSkNZ;vjکSkNZ;vjکSk}کSkΓIQYaiq'NN&NFvjکSkNZ;vjکSkNZ;vjکSkNZ;vjکSkNZ;vjکSkNZ;Ck=Ck=Ck=Ck=Nf.z- f׹me1~%W^?+kKW^3+d^5d^n5}KֽսKսum_!"uY+d^5d^5d^5d^n5 }gc1l,DE^ók8VW8e^9/9ypKͭfp΋̽s^`5r{ 缨j 缜k8^9/#y , yp ǽs^45qsfx+ʙQpsfTq93\8\ܫe3oRũbAK2Ty3Ճ%ӯT~"3F̙R哣93\6~-U`qeɳ_=h2AKWZL/93oϜ.U뾷T֮T֮tќ.U>9:3egzRٯTyr3FA͙RٯTy-UA*a͙Rkk AKI/az͙g,~ʳ_=hWZLzЭ*g˒AKAKAK=AKQksfTέTЭR^u҈Re+{K}o2-U_{p:i}r}o蓣93\6~UZ3å93\6^ksfl4]j }oY2-U'Y͙L93oc͙R哳{K-Ͻ}k ͙}p6gFcQksfThm p蓣93oڜ.U>993\6hm 'wx>gʙ5޺-U^RU޺-U^q%ӯRez͙Ბ>gKg93o͙Rez͙93o<=]VFXk-}mڜsy3å93\6{3eO}m ksfT\3gFsfxh_3åʷ־6gFposfx߸%ӯoʳڜ.={͙}p2pkm QksfTjm Z3eɷ'͙mc %psfTp2}m ksfTLksfl4w93oڜ.U<93\L93\6^ksfxߨ93\Lr >9Z3e#om U']Oz<ξz'_^kɷW}m C93\|k3eCΙѷVksfx߸ʒksfl4}m ͙}}m *͙ѷVksfxߨ93\|k6gFZ͙ѷVksfxߨ93\|r6gF͙Ბ''g.K} *.UϙR^93\Lo_3e#ON *.UѾ6gKg93\6|Ww|}r/[%PK-!zu [Content_Types].xmlPK-!U0#L _rels/.relsPK-!;Yxl/_rels/workbook.xml.relsPK-!ࢾ& xl/workbook.xmlPK-! xl/theme/theme1.xmlPK-!P5A^xl/worksheets/sheet2.xmlPK-!/?-?qxl/worksheets/sheet3.xmlPK-!° 9xl/worksheets/sheet1.xmlPK-!Njxl/sharedStrings.xmlPK-! C{ Hxl/styles.xmlPK-!0$5YrqdocProps/core.xmlPK-!3ՒsdocProps/app.xmlPK-!zW, Rxl/calcChain.xmlPK JRLumShiny/inst/shiny/filter/ui.R0000644000176200001440000002155414175060542016313 0ustar liggesusers## +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ## 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@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", "Custom wavelength" = "custom" ) ), fluidRow( column(width = 10, inputPanel( numericInput("stimulationInput_custom_centre", label = "Centre", value = 470, width = 150, min = 2, max = 1000), numericInput("stimulationInput_custom_width", label = "Width", value = 20, width = 150, min = 1, max = 1000), RLumShiny:::jscolorInput("rec_colour", label = "Colour"))) ) ), # 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 = "net_transmission", label = "Show net transmisison", value = TRUE), 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"), br(), br(), helpText("The currently used '.xlsx' file of the app (template or individual) can be downloaded here.") ), tabPanel("About", h5("App version"), p("0.2.1 (2021-02-24)"), h5("Authors"), p("Urs Tilmann Wolpert, Department of Geography, Justus-Liebig-University Giessen (Germany)"), p("Sebastian Kreutzer, Geography & Earth Sciences, Aberystwyth University (United Kingdom)"), h5("Contact"), p("urs.t.wolpert@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"), ".") ) ) ) RLumShiny/inst/shiny/abanico/0000755000176200001440000000000014175060542015653 5ustar liggesusersRLumShiny/inst/shiny/abanico/Global.R0000644000176200001440000000034714175060542017202 0ustar liggesusers## global.R ## library(Luminescence) library(RLumShiny) library(shiny) library(data.table) library(rhandsontable) # load example data data(ExampleData.DeValues, envir = environment()) enableBookmarking(store = "server")RLumShiny/inst/shiny/abanico/server.R0000644000176200001440000004120714175060542017310 0ustar liggesusers## Server.R ## MAIN FUNCTION 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")), data = NULL, args = NULL) ### GET DATA SETS observe({ ### 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 isolate({ filter.prim<- input$filter.prim filter.sec<- input$filter.sec }) if(!is.null(filter.prim)) { index<- grep(paste(filter.prim, collapse = "|"), data[[1]][,1]) sub[[1]]<- data[[1]][-index,] } if(length(data) == 2 && !is.null(filter.sec)) { index<- grep(paste(filter.sec, collapse = "|"), data[[2]][,1]) sub[[2]]<- data[[2]][-index,] } stillSelected.prim<- filter.prim stillSelected.sec<- filter.sec updateSelectInput(session, inputId = "filter.prim", choices = sort(data[[1]][,1]), selected = stillSelected.prim) if(length(data) == 2) { updateSelectInput(session, inputId = "filter.sec", choices = sort(data[[2]][,1]), selected = stillSelected.sec) } values$data <- sub }) 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) observeEvent(input$file1, { inFile<- input$file1 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) 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<- values$data if(input$logz == TRUE) { sd<- unlist(lapply(data, function(x) x[,2]/x[,1])) } else { sd<- unlist(lapply(data, function(x) x[,2])) } prec<- 1/sd sliderInput(inputId = "xlim", sep="", label = "Range x-axis", min = 0, max = round(max(prec)*2, 3), value = c(0, max(prec)*1.05)) })## EndOf::renderUI() # dynamically inject sliderInput for z-axis range output$zlim<- renderUI({ data<- unlist(lapply(values$data, function(x) x[,1])) min<- min(data) max<- max(data) sliderInput(inputId = "zlim", sep="", label = "Range z-axis", min = min*0.25, max = round(max*1.75, 3), value = c(min*0.8, max*1.2)) })## EndOf::renderUI() output$ylim<- renderUI({ ylim<- plot_AbanicoPlot(values$data, output = TRUE)$ylim sliderInput(inputId = "ylim", sep="", label = "Range y-axis", min = ylim[1]*4, max = round(ylim[2]*4, 3), value = c(ylim[1], ylim[2])) }) # dynamically inject sliderInput for KDE bandwidth output$bw<- renderUI({ data<- unlist(lapply(values$data, function(x) x[,1])) if(input$logz == TRUE) { data<- log(data) min<- 0.001 value<- bw.nrd0(data)*2 max<- value*2 } else { value<- bw.nrd0(data) min<- value/4 max<- value*4 } sliderInput(inputId = "bw", sep="", label = "KDE bandwidth", min = round(min, 3), max = round(max, 3), value = value) })## EndOf::renderUI() output$centralityNumeric<- renderUI({ data <- values$data numericInput(inputId = "centralityNumeric", label = "Value", value = round(mean(data[[1]][,1]), 2), step = 0.01) }) observe({ # refresh plot on button press input$refresh # make sure that input panels are registered on non-active tabs. # by default tabs are suspended and input variables are hence # not available outputOptions(x = output, name = "bw", suspendWhenHidden = FALSE) outputOptions(x = output, name = "zlim", suspendWhenHidden = FALSE) outputOptions(x = output, name = "xlim", suspendWhenHidden = FALSE) outputOptions(x = output, name = "ylim", suspendWhenHidden = FALSE) outputOptions(x = output, name = "centralityNumeric", suspendWhenHidden = FALSE) # if custom datapoint color get RGB code from separate input panel color <- ifelse(input$color == "custom", input$jscol1, input$color) 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 == "") { color2<- "black" } else { color2<- input$jscol2 } } else { color2<- input$color2 } } else { color2<- "black" #adjustcolor("white", alpha.f = 0) } # if custom datapoint style get char from separate input panel pch<- ifelse(input$pch == "custom", input$custompch, as.integer(input$pch)-1) # if custom datapoint style get char from separate input panel pch2<- ifelse(input$pch2 == "custom", input$custompch2, as.integer(input$pch2)-1) # create numeric vector of lines line <- sapply(1:8, function(x) input[[paste0("line", x)]]) # create char vector of line colors line.col <- sapply(1:8, function(x) input[[paste0("colline", x)]]) # create char vector of line labels line.label <- sapply(1:8, function(x) input[[paste0("labline", x)]]) # create integer vector of line types line.lty <- sapply(1:8, function(x) as.numeric(input[[paste0("linelty", x)]])) # if custom polygon color get RGB from separate input panel or "none" polygon.col <- ifelse(input$polygon == "custom", adjustcolor(col = input$rgbPolygon, alpha.f = input$alpha.polygon/100), ifelse(input$polygon == "none", input$polygon, adjustcolor(col = input$polygon, alpha.f = input$alpha.polygon/100))) # if custom polygon color get RGB from separate input panel or "none" # (secondary data set) polygon.col2 <- ifelse(input$polygon2 == "custom", adjustcolor(col = input$rgbPolygon2, alpha.f = input$alpha.polygon/100), ifelse(input$polygon2 == "none", input$polygon2, adjustcolor(col = input$polygon2, alpha.f = input$alpha.polygon/100))) # if custom bar color get RGB from separate input panel or "none" bar.col <- ifelse(input$bar == "custom", adjustcolor(col = input$rgbBar, alpha.f = input$alpha.bar/100), ifelse(input$bar == "none", input$bar, adjustcolor(col = input$bar, alpha.f = input$alpha.bar/100))) # if custom bar color get RGB from separate input panel or "none" # SECONDARY DATA SET bar.col2 <- ifelse(input$bar2 == "custom", adjustcolor(col = input$rgbBar2, alpha.f = input$alpha.bar/100), ifelse(input$bar2 == "none", input$bar, adjustcolor(col = input$bar2, alpha.f = input$alpha.bar/100))) # if custom grid color get RGB from separate input panel or "none" grid.col <- ifelse(input$grid == "custom", adjustcolor(col = input$rgbGrid, alpha.f = input$alpha.grid/100), ifelse(input$grid == "none", input$grid, adjustcolor(col = input$grid, alpha.f = input$alpha.grid/100))) # workaround: if no legend wanted set label to NA and hide # symbol on coordinates -999, -999 if(input$showlegend == FALSE) { legend<- c(NA,NA) legend.pos<- c(-999,-999) } else { if(!all(is.na(unlist(values$data_secondary)))) { legend<- c(input$legendname, input$legendname2) legend.pos<- input$legend.pos } else { legend<- c(input$legendname, "") legend.pos<- input$legend.pos } } # TODO: arg 'bar' handling (custom values, 1 or 2 bars) if (input$customSigBar) { if (!input$addBar) bar <- input$sigmabar1 if (input$addBar) bar <- c(input$sigmabar1, input$sigmabar2) } else { bar <- TRUE } # check whether a keyword or a numeric value is used for # centrality centrality <- ifelse(input$centrality == "custom", input$centralityNumeric, input$centrality) # check whether predefined or custom dispersion dispersion<- ifelse(input$dispersion == "custom", paste("p", input$cinn, sep=""), input$dispersion) # save all arguments in a list values$args<- list(data = values$data, y.axis = input$yaxis, bw = input$bw, bar = bar, dispersion = dispersion, plot.ratio = input$p.ratio, z.0 = centrality, log.z = input$logz, summary = if (input$summary) input$stats else NA, summary.pos = input$sumpos, summary.method = input$summary.method, col = c(color,color2), pch = c(pch,pch2), zlab = input$zlab, main = input$main, zlim = input$zlim, cex = input$cex, mtext = input$mtext, stats = input$statlabels, error.bars = input$errorbars, line = line, line.col = line.col, line.label = line.label, line.lty = line.lty, polygon.col = c(polygon.col,polygon.col2), bar.col = c(bar.col, bar.col2), grid.col = grid.col, legend = legend, legend.pos = legend.pos, na.rm = TRUE, lwd = c(input$lwd, input$lwd2), xlab = c(input$xlab1, input$xlab2), ylab = input$ylab, lty = c(as.integer(input$lty), as.integer(input$lty2)), xlim = input$xlim, ylim = input$ylim, rug = input$rug, layout = input$layout, rotate = input$rotate, boxplot = input$boxplot, kde = input$kde, hist = input$histogram, dots = input$dots, frame = input$frame) }) # render Abanico Plot output$main_plot <- renderPlot({ # validate(need()) makes sure that all data are available to # renderUI({}) before plotting and will wait until there validate(need(expr = input$bw, message = ''), need(expr = input$zlim, message = ''), need(expr = input$ylim, message = ''), need(expr = input$centralityNumeric, message = 'Waiting for data... Please wait!')) # plot Abanico Plot do.call(what = plot_AbanicoPlot, args = values$args) })##EndOf::renderPlot({}) observe({ # nested renderText({}) for code output on "R plot code" tab code.output <- callModule(RLumShiny:::printCode, "printCode", n_input = ifelse(!all(is.na(unlist(values$data_secondary))), 2, 1), fun = "plot_AbanicoPlot(data,", args = values$args) output$plotCode<- renderText({ code.output })##EndOf::renderText({}) callModule(RLumShiny:::exportCodeHandler, "export", code = code.output) callModule(RLumShiny:::exportPlotHandler, "export", fun = "plot_AbanicoPlot", args = values$args) }) Selected<- reactive({ input$refresh }) # renderTable() that prints the data to the second tab output$dataset<- renderDataTable( options = list(pageLength = 10, autoWidth = FALSE), callback = "function(table) { table.on('click.dt', 'tr', function() { $(this).toggleClass('selected'); Shiny.onInputChange('rows', table.rows('.selected').values$data.toArray()); }); }", { data <- values$data colnames(data[[1]])<- c("De","De error") data[[1]] })##EndOf::renterTable() # renderTable() that prints the secondary data to the second tab output$dataset2<- renderDataTable( options = list(pageLength = 10, autoWidth = FALSE), callback = "function(table) { table.on('click.dt', 'tr', function() { $(this).toggleClass('selected'); Shiny.onInputChange('rows', table.rows('.selected').values$data.toArray()); }); }", { if(!all(is.na(unlist(values$data_secondary)))) { data <- values$data colnames(data[[2]])<- c("De","De error") data[[2]] } })##EndOf::renterTable() # renderTable() to print the results of the # central age model (CAM) output$CAM<- renderDataTable( options = list(pageLength = 10, autoWidth = FALSE), { data<- values$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) RLumShiny/inst/shiny/abanico/www/0000755000176200001440000000000014175060542016477 5ustar liggesusersRLumShiny/inst/shiny/abanico/www/RL_Logo.png0000644000176200001440000007222114175060542020506 0ustar liggesusersPNG  IHDR pHYs.#.#x?v OiCCPPhotoshop ICC profilexڝSgTS=BKKoR RB&*! J!QEEȠQ, !{kּ> H3Q5 B.@ $pd!s#~<<+"x M0B\t8K@zB@F&S`cbP-`'{[! eDh;VEX0fK9-0IWfH  0Q){`##xFW<+*x<$9E[-qWW.(I+6aa@.y24x6_-"bbϫp@t~,/;m%h^ uf@Wp~<5j>{-]cK'Xto(hw?G%fIq^D$.Tʳ?D*A, `6B$BB dr`)B(Ͱ*`/@4Qhp.U=pa( Aa!ڈbX#!H$ ɈQ"K5H1RT UH=r9\F;2G1Q= C7F dt1r=6Ыhڏ>C03l0.B8, c˱" VcϱwE 6wB aAHXLXNH $4 7 Q'"K&b21XH,#/{C7$C2'ITFnR#,4H#dk9, +ȅ3![ b@qS(RjJ4e2AURݨT5ZBRQ4u9̓IKhhitݕNWGw Ljg(gwLӋT071oUX**| J&*/Tު UUT^S}FU3S ԖUPSSg;goT?~YYLOCQ_ cx,!k u5&|v*=9C3J3WRf?qtN (~))4L1e\kXHQG6EYAJ'\'GgSSݧ M=:.kDwn^Loy}/TmG X $ <5qo</QC]@Caaᄑ.ȽJtq]zۯ6iܟ4)Y3sCQ? 0k߬~OCOg#/c/Wװwa>>r><72Y_7ȷOo_C#dz%gA[z|!?:eAAA!h쐭!ΑiP~aa~ 'W?pX15wCsDDDޛg1O9-J5*>.j<74?.fYXXIlK9.*6nl {/]py.,:@LN8A*%w% yg"/6шC\*NH*Mz쑼5y$3,幄'L Lݛ:v m2=:1qB!Mggfvˬen/kY- BTZ(*geWf͉9+̳ې7ᒶKW-X潬j9(xoʿܔĹdff-[n ڴ VE/(ۻCɾUUMfeI?m]Nmq#׹=TR+Gw- 6 U#pDy  :v{vg/jBFS[b[O>zG499?rCd&ˮ/~јѡ򗓿m|x31^VwwO| (hSЧc3-gAMA|Q cHRMz%u0`:o_FiIDATx}td%! )+7ږJ["\wKIQl7YWtFuftZǙ]=8n-Ot) q\p7ab SZMM@z K[yӧO?_7n\ pw~ \i$eo .<_: @IpB^D=c,JN+߻jժ8|()ٞ /MMM#g̙d\]w5f߾}}vP2.^zTq㢯ψ˼W馛FGN#P.NȦG"suhll4(E%>F]]Q~o=6mdPcbŊZ|ب˼xaPl."o,۷o7.E˼۷… K;|XRJw}~(T_u^^矏F?mƼ|>{WkΜ9 sl瞲^O$y1qIJƍ>?qZ*/,YR߳?8F-uy۷o VOF8GrWXQIU\VZ~OVײo߾ؾ}>F$yӧW4nܸ2oΜ9U5GN? [/o .گ矏F?Uc^]]]U}G9{`]vEL:)de1!Ҭ!UVǴi?Y>K苧鍈m{N}?SJ_m[2#@%6 qw;4T>u>o_ODPVbcލ7X3_}b5502|eXV"c?9E__H6;OYO?{P+z{{cժU̙30Q>= v@$&-Y$1ߔؾ}{x~BA"1oo߾D}c.\~B^GeqHDļ\.oΊ+S Z~OϸRc^O7gժU>p۾/zNDx0c^>^oЍ7~RDz_ž>`j:s=۷/={VSOHl;|pZ*ߤn)5ɿ "٘w;=c?:tƇO,P^|@ }XpaYO-P5<6 KKf"žhf5Yr\*YsO<~j~VTHż/SZjUٟY o Mg߁}wBy/B{ｩ-Y$%Oxt T̻뮻R ۷o_l߾=nF?@Ѹ 5>ߑ"~. 1ZJjb^.(+V<`('o<{<J*b^(UV?hll4P>ܰ5"ؾϣ1H o։y@<<BБczf@by@ܻ?:7l@y@"?H41i|>6u툮m{<Oj@y@MH31 O["%UMC%U%ǃ_vU<*xT'q"νsֈ!F@G=O5#B;tX^9zNxp~۱G"Z(1( /s̳ŗlr (1|>+ /2xPb0lV>>*Aŗ^U_Gj<`H!gZ>b R KNζ=GE<Rb<\|i;!@ sŮj)5 j)PqEsܰUÑ" <(5m <8G\}'<<8/r7e!(yc-Pnb¡#⾕ y@Yy0B; [<3 T<5m]=BP1b Tmq)7^\|QL0..ln_a$H01Bo1S.yCןuuugZ 'A\}'<EګrlH71`0=?0pN^.0 "57b4B0g qascwZHpw)154qG y._y\Eb%Amk5Gfx, <1T NwY q'A x%OƧ%p[hO|o<(m[ ̾WJ7?54raA8Ẹ:r,qGmkR $QU|ܷ!!Txڣ $QU> yHyT޾ D<FḲ*<@\yT#D<Ẹ|NI%Plbm{|N35.>%raA(1y͏#1D<JṂ"Kk6 y$ָܶh\s|%1Id<*scCP涵FD_{A(91;tX15mK(|>|ԬrP @ىyʯ|Cȣ& ~.GOo*Ḅl~d8xԜm+/f *J̣,|Zj-]:7luGUp@y̓_G ^}}q Q 6WyEQWWg81asGmk2scc*8< Z yP<s25^+E23-yP|bcWw!5!JC5a>Wy#o~% ;7"@y¦o#!qJw#q[\1"sZ!D#""|8x ָܶ+cc@yDD} <m|!//涵nH1/|^^]FFH!Wy\b^8x)*IK_z)*MK'z/RU$PORU$P]!e涵u4$@FH2s`b^?KmNK'2O\p! ļ'"sZchļz$#@ y w)[b^y#ܶhb^>wܛlSq^|)"%sM;:n20ORbn[k̼l! Eļ&|30dfH1/A6=7BJ<H/1/A~p>/MK˼47RLKggxӔ)&Abb^Be^*44RLK5B]>} <ozF\=-Fk#$ <d yP涵F}@کP#)'@ !ᮻ #b^R'O!ZyP+<\|1j yP+<b1j5B!@FyP#<bԀ_7KK9W_ayNbԘ=RHK7Mhرq#@ y R__fN7D WK/RFK:# )#%̕o))#%7]b-0s)Q[H1/a]8)Q[H1/a6])_RBK#ؾm{;RBK٭o1Ba#@ y tٛh! ļ4q`a@:y 42{b~pb^BaFH>t1$P_sRfwwOt}o! ļsF۱u$Po2K0Ru$P FH)y\b^]KB ļ[0wRu$`3/sRu$`Z!\@y !\@y w˂9FHOtl۱Pļ-'63T11/CJD5گ1[({ >7Q-<(xԖsBOb^[!8'AϿ0#R{{;ޮg[?1`<:b/ z0 bg:b z{1`" c\aޥqQA zg;c ΣTvw?x`7Bc|v'/^z PǰΣԺ+>yߚ/g 1"(=Wޛn f[1\1b\Qr//|-e0#{ ( _*>TsǨym۱|m)c?01[[[o!(nz>RvwCϟ#G5 QT3N2 W߉P<06{bՃ#>J&Qt !QuXcjGI_UaYz~z od>}'?yTx\pQzb%3eldo!"BУ*=ӧܒqKfQjb%' AU۱:@U({/-Uo0WqWYuuuy%&xܖ1?wĕO3 UC̣,l<*b-7=?4-#%Qu|~i#0\bUVz[^iNJom}sdo!"|~sz{hweo뮙uuuH91' Aj F=15n̉mPo:Tp̚9/VkOeG26>t;sVA~Ջ{ڷ^\ _?]x]wѱx~\d^'NGpOE㎎˧ A%n-|q*D#xpX|q(#1074?G%rc'GkƧ%&G\2iB|wD熭Pb~UT@w5W˦z+.9H,A*ފ;59=.|#G_Uw!OЃ|+CsZq͑;;̾;V}[qQ5eԘ Ώ?Y\@ XOzUN!߽4> 2cd/*kxAT'18d:r,[PD1[`H3NrGo<`XuŲw(@x]ns-<`zJe0j__;36u툮m{\@y?" b-qQQJMø>OJgEt\%~U1Y-<=(y@Ųc>tLJ!߽4?eQol2g}.fdIH|wMo 0LbP13N6T̡#Ǣ!`D__Ƌ/|*E}@y@xx sLݟ.^"%/uԵCȣ\6 *|u_}'"A-ChinY3gbn+CE߱g#O?/C V~((KHN};o~X?N>q|S&A?547 O^}}7ힾ#ⷱO?k&A]U岙fCT W?ypБc)yRmvGAlԣT1RБcwtblCT1R辕ʣ\6 y2;7Cjok=)ӹa< e37UJ̃ٸQ#PP.E)kWy iFbbĦB岙fCT91Rŗ^m{ AA-͍1cdCT91R`W*rLܾd!j d8x'M0@  WyfFy`޾S&ئ1b$u]QP.yP?yUCjokuPc]e-͍1k C$5fW*rLܾd!J̃d8x'M0@ByPC֮*rLq!L̃q1Wy iꔉq `bԈ6ʣ\6K7@‰yP9}' AAW]1-61@‰yP\1\6 m{ f͜a"B̃ԵU岙x )bTHRKscL4"A]U岙}C bT3>5M2U!A|iFWyfb5<(CGEo CP)clCbu]QP.ws!8#1hR{[k3:7luGAl&2f<({rLܺ`N<(|>*aΕF`HbB岙XnJ̃ѵm!(1f͜aJ̃[oʣ\6/Y`Ẽ?~21C5s( 1F`SWyfw,6%#0?*!47I @Ɉy0LkoqGAl&n_̳ŁG AASLt@ɉy0 _ZU岙Xx!(91Бcw4u4gzfWyf]\hB̃!ܻUCjok_:CPb sVWyf"3o!(1 عw((ĭ D}}1(1 ϻns(+1`S!rLt,j7e'ڶf0e'7\QP.ۗ,0!iZc "<8[\Q<*M̃9t䘫<4uDWyTzfWyfb<^0]uŴ4T*岙6TGܻUCjokzCPqb׹a< e37T1Tζ=F\6]P5<4k #Xb5cS! m{ f͜aRỊl*rLq!H-1<3M6%Q5֮*rLܾd!H51d8x4uĘwY4Z#i<*bS!rLt,j7Gڶf0G=oʣ\6/Y`81?~2vuZc 3(뷸ʣ Wy0419tX8x4uDWy01Yn< e3t|C<Бcw4u401pPrLܙpb%s~Wy 5 g!Qrʣ\6y  QRٶfcQ<&1G]1Y3gỊd6u(h*>1[*FḤ$V~((KFḤZc (뷸ʣ\6wtl1:t䘫<4uĸhQ(6ʣ\6K7G:r,zNZclC(y}+rGAl&2f΁GQܻ 5 @̣(:7luGAl&C98g7?j e3ѱ=HڶUC5s<ɦB岙fC@yZѵm!(1fLl(1Q[~< e3q"'Ƙ:7luǐn5M2UGA_ZU岙Xx!<Бcw4u4PFbgzfWyf-2x{cHmQ__o(31ܰU岙̛m1Wζ=F\6.**D|>o~UCaΕF 8eS!rLt,j7TGD*# 1f͜a 1Xoʣ\6/Y`01?~2 []1_k!b^Bm!QP.E#%P>m{ f͜a1b^=oʣ\6c!y d147I 5HK뷸ʣ\6/Y`Qb^m{\1Y3gR@̫rvyfΎ )!U_z9147ƌi>B̫b-Wyf% )"U'Ƙm{ f͜aH91 |UÑQe3ѱ$aL>=VX/Af0jժhjj5ƨBbB.ۗ,0c}vcT1F1&O`?.\mmmk*  m'N+VD>7Hy0BSLt@*Z*~~/1*D̃e3t|C}?~|<(31F+ئ1 ꫯx R&b S.m ٷo_455Ŋ+Qb S{[k`ժUQWW۷o7F y0 l&2fb…1~8|1J@̃e3ѱU SL>=r+21aFzG)>cCF{<"`-͍c…΁䲙}C@۷/O+Vyz A-͍1yC@ Z*sM1F@̃3e3e %}ypSLMc epdb󴵞qP٪z*Su+4^)RkߥЉtB&!dfD1cV0dd/0ɽM$>>>zm>|36cuu5v\\\h'#7+rt4#<@x ,C3jZk{<֭[1ݻggg0k>|Ƞpj5v ̃xT*idXӉR~{4D^Z'''Z0k>| f<z4HMȨ5ATx"k-M&I^pߏz7w&kMВ$n[[[\0I4cmm-Wrv;...r.atbyy97y>Z~!q܌o.yp8h W0Bt:Q*{05 (ͨjq||Zyxɓ(J3U0>^GVL#KX__v=yz<Nj5^쾘[ <4MG?<$I(AT*!K>ߍhsEj<og%/M8< ]qxx+++~On`a%I^/Aa jnF*̚y,Vxpk73iZa{  Ӓ$n[㴟-UĹx3i4JE3>  3$pXxqLz1y0W;;;1LŻl4Mw v0SIQ A5 nFЌ+ qV+ϣlh7XRDLiK4ceeE3<.Iz1 yS$`vh4-͘2aSj4ok"iښfܰ<`p-IDuvvvvślF{{{QT4cvJ?}'W$ph.ޜ9f /1yqW""ZVL&h41?4~o.^9f @Dwtt@ :E[L>y煋0 L|10?f@|v]k /\9f ōui]ug@nΕ7l`|?\+o+OvVՃ}UV:Ws-7m+Ov}sVJ!cSY+rfjY9@L5/+g@X@7rDypcXyQ  n<,l&4nȉnb[z,D]z,[X{dIXxs{Zf/s6ٙIENDB`RLumShiny/inst/shiny/abanico/www/style.css0000644000176200001440000000242714175060542020356 0ustar liggesusers.custom-modal { padding-left: 10px; padding-top: 10px; padding-bottom: 10px; padding-right: 10px; line-height: 200%; background-color: #fff; overflow: visible; position: absolute; z-index: 999; border-radius: 10px; border-style: solid; border-color: #428bca; } .h { font-size: 11px; margin: 0 0 0px; } h5, h6 { color: #428bca; } .tooltip-inner { max-width: 450px; } .control-label, .selectize-dropdown, .item, .btn, .uneditable-input, .sorting, .odd, .even, .dataTables-info, .fa, .fa-refresh { font-size: 12px; } .selectize-input { padding: 0px 10px; min-height: 20px; } label, body, input { font-size: 12px; } .label, .badge { font-size: 12px; padding: 4px 20px; margin: 10px; line-height: 18px; } .label-info, .badge-info { background-color: #428bca; } input[type="text"],input[type="number"],input[type="email"],input[type="url"],input[type="search"],input[type="tel"],input[type="color"],.uneditable-input{ display:inline-block; height:18px; padding:0px 0px 0px 7px; margin-bottom:10px; font-size: 11px; line-height: 1.5; color:#555; vertical-align:middle; -webkit-border-radius:4px; -moz-border-radius:4px; border-radius:4px } input,textarea,.uneditable-input{ width: auto; } RLumShiny/inst/shiny/abanico/www/GitHub-Mark-32px.png0000644000176200001440000000326214175060542022054 0ustar liggesusersPNG  IHDR szztEXtSoftwareAdobe ImageReadyqe<$iTXtXML:com.adobe.xmp $IDATxėmhayL30A+R#f>IHکy(M)_o5 0+0Ėl&o{i^]u<{Yws}=uC>$L, }<w}8^ AO?p! xaяPKI3`'B>0QT1<+`}^nvkp^ƅF|1"Gp.*oO׀Vp ]߅jc8K$q 8jV`#`vmpGѢu!#}#:U_?_yhE $=;c*xNOo+&w)%K-R%6n'o">j/t³qoGW7j%2q GX?woibCÐAzbǰt \14|S.DZ]# b|H$(ʕohmqͱRP셣$,0Z20 tNvRW3K8Xk2 IO6 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("fas fa-sync")), 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."), helpText(tags$b("NOTE:"), tags$a( href = "https://github.com/R-Lum/Luminescence/issues/50", target = "_blank", HTML("The statistical parameters are calculated on the logged DE values", "if log.z = TRUE (the default, see 'Axis' > 'Logarithmic z-axis').") )), 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 De-errors as error bars on De-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("
2σ bar
")), 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
"), 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
"), 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
"), 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
"),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
"),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
"),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
"),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
"),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
"),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
"),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("
2σ bar
")), 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 values to the list object.") ), RLumShiny:::exportTab("export", filename = "abanico plot"), RLumShiny:::aboutTab("about", "abanico") )##EndOf::tabsetPanel ),##EndOf::sidebarPanel # 3 - output panel mainPanel(width = 7, # insert css code inside 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 } RLumShiny/inst/shiny/histogram/0000755000176200001440000000000014175060542016254 5ustar liggesusersRLumShiny/inst/shiny/histogram/Global.R0000644000176200001440000000036214175060542017600 0ustar liggesusers## 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")RLumShiny/inst/shiny/histogram/server.R0000644000176200001440000001323014175060542017704 0ustar liggesusers## Server.R ## MAIN FUNCTION function(input, output, session) { # input data (with default) values <- reactiveValues(data = if ("startData" %in% names(.GlobalEnv)) startData else ExampleData.DeValues$CA1, args = NULL) session$onSessionEnded(function() { stopApp() }) # check and read in file (DATA SET 1) observeEvent(input$file1, { inFile<- input$file1 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 }) # dynamically inject sliderInput for x-axis range output$xlim<- renderUI({ # check if file is loaded # # case 1: yes -> slinderInput with custom values 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) })## 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) }) observe({ # make sure that input panels are registered on non-active tabs. # by default tabs are suspended and input variables are hence # not available outputOptions(x = output, name = "xlim", suspendWhenHidden = FALSE) # color of plor elements pch.color <- ifelse(input$pchColor == "custom", input$pchRgb, input$pchColor) bars.color <- ifelse(input$barsColor == "custom", adjustcolor(col = input$barsRgb, alpha.f = input$alpha.bars/100), adjustcolor(col = input$barsColor, alpha.f = input$alpha.bars/100)) rugs.color <- ifelse(input$rugsColor == "custom", input$rugsRgb, input$rugsColor) normal.color <- ifelse(input$normalColor == "custom", input$normalRgb, input$normalColor) colors<- c(bars.color, rugs.color, normal.color, pch.color) values$args <- list( data = values$data, na.rm = TRUE, cex.global = input$cex, pch = ifelse(input$pch == "custom", input$custompch, as.integer(input$pch) - 1), xlim = input$xlim, summary.pos = input$sumpos, mtext = input$mtext, main = input$main, rug = input$rugs, se = input$errorBars, normal_curve = input$norm, summary = if (input$summary) input$stats else NA, xlab = input$xlab, ylab = c(input$ylab1, input$ylab2), colour = colors) }) output$main_plot <- renderPlot({ validate(need(input$xlim, "Just wait a second...")) do.call(plot_Histogram, args = values$args) })##EndOf::renderPlot({}) observe({ # nested renderText({}) for code output on "R plot code" tab code.output <- callModule(RLumShiny:::printCode, "printCode", n_input = 1, fun = "plot_Histogram(data,", args = values$args) output$plotCode<- renderText({ code.output })##EndOf::renderText({}) callModule(RLumShiny:::exportCodeHandler, "export", code = code.output) callModule(RLumShiny:::exportPlotHandler, "export", fun = "plot_Histogram", args = values$args) }) # renderTable() that prints the data to the second tab output$dataset<- renderDataTable( options = list(pageLength = 10, autoWidth = FALSE), callback = "function(table) { table.on('click.dt', 'tr', function() { $(this).toggleClass('selected'); Shiny.onInputChange('rows', table.rows('.selected').data().toArray()); }); }", { setNames(values$data, c("De", "De error")) })##EndOf::renterTable() # reactive function for gVis plots that allow for dynamic input! myOptionsCAM<- reactive({ options<- list( page="enable", width="500px", sort="disable") return(options) }) # renderTable() to print the results of the # central age model (CAM) output$CAM<- renderDataTable( options = list(pageLength = 10, autoWidth = FALSE), { 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)RLumShiny/inst/shiny/histogram/www/0000755000176200001440000000000014175060542017100 5ustar liggesusersRLumShiny/inst/shiny/histogram/www/RL_Logo.png0000644000176200001440000007222114175060542021107 0ustar liggesusersPNG  IHDR pHYs.#.#x?v OiCCPPhotoshop ICC profilexڝSgTS=BKKoR RB&*! J!QEEȠQ, !{kּ> H3Q5 B.@ $pd!s#~<<+"x M0B\t8K@zB@F&S`cbP-`'{[! eDh;VEX0fK9-0IWfH  0Q){`##xFW<+*x<$9E[-qWW.(I+6aa@.y24x6_-"bbϫp@t~,/;m%h^ uf@Wp~<5j>{-]cK'Xto(hw?G%fIq^D$.Tʳ?D*A, `6B$BB dr`)B(Ͱ*`/@4Qhp.U=pa( Aa!ڈbX#!H$ ɈQ"K5H1RT UH=r9\F;2G1Q= C7F dt1r=6Ыhڏ>C03l0.B8, c˱" VcϱwE 6wB aAHXLXNH $4 7 Q'"K&b21XH,#/{C7$C2'ITFnR#,4H#dk9, +ȅ3![ b@qS(RjJ4e2AURݨT5ZBRQ4u9̓IKhhitݕNWGw Ljg(gwLӋT071oUX**| J&*/Tު UUT^S}FU3S ԖUPSSg;goT?~YYLOCQ_ cx,!k u5&|v*=9C3J3WRf?qtN (~))4L1e\kXHQG6EYAJ'\'GgSSݧ M=:.kDwn^Loy}/TmG X $ <5qo</QC]@Caaᄑ.ȽJtq]zۯ6iܟ4)Y3sCQ? 0k߬~OCOg#/c/Wװwa>>r><72Y_7ȷOo_C#dz%gA[z|!?:eAAA!h쐭!ΑiP~aa~ 'W?pX15wCsDDDޛg1O9-J5*>.j<74?.fYXXIlK9.*6nl {/]py.,:@LN8A*%w% yg"/6шC\*NH*Mz쑼5y$3,幄'L Lݛ:v m2=:1qB!Mggfvˬen/kY- BTZ(*geWf͉9+̳ې7ᒶKW-X潬j9(xoʿܔĹdff-[n ڴ VE/(ۻCɾUUMfeI?m]Nmq#׹=TR+Gw- 6 U#pDy  :v{vg/jBFS[b[O>zG499?rCd&ˮ/~јѡ򗓿m|x31^VwwO| (hSЧc3-gAMA|Q cHRMz%u0`:o_FiIDATx}td%! )+7ږJ["\wKIQl7YWtFuftZǙ]=8n-Ot) q\p7ab SZMM@z K[yӧO?_7n\ pw~ \i$eo .<_: @IpB^D=c,JN+߻jժ8|()ٞ /MMM#g̙d\]w5f߾}}vP2.^zTq㢯ψ˼W馛FGN#P.NȦG"suhll4(E%>F]]Q~o=6mdPcbŊZ|ب˼xaPl."o,۷o7.E˼۷… K;|XRJw}~(T_u^^矏F?mƼ|>{WkΜ9 sl瞲^O$y1qIJƍ>?qZ*/,YR߳?8F-uy۷o VOF8GrWXQIU\VZ~OVײo߾ؾ}>F$yӧW4nܸ2oΜ9U5GN? [/o .گ矏F?Uc^]]]U}G9{`]vEL:)de1!Ҭ!UVǴi?Y>K苧鍈m{N}?SJ_m[2#@%6 qw;4T>u>o_ODPVbcލ7X3_}b5502|eXV"c?9E__H6;OYO?{P+z{{cժU̙30Q>= v@$&-Y$1ߔؾ}{x~BA"1oo߾D}c.\~B^GeqHDļ\.oΊ+S Z~OϸRc^O7gժU>p۾/zNDx0c^>^oЍ7~RDz_ž>`j:s=۷/={VSOHl;|pZ*ߤn)5ɿ "٘w;=c?:tƇO,P^|@ }XpaYO-P5<6 KKf"žhf5Yr\*YsO<~j~VTHż/SZjUٟY o Mg߁}wBy/B{ｩ-Y$%Oxt T̻뮻R ۷o_l߾=nF?@Ѹ 5>ߑ"~. 1ZJjb^.(+V<`('o<{<J*b^(UV?hll4P>ܰ5"ؾϣ1H o։y@<<BБczf@by@ܻ?:7l@y@"?H41i|>6u툮m{<Oj@y@MH31 O["%UMC%U%ǃ_vU<*xT'q"νsֈ!F@G=O5#B;tX^9zNxp~۱G"Z(1( /s̳ŗlr (1|>+ /2xPb0lV>>*Aŗ^U_Gj<`H!gZ>b R KNζ=GE<Rb<\|i;!@ sŮj)5 j)PqEsܰUÑ" <(5m <8G\}'<<8/r7e!(yc-Pnb¡#⾕ y@Yy0B; [<3 T<5m]=BP1b Tmq)7^\|QL0..ln_a$H01Bo1S.yCןuuugZ 'A\}'<EګrlH71`0=?0pN^.0 "57b4B0g qascwZHpw)154qG y._y\Eb%Amk5Gfx, <1T NwY q'A x%OƧ%p[hO|o<(m[ ̾WJ7?54raA8Ẹ:r,qGmkR $QU|ܷ!!Txڣ $QU> yHyT޾ D<FḲ*<@\yT#D<Ẹ|NI%Plbm{|N35.>%raA(1y͏#1D<JṂ"Kk6 y$ָܶh\s|%1Id<*scCP涵FD_{A(91;tX15mK(|>|ԬrP @ىyʯ|Cȣ& ~.GOo*Ḅl~d8xԜm+/f *J̣,|Zj-]:7luGUp@y̓_G ^}}q Q 6WyEQWWg81asGmk2scc*8< Z yP<s25^+E23-yP|bcWw!5!JC5a>Wy#o~% ;7"@y¦o#!qJw#q[\1"sZ!D#""|8x ָܶ+cc@yDD} <m|!//涵nH1/|^^]FFH!Wy\b^8x)*IK_z)*MK'z/RU$PORU$P]!e涵u4$@FH2s`b^?KmNK'2O\p! ļ'"sZchļz$#@ y w)[b^y#ܶhb^>wܛlSq^|)"%sM;:n20ORbn[k̼l! Eļ&|30dfH1/A6=7BJ<H/1/A~p>/MK˼47RLKggxӔ)&Abb^Be^*44RLK5B]>} <ozF\=-Fk#$ <d yP涵F}@کP#)'@ !ᮻ #b^R'O!ZyP+<\|1j yP+<b1j5B!@FyP#<bԀ_7KK9W_ayNbԘ=RHK7Mhرq#@ y R__fN7D WK/RFK:# )#%̕o))#%7]b-0s)Q[H1/a]8)Q[H1/a6])_RBK#ؾm{;RBK٭o1Ba#@ y tٛh! ļ4q`a@:y 42{b~pb^BaFH>t1$P_sRfwwOt}o! ļsF۱u$Po2K0Ru$P FH)y\b^]KB ļ[0wRu$`3/sRu$`Z!\@y !\@y w˂9FHOtl۱Pļ-'63T11/CJD5گ1[({ >7Q-<(xԖsBOb^[!8'AϿ0#R{{;ޮg[?1`<:b/ z0 bg:b z{1`" c\aޥqQA zg;c ΣTvw?x`7Bc|v'/^z PǰΣԺ+>yߚ/g 1"(=Wޛn f[1\1b\Qr//|-e0#{ ( _*>TsǨym۱|m)c?01[[[o!(nz>RvwCϟ#G5 QT3N2 W߉P<06{bՃ#>J&Qt !QuXcjGI_UaYz~z od>}'?yTx\pQzb%3eldo!"BУ*=ӧܒqKfQjb%' AU۱:@U({/-Uo0WqWYuuuy%&xܖ1?wĕO3 UC̣,l<*b-7=?4-#%Qu|~i#0\bUVz[^iNJom}sdo!"|~sz{hweo뮙uuuH91' Aj F=15n̉mPo:Tp̚9/VkOeG26>t;sVA~Ջ{ڷ^\ _?]x]wѱx~\d^'NGpOE㎎˧ A%n-|q*D#xpX|q(#1074?G%rc'GkƧ%&G\2iB|wD熭Pb~UT@w5W˦z+.9H,A*ފ;59=.|#G_Uw!OЃ|+CsZq͑;;̾;V}[qQ5eԘ Ώ?Y\@ XOzUN!߽4> 2cd/*kxAT'18d:r,[PD1[`H3NrGo<`XuŲw(@x]ns-<`zJe0j__;36u툮m{\@y?" b-qQQJMø>OJgEt\%~U1Y-<=(y@Ųc>tLJ!߽4?eQol2g}.fdIH|wMo 0LbP13N6T̡#Ǣ!`D__Ƌ/|*E}@y@xx sLݟ.^"%/uԵCȣ\6 *|u_}'"A-ChinY3gbn+CE߱g#O?/C V~((KHN};o~X?N>q|S&A?547 O^}}7ힾ#ⷱO?k&A]U岙fCT W?ypБc)yRmvGAlԣT1RБcwtblCT1R辕ʣ\6 y2;7Cjok=)ӹa< e37UJ̃ٸQ#PP.E)kWy iFbbĦB岙fCT91Rŗ^m{ AA-͍1cdCT91R`W*rLܾd!j d8x'M0@  WyfFy`޾S&ئ1b$u]QP.yP?yUCjokuPc]e-͍1k C$5fW*rLܾd!J̃d8x'M0@ByPC֮*rLq!L̃q1Wy iꔉq `bԈ6ʣ\6K7@‰yP9}' AAW]1-61@‰yP\1\6 m{ f͜a"B̃ԵU岙x )bTHRKscL4"A]U岙}C bT3>5M2U!A|iFWyfb5<(CGEo CP)clCbu]QP.ws!8#1hR{[k3:7luGAl&2f<({rLܺ`N<(|>*aΕF`HbB岙XnJ̃ѵm!(1f͜aJ̃[oʣ\6/Y`Ẽ?~21C5s( 1F`SWyfw,6%#0?*!47I @Ɉy0LkoqGAl&n_̳ŁG AASLt@ɉy0 _ZU岙Xx!(91Бcw4u4gzfWyf]\hB̃!ܻUCjok_:CPb sVWyf"3o!(1 عw((ĭ D}}1(1 ϻns(+1`S!rLt,j7e'ڶf0e'7\QP.ۗ,0!iZc "<8[\Q<*M̃9t䘫<4uDWyTzfWyfb<^0]uŴ4T*岙6TGܻUCjokzCPqb׹a< e37T1Tζ=F\6]P5<4k #Xb5cS! m{ f͜aRỊl*rLq!H-1<3M6%Q5֮*rLܾd!H51d8x4uĘwY4Z#i<*bS!rLt,j7Gڶf0G=oʣ\6/Y`81?~2vuZc 3(뷸ʣ Wy0419tX8x4uDWy01Yn< e3t|C<Бcw4u401pPrLܙpb%s~Wy 5 g!Qrʣ\6y  QRٶfcQ<&1G]1Y3gỊd6u(h*>1[*FḤ$V~((KFḤZc (뷸ʣ\6wtl1:t䘫<4uĸhQ(6ʣ\6K7G:r,zNZclC(y}+rGAl&2f΁GQܻ 5 @̣(:7luGAl&C98g7?j e3ѱ=HڶUC5s<ɦB岙fC@yZѵm!(1fLl(1Q[~< e3q"'Ƙ:7luǐn5M2UGA_ZU岙Xx!<Бcw4u4PFbgzfWyf-2x{cHmQ__o(31ܰU岙̛m1Wζ=F\6.**D|>o~UCaΕF 8eS!rLt,j7TGD*# 1f͜a 1Xoʣ\6/Y`01?~2 []1_k!b^Bm!QP.E#%P>m{ f͜a1b^=oʣ\6c!y d147I 5HK뷸ʣ\6/Y`Qb^m{\1Y3gR@̫rvyfΎ )!U_z9147ƌi>B̫b-Wyf% )"U'Ƙm{ f͜aH91 |UÑQe3ѱ$aL>=VX/Af0jժhjj5ƨBbB.ۗ,0c}vcT1F1&O`?.\mmmk*  m'N+VD>7Hy0BSLt@*Z*~~/1*D̃e3t|C}?~|<(31F+ئ1 ꫯx R&b S.m ٷo_455Ŋ+Qb S{[k`ժUQWW۷o7F y0 l&2fb…1~8|1J@̃e3ѱU SL>=r+21aFzG)>cCF{<"`-͍c…΁䲙}C@۷/O+Vyz A-͍1yC@ Z*sM1F@̃3e3e %}ypSLMc epdb󴵞qP٪z*Su+4^)RkߥЉtB&!dfD1cV0dd/0ɽM$>>>zm>|36cuu5v\\\h'#7+rt4#<@x ,C3jZk{<֭[1ݻggg0k>|Ƞpj5v ̃xT*idXӉR~{4D^Z'''Z0k>| f<z4HMȨ5ATx"k-M&I^pߏz7w&kMВ$n[[[\0I4cmm-Wrv;...r.atbyy97y>Z~!q܌o.yp8h W0Bt:Q*{05 (ͨjq||Zyxɓ(J3U0>^GVL#KX__v=yz<Nj5^쾘[ <4MG?<$I(AT*!K>ߍhsEj<og%/M8< ]qxx+++~On`a%I^/Aa jnF*̚y,Vxpk73iZa{  Ӓ$n[㴟-UĹx3i4JE3>  3$pXxqLz1y0W;;;1LŻl4Mw v0SIQ A5 nFЌ+ qV+ϣlh7XRDLiK4ceeE3<.Iz1 yS$`vh4-͘2aSj4ok"iښfܰ<`p-IDuvvvvślF{{{QT4cvJ?}'W$ph.ޜ9f /1yqW""ZVL&h41?4~o.^9f @Dwtt@ :E[L>y煋0 L|10?f@|v]k /\9f ōui]ug@nΕ7l`|?\+o+OvVՃ}UV:Ws-7m+Ov}sVJ!cSY+rfjY9@L5/+g@X@7rDypcXyQ  n<,l&4nȉnb[z,D]z,[X{dIXxs{Zf/s6ٙIENDB`RLumShiny/inst/shiny/histogram/www/style.css0000644000176200001440000000242714175060542020757 0ustar liggesusers.custom-modal { padding-left: 10px; padding-top: 10px; padding-bottom: 10px; padding-right: 10px; line-height: 200%; background-color: #fff; overflow: visible; position: absolute; z-index: 999; border-radius: 10px; border-style: solid; border-color: #428bca; } .h { font-size: 11px; margin: 0 0 0px; } h5, h6 { color: #428bca; } .tooltip-inner { max-width: 450px; } .control-label, .selectize-dropdown, .item, .btn, .uneditable-input, .sorting, .odd, .even, .dataTables-info, .fa, .fa-refresh { font-size: 12px; } .selectize-input { padding: 0px 10px; min-height: 20px; } label, body, input { font-size: 12px; } .label, .badge { font-size: 12px; padding: 4px 20px; margin: 10px; line-height: 18px; } .label-info, .badge-info { background-color: #428bca; } input[type="text"],input[type="number"],input[type="email"],input[type="url"],input[type="search"],input[type="tel"],input[type="color"],.uneditable-input{ display:inline-block; height:18px; padding:0px 0px 0px 7px; margin-bottom:10px; font-size: 11px; line-height: 1.5; color:#555; vertical-align:middle; -webkit-border-radius:4px; -moz-border-radius:4px; border-radius:4px } input,textarea,.uneditable-input{ width: auto; } RLumShiny/inst/shiny/histogram/www/GitHub-Mark-32px.png0000644000176200001440000000326214175060542022455 0ustar liggesusersPNG  IHDR szztEXtSoftwareAdobe ImageReadyqe<$iTXtXML:com.adobe.xmp $IDATxėmhayL30A+R#f>IHکy(M)_o5 0+0Ėl&o{i^]u<{Yws}=uC>$L, }<w}8^ AO?p! xaяPKI3`'B>0QT1<+`}^nvkp^ƅF|1"Gp.*oO׀Vp ]߅jc8K$q 8jV`#`vmpGѢu!#}#:U_?_yhE $=;c*xNOo+&w)%K-R%6n'o">j/t³qoGW7j%2q GX?woibCÐAzbǰt \14|S.DZ]# b|H$(ʕohmqͱRP셣$,0Z20 tNvRW3K8Xk2 IO6 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 } RLumShiny/inst/shiny/RCarb/0000755000176200001440000000000014175252574015260 5ustar liggesusersRLumShiny/inst/shiny/RCarb/global.R0000644000176200001440000000130514175060542016632 0ustar liggesusers## +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ## Title: RCarb Shiny App - global.R ## Authors: Sebastian Kreutzer, IRAMAT-CRP2A, Université Bordeaux Montaigne (France) ## Contact: sebastian.kreutzer@u-bordeaux-montainge.fr ## Initial date: 2018-10-14 ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ##load needed packages require(shiny) require(RCarb) require(rhandsontable) require(knitr) ##Shiny settings ## ##increase upload size options(shiny.maxRequestSize = 30 * 1024 ^ 2) ##RCarb ## ##load reference and example data data("Example_Data") data("Reference_Data") temp_files <<- NULL RLumShiny/inst/shiny/RCarb/server.R0000644000176200001440000001604614175060542016710 0ustar liggesusers## +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ## Title: RCarb Shiny App ## Authors: Sebastian Kreutzer, IRAMAT-CRP2A, Université Bordeaux Montaigne (France) ## Contact: sebastian.kreutzer@u-bordeaux-montainge.fr ## Initial date: 2018-10-14 ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ shinyServer(function(input, output, session) { # Initialisation ------------------------------------------------------------------------------ ##we run RCarb one time and create the table we need df <- RCarb::model_DoseRate(data = Example_Data[1,], n.MC = NULL, plot = FALSE, verbose = FALSE) df <- df[-1,] ##make table reactive values <- reactiveValues( df = df ) ##render table output$df <- renderRHandsontable({ rhandsontable( data = values$df,debug = TRUE, selectCallback = TRUE, readOnly = FALSE, customOpts = list( csv = list(name = "Download to CSV", callback = htmlwidgets::JS( "function (key, options) { var csv = csvString(this, sep=',', dec='.'); var link = document.createElement('a'); link.setAttribute('href', 'data:text/plain;charset=utf-8,' + encodeURIComponent(csv)); link.setAttribute('download', 'data.csv'); document.body.appendChild(link); link.click(); document.body.removeChild(link); }")))) %>% hot_table(highlightCol = TRUE, highlightRow = TRUE, allowRowEdit = TRUE) }) #feedback changes in the table observe({ if (!is.null(input$df)) { values$df <- hot_to_r(input$df) } }) # Load example data --------------------------------------------------------------------------- observeEvent(input$load_example, { m <- matrix(NA, nrow = 2, ncol = length(colnames(values$df)) - ncol(Example_Data)) temp <- cbind(Example_Data[c(1,14),], as.data.frame(m, stringsAsFactors = FALSE)) colnames(temp) <- colnames(values$df) values$df <- temp }) # # # File import --------------------------------------------------------------------------------- observeEvent(input$load_file, { ##check whether this is empty if(is.null(input$file$datapath)){ return(NULL) } ##import temp <- read.table( file = input$file$datapath, header = as.logical(input$import_header), sep = input$import_sep) ##check input if (ncol(Example_Data) != ncol(temp) && !all(colnames(Example_Data) == colnames(temp))) { showModal(modalDialog( title = "Important message", "Your input CSV-file does not appear to be correctly formated! Please try again or use the input template!", easyClose = TRUE )) return(NULL) } ##limit to the first columns m <- matrix(NA, nrow = nrow(temp), ncol = length(colnames(values$df)) - ncol(Example_Data)) temp <- cbind(temp[,1:29], as.data.frame(m, stringsAsFactors = FALSE)) colnames(temp) <- colnames(values$df) ##write into table values$df <- temp }) # Calculation --------------------------------------------------------------------------------- observeEvent(input$run_calculation, { ##check input and return null if needed if(nrow(values$df) == 0){ message("Input data has 0 rows, nothing was done!") return(NULL) } ##get temp dir temp_dir <- tempdir() ##run with progressbar withProgress( message = "Running calculations ...", min = 0, max = nrow(values$df), { ##run calculation and create plots for(i in 1:nrow(values$df)){ incProgress(i) temp_files[[i]] <<- paste0(temp_dir,"/SAMPLE_",i,".png") png(file = temp_files[[i]], bg = "transparent", width = 800, height = 400, res = 100) values$df[i,] <- RCarb::model_DoseRate( data = values$df[i,1:29], DR_conv_factors = input$conversion_factors, length_step = input$length_step, max_time = input$max_time, n.MC = input$n.MC, verbose = TRUE, plot = TRUE, mfrow = c(1,2) ) dev.off() } })#end progressbar ##show first plot output$plot <- renderImage({ ##grep correct aliquot temp_aliquot <- paste0("SAMPLE_1.png") ##set filename filename <- temp_files[[grep(pattern = temp_aliquot, x = temp_files,fixed = TRUE)]] #Return a list containing the filename and alt text list(src = filename, alt = paste("Image number", temp_aliquot)) }, deleteFile = FALSE) }) # Graphical output ---------------------------------------------------------------------------- observeEvent(input$df_select, { if(is.null(temp_files)) return(NULL) ##grep correct aliquot temp_aliquot <- paste0("SAMPLE_",input$df_select$select$r,".png") ##return NULL if it does not exist if(length(grep(pattern = temp_aliquot, x = temp_files,fixed = TRUE)) == 0) return(NULL) ##render image output$plot <- renderImage({ ##set filename filename <- temp_files[[grep(pattern = temp_aliquot, x = temp_files, fixed = TRUE)]] #Return a list containing the filename and alt text list(src = filename, alt = paste("Image number", temp_aliquot)) }, deleteFile = FALSE) }) # Download for template ----------------------------------------------------------------------- output$download_template <- downloadHandler( filename = "RCarb_InputTemplate.csv", content = function(file){ ##use the internal function from RCarb RCarb::write_InputTemplate(file = file) }, contentType = "text/csv" ) # Render static pages ------------------------------------------------------------------------- output$about <- renderUI({ HTML(markdown::markdownToHTML(knit('static/about.Rmd', quiet = TRUE, output = tempfile()), fragment.only = TRUE)) }) output$news <- renderUI({ HTML(markdown::markdownToHTML(knit('static/news.Rmd', quiet = TRUE, output = tempfile()), fragment.only = TRUE)) }) })#EOF RLumShiny/inst/shiny/RCarb/ui.R0000644000176200001440000001042214175060542016007 0ustar liggesusers## +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ## Title: RCarb Shiny App -ui.R ## Authors: Sebastian Kreutzer, IRAMAT-CRP2A, Université Bordeaux Montaigne (France) ## Contact: sebastian.kreutzer@u-bordeaux-montainge.fr ## Initial date: 2018-10-14 ##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ shinyUI( navbarPage( title = HTML(paste0("RCarb App")), windowTitle = "RCarb App", footer = HTML( "
This software comes WITHOUT ANY WARRANTY.
"), # # # PANEL - Analysis----------------------------------------------------------------------------- tabPanel(title = "Import - Analysis", sidebarLayout( sidebarPanel( tabsetPanel( tabPanel(title = "Import data", br(), fileInput("file", accept = "*.csv", label = "Select CSV-file with your data ...", multiple = FALSE), div( radioButtons("import_header", label = "1st row is column header?", choiceNames = c("yes", "no"), choiceValues = list(TRUE, FALSE), inline = TRUE), selectInput("import_sep", label = "Column separator", choices = c(",",";","&","$")), actionButton("load_file", label = "Load from file ...", icon("import", lib = "glyphicon"), style="color: #fff; background-color: #337ab7; border-color: #2e6da4"), actionButton("load_example", label = "Load example data"), align = 'center') ), tabPanel(title = "Run calculation", fluidRow( column(6, selectInput("conversion_factors", label = "Dose rate converison factors", choices = Reference_Data$DR_conv_factors$REFERENCE), numericInput( inputId = "length_step", label = "Step length", value = 1, min = 1, max = 100, width = "100%"), numericInput( inputId = "max_time", label = "Max. time", value = 500, min = 1, max = 500, width = "100%") ), column(6, numericInput( inputId = "n.MC", label = "MC runs", value = 100, min = 1, max = 10000, width = "100%") ) ), div( actionButton("run_calculation", label = "Run calculation", icon = icon("play-circle"), style="color: #fff; background-color: #337ab7; border-color: #2e6da4" ), align = "center") ),##tabPanel tabPanel( title = "Input template", br(), div( downloadButton("download_template",label = "Download input CSV-file template", icon = icon("download")), align = "center" ) ) )##end TabsetPanel ),##end sidebarPanel mainPanel( rHandsontableOutput("df", height = "250px"), div(align = "center", plotOutput(outputId = "plot") ) )##mainPanel ),##sidebarLayout icon = icon("dashboard", lib = "glyphicon") ),##tabPanel # # # PANEL - News ------------------------------------------------------------------------------ tabPanel("News", fluidRow( column(10, offset = 1, uiOutput('news') ) ),icon = icon("list-alt", lib = "glyphicon") ),#news # PANEL - About ------------------------------------------------------------------------------ tabPanel("About", fluidRow( column(10, offset = 1, uiOutput('about') ) ),icon = icon("info-sign", lib = "glyphicon") )#About )##navbarPage )##EOF RLumShiny/inst/shiny/radialplot/0000755000176200001440000000000014175060542016412 5ustar liggesusersRLumShiny/inst/shiny/radialplot/Global.R0000644000176200001440000000032014175060542017730 0ustar liggesusers## global.R ## library(Luminescence) library(RLumShiny) library(shiny) library(data.table) library(rhandsontable) # load example data data(ExampleData.DeValues) enableBookmarking(store = "server")RLumShiny/inst/shiny/radialplot/server.R0000644000176200001440000003023314175060542020044 0ustar liggesusers## Server.R ## MAIN FUNCTION function(input, output, session) { # input data (with default) values <- reactiveValues(data_primary = if ("startData" %in% names(.GlobalEnv)) startData else ExampleData.DeValues$CA1, data_secondary = setNames(as.data.frame(matrix(NA_real_, nrow = 5, ncol = 2)), c("x", "y")), data = NULL, args = NULL) session$onSessionEnded(function() { stopApp() }) # check and read in file (DATA SET 1) observeEvent(input$file1, { inFile<- input$file1 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) 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 observe({ ### 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"))) values$data <- 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({ centValue.data <- do.call(rbind, values$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({ xlim.data<- do.call(rbind, values$data) 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) })## EndOf::renderUI() # dynamically inject sliderInput for z-axis range output$zlim<- renderUI({ zlim.data<- do.call(rbind, values$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() observe({ # refresh plot on button press input$refresh # make sure that input panels are registered on non-active tabs. # by default tabs are suspended and input variables are hence # not available outputOptions(x = output, name = "zlim", suspendWhenHidden = FALSE) outputOptions(x = output, name = "centValue", suspendWhenHidden = FALSE) outputOptions(x = output, name = "xlim", suspendWhenHidden = FALSE) # if custom datapoint color get RGB code from separate input panel color <- ifelse(input$color == "custom", input$rgb, input$color) 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 } else { color2<- input$color2 } } else { color2<- adjustcolor("white", alpha.f = 0) } # if custom datapoint style get char from separate input panel pch<- ifelse(input$pch == "custom", input$custompch, as.integer(input$pch)-1) # if custom datapoint style get char from separate input panel pch2<- ifelse(input$pch2 == "custom", input$custompch2, as.integer(input$pch2)-1) # workaround to initialize plotting after app startup centValue <- ifelse(is.null(input$centValue), 3000, input$centValue) # create numeric vector of lines line <- sapply(1:8, function(x) input[[paste0("line", x)]]) # create char vector of line colors line.col <- sapply(1:8, function(x) input[[paste0("colline", x)]]) # create char vector of line labels line.label <- sapply(1:8, function(x) input[[paste0("labline", x)]]) # if custom bar color get RGB from separate input panel or "none" bar.col <- ifelse(input$bar == "custom", adjustcolor(col = input$rgbBar, alpha.f = input$alpha.bar/100), ifelse(input$bar == "none", input$bar, adjustcolor(col = input$bar, alpha.f = input$alpha.bar/100))) # if custom bar color get RGB from separate input panel or "none" # SECONDARY DATA SET bar.col2 <- ifelse(input$bar2 == "custom", adjustcolor(col = input$rgbBar2, alpha.f = input$alpha.bar/100), ifelse(input$bar2 == "none", input$bar, adjustcolor(col = input$bar2, alpha.f = input$alpha.bar/100))) # if custom grid color get RGB from separate input panel or "none" grid.col <- ifelse(input$grid == "custom", adjustcolor(col = input$rgbGrid, alpha.f = input$alpha.grid/100), ifelse(input$grid == "none", input$grid, adjustcolor(col = input$grid, alpha.f = input$alpha.grid/100))) # workaround: if no legend wanted set label to NA and hide # symbol on coordinates -999, -999 if(input$showlegend == FALSE) { legend<- c(NA,NA) legend.pos<- c(-999,-999) } else { if(!all(is.na(unlist(values$data_secondary)))) { legend<- c(input$legendname, input$legendname2) legend.pos<- input$legend.pos } else { legend<- c(input$legendname, "") legend.pos<- input$legend.pos } } # plot radial Plot values$args <- list( data = values$data, xlim = input$xlim, zlim = input$zlim, xlab = c(input$xlab1, input$xlab2), ylab = input$ylab, zlab = input$zlab, y.ticks = input$yticks, grid.col = grid.col, bar.col = c(bar.col, bar.col2), pch = c(pch,pch2), col = c(color,color2), line = line, line.col = line.col, line.label = line.label, main = input$main, cex = input$cex, mtext = input$mtext, log.z = input$logz, stats = input$statlabels, plot.ratio = input$curvature, summary = if (input$summary) input$stats else NA, summary.pos = input$sumpos, legend = legend, legend.pos = legend.pos, na.rm = TRUE, central.value = input$centValue, centrality = input$centrality, lwd = c(input$lwd, input$lwd2), lty = c(as.integer(input$lty), as.integer(input$lty2))) }) # render Radial Plot output$main_plot <- renderPlot({ # validate(need()) makes sure that all data are available to # renderUI({}) before plotting and will wait until there validate( need(expr = input$centValue, message = 'Waiting for data... Please wait!'), need(expr = input$zlim, message = 'Waiting for data... Please wait!') ) do.call(plot_RadialPlot, args = values$args) })##EndOf::renderPlot({}) observe({ # nested renderText({}) for code output on "R plot code" tab code.output <- callModule(RLumShiny:::printCode, "printCode", n_input = 2, fun = "plot_RadialPlot(data,", args = values$args) output$plotCode<- renderText({ code.output })##EndOf::renderText({}) callModule(RLumShiny:::exportCodeHandler, "export", code = code.output) callModule(RLumShiny:::exportPlotHandler, "export", fun = "plot_RadialPlot", args = values$args) }) # renderTable() that prints the data to the second tab output$dataset<- renderDataTable( options = list(pageLength = 10, autoWidth = FALSE), callback = "function(table) { table.on('click.dt', 'tr', function() { $(this).toggleClass('selected'); Shiny.onInputChange('rows', table.rows('.selected').values$data.toArray()); }); }", { data<- values$data[[1]] colnames(data)<- c("De","De error") data })##EndOf::renterTable() # renderTable() that prints the secondary data to the second tab output$dataset2<- renderDataTable( options = list(pageLength = 10, autoWidth = FALSE), callback = "function(table) { table.on('click.dt', 'tr', function() { $(this).toggleClass('selected'); Shiny.onInputChange('rows', table.rows('.selected').values$data.toArray()); }); }", { if(!all(is.na(unlist(values$data_secondary)))) { data<- values$data[[2]] colnames(data)<- c("De","De error") data } else { } })##EndOf::renterTable() # renderTable() to print the results of the # central age model (CAM) output$CAM<- renderDataTable( options = list(pageLength = 10, autoWidth = FALSE), { data <- values$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)RLumShiny/inst/shiny/radialplot/www/0000755000176200001440000000000014175060542017236 5ustar liggesusersRLumShiny/inst/shiny/radialplot/www/RL_Logo.png0000644000176200001440000007222114175060542021245 0ustar liggesusersPNG  IHDR pHYs.#.#x?v OiCCPPhotoshop ICC profilexڝSgTS=BKKoR RB&*! J!QEEȠQ, !{kּ> H3Q5 B.@ $pd!s#~<<+"x M0B\t8K@zB@F&S`cbP-`'{[! eDh;VEX0fK9-0IWfH  0Q){`##xFW<+*x<$9E[-qWW.(I+6aa@.y24x6_-"bbϫp@t~,/;m%h^ uf@Wp~<5j>{-]cK'Xto(hw?G%fIq^D$.Tʳ?D*A, `6B$BB dr`)B(Ͱ*`/@4Qhp.U=pa( Aa!ڈbX#!H$ ɈQ"K5H1RT UH=r9\F;2G1Q= C7F dt1r=6Ыhڏ>C03l0.B8, c˱" VcϱwE 6wB aAHXLXNH $4 7 Q'"K&b21XH,#/{C7$C2'ITFnR#,4H#dk9, +ȅ3![ b@qS(RjJ4e2AURݨT5ZBRQ4u9̓IKhhitݕNWGw Ljg(gwLӋT071oUX**| J&*/Tު UUT^S}FU3S ԖUPSSg;goT?~YYLOCQ_ cx,!k u5&|v*=9C3J3WRf?qtN (~))4L1e\kXHQG6EYAJ'\'GgSSݧ M=:.kDwn^Loy}/TmG X $ <5qo</QC]@Caaᄑ.ȽJtq]zۯ6iܟ4)Y3sCQ? 0k߬~OCOg#/c/Wװwa>>r><72Y_7ȷOo_C#dz%gA[z|!?:eAAA!h쐭!ΑiP~aa~ 'W?pX15wCsDDDޛg1O9-J5*>.j<74?.fYXXIlK9.*6nl {/]py.,:@LN8A*%w% yg"/6шC\*NH*Mz쑼5y$3,幄'L Lݛ:v m2=:1qB!Mggfvˬen/kY- BTZ(*geWf͉9+̳ې7ᒶKW-X潬j9(xoʿܔĹdff-[n ڴ VE/(ۻCɾUUMfeI?m]Nmq#׹=TR+Gw- 6 U#pDy  :v{vg/jBFS[b[O>zG499?rCd&ˮ/~јѡ򗓿m|x31^VwwO| (hSЧc3-gAMA|Q cHRMz%u0`:o_FiIDATx}td%! )+7ږJ["\wKIQl7YWtFuftZǙ]=8n-Ot) q\p7ab SZMM@z K[yӧO?_7n\ pw~ \i$eo .<_: @IpB^D=c,JN+߻jժ8|()ٞ /MMM#g̙d\]w5f߾}}vP2.^zTq㢯ψ˼W馛FGN#P.NȦG"suhll4(E%>F]]Q~o=6mdPcbŊZ|ب˼xaPl."o,۷o7.E˼۷… K;|XRJw}~(T_u^^矏F?mƼ|>{WkΜ9 sl瞲^O$y1qIJƍ>?qZ*/,YR߳?8F-uy۷o VOF8GrWXQIU\VZ~OVײo߾ؾ}>F$yӧW4nܸ2oΜ9U5GN? [/o .گ矏F?Uc^]]]U}G9{`]vEL:)de1!Ҭ!UVǴi?Y>K苧鍈m{N}?SJ_m[2#@%6 qw;4T>u>o_ODPVbcލ7X3_}b5502|eXV"c?9E__H6;OYO?{P+z{{cժU̙30Q>= v@$&-Y$1ߔؾ}{x~BA"1oo߾D}c.\~B^GeqHDļ\.oΊ+S Z~OϸRc^O7gժU>p۾/zNDx0c^>^oЍ7~RDz_ž>`j:s=۷/={VSOHl;|pZ*ߤn)5ɿ "٘w;=c?:tƇO,P^|@ }XpaYO-P5<6 KKf"žhf5Yr\*YsO<~j~VTHż/SZjUٟY o Mg߁}wBy/B{ｩ-Y$%Oxt T̻뮻R ۷o_l߾=nF?@Ѹ 5>ߑ"~. 1ZJjb^.(+V<`('o<{<J*b^(UV?hll4P>ܰ5"ؾϣ1H o։y@<<BБczf@by@ܻ?:7l@y@"?H41i|>6u툮m{<Oj@y@MH31 O["%UMC%U%ǃ_vU<*xT'q"νsֈ!F@G=O5#B;tX^9zNxp~۱G"Z(1( /s̳ŗlr (1|>+ /2xPb0lV>>*Aŗ^U_Gj<`H!gZ>b R KNζ=GE<Rb<\|i;!@ sŮj)5 j)PqEsܰUÑ" <(5m <8G\}'<<8/r7e!(yc-Pnb¡#⾕ y@Yy0B; [<3 T<5m]=BP1b Tmq)7^\|QL0..ln_a$H01Bo1S.yCןuuugZ 'A\}'<EګrlH71`0=?0pN^.0 "57b4B0g qascwZHpw)154qG y._y\Eb%Amk5Gfx, <1T NwY q'A x%OƧ%p[hO|o<(m[ ̾WJ7?54raA8Ẹ:r,qGmkR $QU|ܷ!!Txڣ $QU> yHyT޾ D<FḲ*<@\yT#D<Ẹ|NI%Plbm{|N35.>%raA(1y͏#1D<JṂ"Kk6 y$ָܶh\s|%1Id<*scCP涵FD_{A(91;tX15mK(|>|ԬrP @ىyʯ|Cȣ& ~.GOo*Ḅl~d8xԜm+/f *J̣,|Zj-]:7luGUp@y̓_G ^}}q Q 6WyEQWWg81asGmk2scc*8< Z yP<s25^+E23-yP|bcWw!5!JC5a>Wy#o~% ;7"@y¦o#!qJw#q[\1"sZ!D#""|8x ָܶ+cc@yDD} <m|!//涵nH1/|^^]FFH!Wy\b^8x)*IK_z)*MK'z/RU$PORU$P]!e涵u4$@FH2s`b^?KmNK'2O\p! ļ'"sZchļz$#@ y w)[b^y#ܶhb^>wܛlSq^|)"%sM;:n20ORbn[k̼l! Eļ&|30dfH1/A6=7BJ<H/1/A~p>/MK˼47RLKggxӔ)&Abb^Be^*44RLK5B]>} <ozF\=-Fk#$ <d yP涵F}@کP#)'@ !ᮻ #b^R'O!ZyP+<\|1j yP+<b1j5B!@FyP#<bԀ_7KK9W_ayNbԘ=RHK7Mhرq#@ y R__fN7D WK/RFK:# )#%̕o))#%7]b-0s)Q[H1/a]8)Q[H1/a6])_RBK#ؾm{;RBK٭o1Ba#@ y tٛh! ļ4q`a@:y 42{b~pb^BaFH>t1$P_sRfwwOt}o! ļsF۱u$Po2K0Ru$P FH)y\b^]KB ļ[0wRu$`3/sRu$`Z!\@y !\@y w˂9FHOtl۱Pļ-'63T11/CJD5گ1[({ >7Q-<(xԖsBOb^[!8'AϿ0#R{{;ޮg[?1`<:b/ z0 bg:b z{1`" c\aޥqQA zg;c ΣTvw?x`7Bc|v'/^z PǰΣԺ+>yߚ/g 1"(=Wޛn f[1\1b\Qr//|-e0#{ ( _*>TsǨym۱|m)c?01[[[o!(nz>RvwCϟ#G5 QT3N2 W߉P<06{bՃ#>J&Qt !QuXcjGI_UaYz~z od>}'?yTx\pQzb%3eldo!"BУ*=ӧܒqKfQjb%' AU۱:@U({/-Uo0WqWYuuuy%&xܖ1?wĕO3 UC̣,l<*b-7=?4-#%Qu|~i#0\bUVz[^iNJom}sdo!"|~sz{hweo뮙uuuH91' Aj F=15n̉mPo:Tp̚9/VkOeG26>t;sVA~Ջ{ڷ^\ _?]x]wѱx~\d^'NGpOE㎎˧ A%n-|q*D#xpX|q(#1074?G%rc'GkƧ%&G\2iB|wD熭Pb~UT@w5W˦z+.9H,A*ފ;59=.|#G_Uw!OЃ|+CsZq͑;;̾;V}[qQ5eԘ Ώ?Y\@ XOzUN!߽4> 2cd/*kxAT'18d:r,[PD1[`H3NrGo<`XuŲw(@x]ns-<`zJe0j__;36u툮m{\@y?" b-qQQJMø>OJgEt\%~U1Y-<=(y@Ųc>tLJ!߽4?eQol2g}.fdIH|wMo 0LbP13N6T̡#Ǣ!`D__Ƌ/|*E}@y@xx sLݟ.^"%/uԵCȣ\6 *|u_}'"A-ChinY3gbn+CE߱g#O?/C V~((KHN};o~X?N>q|S&A?547 O^}}7ힾ#ⷱO?k&A]U岙fCT W?ypБc)yRmvGAlԣT1RБcwtblCT1R辕ʣ\6 y2;7Cjok=)ӹa< e37UJ̃ٸQ#PP.E)kWy iFbbĦB岙fCT91Rŗ^m{ AA-͍1cdCT91R`W*rLܾd!j d8x'M0@  WyfFy`޾S&ئ1b$u]QP.yP?yUCjokuPc]e-͍1k C$5fW*rLܾd!J̃d8x'M0@ByPC֮*rLq!L̃q1Wy iꔉq `bԈ6ʣ\6K7@‰yP9}' AAW]1-61@‰yP\1\6 m{ f͜a"B̃ԵU岙x )bTHRKscL4"A]U岙}C bT3>5M2U!A|iFWyfb5<(CGEo CP)clCbu]QP.ws!8#1hR{[k3:7luGAl&2f<({rLܺ`N<(|>*aΕF`HbB岙XnJ̃ѵm!(1f͜aJ̃[oʣ\6/Y`Ẽ?~21C5s( 1F`SWyfw,6%#0?*!47I @Ɉy0LkoqGAl&n_̳ŁG AASLt@ɉy0 _ZU岙Xx!(91Бcw4u4gzfWyf]\hB̃!ܻUCjok_:CPb sVWyf"3o!(1 عw((ĭ D}}1(1 ϻns(+1`S!rLt,j7e'ڶf0e'7\QP.ۗ,0!iZc "<8[\Q<*M̃9t䘫<4uDWyTzfWyfb<^0]uŴ4T*岙6TGܻUCjokzCPqb׹a< e37T1Tζ=F\6]P5<4k #Xb5cS! m{ f͜aRỊl*rLq!H-1<3M6%Q5֮*rLܾd!H51d8x4uĘwY4Z#i<*bS!rLt,j7Gڶf0G=oʣ\6/Y`81?~2vuZc 3(뷸ʣ Wy0419tX8x4uDWy01Yn< e3t|C<Бcw4u401pPrLܙpb%s~Wy 5 g!Qrʣ\6y  QRٶfcQ<&1G]1Y3gỊd6u(h*>1[*FḤ$V~((KFḤZc (뷸ʣ\6wtl1:t䘫<4uĸhQ(6ʣ\6K7G:r,zNZclC(y}+rGAl&2f΁GQܻ 5 @̣(:7luGAl&C98g7?j e3ѱ=HڶUC5s<ɦB岙fC@yZѵm!(1fLl(1Q[~< e3q"'Ƙ:7luǐn5M2UGA_ZU岙Xx!<Бcw4u4PFbgzfWyf-2x{cHmQ__o(31ܰU岙̛m1Wζ=F\6.**D|>o~UCaΕF 8eS!rLt,j7TGD*# 1f͜a 1Xoʣ\6/Y`01?~2 []1_k!b^Bm!QP.E#%P>m{ f͜a1b^=oʣ\6c!y d147I 5HK뷸ʣ\6/Y`Qb^m{\1Y3gR@̫rvyfΎ )!U_z9147ƌi>B̫b-Wyf% )"U'Ƙm{ f͜aH91 |UÑQe3ѱ$aL>=VX/Af0jժhjj5ƨBbB.ۗ,0c}vcT1F1&O`?.\mmmk*  m'N+VD>7Hy0BSLt@*Z*~~/1*D̃e3t|C}?~|<(31F+ئ1 ꫯx R&b S.m ٷo_455Ŋ+Qb S{[k`ժUQWW۷o7F y0 l&2fb…1~8|1J@̃e3ѱU SL>=r+21aFzG)>cCF{<"`-͍c…΁䲙}C@۷/O+Vyz A-͍1yC@ Z*sM1F@̃3e3e %}ypSLMc epdb󴵞qP٪z*Su+4^)RkߥЉtB&!dfD1cV0dd/0ɽM$>>>zm>|36cuu5v\\\h'#7+rt4#<@x ,C3jZk{<֭[1ݻggg0k>|Ƞpj5v ̃xT*idXӉR~{4D^Z'''Z0k>| f<z4HMȨ5ATx"k-M&I^pߏz7w&kMВ$n[[[\0I4cmm-Wrv;...r.atbyy97y>Z~!q܌o.yp8h W0Bt:Q*{05 (ͨjq||Zyxɓ(J3U0>^GVL#KX__v=yz<Nj5^쾘[ <4MG?<$I(AT*!K>ߍhsEj<og%/M8< ]qxx+++~On`a%I^/Aa jnF*̚y,Vxpk73iZa{  Ӓ$n[㴟-UĹx3i4JE3>  3$pXxqLz1y0W;;;1LŻl4Mw v0SIQ A5 nFЌ+ qV+ϣlh7XRDLiK4ceeE3<.Iz1 yS$`vh4-͘2aSj4ok"iښfܰ<`p-IDuvvvvślF{{{QT4cvJ?}'W$ph.ޜ9f /1yqW""ZVL&h41?4~o.^9f @Dwtt@ :E[L>y煋0 L|10?f@|v]k /\9f ōui]ug@nΕ7l`|?\+o+OvVՃ}UV:Ws-7m+Ov}sVJ!cSY+rfjY9@L5/+g@X@7rDypcXyQ  n<,l&4nȉnb[z,D]z,[X{dIXxs{Zf/s6ٙIENDB`RLumShiny/inst/shiny/radialplot/www/style.css0000644000176200001440000000242714175060542021115 0ustar liggesusers.custom-modal { padding-left: 10px; padding-top: 10px; padding-bottom: 10px; padding-right: 10px; line-height: 200%; background-color: #fff; overflow: visible; position: absolute; z-index: 999; border-radius: 10px; border-style: solid; border-color: #428bca; } .h { font-size: 11px; margin: 0 0 0px; } h5, h6 { color: #428bca; } .tooltip-inner { max-width: 450px; } .control-label, .selectize-dropdown, .item, .btn, .uneditable-input, .sorting, .odd, .even, .dataTables-info, .fa, .fa-refresh { font-size: 12px; } .selectize-input { padding: 0px 10px; min-height: 20px; } label, body, input { font-size: 12px; } .label, .badge { font-size: 12px; padding: 4px 20px; margin: 10px; line-height: 18px; } .label-info, .badge-info { background-color: #428bca; } input[type="text"],input[type="number"],input[type="email"],input[type="url"],input[type="search"],input[type="tel"],input[type="color"],.uneditable-input{ display:inline-block; height:18px; padding:0px 0px 0px 7px; margin-bottom:10px; font-size: 11px; line-height: 1.5; color:#555; vertical-align:middle; -webkit-border-radius:4px; -moz-border-radius:4px; border-radius:4px } input,textarea,.uneditable-input{ width: auto; } RLumShiny/inst/shiny/radialplot/www/GitHub-Mark-32px.png0000644000176200001440000000326214175060542022613 0ustar liggesusersPNG  IHDR szztEXtSoftwareAdobe ImageReadyqe<$iTXtXML:com.adobe.xmp $IDATxėmhayL30A+R#f>IHکy(M)_o5 0+0Ėl&o{i^]u<{Yws}=uC>$L, }<w}8^ AO?p! xaяPKI3`'B>0QT1<+`}^nvkp^ƅF|1"Gp.*oO׀Vp ]߅jc8K$q 8jV`#`vmpGѢu!#}#:U_?_yhE $=;c*xNOo+&w)%K-R%6n'o">j/t³qoGW7j%2q GX?woibCÐAzbǰt \14|S.DZ]# b|H$(ʕohmqͱRP셣$,0Z20 tNvRW3K8Xk2 IO6 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("fas fa-sync")), 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
"), 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
"),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
"),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
"),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
"),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
"),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
"),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
"),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("
2σ bar
")), 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 RLumShiny:::exportTab("export", filename = "radial plot"), RLumShiny:::aboutTab("about", "radialplot") )##EndOf::tabsetPanel ),##EndOf::sidebarPanel # 3 - output panel mainPanel(width = 7, # insert css code inside 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 } RLumShiny/inst/shiny/KDE/0000755000176200001440000000000014175060542014662 5ustar liggesusersRLumShiny/inst/shiny/KDE/Global.R0000644000176200001440000000031514175060542016204 0ustar liggesusers## Server.R library(Luminescence) library(shiny) library(RLumShiny) library(data.table) library(rhandsontable) # load example data data(ExampleData.DeValues) enableBookmarking(store = "server")RLumShiny/inst/shiny/KDE/server.R0000644000176200001440000002047114175060542016317 0ustar liggesusers## MAIN FUNCTION function(input, output, session) { # input data (with default) values <- reactiveValues(data_primary = if ("startData" %in% names(.GlobalEnv)) startData else ExampleData.DeValues$CA1, data_secondary = setNames(as.data.frame(matrix(NA_real_, nrow = 5, ncol = 2)), c("x", "y")), data = NULL, args = NULL) session$onSessionEnded(function() { stopApp() }) # check and read in file (DATA SET 1) observeEvent(input$file1, { inFile<- input$file1 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) 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 observe({ ### 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"))) values$data <- 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({ data <- do.call(rbind, values$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)) })## EndOf::renderUI() # dynamically inject sliderInput for KDE bandwidth output$bw<- renderUI({ data <- do.call(rbind, values$data) sliderInput(inputId = "bw", label = "KDE bandwidth", min = bw.nrd0(data[,1])/4, max = bw.nrd0(data[,1])*4, value = bw.nrd0(data[,1])) })## EndOf::renderUI() observe({ # make sure that input panels are registered on non-active tabs. # by default tabs are suspended and input variables are hence # not available outputOptions(x = output, name = "xlim", suspendWhenHidden = FALSE) outputOptions(x = output, name = "bw", suspendWhenHidden = FALSE) # refresh plot on button press input$refresh # check if any summary stats are activated, else NA summary <- if (input$summary) input$stats else "" logx <- ifelse(input$logx, "x", "") # if custom datapoint color get RGB code from separate input panel color <- ifelse(input$color == "custom", input$rgb, input$color) # if custom datapoint color get RGB code from separate input panel if(!all(is.na(unlist(values$data_secondary)))) { color2 <- ifelse(input$color2 == "custom", input$rgb2, input$color2) } else { color2<- adjustcolor("white", alpha.f = 0) } values$args <- list( data = values$data, cex = input$cex, log = logx, xlab = input$xlab, ylab = c(input$ylab1, input$ylab2), main = input$main, values.cumulative = input$cumulative, na.rm = TRUE, rug = input$rug, boxplot = input$boxplot, summary = summary, summary.pos = input$sumpos, summary.method = input$summary.method, bw = input$bw, xlim = input$xlim, col = c(color, color2)) }) output$main_plot <- renderPlot({ # validate(need()) makes sure that all data are available to # renderUI({}) before plotting and will wait until there validate( need(expr = input$xlim, message = ''), need(expr = input$bw, message = 'Waiting for data... Please wait!') ) do.call(plot_KDE, args = values$args) })##EndOf::renderPlot({}) observe({ # nested renderText({}) for code output on "R plot code" tab code.output <- callModule(RLumShiny:::printCode, "printCode", n_input = 2, fun = "plot_KDE(data,", args = values$args) output$plotCode<- renderText({ code.output })##EndOf::renderText({}) callModule(RLumShiny:::exportCodeHandler, "export", code = code.output) callModule(RLumShiny:::exportPlotHandler, "export", fun = "plot_KDE", args = values$args) }) # renderTable() that prints the data to the second tab output$dataset<- renderDataTable( options = list(pageLength = 10, autoWidth = FALSE), callback = "function(table) { table.on('click.dt', 'tr', function() { $(this).toggleClass('selected'); Shiny.onInputChange('rows', table.rows('.selected').values$data.toArray()); }); }", { data <- values$data[[1]] colnames(data) <- c("De","De error") data })##EndOf::renterTable() # renderTable() that prints the secondary data to the second tab output$dataset2<- renderDataTable( options = list(pageLength = 10, autoWidth = FALSE), callback = "function(table) { table.on('click.dt', 'tr', function() { $(this).toggleClass('selected'); Shiny.onInputChange('rows', table.rows('.selected').values$data.toArray()); }); }", { if(!all(is.na(unlist(values$data_secondary)))) { data <- values$data[[2]] colnames(data) <- c("De","De error") data } else { } })##EndOf::renterTable() # renderTable() to print the results of the # central age model (CAM) output$CAM<- renderDataTable( options = list(pageLength = 10, autoWidth = FALSE), { data <- values$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)RLumShiny/inst/shiny/KDE/www/0000755000176200001440000000000014175060542015506 5ustar liggesusersRLumShiny/inst/shiny/KDE/www/RL_Logo.png0000644000176200001440000007222114175060542017515 0ustar liggesusersPNG  IHDR pHYs.#.#x?v OiCCPPhotoshop ICC profilexڝSgTS=BKKoR RB&*! J!QEEȠQ, !{kּ> H3Q5 B.@ $pd!s#~<<+"x M0B\t8K@zB@F&S`cbP-`'{[! eDh;VEX0fK9-0IWfH  0Q){`##xFW<+*x<$9E[-qWW.(I+6aa@.y24x6_-"bbϫp@t~,/;m%h^ uf@Wp~<5j>{-]cK'Xto(hw?G%fIq^D$.Tʳ?D*A, `6B$BB dr`)B(Ͱ*`/@4Qhp.U=pa( Aa!ڈbX#!H$ ɈQ"K5H1RT UH=r9\F;2G1Q= C7F dt1r=6Ыhڏ>C03l0.B8, c˱" VcϱwE 6wB aAHXLXNH $4 7 Q'"K&b21XH,#/{C7$C2'ITFnR#,4H#dk9, +ȅ3![ b@qS(RjJ4e2AURݨT5ZBRQ4u9̓IKhhitݕNWGw Ljg(gwLӋT071oUX**| J&*/Tު UUT^S}FU3S ԖUPSSg;goT?~YYLOCQ_ cx,!k u5&|v*=9C3J3WRf?qtN (~))4L1e\kXHQG6EYAJ'\'GgSSݧ M=:.kDwn^Loy}/TmG X $ <5qo</QC]@Caaᄑ.ȽJtq]zۯ6iܟ4)Y3sCQ? 0k߬~OCOg#/c/Wװwa>>r><72Y_7ȷOo_C#dz%gA[z|!?:eAAA!h쐭!ΑiP~aa~ 'W?pX15wCsDDDޛg1O9-J5*>.j<74?.fYXXIlK9.*6nl {/]py.,:@LN8A*%w% yg"/6шC\*NH*Mz쑼5y$3,幄'L Lݛ:v m2=:1qB!Mggfvˬen/kY- BTZ(*geWf͉9+̳ې7ᒶKW-X潬j9(xoʿܔĹdff-[n ڴ VE/(ۻCɾUUMfeI?m]Nmq#׹=TR+Gw- 6 U#pDy  :v{vg/jBFS[b[O>zG499?rCd&ˮ/~јѡ򗓿m|x31^VwwO| (hSЧc3-gAMA|Q cHRMz%u0`:o_FiIDATx}td%! )+7ږJ["\wKIQl7YWtFuftZǙ]=8n-Ot) q\p7ab SZMM@z K[yӧO?_7n\ pw~ \i$eo .<_: @IpB^D=c,JN+߻jժ8|()ٞ /MMM#g̙d\]w5f߾}}vP2.^zTq㢯ψ˼W馛FGN#P.NȦG"suhll4(E%>F]]Q~o=6mdPcbŊZ|ب˼xaPl."o,۷o7.E˼۷… K;|XRJw}~(T_u^^矏F?mƼ|>{WkΜ9 sl瞲^O$y1qIJƍ>?qZ*/,YR߳?8F-uy۷o VOF8GrWXQIU\VZ~OVײo߾ؾ}>F$yӧW4nܸ2oΜ9U5GN? [/o .گ矏F?Uc^]]]U}G9{`]vEL:)de1!Ҭ!UVǴi?Y>K苧鍈m{N}?SJ_m[2#@%6 qw;4T>u>o_ODPVbcލ7X3_}b5502|eXV"c?9E__H6;OYO?{P+z{{cժU̙30Q>= v@$&-Y$1ߔؾ}{x~BA"1oo߾D}c.\~B^GeqHDļ\.oΊ+S Z~OϸRc^O7gժU>p۾/zNDx0c^>^oЍ7~RDz_ž>`j:s=۷/={VSOHl;|pZ*ߤn)5ɿ "٘w;=c?:tƇO,P^|@ }XpaYO-P5<6 KKf"žhf5Yr\*YsO<~j~VTHż/SZjUٟY o Mg߁}wBy/B{ｩ-Y$%Oxt T̻뮻R ۷o_l߾=nF?@Ѹ 5>ߑ"~. 1ZJjb^.(+V<`('o<{<J*b^(UV?hll4P>ܰ5"ؾϣ1H o։y@<<BБczf@by@ܻ?:7l@y@"?H41i|>6u툮m{<Oj@y@MH31 O["%UMC%U%ǃ_vU<*xT'q"νsֈ!F@G=O5#B;tX^9zNxp~۱G"Z(1( /s̳ŗlr (1|>+ /2xPb0lV>>*Aŗ^U_Gj<`H!gZ>b R KNζ=GE<Rb<\|i;!@ sŮj)5 j)PqEsܰUÑ" <(5m <8G\}'<<8/r7e!(yc-Pnb¡#⾕ y@Yy0B; [<3 T<5m]=BP1b Tmq)7^\|QL0..ln_a$H01Bo1S.yCןuuugZ 'A\}'<EګrlH71`0=?0pN^.0 "57b4B0g qascwZHpw)154qG y._y\Eb%Amk5Gfx, <1T NwY q'A x%OƧ%p[hO|o<(m[ ̾WJ7?54raA8Ẹ:r,qGmkR $QU|ܷ!!Txڣ $QU> yHyT޾ D<FḲ*<@\yT#D<Ẹ|NI%Plbm{|N35.>%raA(1y͏#1D<JṂ"Kk6 y$ָܶh\s|%1Id<*scCP涵FD_{A(91;tX15mK(|>|ԬrP @ىyʯ|Cȣ& ~.GOo*Ḅl~d8xԜm+/f *J̣,|Zj-]:7luGUp@y̓_G ^}}q Q 6WyEQWWg81asGmk2scc*8< Z yP<s25^+E23-yP|bcWw!5!JC5a>Wy#o~% ;7"@y¦o#!qJw#q[\1"sZ!D#""|8x ָܶ+cc@yDD} <m|!//涵nH1/|^^]FFH!Wy\b^8x)*IK_z)*MK'z/RU$PORU$P]!e涵u4$@FH2s`b^?KmNK'2O\p! ļ'"sZchļz$#@ y w)[b^y#ܶhb^>wܛlSq^|)"%sM;:n20ORbn[k̼l! Eļ&|30dfH1/A6=7BJ<H/1/A~p>/MK˼47RLKggxӔ)&Abb^Be^*44RLK5B]>} <ozF\=-Fk#$ <d yP涵F}@کP#)'@ !ᮻ #b^R'O!ZyP+<\|1j yP+<b1j5B!@FyP#<bԀ_7KK9W_ayNbԘ=RHK7Mhرq#@ y R__fN7D WK/RFK:# )#%̕o))#%7]b-0s)Q[H1/a]8)Q[H1/a6])_RBK#ؾm{;RBK٭o1Ba#@ y tٛh! ļ4q`a@:y 42{b~pb^BaFH>t1$P_sRfwwOt}o! ļsF۱u$Po2K0Ru$P FH)y\b^]KB ļ[0wRu$`3/sRu$`Z!\@y !\@y w˂9FHOtl۱Pļ-'63T11/CJD5گ1[({ >7Q-<(xԖsBOb^[!8'AϿ0#R{{;ޮg[?1`<:b/ z0 bg:b z{1`" c\aޥqQA zg;c ΣTvw?x`7Bc|v'/^z PǰΣԺ+>yߚ/g 1"(=Wޛn f[1\1b\Qr//|-e0#{ ( _*>TsǨym۱|m)c?01[[[o!(nz>RvwCϟ#G5 QT3N2 W߉P<06{bՃ#>J&Qt !QuXcjGI_UaYz~z od>}'?yTx\pQzb%3eldo!"BУ*=ӧܒqKfQjb%' AU۱:@U({/-Uo0WqWYuuuy%&xܖ1?wĕO3 UC̣,l<*b-7=?4-#%Qu|~i#0\bUVz[^iNJom}sdo!"|~sz{hweo뮙uuuH91' Aj F=15n̉mPo:Tp̚9/VkOeG26>t;sVA~Ջ{ڷ^\ _?]x]wѱx~\d^'NGpOE㎎˧ A%n-|q*D#xpX|q(#1074?G%rc'GkƧ%&G\2iB|wD熭Pb~UT@w5W˦z+.9H,A*ފ;59=.|#G_Uw!OЃ|+CsZq͑;;̾;V}[qQ5eԘ Ώ?Y\@ XOzUN!߽4> 2cd/*kxAT'18d:r,[PD1[`H3NrGo<`XuŲw(@x]ns-<`zJe0j__;36u툮m{\@y?" b-qQQJMø>OJgEt\%~U1Y-<=(y@Ųc>tLJ!߽4?eQol2g}.fdIH|wMo 0LbP13N6T̡#Ǣ!`D__Ƌ/|*E}@y@xx sLݟ.^"%/uԵCȣ\6 *|u_}'"A-ChinY3gbn+CE߱g#O?/C V~((KHN};o~X?N>q|S&A?547 O^}}7ힾ#ⷱO?k&A]U岙fCT W?ypБc)yRmvGAlԣT1RБcwtblCT1R辕ʣ\6 y2;7Cjok=)ӹa< e37UJ̃ٸQ#PP.E)kWy iFbbĦB岙fCT91Rŗ^m{ AA-͍1cdCT91R`W*rLܾd!j d8x'M0@  WyfFy`޾S&ئ1b$u]QP.yP?yUCjokuPc]e-͍1k C$5fW*rLܾd!J̃d8x'M0@ByPC֮*rLq!L̃q1Wy iꔉq `bԈ6ʣ\6K7@‰yP9}' AAW]1-61@‰yP\1\6 m{ f͜a"B̃ԵU岙x )bTHRKscL4"A]U岙}C bT3>5M2U!A|iFWyfb5<(CGEo CP)clCbu]QP.ws!8#1hR{[k3:7luGAl&2f<({rLܺ`N<(|>*aΕF`HbB岙XnJ̃ѵm!(1f͜aJ̃[oʣ\6/Y`Ẽ?~21C5s( 1F`SWyfw,6%#0?*!47I @Ɉy0LkoqGAl&n_̳ŁG AASLt@ɉy0 _ZU岙Xx!(91Бcw4u4gzfWyf]\hB̃!ܻUCjok_:CPb sVWyf"3o!(1 عw((ĭ D}}1(1 ϻns(+1`S!rLt,j7e'ڶf0e'7\QP.ۗ,0!iZc "<8[\Q<*M̃9t䘫<4uDWyTzfWyfb<^0]uŴ4T*岙6TGܻUCjokzCPqb׹a< e37T1Tζ=F\6]P5<4k #Xb5cS! m{ f͜aRỊl*rLq!H-1<3M6%Q5֮*rLܾd!H51d8x4uĘwY4Z#i<*bS!rLt,j7Gڶf0G=oʣ\6/Y`81?~2vuZc 3(뷸ʣ Wy0419tX8x4uDWy01Yn< e3t|C<Бcw4u401pPrLܙpb%s~Wy 5 g!Qrʣ\6y  QRٶfcQ<&1G]1Y3gỊd6u(h*>1[*FḤ$V~((KFḤZc (뷸ʣ\6wtl1:t䘫<4uĸhQ(6ʣ\6K7G:r,zNZclC(y}+rGAl&2f΁GQܻ 5 @̣(:7luGAl&C98g7?j e3ѱ=HڶUC5s<ɦB岙fC@yZѵm!(1fLl(1Q[~< e3q"'Ƙ:7luǐn5M2UGA_ZU岙Xx!<Бcw4u4PFbgzfWyf-2x{cHmQ__o(31ܰU岙̛m1Wζ=F\6.**D|>o~UCaΕF 8eS!rLt,j7TGD*# 1f͜a 1Xoʣ\6/Y`01?~2 []1_k!b^Bm!QP.E#%P>m{ f͜a1b^=oʣ\6c!y d147I 5HK뷸ʣ\6/Y`Qb^m{\1Y3gR@̫rvyfΎ )!U_z9147ƌi>B̫b-Wyf% )"U'Ƙm{ f͜aH91 |UÑQe3ѱ$aL>=VX/Af0jժhjj5ƨBbB.ۗ,0c}vcT1F1&O`?.\mmmk*  m'N+VD>7Hy0BSLt@*Z*~~/1*D̃e3t|C}?~|<(31F+ئ1 ꫯx R&b S.m ٷo_455Ŋ+Qb S{[k`ժUQWW۷o7F y0 l&2fb…1~8|1J@̃e3ѱU SL>=r+21aFzG)>cCF{<"`-͍c…΁䲙}C@۷/O+Vyz A-͍1yC@ Z*sM1F@̃3e3e %}ypSLMc epdb󴵞qP٪z*Su+4^)RkߥЉtB&!dfD1cV0dd/0ɽM$>>>zm>|36cuu5v\\\h'#7+rt4#<@x ,C3jZk{<֭[1ݻggg0k>|Ƞpj5v ̃xT*idXӉR~{4D^Z'''Z0k>| f<z4HMȨ5ATx"k-M&I^pߏz7w&kMВ$n[[[\0I4cmm-Wrv;...r.atbyy97y>Z~!q܌o.yp8h W0Bt:Q*{05 (ͨjq||Zyxɓ(J3U0>^GVL#KX__v=yz<Nj5^쾘[ <4MG?<$I(AT*!K>ߍhsEj<og%/M8< ]qxx+++~On`a%I^/Aa jnF*̚y,Vxpk73iZa{  Ӓ$n[㴟-UĹx3i4JE3>  3$pXxqLz1y0W;;;1LŻl4Mw v0SIQ A5 nFЌ+ qV+ϣlh7XRDLiK4ceeE3<.Iz1 yS$`vh4-͘2aSj4ok"iښfܰ<`p-IDuvvvvślF{{{QT4cvJ?}'W$ph.ޜ9f /1yqW""ZVL&h41?4~o.^9f @Dwtt@ :E[L>y煋0 L|10?f@|v]k /\9f ōui]ug@nΕ7l`|?\+o+OvVՃ}UV:Ws-7m+Ov}sVJ!cSY+rfjY9@L5/+g@X@7rDypcXyQ  n<,l&4nȉnb[z,D]z,[X{dIXxs{Zf/s6ٙIENDB`RLumShiny/inst/shiny/KDE/www/style.css0000644000176200001440000000242714175060542017365 0ustar liggesusers.custom-modal { padding-left: 10px; padding-top: 10px; padding-bottom: 10px; padding-right: 10px; line-height: 200%; background-color: #fff; overflow: visible; position: absolute; z-index: 999; border-radius: 10px; border-style: solid; border-color: #428bca; } .h { font-size: 11px; margin: 0 0 0px; } h5, h6 { color: #428bca; } .tooltip-inner { max-width: 450px; } .control-label, .selectize-dropdown, .item, .btn, .uneditable-input, .sorting, .odd, .even, .dataTables-info, .fa, .fa-refresh { font-size: 12px; } .selectize-input { padding: 0px 10px; min-height: 20px; } label, body, input { font-size: 12px; } .label, .badge { font-size: 12px; padding: 4px 20px; margin: 10px; line-height: 18px; } .label-info, .badge-info { background-color: #428bca; } input[type="text"],input[type="number"],input[type="email"],input[type="url"],input[type="search"],input[type="tel"],input[type="color"],.uneditable-input{ display:inline-block; height:18px; padding:0px 0px 0px 7px; margin-bottom:10px; font-size: 11px; line-height: 1.5; color:#555; vertical-align:middle; -webkit-border-radius:4px; -moz-border-radius:4px; border-radius:4px } input,textarea,.uneditable-input{ width: auto; } RLumShiny/inst/shiny/KDE/www/GitHub-Mark-32px.png0000644000176200001440000000326214175060542021063 0ustar liggesusersPNG  IHDR szztEXtSoftwareAdobe ImageReadyqe<$iTXtXML:com.adobe.xmp $IDATxėmhayL30A+R#f>IHکy(M)_o5 0+0Ėl&o{i^]u<{Yws}=uC>$L, }<w}8^ AO?p! xaяPKI3`'B>0QT1<+`}^nvkp^ƅF|1"Gp.*oO׀Vp ]߅jc8K$q 8jV`#`vmpGѢu!#}#:U_?_yhE $=;c*xNOo+&w)%K-R%6n'o">j/t³qoGW7j%2q GX?woibCÐAzbǰt \14|S.DZ]# b|H$(ʕohmqͱRP셣$,0Z20 tNvRW3K8Xk2 IO6 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("fas fa-sync")), 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 RLumShiny:::exportTab("export", filename = "KDE"), RLumShiny:::aboutTab("about", "KDE") )##EndOf::tabsetPanel ),##EndOf::sidebarPanel # 3 - output panel mainPanel(width = 7, # insert css code inside 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 } RLumShiny/inst/shiny/scalegamma/0000755000176200001440000000000014175060542016351 5ustar liggesusersRLumShiny/inst/shiny/scalegamma/global.R0000644000176200001440000000116714175060542017741 0ustar liggesusers## global.R ## library(Luminescence) library(RLumShiny) library(shiny) library(data.table) library(rhandsontable) if (utils::packageVersion("Luminescence") < "0.9.0") stop( "\n\n", rep("#", 30), "\n", "This application requires 'Luminescence' version >=0.9.0.\n", "See ?Luminescence::install_DevelopmentVersion() to get the ", "latest version of the package.", "\n", rep("#", 30), "\n\n", call. = FALSE) data("ExampleData.ScaleGammaDose") example_data <- ExampleData.ScaleGammaDose f <- function(x, d = 3) formatC(x, digits = d, format = "f") enableBookmarking(store = "server")RLumShiny/inst/shiny/scalegamma/server.R0000644000176200001440000001400514175060542020002 0ustar liggesusers## Server.R ## MAIN FUNCTION function(input, output, session) { # input data (with default) values <- reactiveValues(data = example_data, data_used = NULL, args = NULL, results = NULL, error = NULL) session$onSessionEnded(function() { stopApp() }) observe({ # make sure that input panels are registered on non-active tabs. # by default tabs are suspended and input variables are hence # not available outputOptions(x = output, name = "df_inf", suspendWhenHidden = FALSE) outputOptions(x = output, name = "df_scaled", suspendWhenHidden = FALSE) outputOptions(x = output, name = "main_plot", suspendWhenHidden = FALSE) }) ## FILE INPUT ---- observeEvent(input$file, { inFile<- input$file if(is.null(inFile)) return(NULL) # if no file was uploaded return NULL data <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath ## add or crop columns if (ncol(data) > 12) data <- data[ ,1:12] else if (ncol(data) < 12) { ncol <- 12 - ncol(data) data <- cbind(data, matrix(NA, ncol = ncol)) } values$data <- data }) ## R_HANDSONTABLE ---- output$table_in_primary <- renderRHandsontable({ rh <- rhandsontable(values$data, height = 300, colHeaders = c("Layer ID", "Thickness (cm)", "Sample offset (cm)", "K (%)", "error", "Th (ppm)", "error", "U (ppm)", "error", "Water content (%)", "error", "Density (g/cm3)"), rowHeaders = NULL) rh <- hot_cols(rh, renderer = " function(instance, td, row, col, prop, value, cellProperties) { Handsontable.renderers.NumericRenderer.apply(this, arguments); if (col != 2 && !value) { td.style.background = 'crimson'; td.style.textDecoration = 'line-through'; } else if (col == 2 && !value) { td.style.background = 'darkgrey'; } }") invalid_rows <- which(!complete.cases(values$data[ ,-3])) if (length(invalid_rows) > 0) { for (i in 1:length(invalid_rows)) rh <- hot_cell(rh, row = invalid_rows[i], col = 1, comment = paste("Layer removed due to incomplete layer information.", "Please check all values and fill in missing information", "if applicable.")) } rh }) observeEvent(input$table_in_primary, { if (!is.null(hot_to_r(input$table_in_primary))) values$data <- hot_to_r(input$table_in_primary) }) ## INPUT DATA CHECK ---- observe({ ## remove incomplete rows # note that we have to remove the third column (sample_offset), which # explicitly requires NA values for all non-target layers tmp <- values$data[complete.cases(values$data[ ,-3]), ] values$data_used <- tmp }) ## ARGUMENTS ---- observe({ # compile args args <- list( data = values$data_used, conversion_factors = input$conv_fac, fractional_gamma_dose = input$frac_dose, plot = TRUE, plot_single = TRUE, verbose = FALSE ) # sanitise final list by removing all NULL elements args[sapply(args, is.null)] <- NULL # return values$args <- args }) ## SHINY MODULES ---- observe({ # nested renderText({}) for code output on "R plot code" tab code.output <- callModule(RLumShiny:::printCode, "printCode", n_input = 1, fun = paste0("scale_GammaDose(data,"), args = values$args) output$plotCode<- renderText({ code.output })##EndOf::renderText({}) callModule(RLumShiny:::exportCodeHandler, "export", code = code.output) callModule(RLumShiny:::exportPlotHandler, "export", fun = "scale_GammaDose", args = values$args) }) ## MAIN ---- ## Calculate results # observe({ # tryCatch({ # values$results <- do.call(scale_GammaDose, values$args) # }, error = function(e) { # values$error <- e # values$results <- NULL # }) # }) ## PLOT ---- output$main_plot <- renderPlot({ tryCatch({ values$results <- do.call(scale_GammaDose, values$args) }, error = function(e) { values$error <- e values$results <- NULL }) }) ## ERROR HANDLING ---- output$error <- renderText({ # invalidate all reactive values if (!is.null(values$error)) { values$results <- NULL HTML(paste0( tags$br(), tags$p("ERROR!", style = "color:red; font-size:20px;"), values$error$message )) } }) ## NUMERIC RESULTS ---- output$console <- renderText({ if (is.null(values$results)) return(NULL) values$error <- NULL res <- as.data.frame(get_RLum(values$results)) inf_table <- get_RLum(values$results, "dose_rates")$infinite_matrix HTML(paste0( tags$br(), tags$p("RESULTS", style = "color:#008000; font-size:20px;"), tags$p( tags$b("Target layer: "), res$id, tags$br(), tags$b("Scaled gamma dose rate (Gy/ka): "), f(res$dose_rate_total), "\u00b1", f(res$dose_rate_total_err), tags$br(), style = "font-size:15px" ) )) }) ## TABLE 1: Infinite matrix dose rate ---- output$df_inf <- renderDataTable({ if (is.null(values$results)) return(NULL) df <- get_RLum(values$results, "dose_rates")$`infinite_matrix` for (i in 2:ncol(df)) df[,i] <- f(df[,i]) df }, options = list(ordering = FALSE, searching = FALSE, paging = FALSE)) ## TABLE 2: Scaled gamma dose rate ---- output$df_scaled <- renderDataTable({ if (is.null(values$results)) return(NULL) df <- get_RLum(values$results, "dose_rates")$scaled_dose_rate for (i in 2:ncol(df)) df[,i] <- f(df[,i]) df }, options = list(ordering = FALSE, searching = FALSE, paging = FALSE)) }##EndOf::function(input, output)RLumShiny/inst/shiny/scalegamma/www/0000755000176200001440000000000014175060542017175 5ustar liggesusersRLumShiny/inst/shiny/scalegamma/www/RL_Logo.png0000644000176200001440000007222114175060542021204 0ustar liggesusersPNG  IHDR pHYs.#.#x?v OiCCPPhotoshop ICC profilexڝSgTS=BKKoR RB&*! J!QEEȠQ, !{kּ> H3Q5 B.@ $pd!s#~<<+"x M0B\t8K@zB@F&S`cbP-`'{[! eDh;VEX0fK9-0IWfH  0Q){`##xFW<+*x<$9E[-qWW.(I+6aa@.y24x6_-"bbϫp@t~,/;m%h^ uf@Wp~<5j>{-]cK'Xto(hw?G%fIq^D$.Tʳ?D*A, `6B$BB dr`)B(Ͱ*`/@4Qhp.U=pa( Aa!ڈbX#!H$ ɈQ"K5H1RT UH=r9\F;2G1Q= C7F dt1r=6Ыhڏ>C03l0.B8, c˱" VcϱwE 6wB aAHXLXNH $4 7 Q'"K&b21XH,#/{C7$C2'ITFnR#,4H#dk9, +ȅ3![ b@qS(RjJ4e2AURݨT5ZBRQ4u9̓IKhhitݕNWGw Ljg(gwLӋT071oUX**| J&*/Tު UUT^S}FU3S ԖUPSSg;goT?~YYLOCQ_ cx,!k u5&|v*=9C3J3WRf?qtN (~))4L1e\kXHQG6EYAJ'\'GgSSݧ M=:.kDwn^Loy}/TmG X $ <5qo</QC]@Caaᄑ.ȽJtq]zۯ6iܟ4)Y3sCQ? 0k߬~OCOg#/c/Wװwa>>r><72Y_7ȷOo_C#dz%gA[z|!?:eAAA!h쐭!ΑiP~aa~ 'W?pX15wCsDDDޛg1O9-J5*>.j<74?.fYXXIlK9.*6nl {/]py.,:@LN8A*%w% yg"/6шC\*NH*Mz쑼5y$3,幄'L Lݛ:v m2=:1qB!Mggfvˬen/kY- BTZ(*geWf͉9+̳ې7ᒶKW-X潬j9(xoʿܔĹdff-[n ڴ VE/(ۻCɾUUMfeI?m]Nmq#׹=TR+Gw- 6 U#pDy  :v{vg/jBFS[b[O>zG499?rCd&ˮ/~јѡ򗓿m|x31^VwwO| (hSЧc3-gAMA|Q cHRMz%u0`:o_FiIDATx}td%! )+7ږJ["\wKIQl7YWtFuftZǙ]=8n-Ot) q\p7ab SZMM@z K[yӧO?_7n\ pw~ \i$eo .<_: @IpB^D=c,JN+߻jժ8|()ٞ /MMM#g̙d\]w5f߾}}vP2.^zTq㢯ψ˼W馛FGN#P.NȦG"suhll4(E%>F]]Q~o=6mdPcbŊZ|ب˼xaPl."o,۷o7.E˼۷… K;|XRJw}~(T_u^^矏F?mƼ|>{WkΜ9 sl瞲^O$y1qIJƍ>?qZ*/,YR߳?8F-uy۷o VOF8GrWXQIU\VZ~OVײo߾ؾ}>F$yӧW4nܸ2oΜ9U5GN? [/o .گ矏F?Uc^]]]U}G9{`]vEL:)de1!Ҭ!UVǴi?Y>K苧鍈m{N}?SJ_m[2#@%6 qw;4T>u>o_ODPVbcލ7X3_}b5502|eXV"c?9E__H6;OYO?{P+z{{cժU̙30Q>= v@$&-Y$1ߔؾ}{x~BA"1oo߾D}c.\~B^GeqHDļ\.oΊ+S Z~OϸRc^O7gժU>p۾/zNDx0c^>^oЍ7~RDz_ž>`j:s=۷/={VSOHl;|pZ*ߤn)5ɿ "٘w;=c?:tƇO,P^|@ }XpaYO-P5<6 KKf"žhf5Yr\*YsO<~j~VTHż/SZjUٟY o Mg߁}wBy/B{ｩ-Y$%Oxt T̻뮻R ۷o_l߾=nF?@Ѹ 5>ߑ"~. 1ZJjb^.(+V<`('o<{<J*b^(UV?hll4P>ܰ5"ؾϣ1H o։y@<<BБczf@by@ܻ?:7l@y@"?H41i|>6u툮m{<Oj@y@MH31 O["%UMC%U%ǃ_vU<*xT'q"νsֈ!F@G=O5#B;tX^9zNxp~۱G"Z(1( /s̳ŗlr (1|>+ /2xPb0lV>>*Aŗ^U_Gj<`H!gZ>b R KNζ=GE<Rb<\|i;!@ sŮj)5 j)PqEsܰUÑ" <(5m <8G\}'<<8/r7e!(yc-Pnb¡#⾕ y@Yy0B; [<3 T<5m]=BP1b Tmq)7^\|QL0..ln_a$H01Bo1S.yCןuuugZ 'A\}'<EګrlH71`0=?0pN^.0 "57b4B0g qascwZHpw)154qG y._y\Eb%Amk5Gfx, <1T NwY q'A x%OƧ%p[hO|o<(m[ ̾WJ7?54raA8Ẹ:r,qGmkR $QU|ܷ!!Txڣ $QU> yHyT޾ D<FḲ*<@\yT#D<Ẹ|NI%Plbm{|N35.>%raA(1y͏#1D<JṂ"Kk6 y$ָܶh\s|%1Id<*scCP涵FD_{A(91;tX15mK(|>|ԬrP @ىyʯ|Cȣ& ~.GOo*Ḅl~d8xԜm+/f *J̣,|Zj-]:7luGUp@y̓_G ^}}q Q 6WyEQWWg81asGmk2scc*8< Z yP<s25^+E23-yP|bcWw!5!JC5a>Wy#o~% ;7"@y¦o#!qJw#q[\1"sZ!D#""|8x ָܶ+cc@yDD} <m|!//涵nH1/|^^]FFH!Wy\b^8x)*IK_z)*MK'z/RU$PORU$P]!e涵u4$@FH2s`b^?KmNK'2O\p! ļ'"sZchļz$#@ y w)[b^y#ܶhb^>wܛlSq^|)"%sM;:n20ORbn[k̼l! Eļ&|30dfH1/A6=7BJ<H/1/A~p>/MK˼47RLKggxӔ)&Abb^Be^*44RLK5B]>} <ozF\=-Fk#$ <d yP涵F}@کP#)'@ !ᮻ #b^R'O!ZyP+<\|1j yP+<b1j5B!@FyP#<bԀ_7KK9W_ayNbԘ=RHK7Mhرq#@ y R__fN7D WK/RFK:# )#%̕o))#%7]b-0s)Q[H1/a]8)Q[H1/a6])_RBK#ؾm{;RBK٭o1Ba#@ y tٛh! ļ4q`a@:y 42{b~pb^BaFH>t1$P_sRfwwOt}o! ļsF۱u$Po2K0Ru$P FH)y\b^]KB ļ[0wRu$`3/sRu$`Z!\@y !\@y w˂9FHOtl۱Pļ-'63T11/CJD5گ1[({ >7Q-<(xԖsBOb^[!8'AϿ0#R{{;ޮg[?1`<:b/ z0 bg:b z{1`" c\aޥqQA zg;c ΣTvw?x`7Bc|v'/^z PǰΣԺ+>yߚ/g 1"(=Wޛn f[1\1b\Qr//|-e0#{ ( _*>TsǨym۱|m)c?01[[[o!(nz>RvwCϟ#G5 QT3N2 W߉P<06{bՃ#>J&Qt !QuXcjGI_UaYz~z od>}'?yTx\pQzb%3eldo!"BУ*=ӧܒqKfQjb%' AU۱:@U({/-Uo0WqWYuuuy%&xܖ1?wĕO3 UC̣,l<*b-7=?4-#%Qu|~i#0\bUVz[^iNJom}sdo!"|~sz{hweo뮙uuuH91' Aj F=15n̉mPo:Tp̚9/VkOeG26>t;sVA~Ջ{ڷ^\ _?]x]wѱx~\d^'NGpOE㎎˧ A%n-|q*D#xpX|q(#1074?G%rc'GkƧ%&G\2iB|wD熭Pb~UT@w5W˦z+.9H,A*ފ;59=.|#G_Uw!OЃ|+CsZq͑;;̾;V}[qQ5eԘ Ώ?Y\@ XOzUN!߽4> 2cd/*kxAT'18d:r,[PD1[`H3NrGo<`XuŲw(@x]ns-<`zJe0j__;36u툮m{\@y?" b-qQQJMø>OJgEt\%~U1Y-<=(y@Ųc>tLJ!߽4?eQol2g}.fdIH|wMo 0LbP13N6T̡#Ǣ!`D__Ƌ/|*E}@y@xx sLݟ.^"%/uԵCȣ\6 *|u_}'"A-ChinY3gbn+CE߱g#O?/C V~((KHN};o~X?N>q|S&A?547 O^}}7ힾ#ⷱO?k&A]U岙fCT W?ypБc)yRmvGAlԣT1RБcwtblCT1R辕ʣ\6 y2;7Cjok=)ӹa< e37UJ̃ٸQ#PP.E)kWy iFbbĦB岙fCT91Rŗ^m{ AA-͍1cdCT91R`W*rLܾd!j d8x'M0@  WyfFy`޾S&ئ1b$u]QP.yP?yUCjokuPc]e-͍1k C$5fW*rLܾd!J̃d8x'M0@ByPC֮*rLq!L̃q1Wy iꔉq `bԈ6ʣ\6K7@‰yP9}' AAW]1-61@‰yP\1\6 m{ f͜a"B̃ԵU岙x )bTHRKscL4"A]U岙}C bT3>5M2U!A|iFWyfb5<(CGEo CP)clCbu]QP.ws!8#1hR{[k3:7luGAl&2f<({rLܺ`N<(|>*aΕF`HbB岙XnJ̃ѵm!(1f͜aJ̃[oʣ\6/Y`Ẽ?~21C5s( 1F`SWyfw,6%#0?*!47I @Ɉy0LkoqGAl&n_̳ŁG AASLt@ɉy0 _ZU岙Xx!(91Бcw4u4gzfWyf]\hB̃!ܻUCjok_:CPb sVWyf"3o!(1 عw((ĭ D}}1(1 ϻns(+1`S!rLt,j7e'ڶf0e'7\QP.ۗ,0!iZc "<8[\Q<*M̃9t䘫<4uDWyTzfWyfb<^0]uŴ4T*岙6TGܻUCjokzCPqb׹a< e37T1Tζ=F\6]P5<4k #Xb5cS! m{ f͜aRỊl*rLq!H-1<3M6%Q5֮*rLܾd!H51d8x4uĘwY4Z#i<*bS!rLt,j7Gڶf0G=oʣ\6/Y`81?~2vuZc 3(뷸ʣ Wy0419tX8x4uDWy01Yn< e3t|C<Бcw4u401pPrLܙpb%s~Wy 5 g!Qrʣ\6y  QRٶfcQ<&1G]1Y3gỊd6u(h*>1[*FḤ$V~((KFḤZc (뷸ʣ\6wtl1:t䘫<4uĸhQ(6ʣ\6K7G:r,zNZclC(y}+rGAl&2f΁GQܻ 5 @̣(:7luGAl&C98g7?j e3ѱ=HڶUC5s<ɦB岙fC@yZѵm!(1fLl(1Q[~< e3q"'Ƙ:7luǐn5M2UGA_ZU岙Xx!<Бcw4u4PFbgzfWyf-2x{cHmQ__o(31ܰU岙̛m1Wζ=F\6.**D|>o~UCaΕF 8eS!rLt,j7TGD*# 1f͜a 1Xoʣ\6/Y`01?~2 []1_k!b^Bm!QP.E#%P>m{ f͜a1b^=oʣ\6c!y d147I 5HK뷸ʣ\6/Y`Qb^m{\1Y3gR@̫rvyfΎ )!U_z9147ƌi>B̫b-Wyf% )"U'Ƙm{ f͜aH91 |UÑQe3ѱ$aL>=VX/Af0jժhjj5ƨBbB.ۗ,0c}vcT1F1&O`?.\mmmk*  m'N+VD>7Hy0BSLt@*Z*~~/1*D̃e3t|C}?~|<(31F+ئ1 ꫯx R&b S.m ٷo_455Ŋ+Qb S{[k`ժUQWW۷o7F y0 l&2fb…1~8|1J@̃e3ѱU SL>=r+21aFzG)>cCF{<"`-͍c…΁䲙}C@۷/O+Vyz A-͍1yC@ Z*sM1F@̃3e3e %}ypSLMc epdb󴵞qP٪z*Su+4^)RkߥЉtB&!dfD1cV0dd/0ɽM$>>>zm>|36cuu5v\\\h'#7+rt4#<@x ,C3jZk{<֭[1ݻggg0k>|Ƞpj5v ̃xT*idXӉR~{4D^Z'''Z0k>| f<z4HMȨ5ATx"k-M&I^pߏz7w&kMВ$n[[[\0I4cmm-Wrv;...r.atbyy97y>Z~!q܌o.yp8h W0Bt:Q*{05 (ͨjq||Zyxɓ(J3U0>^GVL#KX__v=yz<Nj5^쾘[ <4MG?<$I(AT*!K>ߍhsEj<og%/M8< ]qxx+++~On`a%I^/Aa jnF*̚y,Vxpk73iZa{  Ӓ$n[㴟-UĹx3i4JE3>  3$pXxqLz1y0W;;;1LŻl4Mw v0SIQ A5 nFЌ+ qV+ϣlh7XRDLiK4ceeE3<.Iz1 yS$`vh4-͘2aSj4ok"iښfܰ<`p-IDuvvvvślF{{{QT4cvJ?}'W$ph.ޜ9f /1yqW""ZVL&h41?4~o.^9f @Dwtt@ :E[L>y煋0 L|10?f@|v]k /\9f ōui]ug@nΕ7l`|?\+o+OvVՃ}UV:Ws-7m+Ov}sVJ!cSY+rfjY9@L5/+g@X@7rDypcXyQ  n<,l&4nȉnb[z,D]z,[X{dIXxs{Zf/s6ٙIENDB`RLumShiny/inst/shiny/scalegamma/www/style.css0000644000176200001440000000242714175060542021054 0ustar liggesusers.custom-modal { padding-left: 10px; padding-top: 10px; padding-bottom: 10px; padding-right: 10px; line-height: 200%; background-color: #fff; overflow: visible; position: absolute; z-index: 999; border-radius: 10px; border-style: solid; border-color: #428bca; } .h { font-size: 11px; margin: 0 0 0px; } h5, h6 { color: #428bca; } .tooltip-inner { max-width: 450px; } .control-label, .selectize-dropdown, .item, .btn, .uneditable-input, .sorting, .odd, .even, .dataTables-info, .fa, .fa-refresh { font-size: 12px; } .selectize-input { padding: 0px 10px; min-height: 20px; } label, body, input { font-size: 12px; } .label, .badge { font-size: 12px; padding: 4px 20px; margin: 10px; line-height: 18px; } .label-info, .badge-info { background-color: #428bca; } input[type="text"],input[type="number"],input[type="email"],input[type="url"],input[type="search"],input[type="tel"],input[type="color"],.uneditable-input{ display:inline-block; height:18px; padding:0px 0px 0px 7px; margin-bottom:10px; font-size: 11px; line-height: 1.5; color:#555; vertical-align:middle; -webkit-border-radius:4px; -moz-border-radius:4px; border-radius:4px } input,textarea,.uneditable-input{ width: auto; } RLumShiny/inst/shiny/scalegamma/www/GitHub-Mark-32px.png0000644000176200001440000000326214175060542022552 0ustar liggesusersPNG  IHDR szztEXtSoftwareAdobe ImageReadyqe<$iTXtXML:com.adobe.xmp $IDATxėmhayL30A+R#f>IHکy(M)_o5 0+0Ėl&o{i^]u<{Yws}=uC>$L, }<w}8^ AO?p! xaяPKI3`'B>0QT1<+`}^nvkp^ƅF|1"Gp.*oO׀Vp ]߅jc8K$q 8jV`#`vmpGѢu!#}#:U_?_yhE $=;c*xNOo+&w)%K-R%6n'o">j/t³qoGW7j%2q GX?woibCÐAzbǰt \14|S.DZ]# b|H$(ʕohmqͱRP셣$,0Z20 tNvRW3K8Xk2 IO6 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 rHandsontableOutput(outputId = "table_in_primary"), helpText(HTML(paste0( tags$b("NOTE: "), "The uploaded file must have exactly 12 columns (see pre-loaded data set above). ", "Only one value in 'Sample offset (cm)' allowed, which indicates the position of the sample in a layer, measured from the bottom of respective layer.", "
Right-click on the table to add or remove rows. Copy-paste is supported.") )) ),##EndOf::Tab_1 tabPanel("Settings", tags$br(), selectInput(inputId = "frac_dose", "Fractional gamma dose table", choices = c("Aitken 1985" = "Aitken1985") ), selectInput(inputId = "conv_fac", "Conversion Factors", choices = c( "Cresswell et al. 2018" = "Cresswelletal2018", "Liritzis et al. 2013" = "Liritzisetal2013", "Guerin et al. 2011" = "Guerinetal2011", "Adamiec & Aitken 1998" = "AdamiecAitken1998" ) ) ), RLumShiny:::exportTab("export", filename = "scalegammadose"), RLumShiny:::aboutTab("about", "scalegammadose") )##EndOf::tabsetPanel ),##EndOf::sidebarPanel # 3 - output panel mainPanel(width = 7, # insert css code inside 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", htmlOutput("error"), plotOutput(outputId = "main_plot", height = "500px"), htmlOutput(outputId = "console")), tabPanel("Infinite matrix \u1E0A\u03B3", dataTableOutput("df_inf")), tabPanel("Scaled \u1E0A\u03B3", dataTableOutput("df_scaled")), tabPanel("R code", verbatimTextOutput("plotCode")) )###EndOf::tabsetPanel )##EndOf::mainPanel ),##EndOf::sideBarLayout bookmarkButton() )##EndOf::fluidPage } RLumShiny/inst/shiny/convert/0000755000176200001440000000000014175060542015737 5ustar liggesusersRLumShiny/inst/shiny/convert/global.R0000644000176200001440000000026114175060542017321 0ustar liggesusers## global.R ## library(Luminescence) library(RLumShiny) library(shiny) library(data.table) library(rhandsontable) source("select.R") enableBookmarking(store = "server")RLumShiny/inst/shiny/convert/select.R0000644000176200001440000000305714175060542017346 0ustar liggesusers## set_selected <- function(x, pos = NULL, curve = NULL) { if (!is.list(x)) stop("\n[set_selected] 'x' must be a list.", call. = FALSE) if (is.list(curve)) if (length(pos) != length(curve)) stop("\n[set_selected] 'x' and 'curve' must be of same length.", call. = FALSE) # Set everything to false for (i in 1:length(x)) { x[[i]]@info$selected <- FALSE for (j in 1:length(x[[i]]@records)) x[[i]]@records[[j]]@info$selected <- FALSE } # Case 3: set selected curves if (!is.null(pos)) { for (i in 1:length(pos)) { x[[pos[i]]]@info$selected <- TRUE if (!is.null(curve)) { for (j in curve[[i]]) { if (is.na(j)) next if (j == 0) next x[[pos[i]]]@records[[j]]@info$selected <- TRUE } } else { for (j in 1:length(x[[pos[i]]]@records)) x[[pos[i]]]@records[[j]]@info$selected <- TRUE } } } return(x) } get_selected <- function(x) { # selected aliquots sel_al <- sapply(x, function(x) x@info$selected) is_null <- which(sapply(sel_al, is.null)) if (length(is_null) != 0) sel_al[is_null] <- FALSE if (is.list(sel_al)) sel_al <- unlist(sel_al) x <- x[sel_al] # selected curves for (i in 1:length(x)) { is_selected <- sapply(x[[i]], function(y) y@info$selected) x[[i]]@records <- x[[i]]@records[is_selected] if (length(x[[i]]@records) == 0) x[[i]] <- NULL } return(x) } RLumShiny/inst/shiny/convert/server.R0000644000176200001440000000762014175060542017375 0ustar liggesusers## Server.R ## MAIN FUNCTION function(input, output, session) { # input data (with default) values <- reactiveValues(data = NULL, data_filtered = NULL, positions = NULL, types = NULL) session$onSessionEnded(function() { stopApp() }) # check and read in file (DATA SET 1) observeEvent(input$import, { inFile<- input$file if(is.null(inFile)) return(NULL) # 1. Risoe .bin(x) if (tools::file_ext(inFile$name) == "bin" || tools::file_ext(inFile$name) == "binx") { # rename temp file file <- paste0(inFile$datapath, ".", tools::file_ext(inFile$name)) file.rename(inFile$datapath, file) # import the file values$data <- read_BIN2R(file, fastForward = TRUE, verbose = FALSE) values$data_filtered <- values$data # set some diagnostic values values$positions <- unique(sapply(values$data, function(x) { x@records[[1]]@info$POSITION })) values$types <- unique(sapply(values$data[[1]]@records, function(x) { x@recordType })) } }) output$positions <- renderUI({ if (!is.null(values$positions)) checkboxGroupInput("positions", "Positions", choiceNames = as.character(values$positions), choiceValues = 1:length(values$positions), selected = 1:length(values$positions), inline = TRUE) }) output$curveTypes <- renderUI({ if (!is.null(values$types)) checkboxGroupInput("curveTypes", "Curve types", choices = values$types, selected = values$types) }) ## FILTER ---- observe({ if (is.null(values$data)) return(NULL) data_filtered <- values$data[as.numeric(input$positions)] values$data_filtered <- lapply(data_filtered, function(x) { subset(x, recordType %in% input$curveTypes) }) }) ## --------------------- OUTPUT ------------------------------------------- ## output$positionTabs <- renderUI({ if (is.null(values$data_filtered)) return(NULL) tabs <- lapply(values$positions[as.numeric(input$positions)], function(pos) { tabPanel(pos, plotOutput(paste0("pos", pos))) }) do.call(tabsetPanel, c(id = "tab", tabs)) }) observe({ input$tab values$data values$data_filtered input$curveTypes if (is.null(values$data_filtered) || length(values$data_filtered) == 0) return(NULL) pos <- which(unique(sapply(values$data_filtered, function(x) { x@records[[1]]@info$POSITION })) == input$tab) print(pos) if (length(pos) > 0) updateCheckboxGroupInput(session, "curves", choices = 1:length(values$data_filtered[[pos]]), selected = 1:length(values$data_filtered[[pos]]), inline = TRUE) }) observeEvent(input$export, { if (is.null(values$data_filtered)) return(NULL) do.call(input$targetFile, values$data_filtered) }) observe({ pos_sel <- values$positions[as.numeric(input$positions)] pos_sel_index <- which(values$positions %in% pos_sel) for (i in 1:length(pos_sel)) # Explanation on local({}): # https://gist.github.com/wch/5436415/ local({ local_i <- i output[[paste0("pos", pos_sel[local_i])]] <- renderPlot({ if (is.null(values$data_filtered[[local_i]])) { plot(0, type = "n", axes = FALSE, ann = FALSE) return(NULL) } else { plot(values$data_filtered[[local_i]], combine = TRUE) } }) }) }) }##EndOf::function(input, output)RLumShiny/inst/shiny/convert/www/0000755000176200001440000000000014175060542016563 5ustar liggesusersRLumShiny/inst/shiny/convert/www/RL_Logo.png0000644000176200001440000007222114175060542020572 0ustar liggesusersPNG  IHDR pHYs.#.#x?v OiCCPPhotoshop ICC profilexڝSgTS=BKKoR RB&*! J!QEEȠQ, !{kּ> H3Q5 B.@ $pd!s#~<<+"x M0B\t8K@zB@F&S`cbP-`'{[! eDh;VEX0fK9-0IWfH  0Q){`##xFW<+*x<$9E[-qWW.(I+6aa@.y24x6_-"bbϫp@t~,/;m%h^ uf@Wp~<5j>{-]cK'Xto(hw?G%fIq^D$.Tʳ?D*A, `6B$BB dr`)B(Ͱ*`/@4Qhp.U=pa( Aa!ڈbX#!H$ ɈQ"K5H1RT UH=r9\F;2G1Q= C7F dt1r=6Ыhڏ>C03l0.B8, c˱" VcϱwE 6wB aAHXLXNH $4 7 Q'"K&b21XH,#/{C7$C2'ITFnR#,4H#dk9, +ȅ3![ b@qS(RjJ4e2AURݨT5ZBRQ4u9̓IKhhitݕNWGw Ljg(gwLӋT071oUX**| J&*/Tު UUT^S}FU3S ԖUPSSg;goT?~YYLOCQ_ cx,!k u5&|v*=9C3J3WRf?qtN (~))4L1e\kXHQG6EYAJ'\'GgSSݧ M=:.kDwn^Loy}/TmG X $ <5qo</QC]@Caaᄑ.ȽJtq]zۯ6iܟ4)Y3sCQ? 0k߬~OCOg#/c/Wװwa>>r><72Y_7ȷOo_C#dz%gA[z|!?:eAAA!h쐭!ΑiP~aa~ 'W?pX15wCsDDDޛg1O9-J5*>.j<74?.fYXXIlK9.*6nl {/]py.,:@LN8A*%w% yg"/6шC\*NH*Mz쑼5y$3,幄'L Lݛ:v m2=:1qB!Mggfvˬen/kY- BTZ(*geWf͉9+̳ې7ᒶKW-X潬j9(xoʿܔĹdff-[n ڴ VE/(ۻCɾUUMfeI?m]Nmq#׹=TR+Gw- 6 U#pDy  :v{vg/jBFS[b[O>zG499?rCd&ˮ/~јѡ򗓿m|x31^VwwO| (hSЧc3-gAMA|Q cHRMz%u0`:o_FiIDATx}td%! )+7ږJ["\wKIQl7YWtFuftZǙ]=8n-Ot) q\p7ab SZMM@z K[yӧO?_7n\ pw~ \i$eo .<_: @IpB^D=c,JN+߻jժ8|()ٞ /MMM#g̙d\]w5f߾}}vP2.^zTq㢯ψ˼W馛FGN#P.NȦG"suhll4(E%>F]]Q~o=6mdPcbŊZ|ب˼xaPl."o,۷o7.E˼۷… K;|XRJw}~(T_u^^矏F?mƼ|>{WkΜ9 sl瞲^O$y1qIJƍ>?qZ*/,YR߳?8F-uy۷o VOF8GrWXQIU\VZ~OVײo߾ؾ}>F$yӧW4nܸ2oΜ9U5GN? [/o .گ矏F?Uc^]]]U}G9{`]vEL:)de1!Ҭ!UVǴi?Y>K苧鍈m{N}?SJ_m[2#@%6 qw;4T>u>o_ODPVbcލ7X3_}b5502|eXV"c?9E__H6;OYO?{P+z{{cժU̙30Q>= v@$&-Y$1ߔؾ}{x~BA"1oo߾D}c.\~B^GeqHDļ\.oΊ+S Z~OϸRc^O7gժU>p۾/zNDx0c^>^oЍ7~RDz_ž>`j:s=۷/={VSOHl;|pZ*ߤn)5ɿ "٘w;=c?:tƇO,P^|@ }XpaYO-P5<6 KKf"žhf5Yr\*YsO<~j~VTHż/SZjUٟY o Mg߁}wBy/B{ｩ-Y$%Oxt T̻뮻R ۷o_l߾=nF?@Ѹ 5>ߑ"~. 1ZJjb^.(+V<`('o<{<J*b^(UV?hll4P>ܰ5"ؾϣ1H o։y@<<BБczf@by@ܻ?:7l@y@"?H41i|>6u툮m{<Oj@y@MH31 O["%UMC%U%ǃ_vU<*xT'q"νsֈ!F@G=O5#B;tX^9zNxp~۱G"Z(1( /s̳ŗlr (1|>+ /2xPb0lV>>*Aŗ^U_Gj<`H!gZ>b R KNζ=GE<Rb<\|i;!@ sŮj)5 j)PqEsܰUÑ" <(5m <8G\}'<<8/r7e!(yc-Pnb¡#⾕ y@Yy0B; [<3 T<5m]=BP1b Tmq)7^\|QL0..ln_a$H01Bo1S.yCןuuugZ 'A\}'<EګrlH71`0=?0pN^.0 "57b4B0g qascwZHpw)154qG y._y\Eb%Amk5Gfx, <1T NwY q'A x%OƧ%p[hO|o<(m[ ̾WJ7?54raA8Ẹ:r,qGmkR $QU|ܷ!!Txڣ $QU> yHyT޾ D<FḲ*<@\yT#D<Ẹ|NI%Plbm{|N35.>%raA(1y͏#1D<JṂ"Kk6 y$ָܶh\s|%1Id<*scCP涵FD_{A(91;tX15mK(|>|ԬrP @ىyʯ|Cȣ& ~.GOo*Ḅl~d8xԜm+/f *J̣,|Zj-]:7luGUp@y̓_G ^}}q Q 6WyEQWWg81asGmk2scc*8< Z yP<s25^+E23-yP|bcWw!5!JC5a>Wy#o~% ;7"@y¦o#!qJw#q[\1"sZ!D#""|8x ָܶ+cc@yDD} <m|!//涵nH1/|^^]FFH!Wy\b^8x)*IK_z)*MK'z/RU$PORU$P]!e涵u4$@FH2s`b^?KmNK'2O\p! ļ'"sZchļz$#@ y w)[b^y#ܶhb^>wܛlSq^|)"%sM;:n20ORbn[k̼l! Eļ&|30dfH1/A6=7BJ<H/1/A~p>/MK˼47RLKggxӔ)&Abb^Be^*44RLK5B]>} <ozF\=-Fk#$ <d yP涵F}@کP#)'@ !ᮻ #b^R'O!ZyP+<\|1j yP+<b1j5B!@FyP#<bԀ_7KK9W_ayNbԘ=RHK7Mhرq#@ y R__fN7D WK/RFK:# )#%̕o))#%7]b-0s)Q[H1/a]8)Q[H1/a6])_RBK#ؾm{;RBK٭o1Ba#@ y tٛh! ļ4q`a@:y 42{b~pb^BaFH>t1$P_sRfwwOt}o! ļsF۱u$Po2K0Ru$P FH)y\b^]KB ļ[0wRu$`3/sRu$`Z!\@y !\@y w˂9FHOtl۱Pļ-'63T11/CJD5گ1[({ >7Q-<(xԖsBOb^[!8'AϿ0#R{{;ޮg[?1`<:b/ z0 bg:b z{1`" c\aޥqQA zg;c ΣTvw?x`7Bc|v'/^z PǰΣԺ+>yߚ/g 1"(=Wޛn f[1\1b\Qr//|-e0#{ ( _*>TsǨym۱|m)c?01[[[o!(nz>RvwCϟ#G5 QT3N2 W߉P<06{bՃ#>J&Qt !QuXcjGI_UaYz~z od>}'?yTx\pQzb%3eldo!"BУ*=ӧܒqKfQjb%' AU۱:@U({/-Uo0WqWYuuuy%&xܖ1?wĕO3 UC̣,l<*b-7=?4-#%Qu|~i#0\bUVz[^iNJom}sdo!"|~sz{hweo뮙uuuH91' Aj F=15n̉mPo:Tp̚9/VkOeG26>t;sVA~Ջ{ڷ^\ _?]x]wѱx~\d^'NGpOE㎎˧ A%n-|q*D#xpX|q(#1074?G%rc'GkƧ%&G\2iB|wD熭Pb~UT@w5W˦z+.9H,A*ފ;59=.|#G_Uw!OЃ|+CsZq͑;;̾;V}[qQ5eԘ Ώ?Y\@ XOzUN!߽4> 2cd/*kxAT'18d:r,[PD1[`H3NrGo<`XuŲw(@x]ns-<`zJe0j__;36u툮m{\@y?" b-qQQJMø>OJgEt\%~U1Y-<=(y@Ųc>tLJ!߽4?eQol2g}.fdIH|wMo 0LbP13N6T̡#Ǣ!`D__Ƌ/|*E}@y@xx sLݟ.^"%/uԵCȣ\6 *|u_}'"A-ChinY3gbn+CE߱g#O?/C V~((KHN};o~X?N>q|S&A?547 O^}}7ힾ#ⷱO?k&A]U岙fCT W?ypБc)yRmvGAlԣT1RБcwtblCT1R辕ʣ\6 y2;7Cjok=)ӹa< e37UJ̃ٸQ#PP.E)kWy iFbbĦB岙fCT91Rŗ^m{ AA-͍1cdCT91R`W*rLܾd!j d8x'M0@  WyfFy`޾S&ئ1b$u]QP.yP?yUCjokuPc]e-͍1k C$5fW*rLܾd!J̃d8x'M0@ByPC֮*rLq!L̃q1Wy iꔉq `bԈ6ʣ\6K7@‰yP9}' AAW]1-61@‰yP\1\6 m{ f͜a"B̃ԵU岙x )bTHRKscL4"A]U岙}C bT3>5M2U!A|iFWyfb5<(CGEo CP)clCbu]QP.ws!8#1hR{[k3:7luGAl&2f<({rLܺ`N<(|>*aΕF`HbB岙XnJ̃ѵm!(1f͜aJ̃[oʣ\6/Y`Ẽ?~21C5s( 1F`SWyfw,6%#0?*!47I @Ɉy0LkoqGAl&n_̳ŁG AASLt@ɉy0 _ZU岙Xx!(91Бcw4u4gzfWyf]\hB̃!ܻUCjok_:CPb sVWyf"3o!(1 عw((ĭ D}}1(1 ϻns(+1`S!rLt,j7e'ڶf0e'7\QP.ۗ,0!iZc "<8[\Q<*M̃9t䘫<4uDWyTzfWyfb<^0]uŴ4T*岙6TGܻUCjokzCPqb׹a< e37T1Tζ=F\6]P5<4k #Xb5cS! m{ f͜aRỊl*rLq!H-1<3M6%Q5֮*rLܾd!H51d8x4uĘwY4Z#i<*bS!rLt,j7Gڶf0G=oʣ\6/Y`81?~2vuZc 3(뷸ʣ Wy0419tX8x4uDWy01Yn< e3t|C<Бcw4u401pPrLܙpb%s~Wy 5 g!Qrʣ\6y  QRٶfcQ<&1G]1Y3gỊd6u(h*>1[*FḤ$V~((KFḤZc (뷸ʣ\6wtl1:t䘫<4uĸhQ(6ʣ\6K7G:r,zNZclC(y}+rGAl&2f΁GQܻ 5 @̣(:7luGAl&C98g7?j e3ѱ=HڶUC5s<ɦB岙fC@yZѵm!(1fLl(1Q[~< e3q"'Ƙ:7luǐn5M2UGA_ZU岙Xx!<Бcw4u4PFbgzfWyf-2x{cHmQ__o(31ܰU岙̛m1Wζ=F\6.**D|>o~UCaΕF 8eS!rLt,j7TGD*# 1f͜a 1Xoʣ\6/Y`01?~2 []1_k!b^Bm!QP.E#%P>m{ f͜a1b^=oʣ\6c!y d147I 5HK뷸ʣ\6/Y`Qb^m{\1Y3gR@̫rvyfΎ )!U_z9147ƌi>B̫b-Wyf% )"U'Ƙm{ f͜aH91 |UÑQe3ѱ$aL>=VX/Af0jժhjj5ƨBbB.ۗ,0c}vcT1F1&O`?.\mmmk*  m'N+VD>7Hy0BSLt@*Z*~~/1*D̃e3t|C}?~|<(31F+ئ1 ꫯx R&b S.m ٷo_455Ŋ+Qb S{[k`ժUQWW۷o7F y0 l&2fb…1~8|1J@̃e3ѱU SL>=r+21aFzG)>cCF{<"`-͍c…΁䲙}C@۷/O+Vyz A-͍1yC@ Z*sM1F@̃3e3e %}ypSLMc epdb󴵞qP٪z*Su+4^)RkߥЉtB&!dfD1cV0dd/0ɽM$>>>zm>|36cuu5v\\\h'#7+rt4#<@x ,C3jZk{<֭[1ݻggg0k>|Ƞpj5v ̃xT*idXӉR~{4D^Z'''Z0k>| f<z4HMȨ5ATx"k-M&I^pߏz7w&kMВ$n[[[\0I4cmm-Wrv;...r.atbyy97y>Z~!q܌o.yp8h W0Bt:Q*{05 (ͨjq||Zyxɓ(J3U0>^GVL#KX__v=yz<Nj5^쾘[ <4MG?<$I(AT*!K>ߍhsEj<og%/M8< ]qxx+++~On`a%I^/Aa jnF*̚y,Vxpk73iZa{  Ӓ$n[㴟-UĹx3i4JE3>  3$pXxqLz1y0W;;;1LŻl4Mw v0SIQ A5 nFЌ+ qV+ϣlh7XRDLiK4ceeE3<.Iz1 yS$`vh4-͘2aSj4ok"iښfܰ<`p-IDuvvvvślF{{{QT4cvJ?}'W$ph.ޜ9f /1yqW""ZVL&h41?4~o.^9f @Dwtt@ :E[L>y煋0 L|10?f@|v]k /\9f ōui]ug@nΕ7l`|?\+o+OvVՃ}UV:Ws-7m+Ov}sVJ!cSY+rfjY9@L5/+g@X@7rDypcXyQ  n<,l&4nȉnb[z,D]z,[X{dIXxs{Zf/s6ٙIENDB`RLumShiny/inst/shiny/convert/www/style.css0000644000176200001440000000242714175060542020442 0ustar liggesusers.custom-modal { padding-left: 10px; padding-top: 10px; padding-bottom: 10px; padding-right: 10px; line-height: 200%; background-color: #fff; overflow: visible; position: absolute; z-index: 999; border-radius: 10px; border-style: solid; border-color: #428bca; } .h { font-size: 11px; margin: 0 0 0px; } h5, h6 { color: #428bca; } .tooltip-inner { max-width: 450px; } .control-label, .selectize-dropdown, .item, .btn, .uneditable-input, .sorting, .odd, .even, .dataTables-info, .fa, .fa-refresh { font-size: 12px; } .selectize-input { padding: 0px 10px; min-height: 20px; } label, body, input { font-size: 12px; } .label, .badge { font-size: 12px; padding: 4px 20px; margin: 10px; line-height: 18px; } .label-info, .badge-info { background-color: #428bca; } input[type="text"],input[type="number"],input[type="email"],input[type="url"],input[type="search"],input[type="tel"],input[type="color"],.uneditable-input{ display:inline-block; height:18px; padding:0px 0px 0px 7px; margin-bottom:10px; font-size: 11px; line-height: 1.5; color:#555; vertical-align:middle; -webkit-border-radius:4px; -moz-border-radius:4px; border-radius:4px } input,textarea,.uneditable-input{ width: auto; } RLumShiny/inst/shiny/convert/www/GitHub-Mark-32px.png0000644000176200001440000000326214175060542022140 0ustar liggesusersPNG  IHDR szztEXtSoftwareAdobe ImageReadyqe<$iTXtXML:com.adobe.xmp $IDATxėmhayL30A+R#f>IHکy(M)_o5 0+0Ėl&o{i^]u<{Yws}=uC>$L, }<w}8^ AO?p! xaяPKI3`'B>0QT1<+`}^nvkp^ƅF|1"Gp.*oO׀Vp ]߅jc8K$q 8jV`#`vmpGѢu!#}#:U_?_yhE $=;c*xNOo+&w)%K-R%6n'o">j/t³qoGW7j%2q GX?woibCÐAzbǰt \14|S.DZ]# b|H$(ʕohmqͱRP셣$,0Z20 tNvRW3K8Xk2 IO6 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("Measurement file"), accept="application/octet-stream, .bin, .binx"), # import actionButton(inputId = "import", label = "Import", class = "btn btn-success"), tags$hr(), # dynamic elements depending on input file fluidRow( column(width = 6, uiOutput("positions") ), column(width = 6, uiOutput("curveTypes") ) ) ),##EndOf::Tab_1 tabPanel("Curves", div(align = "center", h5("(De)select individual curves")), checkboxGroupInput("curves", "Curves") ),##EndOf::Tab_4 tabPanel("Export", selectInput("targetFile", label = "Export to...", choices = list(".bin(x)" = "write_R2BIN", ".csv" = "write_RLum2CSV")), actionButton("export", "Download file", class = "btn btn-success") ) )##EndOf::tabsetPanel ),##EndOf::sidebarPanel # 3 - output panel mainPanel(width = 7, # insert css code inside 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 fluidRow( uiOutput("positionTabs") ) )##EndOf::mainPanel ),##EndOf::sideBarLayout bookmarkButton() )##EndOf::fluidPage }RLumShiny/inst/shiny/transformCW/0000755000176200001440000000000014175060542016524 5ustar liggesusersRLumShiny/inst/shiny/transformCW/UI.R0000644000176200001440000002676614175060542017205 0ustar liggesusers## UI.R 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
"), jscolorInput(inputId = "jscol1")) ) ), br(), 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(), 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 RLumShiny:::exportTab("export", filename = "transformCW"), RLumShiny:::aboutTab("about", "transformCW") )##EndOf::tabsetPanel ),##EndOf::sidebarPanel # 3 - output panel mainPanel(width = 7, # insert css code inside 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")))), tabPanel("R code", verbatimTextOutput("plotCode")) )###EndOf::tabsetPanel )##EndOf::mainPanel ),##EndOf::sideBarLayout bookmarkButton(), downloadButton("exportScript", "Download transformed data", class="btn btn-success") )##EndOf::fluidPage }RLumShiny/inst/shiny/transformCW/Server.R0000644000176200001440000001163214175060542020120 0ustar liggesusers## Server.R ## MAIN FUNCTION function(input, output, session) { # input data (with default) values <- reactiveValues(data_primary = if ("startData" %in% names(.GlobalEnv)) startData else ExampleData.CW_OSL_Curve, tdata = NULL, args = NULL, pargs = NULL) session$onSessionEnded(function() { stopApp() }) # check and read in file (DATA SET 1) observeEvent(input$file, { inFile<- input$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 }) output$table_in_primary <- renderRHandsontable({ rhandsontable(values$data_primary, height = 300, colHeaders = c("Time", "Signal"), 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_primary <- hot_to_r(df_tmp) }) # TRANSFORM DATA observe({ P <- input$p delta <- input$delta # validate method parameters if (is.na(input$delta)) { updateNumericInput(session, "delta", value = 1) delta <- 1 } else if (input$delta < 1) { updateNumericInput(session, "delta", value = 1) delta <- 1 } # validate method parameters if (is.na(input$p)) { updateNumericInput(session, "p", value = 1) P <- 1 } else if (input$p < 1) { updateNumericInput(session, "p", value = 1) P <- 1 } args <- list(values$data_primary) if (input$method == "CW2pHMi") if (delta >= 1) args <- append(args, delta) if (input$method == "CW2pLMi" || input$method == "CW2pPMi") if (P >= 1) args <- append(args, P) values$args <- args # values$export_args <- args values$tdata <- try(do.call(input$method, args)) }) output$main_plot <- renderPlot({ # be reactive on method changes input$method input$delta input$p if (inherits(values$tdata, "try-error")) { plot(1, type="n", axes=F, xlab="", ylab="") text(1, labels = paste(values$tdata, collapse = "\n")) return() } values$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$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), bty = "n") par(mar=c(5,4,4,5)+.1, cex = input$cex) do.call(plot, values$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() { "transformedCW.txt" }, content = function(file) { write.table(values$tdata, file, sep = ",", quote = FALSE, row.names = FALSE) },#EO content =, contentType = "text" )#EndOf::dowmloadHandler() }) observe({ # nested renderText({}) for code output on "R plot code" tab code.output <- callModule(RLumShiny:::printCode, "printCode", n_input = 1, fun = paste0(input$method, "(data,"), args = values$args) output$plotCode<- renderText({ code.output })##EndOf::renderText({}) callModule(RLumShiny:::exportCodeHandler, "export", code = code.output) callModule(RLumShiny:::exportPlotHandler, "export", fun = "plot", args = values$pargs) }) output$dataset <- renderDataTable({ if (!is.null(values$tdata)) values$tdata }) }##EndOf::function(input, output)RLumShiny/inst/shiny/transformCW/Global.R0000644000176200001440000000033014175060542020043 0ustar liggesusers## global.R ## library(Luminescence) library(RLumShiny) library(shiny) library(data.table) library(rhandsontable) data("ExampleData.CW_OSL_Curve", envir = environment()) enableBookmarking(store = "server")RLumShiny/inst/shiny/transformCW/www/0000755000176200001440000000000014175060542017350 5ustar liggesusersRLumShiny/inst/shiny/transformCW/www/RL_Logo.png0000644000176200001440000007222114175060542021357 0ustar liggesusersPNG  IHDR pHYs.#.#x?v OiCCPPhotoshop ICC profilexڝSgTS=BKKoR RB&*! J!QEEȠQ, !{kּ> H3Q5 B.@ $pd!s#~<<+"x M0B\t8K@zB@F&S`cbP-`'{[! eDh;VEX0fK9-0IWfH  0Q){`##xFW<+*x<$9E[-qWW.(I+6aa@.y24x6_-"bbϫp@t~,/;m%h^ uf@Wp~<5j>{-]cK'Xto(hw?G%fIq^D$.Tʳ?D*A, `6B$BB dr`)B(Ͱ*`/@4Qhp.U=pa( Aa!ڈbX#!H$ ɈQ"K5H1RT UH=r9\F;2G1Q= C7F dt1r=6Ыhڏ>C03l0.B8, c˱" VcϱwE 6wB aAHXLXNH $4 7 Q'"K&b21XH,#/{C7$C2'ITFnR#,4H#dk9, +ȅ3![ b@qS(RjJ4e2AURݨT5ZBRQ4u9̓IKhhitݕNWGw Ljg(gwLӋT071oUX**| J&*/Tު UUT^S}FU3S ԖUPSSg;goT?~YYLOCQ_ cx,!k u5&|v*=9C3J3WRf?qtN (~))4L1e\kXHQG6EYAJ'\'GgSSݧ M=:.kDwn^Loy}/TmG X $ <5qo</QC]@Caaᄑ.ȽJtq]zۯ6iܟ4)Y3sCQ? 0k߬~OCOg#/c/Wװwa>>r><72Y_7ȷOo_C#dz%gA[z|!?:eAAA!h쐭!ΑiP~aa~ 'W?pX15wCsDDDޛg1O9-J5*>.j<74?.fYXXIlK9.*6nl {/]py.,:@LN8A*%w% yg"/6шC\*NH*Mz쑼5y$3,幄'L Lݛ:v m2=:1qB!Mggfvˬen/kY- BTZ(*geWf͉9+̳ې7ᒶKW-X潬j9(xoʿܔĹdff-[n ڴ VE/(ۻCɾUUMfeI?m]Nmq#׹=TR+Gw- 6 U#pDy  :v{vg/jBFS[b[O>zG499?rCd&ˮ/~јѡ򗓿m|x31^VwwO| (hSЧc3-gAMA|Q cHRMz%u0`:o_FiIDATx}td%! )+7ږJ["\wKIQl7YWtFuftZǙ]=8n-Ot) q\p7ab SZMM@z K[yӧO?_7n\ pw~ \i$eo .<_: @IpB^D=c,JN+߻jժ8|()ٞ /MMM#g̙d\]w5f߾}}vP2.^zTq㢯ψ˼W馛FGN#P.NȦG"suhll4(E%>F]]Q~o=6mdPcbŊZ|ب˼xaPl."o,۷o7.E˼۷… K;|XRJw}~(T_u^^矏F?mƼ|>{WkΜ9 sl瞲^O$y1qIJƍ>?qZ*/,YR߳?8F-uy۷o VOF8GrWXQIU\VZ~OVײo߾ؾ}>F$yӧW4nܸ2oΜ9U5GN? [/o .گ矏F?Uc^]]]U}G9{`]vEL:)de1!Ҭ!UVǴi?Y>K苧鍈m{N}?SJ_m[2#@%6 qw;4T>u>o_ODPVbcލ7X3_}b5502|eXV"c?9E__H6;OYO?{P+z{{cժU̙30Q>= v@$&-Y$1ߔؾ}{x~BA"1oo߾D}c.\~B^GeqHDļ\.oΊ+S Z~OϸRc^O7gժU>p۾/zNDx0c^>^oЍ7~RDz_ž>`j:s=۷/={VSOHl;|pZ*ߤn)5ɿ "٘w;=c?:tƇO,P^|@ }XpaYO-P5<6 KKf"žhf5Yr\*YsO<~j~VTHż/SZjUٟY o Mg߁}wBy/B{ｩ-Y$%Oxt T̻뮻R ۷o_l߾=nF?@Ѹ 5>ߑ"~. 1ZJjb^.(+V<`('o<{<J*b^(UV?hll4P>ܰ5"ؾϣ1H o։y@<<BБczf@by@ܻ?:7l@y@"?H41i|>6u툮m{<Oj@y@MH31 O["%UMC%U%ǃ_vU<*xT'q"νsֈ!F@G=O5#B;tX^9zNxp~۱G"Z(1( /s̳ŗlr (1|>+ /2xPb0lV>>*Aŗ^U_Gj<`H!gZ>b R KNζ=GE<Rb<\|i;!@ sŮj)5 j)PqEsܰUÑ" <(5m <8G\}'<<8/r7e!(yc-Pnb¡#⾕ y@Yy0B; [<3 T<5m]=BP1b Tmq)7^\|QL0..ln_a$H01Bo1S.yCןuuugZ 'A\}'<EګrlH71`0=?0pN^.0 "57b4B0g qascwZHpw)154qG y._y\Eb%Amk5Gfx, <1T NwY q'A x%OƧ%p[hO|o<(m[ ̾WJ7?54raA8Ẹ:r,qGmkR $QU|ܷ!!Txڣ $QU> yHyT޾ D<FḲ*<@\yT#D<Ẹ|NI%Plbm{|N35.>%raA(1y͏#1D<JṂ"Kk6 y$ָܶh\s|%1Id<*scCP涵FD_{A(91;tX15mK(|>|ԬrP @ىyʯ|Cȣ& ~.GOo*Ḅl~d8xԜm+/f *J̣,|Zj-]:7luGUp@y̓_G ^}}q Q 6WyEQWWg81asGmk2scc*8< Z yP<s25^+E23-yP|bcWw!5!JC5a>Wy#o~% ;7"@y¦o#!qJw#q[\1"sZ!D#""|8x ָܶ+cc@yDD} <m|!//涵nH1/|^^]FFH!Wy\b^8x)*IK_z)*MK'z/RU$PORU$P]!e涵u4$@FH2s`b^?KmNK'2O\p! ļ'"sZchļz$#@ y w)[b^y#ܶhb^>wܛlSq^|)"%sM;:n20ORbn[k̼l! Eļ&|30dfH1/A6=7BJ<H/1/A~p>/MK˼47RLKggxӔ)&Abb^Be^*44RLK5B]>} <ozF\=-Fk#$ <d yP涵F}@کP#)'@ !ᮻ #b^R'O!ZyP+<\|1j yP+<b1j5B!@FyP#<bԀ_7KK9W_ayNbԘ=RHK7Mhرq#@ y R__fN7D WK/RFK:# )#%̕o))#%7]b-0s)Q[H1/a]8)Q[H1/a6])_RBK#ؾm{;RBK٭o1Ba#@ y tٛh! ļ4q`a@:y 42{b~pb^BaFH>t1$P_sRfwwOt}o! ļsF۱u$Po2K0Ru$P FH)y\b^]KB ļ[0wRu$`3/sRu$`Z!\@y !\@y w˂9FHOtl۱Pļ-'63T11/CJD5گ1[({ >7Q-<(xԖsBOb^[!8'AϿ0#R{{;ޮg[?1`<:b/ z0 bg:b z{1`" c\aޥqQA zg;c ΣTvw?x`7Bc|v'/^z PǰΣԺ+>yߚ/g 1"(=Wޛn f[1\1b\Qr//|-e0#{ ( _*>TsǨym۱|m)c?01[[[o!(nz>RvwCϟ#G5 QT3N2 W߉P<06{bՃ#>J&Qt !QuXcjGI_UaYz~z od>}'?yTx\pQzb%3eldo!"BУ*=ӧܒqKfQjb%' AU۱:@U({/-Uo0WqWYuuuy%&xܖ1?wĕO3 UC̣,l<*b-7=?4-#%Qu|~i#0\bUVz[^iNJom}sdo!"|~sz{hweo뮙uuuH91' Aj F=15n̉mPo:Tp̚9/VkOeG26>t;sVA~Ջ{ڷ^\ _?]x]wѱx~\d^'NGpOE㎎˧ A%n-|q*D#xpX|q(#1074?G%rc'GkƧ%&G\2iB|wD熭Pb~UT@w5W˦z+.9H,A*ފ;59=.|#G_Uw!OЃ|+CsZq͑;;̾;V}[qQ5eԘ Ώ?Y\@ XOzUN!߽4> 2cd/*kxAT'18d:r,[PD1[`H3NrGo<`XuŲw(@x]ns-<`zJe0j__;36u툮m{\@y?" b-qQQJMø>OJgEt\%~U1Y-<=(y@Ųc>tLJ!߽4?eQol2g}.fdIH|wMo 0LbP13N6T̡#Ǣ!`D__Ƌ/|*E}@y@xx sLݟ.^"%/uԵCȣ\6 *|u_}'"A-ChinY3gbn+CE߱g#O?/C V~((KHN};o~X?N>q|S&A?547 O^}}7ힾ#ⷱO?k&A]U岙fCT W?ypБc)yRmvGAlԣT1RБcwtblCT1R辕ʣ\6 y2;7Cjok=)ӹa< e37UJ̃ٸQ#PP.E)kWy iFbbĦB岙fCT91Rŗ^m{ AA-͍1cdCT91R`W*rLܾd!j d8x'M0@  WyfFy`޾S&ئ1b$u]QP.yP?yUCjokuPc]e-͍1k C$5fW*rLܾd!J̃d8x'M0@ByPC֮*rLq!L̃q1Wy iꔉq `bԈ6ʣ\6K7@‰yP9}' AAW]1-61@‰yP\1\6 m{ f͜a"B̃ԵU岙x )bTHRKscL4"A]U岙}C bT3>5M2U!A|iFWyfb5<(CGEo CP)clCbu]QP.ws!8#1hR{[k3:7luGAl&2f<({rLܺ`N<(|>*aΕF`HbB岙XnJ̃ѵm!(1f͜aJ̃[oʣ\6/Y`Ẽ?~21C5s( 1F`SWyfw,6%#0?*!47I @Ɉy0LkoqGAl&n_̳ŁG AASLt@ɉy0 _ZU岙Xx!(91Бcw4u4gzfWyf]\hB̃!ܻUCjok_:CPb sVWyf"3o!(1 عw((ĭ D}}1(1 ϻns(+1`S!rLt,j7e'ڶf0e'7\QP.ۗ,0!iZc "<8[\Q<*M̃9t䘫<4uDWyTzfWyfb<^0]uŴ4T*岙6TGܻUCjokzCPqb׹a< e37T1Tζ=F\6]P5<4k #Xb5cS! m{ f͜aRỊl*rLq!H-1<3M6%Q5֮*rLܾd!H51d8x4uĘwY4Z#i<*bS!rLt,j7Gڶf0G=oʣ\6/Y`81?~2vuZc 3(뷸ʣ Wy0419tX8x4uDWy01Yn< e3t|C<Бcw4u401pPrLܙpb%s~Wy 5 g!Qrʣ\6y  QRٶfcQ<&1G]1Y3gỊd6u(h*>1[*FḤ$V~((KFḤZc (뷸ʣ\6wtl1:t䘫<4uĸhQ(6ʣ\6K7G:r,zNZclC(y}+rGAl&2f΁GQܻ 5 @̣(:7luGAl&C98g7?j e3ѱ=HڶUC5s<ɦB岙fC@yZѵm!(1fLl(1Q[~< e3q"'Ƙ:7luǐn5M2UGA_ZU岙Xx!<Бcw4u4PFbgzfWyf-2x{cHmQ__o(31ܰU岙̛m1Wζ=F\6.**D|>o~UCaΕF 8eS!rLt,j7TGD*# 1f͜a 1Xoʣ\6/Y`01?~2 []1_k!b^Bm!QP.E#%P>m{ f͜a1b^=oʣ\6c!y d147I 5HK뷸ʣ\6/Y`Qb^m{\1Y3gR@̫rvyfΎ )!U_z9147ƌi>B̫b-Wyf% )"U'Ƙm{ f͜aH91 |UÑQe3ѱ$aL>=VX/Af0jժhjj5ƨBbB.ۗ,0c}vcT1F1&O`?.\mmmk*  m'N+VD>7Hy0BSLt@*Z*~~/1*D̃e3t|C}?~|<(31F+ئ1 ꫯx R&b S.m ٷo_455Ŋ+Qb S{[k`ժUQWW۷o7F y0 l&2fb…1~8|1J@̃e3ѱU SL>=r+21aFzG)>cCF{<"`-͍c…΁䲙}C@۷/O+Vyz A-͍1yC@ Z*sM1F@̃3e3e %}ypSLMc epdb󴵞qP٪z*Su+4^)RkߥЉtB&!dfD1cV0dd/0ɽM$>>>zm>|36cuu5v\\\h'#7+rt4#<@x ,C3jZk{<֭[1ݻggg0k>|Ƞpj5v ̃xT*idXӉR~{4D^Z'''Z0k>| f<z4HMȨ5ATx"k-M&I^pߏz7w&kMВ$n[[[\0I4cmm-Wrv;...r.atbyy97y>Z~!q܌o.yp8h W0Bt:Q*{05 (ͨjq||Zyxɓ(J3U0>^GVL#KX__v=yz<Nj5^쾘[ <4MG?<$I(AT*!K>ߍhsEj<og%/M8< ]qxx+++~On`a%I^/Aa jnF*̚y,Vxpk73iZa{  Ӓ$n[㴟-UĹx3i4JE3>  3$pXxqLz1y0W;;;1LŻl4Mw v0SIQ A5 nFЌ+ qV+ϣlh7XRDLiK4ceeE3<.Iz1 yS$`vh4-͘2aSj4ok"iښfܰ<`p-IDuvvvvślF{{{QT4cvJ?}'W$ph.ޜ9f /1yqW""ZVL&h41?4~o.^9f @Dwtt@ :E[L>y煋0 L|10?f@|v]k /\9f ōui]ug@nΕ7l`|?\+o+OvVՃ}UV:Ws-7m+Ov}sVJ!cSY+rfjY9@L5/+g@X@7rDypcXyQ  n<,l&4nȉnb[z,D]z,[X{dIXxs{Zf/s6ٙIENDB`RLumShiny/inst/shiny/transformCW/www/style.css0000644000176200001440000000242714175060542021227 0ustar liggesusers.custom-modal { padding-left: 10px; padding-top: 10px; padding-bottom: 10px; padding-right: 10px; line-height: 200%; background-color: #fff; overflow: visible; position: absolute; z-index: 999; border-radius: 10px; border-style: solid; border-color: #428bca; } .h { font-size: 11px; margin: 0 0 0px; } h5, h6 { color: #428bca; } .tooltip-inner { max-width: 450px; } .control-label, .selectize-dropdown, .item, .btn, .uneditable-input, .sorting, .odd, .even, .dataTables-info, .fa, .fa-refresh { font-size: 12px; } .selectize-input { padding: 0px 10px; min-height: 20px; } label, body, input { font-size: 12px; } .label, .badge { font-size: 12px; padding: 4px 20px; margin: 10px; line-height: 18px; } .label-info, .badge-info { background-color: #428bca; } input[type="text"],input[type="number"],input[type="email"],input[type="url"],input[type="search"],input[type="tel"],input[type="color"],.uneditable-input{ display:inline-block; height:18px; padding:0px 0px 0px 7px; margin-bottom:10px; font-size: 11px; line-height: 1.5; color:#555; vertical-align:middle; -webkit-border-radius:4px; -moz-border-radius:4px; border-radius:4px } input,textarea,.uneditable-input{ width: auto; } RLumShiny/inst/shiny/transformCW/www/GitHub-Mark-32px.png0000644000176200001440000000326214175060542022725 0ustar liggesusersPNG  IHDR szztEXtSoftwareAdobe ImageReadyqe<$iTXtXML:com.adobe.xmp $IDATxėmhayL30A+R#f>IHکy(M)_o5 0+0Ėl&o{i^]u<{Yws}=uC>$L, }<w}8^ AO?p! xaяPKI3`'B>0QT1<+`}^nvkp^ƅF|1"Gp.*oO׀Vp ]߅jc8K$q 8jV`#`vmpGѢu!#}#:U_?_yhE $=;c*xNOo+&w)%K-R%6n'o">j/t³qoGW7j%2q GX?woibCÐAzbǰt \14|S.DZ]# b|H$(ʕohmqͱRP셣$,0Z20 tNvRW3K8Xk2 IO6", "", sum(na.omit(input$depth_1), na.omit(input$depth_2), na.omit(input$depth_3), na.omit(input$depth_4), na.omit(input$depth_5)), "m", "", "", "
") }, "Total absorber: ","", "", t$total_absorber.gcm2, "g/cm\u00b2", "", "", "
", "Cosmic dose rate (uncorrected): ","", "", round(t$d0, 3), "Gy/ka", "", "", "
", "Geomagnetic latitude: ","", "", round(t$geom_lat, 2), "\u00b0", "", "", "
", "Cosmic dose rate (corrected): ","", "", round(t$dc, 3),"\u00b1", round(t$dc/100*input$error, 3), "Gy/ka", "", "
", "" ) } }) # render results for mode 3 output$resultsTable<- renderDataTable({ # refresh plot on button press input$refresh if(input$mode == "sAxS") { t<- get_results() table<- as.data.frame(cbind(t$depth, t$total_absorber.gcm2, round(t$d0, 3), round(t$dc,3), round(t$dc/100*input$error, 3))) colnames(table)<- c("Depth (m)", "Absorber (g/cm\u00b2)", "Dc (Gy/ka) [uncorrected]", "Dc (Gy/ka) [corrected]", "Dc error (Gy/ka)") table } }, options=list(autoWidth = FALSE, paging = FALSE, processing = TRUE)) # jQuery DataTables options (http://datatables.net) }RLumShiny/inst/shiny/cosmicdose/www/0000755000176200001440000000000014175060542017233 5ustar liggesusersRLumShiny/inst/shiny/cosmicdose/www/style.css0000644000176200001440000000277714175060542021122 0ustar liggesusers.custom-modal { padding-left: 10px; padding-top: 10px; padding-bottom: 10px; padding-right: 10px; line-height: 200%; background-color: #fff; overflow: visible; position: absolute; z-index: 999; border-radius: 10px; border-style: solid; border-color: #428bca; } .h { font-size: 11px; margin: 0 0 0px; } h5 { color: #428bca; font-family:"Lucida Console", Monaco, monospace; } h6 { font-size: 16px; color: #428bca; font-family:"Lucida Console", Monaco, monospace; } .tooltip-inner { max-width: 450px; } #gmap { border-style: solid; border-width: 2px; border-color: #428bca; margin-top: 40px; } .control-label, .selectize-dropdown, .item, .uneditable-input, .sorting, .odd, .even, .dataTables-info, .fa, .fa-refresh { font-size: 11px; } .selectize-input { padding: 0px 10px; min-height: 20px; } .label, .badge { font-size: 14px; padding: 4px 20px; margin: 10px; line-height: 36px; } .label-info, .badge-info { background-color: #428bca; } input[type="text"],input[type="number"],input[type="email"],input[type="url"],input[type="search"],input[type="tel"],input[type="color"],.uneditable-input{ display:inline-block; height:18px; padding:0px 0px 0px 7px; margin-bottom:10px; font-size: 11px; line-height: 1.5; color:#555; vertical-align:middle; -webkit-border-radius:4px; -moz-border-radius:4px; border-radius:4px } input,textarea,.uneditable-input{ width: auto; } .well { padding: 5px 19px; } RLumShiny/inst/shiny/cosmicdose/ui.R0000644000176200001440000001717314175060542017160 0ustar liggesusersfunction(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) ) ) ) ) ), 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)."), 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")), 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("fas fa-sync")), tooltip(refId = "refresh", text = "Reload app"), bookmarkButton() ) ), 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") ) ) ), includeCSS("./www/style.css") ) }