From 496959d9f228ef4cde20015562d310f5395b5976 Mon Sep 17 00:00:00 2001 From: Sam Rogers <7007561+rogerssam@users.noreply.github.com> Date: Wed, 31 Mar 2021 20:21:53 +1030 Subject: [PATCH 1/6] Removed coombe --- data/Coombe2019.rda | Bin 4398 -> 0 bytes man/Coombe2019.Rd | 30 ------------------------------ 2 files changed, 30 deletions(-) delete mode 100644 data/Coombe2019.rda delete mode 100644 man/Coombe2019.Rd diff --git a/data/Coombe2019.rda b/data/Coombe2019.rda deleted file mode 100644 index 237916d12237b82faf0bf642cd243431eb9d1744..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 4398 zcmV+}5z+2KT4*^jL0KkKSr94__W(4+fB*mg|K(MG|NsC0|NsC0|MtUV!Ejk6NkCZ! zX+UW#Z*AZeUEJt|2eUu}eJhsu6aa?rGnX;vn*l%o002&%dbyhH+oYY3IAddor-%R` zM8Zr&@@b^ zMujJ&dW{Cu0iXe+(s@rNr>Fo8JflW{&;a!SdW{V>plAR905oViZ}ljjssL%GfEsAf z&;S4p7>t0(28MuS01QJ$fN7x641mbc0|c2$R7!rR00000000000000000000000^Q z0ThIqXb|;DwKkrjJxvCNnlucD=%Yi_82~f^pfmxaMuSZ>GyniJG(Al;&@=*~kqJFe zZBHb6k&{QEwIg~WU~NKrH6Ev-Gf-#%G8jRi#AGzk(8w_ZLqHldG||0qWAiWu`1fGT zfH1$t%~e%ZPyhe`0000H1R(&DAqWft0ndbOp}!)yekn>|r6w+2T1n4i6^XmWD{k?Q zwsVXp?R2%0tm9gdjT*zwMeVg)p9Skn8eWF5t4`_Rk~Zf%m0#4IY^swULgkCsbA`i=i`npM@Uyyfc{gol#xo~fmFdvHd3mFozE0W#IUW#V%l~OJr9lq0NCtNH#1|3KT8|kbIjVDKbJagC!J5f&?mvAdXOK zm}o>)ayd#;i`tnYAtj6>DN0Y3WS2p+oaZ^JZaK~~8Av55N>7xfDJC*trYV4ky;*CJ zPy=_C6%l|?E;0lX0JZs>9MV$3SJAY^EBwb)Ozz3p9?iMcfds`8Myxr()W~StELOW= zdek!jwpuycIvOj6lrkEY4#f}|2#Hf?b=^LB&yKV=9l1NJTP>~AjuQ|#x5#EQ5E02O zgq}wPlC>hNms6VGiF(Ad+m|^u1ZlH~fj0I#M(d4UYXl=Z7Ar&;T-@B=$#DSOKv~Ud zMlsJ*CYZFc1Uk$>Xv)n}r$$VufxC3-AW1k`)nvI=q6OSQRjf@hw=)nFKsYKOyrfaP za*AP6HnXmZU{W)-{cV*gn50rlZD^neM|gKK!hlEx9)fpJ@Of@B)T4+G(CD7y^k_<081{9!&*1dXjv z9dNu;{1UW+nUapfswaXh#&q7S!VVhD{)O9$T@j~FrR5prIFT;T% zi3rnX1QdoT3<#*%Q%%`_raK zzDB3U?Nb+5aYQIaV%?x9YR+r2Rv>dB0nD;5%fk0Ur86>%j)hfSvDfb+D^jot*Ig*b6Hfvw8c(B&_H$yGP1Kv1VY71K_$M*ZM>W{+`(D0<`d34 z!GAIJ`kt>Jqw#xv&s*bneSeSgK2Lk)e7|GA*2(Pr!0>Ie=KEhe!|r_l4~xW~A6-Zo zsJv`17|*EI`>cdw=vO9vFQ;Di??t1r>A3@Qv;awD+eZV(1nzrcF?K!1UGkntT~q{j zd$35t5RvuvF$84r=_3(hBv6nlKoD-pe(kbH1_fO7%x0n7(X0n7jyO13J-%bK4CIq2-9$i9G0kvL)s zVUZCZGxI1Od#b5F5rO+JlF40Cu$k1>!}*4M-8^w+`O| zA|yq27jI6LLo@=Cf~zM5RLj?N7qt^HqN|KSBvKLQ$syFl{xU?lL!-4zdK-nb48+5f z9V1SrGZu*&R9%TEfuNlbva~2PEGjb!3Nq?NDr(MT~-K@w>*FdH71Y;Q>oNGnu2 zN*J7w6&qC61q@KjRUuVM#0;WIG}J^)h=^vF1mG70nwqrAR*0cui5M$R(qPjPE^Gi* zjg5+$7Y=q^B7&HOt%77(+8sF3)XJlU+DuH*K*$POQVGQDBO^i;sGzDDakWKBXclrL zqcRJ&5vim_nW|?JY@<@BgIF@HwFR;R7DxsK9Xk@#BTAr5Z2w2~f zC`v*S%Dpu}AEazi+>wpSAVhNcej~eF-zwYk-ap*Pp_MpHj$Ws=GLc!d+#$;php*jI z(#A)+XcHhA#7b%~pePP3I)4i9S5pya?d)OA<86;)XOf-0anIXw+`C4jSiM}fMln39 z04N3kQ9yct3T{D30+_){C=OP1lzTif6mkNP3y&nVm~0{|)JofJx+Ac_079<71t!TA zVq^{CM_viONTAI@^obM)zUS}^XC%}}aq*Znk~(~YKm(aoQcMb}aDg84250ftewA@J zT3-H7Zg5EB#M4W_l_9qv%JxQKnD7fAf>@_B!21EN6{cHQ#BMC!5o+vFJEtYX?wB$LGr1D%)j2K~%i5Mp799=18=W zWJUpEaVaFgERi_2L}CR*34nGn@*fvq!MDGEO8r&wuEzHztqxPhcZoZHRVcnU)t%7c zD++Q#aNrRk0|77)pvHnS1@7d@lTRj0nK5L^lds>&(!YPP=kH_Q-9b%~9_`O=--BYS!+oLb{nRwh+$R@PE1b#;{o ziL^dLZbOv0;ZEieIZ9mgN{h-!gnT7%`S4c>xFs3uTaJuH38+4!HH`yq*3pDrNUiAoPjrBNp@|h6TauaHnx? zAWkyl3yiqSC#sBan`6`JE$b%LVjC5vptd9-5mzu1IlJ`_~UCG;o=Jl@VQSpUQaJk`HDeApw zJQKstl^*N4VdhSIy*&%O@h%YL6yfKePY|Lia;xQcT=3J+b9axPdTu=zioEcg3EcJ6 z)j~kmqUX;zR8zToxg=MdqKl)VOkCQ#g{Iwi4pO;#c<#q2ijQ>r^-5MEQ<(HCm*A>wm({OVV&7|&*>l}J16coyLmC?#4J<%w$5AMx zq(oeZxm5HaXD%1ek_(X(U6pc4D4=>!k#f1ff+)UL7cNwC<<1mT6kMX^TzL{XMMXy@ zTq@;N!md?O2W3!DRZ-5$ia1rm4n!42!sP|XsOM$EiVC@MDj9O@h$6U0Wy+!`;c_Cm zS12xAxpL*pmo8kmT%e$)7ao@vMvxlEJ9B|W6ah&M$;pMni?o>Zc?XHSOcR#`;GM3q z&c{8`l-OJf0qAy-K=OfhS1LP1p=cz{kYrUe>O zL$D-K56noUhb)o7ByjSQCMqGhQcagbfOiCo4ohQ|%5q-s9K2&hj*%q1B~G3vy9whs zOiEk!06D-!0v87}%_rsev~?OccXxG+uimdWkVyI-$dS58(KT_g^NAUfFntn59AZV2 zd&a_LQR!JG`t7$koA~Fw!nU5%$$NZ{>~K4Bq?6^hcrNZ3Za6wotv+@|838q~H1s#!5F z#%wmJv$9Cbxg=wxBx-IFH6w4?q!SSUpgdJmsnh)U6XJ0Gs`$RAQ9Cs0(dlE4^J%;y zl~hoT^y(HwgGwY49C#~kMRoiYi8*nD*GpH&jkk)*==9^JeNRjvU#eZ3mgPT~@ad}k zp7Pk7pucR(K_&Ed-E%xFY0%YXs z+l{Y1OAxeSW?@KIXDJIUDGgKwE1J46p~D3!N4R@lABzOtv6oW$dSXtR1Oyd zUmksGEhQ)bfWcrCT`D>C&(0uERE)0z(+Etwu%e0r(V#g{sNRHK3`S;XDYx$8;9H2* z0+Ru`mlS3mtPZ3U)-r3VN?QVF5llFCS@?RY`m(T+Wx_pSBiPK@M9-Y~S+Gdi+|$A& zZSV;llQ#dxy_PT=U?2h@ARFAxZGQ0iIf?Qw#p72J3Vsc)e7)FjIh`;S^a8He5=o2i z7U7X;adNVU4lkv| zOihUu4KY%sH5?*H7{O4yB~>$R2wH^NSwmVBpd^Z+HF0?zQVGJ%%yQ{%rneXOlZ>mY zbc%r4mI*CsPOycH0>N@d7{UZ%OJKQ?dl@w3K08_xwSg>}m9qk9b{RG<;@aVVv#Z?g z@b|cQczAew+&nnFj<2KA_G1)DL{SG7{^!Or00Z*zZ0rkDRE*uBQ?9>#2A_GEDVy=ovLd zT9s4Pkl3l$R^<0Y%Jf_Kj6?uGDI}5!01`wLR7FJ`xKRXL=Qu?KMO6@7s;a1{D2in= ze2+(?$>(ZoYbT)&k3(ygTO89~!#Xo`BBdK7B;9?TotXGEfG7&C(wjHI;cY3VW=Wf8 zJq-N}?Ev#MN49z5YXde9aT+Q?s1hw}38?N1L`+!FKy?_OTClKxw`ZY`9z1yQ1Ja;( zrT`>FM|;2h?eFdQSoD4!l1KgZ3H96+p))drExDJw!@jY*urU^uoto5ZRq0e1Qxa*0z zRn8FhuSYj8FN_))+1zxJ#HdnG1c3854XJAu2+wNKx1+YkC}KgI&eFU+aS!?dKwd{0 o?<)?6As02(=jYzD04Q96{h&+GE6I?j{7e5Aaz!{$kPs>n_k9QR!T Date: Wed, 31 Mar 2021 20:23:53 +1030 Subject: [PATCH 2/6] Changed to lowercase --- data/coombe2019.rda | Bin 0 -> 4398 bytes man/coombe2019.Rd | 30 ++++++++++++++++++++++++++++++ 2 files changed, 30 insertions(+) create mode 100644 data/coombe2019.rda create mode 100644 man/coombe2019.Rd diff --git a/data/coombe2019.rda b/data/coombe2019.rda new file mode 100644 index 0000000000000000000000000000000000000000..237916d12237b82faf0bf642cd243431eb9d1744 GIT binary patch literal 4398 zcmV+}5z+2KT4*^jL0KkKSr94__W(4+fB*mg|K(MG|NsC0|NsC0|MtUV!Ejk6NkCZ! zX+UW#Z*AZeUEJt|2eUu}eJhsu6aa?rGnX;vn*l%o002&%dbyhH+oYY3IAddor-%R` zM8Zr&@@b^ zMujJ&dW{Cu0iXe+(s@rNr>Fo8JflW{&;a!SdW{V>plAR905oViZ}ljjssL%GfEsAf z&;S4p7>t0(28MuS01QJ$fN7x641mbc0|c2$R7!rR00000000000000000000000^Q z0ThIqXb|;DwKkrjJxvCNnlucD=%Yi_82~f^pfmxaMuSZ>GyniJG(Al;&@=*~kqJFe zZBHb6k&{QEwIg~WU~NKrH6Ev-Gf-#%G8jRi#AGzk(8w_ZLqHldG||0qWAiWu`1fGT zfH1$t%~e%ZPyhe`0000H1R(&DAqWft0ndbOp}!)yekn>|r6w+2T1n4i6^XmWD{k?Q zwsVXp?R2%0tm9gdjT*zwMeVg)p9Skn8eWF5t4`_Rk~Zf%m0#4IY^swULgkCsbA`i=i`npM@Uyyfc{gol#xo~fmFdvHd3mFozE0W#IUW#V%l~OJr9lq0NCtNH#1|3KT8|kbIjVDKbJagC!J5f&?mvAdXOK zm}o>)ayd#;i`tnYAtj6>DN0Y3WS2p+oaZ^JZaK~~8Av55N>7xfDJC*trYV4ky;*CJ zPy=_C6%l|?E;0lX0JZs>9MV$3SJAY^EBwb)Ozz3p9?iMcfds`8Myxr()W~StELOW= zdek!jwpuycIvOj6lrkEY4#f}|2#Hf?b=^LB&yKV=9l1NJTP>~AjuQ|#x5#EQ5E02O zgq}wPlC>hNms6VGiF(Ad+m|^u1ZlH~fj0I#M(d4UYXl=Z7Ar&;T-@B=$#DSOKv~Ud zMlsJ*CYZFc1Uk$>Xv)n}r$$VufxC3-AW1k`)nvI=q6OSQRjf@hw=)nFKsYKOyrfaP za*AP6HnXmZU{W)-{cV*gn50rlZD^neM|gKK!hlEx9)fpJ@Of@B)T4+G(CD7y^k_<081{9!&*1dXjv z9dNu;{1UW+nUapfswaXh#&q7S!VVhD{)O9$T@j~FrR5prIFT;T% zi3rnX1QdoT3<#*%Q%%`_raK zzDB3U?Nb+5aYQIaV%?x9YR+r2Rv>dB0nD;5%fk0Ur86>%j)hfSvDfb+D^jot*Ig*b6Hfvw8c(B&_H$yGP1Kv1VY71K_$M*ZM>W{+`(D0<`d34 z!GAIJ`kt>Jqw#xv&s*bneSeSgK2Lk)e7|GA*2(Pr!0>Ie=KEhe!|r_l4~xW~A6-Zo zsJv`17|*EI`>cdw=vO9vFQ;Di??t1r>A3@Qv;awD+eZV(1nzrcF?K!1UGkntT~q{j zd$35t5RvuvF$84r=_3(hBv6nlKoD-pe(kbH1_fO7%x0n7(X0n7jyO13J-%bK4CIq2-9$i9G0kvL)s zVUZCZGxI1Od#b5F5rO+JlF40Cu$k1>!}*4M-8^w+`O| zA|yq27jI6LLo@=Cf~zM5RLj?N7qt^HqN|KSBvKLQ$syFl{xU?lL!-4zdK-nb48+5f z9V1SrGZu*&R9%TEfuNlbva~2PEGjb!3Nq?NDr(MT~-K@w>*FdH71Y;Q>oNGnu2 zN*J7w6&qC61q@KjRUuVM#0;WIG}J^)h=^vF1mG70nwqrAR*0cui5M$R(qPjPE^Gi* zjg5+$7Y=q^B7&HOt%77(+8sF3)XJlU+DuH*K*$POQVGQDBO^i;sGzDDakWKBXclrL zqcRJ&5vim_nW|?JY@<@BgIF@HwFR;R7DxsK9Xk@#BTAr5Z2w2~f zC`v*S%Dpu}AEazi+>wpSAVhNcej~eF-zwYk-ap*Pp_MpHj$Ws=GLc!d+#$;php*jI z(#A)+XcHhA#7b%~pePP3I)4i9S5pya?d)OA<86;)XOf-0anIXw+`C4jSiM}fMln39 z04N3kQ9yct3T{D30+_){C=OP1lzTif6mkNP3y&nVm~0{|)JofJx+Ac_079<71t!TA zVq^{CM_viONTAI@^obM)zUS}^XC%}}aq*Znk~(~YKm(aoQcMb}aDg84250ftewA@J zT3-H7Zg5EB#M4W_l_9qv%JxQKnD7fAf>@_B!21EN6{cHQ#BMC!5o+vFJEtYX?wB$LGr1D%)j2K~%i5Mp799=18=W zWJUpEaVaFgERi_2L}CR*34nGn@*fvq!MDGEO8r&wuEzHztqxPhcZoZHRVcnU)t%7c zD++Q#aNrRk0|77)pvHnS1@7d@lTRj0nK5L^lds>&(!YPP=kH_Q-9b%~9_`O=--BYS!+oLb{nRwh+$R@PE1b#;{o ziL^dLZbOv0;ZEieIZ9mgN{h-!gnT7%`S4c>xFs3uTaJuH38+4!HH`yq*3pDrNUiAoPjrBNp@|h6TauaHnx? zAWkyl3yiqSC#sBan`6`JE$b%LVjC5vptd9-5mzu1IlJ`_~UCG;o=Jl@VQSpUQaJk`HDeApw zJQKstl^*N4VdhSIy*&%O@h%YL6yfKePY|Lia;xQcT=3J+b9axPdTu=zioEcg3EcJ6 z)j~kmqUX;zR8zToxg=MdqKl)VOkCQ#g{Iwi4pO;#c<#q2ijQ>r^-5MEQ<(HCm*A>wm({OVV&7|&*>l}J16coyLmC?#4J<%w$5AMx zq(oeZxm5HaXD%1ek_(X(U6pc4D4=>!k#f1ff+)UL7cNwC<<1mT6kMX^TzL{XMMXy@ zTq@;N!md?O2W3!DRZ-5$ia1rm4n!42!sP|XsOM$EiVC@MDj9O@h$6U0Wy+!`;c_Cm zS12xAxpL*pmo8kmT%e$)7ao@vMvxlEJ9B|W6ah&M$;pMni?o>Zc?XHSOcR#`;GM3q z&c{8`l-OJf0qAy-K=OfhS1LP1p=cz{kYrUe>O zL$D-K56noUhb)o7ByjSQCMqGhQcagbfOiCo4ohQ|%5q-s9K2&hj*%q1B~G3vy9whs zOiEk!06D-!0v87}%_rsev~?OccXxG+uimdWkVyI-$dS58(KT_g^NAUfFntn59AZV2 zd&a_LQR!JG`t7$koA~Fw!nU5%$$NZ{>~K4Bq?6^hcrNZ3Za6wotv+@|838q~H1s#!5F z#%wmJv$9Cbxg=wxBx-IFH6w4?q!SSUpgdJmsnh)U6XJ0Gs`$RAQ9Cs0(dlE4^J%;y zl~hoT^y(HwgGwY49C#~kMRoiYi8*nD*GpH&jkk)*==9^JeNRjvU#eZ3mgPT~@ad}k zp7Pk7pucR(K_&Ed-E%xFY0%YXs z+l{Y1OAxeSW?@KIXDJIUDGgKwE1J46p~D3!N4R@lABzOtv6oW$dSXtR1Oyd zUmksGEhQ)bfWcrCT`D>C&(0uERE)0z(+Etwu%e0r(V#g{sNRHK3`S;XDYx$8;9H2* z0+Ru`mlS3mtPZ3U)-r3VN?QVF5llFCS@?RY`m(T+Wx_pSBiPK@M9-Y~S+Gdi+|$A& zZSV;llQ#dxy_PT=U?2h@ARFAxZGQ0iIf?Qw#p72J3Vsc)e7)FjIh`;S^a8He5=o2i z7U7X;adNVU4lkv| zOihUu4KY%sH5?*H7{O4yB~>$R2wH^NSwmVBpd^Z+HF0?zQVGJ%%yQ{%rneXOlZ>mY zbc%r4mI*CsPOycH0>N@d7{UZ%OJKQ?dl@w3K08_xwSg>}m9qk9b{RG<;@aVVv#Z?g z@b|cQczAew+&nnFj<2KA_G1)DL{SG7{^!Or00Z*zZ0rkDRE*uBQ?9>#2A_GEDVy=ovLd zT9s4Pkl3l$R^<0Y%Jf_Kj6?uGDI}5!01`wLR7FJ`xKRXL=Qu?KMO6@7s;a1{D2in= ze2+(?$>(ZoYbT)&k3(ygTO89~!#Xo`BBdK7B;9?TotXGEfG7&C(wjHI;cY3VW=Wf8 zJq-N}?Ev#MN49z5YXde9aT+Q?s1hw}38?N1L`+!FKy?_OTClKxw`ZY`9z1yQ1Ja;( zrT`>FM|;2h?eFdQSoD4!l1KgZ3H96+p))drExDJw!@jY*urU^uoto5ZRq0e1Qxa*0z zRn8FhuSYj8FN_))+1zxJ#HdnG1c3854XJAu2+wNKx1+YkC}KgI&eFU+aS!?dKwd{0 o?<)?6As02(=jYzD04Q96{h&+GE6I?j{7e5Aaz!{$kPs>n_k9QR!T Date: Fri, 11 Feb 2022 11:15:17 +1030 Subject: [PATCH 3/6] Updating workflow files on main --- .github/workflows/R-CMD-check.yaml | 3 +-- .github/workflows/pkgdown.yaml | 4 +++- .github/workflows/test-coverage.yaml | 3 ++- 3 files changed, 6 insertions(+), 4 deletions(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 1ea052f..b952900 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -4,11 +4,10 @@ on: push: branches: - main - - master + - dev pull_request: branches: - main - - master name: R-CMD-check diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 3c908d3..238a74f 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -2,7 +2,9 @@ on: push: branches: - main - - master + pull_request: + branches: + - main name: pkgdown diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index d06cbe5..fbae8ae 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -1,7 +1,8 @@ on: push: branches: - - master + - main + - dev #pull_request: # branches: # - master From 35a587ed9ea36c7c7c4ed208a6d6fd8a1d6b13fd Mon Sep 17 00:00:00 2001 From: wasin pipattungsakul Date: Fri, 1 Mar 2024 14:02:00 +1030 Subject: [PATCH 4/6] add rssdf tests --- R/One_Sample.R | 18 +++++++++--------- R/RSSDF.R | 30 +++++++++++++++++------------- R/RSSEF.R | 7 ++++--- tests/population.rda | Bin 0 -> 4547 bytes tests/testthat/test-RSSDF.R | 23 +++++++++++++++++++++++ 5 files changed, 53 insertions(+), 25 deletions(-) create mode 100644 tests/population.rda create mode 100644 tests/testthat/test-RSSDF.R diff --git a/R/One_Sample.R b/R/One_Sample.R index 4a60017..a29f183 100644 --- a/R/One_Sample.R +++ b/R/One_Sample.R @@ -29,35 +29,35 @@ OneSample <- function(data, set_size, method = c("JPS", "RSS"), confidence = 0.9 # If model is 0, it's design based inference, if model = 1, it is model based inference using super population model # pop_size: nrow(data)*set_size <= pop_size, > 0, only relevant if replace = FALSE - if(set_size < 1 | is.na(set_size) | is.null(set_size) | !is.numeric(set_size)) { + if (set_size < 1 || is.na(set_size) || is.null(set_size) || !is.numeric(set_size)) { stop("set_size must be a positive numeric value") } - if(!isTRUE(replace) & !isFALSE(replace)) { + if (!isTRUE(replace) && !isFALSE(replace)) { stop("replace must be TRUE or FALSE") } method <- match.arg(toupper(method), c("JPS", "RSS")) - if(confidence > 1 | confidence < 0 | !is.numeric(confidence)) { + if (confidence > 1 || confidence < 0 || !is.numeric(confidence)) { stop("confidence must take a numeric value between 0 and 1, indicating the confidence level") } - if(!model %in% c(1, 0)) { + if (!model %in% c(1, 0)) { stop("model must be 0 for design based inference or 1 for super-population model") } alpha <- 1 - confidence if (!replace) { - if(missing(pop_size) | is.null(pop_size) | !is.numeric(pop_size)) { + if (missing(pop_size) || is.null(pop_size) || !is.numeric(pop_size)) { stop("A numeric population size pop_size must be provided when sampling without replacement") } - else if(pop_size <= nrow(data)*set_size | pop_size <= 0) { + else if(pop_size <= nrow(data)*set_size || pop_size <= 0) { stop("pop_size must be positive and less than data x set_size") } } - if (model == 1 & missing(pop_size)) { + if (model == 1 && missing(pop_size)) { stop("The population size pop_size must be provided for super-population model") } @@ -74,11 +74,11 @@ OneSample <- function(data, set_size, method = c("JPS", "RSS"), confidence = 0.9 ### Ranked set sample ########################################### ################################################################# - else if(method == "RSS") { + else if (method == "RSS") { RV <- data[, 2] GSV <- aggregate(RV, list(RV), length)$x - if (length(GSV) != set_size | min(GSV) <= 1) { + if (length(GSV) != set_size || min(GSV) <= 1) { stop("In ranked set sample, first ranking method should have at least two observations in any judgment ranking group") } diff --git a/R/RSSDF.R b/R/RSSDF.R index e91135f..9bacf6a 100644 --- a/R/RSSDF.R +++ b/R/RSSDF.R @@ -1,29 +1,33 @@ ############################## 3 -# This function genrates RSS sample with K ranking methods with replacemet +# This function generates RSS sample with K ranking methods with replacement # Pop: has two variables popY, variable of interest # popAux: Auxiliary variable # We assume pop and popAux are correlated # n: sample size n=Hd, H: set size, d: cycle size RSSDF <- function(pop, n, H, K) { - d <- n / H + if (n < H) { + stop("`n` must >= `H`.") + } + + n_cycles <- n / H popY <- pop[, 1] popAux <- pop[, 2] N <- length(popY) RSSM <- matrix(0, ncol = (K + 1), nrow = n) ic <- 1 - for (j in (1:d)) { + for (j in (1:n_cycles)) { for (h in (1:H)) { - setid <- sample(1:N, H) - setY <- popY[setid] - setX <- popAux[setid] - orAux <- order(setX) - orY <- setY[orAux] - osetX <- setX[orAux] - setidO <- setid[orAux] + sampled_id <- sample(1:N, H) + setY <- popY[sampled_id] + setX <- popAux[sampled_id] + auxiliary_order <- order(setX) + ordered_setY <- setY[auxiliary_order] + ordered_setX <- setX[auxiliary_order] + ordered_sample_id <- sampled_id[auxiliary_order] # oset=DELLF(set,tauV[1]) - RSSM[ic, c(1, 2)] <- c(orY[h], h) - k1obs <- osetX[h] - redAux <- popAux[-setidO[h]] + RSSM[ic, c(1, 2)] <- c(ordered_setY[h], h) + k1obs <- ordered_setX[h] + redAux <- popAux[-ordered_sample_id[h]] if (K > 1) { for (k in (2:K)) { kset <- c(k1obs, sample(redAux, (H - 1))) diff --git a/R/RSSEF.R b/R/RSSEF.R index 0d33ecb..f0daed5 100644 --- a/R/RSSEF.R +++ b/R/RSSEF.R @@ -1,7 +1,7 @@ ########################################### # This function provides estimator for RSS data # RSSK: n by (K+1) dimensional data matrix, the first column is Y-values, -# the next K coulumns are the ranks of K-ranking methods +# the next K columns are the ranks of K-ranking methods # set_size: set Size # N: population size # model: if Modle=0 design based inference, if model=1, superpopulation model @@ -21,7 +21,8 @@ #' @keywords internal #' RSSEF <- function(data, set_size, replace, model, N, alpha) { - RM <- data[, -1] + # unused variable + # RM <- data[, -1] RV <- data[, 2] # We need to be careful about this. Y <- data[, 1] # We need to be careful about this. Need to ensure response is in col 1. n <- nrow(data) @@ -86,7 +87,7 @@ RSSEF <- function(data, set_size, replace, model, N, alpha) { Jack.Repl.AWi <- apply(matrix(1:n, ncol = 1), 1, FWDel1, AWY = AWY) # Aggrement weight estimator # when the i-th obseervation is deleted if (replace) fc <- 1 else fc <- 1 - n / (N - 1) - J.var <- fc * (n - 1) * var(Jack.Repl.AWi) * ((n - 1) / n)^2 # Jackknife variance estiamte for aggreement weight JPS estimator + J.var <- fc * (n - 1) * var(Jack.Repl.AWi) * ((n - 1) / n)^2 # Jackknife variance estimate for aggreement weight JPS estimator ############################################################## diff --git a/tests/population.rda b/tests/population.rda new file mode 100644 index 0000000000000000000000000000000000000000..05c1187b47799a08dde64186606b014bcdc44138 GIT binary patch literal 4547 zcmc&$3pkVeAAjA7Ql`eElC&fVDJgS{4z-*j_uD}ih1Sw(IW8mWP$qRsr9*RxkR7v< zamY60mfO0poh(}=+bL((EH;Mz??(TqfBnyS{{QEk-?L}W`}=*r@Avz;{C@BIZu1L; zZ?N~(clW)MZlVJ0N5%`rF@Zi>TJhp8$Q}fxlBETKXaRQ05Wr4uuRa?9jV0$ z}&g?BsG~1^qGa zhdm8*Bu?>T_;`GQeu7pe04xAQi$e1*>pjfO1gF4)ISC8qbn&^$u^W{R-$td(lW#H7 z^M%zy<(3Q=Bx-2gfqc7DwPnf0Jy4(dy7Lf5K1xUS<{FgEhtgT*M8i66})Ke7$qV zc_rnc8hUP~!TbDrG&B(MW@2RoLT{ZML{q+gm8N`(NrCG=T`a6I1#uIW2u<7Eq7EAYm1A{p$PdbTT9swnCzVpUY;z7A7HsH?1mCCZ-+qKh7` zR2$wlce~xiNq&9p)($-tAg5B2eGHe*H6l6G3qzw)8i%y}}?6GjslrUh5>-{Pq5FS#j)Z!o?6{G?>)QK8TsVeJk^DXrUo|+ikq$fRDE< zCLsL=xPEjJqmx8H60^{LLYg%fUJEP)Q)Q)QRR2O|c=7D|MW z@EKNQKbS$ zm*twzrV<|eZ;GGFg^CcCA_JqjIIaaC*TK)4!a^qzB4+TGsfzs!;52ahr{d4$5H^psZBf-mC>52gMYTY3NrNmUYb7*r;@ie0AXQBJe;=oeyaRQFQHR1)JkUET**C(PLn(1K`<1 zNmDB=z}W`yDO=GE#{9ue3uu7{lX)175kP+c)kt<6j|9fNxZrG#6`wNl=NODkr{;pU zeR(JdszxMnWYJ0RWP?q-D+9n>RWyz%6~=2ISIPr@T?V!H1Q^=TiAG7$_?IStXyBbF zsbs%IJOo3{@D3S?qt)OMCps^9Wd95KQJ%=mi@nD`Lnb~rbYM?)Two}A4B@MjqL`B@&1w~A8-h&-^m6j zYMVbxXl4q`iImFZ8;)TeIs^cnZ=_Bb^D)u~z>;2R=pdONo$)iEUY%h<8B0{t-VVrRb%W)+{8^%mj0C`}S{j-z z{=eXx)v9Wm;#bisWYWpf&y|OO_TP>4I529&toveGC z!dv%7G~1L#@gl}^6hx^ZBGkvbk!LhV+W7N<(2!ZQalUJbq4MZxiD-V z)f;%Lra93t3NvAAIfk)pT<11grFz~7`rZ9Z9PcSPmhq=fpxrEux@K}?6mF4kQ~d3bzN5eHS7W8ahG@_#0<`+MgH4Z^6u&XX zMNI>GwS-rd-Fu_Kl@Ui=oMZ%bE_d8+a>H9w%-OQ6suPV32&InW9QrHr;ZU^Z>E)sQ zB?UXuQ++RAu;^Cj)ScSRbJmafxj!eKJo=8;d_~7qc!<9XARZDvNbD= z8|?jb;|X4N{7@g6y`|ZTHD`ObNay$jCdAfua@ly`3tJxd`=CcIMbRmKUXhJ`woBfQ zU(WI85_<)(av7Q?#u)4;L*+&z1Bi3(}8D@RgiwA|K>~M z;vMdS31W1tx#+OLkYt&axe}pC5;ZFBQ-j{U)?{(LQiV=G8|Au;+wi1ueUgVLjNny% z$VnX1-R?Ybw6}1COSHLM5^uhawmHhdCFm@TYBD;q;&Q6++8Pa4Ms`p!<<*;59zVxY z97by#W7*V*kg-7r3kq6_vY#FQ<2&DS+v|0LvE?r@e(W6P*}@3-SJyEEZ-gt>ysD9y z+f3Z!ap_OT(9C#Ir(}(px_d9q{zRZ#vI+e7g)nYN4=%&Vq1;u6M?B-bp~%FnH3S-N z>~G&ih;W+_7!UWJXK>r&?IQ^Lr%Gngfy{jP5%8s@ZRKp)71dW-=Yv1-&2=*A& z)`b3zmf5P_e)YFbXKO{!G~0arhDKj>yy55=_pK&rOEB(_gTi&5oDZ^U`?b|I?~2RP zU!8{hua*`#glAm}S@<-M`M7%{vi)u@R||?= `H`.") +}) From df1c01308987c4f8f56127ff1c23c7a45d383f60 Mon Sep 17 00:00:00 2001 From: wasin pipattungsakul Date: Tue, 5 Mar 2024 11:40:17 +1030 Subject: [PATCH 5/6] test rssnrf --- R/RSSDF.R | 4 +--- R/RSSNRF.R | 9 +++++--- R/utils.R | 42 ++++++++++++++++++++++++++++++++++++ tests/testthat/test-RSSDF.R | 26 +++++++++++++++------- tests/testthat/test-RSSNRF.R | 25 +++++++++++++++++++++ 5 files changed, 92 insertions(+), 14 deletions(-) create mode 100644 R/utils.R create mode 100644 tests/testthat/test-RSSNRF.R diff --git a/R/RSSDF.R b/R/RSSDF.R index 9bacf6a..2dfd0a8 100644 --- a/R/RSSDF.R +++ b/R/RSSDF.R @@ -5,9 +5,7 @@ # We assume pop and popAux are correlated # n: sample size n=Hd, H: set size, d: cycle size RSSDF <- function(pop, n, H, K) { - if (n < H) { - stop("`n` must >= `H`.") - } + verify_rss_params(pop, n, H, K) n_cycles <- n / H popY <- pop[, 1] diff --git a/R/RSSNRF.R b/R/RSSNRF.R index a388c3a..220925e 100644 --- a/R/RSSNRF.R +++ b/R/RSSNRF.R @@ -5,15 +5,18 @@ # We assume pop and popAux are correlated # n: sample size n=Hd, H: set size, d: cycle size RSSNRF <- function(pop, n, H, K) { - d <- n / H + verify_rss_params(pop, n, H, K) + + n_cycles <- n / H K1 <- K + 1 - rseq <- rep((1:H), times = d) + rseq <- rep((1:H), times = n_cycles) popY <- pop[, 1] N <- length(popY) popAux <- pop[, 2] popind <- 1:N RSSM <- matrix(0, ncol = (K1), nrow = n) - ic <- 1 + # unused variable + # ic <- 1 ind <- sample(popind, n * H) setY <- matrix(popY[ind], ncol = H, nrow = n) setX <- matrix(popAux[ind], ncol = H, nrow = n) diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 0000000..25b13ac --- /dev/null +++ b/R/utils.R @@ -0,0 +1,42 @@ +is_positive_wholenumber <- function(x, tol = .Machine$double.eps^0.5) { + is_wholenumber(x, tol) && x > 0 +} + +is_wholenumber <- function(x, tol = .Machine$double.eps^0.5) { + abs(x - round(x)) < tol +} + +verify_rss_params <- function(pop, n, H, K) { + pop_dimension <- dim(pop) + if (length(pop_dimension) != 2) { + stop("`pop` must be a 2-dimension matrix-like object.") + } + + if (pop_dimension[[2]] < 2) { + stop("`pop` must have at least 2 columns.") + } + + if (!is_positive_wholenumber(n)) { + stop("`n` must be a positive whole number.") + } + + if (!is_positive_wholenumber(H)) { + stop("`H` must be a positive whole number.") + } + + if (!is_positive_wholenumber(K)) { + stop("`K` must be a positive whole number.") + } + + if (pop_dimension[[1]] < n) { + stop("`pop` must have at least `n` rows.") + } + + if (n < H) { + stop("`n` must >= `H`.") + } + + if (n %% H != 0) { + stop("`n` must be a multiple of `H`.") + } +} diff --git a/tests/testthat/test-RSSDF.R b/tests/testthat/test-RSSDF.R index f3a1c57..88cefe7 100644 --- a/tests/testthat/test-RSSDF.R +++ b/tests/testthat/test-RSSDF.R @@ -10,14 +10,24 @@ test_that("RSSDF has a correct output.", { expect_equal(sample_counts_in_sets[[2]], 10) expect_equal(table(sample_counts_in_sets)[[1]], 10) - rss_matrix_with_dropped_sample <- RSSDF(population, 100, 11, 2) - expect_equal(sort(unique(rss_matrix_with_dropped_sample[, 2])), 0:11) - - sample_counts_in_sets <- table(rss_matrix_with_dropped_sample[, 2]) - expect_equal(sample_counts_in_sets[[2]], 9) - expect_equal(table(sample_counts_in_sets)[[2]], 11) + # # # in case we are supporting `n %% H > 0` + # rss_matrix_with_dropped_sample <- RSSDF(population, 100, 11, 2) + # expect_equal(sort(unique(rss_matrix_with_dropped_sample[, 2])), 0:11) + # + # sample_counts_in_sets <- table(rss_matrix_with_dropped_sample[, 2]) + # expect_equal(sample_counts_in_sets[[2]], 9) + # expect_equal(table(sample_counts_in_sets)[[2]], 11) }) -test_that("Set size must be greater or equal to sample size.", { - expect_error(RSSDF(1, 10, 11, 1), "`n` must >= `H`.") +test_that("Inputs are valid.", { + matrix_ <- matrix(1:10, nrow = 5, ncol = 2) + + expect_error(RSSDF(1:10, -100, 10, 1), "`pop` must be a 2-dimension matrix-like object.") + expect_error(RSSDF(matrix(1:10), -100, 10, 1), "`pop` must have at least 2 columns.") + expect_error(RSSDF(matrix_, -100, 10, 1), "`n` must be a positive whole number.") + expect_error(RSSDF(matrix_, 100, -10, 1), "`H` must be a positive whole number.") + expect_error(RSSDF(matrix_, 100, 10, -1), "`K` must be a positive whole number.") + expect_error(RSSDF(matrix_, 100, 10, 1), "`pop` must have at least `n` rows.") + expect_error(RSSDF(matrix_, 5, 11, 1), "`n` must >= `H`.") + expect_error(RSSDF(matrix_, 5, 4, 1), "`n` must be a multiple of `H`.") }) diff --git a/tests/testthat/test-RSSNRF.R b/tests/testthat/test-RSSNRF.R new file mode 100644 index 0000000..f1e5594 --- /dev/null +++ b/tests/testthat/test-RSSNRF.R @@ -0,0 +1,25 @@ +test_that("RSSDF has a correct output.", { + skip_if(getRversion() < 3.4) + load("../population.rda") + + rss_matrix <- RSSNRF(population, 100, 10, 2) + expect_equal(dim(rss_matrix), c(100, 3)) + expect_equal(sort(unique(rss_matrix[, 2])), 1:10) + + sample_counts_in_sets <- table(rss_matrix[, 2]) + expect_equal(sample_counts_in_sets[[2]], 10) + expect_equal(table(sample_counts_in_sets)[[1]], 10) +}) + +test_that("Inputs are valid.", { + matrix_ <- matrix(1:10, nrow = 5, ncol = 2) + + expect_error(RSSNRF(1:10, -100, 10, 1), "`pop` must be a 2-dimension matrix-like object.") + expect_error(RSSNRF(matrix(1:10), -100, 10, 1), "`pop` must have at least 2 columns.") + expect_error(RSSNRF(matrix_, -100, 10, 1), "`n` must be a positive whole number.") + expect_error(RSSNRF(matrix_, 100, -10, 1), "`H` must be a positive whole number.") + expect_error(RSSNRF(matrix_, 100, 10, -1), "`K` must be a positive whole number.") + expect_error(RSSNRF(matrix_, 100, 10, 1), "`pop` must have at least `n` rows.") + expect_error(RSSNRF(matrix_, 5, 11, 1), "`n` must >= `H`.") + expect_error(RSSNRF(matrix_, 5, 4, 1), "`n` must be a multiple of `H`.") +}) From c93d77a17c776600b50e2ef2ace985fbb18a3cfb Mon Sep 17 00:00:00 2001 From: wasin pipattungsakul Date: Tue, 5 Mar 2024 11:43:20 +1030 Subject: [PATCH 6/6] add todo --- tests/testthat/test-RSSDF.R | 1 + tests/testthat/test-RSSNRF.R | 1 + 2 files changed, 2 insertions(+) diff --git a/tests/testthat/test-RSSDF.R b/tests/testthat/test-RSSDF.R index 88cefe7..3a329ae 100644 --- a/tests/testthat/test-RSSDF.R +++ b/tests/testthat/test-RSSDF.R @@ -1,5 +1,6 @@ test_that("RSSDF has a correct output.", { skip_if(getRversion() < 3.4) + # TODO: create a matrix to not rely on `population.rda` load("../population.rda") rss_matrix <- RSSDF(population, 100, 10, 2) diff --git a/tests/testthat/test-RSSNRF.R b/tests/testthat/test-RSSNRF.R index f1e5594..fd0382a 100644 --- a/tests/testthat/test-RSSNRF.R +++ b/tests/testthat/test-RSSNRF.R @@ -1,5 +1,6 @@ test_that("RSSDF has a correct output.", { skip_if(getRversion() < 3.4) + # TODO: create a matrix to not rely on `population.rda` load("../population.rda") rss_matrix <- RSSNRF(population, 100, 10, 2)