From 1f81a353f9ae4bc393aec07531b29a3386c95d96 Mon Sep 17 00:00:00 2001 From: Jan Gleixner Date: Sun, 17 Nov 2019 16:20:16 +0100 Subject: [PATCH 1/3] tests for correct weighting/scaling of PCs --- tests/testthat/test_dimensional_reduction.R | 86 +++++++++++++++++++++ 1 file changed, 86 insertions(+) diff --git a/tests/testthat/test_dimensional_reduction.R b/tests/testthat/test_dimensional_reduction.R index 9fadd6ea6..711d22ff4 100644 --- a/tests/testthat/test_dimensional_reduction.R +++ b/tests/testthat/test_dimensional_reduction.R @@ -58,3 +58,89 @@ test_that("pca returns total variance (see #982)", { sum(prcomp_result$sdev^2)) }) + +test_that("pca embedding weighting works", { + # Generate dummy data exp matrix + set.seed(seed = 1) + npcs <- 50 + dummyexpMat <- matrix( + data = stats::rexp(n = 2e4, rate = 1), + ncol = 200, nrow = 100 + ) + colnames(x = dummyexpMat) <- paste0("cell", seq(ncol(x = dummyexpMat))) + row.names(x = dummyexpMat) <- paste0("gene", seq(nrow(x = dummyexpMat))) + + # Create Seurat object for testing + obj <- CreateSeuratObject(counts = dummyexpMat) + + # Normalize + obj <- NormalizeData(object = obj, verbose = FALSE) + # Scale + obj <- ScaleData(object = obj, verbose = FALSE) + + # un(weighted/scaled) + # compute PCA + obj <- suppressWarnings(expr = RunPCA( + object = obj, + features = rownames(x = obj), + verbose = FALSE, + reduction.name = "pca.prcomp.unscaled", + npcs = npcs, + weight.by.var = FALSE, + approx = FALSE + )) + + obj <- suppressWarnings(expr = RunPCA( + object = obj, + features = rownames(x = obj), + verbose = FALSE, + reduction.name = "pca.irlba.unscaled", + npcs = npcs, + weight.by.var = FALSE, + approx = TRUE + )) + + # Compare + expect_equivalent( + diag(x = cov(x = slot(object = obj[["pca.prcomp.unscaled"]], name = "cell.embeddings"))), + rep(x = 1/(ncol(x = obj)-1), times=npcs) + ) + expect_equivalent( + diag(x = cov(x = slot(object = obj[["pca.irlba.unscaled"]], name = "cell.embeddings"))), + rep(x = 1/(ncol(x = obj)-1), times=npcs) + ) + + # weighted/scaled + # compute PCA + obj <- suppressWarnings(expr = RunPCA( + object = obj, + features = rownames(x = obj), + verbose = FALSE, + reduction.name = "pca.prcomp.var_scaled", + npcs = npcs, + weight.by.var = TRUE, + approx = FALSE + )) + + obj <- suppressWarnings(expr = RunPCA( + object = obj, + features = rownames(x = obj), + verbose = FALSE, + reduction.name = "pca.irlba.var_scaled", + npcs = npcs, + weight.by.var = TRUE, + approx = TRUE + )) + + # Compare + expect_equivalent( + diag(x = cov(x = slot(object = obj[["pca.prcomp.var_scaled"]], name = "cell.embeddings"))), + slot(object = obj[["pca.prcomp.var_scaled"]], name = "stdev")[1:npcs]^2 + ) + expect_equivalent( + diag(x = cov(x = slot(object = obj[["pca.irlba.var_scaled"]], name = "cell.embeddings"))), + slot(object = obj[["pca.prcomp.var_scaled"]], name = "stdev")[1:npcs]^2 + ) + +}) + From 852e2d10d9d323e5d1e7b0feb6141a09a5d3445e Mon Sep 17 00:00:00 2001 From: Jan Gleixner Date: Sun, 17 Nov 2019 17:31:39 +0100 Subject: [PATCH 2/3] test for downward compatible behavior of RunPCA --- tests/testthat/pcalist.approx...FALSE..rds | Bin 0 -> 9160 bytes ...approx...FALSE..weight.by.var...FALSE..rds | Bin 0 -> 9112 bytes ....approx...FALSE..weight.by.var...TRUE..rds | Bin 0 -> 9160 bytes tests/testthat/pcalist.approx...TRUE..rds | Bin 0 -> 8359 bytes ....approx...TRUE..weight.by.var...FALSE..rds | Bin 0 -> 8288 bytes ...t.approx...TRUE..weight.by.var...TRUE..rds | Bin 0 -> 8359 bytes tests/testthat/test_dimensional_reduction.R | 41 ++++++++++++++++++ 7 files changed, 41 insertions(+) create mode 100644 tests/testthat/pcalist.approx...FALSE..rds create mode 100644 tests/testthat/pcalist.approx...FALSE..weight.by.var...FALSE..rds create mode 100644 tests/testthat/pcalist.approx...FALSE..weight.by.var...TRUE..rds create mode 100644 tests/testthat/pcalist.approx...TRUE..rds create mode 100644 tests/testthat/pcalist.approx...TRUE..weight.by.var...FALSE..rds create mode 100644 tests/testthat/pcalist.approx...TRUE..weight.by.var...TRUE..rds diff --git a/tests/testthat/pcalist.approx...FALSE..rds b/tests/testthat/pcalist.approx...FALSE..rds new file mode 100644 index 0000000000000000000000000000000000000000..c30e7b0e5f4d6bf165f9925c6c8f3d6c1e7602e0 GIT binary patch literal 9160 zcmZwJRZtvEpr&CYxCM8&0R{~&!9oNb+}%Bd!7X@z;4Z=4-QC?KxVsE6_#pe&IaOO* zTj`7E;=S#zu8%qb74Clya>1&Hpt^pa_;;x2l(cy`GTtG@A%%=BVF@7o;2V!QhiPEU zCsGGi2IU+~nIMo=1?D#vI;^jFQiEoh2KUb5(x<+@OOWV$v8DYLSlj)Im(SftOHSJ= zpGkv{L_|dVM6MhfMEtHqL>jKzL`2w)!RF;a3Sc{is(#pwMBFA)o2!&nT7(OpLoNO#98zPh#PkAen9UvbU@Jfyb6k%{F zsQgS8zTaT>yUso&KtNUS9J>=4e?qS|;+o%x5pvhB_Xx%&S^{nEBpA?6P$pTHrmJfMR3=sBn$e6jXa8}hUZ`Zkr^GRON@oa|NVXz3 zZzUY9Agylqj6%fHlT9`(!G$j{92R$Lh4`COhsiIX%St&V(@*h0A|##QVZQ)F#=J#t zbNjc7SipIFhnDdN>=WV3e#fjod}_Z*uutwjz%2+(aAMF+Z12<-bnpD+)F9}*>bv

#vkQ1&;^LLKD6DRw=( zqZJy$W-RqZnq$x4=(*|BgYck@o=Zc+%k!1%zLD7~>KVVxF(US~58 z?hj{7IfD);CLhGz+2r#z8QC2#8^@(c$blxmQz?r9ifVvmMhUt=wmaDp2YJ`Nm21-a zXvY;r%B0=dx^EB$$H%4{vq?%OqOHuNI16TVih1UH&@?1An4*9(typ#y^#OrD_+HYxZV%CI&c+PGF#&A?r_$KO^Ep zL7#ZcWB>jVOk#06(G>R~4R`rWyB{76+PkCg8<1BVAAS08FrH`_!+zGkb!8%OdHR^- zwUDR)8dQ;eSCH9zEn9g~S2199hV7uv#R5K!JFGb%Wt3`zuk(?(I$ELrlb$ z&){rygH+o05(WIgKipxAWfoF8f%rXkksCoq0bB&&*hRn}Y~G}{nk!d6ADrt2vBKwa%SOr~eHn^qtn1@pg;4G1e)R>e*itlDX zdK$dj*s(@N-HH{C6-E&HiP(MV-|7778aLg@XlkqH>R0!+vCah)Vbi?AzhE z_av++$lj{zxnWWk142)?cP=-|Kz45|lwvd1z*7dS-1-m7mi473&@+0#q!M}d8AXuZ z%d6YQD=mD8xrL=d|Kao=UsDLv2|VzGxpA=;0N3uK)2PAtz??KuW+yM;1(!Btvnn^4 zn2XlO;G+@GGJNWXfSK8Wp12_wbQ$CuAX-{DvkKAk_iiAC-5Co29-HOVR}_iL#_P_) z1f9vRQJ;{f@%m^Z3`cRjsD*CW4{UGp+X#=&+duz zpxb;E0-}Rlr}>P=fZCf?YGBJw%}H3PK5?WoH(PX7!n419vGvD?OI34LB7#VQW2{Gn zk8BmPEwCA?ZK|p)Pdi4f<;xaz4PVR@@)136MOEs$De1bSU(rSxV&B;gom_xvchFLc zIjH0=AA_C5N!>R+0qL{zdSjShkJUATc< zO+&GQCc+e(}6rE>crs0?5{x(W~3nkVB@JihIB*#{jkDThf$4j-xN-uQ1y1>5vSt!%9npxd=xH2dj&I`6z=!C1JSn z$E@Ll5S-3}s2g*KdPwd|g^ds8xt5B2HFr@CeE5ww<-^qzL+P0wxc=-bsb}*|tk1)8 zlU1&)QJ3)%5ugh198@=l@7>g^B;2OJh4c2paIeP#;BIPKFy0_g05&?+zS6@@{S@52>ODLO zOy~@(XWLt#YPqa~0W6ls?s~3=1P>I1%QK1fe+xCYv-(UD=FAXJKsT6(X{&xi3aBB# z?(7lGhJY&4l%cC>;^p)#W$`%xt)C-HYnsQn%lHUxt^P)T-+N%N_rl4y^d!Sxp3u$v zR4oH3`ZhB?#!CI5XCu?bpAiBlr#h*dF+PN%KApu6{ZemITVBnR-848FfMY+DrgN#h zu|ZK{N=^TOFwZ$_feXoj+Ma6TcnnY_-6&Y~*{!(Okh#9S&UQZVlVY5A;uvJ`Cd&uiwVJrRDw<-R025y%>_A0I`8(Uwm+v~jc@Kh3FT z?b>9#a4AKstuxr7DL_Jw&oHgEGtMERqt0vH--?oXboC(hSVzkL$o}zFk~yu=R%dGtahqD*Q39Pkoj2d;ODc%`ZHiHJ<9L{ ztV)aJ)1QpRHNU;mdSd9ypG*N&f_fTt*2*@D%n2E_KV@~NvagmOi%n(6y4?VTx7}b2 zqQ7x_qvDNJ6XKDMyrWOpNV7II6(*9By^luY9{v$hZr!PB2_=(ARxrP< z74fy=-Mp=xYV|QHUE-e?UPO?^CYtE?bkBV}%H_Fx3Wd zwq>ppqGI8#$Gsl6z@rX`<0AmHA1H1$Qagn}*h+HB9CTDQs~Zel9`W3rP+;TQPt*%iAc6V z%L!fk?_rG2e+&03MegMI#=o|Nhm)+nCkEIQ3{T^K+s;pVkL&>*x|pwgjoPRZv?tLu zMfceFPOQE6QRe*6uGi4Y%P6*6dLop+MN)&Rimy|*aOOs2@(YlXlgsT4H~p4PK!Wz^ zjC7fl>TMPS=#G9&@X?FTX~vJ>1q@6t-!Gm10PGbLDElkd}=7l~ey1 zvjzL|N}H@nGU?_HzmR2>d+g>IDv+!m(73LWic@gXt-0SBv24rfZ>(R~NBWK%5_-|W z_72F!xqqfjJi-d#At$yqS`1kMzgV0gC`nBg(pGY|-AS^jXHCX`gO5r7kf_n$iHVMp zDN||jsCANYae||SZ89=yw=ONW$f1{9AtEOGNCP`IXnVeH%kH`_4mnAGKW$O%M&pek z@)RQ9+Ja|V-Tkn$QvaI=Xi~pRXrdKJTl3o*KWYwC`%AT2Fbu2R&mbAE@H-aoIi9aI z)LI}Z>TGiOhP+} zZ9VoPHhZZ2HGi2(9O(RF@$z!SIz8L)v}dOwWYM530I{=2`0qmQ<^A;ha|seBI`%iT zY~uG;wv;-wVxMA+8qL#K%mhdFg7Th;u)jjS1eH}Kb zj6X?Nf*(j*>@HQk=PNWmz+-fzZ`P|D6V&-si+yCiL^+rcSf9XE>^s}PNIof;n8BGK zPL}y7&D+ZQ9_c)72>AICqW=kET9YOs%^casC7{!5WS@m#YQI`xlhAs(LoYx+$x{9$ zGLAw9p<<)hUKpTTB}^pC$+CuKdm=G4cZ3Ud*_3!(67v^Ia)@CbFWbwj6(q1< zWLVOH?(v$UT%m~*#N+75>O|S`?lT(|;9^H9BsYh)iMLPFxaL+5r40!Q6b)S=-JA`E zeXdtryH3P7uz6FHHC>SMsmXj2)^{jolTpg{Dko)S%vhPE-omzUT(xg@%)wml6i#no zj53LBvb&-5)}#@Me*!svf|F~lnlH?%lj-}m;);|3p?ULG?+Z@j8DFmtsN3G5*xSRA zS4!=S)HdO3dCW>TinYzNw_l3n+N^3`Qj{9Y-kY>%tt=-1z6}lhHI?f$i8`K`O^CTK zu2AMEQ9lxMA9qooTN)=-@cXNEE>=ezZchQvr+A??`N`|c-oa|I>h7X(CHlAKer4K= zpl?_Qo6umTf)Si#dQ_i6lY*(7SRe~u+=7p?<|cjZgxr9O2?O9&GC z6lP~g?J94pWHonEL$iLkAcs^K*>WV0?PK=Z2ApFtotEX`l*%5Fxb;6|N6v;7x`8AQ!aj(Bm+|{Dn@WM z=-(t(gU~SkMP&6fD#kyEz&4(t1quhrgjOHDC!*}lmDU2I{%-{LN-+cf1!iwA4e(#c z_x3UX|3zz%Omg)R9+7@;uACMaErP>%h7tH*yf-Ae=vonG=dp>8mHNy|YHc=8OaJFL zCJ)cZ*V6iLiTowAOzJE7vgvBp@vQbL1q%Ngb7NT1Oa4h5D{D#azldceE6M!_v$X2M z`LdyE$1$vwDh1M|;IE0;CI1t{6-$ru|A}NNNq+dh_*R;dAN~(ylhuynSoKv3~4iih;{o{Ryvg0$0 z+tpng4JJzLw{*7IiE@CdAfe&&i4l1PjKiWls7 zlH1sA5WS>g>8R%>igWhWZtZ<&kw(=T25TNpmT1Q(Gy;ByCmpbVSa@ccl2ZjY(l18a zxe@$Hng*{i<+m`-t<-k#>uMjW*t*yP+a+3_-p3An#XdQZd0|$`NsS@`g26ZQWf}KQuYm6Bq8CYFd~-(9bz~iJkbzm! zAbBZivj%(3xbqx|`wxThFm@)?{WIfFOaz5LZ|1J=ckef)M!c;{Rc)gJO1;v1L$q%t zds0=? zITxlKY^53PzLpvy$BFTNo51ndI?$bn)vLj9VenI-+ktjm!CU}$z9$$>xfjY~ zoC)z3(vbf{Z4A${JVqI>6!CMmQ+4R6(ldafvdY@4)Hf&H7SC1xER<$+d_-^;fWJ5F zEd;)#r=-wKPEN%!5Zo|itN;B-oo8u1RcTp$;=k%M=dm;v9hjl3Euf2(*ORvldpw>i zIC3g?%WAmc0M+dLw&xtc+{=@bJ|)!c-Vda6{sx24x>f8uouTPUZ1@lDmYK3k&fdzn z__PwyFdJq65UiyTHPYh~bM_!p^K4t9+~}bCG%%OB+Vy~L69U935cfF$9mWSk*< zON(l{Y4rV6qRSC#0qhDjSjzYsz2--{ute~7&F3hIYq%5%6_<}y?9aS3JcJU zd5u@dO$>Kb)*eY(e7GGP4s7~Q zZLs0GXJ1A$JfJ)?6?{sLD4-hE#$3iJiBza9mDAO)Tf_k)rbSdT12^>#@qw%JrVVOEl!?xW|;2p-N?7 z%EatMmHJLMw2uX;ka)xYZ}t&nBG|L|_rBCa$nW4&Yc9Hz5(79-+-8UIJ7wPH2`^2C zMJ>2QAhvzHs7!P0m>K-&tRUGspNMj7b-!S z-fMvdfAfX=Nv*SCFX{YUcd95zhRd$g1O*_{A^t|oyxU@6W|@s&9RH|}nH{FsX9-0^ z$DlJsVl}mWejf`90f3elFHHFk|E7ED5%fs{0TAK2Qy|8PKDv3X8U_mjy{ePYsSiY} zEDP)GsgN8s&TZ7uyQpqC@kH#XrHTG(>92k5#&&++wcYQZ=sjO$(x_R ze9F&iC8RXQg(^|tYDnO=a+7`9f#eN_*wgs2Zs)NmF$2m;dBRGy&_+9{1vN#wPz8S{ zEwkqSh^ccb8H~PS-%^fxz?+e~KFUNv8G9|z1qBz`bnh3?(zK+7R;jNX4=-LpJj!BqA zH1VySd-&pgcZ5gy=6Lbz0*-0A<>M4dDb`rm5NP>L?-iC(G9eDL&A4llz-lg3jDHbd&4q^X5B~4a{{PnZ>q5b;X zZKuu!X*EAb6H<=Ymo9dXN*|rvSfJfvIws_%Xh^XXxn3UX(H5F zN8FQdY0?LUl^W%~+6`GEqB1#r4M{%I_D8#;-tfKaHEKUP-@DV4H4^1=SC4r|O_DsH z0wtn?H#Hrwh?2+RO1h|n4KLDix!&$ZJp?5hjk`8mP)1{unEDJf8v_tOi}=c}v{(hq zoW_}tCOk~US_ z_+pf=|KA*2`N)OG32J{U!l|1G(>fhP%e)OZVmax>5lPnUSE$?h~Ou zuF>BK4c6KkOiZ@G7s}inqa%HNFHSK^%=Ha7*~Ldfl4~ljCc`%r5|!07hTPBa(xQ!P zXeu5?T%phi$6<6Xl6m|WKrl9P(?L{|fgn1vL-oW{y-H8_iNGKuGJUpqxi+Yj2JNQI zJ@UI=3(nJ%-Lrxb%25O{fB8l+&QsF6jN+_yY~Qb=Y-f!nh#k&UyR@u{*-cKHL-T89 z(`~^$Yd3lCZ)5{@(Q1Yylum1k>IJcu+kw`pXq_wu0~NI5^$%P z&%t5~5%?*s$a6dko^ltShZ<*E;)~gBn|G${w9{2fkW&Qqk=B`oi~a@C(bim)*l-t; z_v+NRmTEPwx9RsUjHMAj?~e1F5z?NsUj{cq#j2wHU45EDm#eydy1L4x%bd7%Yj!EE zK6!QqHp)hzWd%}Xv&V=?Z<_+F<}~o+{7jKM_1s*d3v~Q7^zOc?v!K*_>f;y@^S{e7 zw4gw;ed<2^5cP+RUlg7l#r>(pJ5BP#+DYH|8dlmQQM-MVJ&FR6YhNb&+SV?3$0}ve zMi24cJd&Vl`@!~V0MFo&Y;Veo-N&N!qWve*eN~-^L!6#Ts<@7IMf9{?7dd^?9=G7=C`EeiFYNqBt<+g@gM)CJ_;x literal 0 HcmV?d00001 diff --git a/tests/testthat/pcalist.approx...FALSE..weight.by.var...FALSE..rds b/tests/testthat/pcalist.approx...FALSE..weight.by.var...FALSE..rds new file mode 100644 index 0000000000000000000000000000000000000000..58e7f45cbe7d582504584c66cd054b376474b409 GIT binary patch literal 9112 zcmdtlRa+Dc*ezhCYZ#<+2BjNi1c{*=>F$#5ZV(WVR;0VTyOHij8U{&W=%Ha?f7jlJ z-}?*pb8sK5Kd{yVj>dZRe-EQ*&F7P*;fu(*`G`hZLScTwY5qW(^5DTY40(px(hnqR zUu=Isek4SR%VMXA@8^xI7Jq<{C%i`pO*i;&Oe68C9`6l%M7m*ahSgoL$I7lHc%^ww z*Uc(53GGkWOnOcbJ|PoXPz!~J?6RcBmoc5x}rFoFb4`Hz@b6YE=Ek?H6{i)<-1w+_tMr&_zzOC^_M%(1JH-|Gq*hEgAR5z_oU$Jd$E)kRX z)~$wi@J+!T`)s&c;H*-6X=vbnI^+c>1fDd2`%?95#-(b&A@UdVQM(0oF3jc?&D?M@ zZX-I80SHXpo_O2;d#`p*E&r7zYfnyx>m0T8c#tjl;JdWM8x%aZlFuQCgAReZkbZl$ zekgqWEg7~^SaSz;Abi$+Z9AreQF?}SQ>QRtF`82A^3)syb*vrX?wM4GQtqvp>-rms zJr>)YcfoUqmG1EPzSCwJO1_7ce%=9%2tWHsyr0%yV1|5}vC8RO#-+}b%TYtYiaT|< zc2#ca{Sp>FB_+TVvrOgKe4`XDeP4g4-(-pgqokSU$!N-(_GR6zLSkO^+us(*1xu77 zW$h59-vD)$hE;;2HIzm}=M~B6a=j|$^gTKC;Pl$YWp;`E6llMdk4e zDoY7(3Q8X^nX3+pHEr!Vd%aAqQ8=jt(&aSje|~zSza;6&U)eZT34bGp3ip80hzc?HH6ffa~)GMCK-wMI~8dASkk=V1`MKpJdr%$xD zHr;ILw!Ubwpd62Nwv}()&D4Bst;xOnWj%V0@Dbp58K9!YJh-+E?2)}G$S!}*d?R~B zdi$ocmn|Qu{3rh}P?;6m9kU72^@Df0F>!By8R+M1h#h6N3!L4b#ytQqf-L4FaV-6t4m zLw9?l6Q8?Lc%Z<4g&(5QSH#R=9(RNpP><_>S}>~lbg4gK@HZuiIc)_3JkJU74tJP&%fnEB}IK>p~=4qcqXi!~zic9UbHco?In zo68W-lc~S?yA-8C&gQCp{HaLMxu#vWB(>-JTbuSBb0 zEaEvwofH)Q+*VD=0rQ5)k6HU6m0~6tv^yUk#Z-A&7H`^zWaJ>5pcF}xn27Uq@t3ql z!BVs7=wy9$`qaSR?d>&k*pxMu1)b!A{iJe$fT4vZiGWB9a5a!2uURHmurk>x^tlF( zsNochtA_{B*%hDWj%oTVc&M_JUT1&l)9(_T`E*cR5#UH!{GtNAcj@t@_krx6zvmb%4uWT6Udmth6glOs(3aHoLP->VJ$Y3x zu1%39CVJ<0UE;?;g~{FM4JgKxj{SlLbK)mW{rYaSf{7@}uFLp{_0Z6FdOKN%L{wZ% zO#5~q5(}m_e`oA{u>qgrZEW|`VwQlH^#q1t+l`D&G>qh$rBR9{V1ep{vIcbRHwv!4Un z>gDHt>`iOaEtj~YEMGD~NH1ecDAm(@MOPC~XrwSzxx(=J%>YRPaoyj37bybq%a!uo zTcRA?#2LBa{jhl|GMs;E+F9wvfGgK%A-wbY;Nr@a-g%}fRb|Vc1!*?axu~m|xL)K9 zWDcI@Yn97UfpXl&i853Y(O&Zg0SG^G{wJ9jD+h82`H{>ev#r?teaI3K_b#}KnywGU_-VgW z;qst+X1@@gTkk@N&<~#xhLsXI&gen(Wl(+HUW4RFz>;(vqS9q*mZLUzo z@bU!)f#~FU)rPT%20O3I+%nX0I){|Sem__1?Y6^vB#^7!^YW5>_d+1q!iOQBkvxw8 zY+>T99&+V;Owug6vS-rKxWwJ~_t^C!E0VkZqPr0uLS&zi4Q_Kg!hG8*>2A^4f`%7q zyo41nj7ekc7eZ~6l+V??L&7Kq{42<8=TDO@VbQKn0}HGA;+BS?I7mX$*NA(+m%#1; z3B2<`Pg$bPaC6^ETv-eKc7F8BP215)DvPW4LUtUOSh42|&mQH3=&_O5k79*&-sA)d zY4hdDDu9uB=jsD}6?7d60!9*#)z+aS-TkFbk=J>T@-lfYFMD88<1*``S+!=wt$pHQ z|8;`@9#4kIS=}B7kwdC;+a16752DH4QXRRt>hL->svEucI0WmCGB8Ky;6t&3%H&R8 z@=sK6jUE31^A@_|NI3`5V0I9m?q}A|jpfz$MEu{2bA*Fxh1(KnvmPlaEg7VpkGPru zAVq13a%ryk%J*XG9pLYS`>DA`&m3t{zew$;-qkhP#`$ww>-e*_P7{7a{-_7(wb4*E zWXH>ZTCq;x;aZjgLBTccw?~07cX@{&D=M=;#Wl#qdu9^8E^C^0ssOX3;#u?KlV4)w)<@uf=1Gnpn5l!KPG=UB^jOA zgfo7CA{uIfm_E(Z4CAAfOd2zRjBrS`W$5adET^rG2%oC&ow}hHqN-KWrg0&CXjW>B zUcEOgAqwS#CrjN-GZ5P5!@5&EeaWe3&Ei9X48-L3>Z2mD($4a!&LyrX(y zulJ(Q1k*Bqa6PzOr_NA>&~s6p`itSNN(6y8crwMRCiPF7VNLHyD+~oVyk?05j+EiP z#O&DMg7}|G`Ru8b+Ai}(ZK#uj7AKDHc= z!wV0eQf|LK&&97fBaG=n?DQByKEkXPOO@pd_@o^Hw%nzw<}LFC;YVKK1CAR&l3V^$ zBNda}ykG4KOyVN>m!l^OkqO9=*%JAA+F-y&mqGsrNvfDi+#c10G*RaxN&HdrE*X)O zRwIg54FFwSiin(bS;3|IuvA4?KdpaO+RDA=7xKy0wL~wioUJPTT3x|y%yKTdu?fyh z5hqW_e~rr77KnLqi+q9X+O{QT46bu|OD-JfmhI0gq6gw9JGA5enHIZd1E!CASlJ(E zuX1XvR_K${$;_g}6)tb>t|Ai9;&H1^;Un@_bgDy;Mt|s4;L02|%{_S&PV3J$uB5!Y zyByc!U1{-Lkv)a^{eyuJvIUvxCgHqI?S7JOx1G}A3?T}n8d=krQ_8~qoBwHtO-7#y zY>Ain;0cOYmxZnMob(#9*I>i5UEwMyAFO)1*v*nZPw?H`MU*bYc7#U*pUyDsP*N4u zHk?75?iZdJM6allmIvmtmIvtuAFf1ul)+V|}#Cl=?iPU}=R%o ziO$mc`g(Z%K zu*yAKlOveiZC3q_R;;8tr2o3!_@GAp?Hayd3bq8F?eSWz18(9S|G&?Xjxwqwn}u24+royA)Qq0Oo=UMOi4N+*S)e8g)~N>2-MDRooSL6K zpKx>-smL>Vzi0FbvyY)blxTB5KH+=v6IVNPwD~=l9NV49U6G zl1T0wl#XwL+7Ko~3ElnJxSSKN-gAKQ$FgRv zE2;J6&#-5#bZVoeTXuT9_Dcb_37K?NJ41w=DiaD|BfgMrHz3r7UdM&)4lfatazpQ^ z1j7yY<{LS$P#9=&^gi$-Mz}~Oznt|+XdD&qt(pvQD*o0H$~{UQDmLw!y+;{5)5PF7 zX=H4^KoTUg-ZlIR#|-4|>0u>q`jSPpORZG;CZKYML^}5;DlnFqW!w5Lx+5In>y;{B zuCoTYr6F0ry5+o74(^={lB|xrwRFq$Gj4h*eT~NfFDLc14vlnsi|HAL_J+ESMBAyt zih!EU!N@P`4juI^sBT;iXXbV;{=Dq)Yt))1&l~-K+}{#HYLDUM4~(@77pu<(kYpnM z`kGrHb5hT#jkrY%TaGm(WiLU!yB^-Pbp;>4&2R>V6Jd*(00^6%}ZtQ_?FD&bd1 zWz8YdPPi!GtRb4-3W1%Vazk;_`;NSQi=J?#1s~@a36_rZt8MFR1Vl(eaw`Y96#Yum zw&tKIDw7Pa!RkuuO?>iV8@}(93>Xz>tR?Y#>;nMBK3wFmyZW51R*tofb|wnO-D>Lg zU;1&YP_OVdHeLziK|=qTh$!p0O9K&pG=-GvwdWl45|i10YA_h1*!wR9B0-}|SShD9n3@)vh( zOw+;r#Gp3a%uvj3C)})ZUpSy{OVH@wc)01Lq0_-Yc3;eQ`>)wtTp8xGF00M+UaISf z0jrK)yuBU+7Orc7>dY&iL0ldmff@?dOFoBL(v#2YYc=h|dDsAuarc^^sg9j#$3QM; z20XbfcVUihruE%iNAN(%A=5*NQgUK`ns@khWC)szfN*R6j-Ao3B$#<5kbdPLf!aqDdki;8)ecjSj3~J9WRnX{nP zY0@wlIr9WkZq(lnL{=@@t4;lsaq>KSM=E*jyZGqMLg@@q@iTiLi*u6L$xt8imOhHB za!xwlho*w56=ttDe^N*U0(3@1T8QyH5X2dT(h=zK!#p z_k`((igHv|KkhyPy_;Bsrqv0?Du0)ZU-2%_-&(PRE&mIC%u($ zZW7_?@o>V;aCgsXwpT^Tc&w1 zH{c?o2VYVFbU!a&)~{OL`6Hw_DGj*m(u|ESr(OGAm>-uOai23;)E}Tff`ExI)azT( zN9artFb0N-xc&WLwRJC36s4oqM@XSS%&uA|*-uELfXDv6?wjsNYFNyF!kiiwqWfQz zriMl7{ukD%Vd1*}#lO_BINkq(JT)v>_rFL@4U5$MFLYAF!gT*P*Ic+~#sOLHKuPDa zLv-lz8bWjDvcq(!@t=jZSs4t9zEvbTClOYw^=Znt%42J@{QZC7NNZF~#ec!v8WmFU zUzD~+MOFM4)~!+D75~M*)~L9O|AM?VD!AgmNNtUZtoScLAB`;Zje%!xoQACwSuhUQJKzY}j-<`SPl62D6S1<?I1K?JN&EnyhW*=6^i42T)d=mrWgywbPcs4k@TshZw+)X>gRo*D8j9T>bJ{D zR)zjO8t(1-sg5v(a$~S?tz%9Eh_pS~} zG+}h%<)3#~paH4RWzMc~@4(7%he#q-f^xGzW>$f3_CT!93!W!51R>y1`R0xSN%QE~ z`jU#*WySt*JV!C>0$@o|9etq?mMJV{|LZ^3oqncqMcVCe5(|+|Pt0~IS^5pmWRjI_ z*2T@71ovN9jaVK|qm3$(5}Ij}WO9zi;0jbXy-N)?G3T4WA0{8ZJP844H;&F-G<(ow z^^+Iv0<57p6wsF1fd^vOi)kvqf+mu=oO?Jm!3R+gZjDR?lQOL$$en#ZirxQkP8G{s zhPJ;#%0{_w_iM`_vDUTXx`&aYdMB-PKZB^qzO z-}vw&AVcAgRXnRCgOhMCOdpp*fh%D+n=u~^84A%>B=s)M^0c|PMeS8J?f|l{VstBs z=cvKBWOS)`^gT6~da17eMq3S1saCh|Y}4=^^)guGwe_xHIV*b1`Pu2Cmnj(EaHn?= zyr*EeH&I~S6^`pnpy!JD-V)IsSn8J-Liteyv1{h-RV(Wm4cC?Zv;a5##Tmb?CHE^bBfDv@Y%vUh=_qZNbRhyI)9{X96!no@K4}&s7$b*9xHOg1mv$sE_`M1@x;d# z*F`AyuZ(bPZi+st``LAU@6Kq|lYexDaJo6tB{ zg1KPlQJT`#cwI>A@6;5J=q_3xURD;f2UOn!bC`MKXEIklfmHXOKvBYWky>*P4)1K@ zXA<`(K)u%b);LM->qw@}Sf>kqfLI_~w4aUufmZ{U)428H*meXhA_;=yIsoBJG9%soA~0cm5CLZDeQ_= z;qYB9{m{+LhK3W%Spm~&BouOsIss|P70i^_7X6hfD|HrlQIomi@@_723^{uuYze{2skZxIl zc+R+N2dqI)eyTrP&s?q2(tT6(gJf}j&a6-uPLzRpYN*zy!2?8#k z2u<^vIkpp)*ZcI=dDs=d>rc?`2~#Vm=!Zhd25vEJ-K|L|f)JSKX`!@G){YvMlz1$J zH2FyH*dtVQSAY)Par+SOz!82IkIp0HQ1kY-Ga@Eqgp>H=v!`K<9Jc`Dj@DiGBr2gN z9u}OtyBCp%@GC$I$^Debe%F18HO7a}gV<=ombyOOMC^qN6+&EX)wQDw>>W9#DreOa zPo@!v-aiPVbj!*{n<>Iuv#TSYixUs6sIgJ>iPlVkJ*YXeL%ezm|ET|E`~4_vGmL#Au~p-H z_-*~fOm?re$L~+5oJJ??8r67$Em6%cg0jq$DBzQR&qJ*X(%JzA$5XG zR>)p~8e0HWe-g)b4+sjy99H5gNECSu>i~n};B{O5k?_I?663SOrlxl7H;$5@xn!ifH(ua)R`|YO8VkfYhb_$Idk$ z#do~97z|u*FSGWHb2Amq^GkgCXG)Z6j>D`%dnF9J)_o)>=?gc1ECzyJzwsHqkM~)X zsMl8`>Ud@x0Pl?7-n8SUu?3#G3s(RKSi7%kcBpS_qU?=P?aEHBMcRJ`}+>c9Rz&Ip1=G5dSCB}-2Mr=_IO!(v>ok% zX|w6*>ZfOrucVW|ctju%;62r^UVM>AYZMG#UJPxLWBcdzM{sqJNVs5Q&@c=Kk=alS zfz;l)wFKECy)<7q>wXU{E)N6-?kPvS|J>jybW)$&yHG#ebNyEH<08w;Gu?8>+saSg+;(tr7%$6pk(}*$T1lu@fXMDAzz=y0SqYSUB zyF%TcP~;|c(LI~!eogMDS9SuX#Weq)7f$oentMofz`L6BbpeNj!nBdf*IAvV#>fk5 zawr3D>*z3=bXd#jG9eWX-CuZ&7C|z%Sx`>%aRq*i&Z)-fvLGJa_QH4&ggWAHaZ|lh ze|&H4Oa2w$7HXnXlEtS~j1m5)pb>2&(ZqWFdAKSif%~dT5_#VDid>$bsIXlXBivvb zfJ1|bc>Bn5fBE1`{zNhzq~*kc$Lr(sNSqVgtI{=Lv8%{^=X?+s+XC*(EsDI`xwI!Y zz#Z0?O#c1*cDtC<7Y(mdz|*5m>J8p8=-X)#Tj6y~bRIlqvbEwf$UO;Mfv12K&I!P9^YUVK=RmJ` z1y=u8$un8_;3{#DW!xKSSUxlBafc$~4sD+0_vRx5YJZ@iH)-=po)x&TE9`b0u`Zz-47C{CvxnV_bf;dE!pfOUDo7XNGEA2TM0sT4?i0Sj{*QKK6FKF z8@XaOvDO1is48b(v#SwiuRJ6@laA9rl{O$cMi~n6MR4f=rgp$5cW$SR(g%>O^7-|p zL3J?YP51bOHMG?8GfUZpO^9t)LuhkTrwTvP?5ej|Q01@Ylgmo?&N0wkB?ix$=uGt`TpgC>s>x0S>;6KWDFiV zaV7CFfc^Nh{WDos-&_O6fg*9GV$4a5{UkdV>oU2n-b)RB<8co^j@1b}`!iVtVRIv2 z9dGTONI*5ZG$~?Z!#@p{;a#`y?|1aHl6{2Hj1jaJx@7yT80y9t^r+|U{`t5PVE<$)(02IR7~vk`=SxxrYp#2}0P{Hz`}vkp7= dKe8mlN8Uq`*WKsqFW?6e8sdE-bI7Y#{|ABq1p)v7 literal 0 HcmV?d00001 diff --git a/tests/testthat/pcalist.approx...FALSE..weight.by.var...TRUE..rds b/tests/testthat/pcalist.approx...FALSE..weight.by.var...TRUE..rds new file mode 100644 index 0000000000000000000000000000000000000000..c30e7b0e5f4d6bf165f9925c6c8f3d6c1e7602e0 GIT binary patch literal 9160 zcmZwJRZtvEpr&CYxCM8&0R{~&!9oNb+}%Bd!7X@z;4Z=4-QC?KxVsE6_#pe&IaOO* zTj`7E;=S#zu8%qb74Clya>1&Hpt^pa_;;x2l(cy`GTtG@A%%=BVF@7o;2V!QhiPEU zCsGGi2IU+~nIMo=1?D#vI;^jFQiEoh2KUb5(x<+@OOWV$v8DYLSlj)Im(SftOHSJ= zpGkv{L_|dVM6MhfMEtHqL>jKzL`2w)!RF;a3Sc{is(#pwMBFA)o2!&nT7(OpLoNO#98zPh#PkAen9UvbU@Jfyb6k%{F zsQgS8zTaT>yUso&KtNUS9J>=4e?qS|;+o%x5pvhB_Xx%&S^{nEBpA?6P$pTHrmJfMR3=sBn$e6jXa8}hUZ`Zkr^GRON@oa|NVXz3 zZzUY9Agylqj6%fHlT9`(!G$j{92R$Lh4`COhsiIX%St&V(@*h0A|##QVZQ)F#=J#t zbNjc7SipIFhnDdN>=WV3e#fjod}_Z*uutwjz%2+(aAMF+Z12<-bnpD+)F9}*>bv

#vkQ1&;^LLKD6DRw=( zqZJy$W-RqZnq$x4=(*|BgYck@o=Zc+%k!1%zLD7~>KVVxF(US~58 z?hj{7IfD);CLhGz+2r#z8QC2#8^@(c$blxmQz?r9ifVvmMhUt=wmaDp2YJ`Nm21-a zXvY;r%B0=dx^EB$$H%4{vq?%OqOHuNI16TVih1UH&@?1An4*9(typ#y^#OrD_+HYxZV%CI&c+PGF#&A?r_$KO^Ep zL7#ZcWB>jVOk#06(G>R~4R`rWyB{76+PkCg8<1BVAAS08FrH`_!+zGkb!8%OdHR^- zwUDR)8dQ;eSCH9zEn9g~S2199hV7uv#R5K!JFGb%Wt3`zuk(?(I$ELrlb$ z&){rygH+o05(WIgKipxAWfoF8f%rXkksCoq0bB&&*hRn}Y~G}{nk!d6ADrt2vBKwa%SOr~eHn^qtn1@pg;4G1e)R>e*itlDX zdK$dj*s(@N-HH{C6-E&HiP(MV-|7778aLg@XlkqH>R0!+vCah)Vbi?AzhE z_av++$lj{zxnWWk142)?cP=-|Kz45|lwvd1z*7dS-1-m7mi473&@+0#q!M}d8AXuZ z%d6YQD=mD8xrL=d|Kao=UsDLv2|VzGxpA=;0N3uK)2PAtz??KuW+yM;1(!Btvnn^4 zn2XlO;G+@GGJNWXfSK8Wp12_wbQ$CuAX-{DvkKAk_iiAC-5Co29-HOVR}_iL#_P_) z1f9vRQJ;{f@%m^Z3`cRjsD*CW4{UGp+X#=&+duz zpxb;E0-}Rlr}>P=fZCf?YGBJw%}H3PK5?WoH(PX7!n419vGvD?OI34LB7#VQW2{Gn zk8BmPEwCA?ZK|p)Pdi4f<;xaz4PVR@@)136MOEs$De1bSU(rSxV&B;gom_xvchFLc zIjH0=AA_C5N!>R+0qL{zdSjShkJUATc< zO+&GQCc+e(}6rE>crs0?5{x(W~3nkVB@JihIB*#{jkDThf$4j-xN-uQ1y1>5vSt!%9npxd=xH2dj&I`6z=!C1JSn z$E@Ll5S-3}s2g*KdPwd|g^ds8xt5B2HFr@CeE5ww<-^qzL+P0wxc=-bsb}*|tk1)8 zlU1&)QJ3)%5ugh198@=l@7>g^B;2OJh4c2paIeP#;BIPKFy0_g05&?+zS6@@{S@52>ODLO zOy~@(XWLt#YPqa~0W6ls?s~3=1P>I1%QK1fe+xCYv-(UD=FAXJKsT6(X{&xi3aBB# z?(7lGhJY&4l%cC>;^p)#W$`%xt)C-HYnsQn%lHUxt^P)T-+N%N_rl4y^d!Sxp3u$v zR4oH3`ZhB?#!CI5XCu?bpAiBlr#h*dF+PN%KApu6{ZemITVBnR-848FfMY+DrgN#h zu|ZK{N=^TOFwZ$_feXoj+Ma6TcnnY_-6&Y~*{!(Okh#9S&UQZVlVY5A;uvJ`Cd&uiwVJrRDw<-R025y%>_A0I`8(Uwm+v~jc@Kh3FT z?b>9#a4AKstuxr7DL_Jw&oHgEGtMERqt0vH--?oXboC(hSVzkL$o}zFk~yu=R%dGtahqD*Q39Pkoj2d;ODc%`ZHiHJ<9L{ ztV)aJ)1QpRHNU;mdSd9ypG*N&f_fTt*2*@D%n2E_KV@~NvagmOi%n(6y4?VTx7}b2 zqQ7x_qvDNJ6XKDMyrWOpNV7II6(*9By^luY9{v$hZr!PB2_=(ARxrP< z74fy=-Mp=xYV|QHUE-e?UPO?^CYtE?bkBV}%H_Fx3Wd zwq>ppqGI8#$Gsl6z@rX`<0AmHA1H1$Qagn}*h+HB9CTDQs~Zel9`W3rP+;TQPt*%iAc6V z%L!fk?_rG2e+&03MegMI#=o|Nhm)+nCkEIQ3{T^K+s;pVkL&>*x|pwgjoPRZv?tLu zMfceFPOQE6QRe*6uGi4Y%P6*6dLop+MN)&Rimy|*aOOs2@(YlXlgsT4H~p4PK!Wz^ zjC7fl>TMPS=#G9&@X?FTX~vJ>1q@6t-!Gm10PGbLDElkd}=7l~ey1 zvjzL|N}H@nGU?_HzmR2>d+g>IDv+!m(73LWic@gXt-0SBv24rfZ>(R~NBWK%5_-|W z_72F!xqqfjJi-d#At$yqS`1kMzgV0gC`nBg(pGY|-AS^jXHCX`gO5r7kf_n$iHVMp zDN||jsCANYae||SZ89=yw=ONW$f1{9AtEOGNCP`IXnVeH%kH`_4mnAGKW$O%M&pek z@)RQ9+Ja|V-Tkn$QvaI=Xi~pRXrdKJTl3o*KWYwC`%AT2Fbu2R&mbAE@H-aoIi9aI z)LI}Z>TGiOhP+} zZ9VoPHhZZ2HGi2(9O(RF@$z!SIz8L)v}dOwWYM530I{=2`0qmQ<^A;ha|seBI`%iT zY~uG;wv;-wVxMA+8qL#K%mhdFg7Th;u)jjS1eH}Kb zj6X?Nf*(j*>@HQk=PNWmz+-fzZ`P|D6V&-si+yCiL^+rcSf9XE>^s}PNIof;n8BGK zPL}y7&D+ZQ9_c)72>AICqW=kET9YOs%^casC7{!5WS@m#YQI`xlhAs(LoYx+$x{9$ zGLAw9p<<)hUKpTTB}^pC$+CuKdm=G4cZ3Ud*_3!(67v^Ia)@CbFWbwj6(q1< zWLVOH?(v$UT%m~*#N+75>O|S`?lT(|;9^H9BsYh)iMLPFxaL+5r40!Q6b)S=-JA`E zeXdtryH3P7uz6FHHC>SMsmXj2)^{jolTpg{Dko)S%vhPE-omzUT(xg@%)wml6i#no zj53LBvb&-5)}#@Me*!svf|F~lnlH?%lj-}m;);|3p?ULG?+Z@j8DFmtsN3G5*xSRA zS4!=S)HdO3dCW>TinYzNw_l3n+N^3`Qj{9Y-kY>%tt=-1z6}lhHI?f$i8`K`O^CTK zu2AMEQ9lxMA9qooTN)=-@cXNEE>=ezZchQvr+A??`N`|c-oa|I>h7X(CHlAKer4K= zpl?_Qo6umTf)Si#dQ_i6lY*(7SRe~u+=7p?<|cjZgxr9O2?O9&GC z6lP~g?J94pWHonEL$iLkAcs^K*>WV0?PK=Z2ApFtotEX`l*%5Fxb;6|N6v;7x`8AQ!aj(Bm+|{Dn@WM z=-(t(gU~SkMP&6fD#kyEz&4(t1quhrgjOHDC!*}lmDU2I{%-{LN-+cf1!iwA4e(#c z_x3UX|3zz%Omg)R9+7@;uACMaErP>%h7tH*yf-Ae=vonG=dp>8mHNy|YHc=8OaJFL zCJ)cZ*V6iLiTowAOzJE7vgvBp@vQbL1q%Ngb7NT1Oa4h5D{D#azldceE6M!_v$X2M z`LdyE$1$vwDh1M|;IE0;CI1t{6-$ru|A}NNNq+dh_*R;dAN~(ylhuynSoKv3~4iih;{o{Ryvg0$0 z+tpng4JJzLw{*7IiE@CdAfe&&i4l1PjKiWls7 zlH1sA5WS>g>8R%>igWhWZtZ<&kw(=T25TNpmT1Q(Gy;ByCmpbVSa@ccl2ZjY(l18a zxe@$Hng*{i<+m`-t<-k#>uMjW*t*yP+a+3_-p3An#XdQZd0|$`NsS@`g26ZQWf}KQuYm6Bq8CYFd~-(9bz~iJkbzm! zAbBZivj%(3xbqx|`wxThFm@)?{WIfFOaz5LZ|1J=ckef)M!c;{Rc)gJO1;v1L$q%t zds0=? zITxlKY^53PzLpvy$BFTNo51ndI?$bn)vLj9VenI-+ktjm!CU}$z9$$>xfjY~ zoC)z3(vbf{Z4A${JVqI>6!CMmQ+4R6(ldafvdY@4)Hf&H7SC1xER<$+d_-^;fWJ5F zEd;)#r=-wKPEN%!5Zo|itN;B-oo8u1RcTp$;=k%M=dm;v9hjl3Euf2(*ORvldpw>i zIC3g?%WAmc0M+dLw&xtc+{=@bJ|)!c-Vda6{sx24x>f8uouTPUZ1@lDmYK3k&fdzn z__PwyFdJq65UiyTHPYh~bM_!p^K4t9+~}bCG%%OB+Vy~L69U935cfF$9mWSk*< zON(l{Y4rV6qRSC#0qhDjSjzYsz2--{ute~7&F3hIYq%5%6_<}y?9aS3JcJU zd5u@dO$>Kb)*eY(e7GGP4s7~Q zZLs0GXJ1A$JfJ)?6?{sLD4-hE#$3iJiBza9mDAO)Tf_k)rbSdT12^>#@qw%JrVVOEl!?xW|;2p-N?7 z%EatMmHJLMw2uX;ka)xYZ}t&nBG|L|_rBCa$nW4&Yc9Hz5(79-+-8UIJ7wPH2`^2C zMJ>2QAhvzHs7!P0m>K-&tRUGspNMj7b-!S z-fMvdfAfX=Nv*SCFX{YUcd95zhRd$g1O*_{A^t|oyxU@6W|@s&9RH|}nH{FsX9-0^ z$DlJsVl}mWejf`90f3elFHHFk|E7ED5%fs{0TAK2Qy|8PKDv3X8U_mjy{ePYsSiY} zEDP)GsgN8s&TZ7uyQpqC@kH#XrHTG(>92k5#&&++wcYQZ=sjO$(x_R ze9F&iC8RXQg(^|tYDnO=a+7`9f#eN_*wgs2Zs)NmF$2m;dBRGy&_+9{1vN#wPz8S{ zEwkqSh^ccb8H~PS-%^fxz?+e~KFUNv8G9|z1qBz`bnh3?(zK+7R;jNX4=-LpJj!BqA zH1VySd-&pgcZ5gy=6Lbz0*-0A<>M4dDb`rm5NP>L?-iC(G9eDL&A4llz-lg3jDHbd&4q^X5B~4a{{PnZ>q5b;X zZKuu!X*EAb6H<=Ymo9dXN*|rvSfJfvIws_%Xh^XXxn3UX(H5F zN8FQdY0?LUl^W%~+6`GEqB1#r4M{%I_D8#;-tfKaHEKUP-@DV4H4^1=SC4r|O_DsH z0wtn?H#Hrwh?2+RO1h|n4KLDix!&$ZJp?5hjk`8mP)1{unEDJf8v_tOi}=c}v{(hq zoW_}tCOk~US_ z_+pf=|KA*2`N)OG32J{U!l|1G(>fhP%e)OZVmax>5lPnUSE$?h~Ou zuF>BK4c6KkOiZ@G7s}inqa%HNFHSK^%=Ha7*~Ldfl4~ljCc`%r5|!07hTPBa(xQ!P zXeu5?T%phi$6<6Xl6m|WKrl9P(?L{|fgn1vL-oW{y-H8_iNGKuGJUpqxi+Yj2JNQI zJ@UI=3(nJ%-Lrxb%25O{fB8l+&QsF6jN+_yY~Qb=Y-f!nh#k&UyR@u{*-cKHL-T89 z(`~^$Yd3lCZ)5{@(Q1Yylum1k>IJcu+kw`pXq_wu0~NI5^$%P z&%t5~5%?*s$a6dko^ltShZ<*E;)~gBn|G${w9{2fkW&Qqk=B`oi~a@C(bim)*l-t; z_v+NRmTEPwx9RsUjHMAj?~e1F5z?NsUj{cq#j2wHU45EDm#eydy1L4x%bd7%Yj!EE zK6!QqHp)hzWd%}Xv&V=?Z<_+F<}~o+{7jKM_1s*d3v~Q7^zOc?v!K*_>f;y@^S{e7 zw4gw;ed<2^5cP+RUlg7l#r>(pJ5BP#+DYH|8dlmQQM-MVJ&FR6YhNb&+SV?3$0}ve zMi24cJd&Vl`@!~V0MFo&Y;Veo-N&N!qWve*eN~-^L!6#Ts<@7IMf9{?7dd^?9=G7=C`EeiFYNqBt<+g@gM)CJ_;x literal 0 HcmV?d00001 diff --git a/tests/testthat/pcalist.approx...TRUE..rds b/tests/testthat/pcalist.approx...TRUE..rds new file mode 100644 index 0000000000000000000000000000000000000000..a1e0dced1693b9f73aeb41c266d6d64f21295c49 GIT binary patch literal 8359 zcmZw5Rag^@3`E0=vA#tKV4 zE*cW8Iyq;E8}EVZN(HgOeJ+awq(OyW9sFL*8!hh|cm~W)DB8;a$(oP`oFWqbh366Njw zX?8olJh+o#%k4QcY`7S(JUZZ(?1(EI^}XPug){MWC5a8B^RL3=x&sI9$kKfEErz%N zyJ%1znldElZnpa!idM`$U&2S5Y5jH92oac&xJo~mKGgT(Eg-1oSKfOMc04evG9Etf&93Ez-#N|chLop z$CxX-td)gsO9Xz91~Y&2-m!PJBk@GlzPx5mVwiAL#n8HLc-mPr@=o-19r}lwX=!s* z@x{>TR058eIA!2F*9_fEv%;R!Q)l?zF{j7PWqMMQV^Gd@>RVT3i7TK-^5(L~$$~#j z&{X`@$El1ljf&MFa#QKH`I&pE46wyL-Goga!_#orVVvS&4!nb>s(`9TbG52?K9GFa zq+vG)hN=h2WnE)KyQhtrn!H;svC2-*gTKkHP)C!n=q(TkqDs4YAf}^RxI!GY%lCcM zPEwbj$GXI0AHFeD$*Wr2qsCh(llzmbil;k1Vn=0i7JhJBN_PbOu-E+l$=P3!7>f#?l67IRU8ITm zd_WT*w{qM0_p@22$6)+HN4bm4Vh6{&)5QZ_;?x18`%>V0&<~I3&IJ0PPJ_WX5uW^1037(hYozs=VHH#83!sm`Z?q z<(?f^!Tn&0zB>JE|2+`##!WXaZ5M}H@v^?rX5Bq|AWFdE@V}5(X>K<4wu&Sx zkcNs!q+|;qO7i{yPkMX)qLTb&dSKn06CWJtSht$ij_@`kpBuv*iOUtTWZePIL%hQN zpjw9Q+hTkBhDI5S%=u@KgS$%>0@{MX%;4$#duxnyidY?-BMk~J;-=PnsED)4xrUvE z9Z!g)E9v0b9Q4iF&w&;GqB@-|U8OZX?Vd9SW&~-M5Z;^_iJm|ZIUt#X56$vD_CcyA z>4P5uz_J7yHFB!v?r#T(?}){^BA_KQ9paB1);0EfMTYD{UMICRk&Z*BRN{9rk^{7x zlE>2&%UOCX_fw2DUR4$Zz5txexWBZMg)o}=S+ge@gedE@3BLicEu~RAkL;<@8J{%! zC{arFnze-c_Th!1RhwE!{TS#R9vfD*o~=c)Ti{FVMEMxYc3d@Mzjv}L>|9tUkLd^u z-;rI^o>k+!pd~LGm~vR}q<2jRc57}JHGiPKqT&k*@+#t7%sNRV;f){Y7`WlZ_HVVE z_tf^>cc*3Tl7pfn_c==ToHKga^dnXb4F97nNhF#0W53X4C{(`*zum<5^#1te2lQy7zDI4DhR=!S<5&O+C^N3^4 zolBc}I}sgcv(mF;oQ>8O91xpdBM1AG0_XN!m5acjbq6VV97@$Sm~k7fMO^!J$vFR@ z#9_MW&vxuUGIow~0rhM8si*a$3 z5^jO%Y2^Na3f1&whwx^12oaei{<`%1*Js6b@3@>z_rlBgsr*nx4Fp=;W} z*zlAvAYByr)7-MiSmO=r-fHKNbqS$RO=7(`gH1Rhm4+?yqkDmGeEjI}8q5Q|N)lYd zWnEHBsCgSp1K8Q~Su6S=MR8fDvF{%Pw{O|+>98X|3_WNom6d$Wu|0OTtIyY`oO#5| ztE+G*MIkWdFe~};v+HfZ=12-r==+(=OW%IW0Z07a32ygYgRR6H<0;P7!X>#S@=rw= z*PlGJrOs$N4RZsfj#Phb`&j6J=RaHLMoJ82Gfj~5e6Mns^Lp8#zImDvvYg~Y|Jhc( z90^{n>a+Nyf+xh~%fIf<{K~@ZqKlWOnM7%y%YX1D;LKskV5P(_SuQwY`DnuhD-GQ^ zlPi)dRd~^3rMGaxVSl&MD3RkfSgI1Gpbh2{F%vH)ZHHoE1?7WWJ;%R{lEweLgGt{I zMKf}DX%H7kcKtBX`}>+q=_b9Q7|4N|8I=f}6F=OnaytAf^g3k{q5kd0lLFTe^zJqXGbm z`*g=&CevH$lSXA3G(}p0LvfCAB^4y>B@fT21}gbR&Cvy!J7}L+^+yW2=`NC^nmC|`@$EXb!CRZDVwqLfL9v4)I?%=Nv@Cy!1St5; z;s*JJi+0%-uBlX;xhw1?tBmA(p{*Cbn%Sg2#_L-6E_p@KsTegDU%GV)=s>Zso6KgA*oTq!=!;~_LS4+)enj}tpC|& zVifbZsMUdzx3lgy3D8#dn47v+@BLt}Y0aA=GDHe1fLCjUhNy4b3b#(G(+mw7eyW%T z8XZ}Lo(5Qf8xR1x69W!DV3!%${2i_oXFzlC*ZEMbS1WVXMm;w8O*XJw`&Fe{N?fqU zqFiswd3?-qdk~HRy6bm#VbFHF8q(lKdQS~}9N1B1j)QP~UZmmVEyy!mV(PAk)HTKpGMmP$7Se`xwtg#GDE=1PDcDQ zU#KCc+Z2B(i)3DUOfvru#nX4)wNU!umalnJP7tN~1+WE_qX&#%!EGl+x)}>A85%y& zki?*+mjrBQmK%BX6sgPHzuC2rLUI$6UsjqU@emSp&v@T_t7rWfZFDhf!vOYez*Bj3_cFXk_=6v%fXczj+ks@L&Q5iuKLyKHp6-ZVm=nF|7FDD?_d+(c%~_Dpz!ag6dxc5K1eI30 zQ$YTeakputho$u`A3Kd*akXBS9JHa%9k%P{IV~>^j;u+EAbKhxo@WrQV#xrw}|Zs6f&N>(mAJu)VUB|moe&P_l3ocys%QWa+(VZkK9rXCAPq~@&Wjbv=*Evo6U~Zu^3w^Vloca4^Cu#gi^;nnb(^-PF*JrhC6&KG_+zPJY22w57yt04 z!@_muy;K4une;FfD!_p{Uz51Hz^K1y)Y&1Yf1hDovgf_;7u3#=ZOG%y*9Qt+LV zKr<=9%@l8`wjPux!Wt*Crx)J(9Y{3l9n!D$IL5<1ANmV`etBO|-4BA8TRk3#t86}q zLVLBN!}sIofElqUTVU}CJ4~zZ`&rjmV7Jcn7=?kDph3Jb*)bql{VXgm^#FLx_$=O* z`<=7FNnatI$yn|)YWt8CQ-2Llei1#v%=R^l{!_K`IjA2J95(*qxG`RK01N_0BIt2{ zWySpJ8(~nf-_tnhUK_m;{*;Bj-B^^jm)OJl!Pc^D(+PmKc)s@Dc)4tQBm6RF;m50c ze0ZI>3@TjdK<;7 z>yT|D@upP9Wsjv7Tr)(j*BUj9!h9_qECaox^46^0u~j$5iy#y9+H=Fw{ZF&u4g_9K z`_jb+n>u{w9lhtevQ+g7@eBRoHikM4LY%dEfuh=lozB$I%i_Qi=90hb2@>CVUFz+x z-omF5=c`$gCR+7@eWLRW3H)yb9<8`F2^)GiTaL@na-Z%m!`A(oRnP86l#6EV58H0i zHa-$RW_qZv4(b>D&3^H#1lV0j{-;q$XP; z9Jj*N$an8IGlzLg1js%^NNStXh8#lqg$`1jnPlM`JrmoxdAwq=gR6|K^b_o0ZKmn9 z4vthvn@-X}@v;_bH8^*{{!Auoi3_8x@(8z<-sjqKb+T`5-7fx8i#48Zc^&;Nw`Gd7iONGLPq%$XpQnd@c9IhCW1PIKeQ{zz3~Vl&@jW=i zQZU4uFG&^(N@R`7P1N)gM-^MU(Hk#izf7cV@$|UIbo;d{*aC2H&{vPHc_W!`dW_)DM{HB>>fE%`-QZ0&s`CvU zfBWO3mfKZMRQ49EC@4r;&1eIXh(y!d%9tH6{xWq2Q#=m84U7^#E&8Q@s2?JAeA1lw zRmNA#A{3@G&c7+!au~vRuXWbh$*_{hZ^3@e#w-$>Vt`|z)#CbwHLuunw(mxyhu8S4 zW9UjYQJ+q?G&Y-+n!dFw>Uc@39e#Fub&>PF8>jtPG+5R*p7g}z-PR;|MLa1^_o+ON z@F@9jWCw0$%>Y_90Z=3n$xn z_1+}m4(d#im~p*SA{!U;#AWT|3_L|U1<%TkX`q!>davW}g>_3%pn@klieBt}WY}Mj z6CyG; zE31F;hK$V0>R%9(iC9_vgKa{x*H-_8h>Xu_`(L~vqqExnA2xe=tV6GT)JDqWK1xth z+SsIg`|weOQru=Y<(r=Vz~+-<#ep_Sq6QopQ;i6e|})s_tyCrLk#+OI{$=4 zUtMSDUoh$O=nVY}HhpKEp?|@sPop#RFIe@>bcX%~v%Zwh(Enfq`}DNX`V_3mdpR}H zZ`yq2bl>vn$pwOPy17UOUE*L*BtnuTvMP<&D4(v{Oe_Vu-nIqpLQ?QZpwJp#&DikD zzlKaEbyRTP66?Klh`+?=0#Q3b?7U*^juYp0Ttl8#*)~ojhJns?)j0drkGn3fnm<+S z=<_QXa#0@w^~bszk-aM!^avJJjCWl-1T-clXfY7Q$^H}+GOu$QAw?1=U6b(wXZ z4O>i{6z(LN)02oy0rplNl9>T+)5+hoFU6k6dSYLllwbTpcPy;Q()oW0d9A{3BGI#5 z39_gpf@lKG2J1@RPX(WKZ`VnA7)nGttuE0^8(@gvx&eX({S;K$M4KY3@nh{4xm4*q zVk+~yZ#HXj%67Qz$$g0P1ENs;6R!ue2<)Ok!Uk4@r|_B19zS`5B`PZjo<~BKlT*3y zWg&+2k+lRR?sWLi*s}a`F+@bP0wQIw`zY!yu}awYWDqBiTgSy=Xh?>owfkfV)MCxoWbL8b@KVl0DG5>sOUd>2JfQJN)x(wHw(?=^-R zGA>-`AzKr;JxbX~@k;{Ul9&eeHWIO%Y>ala%@B4sUxDU(eFpDlYE8YPmVUs>QMD-= zIgDzojUfnXwFHwnAc!zuVUp_Fqp~Yy8lIh&?g2CF$_jD>H36vEG;v(_b|ILK9D&hG zErH|hbVn&Hy%c3e5BtfcdJIpg8NK@366zZ!Wk2Z{!8o@rn@Ok2OFT+d0CLO^Z z;m(XTzKSihZ0?n0+<@PGzXd+K&}+YuVytTL9Nobryi!~#3wL`#SzWU@2k4OdZjV6t z+;I!|8-I=Ra-;S?rt1+Snv805Sg;uWz*A=kS*gezQK&GqRmooA9uG|0D>|#ek~dMB zr5ZOT^h0`lCk2q@J;qE{@hlGL0X`R+&QW|V@(juinzvT&SL4Nh!RZd18gwc2y`Hfu zZ|M9H$HsE{>A|rEfnE4`t{0`uJ_vEu)YG1gFq-6TlsT~U4;U{Ds#~P!dXcp%pPW!o z=GBXT=rjmN*L7bfvU)dmeUr}VEp2KC_RzqshENDFw!8Nv0U}U4Q@{GQ= z^668Pb(oP@)xC;oKxzGdr!>^2y>+`Hc@&r3OnT{wD%g0JJsp|Wm#x>WIe5ej#paL< zxv@c(W)pnke4+6xTtJ<^099(vK{2;9;ov-K%Fdv&y?{QEj2z8MO$_eTs{q!@_ph#> zlo8_m-sBUNYqcSctS}Zofsc z615P|1T4`8n1z1!Y{YhJ6Ba2lcqsgv)Y!0LhP%?k7*y1C*nQEfI1t|BLUCyyVyhI( zCDp3hl`mjS#~d<0Z}CPfI=PSA`btnOVJcJHt^>r#rdWMfKkG-N)y{Nj=yWRA<8eKo zyDkv(M}OjQz48n9++qptP5M^+C4RF9_UyDaQvl*lQ^((@-iP#IORw?96GuCb0Rw(v^xd&HEY+hQBvU2B&g^s^z{j53y`%a3_nU3_{r|NbNLF53`G;3Rmbrzy8mG?&`kmqk z1+Sbp<8D;9ikRCcMy%*|Pu27h#9Gf_UJ4mY%!(+?iE1UgJSiK$lUfsLCHjlWn&XB) z63-b^@N6R%jMI)Y2J^w_<7A zZnxHW>6oIxJZCEhw@C%s!Q*0WK4%a6l7}#fZ5zAg0A;FAPV^U5VY@rc@XR3HF!IEV zjqP7beV*Qb5mTrzvq3 zzIFvZ@bRjB!aki>ji-kGj@R=UYu?&rj;at|9 znh?)CG(+{$>~*PBi2_nY947qLRa?MC&V$&D%hP(oAqTU3b&A`O^p=u-}SBSBrigj z(Q98aor_YmfP~DcjokYon4V4SVu`g-5-=|6efi@bvfp3pO6-{{DZ#$V1cL|1Vg1%=-KP1v8ISfB*mRL}~c6vGf3d zE(ku-7*?)GE*od(N@V9gNcTS;{{{3udkTCA5K#dtDFF?ei;_ZV9|)Fu=?9M7jQ=WG z%_uDTvJEeW(q1K3Kh^w!u`1F)#>bN%Om4;)F_^pbTXU*?Ed3p|-v?sTNAq#0({G^m zrm#c66Xs7<_ekjYKMDQq6?eo=HZgtT|0MkDG^;(L{_oR~S8SHaQ^$Dk z=>6s(+&iSX^cMipKD<1FPG%lF2}KCW*gQgQ-w3~z{bPA@=|}pcpIDbzTy#`x!uD`6 zh9cMf;&#bTs&cyoUxR7#!)*>OD@T$jC5@=oa&n$Z<50lRt)V5O)x#$r$m6E0)yWgV P1HEh2&4H=FvuFPYCv}f? literal 0 HcmV?d00001 diff --git a/tests/testthat/pcalist.approx...TRUE..weight.by.var...FALSE..rds b/tests/testthat/pcalist.approx...TRUE..weight.by.var...FALSE..rds new file mode 100644 index 0000000000000000000000000000000000000000..16119bb61c9923a8399226f874e79d6d03880e62 GIT binary patch literal 8288 zcmZ|RRaX>@1Fn5(kd*F{Zlt?QL7EvDx*G)PmX;c%8|bUI);XU{jB#r z*lVxl|33H~+@Ij0i^F{N{|&ul#S2IR>cVh0LIbgD^J^!n9-}AI#e{OJl9z{usy5S; zaxl!8%+N4GV>O=HP>@K7L8yw_as#sLyB?E%eY*h#k3#{s@bmG&MM&0lmQa8u#G-(n zjEoGQtmc&n89px=nMjQ&85!M_9)$=Q-C}&j0ky6t6_ugq>f1eA+jMWzN!>;}O~gq! zXS*paj?3ehSY=9u-im8*Y17y&zcb|=?V?Oe@FFgRb6DfM4V%?X-a#eApENk3{?Vw$qhGUeT$Zu0K$e7UBd zCq$t#dS_S3%dz)sWtA(`U(;SIE~Kbt|AKOUZ>QG>+My?SXRJm zbQTO5cOv{hY8Lq&Kkz-qHSeb3Cl$IMRiPGGO%N2Bba98c(xwvMgFw-T@}qCsq|f-V z+*OzQ1%En*i?2Mhg6!(TIwT)MYcH+X7AM?B_VbZ6(BfEVgTOsH2CM5sE7;(AVW;uo za|~3j)lXyYW%%hgM|9v|51P>$>f;u@q6DQNcC#HtR_L&q%FTJ2e@qB$YUuC1^RSPm zqzUwx#8(L*&e?z3zaoI-W2-y#i*cVgptD~dBJOGsP(}YTtZ<4)-{Z7RsB? z;SD!PKSz;a(0fP-4Km$I6E7I!35an(7xj@Ke9ynA=b6O@4Ns;?s%&L#|(0*Fdf-terBlcq4CBOaIWBs&Ppo^=eZ|-z6?; zZ1o|piAOUzn@8znG3-OAWuDKM3M+PNq3R|6GC_(un9CU!hOfe~1Pfy~mBz=HmLfyevT%PZ|JmA_$ll>W6Co5kGF06a; zLHR||d)XcbBmv3QTZ+thy`6|3cp6inPl@$i<;%gp(O;)*Chynj6uT7OI*EOPgZ z_X*@%q5S+BPCES_c@H);9BsBxE2zZB;yaQ%>dMSUyOO|>(_i~OCdFxYAubW03cVO% zbFS#tXGdv6nSQe%x#CusWaFJ%mfXHW@0!>#+?b3Dlm)#A%dg|dQD;$B-gxrc4IP}S z-zR9T2zMNfta=hSb7;FNQ!&7VYca1FST&zr_)ppl^F;N-&%nmV*;N-nzf0d)- zrM@3eW1u`h?!DoxQot9-T1%xEDn)Q4M7xS^_{Xs0`(QS~%F!B0Ry6sdpzGO|NYsGD z4mDW^|0~w?d+CILZ@}f8h9E8%>|BHSCQ-5`RI4P#yBuq8Iakw~HRBA7U*PI*QlLpp zkGa!MeV?FL_wrkA=y~mhknQWrm1&}-D;@@KltyHag-+9Y)d#-f@@Hpmd+Vab3g<9K z3{6b1>x0gBgNTfWIkNc&ok9;C4d8hu3KSqcf}P!khfNX?$ie$nzC_#43jBltbKQ3o z7lppkUD=)K6~5iBNT7gzKJefY6%M(o4M58MB$JNJsBNzkV!TeIpa*pYor!TU5UErFU}bM~c);ar#-e^K)U%OW~T|^!T|>kvF-j zDcK52`#7(9$qDx;qg(Ab%sZYsqZT{AgBv}p{*IwysD`BX!=9eSQV)u;gQlvpAM#Eu z$lpnR|5d~(%h5vGD_WDdgQF}T)ayG*Hmx;GF*8lx`Yy(l-3(D=l4R9!@r%8g>K^>3 zO<2E^m&BRJKfRMEt{dLRYWTX*H8Z5+$fK<6_0I7VL$OvWDuBqfpoahT7tCt6BVW|d zg)MzP=gz$!MSF7WZa=S6b@zf6d}ftuWAg8~(?F=4cA(Yh{alrgW_HtGO9{uj3~J?^ zdN?69_=e=c()b!l3#-*N8*yn*v$Q@MbCx#a^L_wjA$nK0@+GJ-_1fP=5~Fh#DvnN& z3D*WO?)N9*l~T_6t+t33%x0a}*2>p5dy3=eQ!DzO?Yd0RDrL3jg)ri!K*&;hI0ykTS1P2zk+>+T{E7yAnd}HU_;2pP#_o498ukhKi1c;)}5!> zAs9(FAC}kxX_fQvnPX3@-tl{f9_8L{eb91oTw2MT2#x!B=y_A^Hb7l50(kgir6q2> zFnyL8S^G73a?sH$^W5vMkE{d)wh}Bew4U{h;l?NaCbIP^KqbWrG~p6cTLVw7&PqJU z#Z8{03C?8Y8LM;hQuaQOZ|Y&e9hP$Ey}RW2p#COqBVQ~K#q*3hxH(^wd{zd8oAD0c zO3yQNyEM-dT*cuAS#uEa3R;DGSu64F8E4NkUwe^<%lGoagllAtA`E6{tCQ#_Y`v#e zlIrOTYVOtdD&!!dQWfTF$+2%B87JaHYxJACKAVM~nb6ryNbIPy@dqt23N8_Eu+c`x z0N#7=EleP@7;wN7d86^}2E+T;#PK6h=j98s2&KoT`lJGd`JI?0=AFpF9^C3EuMB#G z%Abf<5Ssrj8pZ)SvE|7`;_fqiPu{RRQ;l!n4bSG!rOvBACWOace93 zj&DAB+x?;}&UjDv>sOR}9@sFm!;&Oiecne>!S$Y%)*gKEjy^sq+VM@g;em#H2c0P# zNB$m%2QFg4YDRwx4719u;t7H$wJXyaB} z(yqs6{~V{W3=-! z0NncV{a5RMempjdn*)dG+-hWG@UZSX>#ro$`53YUKF2x{3p{1n1$dL219x?C7u)!7 z3~QNLEjy`GVJakzUEi2qtu$W;t1g_l4G&l7k$Gn8Jc?72 z@GRo{(wN=c*AIAOy;FuNXxvfbZj73cvelmIOhG_f9=H1!r_Raq#@-f*9?;qklx{bO zkJg7?yc!nK&UgZo2zH^1yjAW~S%$N0S(*ttU@m2r=;;%of-BiHFP^`GQQ9bDezW>{ zj;-(1!Wxm4o=olC-j3XMuN*@71IBOTVTs(gMiK1HK0oY^;PS~vvnS^PjDLF?cr79R zxC|8f@^lO6vdf{3Cq_pIF!bcc<*Y1G>!jp-_~jlM!qpgZH#3ZVG%Dg{T>!&VLab&u zIiK`bO^F-7*sJx8!!F6TQM|#B94yl!HRkqb@(2h;wZA7esr(6` z40YrT5tD8U+P@>W48Ch7`3kWg=lI|xP6MSq^1SsIjE}ckC~wYYTE!4^l};i0LdEd& zE})iY2t|OdEZu24$c|pyy~UFeo47e_JN&OH z1nkk0nv)ww-GN>bTaXP-v%1S-b;Gqbo?Te3OvYl^Wz7-cbP0uDQZ{dYTvsYUqid*m z-~qBNZjSl3zlqzeK;A4#m;Zb2tL)8%AxbHBn*prs#@c5=>S>pEUl|nc)xMNAIK*{1 z!u9&1URH{*f{l=`ufZ;l5kRhh7W$`wPHgZ8-HFuzOOo7-;>icDSS_KsHXgThDO6{% z@3q$H90qwj?)DcQ`1w_&4HJNg9>GVy?;L;vS#_m=z+Mb2bAgbZdqBq9{rNnbC!G#0 zrgrBscmZCf@mcfd=pc4$*lnXW8+-R&A`y=;+*N)UeuGi=I)Y!uUSVb`vKPEV6PW9% zjLTT=Mt8&;gSRM-a#LxOy ziNmne(`s~~+M5X_k`l?3cc`8S`=ZOUT?XOQ{eyIcQJ~#!uzA}dY8#r(&k%A1;Z#Uf zgM{18YZCm3n!p*tFQJ374u=c!qVH|Cy{f#xb|Q97>2;LQt_831wW(K$Uv)bdJSb^X zmIUe@h={5t#kxW|{Dq7qB}7U^m~eZM7o#DWYD0JV=WW0C?0^kf-VOfcuP&*NehRuT z%j-94rdw}*h?$-}Go%S7T>3=T-}{3Vx>G)%FC`;v5gHlVI9EEPWwHLo>6``ClM(hX zg-VYevV~P3;qeCHJvdidKo~lRTp;DJMy!fg*X$Rz4rY*M%rm;7jB~@4Ir3@6qhLh~ z!sQXQy1(rexPrXGvEyCWZq7mnG&|MA;>#qq8X}k<+6w5$KK#+2(_$=raKX|}%WI>% zYCirfpwWvwk`x?%?C&zeJqeqB_!$<`98%f1S2d-V_mX1^jj zmU%LniAp+-su_u~NYic1czXQ9or>VnhutO@hWV8Rbt$53IhTR@4aUi#0?0wyv*+L`uJbsX?6l8@mIk>nhuVH;w0n1P$cvj&OD437aFg4Suk!nG+Vc{10#!31tJU-xL>mVVNb-id$ zPPRB96Bk_dE~xTrUTk$MeD3K>$Xw1NV7)5?{vxJRdhS&CL|NX2zETtR>}38#nc0QD zP$PFiC-=KXc{jFLmg#kJxnj|q*pE!;$(f3lZ(^ZZnAnm31`9h4s`U?kVPYph{|Od$ z9`x5g;KRfYhyD{R>=Y>9KY(Il$3g!E8zHGuZ;>jH7%Ps^LYs-}YlKoV^uKc;#HbVz z^fQI^2Qme_b@8`kWo2;+3Tx|c$x6yPC9;*os%gj-I`sOli{FRov4c6#{{NFCQcqj; zpQPz&tC9SR1ifihl7Eq>H?2nUFT(ZsRZ0FuiXOij$-juxt5qfW2WgBII!yXsi{B^f zv47)G(kW4`Bv$+HWSlxlt?+!@yq$x+u zVW^l;K~;RvF|vWYn!z5tbNhgV?Bnos&30o<-zlxf25_TdzAsi3C->-R5ETcNp!KJH z>r_SmxCkgIH_uLFpkYMbdqqt$#G} z9N+4>^+s5;g4T3;jc$HFo`EDZW$jgJoCC@@bNo~>6Lam^oi$%0YyOxbjgqn2djHk-T{#>@;_mCXOMV&o zI?O!*zJd+(v*;AkJn&{)8^h@|c8FP~CG`6wFAnC&Z1i_llHM4ezoer)7^+KQZ7Nno z|BaOv+VX}@+uqrfbS=dS*UIc@SY$2X&RbO*H9+OtZ5oZ6 zFiFq+=(dgZ@RWvHPDO*O20V;*j#KJ2e)Vtd9+qtZYB%a#n|I^dfun#rSN#Cwx(Qw{ zp$;P?IpLt)e5udp=N;vb7cDGIF=Xk!nv{$ZOD`R>O-Slh8GFvblz3T;We1ublYjKX z6MBkBD1p>{fp5KgkO>ELxun{R3zIWSlGp8%1|a+IoPr$r>}E9H>V(p1UZ}Ydrzd}D zsB*fMF=&j;?jaK1UX(1m$*#C&}d zQR{?TE1$|#-b%3$5UR}no>;-JR#0w&s-VEulvr%P@Sf=yA? z_5%U?y9bY%w-2UwR2`PT1HpePw<-q+muVy4CZ{ctr!bUsaNvK~s4h3nn+zxM9Az>c zZnMH616TwC-qsCCt97wqMp#Z9CA5wR6i&-ppPt^(fEk^3KW8p~%>pSjS7)X6HyI2S zIWcN4O&eX8^fJ++1nA)%<_d*_N?o&ihg#_yE?f&6&dJ6x0d$6GSA=c}n+?ZZ7Fg3B zCithmnceqsRJ#xOM}Kx9X`0eaHQ^kb-i{N!1DS{)?X01XqPAfnP1ae=q(W2Du8u9} zah{FA&hbXCycX}-MTA-9>PPIR`4*UVf=vJdpY5?+A#;$u1c#xh!)mF>!L+}UKaAlU zx(qm}wSFJ{f{?~agot5cL|WJH9+M7ikbr|N`@i&^B1m`x7go_$wi=gwp2yBizU-w` z2}?*!Mzg@_b9%>SmRf=gA6C`Tl{G$mzg^2fso~}*GNsCpbxa+T4+DsSYiPY~cceu6 z|8lKt-ogoXjMo6)&LD}ct)mnd*E&EFc3*y8URwA<)~MfJlB^$GG2>5m1~_xiyeTw* zBK@STF0+iB?|QByKRbRMm_En2?c*o4w`pB55;q@i!m;qajF>dlI>a|I(LHBhZ$x&2mhU{FV_SkP{BBkX zk{9J|z)h@lU)1zy9}=Vn$Ve;zF3x>(jD}@J6tH9E+RL_-vF1bQOZrm`WeuL zuvpl(%j+Kc+nIBME_RGdtghlsPvU|QmEVNw*+1E*vIzO0`>;;uI(Z-SXA>fpm z9V1AQ0OT4_-@QBR5<5pPH1n>*<+9akKAO!Y(RW}r~EQ{Y|^040npt*a)7-A znNq%ucEgVrHQ^TJl-KZEIJ3o+FRRKBUrIFV?uP<&77&%5HIW?U-3C?V-_xDu7LK&N?cD}!vM@|vp@dxe>&cM0^ z?N|C9y&g#errV89{8;N33E=kAd22}DVnuK{j!-hZJ6m(B=NM5|_>T8dLFJK!?Vz40 zsY?LIxntdE-LOio)_Sc@v4Z9aKfXLb5fV*akQ)0Sf>X{<&D+`_L4CNE;m@=v)w|8j zJJ%VgHV9)&{5I2@MZQ4m#i+c)SPBSkjDKh)uiC2WRGqUem%ah2SDxVBHMafA=rDXu zLaCn=fC?}_`0^_ihlj{HwN?L%E9=GJs(@9`s3buhyRVQ78_n0TiEKP6ywKy){QWkv z*21e9r=}5v7TbzU&~wj^A}!8o21H;J#vFIDwrJ4N?B=b7WQy?%t%A^>hedLZvx42O z#H?(@pWuYe-nB{Ntwq^;A*~SH1~U}IV)va8UkEP5tgmZO@Yzu>U-h+O5kc&GCd%Z$ zik1YiYD}cb|1+jB|3^&!7uf$JrZN9VO#c_y|0AX`|3^&!7uf%fX(;CZ8`1x_tnY6< zuQ&JGUd}wPi#7|YY-nz%wNW=wXN0)#DB-g8o#>RQ8rn z5njZ0m~?fW*9*&B1pLvJcmY*Y7_gKsO!9nWaeW!<8k`bo_JV${6BMdV_5w?}TK;i7 zeKPwTb*@e1uXr~)c_Ts2e^fHnxb?9gXH*QSE0ddhqR6N>+xC(#bzjsM+z|+On;2IB+;6iTO`}vWDCq(3eZsL5|NId6b zW8H5$vqYJ!waUkr3P!b;z@W#YJ-ha$c6G1iPeiOAh$M93AtL;Cmm*JB6X{I>&ypWQ Vcnc)%Llj;xzC8`~f%sp&`ak6f9ozr_ literal 0 HcmV?d00001 diff --git a/tests/testthat/pcalist.approx...TRUE..weight.by.var...TRUE..rds b/tests/testthat/pcalist.approx...TRUE..weight.by.var...TRUE..rds new file mode 100644 index 0000000000000000000000000000000000000000..a1e0dced1693b9f73aeb41c266d6d64f21295c49 GIT binary patch literal 8359 zcmZw5Rag^@3`E0=vA#tKV4 zE*cW8Iyq;E8}EVZN(HgOeJ+awq(OyW9sFL*8!hh|cm~W)DB8;a$(oP`oFWqbh366Njw zX?8olJh+o#%k4QcY`7S(JUZZ(?1(EI^}XPug){MWC5a8B^RL3=x&sI9$kKfEErz%N zyJ%1znldElZnpa!idM`$U&2S5Y5jH92oac&xJo~mKGgT(Eg-1oSKfOMc04evG9Etf&93Ez-#N|chLop z$CxX-td)gsO9Xz91~Y&2-m!PJBk@GlzPx5mVwiAL#n8HLc-mPr@=o-19r}lwX=!s* z@x{>TR058eIA!2F*9_fEv%;R!Q)l?zF{j7PWqMMQV^Gd@>RVT3i7TK-^5(L~$$~#j z&{X`@$El1ljf&MFa#QKH`I&pE46wyL-Goga!_#orVVvS&4!nb>s(`9TbG52?K9GFa zq+vG)hN=h2WnE)KyQhtrn!H;svC2-*gTKkHP)C!n=q(TkqDs4YAf}^RxI!GY%lCcM zPEwbj$GXI0AHFeD$*Wr2qsCh(llzmbil;k1Vn=0i7JhJBN_PbOu-E+l$=P3!7>f#?l67IRU8ITm zd_WT*w{qM0_p@22$6)+HN4bm4Vh6{&)5QZ_;?x18`%>V0&<~I3&IJ0PPJ_WX5uW^1037(hYozs=VHH#83!sm`Z?q z<(?f^!Tn&0zB>JE|2+`##!WXaZ5M}H@v^?rX5Bq|AWFdE@V}5(X>K<4wu&Sx zkcNs!q+|;qO7i{yPkMX)qLTb&dSKn06CWJtSht$ij_@`kpBuv*iOUtTWZePIL%hQN zpjw9Q+hTkBhDI5S%=u@KgS$%>0@{MX%;4$#duxnyidY?-BMk~J;-=PnsED)4xrUvE z9Z!g)E9v0b9Q4iF&w&;GqB@-|U8OZX?Vd9SW&~-M5Z;^_iJm|ZIUt#X56$vD_CcyA z>4P5uz_J7yHFB!v?r#T(?}){^BA_KQ9paB1);0EfMTYD{UMICRk&Z*BRN{9rk^{7x zlE>2&%UOCX_fw2DUR4$Zz5txexWBZMg)o}=S+ge@gedE@3BLicEu~RAkL;<@8J{%! zC{arFnze-c_Th!1RhwE!{TS#R9vfD*o~=c)Ti{FVMEMxYc3d@Mzjv}L>|9tUkLd^u z-;rI^o>k+!pd~LGm~vR}q<2jRc57}JHGiPKqT&k*@+#t7%sNRV;f){Y7`WlZ_HVVE z_tf^>cc*3Tl7pfn_c==ToHKga^dnXb4F97nNhF#0W53X4C{(`*zum<5^#1te2lQy7zDI4DhR=!S<5&O+C^N3^4 zolBc}I}sgcv(mF;oQ>8O91xpdBM1AG0_XN!m5acjbq6VV97@$Sm~k7fMO^!J$vFR@ z#9_MW&vxuUGIow~0rhM8si*a$3 z5^jO%Y2^Na3f1&whwx^12oaei{<`%1*Js6b@3@>z_rlBgsr*nx4Fp=;W} z*zlAvAYByr)7-MiSmO=r-fHKNbqS$RO=7(`gH1Rhm4+?yqkDmGeEjI}8q5Q|N)lYd zWnEHBsCgSp1K8Q~Su6S=MR8fDvF{%Pw{O|+>98X|3_WNom6d$Wu|0OTtIyY`oO#5| ztE+G*MIkWdFe~};v+HfZ=12-r==+(=OW%IW0Z07a32ygYgRR6H<0;P7!X>#S@=rw= z*PlGJrOs$N4RZsfj#Phb`&j6J=RaHLMoJ82Gfj~5e6Mns^Lp8#zImDvvYg~Y|Jhc( z90^{n>a+Nyf+xh~%fIf<{K~@ZqKlWOnM7%y%YX1D;LKskV5P(_SuQwY`DnuhD-GQ^ zlPi)dRd~^3rMGaxVSl&MD3RkfSgI1Gpbh2{F%vH)ZHHoE1?7WWJ;%R{lEweLgGt{I zMKf}DX%H7kcKtBX`}>+q=_b9Q7|4N|8I=f}6F=OnaytAf^g3k{q5kd0lLFTe^zJqXGbm z`*g=&CevH$lSXA3G(}p0LvfCAB^4y>B@fT21}gbR&Cvy!J7}L+^+yW2=`NC^nmC|`@$EXb!CRZDVwqLfL9v4)I?%=Nv@Cy!1St5; z;s*JJi+0%-uBlX;xhw1?tBmA(p{*Cbn%Sg2#_L-6E_p@KsTegDU%GV)=s>Zso6KgA*oTq!=!;~_LS4+)enj}tpC|& zVifbZsMUdzx3lgy3D8#dn47v+@BLt}Y0aA=GDHe1fLCjUhNy4b3b#(G(+mw7eyW%T z8XZ}Lo(5Qf8xR1x69W!DV3!%${2i_oXFzlC*ZEMbS1WVXMm;w8O*XJw`&Fe{N?fqU zqFiswd3?-qdk~HRy6bm#VbFHF8q(lKdQS~}9N1B1j)QP~UZmmVEyy!mV(PAk)HTKpGMmP$7Se`xwtg#GDE=1PDcDQ zU#KCc+Z2B(i)3DUOfvru#nX4)wNU!umalnJP7tN~1+WE_qX&#%!EGl+x)}>A85%y& zki?*+mjrBQmK%BX6sgPHzuC2rLUI$6UsjqU@emSp&v@T_t7rWfZFDhf!vOYez*Bj3_cFXk_=6v%fXczj+ks@L&Q5iuKLyKHp6-ZVm=nF|7FDD?_d+(c%~_Dpz!ag6dxc5K1eI30 zQ$YTeakputho$u`A3Kd*akXBS9JHa%9k%P{IV~>^j;u+EAbKhxo@WrQV#xrw}|Zs6f&N>(mAJu)VUB|moe&P_l3ocys%QWa+(VZkK9rXCAPq~@&Wjbv=*Evo6U~Zu^3w^Vloca4^Cu#gi^;nnb(^-PF*JrhC6&KG_+zPJY22w57yt04 z!@_muy;K4une;FfD!_p{Uz51Hz^K1y)Y&1Yf1hDovgf_;7u3#=ZOG%y*9Qt+LV zKr<=9%@l8`wjPux!Wt*Crx)J(9Y{3l9n!D$IL5<1ANmV`etBO|-4BA8TRk3#t86}q zLVLBN!}sIofElqUTVU}CJ4~zZ`&rjmV7Jcn7=?kDph3Jb*)bql{VXgm^#FLx_$=O* z`<=7FNnatI$yn|)YWt8CQ-2Llei1#v%=R^l{!_K`IjA2J95(*qxG`RK01N_0BIt2{ zWySpJ8(~nf-_tnhUK_m;{*;Bj-B^^jm)OJl!Pc^D(+PmKc)s@Dc)4tQBm6RF;m50c ze0ZI>3@TjdK<;7 z>yT|D@upP9Wsjv7Tr)(j*BUj9!h9_qECaox^46^0u~j$5iy#y9+H=Fw{ZF&u4g_9K z`_jb+n>u{w9lhtevQ+g7@eBRoHikM4LY%dEfuh=lozB$I%i_Qi=90hb2@>CVUFz+x z-omF5=c`$gCR+7@eWLRW3H)yb9<8`F2^)GiTaL@na-Z%m!`A(oRnP86l#6EV58H0i zHa-$RW_qZv4(b>D&3^H#1lV0j{-;q$XP; z9Jj*N$an8IGlzLg1js%^NNStXh8#lqg$`1jnPlM`JrmoxdAwq=gR6|K^b_o0ZKmn9 z4vthvn@-X}@v;_bH8^*{{!Auoi3_8x@(8z<-sjqKb+T`5-7fx8i#48Zc^&;Nw`Gd7iONGLPq%$XpQnd@c9IhCW1PIKeQ{zz3~Vl&@jW=i zQZU4uFG&^(N@R`7P1N)gM-^MU(Hk#izf7cV@$|UIbo;d{*aC2H&{vPHc_W!`dW_)DM{HB>>fE%`-QZ0&s`CvU zfBWO3mfKZMRQ49EC@4r;&1eIXh(y!d%9tH6{xWq2Q#=m84U7^#E&8Q@s2?JAeA1lw zRmNA#A{3@G&c7+!au~vRuXWbh$*_{hZ^3@e#w-$>Vt`|z)#CbwHLuunw(mxyhu8S4 zW9UjYQJ+q?G&Y-+n!dFw>Uc@39e#Fub&>PF8>jtPG+5R*p7g}z-PR;|MLa1^_o+ON z@F@9jWCw0$%>Y_90Z=3n$xn z_1+}m4(d#im~p*SA{!U;#AWT|3_L|U1<%TkX`q!>davW}g>_3%pn@klieBt}WY}Mj z6CyG; zE31F;hK$V0>R%9(iC9_vgKa{x*H-_8h>Xu_`(L~vqqExnA2xe=tV6GT)JDqWK1xth z+SsIg`|weOQru=Y<(r=Vz~+-<#ep_Sq6QopQ;i6e|})s_tyCrLk#+OI{$=4 zUtMSDUoh$O=nVY}HhpKEp?|@sPop#RFIe@>bcX%~v%Zwh(Enfq`}DNX`V_3mdpR}H zZ`yq2bl>vn$pwOPy17UOUE*L*BtnuTvMP<&D4(v{Oe_Vu-nIqpLQ?QZpwJp#&DikD zzlKaEbyRTP66?Klh`+?=0#Q3b?7U*^juYp0Ttl8#*)~ojhJns?)j0drkGn3fnm<+S z=<_QXa#0@w^~bszk-aM!^avJJjCWl-1T-clXfY7Q$^H}+GOu$QAw?1=U6b(wXZ z4O>i{6z(LN)02oy0rplNl9>T+)5+hoFU6k6dSYLllwbTpcPy;Q()oW0d9A{3BGI#5 z39_gpf@lKG2J1@RPX(WKZ`VnA7)nGttuE0^8(@gvx&eX({S;K$M4KY3@nh{4xm4*q zVk+~yZ#HXj%67Qz$$g0P1ENs;6R!ue2<)Ok!Uk4@r|_B19zS`5B`PZjo<~BKlT*3y zWg&+2k+lRR?sWLi*s}a`F+@bP0wQIw`zY!yu}awYWDqBiTgSy=Xh?>owfkfV)MCxoWbL8b@KVl0DG5>sOUd>2JfQJN)x(wHw(?=^-R zGA>-`AzKr;JxbX~@k;{Ul9&eeHWIO%Y>ala%@B4sUxDU(eFpDlYE8YPmVUs>QMD-= zIgDzojUfnXwFHwnAc!zuVUp_Fqp~Yy8lIh&?g2CF$_jD>H36vEG;v(_b|ILK9D&hG zErH|hbVn&Hy%c3e5BtfcdJIpg8NK@366zZ!Wk2Z{!8o@rn@Ok2OFT+d0CLO^Z z;m(XTzKSihZ0?n0+<@PGzXd+K&}+YuVytTL9Nobryi!~#3wL`#SzWU@2k4OdZjV6t z+;I!|8-I=Ra-;S?rt1+Snv805Sg;uWz*A=kS*gezQK&GqRmooA9uG|0D>|#ek~dMB zr5ZOT^h0`lCk2q@J;qE{@hlGL0X`R+&QW|V@(juinzvT&SL4Nh!RZd18gwc2y`Hfu zZ|M9H$HsE{>A|rEfnE4`t{0`uJ_vEu)YG1gFq-6TlsT~U4;U{Ds#~P!dXcp%pPW!o z=GBXT=rjmN*L7bfvU)dmeUr}VEp2KC_RzqshENDFw!8Nv0U}U4Q@{GQ= z^668Pb(oP@)xC;oKxzGdr!>^2y>+`Hc@&r3OnT{wD%g0JJsp|Wm#x>WIe5ej#paL< zxv@c(W)pnke4+6xTtJ<^099(vK{2;9;ov-K%Fdv&y?{QEj2z8MO$_eTs{q!@_ph#> zlo8_m-sBUNYqcSctS}Zofsc z615P|1T4`8n1z1!Y{YhJ6Ba2lcqsgv)Y!0LhP%?k7*y1C*nQEfI1t|BLUCyyVyhI( zCDp3hl`mjS#~d<0Z}CPfI=PSA`btnOVJcJHt^>r#rdWMfKkG-N)y{Nj=yWRA<8eKo zyDkv(M}OjQz48n9++qptP5M^+C4RF9_UyDaQvl*lQ^((@-iP#IORw?96GuCb0Rw(v^xd&HEY+hQBvU2B&g^s^z{j53y`%a3_nU3_{r|NbNLF53`G;3Rmbrzy8mG?&`kmqk z1+Sbp<8D;9ikRCcMy%*|Pu27h#9Gf_UJ4mY%!(+?iE1UgJSiK$lUfsLCHjlWn&XB) z63-b^@N6R%jMI)Y2J^w_<7A zZnxHW>6oIxJZCEhw@C%s!Q*0WK4%a6l7}#fZ5zAg0A;FAPV^U5VY@rc@XR3HF!IEV zjqP7beV*Qb5mTrzvq3 zzIFvZ@bRjB!aki>ji-kGj@R=UYu?&rj;at|9 znh?)CG(+{$>~*PBi2_nY947qLRa?MC&V$&D%hP(oAqTU3b&A`O^p=u-}SBSBrigj z(Q98aor_YmfP~DcjokYon4V4SVu`g-5-=|6efi@bvfp3pO6-{{DZ#$V1cL|1Vg1%=-KP1v8ISfB*mRL}~c6vGf3d zE(ku-7*?)GE*od(N@V9gNcTS;{{{3udkTCA5K#dtDFF?ei;_ZV9|)Fu=?9M7jQ=WG z%_uDTvJEeW(q1K3Kh^w!u`1F)#>bN%Om4;)F_^pbTXU*?Ed3p|-v?sTNAq#0({G^m zrm#c66Xs7<_ekjYKMDQq6?eo=HZgtT|0MkDG^;(L{_oR~S8SHaQ^$Dk z=>6s(+&iSX^cMipKD<1FPG%lF2}KCW*gQgQ-w3~z{bPA@=|}pcpIDbzTy#`x!uD`6 zh9cMf;&#bTs&cyoUxR7#!)*>OD@T$jC5@=oa&n$Z<50lRt)V5O)x#$r$m6E0)yWgV P1HEh2&4H=FvuFPYCv}f? literal 0 HcmV?d00001 diff --git a/tests/testthat/test_dimensional_reduction.R b/tests/testthat/test_dimensional_reduction.R index 711d22ff4..96a745210 100644 --- a/tests/testthat/test_dimensional_reduction.R +++ b/tests/testthat/test_dimensional_reduction.R @@ -144,3 +144,44 @@ test_that("pca embedding weighting works", { }) +test_that("pca reduction behaves as previously", { + # Generate dummy data exp matrix + set.seed(seed = 1) + npcs <- 3 + dummyexpMat <- matrix( + data = stats::rexp(n = 2e4, rate = 1), + ncol = 200, nrow = 100 + ) + colnames(x = dummyexpMat) <- paste0("cell", seq(ncol(x = dummyexpMat))) + row.names(x = dummyexpMat) <- paste0("gene", seq(nrow(x = dummyexpMat))) + + # Create Seurat object for testing + obj <- CreateSeuratObject(counts = dummyexpMat) + + # Normalize + obj <- NormalizeData(object = obj, verbose = FALSE) + # Scale + obj <- ScaleData(object = obj, verbose = FALSE) + + # compute PCA with different values of related parameters + for (approx in list(list(approx=TRUE), list(approx=FALSE))) { + for (weight.by.var in list(list(weight.by.var=TRUE), list(weight.by.var=FALSE), list())) { + pars <- c(approx, weight.by.var) + pars.str <- paste0(deparse(pars), collapse="") + expect_known_value( + object = suppressWarnings( + expr = do.call( + what = RunPCA, + args = c( + list(object = obj, features = rownames(x = obj), npcs = npcs), + pars + ) + ) + )[["pca"]], + file = paste0("pca", make.names(pars.str), ".rds"), + label = paste0("RunPCA with ", pars.str) + ) + } + } +}) + From 0730374f5b16cda6a93a7b92b2fbeba8c009c164 Mon Sep 17 00:00:00 2001 From: Jan Gleixner Date: Sun, 17 Nov 2019 23:43:33 +0100 Subject: [PATCH 3/3] fix scaling of PCs for `approx=FALSE` control behavior through option, default: old behavior, warning simplify implementation --- R/dimensional_reduction.R | 101 +++++++++++++------- tests/testthat/test_dimensional_reduction.R | 4 +- 2 files changed, 67 insertions(+), 38 deletions(-) diff --git a/R/dimensional_reduction.R b/R/dimensional_reduction.R index 9a0ffad67..30189474d 100644 --- a/R/dimensional_reduction.R +++ b/R/dimensional_reduction.R @@ -799,44 +799,71 @@ RunPCA.default <- function( approx = TRUE, ... ) { + if(!approx) { + pcs.name <- if(rev.pca) "`gene.loadings`" else "`cell.embeddings`" + # Stage 1: + Seurat.RunPCA.use.correct.scaling <- getOption(x = "Seurat.RunPCA.use.correct.scaling") + if (is.null(Seurat.RunPCA.use.correct.scaling)) { + warning("If used with `approx=FALSE`, RunPCA does not scale ", pcs.name, " correctly. This will change", + " in a future version.\nTo switch to the new, correct behavior now and get rid of this" , # to be changed to + " warning message, use `options(Seurat.RunPCA.use.correct.scaling = TRUE)` or use `approx=TRUE` (recommended).", + "\nTo maintain the current (wrong) behavior and get rid of this warning message,", + " set `options(Seurat.RunPCA.use.correct.scaling = FALSE)` (not recommended).", + "\nSee https://github.com/satijalab/seurat/issues/2237 for further information.") + Seurat.RunPCA.use.correct.scaling <- FALSE + } + # # Stage 2: # fill in current date for yyyyy in stage 4 warning + # Seurat.RunPCA.use.correct.scaling <- getOption(x = "Seurat.RunPCA.use.correct.scaling", default = TRUE) + # # Stage 3: # fill in current date for xxxxx in stage 4 warnings + # Seurat.RunPCA.use.correct.scaling <- getOption(x = "Seurat.RunPCA.use.correct.scaling", default = TRUE) + # if (!Seurat.RunPCA.use.correct.scaling) { + # warning("Using `options(Seurat.RunPCA.use.correct.scaling = FALSE)` is deprecated in will cause an error in future versions of Seurat.", + # "\nSee https://github.com/satijalab/seurat/issues/2237 for further information.") + # } + # # Stage 4: remove if clause below + # Seurat.RunPCA.use.correct.scaling <- getOption(x = "Seurat.RunPCA.use.correct.scaling", default = TRUE) + # if (!is.null(Seurat.RunPCA.use.correct.scaling)) { + # if (Seurat.RunPCA.use.correct.scaling) { + # warning("Using `options(Seurat.RunPCA.use.correct.scaling = FALSE)` is deprecated since xxxxx.", + # " Specifing `options(Seurat.RunPCA.use.correct.scaling = TRUE)` is no longer needed since yyyyy, please to not set it anymore.", + # "\nSee https://github.com/satijalab/seurat/issues/2237 for further information.") + # } else { + # stop("`options(Seurat.RunPCA.use.correct.scaling = FALSE)` has been deprecated since xxxx and is no longer supported.", + # "\nSee https://github.com/satijalab/seurat/issues/2237 for further information.") + # } + # } + # # Stage 5: remove this if clause + } + if (!is.null(x = seed.use)) { set.seed(seed = seed.use) } - if (rev.pca) { - npcs <- min(npcs, ncol(x = object) - 1) - pca.results <- irlba(A = object, nv = npcs, ...) - total.variance <- sum(RowVar(x = t(x = object))) - sdev <- pca.results$d/sqrt(max(1, nrow(x = object) - 1)) - if (weight.by.var) { - feature.loadings <- pca.results$u %*% diag(pca.results$d) - } else{ - feature.loadings <- pca.results$u - } - cell.embeddings <- pca.results$v - } - else { - total.variance <- sum(RowVar(x = object)) - if (approx) { - npcs <- min(npcs, nrow(x = object) - 1) - pca.results <- irlba(A = t(x = object), nv = npcs, ...) - feature.loadings <- pca.results$v - sdev <- pca.results$d/sqrt(max(1, ncol(object) - 1)) - if (weight.by.var) { - cell.embeddings <- pca.results$u %*% diag(pca.results$d) - } else { - cell.embeddings <- pca.results$u - } - } else { - npcs <- min(npcs, nrow(x = object)) - pca.results <- prcomp(x = t(object), rank. = npcs, ...) - feature.loadings <- pca.results$rotation - sdev <- pca.results$sdev - if (weight.by.var) { - cell.embeddings <- pca.results$x %*% diag(pca.results$sdev[1:npcs]^2) - } else { - cell.embeddings <- pca.results$x - } - } + t.object <- if(rev.pca) object else t(x = object) + nt.object <- if(rev.pca) t(x = object) else object + total.variance <- sum(RowVar(x = nt.object)) + if (approx){ + npcs <- min(npcs, ncol(x = t.object) - 1) # irlba does not allow computation of all PCs + pca.results <- irlba(A = t.object, nv = npcs, ...) + sdev <- pca.results$d/sqrt(nrow(t.object) - 1) + feature.loadings <- pca.results$v + cell.embeddings <- pca.results$u %*% diag(pca.results$d) + } else { + pca.results <- prcomp(x = t.object, rank. = npcs, ...) + sdev <- pca.results$sdev + feature.loadings <- pca.results$rotation + cell.embeddings <- pca.results$x + } + if (!approx && !Seurat.RunPCA.use.correct.scaling ) { # to be removed at stage 4 + if (weight.by.var) { # + cell.embeddings <- cell.embeddings %*% diag(sdev[1:npcs]^2) # + } # + } else if (!weight.by.var) { + cell.embeddings <- cell.embeddings %*% diag(1/sdev[1:npcs]/sqrt(nrow(t.object) - 1)) + } + if (rev.pca){ + tmp <- feature.loadings + feature.loadings <- cell.embeddings + cell.embeddings <- tmp } rownames(x = feature.loadings) <- rownames(x = object) colnames(x = feature.loadings) <- paste0(reduction.key, 1:npcs) @@ -861,8 +888,8 @@ RunPCA.default <- function( return(reduction.data) } -#' @param features Features to compute PCA on. If features=NULL, PCA will be run -#' using the variable features for the Assay. +#' @param features Features to compute PCA on. If features=NULL, PCA will be run +#' using the variable features for the Assay. #' #' @rdname RunPCA #' @export diff --git a/tests/testthat/test_dimensional_reduction.R b/tests/testthat/test_dimensional_reduction.R index 96a745210..b03bb437a 100644 --- a/tests/testthat/test_dimensional_reduction.R +++ b/tests/testthat/test_dimensional_reduction.R @@ -60,6 +60,8 @@ test_that("pca returns total variance (see #982)", { }) test_that("pca embedding weighting works", { + #test new behavior + Seurat.RunPCA.use.correct.scaling.bak <- options(Seurat.RunPCA.use.correct.scaling = TRUE) # Generate dummy data exp matrix set.seed(seed = 1) npcs <- 50 @@ -141,7 +143,7 @@ test_that("pca embedding weighting works", { diag(x = cov(x = slot(object = obj[["pca.irlba.var_scaled"]], name = "cell.embeddings"))), slot(object = obj[["pca.prcomp.var_scaled"]], name = "stdev")[1:npcs]^2 ) - + options(Seurat.RunPCA.use.correct.scaling.bak) }) test_that("pca reduction behaves as previously", {