From 45bad01213203971fa279203942410af1b5f9153 Mon Sep 17 00:00:00 2001 From: Konrad1991 Date: Thu, 21 Nov 2024 10:36:42 +0100 Subject: [PATCH] added missing ui tests --- .development/ESY_Labs.qmd | 26 ------ Rplots.pdf | Bin 7694 -> 0 bytes TRUE | 0 bs/R/DoseResponse.R | 32 +++---- bs/R/statisticalTests.R | 105 +++++++++++------------ bs/R/utils.R | 5 +- bs/inst/tinytest/Assumptions.R | 21 ++++- bs/inst/tinytest/Correlation.R | 16 ++++ bs/inst/tinytest/DoseResponse.R | 50 +++++++++++ bs/inst/tinytest/StatisticalTests.R | 99 ++++++++++++++++++++-- bs/inst/tinytest/TTest.R | 30 ++++++- bs/inst/tinytest/Visualisation.R | 124 ++++++++++++++++++---------- bs/tests/tinytest.R | 1 - 13 files changed, 356 insertions(+), 153 deletions(-) delete mode 100644 .development/ESY_Labs.qmd delete mode 100644 Rplots.pdf delete mode 100644 TRUE create mode 100644 bs/inst/tinytest/DoseResponse.R diff --git a/.development/ESY_Labs.qmd b/.development/ESY_Labs.qmd deleted file mode 100644 index b665e92..0000000 --- a/.development/ESY_Labs.qmd +++ /dev/null @@ -1,26 +0,0 @@ ---- -output: html_document ---- - -## Overview - -- 1. Describe DOE in Excel - * Number of parameters - * Boundaries of parameters -- 2. Rscript - * generates DOE matrix -- 3. TPA sends DOE matrix back to ELN -- 4. User collects DOE matrix via chemotion python API using the Device computer -- 5. Device measures samples and sends results back to ELN via Inbox (via Shuttle) - -## Alternative - -- 1. Describe DOE in Excel - * Number of parameters - * Boundaries of parameters -- 2. Rscript - * generates DOE matrix - * uses python API to generate one reaction variation per row in the DOE matrix -- 3. User collects Reaction variation via python API -- 4. Device measures samples and sends results back to ELN via Inbox (via Shuttle) -- 5. Maybe, python API can link the results with the respective Reaction variation diff --git a/Rplots.pdf b/Rplots.pdf deleted file mode 100644 index ea3bb1c6cdaf096915f3667b496a0248a10b47ea..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 7694 zcmZ{J2{@GP_x~V-B7`Pkl0A$Wdt}L;%Dykr7)-{@WM*VHmJqU(Pzoiqys~E(A!J{R zBq2nWEZOsWW>CG~_y3>ka=GTr{hZ}GI7qzt2A&}h(DP)AUYtp_6v zA_c)-xyq=l%m~%+KspjoSd6A40SOV&JOh`4%fMhTMHpNLE+Z|<2)&4P`v3lBiXxza zr;H&w9*#Iy6ao)1AQEsy0`Qoj2iA#*KzfjWm64Q@gaa~)Ei73i%BZ5kh{QONy@3Dr z1_Cwp#vvh44M&0_8tVdq8alcl@epZXfidLI1M>fQfV_^p+5?Fp>@A0CU@-*XD;}ai zc^qnt#AAsb2tc3A|L7wx*oWf+65~Q}g-FZG%0i&pC^P|x0IH1!z|lk^uue#_-*^Im znLDG`gPaEjv9sE&4Xdjry=jWT^$^(C`dL z85N!N#^2l-DEU+v`%6=`(zDB5@W6B+f@^-1Z+V-s)?Kms$OHAK%~hvu6sET0-<5ss zT>dzg(sJbS$Myxd?FKSJ5q&KXEV&JTa*BEcRVs66xS?&H>x=K5B$lw6aM|+gFSj3_ zEU(O5ma#367AV24`yH1Y059`x3?hf8%g=JI^Dol#)eZ3!J+BBc-%8ZK-uZkk=B7(` zui4Y%bSi#m_e~qK*A^wn|pGA{l~8nbh>>NtAF93@~^lvDvtPJKi8o1Rc9A(+NFqm-J%batedD{34Nz8 z_H*zgk!o%2!>3niQejP0RkukE&g!Bms`s^?l{E6M>0V0kWH#KWd~!utgu$haSKi`C z=d(zU*I*Ix5G-e=*W{|i_&wux10z#=<9zl6yb|+ZY>v|b!t=*NSk43llW(EO%Fhu4 zPZ9RahcpQ)&}ScD?^toD25cRa9HB@heNR z&-6PfqnfBmP-cg|m}l_qR|P%Z=;o8@CLCV_qz&66HfPAj0zP-cOx~@FMgjnM1{+I7 zi&F8yn5Rs&%07#WJgAn5GRDS^;&Qo9&z?wM_SS2NF*;vA_2@(?&o#Ad0f&6B$T9nR zXF!jN`+BnI*R7*kUjc{I6>*tAW5St*`F*S$&FN~Jk7dZ-Nv!M<)~+#m)8Rv-zxxU^?=7dxk>JQfy95kI zJCkZMUM*>J?;JEVgWPeXYg+P95i^>&zpLq>LxjyWgOo1NU1B+l<@k``2P*QQBN-?-JkkARdndPQ-pXbh4`iQg})bO|MW zpUQZs^7S7@&N6qm=5XHvg>#@anVHl=hdff+TtO#XO^01)cO7a4dHXd^uC&)d*GI&5 z0oQDNIsmx+y-VXSx839mS1j~qju*W;=r94c@FHFX4pO-#f%!^C?5(YizJKH@&D`NIxf4y-uyFyS8)< zZ`Y0TuHVr+%e>gS_sWhgZ#Vc0Q<|~>)C!%$WxyJ0Qwl-NsY~ zGPwI~u5=1covQEO?kxh1uCu4T7wl_)-7o9v&RTOS-K`I;O(W7W_PDJ77ghR8fJlcH z>UH~)f|-s6`%r?%H3p&OGN=s4*WcT^?QK4_7o9EQhfHU4mDV?M{3D_)dH{@c3a5mI zf!OFt1&35h|t~p$Djiu!)F#$q*pI)3vom!d72r~4nN@>!6|9+OK`>I%KL3o^8Fq{pIm2m zj&_=ox2+T#zjH!apT%kq0jWn6b0caj-+{f|r9br)kG0du)MO=(xNZ)d`!kZTk3F!t zG+w-K61o34KFF5#UKIT`j>7*a&;}`$3_*G{?+1Xkzw!1{T^L`BX6xOf32&u5u)88t zL4Z&DIim3ap7vfjDS`gDwM9*_7AQoc;{}qLcrxc2Pn%jlVYlbFp*_hB*gD+f zzmw#Ahs1ZPv=`UA%c)-ix$U6)0j({qcE}anR{UcZCufqf&A2N4u(P5dg-iS-zv78c zC_qzD2EFGW#Fe}FnUwq9oc4aQTT5up<~jrUcDt_S;_tm`yVp@*}gSlz(l^KOq9f4&YXw_K*{$*>@73vrVIBM=s0hw!!=cLE}MT{gi~0 zrZ50>sZ}4l&p06x{f=s7^gN7l6q0#*WYCzZC9wx6$}|hJVtn$0Yr922x+a>_s=ifY zH@%}ky!ipo(t!%t8N-zikaxdyYuOL6bRPz)JH>6@DQ|M3;La?EP3$XTuaSPN#p#`1 z-2yWI##s95AmlT46{vy7)fmp^0XetlHzd|{y>bE^tlZhTL2YX-=AcbRlCI_^jX$ut z2cC)n=|nYNA;8jrNGQqstTzLwGF9`w@SaQ*hN+;xhys=eO*Bh{*@};$Kuv2+cWnF$B{=V7Sg2H z|8e|T(^&rrfjxq&IM(+9)~3`}{=np*9wojg1x?-0OX2D(on!|;muo|EcOffAYBaBJnyw|(p&!|~G&@|8}TS3w<^W(#bi)tFXg@WO-7?zygO(m6+`wd09CO9WvN4;Xm zCSe!u$9RgVUPVz< zszE7A1$i}px^`!F-q{Q%)1r9qrPbNPZzYb;4AIdfb8{KzmFqj1;PD5 z^P;Kv-Mm0^%n}8m>cN25FG+6tw8~veSLHIm4yy%44W_?O9Lcz(3v0*Yc0=Q&8k)Jn zl>~ULH#7dnn25fH0Pn*SaFQ8?+9NTPf=ddfWYTVV6C#C+AB(?Ib2%l1Yz@e_f@!Tn z0BjviN`c>N-ld2q_q`0`#zS5#Q%*{uGy?!b{@nz;-i@*`tQwY;hyd{?GK!pbk^yp( zG?_5>=bV(>$*-@+8+dAuY1#jzbdh=euS%M5L&TUldHeO9-AZ!Zwv|llqeaobdzTPN z%O0-hx1@puy&#vr19?ryxyf~FA-VL4(q3xQeQ$d2oS)yZzCNn)dc=ZYIX$yt(=V{; z4l&@X&R(>=d?Daw{m17Y7^1UODtn+q&~J5(jaU`k;R-eAbz(;eor(l2c+r4K%O$OG z;$WL<{#6eT3}o5Myzg|8zoL!d`83V6e=bi*C1FkzS7to>h_!hu>nqS=%zL-ZB?+ox zH1OX|Y9M#;#%$WA{Ek%w@kg%V^xfx|kNsoA@Q=GWQwWhMsCf3OT^@!f@0FbdQ@;dF z|Em{fwHq1>(gtp+vI=1dNaKJ(R9m3?g6b*Nouao&VhS=HogJztaA<`yTAO; zTL7|%Y|jR&r=fAq5s!3&$dOms?Y~zbf7_2yojk~6$VQ-=NKX_3NmdHI1iUMN?oIq~ zSw*@3=fqF;>G#C{F!8#n$pB|~N0oe);q4=l37u}P#?-opt90Wf#b69a&ez0&_~kTB zahgW)SqI@FBcu$C_xxTRHfd~%uh z?=J_%ZH3UjxnRjaI`qi$=$FZch+9!E4)j!q7CfO1xHe!5=4w_rYw5%d zJNQL$8^53TkSvNz@K9xN3%-36xiCH?Ja$WwtvWj10n9adaIFkpErbXm=!L1h#g6BL z{VvIYL~ajBPT)la_Zu8}ZZm4Bz2YU-kLwl>WB%45X1X#${B<$85 z_NXr%9Tz8~8d{~8@^2o)v%U=SVm~5)kPu>Tyubp1Rsr~(u8mwB^9S1 zO9;+!5PnKWOlOq|k;5G$1R+Lb6zC;`S{x1xQ5j1yr;0<#_>MkD~r^P&u+3gN~fg-GrW+%^p20?#^~e3N9K>@ zGM*dJ8$Nuh(reZ$a+Ps~^`f@hB$DG)*Y4ESM`q_#zRN+-`$;S}q#!UhLj$Rk8F zEaq6?g%d&?h17-MLhhaz#T($a(T-X9mj9gTKQR+|xWOau3L5r`(f5cin=h?WjDN_f zQ3CFj!ev|KOA)8*%|@(o!Z-^Ydnve*ZTQH1G)u$MLdy^2nzkQHz(LiRw38z2(F`v` zbv=La6+(J&`8%=Ku$DB;H3M>S>cEL zpZKdFcbc`GSUi-iE)1W;2&J9;Ed1IiUCdJKfXKp8^V7W|1TkA9udE0Q8PjD`+kcXC zEgyMlUeo>YjLp7T_hwGLk#(kN2Ep`OSa%WJY(QJlR8hmb&?9P*_N&fO@rH;|jW0%# zBAX&EA_&va=LSfVvR-1Z_O#Ws!eI^REZRf17W!*PSSp=2guW?)u5Ez~F1clvp5-^5ezr$746_YU@H_YOak?)C5O=`DG7 z{n_UpHB>Sx)NTCg_b!DOKM2h3F)b(N9^6(8pB(BBm2HzbC1c?_*K?xtL4SAuV$Zwo z=iO&AR!mb~&OUnhyh>v;^yd?1v&M@$>4h4TPudY-jCFV7+n+iu!?Fmn#BHKr`AT_6 zxwOw)A0wX|KC?cn%M2Uh+XCA>8&w-7bZ6*J($Ui8(3Kqi5hh-Dw9YPUJ1qBB^sOt= za>t0^vv6~1W~p|0jBK^rIk{`{R?giH9&JYv@8B1uKe_u19Fi-P*N44;al^ygcv@*E zD%!#&Iyo3WZ9kX2nDp%M$GBh`OFkm5_oQCsyYjlW`u(qvkc^O~ zM{SPXT{W<-{Qe(wQEwR$?#>UdpHuQy%<()kvD`mUYxUjl!#WpNmi~SHsFn=xw@YhF z$0u)dKl7XEq7dzyNWeKI&Q*dM24TyFGgOlZ_aV_&`vHt?MT2 zro_#8#YYe5+LyaYnZ^3qrRX`yIrda~EIs!2{5$BRfk2tiUE#CmJueQYD&HGTHI832 zt>H9fO3mKL?$4~g#B}jv+E3B5LRDvJlH!xEnd-7;F>Jz%rI+C0g{_5=g-==@B+c5& z2{N+DA~go03Mv|820D64^_m6t@cUzlCU=&EmziBd8_%C{+W+MB|IV)k{wXKkGus{czT3Rb4-#_()UV3M+>8ps671weQU7o zfF07XxOm#1cz#9qmc>Qi9Ov1r!S@y36}jJkeCRRHHnXr^#pF87xB0x@Xs62vi}X+S zSKQ>4)0Y1k*tSt#rkC-o=v!UDmw<0U5j6g7F>P%U_a%@yxED`|iwAG4=jnn-(~a+f&$?b~<{qDtRq{=v<&_#9{@b^+Zv zur%q{@$lQ~cUAAjw$XS)?vu73@YD1I|L;1q0$erbY%BhpNE=Z3qw`y*Sxm$ z`tRJ!ZcshFW4qZpK5+fD*A`rgLrM0R?ebPnZp!7SuRrW`&mrdtAC|W*z`4%$NtH%{ z_z{U2_nnI5>+I5H^ZE0qRg(jz){ia!n9GhfNDH7@4PDy&&rw_P_c4@l?|MrM1KcE` zFu?s5`PlmBn*|D^j=`h$1&mNll(RDuxYHtETG>EkWTEaT3=t1el!IO)VhKnz(wV>r zlaYZsVS#HnJRSvsx_CHx0%u%D1d)8yMW8$oM0aO2(hCA5pwLc$$lVd)fyF?eS3Hp9 zg}{@J2n29V#t3yn0jBUMJOnCFZd{v0Mvwdg+RIQBMX5MxA}1>=Eemmm{FcFiTTk)_g840j z$pLfFzh%JPC!qd+WWb&1e`L}yVBqgx9042NF;0cZ%1PU_p(u#77f`VEG H+Km4PxO;zx diff --git a/TRUE b/TRUE deleted file mode 100644 index e69de29..0000000 diff --git a/bs/R/DoseResponse.R b/bs/R/DoseResponse.R index e1ec8d5..c156520 100644 --- a/bs/R/DoseResponse.R +++ b/bs/R/DoseResponse.R @@ -1,5 +1,3 @@ -# TODO: add everywhere the ? documentation. -# In an analogous way to the DoseResponse tab DoseResponseSidebarUI <- function(id) { tabPanel( "Dose Response analysis", @@ -18,9 +16,9 @@ DoseResponseSidebarUI <- function(id) { verbatimTextOutput(NS(id, "applied_filter")) ), br(), - uiOutput(NS(id, "substanceNames")), - uiOutput(NS(id, "negIdentifier")), - uiOutput(NS(id, "posIdentifier")), + uiOutput(NS(id, "substanceNamesUI")), + uiOutput(NS(id, "negIdentifierUI")), + uiOutput(NS(id, "posIdentifierUI")), actionButton(NS(id, "ic50"), "Conduct analysis") ) ) @@ -53,7 +51,6 @@ DoseResponseUI <- function(id) { DoseResponseServer <- function(id, data, listResults) { moduleServer(id, function(input, output, session) { - r_vals <- reactiveValues( plots = NULL, names = NULL, # For dropdown_plots @@ -63,7 +60,7 @@ DoseResponseServer <- function(id, data, listResults) { ) # Render names, conc and abs column - output[["substanceNames"]] <- renderUI({ + output[["substanceNamesUI"]] <- renderUI({ req(!is.null(data$df)) req(is.data.frame(data$df)) colnames <- names(data$df) @@ -84,7 +81,7 @@ DoseResponseServer <- function(id, data, listResults) { ) }) - output[["negIdentifier"]] <- renderUI({ + output[["negIdentifierUI"]] <- renderUI({ req(!is.null(data$df)) req(is.data.frame(data$df)) req(input$`substanceNames`) @@ -101,13 +98,13 @@ DoseResponseServer <- function(id, data, listResults) { selectInput( inputId = paste0("DOSERESPONSE-negIdentifier"), label = "Name of the negative control", - choices = choices[1:length( choices)], + choices = choices[1:length(choices)], selected = NULL ) ) }) - output[["posIdentifier"]] <- renderUI({ + output[["posIdentifierUI"]] <- renderUI({ req(!is.null(data$df)) req(is.data.frame(data$df)) req(input$`substanceNames`) @@ -124,7 +121,7 @@ DoseResponseServer <- function(id, data, listResults) { selectInput( inputId = paste0("DOSERESPONSE-posIdentifier"), label = "Name of the positive control", - choices = choices[1:length( choices)], + choices = choices[1:length(choices)], selected = NULL ) ) @@ -195,14 +192,18 @@ DoseResponseServer <- function(id, data, listResults) { FormulaEditorUI("FO"), easyClose = TRUE, size = "l", - footer = NULL + footer = tagList( + modalButton("Close") + ) )) }) # display current formula observe({ req(!is.null(data$formula)) - output$formula <- renderText({deparse(data$formula)}) + output$formula <- renderText({ + deparse(data$formula) + }) }) drFct <- function() { @@ -266,6 +267,10 @@ DoseResponseServer <- function(id, data, listResults) { listResults$counter <- listResults$counter + 1 new_result_name <- paste0("DoseResponseNr", listResults$counter) listResults$all_data[[new_result_name]] <- new("doseResponse", df = resDF, p = resPlot) + + exportTestValues( + doseresponse_res = listResults$curr_data + ) } } @@ -347,7 +352,6 @@ DoseResponseServer <- function(id, data, listResults) { r_vals$currentPageOverview <- r_vals$currentPageOverview - 1 } }) - }) return(listResults) diff --git a/bs/R/statisticalTests.R b/bs/R/statisticalTests.R index cc6b821..2a5f2ff 100644 --- a/bs/R/statisticalTests.R +++ b/bs/R/statisticalTests.R @@ -64,7 +64,7 @@ testsSidebarUI <- function(id) { "Unbalanced" = "ub" ) ), - uiOutput(NS(id, "padj")) + uiOutput(NS(id, "padjUI")) ) ) } @@ -91,9 +91,8 @@ testsUI <- function(id) { testsServer <- function(id, data, listResults) { moduleServer(id, function(input, output, session) { - # Render p adjustment methods - output[["padj"]] <- renderUI({ + output[["padjUI"]] <- renderUI({ if (input$PostHocTests == "kruskalTest" || input$PostHocTests == "LSD") { return( selectInput(NS(id, "padj"), "Adjusted p method", @@ -246,55 +245,58 @@ testsServer <- function(id, data, listResults) { output$test_error <- renderText(err) } if (is.null(err)) { - e <- try({ - switch(method, - aov = { - fit <- broom::tidy(aov(formula, data = df)) - }, - kruskal = { - fit <- broom::tidy(kruskal.test(formula, data = df)) # Keep here the restriction for respone ~ predictor - }, - HSD = { - check_formula(formula) - aov_res <- aov(formula, data = df) - bal <- input$design - req(bal) - if (bal == "Balanced") { - bal <- TRUE - } else { - bal <- FALSE + e <- try( + { + switch(method, + aov = { + fit <- broom::tidy(aov(formula, data = df)) + }, + kruskal = { + fit <- broom::tidy(kruskal.test(formula, data = df)) # Keep here the restriction for respone ~ predictor + }, + HSD = { + check_formula(formula) + aov_res <- aov(formula, data = df) + bal <- input$design + req(bal) + if (bal == "Balanced") { + bal <- TRUE + } else { + bal <- FALSE + } + fit <- agricolae::HSD.test(aov_res, + trt = indep, + alpha = input$pval, group = TRUE, unbalanced = bal + )$groups + }, + kruskalTest = { + check_formula(formula) + fit <- with(df, kruskal(df[, dep], df[, indep]), + alpha = input$pval, p.adj = input$padj, group = TRUE + )$groups + }, + LSD = { + check_formula(formula) + aov_res <- aov(formula, data = df) + fit <- agricolae::LSD.test(aov_res, + trt = indep, + alpha = input$pval, p.adj = input$padj, group = TRUE + )$groups + }, + scheffe = { + check_formula(formula) + aov_res <- aov(formula, data = df) + fit <- agricolae::scheffe.test(aov_res, trt = indep, alpha = input$pval, group = TRUE)$groups + }, + REGW = { + check_formula(formula) + aov_res <- aov(formula, data = df) + fit <- agricolae::REGW.test(aov_res, trt = indep, alpha = input$pval, group = TRUE)$groups } - fit <- agricolae::HSD.test(aov_res, - trt = indep, - alpha = input$pval, group = TRUE, unbalanced = bal - )$groups - }, - kruskalTest = { - check_formula(formula) - fit <- with(df, kruskal(df[, dep], df[, indep]), - alpha = input$pval, p.adj = input$padj, group = TRUE - )$groups - }, - LSD = { - check_formula(formula) - aov_res <- aov(formula, data = df) - fit <- agricolae::LSD.test(aov_res, - trt = indep, - alpha = input$pval, p.adj = input$padj, group = TRUE - )$groups - }, - scheffe = { - check_formula(formula) - aov_res <- aov(formula, data = df) - fit <- agricolae::scheffe.test(aov_res, trt = indep, alpha = input$pval, group = TRUE)$groups - }, - REGW = { - check_formula(formula) - aov_res <- aov(formula, data = df) - fit <- agricolae::REGW.test(aov_res, trt = indep, alpha = input$pval, group = TRUE)$groups - } - ) - }, silent = TRUE) + ) + }, + silent = TRUE + ) if (inherits(e, "try-error")) { err <- conditionMessage(attr(e, "condition")) err <- paste0(err, "\n", "Test did not run successfully") @@ -328,7 +330,6 @@ testsServer <- function(id, data, listResults) { observeEvent(input$PostHocTest, { conductTests(input$PostHocTests) }) - }) return(listResults) diff --git a/bs/R/utils.R b/bs/R/utils.R index 420277c..fb089f0 100644 --- a/bs/R/utils.R +++ b/bs/R/utils.R @@ -496,6 +496,9 @@ check_filename_for_serverless <- function(filename) { # Split list of plots into panels of 9 plots create_plot_pages <- function(plotList) { n_full_pages <- floor(length(plotList) / 9) + if (n_full_pages == 0) { + return(list(cowplot::plot_grid(plotlist = plotList))) + } n_plots_last_page <- length(plotList) %% 9 res <- list() i <- 1 @@ -507,7 +510,7 @@ create_plot_pages <- function(plotList) { } } res[[i + 1]] <- plotList[(n_full_pages * 9 + 1): - (n_full_pages * 9 + n_plots_last_page)] + (n_full_pages * 9 + n_plots_last_page)] lapply(res, function(x) { cowplot::plot_grid(plotlist = x) }) diff --git a/bs/inst/tinytest/Assumptions.R b/bs/inst/tinytest/Assumptions.R index 2995fda..0bec908 100644 --- a/bs/inst/tinytest/Assumptions.R +++ b/bs/inst/tinytest/Assumptions.R @@ -3,18 +3,29 @@ library(tinytest) app <- bs::app() app <- shiny::shinyApp(app$ui, app$server) app <- AppDriver$new(app) +app$wait_for_idle() app$upload_file( file = system.file("/test_data/CO2.csv", package = "bs") ) +app$wait_for_idle() app$set_inputs(conditionedPanels = "Assumption") +app$wait_for_idle() app$set_window_size(width = 2259, height = 1326) +app$wait_for_idle() app$click("ASS-open_formula_editor") +app$wait_for_idle() app$set_inputs(`FO-colnames-dropdown_0` = "uptake") +app$wait_for_idle() app$click("FO-colnames_Treatment_0") +app$wait_for_idle() app$click("FO-create_formula") +app$wait_for_idle() app$run_js("$('.modal-footer button:contains(\"Close\")').click();") +app$wait_for_idle() app$click("ASS-shapiro") +app$wait_for_idle() res <- app$get_values()$export +app$wait_for_idle() expected <- rbind( broom::tidy(shapiro.test(CO2[CO2$Treatment == "nonchilled", "uptake"])), broom::tidy(shapiro.test(CO2[CO2$Treatment == "chilled", "uptake"])) @@ -26,7 +37,9 @@ tinytest::expect_equal(res[[1]], expected) # Update output value app$click("ASS-shapiroResiduals") +app$wait_for_idle() res <- app$get_values()$export +app$wait_for_idle() fit <- lm(uptake ~ Treatment, data = CO2) r <- resid(fit) expected <- broom::tidy(shapiro.test(r)) @@ -35,16 +48,22 @@ tinytest::expect_equal(res[[1]], expected) # Update output value app$click("ASS-levene") +app$wait_for_idle() res <- app$get_values()$export +app$wait_for_idle() expected <- broom::tidy(car::leveneTest(uptake ~ Treatment, - data = CO2, center = "mean")) + data = CO2, center = "mean" +)) expected$`Variance homogenity` <- expected$p.value > 0.05 tinytest::expect_equal(res[[1]], expected) # Update output value app$click("ASS-DiagnosticPlot") +app$wait_for_idle() res <- app$get_values()$export +app$wait_for_idle() tinytest::expect_equal(inherits(res[[1]], "ggplot"), TRUE) # TODO: add internal backend test for diagnostic plot functions +app$wait_for_idle() app$stop() diff --git a/bs/inst/tinytest/Correlation.R b/bs/inst/tinytest/Correlation.R index 4962cda..37cd6b7 100644 --- a/bs/inst/tinytest/Correlation.R +++ b/bs/inst/tinytest/Correlation.R @@ -3,29 +3,45 @@ library(tinytest) app <- bs::app() app <- shiny::shinyApp(app$ui, app$server) app <- AppDriver$new(app) +app$wait_for_idle() app$upload_file( file = system.file("/test_data/CO2.csv", package = "bs") ) +app$wait_for_idle() app$set_window_size(width = 2259, height = 1326) +app$wait_for_idle() app$set_inputs(conditionedPanels = "Correlation") +app$wait_for_idle() app$click("CORR-open_formula_editor") +app$wait_for_idle() app$set_inputs(`FO-colnames-dropdown_0` = "uptake") +app$wait_for_idle() app$click("FO-colnames_conc_0") +app$wait_for_idle() app$click("FO-create_formula") +app$wait_for_idle() app$run_js("$('.modal-footer button:contains(\"Close\")').click();") +app$wait_for_idle() app$click("CORR-pear") +app$wait_for_idle() res <- app$get_values()$export +app$wait_for_idle() expected <- cor.test(CO2$uptake, CO2$conc, method = "pearson") expected <- broom::tidy(expected) tinytest::expect_equal(res[[1]], expected) app$click("CORR-spear") +app$wait_for_idle() res <- app$get_values()$export +app$wait_for_idle() expected <- cor.test(CO2$uptake, CO2$conc, method = "spearman") expected <- broom::tidy(expected) tinytest::expect_equal(res[[1]], expected) app$click("CORR-kendall") +app$wait_for_idle() res <- app$get_values()$export +app$wait_for_idle() expected <- cor.test(CO2$uptake, CO2$conc, method = "kendall") expected <- broom::tidy(expected) tinytest::expect_equal(res[[1]], expected) +app$wait_for_idle() app$stop() diff --git a/bs/inst/tinytest/DoseResponse.R b/bs/inst/tinytest/DoseResponse.R new file mode 100644 index 0000000..20ce65f --- /dev/null +++ b/bs/inst/tinytest/DoseResponse.R @@ -0,0 +1,50 @@ +library(shinytest2) +library(tinytest) +app <- bs::app() +app <- shiny::shinyApp(app$ui, app$server) +app <- AppDriver$new(app) +app$wait_for_idle() +app$upload_file( + file = system.file("/test_data/DoseResponse.csv", package = "bs") +) +app$wait_for_idle() +app$set_window_size(width = 2259, height = 1326) +app$wait_for_idle() +app$set_inputs(conditionedPanels = "Dose Response analysis") +app$wait_for_idle() + +# Define formula +app$click("DOSERESPONSE-open_formula_editor") +app$wait_for_idle() +app$set_inputs(`FO-colnames-dropdown_0` = "abs") +app$wait_for_idle() +app$set_inputs(`FO-editable_code` = "conc") +app$wait_for_idle() +app$click("FO-create_formula") +app$wait_for_idle() +app$run_js("$('.modal-footer button:contains(\"Close\")').click();") +app$wait_for_idle() + +app$set_inputs(`DOSERESPONSE-substanceNames` = "names") +app$wait_for_idle() +app$set_inputs(`DOSERESPONSE-negIdentifier` = "neg") +app$wait_for_idle() +app$set_inputs(`DOSERESPONSE-posIdentifier` = "pos") +app$wait_for_idle() +app$click("DOSERESPONSE-ic50") +app$wait_for_idle() + +res <- app$get_values()$export +res_df <- res[[1]]@df + +data <- read.csv(system.file("/test_data/DoseResponse.csv", package = "bs")) +expected <- MTT::ic50(data, "abs", "conc", "names", "neg", "pos") +dfs <- lapply(expected, function(x) { + if (is.list(x)) { + return(x[[1]]) + } +}) +expected <- do.call(rbind, dfs) +tinytest::expect_equal(res_df, expected) + +app$stop() diff --git a/bs/inst/tinytest/StatisticalTests.R b/bs/inst/tinytest/StatisticalTests.R index bcf9e75..6940efa 100644 --- a/bs/inst/tinytest/StatisticalTests.R +++ b/bs/inst/tinytest/StatisticalTests.R @@ -3,50 +3,72 @@ library(tinytest) app <- bs::app() app <- shiny::shinyApp(app$ui, app$server) app <- AppDriver$new(app) +app$wait_for_idle() app$upload_file( file = system.file("/test_data/CO2.csv", package = "bs") ) +app$wait_for_idle() app$set_window_size(width = 2259, height = 1326) +app$wait_for_idle() app$set_inputs(conditionedPanels = "Tests") +app$wait_for_idle() # Define formula app$click("TESTS-open_formula_editor") +app$wait_for_idle() app$set_inputs(`FO-colnames-dropdown_0` = "uptake") +app$wait_for_idle() app$set_inputs(`FO-editable_code` = "conc * Treatment + Type") +app$wait_for_idle() app$click("FO-create_formula") +app$wait_for_idle() app$run_js("$('.modal-footer button:contains(\"Close\")').click();") +app$wait_for_idle() # ANOVA -app$set_inputs(TestsConditionedPanels = "More than two groups") +app$set_inputs(TestsConditionedPanels = "More than two groups") +app$wait_for_idle() app$click("TESTS-aovTest") +app$wait_for_idle() res <- app$get_values()$export +app$wait_for_idle() CO2$Treatment <- as.character(CO2$Treatment) CO2$Type <- as.character(CO2$Type) -expected <- broom::tidy(aov(uptake ~ conc*Treatment + Type, data = CO2)) +expected <- broom::tidy(aov(uptake ~ conc * Treatment + Type, data = CO2)) expected <- cbind(expected, row.names(expected)) names(expected)[ncol(expected)] <- paste0("conc * Treatment + Type", collapse = ".") tinytest::expect_equal(res[[1]], expected) # Kruskal-Wallis app$click("TESTS-open_formula_editor") +app$wait_for_idle() app$set_inputs(`FO-colnames-dropdown_0` = "uptake") +app$wait_for_idle() app$set_inputs(`FO-editable_code` = "conc") +app$wait_for_idle() app$click("FO-create_formula") +app$wait_for_idle() app$run_js("$('.modal-footer button:contains(\"Close\")').click();") +app$wait_for_idle() app$click("TESTS-kruskalTest") +app$wait_for_idle() res <- app$get_values()$export +app$wait_for_idle() CO2$Treatment <- as.character(CO2$Treatment) -expected <- broom::tidy(kruskal.test(uptake ~conc, data = CO2)) +expected <- broom::tidy(kruskal.test(uptake ~ conc, data = CO2)) expected <- cbind(expected, row.names(expected)) names(expected)[ncol(expected)] <- paste0("conc", collapse = ".") tinytest::expect_equal(res[[1]], expected) # PostHoc tests # TukeyHSD -app$set_inputs(TestsConditionedPanels = "Posthoc tests") +app$set_inputs(TestsConditionedPanels = "Posthoc tests") +app$wait_for_idle() app$set_inputs(`TESTS-PostHocTests` = "HSD") +app$wait_for_idle() app$click("TESTS-PostHocTest") +app$wait_for_idle() res <- app$get_values()$export fit <- aov(uptake ~ conc, data = CO2) fit <- agricolae::HSD.test(fit, @@ -57,11 +79,16 @@ expected <- cbind(fit, row.names(fit)) names(expected)[ncol(expected)] <- paste0("conc", collapse = ".") tinytest::expect_equal(res[[1]], expected) -app$set_inputs(TestsConditionedPanels = "Posthoc tests") +app$set_inputs(TestsConditionedPanels = "Posthoc tests") +app$wait_for_idle() app$set_inputs(`TESTS-PostHocTests` = "HSD") +app$wait_for_idle() app$set_inputs(`TESTS-design` = "ub") +app$wait_for_idle() app$click("TESTS-PostHocTest") +app$wait_for_idle() res <- app$get_values()$export +app$wait_for_idle() fit <- aov(uptake ~ conc, data = CO2) fit <- agricolae::HSD.test(fit, trt = "conc", @@ -73,24 +100,78 @@ tinytest::expect_equal(res[[1]], expected) # Kruskal-Wallis test app$set_inputs(`TESTS-PostHocTests` = "kruskalTest") +app$wait_for_idle() +app$set_inputs(`TESTS-padj` = "BH") +app$wait_for_idle() app$click("TESTS-PostHocTest") +app$wait_for_idle() res <- app$get_values()$export +app$wait_for_idle() df <- CO2 dep <- "uptake" fit <- with(df, agricolae::kruskal(df[, dep], df[, "conc"]), - alpha = 0.05, p.adj = 0.05, group = TRUE + alpha = 0.05, p.adj = "BH", group = TRUE )$groups expected <- cbind(fit, row.names(fit)) names(expected)[ncol(expected)] <- paste0("conc", collapse = ".") tinytest::expect_equal(res[[1]], expected) # LSD - +app$set_inputs(`TESTS-PostHocTests` = "LSD") +app$wait_for_idle() +app$set_inputs(`TESTS-padj` = "BY") +app$wait_for_idle() +app$click("TESTS-PostHocTest") +app$wait_for_idle() +res <- app$get_values()$export +app$wait_for_idle() +df <- CO2 +dep <- "uptake" +fit <- aov(uptake ~ conc, data = CO2) +fit <- agricolae::LSD.test( + fit, + trt = "conc", + alpha = 0.05, p.adj = "BY", group = TRUE +)$groups +expected <- cbind(fit, row.names(fit)) +names(expected)[ncol(expected)] <- paste0("conc", collapse = ".") +tinytest::expect_equal(res[[1]], expected) # scheffe - +# aov_res <- aov(formula, data = df) +# fit <- agricolae::scheffe.test(aov_res, trt = indep, alpha = input$pval, group = TRUE)$groups +app$set_inputs(`TESTS-PostHocTests` = "scheffe") +app$wait_for_idle() +app$click("TESTS-PostHocTest") +app$wait_for_idle() +res <- app$get_values()$export +app$wait_for_idle() +fit <- aov(uptake ~ conc, data = CO2) +fit <- agricolae::scheffe.test( + fit, + trt = "conc", + alpha = 0.05, group = TRUE +)$groups +expected <- cbind(fit, row.names(fit)) +names(expected)[ncol(expected)] <- paste0("conc", collapse = ".") +tinytest::expect_equal(res[[1]], expected) # REGW +app$set_inputs(`TESTS-PostHocTests` = "REGW") +app$wait_for_idle() +app$click("TESTS-PostHocTest") +app$wait_for_idle() +res <- app$get_values()$export +app$wait_for_idle() +fit <- aov(uptake ~ conc, data = CO2) +fit <- agricolae::REGW.test( + fit, + trt = "conc", + alpha = 0.05, group = TRUE +)$groups +expected <- cbind(fit, row.names(fit)) +names(expected)[ncol(expected)] <- paste0("conc", collapse = ".") +tinytest::expect_equal(res[[1]], expected) -app$view() +app$stop() diff --git a/bs/inst/tinytest/TTest.R b/bs/inst/tinytest/TTest.R index ef0a3cf..56dcdab 100644 --- a/bs/inst/tinytest/TTest.R +++ b/bs/inst/tinytest/TTest.R @@ -3,23 +3,35 @@ library(tinytest) app <- bs::app() app <- shiny::shinyApp(app$ui, app$server) app <- AppDriver$new(app) +app$wait_for_idle() app$upload_file( file = system.file("/test_data/CO2.csv", package = "bs") ) +app$wait_for_idle() app$set_window_size(width = 2259, height = 1326) +app$wait_for_idle() app$set_inputs(conditionedPanels = "Tests") +app$wait_for_idle() app$click("TESTS-open_formula_editor") +app$wait_for_idle() app$set_inputs(`FO-colnames-dropdown_0` = "uptake") +app$wait_for_idle() app$click("FO-colnames_Treatment_0") +app$wait_for_idle() app$click("FO-create_formula") +app$wait_for_idle() app$run_js("$('.modal-footer button:contains(\"Close\")').click();") +app$wait_for_idle() app$click("TESTS-tTest") +app$wait_for_idle() res <- app$get_values()$export +app$wait_for_idle() CO2$Treatment <- as.character(CO2$Treatment) expected <- broom::tidy( t.test( - uptake ~ Treatment, data = CO2, + uptake ~ Treatment, + data = CO2, var.equal = TRUE, conf.level = 0.95, alternative = "two.sided" ) @@ -27,23 +39,30 @@ expected <- broom::tidy( tinytest::expect_equal(res[[1]], expected) # Update output value app$set_inputs(`TESTS-altHyp` = "less") +app$wait_for_idle() app$click("TESTS-tTest") +app$wait_for_idle() res <- app$get_values()$export expected <- broom::tidy( t.test( - uptake ~ Treatment, data = CO2, + uptake ~ Treatment, + data = CO2, var.equal = TRUE, conf.level = 0.95, alternative = "less" ) ) tinytest::expect_equal(res[[1]], expected) +app$wait_for_idle() # Update output value app$set_inputs(`TESTS-altHyp` = "greater") +app$wait_for_idle() app$click("TESTS-tTest") +app$wait_for_idle() res <- app$get_values()$export expected <- broom::tidy( t.test( - uptake ~ Treatment, data = CO2, + uptake ~ Treatment, + data = CO2, var.equal = TRUE, conf.level = 0.95, alternative = "greater" ) @@ -51,11 +70,14 @@ expected <- broom::tidy( tinytest::expect_equal(res[[1]], expected) # Update output value app$set_inputs(`TESTS-varEq` = "noeq") +app$wait_for_idle() app$click("TESTS-tTest") +app$wait_for_idle() res <- app$get_values()$export expected <- broom::tidy( t.test( - uptake ~ Treatment, data = CO2, + uptake ~ Treatment, + data = CO2, var.equal = FALSE, conf.level = 0.95, alternative = "greater" ) diff --git a/bs/inst/tinytest/Visualisation.R b/bs/inst/tinytest/Visualisation.R index 9a9afec..a1d2705 100644 --- a/bs/inst/tinytest/Visualisation.R +++ b/bs/inst/tinytest/Visualisation.R @@ -4,14 +4,21 @@ library(tinytest) app <- bs::app() app <- shiny::shinyApp(app$ui, app$server) app <- AppDriver$new(app) +app$wait_for_idle() app$set_window_size(width = 2259, height = 1326) +app$wait_for_idle() app$upload_file( file = system.file("/test_data/CO2.csv", package = "bs") ) +app$wait_for_idle() app$set_inputs(conditionedPanels = "Visualisation") +app$wait_for_idle() app$set_inputs(`VIS-yVar` = "uptake") +app$wait_for_idle() app$set_inputs(`VIS-xVar` = "conc") +app$wait_for_idle() app$click("VIS-CreatePlotBox") +app$wait_for_idle() # Test basic plot x <- "conc" @@ -25,8 +32,7 @@ y_min <- min(df[[y]], na.rm = TRUE) padded_min_y <- y_min * 0.95 y_max <- max(df[[y]], na.rm = TRUE) padded_max_y <- y_max * 1.05 -ep <- ggplot( -) + +ep <- ggplot() + geom_boxplot( data = CO2, aes(x = .data[[x]], y = .data[[y]], group = interaction(.data[[x]])) @@ -35,6 +41,7 @@ ep <- ggplot( scale_y_continuous(limits = c(padded_min_y, padded_max_y)) + labs(x = "x label", y = "y label") p <- app$get_values()$export$`VIS-plot` +app$wait_for_idle() p_data_extracted <- ggplot_build(p)$data[[1]] ep_data_extracted <- ggplot_build(ep)$data[[1]] expect_equal(p_data_extracted, ep_data_extracted) @@ -53,16 +60,18 @@ legendTitleFill <- "Treatment" colourTheme <- "Accent" legendTitleColour <- "" app$set_inputs(`VIS-fill` = "Treatment") +app$wait_for_idle() app$click("VIS-CreatePlotBox") +app$wait_for_idle() aesColour <- aes() aesFill <- aes(fill = .data[[fillVar]]) CO2$Treatment <- as.character(CO2$Treatment) -ep <- ggplot( -) + +ep <- ggplot() + geom_boxplot( data = CO2, - aes(x = .data[[x]], y = .data[[y]], - !!!aesColour, !!!aesFill, + aes( + x = .data[[x]], y = .data[[y]], + !!!aesColour, !!!aesFill, group = interaction(.data[[x]], !!!aesColour, !!!aesFill), ) ) + @@ -74,6 +83,7 @@ ep <- ggplot( scale_fill_brewer(palette = fillTheme) + scale_color_brewer(palette = colourTheme) p <- app$get_values()$export$`VIS-plot` +app$wait_for_idle() pd <- ggplot_build(p)$data[[1]] epd <- ggplot_build(ep)$data[[1]] tinytest::expect_equal(pd, epd) @@ -87,7 +97,9 @@ Map(function(a, b) { # Adding colour to plot app$set_inputs(`VIS-col` = "Treatment") +app$wait_for_idle() app$click("VIS-CreatePlotBox") +app$wait_for_idle() fillTheme <- "BuGn" fillVar <- "Treatment" legendTitleFill <- "Treatment" @@ -95,16 +107,18 @@ colourTheme <- "Accent" colVar <- "Treatment" legendTitleColour <- "" app$set_inputs(`VIS-fill` = "Treatment") +app$wait_for_idle() app$click("VIS-CreatePlotBox") +app$wait_for_idle() aesColour <- aes(colour = .data[[colVar]]) aesFill <- aes(fill = .data[[fillVar]]) CO2$Treatment <- as.character(CO2$Treatment) -ep <- ggplot( -) + +ep <- ggplot() + geom_boxplot( data = CO2, - aes(x = .data[[x]], y = .data[[y]], - !!!aesColour, !!!aesFill, + aes( + x = .data[[x]], y = .data[[y]], + !!!aesColour, !!!aesFill, group = interaction(.data[[x]], !!!aesColour, !!!aesFill), ) ) + @@ -116,6 +130,7 @@ ep <- ggplot( scale_fill_brewer(palette = fillTheme) + scale_color_brewer(palette = colourTheme) p <- app$get_values()$export$`VIS-plot` +app$wait_for_idle() pd <- ggplot_build(p)$data[[1]] epd <- ggplot_build(ep)$data[[1]] tinytest::expect_equal(pd, epd) @@ -132,7 +147,9 @@ Map(function(a, b) { padded_min_y <- 7.315 padded_max_y <- 26.3 app$set_inputs(`VIS-YRange` = c(7.315, 26.3)) +app$wait_for_idle() app$click("VIS-CreatePlotBox") +app$wait_for_idle() fillTheme <- "BuGn" fillVar <- "Treatment" legendTitleFill <- "Treatment" @@ -140,16 +157,18 @@ colourTheme <- "Accent" colVar <- "Treatment" legendTitleColour <- "" app$set_inputs(`VIS-fill` = "Treatment") +app$wait_for_idle() app$click("VIS-CreatePlotBox") +app$wait_for_idle() aesColour <- aes(colour = .data[[colVar]]) aesFill <- aes(fill = .data[[fillVar]]) CO2$Treatment <- as.character(CO2$Treatment) -ep <- ggplot( -) + +ep <- ggplot() + geom_boxplot( data = CO2, - aes(x = .data[[x]], y = .data[[y]], - !!!aesColour, !!!aesFill, + aes( + x = .data[[x]], y = .data[[y]], + !!!aesColour, !!!aesFill, group = interaction(.data[[x]], !!!aesColour, !!!aesFill), ) ) + @@ -161,6 +180,7 @@ ep <- ggplot( scale_fill_brewer(palette = fillTheme) + scale_color_brewer(palette = colourTheme) p <- app$get_values()$export$`VIS-plot` +app$wait_for_idle() pd <- ggplot_build(p)$data[[1]] epd <- ggplot_build(ep)$data[[1]] tinytest::expect_equal(pd, epd) @@ -177,7 +197,9 @@ Map(function(a, b) { padded_min_x <- 47.5 padded_max_x <- 637 app$set_inputs(`VIS-XRange` = c(47.5, 637)) +app$wait_for_idle() app$click("VIS-CreatePlotBox") +app$wait_for_idle() fillTheme <- "BuGn" fillVar <- "Treatment" legendTitleFill <- "Treatment" @@ -185,16 +207,18 @@ colourTheme <- "Accent" colVar <- "Treatment" legendTitleColour <- "" app$set_inputs(`VIS-fill` = "Treatment") +app$wait_for_idle() app$click("VIS-CreatePlotBox") +app$wait_for_idle() aesColour <- aes(colour = .data[[colVar]]) aesFill <- aes(fill = .data[[fillVar]]) CO2$Treatment <- as.character(CO2$Treatment) -ep <- ggplot( -) + +ep <- ggplot() + geom_boxplot( data = CO2, - aes(x = .data[[x]], y = .data[[y]], - !!!aesColour, !!!aesFill, + aes( + x = .data[[x]], y = .data[[y]], + !!!aesColour, !!!aesFill, group = interaction(.data[[x]], !!!aesColour, !!!aesFill), ) ) + @@ -206,6 +230,7 @@ ep <- ggplot( scale_fill_brewer(palette = fillTheme) + scale_color_brewer(palette = colourTheme) p <- app$get_values()$export$`VIS-plot` +app$wait_for_idle() pd <- ggplot_build(p)$data[[1]] epd <- ggplot_build(ep)$data[[1]] tinytest::expect_equal(pd, epd) @@ -218,11 +243,14 @@ Map(function(a, b) { }, pl$mapping, epl$mapping) # Test facet -app$expect_values(output = "VIS-plotResult") app$set_inputs(`VIS-XRange` = c(47.5, 1250)) +app$wait_for_idle() app$set_inputs(`VIS-YRange` = c(7.315, 47.775)) +app$wait_for_idle() app$set_inputs(`VIS-facetBy` = "Type") +app$wait_for_idle() app$click("VIS-CreatePlotBox") +app$wait_for_idle() fillTheme <- "BuGn" fillVar <- "Treatment" legendTitleFill <- "Treatment" @@ -230,18 +258,20 @@ colourTheme <- "Accent" colVar <- "Treatment" legendTitleColour <- "" app$set_inputs(`VIS-fill` = "Treatment") +app$wait_for_idle() app$click("VIS-CreatePlotBox") +app$wait_for_idle() aesColour <- aes(colour = .data[[colVar]]) aesFill <- aes(fill = .data[[fillVar]]) CO2$Treatment <- as.character(CO2$Treatment) CO2$Type <- as.character(CO2$Type) facetVar <- "Type" -ep <- ggplot( -) + +ep <- ggplot() + geom_boxplot( data = CO2, - aes(x = .data[[x]], y = .data[[y]], - !!!aesColour, !!!aesFill, + aes( + x = .data[[x]], y = .data[[y]], + !!!aesColour, !!!aesFill, group = interaction(.data[[x]], !!!aesColour, !!!aesFill), ) ) + @@ -249,9 +279,10 @@ ep <- ggplot( guides(fill = guide_legend(title = legendTitleFill)) + guides(colour = guide_legend(title = legendTitleColour)) + scale_fill_brewer(palette = fillTheme) + - scale_color_brewer(palette = colourTheme) + + scale_color_brewer(palette = colourTheme) + facet_wrap(~ .data[[facetVar]], scales = "free") p <- app$get_values()$export$`VIS-plot` +app$wait_for_idle() pd <- ggplot_build(p)$data[[1]] epd <- ggplot_build(ep)$data[[1]] tinytest::expect_equal(pd, epd) @@ -266,8 +297,11 @@ Map(function(a, b) { # Change themes app$set_inputs(`VIS-themeFill` = "Greys") +app$wait_for_idle() app$set_inputs(`VIS-theme` = "Dark2") +app$wait_for_idle() app$click("VIS-CreatePlotBox") +app$wait_for_idle() fillTheme <- "Greys" fillVar <- "Treatment" legendTitleFill <- "Treatment" @@ -275,18 +309,20 @@ colourTheme <- "Dark2" colVar <- "Treatment" legendTitleColour <- "" app$set_inputs(`VIS-fill` = "Treatment") +app$wait_for_idle() app$click("VIS-CreatePlotBox") +app$wait_for_idle() aesColour <- aes(colour = .data[[colVar]]) aesFill <- aes(fill = .data[[fillVar]]) CO2$Treatment <- as.character(CO2$Treatment) CO2$Type <- as.character(CO2$Type) facetVar <- "Type" -ep <- ggplot( -) + +ep <- ggplot() + geom_boxplot( data = CO2, - aes(x = .data[[x]], y = .data[[y]], - !!!aesColour, !!!aesFill, + aes( + x = .data[[x]], y = .data[[y]], + !!!aesColour, !!!aesFill, group = interaction(.data[[x]], !!!aesColour, !!!aesFill), ) ) + @@ -294,9 +330,10 @@ ep <- ggplot( guides(fill = guide_legend(title = legendTitleFill)) + guides(colour = guide_legend(title = legendTitleColour)) + scale_fill_brewer(palette = fillTheme) + - scale_color_brewer(palette = colourTheme) + + scale_color_brewer(palette = colourTheme) + facet_wrap(~ .data[[facetVar]], scales = "free") p <- app$get_values()$export$`VIS-plot` +app$wait_for_idle() pd <- ggplot_build(p)$data[[1]] epd <- ggplot_build(ep)$data[[1]] tinytest::expect_equal(pd, epd) @@ -308,12 +345,11 @@ Map(function(a, b) { expect_equal(a, b) }, pl$mapping, epl$mapping) -cowplot::plot_grid(p, ep) - - # Test scatterplots app$set_inputs(VisConditionedPanels = "Scatterplot") +app$wait_for_idle() app$click("VIS-CreatePlotScatter") +app$wait_for_idle() colourTheme <- "Dark2" colVar <- "Treatment" legendTitleColour <- "Title colour" @@ -321,12 +357,13 @@ aesColour <- aes(colour = .data[[colVar]]) CO2$Treatment <- as.character(CO2$Treatment) CO2$Type <- as.character(CO2$Type) facetVar <- "Type" -app$expect_values(output = "VIS-plotResult") +app$wait_for_idle() ep <- ggplot() + geom_point( data = CO2, - aes(x = .data[[x]], y = .data[[y]], - !!!aesColour + aes( + x = .data[[x]], y = .data[[y]], + !!!aesColour ) ) + labs(x = "x label", y = "y label") + @@ -334,6 +371,7 @@ ep <- ggplot() + scale_color_brewer(palette = colourTheme) + facet_wrap(~ .data[[facetVar]], scales = "free") p <- app$get_values()$export$`VIS-plot` +app$wait_for_idle() pd <- ggplot_build(p)$data[[1]] epd <- ggplot_build(ep)$data[[1]] tinytest::expect_equal(pd, epd) @@ -341,7 +379,9 @@ tinytest::expect_equal(pd, epd) # Test line plots app$set_inputs(VisConditionedPanels = "Lineplot") +app$wait_for_idle() app$click("VIS-CreatePlotLine") +app$wait_for_idle() colourTheme <- "Dark2" colVar <- "Treatment" legendTitleColour <- "Title colour" @@ -352,8 +392,9 @@ facetVar <- "Type" ep <- ggplot() + geom_line( data = CO2, - aes(x = .data[[x]], y = .data[[y]], - !!!aesColour, + aes( + x = .data[[x]], y = .data[[y]], + !!!aesColour, group = interaction(.data[[x]], !!!aesColour) ) ) + @@ -362,16 +403,9 @@ ep <- ggplot() + scale_color_brewer(palette = colourTheme) + facet_wrap(~ .data[[facetVar]], scales = "free") p <- app$get_values()$export$`VIS-plot` +app$wait_for_idle() pd <- ggplot_build(p)$data[[1]] epd <- ggplot_build(ep)$data[[1]] tinytest::expect_equal(pd, epd) -# Check saving of plots -app$click("VIS-plotSave") -app$set_inputs(`VIS-TableSaved` = "Plot Nr 1 Type: line") -app$set_inputs(`VIS-user_filename` = "Plot.xlsx") -app$click("VIS-downloadViss") -app$set_inputs(`VIS-user_filename` = "Plot.zip") -app$click("VIS-downloadViss") - app$stop() diff --git a/bs/tests/tinytest.R b/bs/tests/tinytest.R index 623441c..b78b816 100644 --- a/bs/tests/tinytest.R +++ b/bs/tests/tinytest.R @@ -1,4 +1,3 @@ if (requireNamespace("tinytest", quietly = TRUE)) { tinytest::test_package("bs") } -print("bla")