From 37a74a7c7b15c65f537ba1dd1d8ee54ccda4ab58 Mon Sep 17 00:00:00 2001 From: Giulio Benedetti Date: Wed, 16 Oct 2024 20:56:10 +0300 Subject: [PATCH 1/2] Added LoadingPlot and ColumnTreePlot panels --- DESCRIPTION | 2 +- NAMESPACE | 7 + NEWS | 3 + R/LoadingPlotNA.pdf | Bin 0 -> 13294 bytes R/class-AbundanceDensityPlot.R | 2 +- R/class-ColumnTreePlot.R | 476 +++++++++++++++++++++++++++ R/class-LoadingPlot.R | 294 +++++++++++++++++ R/class-RDAPlot.R | 2 +- R/class-RowTreePlot.R | 2 +- man/AbundanceDensityPlot.Rd | 2 +- man/ColumnTreePlot.Rd | 69 ++++ man/LoadingPlot.Rd | 59 ++++ man/RDAPlot.Rd | 2 +- man/RowTreePlot.Rd | 2 +- tests/testthat/test-ColumnTreePlot.R | 49 +++ tests/testthat/test-LoadingPlot.R | 48 +++ vignettes/iSEEtree.Rmd | 2 + 17 files changed, 1014 insertions(+), 7 deletions(-) create mode 100644 R/LoadingPlotNA.pdf create mode 100644 R/class-ColumnTreePlot.R create mode 100644 R/class-LoadingPlot.R create mode 100644 man/ColumnTreePlot.Rd create mode 100644 man/LoadingPlot.Rd create mode 100644 tests/testthat/test-ColumnTreePlot.R create mode 100644 tests/testthat/test-LoadingPlot.R diff --git a/DESCRIPTION b/DESCRIPTION index b3cc32f..986ead5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: iSEEtree -Version: 0.99.7 +Version: 0.99.8 Authors@R: c(person(given = "Giulio", family = "Benedetti", role = c("aut", "cre"), email = "giulio.benedetti@utu.fi", diff --git a/NAMESPACE b/NAMESPACE index 36b7b2b..e2d5879 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,16 +2,21 @@ export(AbundanceDensityPlot) export(AbundancePlot) +export(ColumnTreePlot) +export(LoadingPlot) export(RDAPlot) export(RowTreePlot) export(iSEE) exportClasses(AbundanceDensityPlot) exportClasses(AbundancePlot) +exportClasses(ColumnTreePlot) +exportClasses(LoadingPlot) exportClasses(RDAPlot) exportClasses(RowTreePlot) exportMethods(iSEE) importFrom(S4Vectors,isEmpty) importFrom(S4Vectors,setValidity2) +importFrom(SingleCellExperiment,reducedDim) importFrom(SingleCellExperiment,reducedDimNames) importFrom(SingleCellExperiment,reducedDims) importFrom(SummarizedExperiment,assayNames) @@ -57,6 +62,8 @@ importFrom(methods,is) importFrom(methods,new) importFrom(methods,slot) importFrom(mia,taxonomyRanks) +importFrom(miaViz,plotColTree) +importFrom(miaViz,plotLoadings) importFrom(miaViz,plotRowTree) importFrom(shiny,plotOutput) importFrom(shiny,renderPlot) diff --git a/NEWS b/NEWS index 5fd5247..5101746 100644 --- a/NEWS +++ b/NEWS @@ -14,3 +14,6 @@ Changes in version 0.99.2 Changes in version 0.99.3 * Added .exportOutput method + +Changes in version 0.99.8 +* Added ColumnTreePlot and LoadingPlot panels diff --git a/R/LoadingPlotNA.pdf b/R/LoadingPlotNA.pdf new file mode 100644 index 0000000000000000000000000000000000000000..ff6cc9126548069a1083c9dc38755797ae274eea GIT binary patch literal 13294 zcmZ{L1zeNg_dktv3kbqM5Kv$YN$GAWmCi9jfe}Nxkp}7RMnJktrKGz{y1VaGO9>Qvw_&Tuo=CVy;r;ky+?KJut5M00Mz&cwxA$3P{Iyk z1harzOB%r-0A|V8oE)57APx`@CkHnd2*iR7RDzoPfA77ufLX$4sR3l{jBLy;!1e%T z2bhfm3_eZ84r<~6hS(wQa2f9LJQ7+Y6Aeib+&;3fD%S9 zBTJ|m0H|VQ2C)acf-|TA{xyO3e7ff7(_7<_0C;QKQjs0OizI@p2X z>v8?pdI*NU-JuAvHiMZ1_&|I-0HCymB@Au>P}&mi97zZmY63y%Z4ZO{%nI8nr9@9B zdaWkR)ZD-p9di&=F9ELfiEU{z7mHSL~Yr&R4ab1vu7z~nAB@!%nLWasq^i6ONl z#ub}RI08is3616HsQYN*K6GB>TZ_Q`WTL}<|BTisG>=MV5-PzvTkV+V+O&6{-`IM6 zyLD6Ay1CHQ{N&n-THy9#FS%7W(L=MrQ?L1^oT`C9L*k;J4E71)??KTZV!(K$F48yO zRn#4N7xAmHsJ7ny=xN%lBXPBI9&c~GP(+>kHhIX5BXMnM^HY_ZH(BS?r$qv_n8dY% zcU)QLsqK3oTT2SunN%C8ZYYI30k(}hcrN#%%jYGIn^&koGvu>h5Z76~R!aoe&Fj<0 zf4DwhN$&{+&Bl9(57NqxwRp!WZk)qs1@*y~xRGBMi71%I^`{Wc!Rng(LbX0+@w5DV zCzSuw6MIoq9$#6K@I(r6_`Qii68OD7(98k=9LBX|(@sqv#=k3yOF!b*MjRc;wWR41 zazsBIyIkv<(jREOpHqj!X&}tvH^zuTjiV;wq9C%Ih{Lr$h4F`jq#7}|Lx!xq zd^8a3=kS_NA)IR|A;?`a$)>nn7_M0c@~jNPBH*(>7M-mGBPThhW6CqeLq=Ngm=qlEDrrfLh?!*%$J82guYqsR!G z!226`aLt#d3f$42*nfY`cur*ga|u33va!4iM)(7H2ln$7`Cr6;av)EWPr&WQTs4@A zLJd3N*36$0{^K-+?3ZxaV0^IKYnSy$TuWYxeMaG_ ^YQ2)UQpl#dwi0~Vb&l`_x z-OC|(4{lK#(M{k#2dJE{;O4hSLC(=;fDP*x*^lCgX_;}zGI;qRvlp{jNhnU@{ z{%Z*Cb|pT*O()eD+=4%W=@KMFXzqoJ_a~J&t0)l(g!*+YNIRs6e1Wsn`5}CP5caoQ!So2vm7iDs zpcX(R1HSn>+)~p&mi`qL9Lgt%a0cwKv2PU~x2@$LdN$&Vt6gg{LDOI)MPYONTbEx7SE9xr zLLVF5>wKx7C-Y_z@*(+%~a8oskrCTV=19s}@nn7rK=5xrHv$ z$NQ3Gblx>awGGWotJbb+OgiUlbZmY8OZeqVMS;x_6AV)IUIn9u%R6VeL zL&?FQtlHfTIT{)#{!(yCYRP!-Fm}(BPE_g5jmKKdYy3dZ%q-9eeDcJEkVLuS?j*yo z2>a`eGzJ!`%(ghjI{iU zq~$%_KfmpMzG4f1A-*rC>i1|_tt97>vlBQzJ@m!T(4qsCnq!W7TPJ6WUm0a{8x+yq zBZOkf0tC?1&5;OEI((q3=SM|_o0&R(P-J#N5)tSxwmk4w{Y|I<}_zKLMQd#DC^0l=Ze@l{3;&I z>|53oO&{vJ-g#K)T~i6pbhSi}A@6WrdoD%lBG1o04S5NucqB(-gt=1$2(yUB4Swa9 z&ccRA*$(lswO|$k&4egOY;~t*cS?zKhn3~Clrlxh$Y$8P*~v&T3w5hXAn&QJWW6CG z`P#EI?1w#~n)#xg^(QGeDPeXq1veU@NE0ddivXFQX0}ecruMb3n>xBC|p-V@Ag?Dtb#IPFejY6I!0`RZ2up%=ZSuLmxkfMCfL}7v(+XcERtC;&m(E3g=Rz^my(O}dO+PSjx!L4dsr*Zze@^laY>sNN$n~ZiGDDq zh*OZ6+)y%6eoYCf@J6xmo7z=!9bwYzZa`jVJWYKClXg&)m}1y77ICCP$~JSQ)L!2r6Tyg;E}APn{z~9euJ+DvoA5qriejuyibhV>QjaN zm4Zi<3_!dRrlUMxG&KUg>ZNWn?N^tL9@QSe@fFF4ro|B#;}4;QG+n-aA56b?RST*I zKS^#SnWf;ureLpq%)!Feh<8U~)`84x*l2b%Ot6~VRaCtYa=hjMztUx!6~=ottP@{d)+ z9vO#^Auds5M)~yyW9EIDekf|#Cn&PYw6RM;0*cK{EYjikPrZ1^>A)rgbcS!)Vy7ugPO(YA~_a>j;8AM1cA- z-;IeE(z;N+U>5tn=|IYR$(#H^fgbdX*_)3oMr=;C8HM=HQ%P9{JarqwXZ20_2M6P} zIj*2|a~a?wTFLC!S)&QAwn$Wnu3>z?3E}kUNx#pE?7ab6w*v&PJw-3SK;;RII>!GfBDMWqEg)Mt= zuTUr%Fn$^<>*CdyS%?#)>myRXBikT-MqLBT4b74TwBTKmg)Ogs@kN<2&J$xn@M6u|&~ zkrB}@^#)xK>sfosD>B#Rm;Tugb4FH3vWyaV3~2ILIogss%Jp%~URk_TrVsay;0#jH zYdze0Cet+rXa?>VP{JnO*bZ7US# zk#}}(fB$wL4U3JPcN@?~0XbKpsYQQ=`vfb~)T!$oi1G+ew7lXy+OQ+q@>dnnWgGyu ztnfQ#5fVpq6$D(haV!%~HP$gudsECJxlF{zf}~ zCP}M>j`c-QU`J$2Yg+vnBNniYhZYfWA_dLxI_$};WglCT3r;Xy<1&DkBKa@HJu%c7 zNXtTsE~|NI%g@?~m#iC$w7k872#V!N(=@&p=y>NvZq#kGg2yRtq;P9P7PBB^@yE#7>2$=$_7lJrg^&wJHX9YxliuhD9m?ah%_0lWq_5zC5@#JSR! zn(11eX}k0sFtasV=uHtbw}$0($I#THz{+-NhVxyz3~$P-51)CfK_nu(`Ia@OnSByw zZKVherW5W0u615g3Ce0d>z=~_Tq}0Z>G;R@>!Aik&XR^~1~`;@#e7slDIgrgXDfFzl(jvo#o}vWcYyf2+9?upvH z6=uaouchdI*lp?AGx%FM%)8u3`wiWRQ?SE8@(Z39vQ7&%X=)wPNVzki46pW-o1StH zCd;9T>y9McMqFcD9n>KIeqU_=`4M$?zPj_}Li~m~{8dg#O4wUJ zqy|Nu?!3y9e9|`ZbDaT~N0S_CBR|1vNKi_t;BB_-U%=m%X_dA!=qeuL($OqRWk@4z z&4u~5KSXDh=P+2@pF}`g#vV0G=lSHEY9keXnVV4mMyq)qCH0N;u-~OK%cuPsnc&G3 zYM`!&`4&s7N_8~@?bhcPG&$0B#>%@wg~3Zt*Y#=B-b!k|KgXG4DZuI9p4$N!?K2V% zAp7^q+vzAfQ`J;!L@}x?_*-yxSWyu4%yNjCHguMeZJX|L`x6ItD=|a}r=u_%XbzcR z-{4kKtj$!tJyH`Bzl;@~*8IF~61T?wWjxJ_Z2`hBn1a@GF?wk#bV!QHNu!aq5UujN z!qjlEWlSbcw0jY|fBRWH=1kNKgO4aBhK=@%p-Sz$;19&m`GsPBYf6{CnMKHX*Cv>TN5e@B3F$^NKuPy zF-hYv6-+rXStKKJr@1?>vzXR>3l|-OZ*m3~t72ahcZB3J3*lKKGC!t15F&G)&xGw< zju911g~Ghik?YMdTxSKi^0T^r3dJq}EJZS^2rG~zjcO$gL0+g^Yxj#=zR8to;U}kr z>pv$8XvPPk2LN|8H z!cVPSm~l2pTWAI$Xj zbKlvFGiDZK7Drio1#HnOrTGddl%9jDA0>S*@SI;^IT=SQ3WKCM2D}oSGd?x=xWXBU-S?vyJ@ne- zh4kSByl7mSOsBj3ij*~f6B!5{00ltbE65YeE~bh_Ew855j}>=PKV@)!h78l<%ULLZ ze;S5&3)fzNugyPE!cL`M$j&6M&VUy?ffqY4h)NDCk};@-Y&6$@lW!M(V!z-HE)-!wwRcXb&haAUE6-x z#3WaC%A1jD^alG|hPd?1G+@@xv|8)oAg<6dU3A6QWrW%*-k*mIaPP}v*c_#}?()iq zQaqXypl^`%%v&_8$dUDswvgR1eAgEE<%Of5@AbmbdJxw^qEqj{>7Jhx=JxtOd5aVZ zFxpoc1!YqQYtrnd2fyY^soB3cJnFBH>EgvHXNWy^ib!iq@OG~iloBuG?-b1Bm*RzA zL7DvV?HcFL<=BI8`U@EbcsHW>7Im3}P5|y!#p>gD=t-P~02T_!`Z?!M zWEJBhkm9xMBNbxidPzCc1}@X-^wgfoHotY4P$+bO z{Kuu~yhs6{Fzpq)V{Ue_C@=DGmg;doK9#s1kS;Jqa7~vhB48oDZjAXbF-Sn$=vaDx zc+uLr-8t`~^_hjVVTH>5H2W@ol5ptBqOp(ZrdzUAJ5CCA7^ zrYyWf=lp>wVV`|tdbR|)(Y?Oa+4(E4w!pQF&N<`0%vr}-|EoX&cXOu-+f!wXpycv+ z&L=din`TdMZ_qJWB#IKcF{6DG)`wXae$cd!mF56UUkwkdfX+f#f)k@Y(iv}0s*_ee ze-LjU0~P{0alsRR1j&o9h#uRdSdjn7Za+jQZxV6*6MGN9rl?6<1Q zZrq7C`xW2SCPa5eiDE+z6uI)_6x;4#_8x8Y?YeMpX9q<`{VWNtLuDsp>YCi6VaOw?v&|01-v}94}_n+ho0*8HEKZj0sTE+&X-P)kM2hI z?nZlEPahTpMXFd|*cf_X0Lo-APuG`5S0q+ek{BN)M%_$*M(f}$#?}0t?P+U&cJa6= zLB!|FrDkgj9oKh`PNN64<}OcXl(Spd&85PjE?#BrrShA;?qRp9t+oB7(XA~EF8!As zo-G{&reOo?^F_crYOSfHyK}U{UDRc|c4ZyX2iVEZ-ZZXa$_-I!UAEn*HKf3>x&a9kn?`rgH zzO5_ZX2<{QNS#PR@?G*mV_-ldK`m|R0hOI-*`8kK91KTq5YGQh&a<%qOtQ|=DDfdE(t%?m8|YgkYC<@xpbox#0% zfRXbYvHSPCK5FUE;cl#-dlH1O!?n!v~WA5z~z%I2JvG zC+ScF$7ouUC%ei8P1>|7Vyw)_o!g44mg>ZW=)hr|Z66&qFM!jGqny+aJSo@Jsq#uf>tWI;#12cLrT~xO>|t{?m^lkt9}ZeX5GuyA4j(RZi32=$%Ga_yk**hohxND;KjX`XUcQ>)B>Io{!A^SwUz>Gm}#6 zI#l*|XES(y1HyGNems^O?>(>Vc|Nvws@(58q1~_Cj0(wmdN*a4Fz}*pMesg%G@xr{ z1nIR2-S9WwICibn(=IMvRvzbX?6{^Y%`YqpR||Kp1EcyP6rYz4emXhXVo96V<^A;g zxhJxbe~#T$3_cAMnnp)vQ4-=mEMdH5Ds}mA{|OWOc>2u^SMod$T?el9!?-{b@cQTu zI0<}kYijo3PtE!*zfz_8E$qI9p>|<6dNsFJJ$7}wSubXnw?iU!_1gX11Kr) z)IEKG*C2__?V)&Jx7oWSW-p>{xCn1B{dpg(Z#k^;0`MAFm#8-4537 z379L3J{MklxH);aMmt2G(q&;TyEBZ9+YhJt=|^z9@z=&;?47N6u0Un zHZO`8D2;BWR?*IEHhj^zmw@g>Y{GxKP6UHmrtIOrPp%_r7|FB~nYSDDuaac;5n1#h z+miabu0J{*KyINujyRDWlvjEdM(vyvi5kXbw;Cyp&o%Phmc}B*o@?Y+q|6ikfoFG5 zF}kkLrkxZh=tBL=j<#PVjBkhXWEoY`0G)gb-x(Oonrkl5nYnOtIa(Qww3AvV< ziywQ@TwnN;9kmucpo(XIIfVlk{(%Ab2ZVwDF9ZPq4yXY94Pww#HvRws!w>{@2V>YD zV1t|$9H@YxXjquQQ3fEyTUm&OnK>M_z`=nSNkA>3cIq}pU;iO(M=F;gVJpiFs5mC8n) z2Bb*`(Pq4&%jBld;$g_65m!ruqXVY#MvmQ5#UiXiEo|gSy z*8M&<1HQI{pY4bI9fkuPhl8C)LR?0}+{VJ)$09t(BfTf0eI{f4Cgc34;sd7>gJzOK zW>Ugt)57P{Bjz)s=CfiJa$*;A;}`Q2e-|V#eN9;^N?R_;SSig~Ez4Q0$X%<-s+1*)r47Jk#DZ{j*`}NB!jYy2;j>iI(c|rpmF#iqVGh(fZPn zx^KfZB}3IkLsee~D+>oI^83s3`bu;AzUB0mWc3tfc7M(2E=>DXklK}>(wUpok(1bw zozR{Y*OnRkGd<>KTGWr!$nPl;t;t_n62n>&LYw15n&N^QV*?wb0~(_I>m&W@B7AGV z_|%4Z*Mxdjhj>&4yH^FdRtC6K_&b+>b}IM#ROahY>J9tmWnbcHTjF6;><%q*wf^d2 z_0{=fq0@(gPZs$O=J_zwJbOs4ok@-jI2&r5ZEcukWsvz%KjVX5hJ{YLxptbFRw_g@ z)kGr&{4Uw}ZIYpSl7U*HzG{M=O1#dSIBlgkEyY+(g_!s9(eLD<-^xU(Nk^(mMW{$d zC`)`%5)W4t4O0*alM@b=6$+sW5nTD7s)E2h{e?^VyQchwhXN{CnAih!00&KkpOIC|chD#$$82p#sp8~J zN+=hboDcew7ilj%KBhMh&YK;$Pc$G!-1?&bRMf=s!p+nqUE1gf3=1(c#6-qDL_)Ph z`fXELDgO9U8YL0MZ7S3rxRxd9(=b@O6WB=iT;LwZcT7Ci__B_VX<_;Om8lDwNw zNF#-@R=GQ&hD&LHLw%ZKxQwEZ!wj@x-6gn<8q(@&7H*M49ba=1Fjv=YWo+!7jT zNJ+l&=(3)(V#x-MV&?Q=TX9DEE!%ByI0Dq{ z8zku^=oskJW+!II52SpqtL`5bO%k#+IH{0)xtdHsdt+kb@3@q-_LWOQj+$v?Oekn5f7;>4^lmS9bjcahNQQH ztkQTF&~FGt3a)5zz<0N$X>ik5YhPwHds#F$r>lUR{*eW^d2pSM?P) z^=8oL-d&?k@&4Ci2G4M?j3j3rvFgBX(ycZM7XV306m?saY7>>@J6g?mqB4{J z%zI{k)pAti+0t|-?A}(JZ8w!{=_%|0HCcAg9A=(_W8V7!w z7t0}bpD3Z<=U;?mY5_2S#4qZK&zccbtElJ_L@LxVj~FGyWl_jPcQVupsK5GeXPR#6 zY%;^1G$7$g)Mluf6JL|LU_Rr(%KM>RMr4UzX{gNiDBO?yNB1EoA1%92?e|z4R5!wX zKjpUg-$a_&BHsB#UW7!ivqCtC9{-dUk91(A4M`nk6Y&D!K`24T$zksi zm48&)FZ`y6Lyz2Zl+R`V-Qt8&%}ggrTiK&RV*PH}ppte~?cBH7u(wmtRZA*9)8rj>hH3 zX2zw*77AaDxsQ#G)fPGyE{=*?Bv|-;T>Y>+%vW>-!?z0WrQT18;t$xEoABfA=X%Da zVZJ{~J(MyrGI2cGGxBxhb@tiY5woS??I`o?bU!t7E*zpu<4ND8Z=3JMw33 zBW=_3zw<8*3k@?4<)Lt(6ykjU3ZG+u*P6TKqd1Q(ua@bEpIxQA2e)x4FT|D`=|qyt#XqzcGoqy7?&hq^Km3ZL+5Gd`9!o!DS2(^N-s0cZY_Pp{WcC#HXB?Yd1}k(1{s zBq@aSW;=JnH&IVE!s@r{?R0naa;>+CR<8!bZl5^xQu=24Uit&cL`k_Umu#|ZlC0!xgD$78 zm@ZjxiLpkfe(-1@NxMTAcqMx!c{!i_nsu(;M(~GlCg0LE{fd-x2s`V9W=hNDC2X6+0`?t)AUf zPdW1aa8g$Jna7S!2wAXH2QN>ZWx;IV4D%FUoyC6MS0!2nCq{CG5`~xYi_mrJmdn_F zjaUQsnW!pASzo5*;QPM!OA|Y@bG1*IHP{D%w6io7&GwjJneOm-f%x4f6(bGR+K@7Z z3I%OS-Dy1t{0G!+cL(`1*)RH=f=|Aqp8vN`R_EeFRV)q5BgnNuLm%) z{e#^T-1%>4c%*sHJ^Qa4>gBQvtG3!amOQq+15w@k!~6T$lGq?6HbprO$A&+D^e#Gi zj?Q;l7D4lC<7rR=7y@WKlP~wq+Qb4}zm$bnxtm?;Sz%UZ=a6jcF7S`Xjxg?p@6ZT8 zajL5A%FSPK?LD}l9Tj?Sue;_njrB7qizNNcdU}d*ti$%!*6Jv@S;6HXB}mA=1lR;U zv>ci~*>D?7-MZKnab7sPEyo!k57#%*+ih62DYXCYk+Fh#L;D)zDTY7*bwC49KyRNi zjn{2C_$GE#qq#J#@v+U`$gkVTr5)8t=z?q=U2}Ki)#m%_l8st>>%loKdvf>M)wGf3 z;G3iiDi5x^a=mSUknpz9>qEmIz5?L6awZYT!>LEpCf$`$hu?tY$+KCRuIKJdKoR{* zr(3y+=*0XEk(Up;H+`$qj;&6&oE&5V-1oYtx1*)W1_iBC4+w2QNhuJT|W=PLKBULzUA#P%r#WZvJOG4npjy|K2?Rbx=Xd z8h$3g!Ww>30kLoW*GR*{TFlzs;%@>rP}0KG6aqh;fH;1j1K{EYT3J{-*aP@^fVK`$ z7{n4{3d06*aRE)B@B2)I{fj=Up%r9%TExP1=t81__tpGe_ZQd|4HNL;eki&zi7N%|I5e6|3B;T^K-&mrT?7E!3lyNRrzlk z|NqeVxVisZE{Kx{1n-OfV=jo3j~Cv-{Y`_}8Ch6D?BHi|;LnRJTp(~Cz`HSPQz*Qz mLv&w2H7FDYK%ABN<1c%dksa)hw?LfyyxiD~j8e+d*#8eknb#Qr literal 0 HcmV?d00001 diff --git a/R/class-AbundanceDensityPlot.R b/R/class-AbundanceDensityPlot.R index c5fb4bf..b22065d 100644 --- a/R/class-AbundanceDensityPlot.R +++ b/R/class-AbundanceDensityPlot.R @@ -6,7 +6,7 @@ #' to generate the plot. #' #' @section Slot overview: -#' The following slots control the thresholds used in the visualization: +#' The following slots control the thresholds used in the visualisation: #' \itemize{ #' \item \code{layout}, a string specifying abundance layout (jitter, density or points). #' \item \code{assay.type}, a string specifying the assay to visualize. diff --git a/R/class-ColumnTreePlot.R b/R/class-ColumnTreePlot.R new file mode 100644 index 0000000..a6b8195 --- /dev/null +++ b/R/class-ColumnTreePlot.R @@ -0,0 +1,476 @@ +#' Column tree plot +#' +#' Hierarchical tree for the columns of a +#' \code{\link[TreeSummarizedExperiment:TreeSummarizedExperiment-constructor]{TreeSummarizedExperiment}} +#' object. The tree represents the sample hierarchy of the study and gets stored +#' in the \code{\link[TreeSummarizedExperiment:rowLinks]{colTree}} slot of the +#' experiment object. The panel implements \code{\link[miaViz:plotTree]{plotColTree}} +#' to generate the plot. +#' +#' @section Slot overview: +#' The following slots control the thresholds used in the visualisation: +#' \itemize{ +#' \item \code{layout}, a string specifying tree layout +#' \item \code{add_legend}, a logical indicating if color legend should appear. +#' \item \code{edge_colour_by}, a string specifying parameter to color lines by +#' when \code{colour_parameters = "Edge"}. +#' \item \code{edge_size_by}, a string specifying parameter to size lines by +#' when \code{size_parameters = "Edge"}. +#' \item \code{tip_colour_by}, a string specifying parameter to color tips by +#' when \code{colour_parameters = "Tip"}. +#' \item \code{tip_size_by}, a string specifying parameter to size tips by +#' when \code{size_parameters = "Tip"}. +#' \item \code{tip_shape_by}, a string specifying parameter to shape tips by +#' when \code{shape_parameters = "Tip"}. +#' \item \code{node_colour_by}, a string specifying parameter to color nodes by +#' when \code{colour_parameters = "Node"}. +#' \item \code{node_size_by}, a string specifying parameter to size nodes by +#' when \code{size_parameters = "Node"}. +#' \item \code{node_shape_by}, a string specifying parameter to shape nodes by +#' when \code{shape_parameters = "Node"}. +#' \item \code{order_tree}, a logical indicating if tree is ordered by +#' alphabetic order of taxonomic levels. +#' } +#' +#' In addition, this class inherits all slots from its parent \linkS4class{Panel} class. +#' +#' @return +#' The \code{ColumnTreePlot(...)} constructor creates an instance of a ColumnTreePlot +#' class, where any slot and its value can be passed to \code{...} as a named +#' argument. +#' +#' @author Giulio Benedetti +#' @examples +#' # Import TreeSE +#' library(mia) +#' data("Tengeler2020", package = "mia") +#' tse <- Tengeler2020 +#' +#' # Store panel into object +#' panel <- ColumnTreePlot() +#' # View some adjustable parameters +#' head(slotNames(panel)) +#' +#' # Launch iSEE with custom initial panel +#' if (interactive()) { +#' iSEE(tse, initial = c(panel)) +#' } +#' +#' @docType methods +#' @name ColumnTreePlot +NULL + +#' @rdname ColumnTreePlot +#' @export +setClass("ColumnTreePlot", contains="Panel", slots=c(layout="character", + add_legend="logical", edge_colour_by="character", tip_colour_by="character", + order_tree="logical", tip_size_by="character", edge_size_by="character", + tip_shape_by="character", node_size_by="character", node_shape_by="character", + node_colour_by="character", visual_parameters="character", + size_parameters="character", shape_parameters="character", + colour_parameters="character")) + +#' @importFrom iSEE .singleStringError .validLogicalError +#' @importFrom S4Vectors setValidity2 +setValidity2("ColumnTreePlot", function(x) { + msg <- character(0) + + msg <- .singleStringError(msg, x, fields=c("layout", "edge_colour_by", + "tip_colour_by", "tip_size_by", "edge_size_by", "tip_shape_by", + "node_colour_by", "node_size_by", "node_shape_by")) + msg <- .validLogicalError(msg, x, fields=c("add_legend", "order_tree")) + + if (length(msg)) { + return(msg) + } + + TRUE +}) + +#' @importFrom iSEE .emptyDefault +#' @importFrom methods callNextMethod +setMethod("initialize", "ColumnTreePlot", function(.Object, ...) { + args <- list(...) + args <- .emptyDefault(args, "layout", "circular") + args <- .emptyDefault(args, "add_legend", TRUE) + args <- .emptyDefault(args, "edge_colour_by", NA_character_) + args <- .emptyDefault(args, "edge_size_by", NA_character_) + args <- .emptyDefault(args, "tip_colour_by", NA_character_) + args <- .emptyDefault(args, "tip_size_by", NA_character_) + args <- .emptyDefault(args, "tip_shape_by", NA_character_) + args <- .emptyDefault(args, "node_colour_by", NA_character_) + args <- .emptyDefault(args, "node_size_by", NA_character_) + args <- .emptyDefault(args, "node_shape_by", NA_character_) + args <- .emptyDefault(args, "visual_parameters", NA_character_) + args <- .emptyDefault(args, "colour_parameters", NA_character_) + args <- .emptyDefault(args, "shape_parameters", NA_character_) + args <- .emptyDefault(args, "size_parameters", NA_character_) + args <- .emptyDefault(args, "order_tree", FALSE) + + do.call(callNextMethod, c(list(.Object), args)) +}) + +#' @export +#' @importFrom methods new +ColumnTreePlot <- function(...) { + new("ColumnTreePlot", ...) +} + +#' @importFrom iSEE .getEncodedName .checkboxInput.iSEE +#' @importFrom methods slot +setMethod(".defineDataInterface", "ColumnTreePlot", function(x, se, select_info) { + panel_name <- .getEncodedName(x) + + list(.checkboxInput.iSEE(x, field="order_tree", label="Order tree", + value=slot(x, "order_tree"))) +}) + +#' @importFrom methods callNextMethod +setMethod(".defineInterface", "ColumnTreePlot", function(x, se, select_info) { + + out <- callNextMethod() + list(out[1], .create_visual_box_for_rowtree(x, se), out[-1]) +}) + +#' @importFrom iSEE .getEncodedName .createProtectedParameterObservers +#' .createUnprotectedParameterObservers +setMethod(".createObservers", "ColumnTreePlot", + function(x, se, input, session, pObjects, rObjects) { + + callNextMethod() + panel_name <- .getEncodedName(x) + + .createProtectedParameterObservers(panel_name, c("layout", "add_legend", + "RowSelectionSource", "order_tree", "size_parameters", "visual_parameters", + "shape_parameters", "colour_parameters"), input=input, pObjects=pObjects, + rObjects=rObjects) + + .createUnprotectedParameterObservers(panel_name, c("edge_colour_by", + "tip_colour_by", "tip_size_by", "tip_shape_by", "node_size_by", + "node_shape_by", "node_colour_by", "edge_size_by"), input=input, + pObjects=pObjects, rObjects=rObjects) + + invisible(NULL) +}) + +setMethod(".fullName", "ColumnTreePlot", function(x) "Column tree plot") + +#' @importMethodsFrom iSEE .panelColor +setMethod(".panelColor", "ColumnTreePlot", function(x) "steelblue") + +#' @importFrom iSEE .getEncodedName +#' @importFrom shiny plotOutput +#' @importFrom shinyWidgets addSpinner +setMethod(".defineOutput", "ColumnTreePlot", function(x) { + panel_name <- .getEncodedName(x) + + addSpinner(plotOutput(panel_name, + height = paste0(slot(x, "PanelHeight"), "px")), color=.panelColor(x)) +}) + +#' @importFrom iSEE .processMultiSelections .textEval +#' @importFrom miaViz plotColTree +setMethod(".generateOutput", "ColumnTreePlot", + function(x, se, all_memory, all_contents) { + + panel_env <- new.env() + all_cmds <- list() + args <- character(0) + + all_cmds[["select"]] <- .processMultiSelections( + x, all_memory, all_contents, panel_env + ) + + if( exists("col_selected", envir=panel_env, inherits=FALSE) ) { + panel_env[["se"]] <- se[unlist(panel_env[["col_selected"]]), ] + } else { + panel_env[["se"]] <- se + } + + args[["layout"]] <- deparse(slot(x, "layout")) + args[["add_legend"]] <- deparse(slot(x, "add_legend")) + args[["order_tree"]] <- deparse(slot(x, "order_tree")) + + if( "Colour" %in% slot(x, "visual_parameters") ){ + args <- .assign_viz_param(args, x, "Edge", "colour") + args <- .assign_viz_param(args, x, "Node", "colour") + args <- .assign_viz_param(args, x, "Tip", "colour") + } + + if( "Shape" %in% slot(x, "visual_parameters") ){ + args <- .assign_viz_param(args, x, "Node", "shape") + args <- .assign_viz_param(args, x, "Tip", "shape") + } + + if( "Size" %in% slot(x, "visual_parameters") ){ + args <- .assign_viz_param(args, x, "Edge", "size") + args <- .assign_viz_param(args, x, "Node", "size") + args <- .assign_viz_param(args, x, "Tip", "size") + } + + args <- sprintf("%s=%s", names(args), args) + args <- paste(args, collapse=", ") + fun_call <- sprintf("p <- miaViz::plotColTree(se, %s)", args) + + fun_cmd <- paste(strwrap(fun_call, width = 80, exdent = 4), collapse = "\n") + plot_out <- .textEval(fun_cmd, panel_env) + all_cmds[["fun"]] <- fun_cmd + + list(commands=all_cmds, plot=plot_out, varname=NULL, contents=NULL) +}) + +#' @importFrom iSEE .getEncodedName .retrieveOutput +#' @importFrom shiny renderPlot +#' @importFrom methods callNextMethod +setMethod(".renderOutput", "ColumnTreePlot", + function(x, se, output, pObjects, rObjects) { + + panel_name <- .getEncodedName(x) + force(se) # defensive programming to avoid bugs due to delayed evaluation + + output[[panel_name]] <- renderPlot({ + .retrieveOutput(panel_name, se, pObjects, rObjects) + }) + + callNextMethod() +}) + +#' @importFrom grDevices pdf dev.off +setMethod(".exportOutput", "ColumnTreePlot", + function(x, se, all_memory, all_contents) { + + contents <- .generateOutput(x, se, all_memory=all_memory, + all_contents=all_contents) + + newpath <- paste0(.getEncodedName(x), ".pdf") + + pdf(newpath, width=slot(x, "PanelHeight") / 75, + height=slot(x, "PanelWidth") * 2) + + print(contents$plot) + dev.off() + + newpath +}) + +#' @importFrom methods callNextMethod +setMethod(".hideInterface", "ColumnTreePlot", function(x, field) { + + if( field %in% c("SelectionHistory", "ColumnSelectionRestrict", + "ColumnSelectionDynamicSource", "ColumnSelectionSource") ){ + TRUE + } else { + callNextMethod() + } +}) + +setMethod(".multiSelectionResponsive", "ColumnTreePlot", + function(x, dims = character(0)) { + + if( "column" %in% dims ){ + return(TRUE) + } + + return(FALSE) +}) + +#' @importFrom methods callNextMethod +#' @importFrom iSEE .getEncodedName .getPanelColor .addTourStep +setMethod(".definePanelTour", "ColumnTreePlot", function(x) { + rbind(c(paste0("#", .getEncodedName(x)), sprintf( + "The ColumnTreePlot panel contains a phylogenetic + tree from the + miaViz + package.", .getPanelColor(x))), + .addTourStep(x, "DataBoxOpen", "The Data parameters box shows the + available parameters that can be tweaked to control the data on + the heatmap.

Action: click on this + box to open up available options."), + .addTourStep(x, "VisualBoxOpen", "The Visual parameters box shows + the available visual parameters that can be tweaked in this + tree.

Action: click on this box to + open up available options."), + callNextMethod()) +}) + +#' @importFrom iSEE .getEncodedName .selectInput.iSEE .checkboxInput.iSEE +#' .radioButtons.iSEE .conditionalOnRadio .addSpecificTour +#' @importFrom SummarizedExperiment colData +#' @importFrom TreeSummarizedExperiment rowTreeNames +.create_visual_box_for_coltree <- function(x, se) { + panel_name <- .getEncodedName(x) + .addSpecificTour(class(x)[1], "layout", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_layout + .selectize-control"), intro = "Here, we can select the + layout of the tree.")))}) + .addSpecificTour(class(x)[1], "add_legend", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_add_legend"), intro = "Here, we can choose + whether or not to show a legend.")))}) + .addSpecificTour(class(x)[1], "edge_colour", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_edge_colour"), intro = "Here, we can choose + whether or not to colour the lines by a variable from the + colData. When active, the available options are listed + and one of them can be selected.")))}) + .addSpecificTour(class(x)[1], "tip_colour", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_tip_colour"), intro = "Here, we can choose + whether or not to colour the tips by a variable from the + colData. When active, the available options are listed + and one of them can be selected.")))}) + .addSpecificTour(class(x)[1], "node_colour", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_node_colour"), intro = "Here, we can choose + whether or not to colour the nodes by a variable from the + colData. When active, the available options are listed + and one of them can be selected.")))}) + .addSpecificTour(class(x)[1], "order_tree", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_order_tree"), intro = "Here, we can order + the tree alphabetically.")))}) + .addSpecificTour(class(x)[1], "tip_colour_by", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_tip_colour_by + .selectize-control"), intro = "Here, we can + choose how to colour the tips by.")))}) + .addSpecificTour(class(x)[1], "tip_size_by", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_tip_size_by + .selectize-control"), intro = "Here, we can + choose how to size the tree tips by.")))}) + .addSpecificTour(class(x)[1], "tip_shape_by", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_tip_shape_by + .selectize-control"), intro = "Here, we can + choose how to shape the tree tips by.")))}) + .addSpecificTour(class(x)[1], "edge_colour_by", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_edge_colour_by + .selectize-control"), intro = "Here, we can + choose how to colour the tree edges by.")))}) + .addSpecificTour(class(x)[1], "edge_size_by", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_edge_size_by + .selectize-control"), intro = "Here, we can + choose how to size the tree edges by.")))}) + .addSpecificTour(class(x)[1], "node_size_by", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_node_size_by + .selectize-control"), intro = "Here, we can + choose how to size the tree nodes by.")))}) + .addSpecificTour(class(x)[1], "node_shape_by", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_node_shape_by + .selectize-control"), intro = "Here, we can + choose how to shape the tree nodes by.")))}) + .addSpecificTour(class(x)[1], "node_colour_by", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_node_colour_by + .selectize-control"), intro = "Here, we can + choose how to colour the tree nodes by.")))}) + .addSpecificTour(class(x)[1], "visual_parameters", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_visual_parameters"), intro = "Here, we can + choose to show the different visual parameters.")))}) + .addSpecificTour(class(x)[1], "colour_parameters", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_colour_parameters"), intro = "Here, we can make + the colour depend on the value of a + categorical column data field for each plot components + (line, tip, node).")))}) + .addSpecificTour(class(x)[1], "shape_parameters", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_shape_parameters"), intro = "Here, we can make + the shape depend on the value of a + categorical column data field for each plot components + (line, tip, node).")))}) + .addSpecificTour(class(x)[1], "size_parameters", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_size_parameters"), intro = "Here, we can make + the size depend on the value of a + categorical column data field for each plot components + (line, tip, node).")))}) + + # Define what parameters the user can adjust + collapseBox(paste0(panel_name, "_VisualBoxOpen"), + title="Visual parameters", open=FALSE, + # Tree layout + .checkboxGroupInput.iSEE(x, field="visual_parameters", label=NULL, + inline=TRUE, selected=slot(x, "visual_parameters"), + choices=c("Colour", "Size", "Shape")), + + .conditionalOnCheckGroup( + paste0(panel_name, "_visual_parameters"), "Colour", + list( + .checkboxGroupInput.iSEE(x, field="colour_parameters", + inline=TRUE, selected=slot(x, "colour_parameters"), + choices=c("Edge", "Node", "Tip"), label="Colour by:"), + .conditionalOnCheckGroup( + paste0(panel_name, "_colour_parameters"), "Edge", + .selectInput.iSEE(x, field="edge_colour_by", + label="Color lines by", choices=names(colData(se)), + selected=slot(x, "edge_colour_by"))), + .conditionalOnCheckGroup( + paste0(panel_name, "_colour_parameters"), "Node", + .selectInput.iSEE(x, field="node_colour_by", + label="Color nodes by", choices=names(colData(se)), + selected=slot(x, "node_colour_by"))), + .conditionalOnCheckGroup( + paste0(panel_name, "_colour_parameters"), "Tip", + .selectInput.iSEE(x, field="tip_colour_by", + label="Color tips by", choices=names(colData(se)), + selected=slot(x, "tip_colour_by"))))), + + .conditionalOnCheckGroup( + paste0(panel_name, "_visual_parameters"), "Size", + list( + .checkboxGroupInput.iSEE(x, field="size_parameters", + inline=TRUE, selected=slot(x, "size_parameters"), + choices=c("Edge", "Node", "Tip"), label="Size by:"), + .conditionalOnCheckGroup( + paste0(panel_name, "_size_parameters"), "Edge", + .selectInput.iSEE(x, field="edge_size_by", + label="Size lines by", choices=names(colData(se)), + selected=slot(x, "edge_size_by"))), + .conditionalOnCheckGroup( + paste0(panel_name, "_size_parameters"), "Node", + .selectInput.iSEE(x, field="node_size_by", + label="Size nodes by", choices=names(colData(se)), + selected=slot(x, "node_size_by"))), + .conditionalOnCheckGroup( + paste0(panel_name, "_size_parameters"), "Tip", + .selectInput.iSEE(x, field="tip_size_by", + label="Size tips by", choices=names(colData(se)), + selected=slot(x, "tip_size_by"))))), + + .conditionalOnCheckGroup( + paste0(panel_name, "_visual_parameters"), "Shape", + list( + .checkboxGroupInput.iSEE(x, field="shape_parameters", + inline=TRUE, selected=slot(x, "shape_parameters"), + choices=c("Node", "Tip"), label="Shape by:"), + .conditionalOnCheckGroup( + paste0(panel_name, "_shape_parameters"), "Node", + .selectInput.iSEE(x, field="node_shape_by", + label="Shape nodes by", choices=names(colData(se)), + selected=slot(x, "node_shape_by"))), + .conditionalOnCheckGroup( + paste0(panel_name, "_shape_parameters"), "Tip", + .selectInput.iSEE(x, field="tip_shape_by", + label="Shape tips by", choices=names(colData(se)), + selected=slot(x, "tip_shape_by"))))), + + .selectInput.iSEE(x, field="layout", label="Layout:", + choices=c("circular", "rectangular", "slanted", "fan", + "inward_circular", "radial", "unrooted", "equal_angle", + "daylight", "dendrogram", "ape", "ellipse", "roundrect"), + selected=slot(x, "layout")), + # Colour legend + .checkboxInput.iSEE(x, field="add_legend", label="View legend", + value=slot(x, "add_legend"))) +} + +#' @importFrom methods slot +.assign_viz_param <- function(args, x, element, aesthetic) { + + param_name <- paste(tolower(element), aesthetic, "by", sep = "_") + + if( element %in% slot(x, paste(aesthetic, "parameters", sep = "_")) ){ + args[[param_name]] <- deparse(slot(x, param_name)) + } + + return(args) +} \ No newline at end of file diff --git a/R/class-LoadingPlot.R b/R/class-LoadingPlot.R new file mode 100644 index 0000000..2a9ae1e --- /dev/null +++ b/R/class-LoadingPlot.R @@ -0,0 +1,294 @@ +#' Loading plot +#' +#' Contribution of single features in a +#' \code{\link[TreeSummarizedExperiment:TreeSummarizedExperiment-constructor]{TreeSummarizedExperiment}} +#' to the components of a target reduced dimension. The panel implements +#' \code{\link[miaViz:plotLoadings]{plotLoadings}} to generate the plot. +#' +#' @section Slot overview: +#' The following slots control the thresholds used in the visualisation: +#' \itemize{ +#' \item \code{dimred}, a string specifying the dimred to visualize. +#' \item \code{layout}, a string specifying abundance layout (barplot or heatmap). +#' \item \code{ncomponents}, a number indicating the number of components to visualize. +#' } +#' +#' In addition, this class inherits all slots from its parent \linkS4class{Panel} class. +#' +#' @return +#' The \code{LoadingPlot(...)} constructor creates an instance of an +#' LoadingPlot class, where any slot and its value can be passed to +#' \code{...} as a named argument. +#' +#' @author Giulio Benedetti +#' @examples +#' # Import libraries +#' library(mia) +#' library(scater) +#' +#' # Import TreeSE +#' data("Tengeler2020", package = "mia") +#' tse <- Tengeler2020 +#' +#' # Add relabundance assay +#' tse <- transformAssay(tse, method = "relabundance") +#' +#' # Add reduced dimensions +#' tse <- runPCA(tse, assay.type = "relabundance") +#' +#' # Store panel into object +#' panel <- LoadingPlot() +#' # View some adjustable parameters +#' head(slotNames(panel)) +#' +#' # Launch iSEE with custom initial panel +#' if (interactive()) { +#' iSEE(tse, initial = c(panel)) +#' } +#' +#' @docType methods +#' @name LoadingPlot +NULL + +#' @rdname LoadingPlot +#' @export +setClass("LoadingPlot", contains="Panel", slots=c(dimred="character", + layout="character", ncomponents="numeric", add.tree="logical")) + +#' @importFrom iSEE .singleStringError .validNumberError .validLogicalError +#' @importFrom S4Vectors setValidity2 +setValidity2("LoadingPlot", function(x) { + msg <- character(0) + + msg <- .singleStringError(msg, x, fields=c("dimred", "layout")) + msg <- .validNumberError(msg, x, "ncomponents", lower=1, upper=Inf) + msg <- .validLogicalError(msg, x, fields="add.tree") + + if( length(msg) ){ + return(msg) + } + + TRUE +}) + +#' @importFrom iSEE .emptyDefault +#' @importFrom methods callNextMethod +setMethod("initialize", "LoadingPlot", function(.Object, ...) { + args <- list(...) + args <- .emptyDefault(args, "dimred", "PCA") + args <- .emptyDefault(args, "layout", "heatmap") + args <- .emptyDefault(args, "ncomponents", 5) + args <- .emptyDefault(args, "add.tree", FALSE) + + do.call(callNextMethod, c(list(.Object), args)) +}) + +#' @export +#' @importFrom methods new +LoadingPlot <- function(...) { + new("LoadingPlot", ...) +} + +#' @importFrom iSEE .getEncodedName .selectInput.iSEE .numericInput.iSEE +#' @importFrom methods slot +#' @importFrom SingleCellExperiment reducedDim reducedDimNames +setMethod(".defineDataInterface", "LoadingPlot", + function(x, se, select_info) { + + panel_name <- .getEncodedName(x) + + list(.selectInput.iSEE(x, field="dimred", label="Reduced dimension", + choices=reducedDimNames(se), selected=slot(x, "dimred")), + # Number of components + .numericInput.iSEE(x, field="ncomponents", label="Number of components", + value=slot(x, "ncomponents"), min=1, step=1, + max=ncol(reducedDim(se, slot(x, "dimred"))))) +}) + +#' @importFrom methods callNextMethod +setMethod(".defineInterface", "LoadingPlot", + function(x, se, select_info) { + + out <- callNextMethod() + list(out[1], .create_visual_box_for_loading_plot(x, se), out[-1]) +}) + +#' @importFrom iSEE .getEncodedName .createProtectedParameterObservers +#' .createUnprotectedParameterObservers +setMethod(".createObservers", "LoadingPlot", + function(x, se, input, session, pObjects, rObjects) { + + callNextMethod() + panel_name <- .getEncodedName(x) + + .createProtectedParameterObservers(panel_name, + c("dimred", "ncomponents"), + input=input, pObjects=pObjects, rObjects=rObjects) + + .createUnprotectedParameterObservers(panel_name, + c("layout", "add.tree"), + input=input, pObjects=pObjects, rObjects=rObjects) + + invisible(NULL) +}) + +setMethod(".fullName", "LoadingPlot", + function(x) "Loading plot") + +#' @importMethodsFrom iSEE .panelColor +setMethod(".panelColor", "LoadingPlot", function(x) "yellow") + +#' @importFrom iSEE .getEncodedName +#' @importFrom shiny plotOutput +#' @importFrom shinyWidgets addSpinner +setMethod(".defineOutput", "LoadingPlot", function(x) { + plot_name <- .getEncodedName(x) + + addSpinner( + plotOutput(plot_name, height = paste0(slot(x, "PanelHeight"), "px")), + color=.panelColor(x)) +}) + +#' @importMethodsFrom iSEE .generateOutput +#' @importFrom iSEE .processMultiSelections .textEval +#' @importFrom miaViz plotLoadings +setMethod(".generateOutput", "LoadingPlot", + function(x, se, all_memory, all_contents) { + + panel_env <- new.env() + all_cmds <- list() + args <- character(0) + + all_cmds[["select"]] <- .processMultiSelections( + x, all_memory, all_contents, panel_env + ) + + if( exists("row_selected", envir=panel_env, inherits=FALSE) ){ + panel_env[["se"]] <- se[unlist(panel_env[["row_selected"]]), ] + } else { + panel_env[["se"]] <- se + } + + args[["dimred"]] <- deparse(slot(x, "dimred")) + args[["layout"]] <- deparse(slot(x, "layout")) + args[["add.tree"]] <- deparse(slot(x , "add.tree")) + + if( is.na(slot(x, "ncomponents")) || slot(x, "ncomponents") <= 0 ){ + args[["ncomponents"]] <- 5 + } else if( slot(x, "ncomponents") > ncol(reducedDim(se, slot(x, "dimred"))) ){ + args[["ncomponents"]] <- ncol(reducedDim(se, slot(x, "dimred"))) + } else { + args[["ncomponents"]] <- deparse(slot(x, "ncomponents")) + } + + args <- sprintf("%s=%s", names(args), args) + args <- paste(args, collapse=", ") + fun_call <- sprintf("p <- miaViz::plotLoadings(se, %s)", args) + + fun_cmd <- paste(strwrap(fun_call, width = 80, exdent = 4), collapse = "\n") + plot_out <- .textEval(fun_cmd, panel_env) + all_cmds[["fun"]] <- fun_cmd + + list(commands=all_cmds, plot=plot_out, varname=NULL, contents=NULL) +}) + +#' @importFrom iSEE .getEncodedName .retrieveOutput +#' @importFrom shiny renderPlot +#' @importFrom methods callNextMethod +setMethod(".renderOutput", "LoadingPlot", + function(x, se, output, pObjects, rObjects) { + + plot_name <- .getEncodedName(x) + force(se) # defensive programming to avoid bugs due to delayed evaluation + + output[[plot_name]] <- renderPlot({ + .retrieveOutput(plot_name, se, pObjects, rObjects) + }) + + callNextMethod() +}) + +#' @importFrom grDevices pdf dev.off +setMethod(".exportOutput", "LoadingPlot", + function(x, se, all_memory, all_contents) { + + contents <- .generateOutput(x, se, all_memory=all_memory, + all_contents=all_contents) + + newpath <- paste0(.getEncodedName(x), ".pdf") + + pdf(newpath, width=slot(x, "PanelHeight") / 75, + height=slot(x, "PanelWidth") * 2) + + print(contents$plot) + dev.off() + + newpath +}) + +#' @importFrom methods callNextMethod +setMethod(".hideInterface", "LoadingPlot", function(x, field) { + + if ( field %in% c("SelectionHistory", "ColumnSelectionRestrict", + "ColumnSelectionDynamicSource", "ColumnSelectionSource") ){ + TRUE + } else { + callNextMethod() + } +}) + +setMethod(".multiSelectionResponsive", "LoadingPlot", + function(x, dims = character(0)) { + + if ("row" %in% dims) { + return(TRUE) + } + return(FALSE) +}) + +#' @importFrom methods callNextMethod +#' @importFrom iSEE .getEncodedName .addTourStep +setMethod(".definePanelTour", "LoadingPlot", function(x) { + rbind(c(paste0("#", .getEncodedName(x)), sprintf( + "The Loading Plot panel + contains a representation of the taxa contributions to the target + reduced dimensions.", .getPanelColor(x))), + .addTourStep(x, "DataBoxOpen", "The Data parameters box shows the + available parameters that can be tweaked to control the data on + the plot.

Action: click on this + box to open up available options."), + .addTourStep(x, "Visual", "The Visual parameters box shows + the available visual parameters that can be tweaked in this + plot.

Action: click on this box to + open up available options."), + callNextMethod()) +}) + +#' @importFrom iSEE .getEncodedName collapseBox .selectInput.iSEE +#' .radioButtons.iSEE .conditionalOnRadio .checkboxInput.iSEE +#' @importFrom methods slot +#' @importFrom SummarizedExperiment colData +.create_visual_box_for_loading_plot <- function(x, se) { + + panel_name <- .getEncodedName(x) + + .addSpecificTour(class(x)[1], "layout", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_layout + .selectize-control"), intro = "Here, we can select the + layout of the plot.")))}) + .addSpecificTour(class(x)[1], "add.tree", function(panel_name) { + data.frame(rbind(c(element = paste0("#", panel_name, + "_add\\.tree"), intro = "Here, we can choose + whether or not to show the phylogenetic tree.")))}) + + # Define what parameters the user can adjust + collapseBox( + paste0(panel_name, "_Visual"), title="Visual parameters", open=FALSE, + # Panel layout + .selectInput.iSEE(x, field="layout", label="Layout", + choices=c("barplot", "heatmap"), + selected=slot(x, "layout")), + # Add tree + .checkboxInput.iSEE(x, field="add.tree", label="View tree", + value=slot(x, "add.tree"))) +} diff --git a/R/class-RDAPlot.R b/R/class-RDAPlot.R index 8645808..1e3aecc 100644 --- a/R/class-RDAPlot.R +++ b/R/class-RDAPlot.R @@ -8,7 +8,7 @@ #' to generate the plot. #' #' @section Slot overview: -#' The following slots control the thresholds used in the visualization: +#' The following slots control the thresholds used in the visualisation: #' \itemize{ #' \item \code{add.ellipse}, a string specifying ellipse layout (filled, coloured or absent). #' \item \code{colour_by}, a string specifying the parameter to color by. diff --git a/R/class-RowTreePlot.R b/R/class-RowTreePlot.R index 7a30ffc..d566c6d 100644 --- a/R/class-RowTreePlot.R +++ b/R/class-RowTreePlot.R @@ -8,7 +8,7 @@ #' to generate the plot. #' #' @section Slot overview: -#' The following slots control the thresholds used in the visualization: +#' The following slots control the thresholds used in the visualisation: #' \itemize{ #' \item \code{layout}, a string specifying tree layout #' \item \code{add_legend}, a logical indicating if color legend should appear. diff --git a/man/AbundanceDensityPlot.Rd b/man/AbundanceDensityPlot.Rd index a1e16ae..f9648d3 100644 --- a/man/AbundanceDensityPlot.Rd +++ b/man/AbundanceDensityPlot.Rd @@ -18,7 +18,7 @@ to generate the plot. } \section{Slot overview}{ -The following slots control the thresholds used in the visualization: +The following slots control the thresholds used in the visualisation: \itemize{ \item \code{layout}, a string specifying abundance layout (jitter, density or points). \item \code{assay.type}, a string specifying the assay to visualize. diff --git a/man/ColumnTreePlot.Rd b/man/ColumnTreePlot.Rd new file mode 100644 index 0000000..098914c --- /dev/null +++ b/man/ColumnTreePlot.Rd @@ -0,0 +1,69 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class-ColumnTreePlot.R +\docType{methods} +\name{ColumnTreePlot} +\alias{ColumnTreePlot} +\alias{ColumnTreePlot-class} +\title{Column tree plot} +\value{ +The \code{ColumnTreePlot(...)} constructor creates an instance of a ColumnTreePlot +class, where any slot and its value can be passed to \code{...} as a named +argument. +} +\description{ +Hierarchical tree for the columns of a +\code{\link[TreeSummarizedExperiment:TreeSummarizedExperiment-constructor]{TreeSummarizedExperiment}} +object. The tree represents the sample hierarchy of the study and gets stored +in the \code{\link[TreeSummarizedExperiment:rowLinks]{colTree}} slot of the +experiment object. The panel implements \code{\link[miaViz:plotTree]{plotColTree}} +to generate the plot. +} +\section{Slot overview}{ + +The following slots control the thresholds used in the visualisation: +\itemize{ +\item \code{layout}, a string specifying tree layout +\item \code{add_legend}, a logical indicating if color legend should appear. +\item \code{edge_colour_by}, a string specifying parameter to color lines by +when \code{colour_parameters = "Edge"}. +\item \code{edge_size_by}, a string specifying parameter to size lines by +when \code{size_parameters = "Edge"}. +\item \code{tip_colour_by}, a string specifying parameter to color tips by +when \code{colour_parameters = "Tip"}. +\item \code{tip_size_by}, a string specifying parameter to size tips by +when \code{size_parameters = "Tip"}. +\item \code{tip_shape_by}, a string specifying parameter to shape tips by +when \code{shape_parameters = "Tip"}. +\item \code{node_colour_by}, a string specifying parameter to color nodes by +when \code{colour_parameters = "Node"}. +\item \code{node_size_by}, a string specifying parameter to size nodes by +when \code{size_parameters = "Node"}. +\item \code{node_shape_by}, a string specifying parameter to shape nodes by +when \code{shape_parameters = "Node"}. +\item \code{order_tree}, a logical indicating if tree is ordered by +alphabetic order of taxonomic levels. +} + +In addition, this class inherits all slots from its parent \linkS4class{Panel} class. +} + +\examples{ +# Import TreeSE +library(mia) +data("Tengeler2020", package = "mia") +tse <- Tengeler2020 + +# Store panel into object +panel <- ColumnTreePlot() +# View some adjustable parameters +head(slotNames(panel)) + +# Launch iSEE with custom initial panel +if (interactive()) { + iSEE(tse, initial = c(panel)) +} + +} +\author{ +Giulio Benedetti +} diff --git a/man/LoadingPlot.Rd b/man/LoadingPlot.Rd new file mode 100644 index 0000000..be7a34b --- /dev/null +++ b/man/LoadingPlot.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class-LoadingPlot.R +\docType{methods} +\name{LoadingPlot} +\alias{LoadingPlot} +\alias{LoadingPlot-class} +\title{Loading plot} +\value{ +The \code{LoadingPlot(...)} constructor creates an instance of an +LoadingPlot class, where any slot and its value can be passed to +\code{...} as a named argument. +} +\description{ +Contribution of single features in a +\code{\link[TreeSummarizedExperiment:TreeSummarizedExperiment-constructor]{TreeSummarizedExperiment}} +to the components of a target reduced dimension. The panel implements +\code{\link[miaViz:plotLoadings]{plotLoadings}} to generate the plot. +} +\section{Slot overview}{ + +The following slots control the thresholds used in the visualisation: +\itemize{ +\item \code{dimred}, a string specifying the dimred to visualize. +\item \code{layout}, a string specifying abundance layout (barplot or heatmap). +\item \code{ncomponents}, a number indicating the number of components to visualize. +} + +In addition, this class inherits all slots from its parent \linkS4class{Panel} class. +} + +\examples{ +# Import libraries +library(mia) +library(scater) + +# Import TreeSE +data("Tengeler2020", package = "mia") +tse <- Tengeler2020 + +# Add relabundance assay +tse <- transformAssay(tse, method = "relabundance") + +# Add reduced dimensions +tse <- runPCA(tse, assay.type = "relabundance") + +# Store panel into object +panel <- LoadingPlot() +# View some adjustable parameters +head(slotNames(panel)) + +# Launch iSEE with custom initial panel +if (interactive()) { + iSEE(tse, initial = c(panel)) +} + +} +\author{ +Giulio Benedetti +} diff --git a/man/RDAPlot.Rd b/man/RDAPlot.Rd index b6e4aff..f04e4b5 100644 --- a/man/RDAPlot.Rd +++ b/man/RDAPlot.Rd @@ -19,7 +19,7 @@ to generate the plot. } \section{Slot overview}{ -The following slots control the thresholds used in the visualization: +The following slots control the thresholds used in the visualisation: \itemize{ \item \code{add.ellipse}, a string specifying ellipse layout (filled, coloured or absent). \item \code{colour_by}, a string specifying the parameter to color by. diff --git a/man/RowTreePlot.Rd b/man/RowTreePlot.Rd index d687225..d0affef 100644 --- a/man/RowTreePlot.Rd +++ b/man/RowTreePlot.Rd @@ -20,7 +20,7 @@ to generate the plot. } \section{Slot overview}{ -The following slots control the thresholds used in the visualization: +The following slots control the thresholds used in the visualisation: \itemize{ \item \code{layout}, a string specifying tree layout \item \code{add_legend}, a logical indicating if color legend should appear. diff --git a/tests/testthat/test-ColumnTreePlot.R b/tests/testthat/test-ColumnTreePlot.R new file mode 100644 index 0000000..76db679 --- /dev/null +++ b/tests/testthat/test-ColumnTreePlot.R @@ -0,0 +1,49 @@ +test_that("ColumnTreePlot", { + + output <- new.env() + pObjects <- new.env() + rObjects <- new.env() + select_info <- list(single = list(feature = "---", sample = "---"), + multi = list(row = "---", column = "---")) + + data("Tengeler2020", package = "mia") + tse <- Tengeler2020 + panel <- ColumnTreePlot() + + panel[["layout"]] <- "rectangular" + + expect_identical(.getEncodedName(panel), "ColumnTreePlotNA") + expect_identical(.fullName(panel), "Column tree plot") + expect_identical(.panelColor(panel), "steelblue") + + expect_s3_class(.defineInterface(panel, tse, select_info)[[1]][[1]], "shiny.tag.list") + expect_length(.defineDataInterface(panel, tse, select_info), 1) + + expect_s3_class(.defineOutput(panel), "shiny.tag.list") + # expect_match(.generateOutput(panel, tse)[["commands"]][["fun"]], + # 'p <- miaViz::plotColTree(se, layout="rectangular", add_legend=TRUE, + # order_tree=FALSE)', + # fixed = TRUE) + + expect_true(.hideInterface(panel, "ColumnSelectionSource")) + expect_false(.multiSelectionResponsive(panel, "row")) + expect_true(.multiSelectionResponsive(panel, "column")) + + expect_contains(slotNames(panel), c("layout", "add_legend", "edge_colour_by", + "tip_colour_by", "order_tree", "tip_size_by", "tip_shape_by", + "edge_size_by", "node_size_by", "node_shape_by", "node_colour_by")) + + expect_contains(.definePanelTour(panel)[[1]], + c("#ColumnTreePlotNA_DataBoxOpen", "#ColumnTreePlotNA_VisualBoxOpen", + "#ColumnTreePlotNA", "#ColumnTreePlotNA_SelectionBoxOpen")) + + expect_s3_class(.create_visual_box_for_coltree(panel, tse), "shiny.tag.list") + + expect_null(.renderOutput(panel, tse, output = output, pObjects = pObjects, rObjects = rObjects)) + expect_s3_class(output$ColumnTreePlotNA, "shiny.render.function") + expect_s3_class(output$ColumnTreePlotNA_INTERNAL_PanelMultiSelectInfo, "shiny.render.function") + expect_s3_class(output$ColumnTreePlotNA_INTERNAL_PanelSelectLinkInfo, "shiny.render.function") + + # expect_identical(.exportOutput(panel, tse), "ColumnTreePlotNA.pdf") + +}) diff --git a/tests/testthat/test-LoadingPlot.R b/tests/testthat/test-LoadingPlot.R new file mode 100644 index 0000000..a9eaea7 --- /dev/null +++ b/tests/testthat/test-LoadingPlot.R @@ -0,0 +1,48 @@ +test_that("LoadingPlot", { + + output <- new.env() + pObjects <- new.env() + rObjects <- new.env() + select_info <- list(single = list(feature = "---", sample = "---"), + multi = list(row = "---", column = "---")) + + data("Tengeler2020", package = "mia") + tse <- Tengeler2020 + panel <- LoadingPlot() + + panel[["layout"]] <- "heatmap" + + tse <- scater::runPCA(tse, assay.type = "counts", ncomponents = 5) + + expect_identical(.getEncodedName(panel), "LoadingPlotNA") + expect_identical(.fullName(panel), "Loading plot") + expect_identical(.panelColor(panel), "yellow") + + expect_s3_class(.defineInterface(panel, tse, select_info)[[1]][[1]], "shiny.tag.list") + expect_length(.defineDataInterface(panel, tse, select_info), 2) + + expect_s3_class(.defineOutput(panel), "shiny.tag.list") + expect_match(.generateOutput(panel, tse)[["commands"]][["fun"]], + 'p <- miaViz::plotLoadings(se, dimred="PCA", layout="heatmap", ', + 'add.tree=FALSE,\n ncomponents=5)', + fixed = TRUE) + + expect_true(.hideInterface(panel, "ColumnSelectionSource")) + expect_false(.multiSelectionResponsive(panel, "column")) + expect_true(.multiSelectionResponsive(panel, "row")) + + expect_contains(slotNames(panel), c("dimred", "layout", "ncomponents", "add.tree")) + + expect_contains(.definePanelTour(panel)[[1]], + c("#LoadingPlotNA_SelectionBoxOpen")) + + expect_s3_class(.create_visual_box_for_loading_plot(panel, tse), "shiny.tag.list") + + expect_null(.renderOutput(panel, tse, output = output, pObjects = pObjects, rObjects = rObjects)) + expect_s3_class(output$LoadingPlotNA, "shiny.render.function") + expect_s3_class(output$LoadingPlotNA_INTERNAL_PanelMultiSelectInfo, "shiny.render.function") + expect_s3_class(output$LoadingPlotNA_INTERNAL_PanelSelectLinkInfo, "shiny.render.function") + + expect_identical(.exportOutput(panel, tse), "LoadingPlotNA.pdf") + +}) \ No newline at end of file diff --git a/vignettes/iSEEtree.Rmd b/vignettes/iSEEtree.Rmd index 3df5ac4..d174fff 100644 --- a/vignettes/iSEEtree.Rmd +++ b/vignettes/iSEEtree.Rmd @@ -85,6 +85,8 @@ plotting functions: by different features in different colours. Its interpretation is explained in the OMA chapter on [Community Composition](https://microbiome.github.io/OMA/docs/devel/pages/21_microbiome_community.html). +- [ColumnTreePlot](https://microbiome.github.io/iSEEtree/reference/ColumnTreePlot.html) +- [LoadingPlot](https://microbiome.github.io/iSEEtree/reference/LoadingPlot.html) - [RDAPlot](https://microbiome.github.io/iSEEtree/reference/RDAPlot.html): an supervised ordination plot of the samples, where every dot is a sample on a reduced dimensional space and every arrow reflects the contribution of a From bcf80b0fca6cd8c9b2c38630ddebcc591c7dad0d Mon Sep 17 00:00:00 2001 From: Giulio Benedetti Date: Wed, 16 Oct 2024 21:41:02 +0300 Subject: [PATCH 2/2] Add new panels to vignettes --- DESCRIPTION | 2 +- pkgdown/_pkgdown.yml | 2 ++ vignettes/metagenomic_data.Rmd | 6 ++++++ 3 files changed, 9 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 986ead5..6473864 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -17,7 +17,7 @@ Description: visualisation to create panels that are specific for TreeSummarizedExperiment objects. Not surprisingly, it also depends on the generic panels from iSEE. -biocViews: Microbiome, Software, Visualization, GUI, ShinyApps +biocViews: Microbiome, Software, Visualization, GUI, ShinyApps, DataImport License: Artistic-2.0 Encoding: UTF-8 Depends: diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index 8f1c906..fc1b356 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -4,6 +4,8 @@ reference: - contents: - AbundanceDensityPlot - AbundancePlot + - ColumnTreePlot + - LoadingPlot - RDAPlot - RowTreePlot - title: Other diff --git a/vignettes/metagenomic_data.Rmd b/vignettes/metagenomic_data.Rmd index 2f5b47b..8a4a306 100644 --- a/vignettes/metagenomic_data.Rmd +++ b/vignettes/metagenomic_data.Rmd @@ -145,3 +145,9 @@ SCREENSHOT("screenshots/metagenomic_data.png", delay=20) To know more about how to explore big data with iSEE and iSEEtree, check the related [iSEE article](https://isee.github.io/iSEE/articles/bigdata.html). + +```{r reproduce, echo=FALSE} +## Session info +options(width = 120) +sessionInfo() +```