0s autopkgtest [16:19:49]: starting date and time: 2025-03-15 16:19:49+0000 0s autopkgtest [16:19:49]: git checkout: 325255d2 Merge branch 'pin-any-arch' into 'ubuntu/production' 0s autopkgtest [16:19:49]: host juju-7f2275-prod-proposed-migration-environment-9; command line: /home/ubuntu/autopkgtest/runner/autopkgtest --output-dir /tmp/autopkgtest-work.vd62ikqz/out --timeout-copy=6000 --setup-commands 'ln -s /dev/null /etc/systemd/system/bluetooth.service; printf "http_proxy=http://squid.internal:3128\nhttps_proxy=http://squid.internal:3128\nno_proxy=127.0.0.1,127.0.1.1,login.ubuntu.com,localhost,localdomain,novalocal,internal,archive.ubuntu.com,ports.ubuntu.com,security.ubuntu.com,ddebs.ubuntu.com,changelogs.ubuntu.com,keyserver.ubuntu.com,launchpadlibrarian.net,launchpadcontent.net,launchpad.net,10.24.0.0/24,keystone.ps5.canonical.com,objectstorage.prodstack5.canonical.com,radosgw.ps5.canonical.com\n" >> /etc/environment' --apt-pocket=proposed=src:glibc --apt-upgrade r-cran-mcmc --timeout-short=300 --timeout-copy=20000 --timeout-build=20000 --env=ADT_TEST_TRIGGERS=glibc/2.41-1ubuntu2 -- lxd -r lxd-armhf-10.145.243.227 lxd-armhf-10.145.243.227:autopkgtest/ubuntu/plucky/armhf 22s autopkgtest [16:20:10]: testbed dpkg architecture: armhf 23s autopkgtest [16:20:12]: testbed apt version: 2.9.33 28s autopkgtest [16:20:16]: @@@@@@@@@@@@@@@@@@@@ test bed setup 29s autopkgtest [16:20:18]: testbed release detected to be: None 37s autopkgtest [16:20:26]: updating testbed package index (apt update) 39s Get:1 http://ftpmaster.internal/ubuntu plucky-proposed InRelease [126 kB] 39s Get:2 http://ftpmaster.internal/ubuntu plucky InRelease [257 kB] 39s Get:3 http://ftpmaster.internal/ubuntu plucky-updates InRelease [126 kB] 40s Get:4 http://ftpmaster.internal/ubuntu plucky-security InRelease [126 kB] 40s Get:5 http://ftpmaster.internal/ubuntu plucky-proposed/universe Sources [379 kB] 40s Get:6 http://ftpmaster.internal/ubuntu plucky-proposed/multiverse Sources [15.8 kB] 40s Get:7 http://ftpmaster.internal/ubuntu plucky-proposed/main Sources [99.7 kB] 40s Get:8 http://ftpmaster.internal/ubuntu plucky-proposed/main armhf Packages [114 kB] 40s Get:9 http://ftpmaster.internal/ubuntu plucky-proposed/main armhf c-n-f Metadata [1832 B] 40s Get:10 http://ftpmaster.internal/ubuntu plucky-proposed/restricted armhf c-n-f Metadata [116 B] 40s Get:11 http://ftpmaster.internal/ubuntu plucky-proposed/universe armhf Packages [312 kB] 41s Get:12 http://ftpmaster.internal/ubuntu plucky-proposed/universe armhf c-n-f Metadata [11.1 kB] 41s Get:13 http://ftpmaster.internal/ubuntu plucky-proposed/multiverse armhf Packages [3472 B] 41s Get:14 http://ftpmaster.internal/ubuntu plucky-proposed/multiverse armhf c-n-f Metadata [240 B] 41s Get:15 http://ftpmaster.internal/ubuntu plucky/main Sources [1394 kB] 42s Get:16 http://ftpmaster.internal/ubuntu plucky/universe Sources [21.0 MB] 66s Get:17 http://ftpmaster.internal/ubuntu plucky/multiverse Sources [299 kB] 66s Get:18 http://ftpmaster.internal/ubuntu plucky/main armhf Packages [1378 kB] 68s Get:19 http://ftpmaster.internal/ubuntu plucky/main armhf c-n-f Metadata [29.4 kB] 68s Get:20 http://ftpmaster.internal/ubuntu plucky/restricted armhf c-n-f Metadata [108 B] 68s Get:21 http://ftpmaster.internal/ubuntu plucky/universe armhf Packages [15.1 MB] 86s Get:22 http://ftpmaster.internal/ubuntu plucky/multiverse armhf Packages [172 kB] 88s Fetched 41.0 MB in 49s (841 kB/s) 89s Reading package lists... 94s autopkgtest [16:21:23]: upgrading testbed (apt dist-upgrade and autopurge) 96s Reading package lists... 96s Building dependency tree... 96s Reading state information... 97s Calculating upgrade...Starting pkgProblemResolver with broken count: 0 97s Starting 2 pkgProblemResolver with broken count: 0 97s Done 98s Entering ResolveByKeep 98s 98s Calculating upgrade... 99s The following packages will be upgraded: 99s libc-bin libc6 locales pinentry-curses python3-jinja2 sos strace 99s 7 upgraded, 0 newly installed, 0 to remove and 0 not upgraded. 99s Need to get 8683 kB of archives. 99s After this operation, 23.6 kB of additional disk space will be used. 99s Get:1 http://ftpmaster.internal/ubuntu plucky-proposed/main armhf libc6 armhf 2.41-1ubuntu2 [2932 kB] 103s Get:2 http://ftpmaster.internal/ubuntu plucky-proposed/main armhf libc-bin armhf 2.41-1ubuntu2 [545 kB] 103s Get:3 http://ftpmaster.internal/ubuntu plucky-proposed/main armhf locales all 2.41-1ubuntu2 [4246 kB] 109s Get:4 http://ftpmaster.internal/ubuntu plucky/main armhf strace armhf 6.13+ds-1ubuntu1 [445 kB] 109s Get:5 http://ftpmaster.internal/ubuntu plucky/main armhf pinentry-curses armhf 1.3.1-2ubuntu3 [40.6 kB] 109s Get:6 http://ftpmaster.internal/ubuntu plucky/main armhf python3-jinja2 all 3.1.5-2ubuntu1 [109 kB] 109s Get:7 http://ftpmaster.internal/ubuntu plucky/main armhf sos all 4.9.0-5 [365 kB] 110s Preconfiguring packages ... 110s Fetched 8683 kB in 11s (815 kB/s) 110s (Reading database ... (Reading database ... 5% (Reading database ... 10% (Reading database ... 15% (Reading database ... 20% (Reading database ... 25% (Reading database ... 30% (Reading database ... 35% (Reading database ... 40% (Reading database ... 45% (Reading database ... 50% (Reading database ... 55% (Reading database ... 60% (Reading database ... 65% (Reading database ... 70% (Reading database ... 75% (Reading database ... 80% (Reading database ... 85% (Reading database ... 90% (Reading database ... 95% (Reading database ... 100% (Reading database ... 64655 files and directories currently installed.) 110s Preparing to unpack .../libc6_2.41-1ubuntu2_armhf.deb ... 110s Unpacking libc6:armhf (2.41-1ubuntu2) over (2.41-1ubuntu1) ... 110s Setting up libc6:armhf (2.41-1ubuntu2) ... 111s (Reading database ... (Reading database ... 5% (Reading database ... 10% (Reading database ... 15% (Reading database ... 20% (Reading database ... 25% (Reading database ... 30% (Reading database ... 35% (Reading database ... 40% (Reading database ... 45% (Reading database ... 50% (Reading database ... 55% (Reading database ... 60% (Reading database ... 65% (Reading database ... 70% (Reading database ... 75% (Reading database ... 80% (Reading database ... 85% (Reading database ... 90% (Reading database ... 95% (Reading database ... 100% (Reading database ... 64655 files and directories currently installed.) 111s Preparing to unpack .../libc-bin_2.41-1ubuntu2_armhf.deb ... 111s Unpacking libc-bin (2.41-1ubuntu2) over (2.41-1ubuntu1) ... 111s Setting up libc-bin (2.41-1ubuntu2) ... 111s (Reading database ... (Reading database ... 5% (Reading database ... 10% (Reading database ... 15% (Reading database ... 20% (Reading database ... 25% (Reading database ... 30% (Reading database ... 35% (Reading database ... 40% (Reading database ... 45% (Reading database ... 50% (Reading database ... 55% (Reading database ... 60% (Reading database ... 65% (Reading database ... 70% (Reading database ... 75% (Reading database ... 80% (Reading database ... 85% (Reading database ... 90% (Reading database ... 95% (Reading database ... 100% (Reading database ... 64655 files and directories currently installed.) 111s Preparing to unpack .../locales_2.41-1ubuntu2_all.deb ... 111s Unpacking locales (2.41-1ubuntu2) over (2.41-1ubuntu1) ... 111s Preparing to unpack .../strace_6.13+ds-1ubuntu1_armhf.deb ... 111s Unpacking strace (6.13+ds-1ubuntu1) over (6.11-0ubuntu1) ... 111s Preparing to unpack .../pinentry-curses_1.3.1-2ubuntu3_armhf.deb ... 111s Unpacking pinentry-curses (1.3.1-2ubuntu3) over (1.3.1-2ubuntu2) ... 111s Preparing to unpack .../python3-jinja2_3.1.5-2ubuntu1_all.deb ... 111s Unpacking python3-jinja2 (3.1.5-2ubuntu1) over (3.1.5-2) ... 111s Preparing to unpack .../archives/sos_4.9.0-5_all.deb ... 112s Unpacking sos (4.9.0-5) over (4.9.0-4) ... 112s Setting up sos (4.9.0-5) ... 112s Setting up pinentry-curses (1.3.1-2ubuntu3) ... 112s Setting up locales (2.41-1ubuntu2) ... 113s Generating locales (this might take a while)... 115s en_US.UTF-8... done 115s Generation complete. 115s Setting up python3-jinja2 (3.1.5-2ubuntu1) ... 115s Setting up strace (6.13+ds-1ubuntu1) ... 115s Processing triggers for man-db (2.13.0-1) ... 116s Processing triggers for systemd (257.3-1ubuntu3) ... 119s Reading package lists... 119s Building dependency tree... 119s Reading state information... 120s Starting pkgProblemResolver with broken count: 0 120s Starting 2 pkgProblemResolver with broken count: 0 120s Done 121s Solving dependencies... 122s 0 upgraded, 0 newly installed, 0 to remove and 0 not upgraded. 124s autopkgtest [16:21:53]: rebooting testbed after setup commands that affected boot 163s autopkgtest [16:22:32]: testbed running kernel: Linux 6.8.0-52-generic #53~22.04.1-Ubuntu SMP PREEMPT_DYNAMIC Wed Jan 15 18:10:51 UTC 2 188s autopkgtest [16:22:57]: @@@@@@@@@@@@@@@@@@@@ apt-source r-cran-mcmc 200s Get:1 http://ftpmaster.internal/ubuntu plucky/universe r-cran-mcmc 0.9-8-1 (dsc) [2083 B] 200s Get:2 http://ftpmaster.internal/ubuntu plucky/universe r-cran-mcmc 0.9-8-1 (tar) [1542 kB] 200s Get:3 http://ftpmaster.internal/ubuntu plucky/universe r-cran-mcmc 0.9-8-1 (diff) [3320 B] 200s gpgv: Signature made Tue Nov 21 10:57:44 2023 UTC 200s gpgv: using RSA key F1F007320A035541F0A663CA578A0494D1C646D1 200s gpgv: issuer "tille@debian.org" 200s gpgv: Can't check signature: No public key 200s dpkg-source: warning: cannot verify inline signature for ./r-cran-mcmc_0.9-8-1.dsc: no acceptable signature found 200s autopkgtest [16:23:09]: testing package r-cran-mcmc version 0.9-8-1 202s autopkgtest [16:23:11]: build not needed 206s autopkgtest [16:23:15]: test generic: preparing testbed 207s Reading package lists... 208s Building dependency tree... 208s Reading state information... 208s Starting pkgProblemResolver with broken count: 0 208s Starting 2 pkgProblemResolver with broken count: 0 208s Done 209s The following NEW packages will be installed: 209s fontconfig fontconfig-config fonts-dejavu-core fonts-dejavu-mono libblas3 209s libcairo2 libdatrie1 libdeflate0 libfontconfig1 libfreetype6 libgfortran5 209s libgomp1 libgraphite2-3 libharfbuzz0b libice6 libjbig0 libjpeg-turbo8 209s libjpeg8 liblapack3 liblerc4 libpango-1.0-0 libpangocairo-1.0-0 209s libpangoft2-1.0-0 libpaper-utils libpaper2 libpixman-1-0 libsharpyuv0 libsm6 209s libtcl8.6 libthai-data libthai0 libtiff6 libtk8.6 libwebp7 libxcb-render0 209s libxcb-shm0 libxft2 libxrender1 libxss1 libxt6t64 r-base-core r-cran-iso 209s r-cran-mcmc r-cran-xtable unzip x11-common xdg-utils zip 209s 0 upgraded, 48 newly installed, 0 to remove and 0 not upgraded. 209s Need to get 39.7 MB of archives. 209s After this operation, 73.2 MB of additional disk space will be used. 209s Get:1 http://ftpmaster.internal/ubuntu plucky/main armhf libfreetype6 armhf 2.13.3+dfsg-1 [330 kB] 210s Get:2 http://ftpmaster.internal/ubuntu plucky/main armhf fonts-dejavu-mono all 2.37-8 [502 kB] 210s Get:3 http://ftpmaster.internal/ubuntu plucky/main armhf fonts-dejavu-core all 2.37-8 [835 kB] 211s Get:4 http://ftpmaster.internal/ubuntu plucky/main armhf fontconfig-config armhf 2.15.0-2ubuntu1 [37.5 kB] 211s Get:5 http://ftpmaster.internal/ubuntu plucky/main armhf libfontconfig1 armhf 2.15.0-2ubuntu1 [114 kB] 212s Get:6 http://ftpmaster.internal/ubuntu plucky/main armhf fontconfig armhf 2.15.0-2ubuntu1 [190 kB] 212s Get:7 http://ftpmaster.internal/ubuntu plucky/main armhf libblas3 armhf 3.12.1-2 [132 kB] 212s Get:8 http://ftpmaster.internal/ubuntu plucky/main armhf libpixman-1-0 armhf 0.44.0-3 [183 kB] 212s Get:9 http://ftpmaster.internal/ubuntu plucky/main armhf libxcb-render0 armhf 1.17.0-2 [15.3 kB] 212s Get:10 http://ftpmaster.internal/ubuntu plucky/main armhf libxcb-shm0 armhf 1.17.0-2 [5774 B] 212s Get:11 http://ftpmaster.internal/ubuntu plucky/main armhf libxrender1 armhf 1:0.9.10-1.1build1 [16.0 kB] 212s Get:12 http://ftpmaster.internal/ubuntu plucky/main armhf libcairo2 armhf 1.18.2-2 [484 kB] 213s Get:13 http://ftpmaster.internal/ubuntu plucky/main armhf libdatrie1 armhf 0.2.13-3build1 [15.7 kB] 213s Get:14 http://ftpmaster.internal/ubuntu plucky/main armhf libdeflate0 armhf 1.23-1 [38.5 kB] 213s Get:15 http://ftpmaster.internal/ubuntu plucky/main armhf libgfortran5 armhf 15-20250222-0ubuntu1 [330 kB] 213s Get:16 http://ftpmaster.internal/ubuntu plucky/main armhf libgomp1 armhf 15-20250222-0ubuntu1 [128 kB] 214s Get:17 http://ftpmaster.internal/ubuntu plucky/main armhf libgraphite2-3 armhf 1.3.14-2ubuntu1 [64.8 kB] 214s Get:18 http://ftpmaster.internal/ubuntu plucky/main armhf libharfbuzz0b armhf 10.2.0-1 [464 kB] 214s Get:19 http://ftpmaster.internal/ubuntu plucky/main armhf x11-common all 1:7.7+23ubuntu3 [21.7 kB] 214s Get:20 http://ftpmaster.internal/ubuntu plucky/main armhf libice6 armhf 2:1.1.1-1 [36.5 kB] 214s Get:21 http://ftpmaster.internal/ubuntu plucky/main armhf libjpeg-turbo8 armhf 2.1.5-3ubuntu2 [127 kB] 214s Get:22 http://ftpmaster.internal/ubuntu plucky/main armhf libjpeg8 armhf 8c-2ubuntu11 [2148 B] 214s Get:23 http://ftpmaster.internal/ubuntu plucky/main armhf liblapack3 armhf 3.12.1-2 [2091 kB] 217s Get:24 http://ftpmaster.internal/ubuntu plucky/main armhf liblerc4 armhf 4.0.0+ds-5ubuntu1 [160 kB] 217s Get:25 http://ftpmaster.internal/ubuntu plucky/main armhf libthai-data all 0.1.29-2build1 [158 kB] 217s Get:26 http://ftpmaster.internal/ubuntu plucky/main armhf libthai0 armhf 0.1.29-2build1 [15.2 kB] 217s Get:27 http://ftpmaster.internal/ubuntu plucky/main armhf libpango-1.0-0 armhf 1.56.2-1 [216 kB] 217s Get:28 http://ftpmaster.internal/ubuntu plucky/main armhf libpangoft2-1.0-0 armhf 1.56.2-1 [43.6 kB] 217s Get:29 http://ftpmaster.internal/ubuntu plucky/main armhf libpangocairo-1.0-0 armhf 1.56.2-1 [25.1 kB] 218s Get:30 http://ftpmaster.internal/ubuntu plucky/main armhf libpaper2 armhf 2.2.5-0.3 [16.3 kB] 218s Get:31 http://ftpmaster.internal/ubuntu plucky/main armhf libpaper-utils armhf 2.2.5-0.3 [14.2 kB] 218s Get:32 http://ftpmaster.internal/ubuntu plucky/main armhf libsharpyuv0 armhf 1.5.0-0.1 [16.4 kB] 218s Get:33 http://ftpmaster.internal/ubuntu plucky/main armhf libsm6 armhf 2:1.2.4-1 [15.1 kB] 218s Get:34 http://ftpmaster.internal/ubuntu plucky/main armhf libtcl8.6 armhf 8.6.16+dfsg-1 [909 kB] 219s Get:35 http://ftpmaster.internal/ubuntu plucky/main armhf libjbig0 armhf 2.1-6.1ubuntu2 [24.9 kB] 219s Get:36 http://ftpmaster.internal/ubuntu plucky/main armhf libwebp7 armhf 1.5.0-0.1 [188 kB] 219s Get:37 http://ftpmaster.internal/ubuntu plucky/main armhf libtiff6 armhf 4.5.1+git230720-4ubuntu4 [179 kB] 219s Get:38 http://ftpmaster.internal/ubuntu plucky/main armhf libxft2 armhf 2.3.6-1build1 [37.4 kB] 219s Get:39 http://ftpmaster.internal/ubuntu plucky/main armhf libxss1 armhf 1:1.2.3-1build3 [6500 B] 219s Get:40 http://ftpmaster.internal/ubuntu plucky/main armhf libtk8.6 armhf 8.6.16-1 [686 kB] 220s Get:41 http://ftpmaster.internal/ubuntu plucky/main armhf libxt6t64 armhf 1:1.2.1-1.2build1 [145 kB] 220s Get:42 http://ftpmaster.internal/ubuntu plucky/main armhf zip armhf 3.0-14ubuntu2 [164 kB] 220s Get:43 http://ftpmaster.internal/ubuntu plucky/main armhf unzip armhf 6.0-28ubuntu6 [167 kB] 220s Get:44 http://ftpmaster.internal/ubuntu plucky/main armhf xdg-utils all 1.2.1-2ubuntu1 [66.0 kB] 220s Get:45 http://ftpmaster.internal/ubuntu plucky/universe armhf r-base-core armhf 4.4.3-1 [28.2 MB] 253s Get:46 http://ftpmaster.internal/ubuntu plucky/universe armhf r-cran-iso armhf 0.0-21-1 [164 kB] 254s Get:47 http://ftpmaster.internal/ubuntu plucky/universe armhf r-cran-mcmc armhf 0.9-8-1 [1222 kB] 255s Get:48 http://ftpmaster.internal/ubuntu plucky/universe armhf r-cran-xtable all 1:1.8-4-2 [689 kB] 256s Preconfiguring packages ... 256s Fetched 39.7 MB in 47s (845 kB/s) 256s Selecting previously unselected package libfreetype6:armhf. 256s (Reading database ... (Reading database ... 5% (Reading database ... 10% (Reading database ... 15% (Reading database ... 20% (Reading database ... 25% (Reading database ... 30% (Reading database ... 35% (Reading database ... 40% (Reading database ... 45% (Reading database ... 50% (Reading database ... 55% (Reading database ... 60% (Reading database ... 65% (Reading database ... 70% (Reading database ... 75% (Reading database ... 80% (Reading database ... 85% (Reading database ... 90% (Reading database ... 95% (Reading database ... 100% (Reading database ... 64655 files and directories currently installed.) 256s Preparing to unpack .../00-libfreetype6_2.13.3+dfsg-1_armhf.deb ... 256s Unpacking libfreetype6:armhf (2.13.3+dfsg-1) ... 257s Selecting previously unselected package fonts-dejavu-mono. 257s Preparing to unpack .../01-fonts-dejavu-mono_2.37-8_all.deb ... 257s Unpacking fonts-dejavu-mono (2.37-8) ... 257s Selecting previously unselected package fonts-dejavu-core. 257s Preparing to unpack .../02-fonts-dejavu-core_2.37-8_all.deb ... 257s Unpacking fonts-dejavu-core (2.37-8) ... 257s Selecting previously unselected package fontconfig-config. 257s Preparing to unpack .../03-fontconfig-config_2.15.0-2ubuntu1_armhf.deb ... 257s Unpacking fontconfig-config (2.15.0-2ubuntu1) ... 257s Selecting previously unselected package libfontconfig1:armhf. 257s Preparing to unpack .../04-libfontconfig1_2.15.0-2ubuntu1_armhf.deb ... 257s Unpacking libfontconfig1:armhf (2.15.0-2ubuntu1) ... 257s Selecting previously unselected package fontconfig. 257s Preparing to unpack .../05-fontconfig_2.15.0-2ubuntu1_armhf.deb ... 257s Unpacking fontconfig (2.15.0-2ubuntu1) ... 257s Selecting previously unselected package libblas3:armhf. 257s Preparing to unpack .../06-libblas3_3.12.1-2_armhf.deb ... 257s Unpacking libblas3:armhf (3.12.1-2) ... 257s Selecting previously unselected package libpixman-1-0:armhf. 257s Preparing to unpack .../07-libpixman-1-0_0.44.0-3_armhf.deb ... 257s Unpacking libpixman-1-0:armhf (0.44.0-3) ... 257s Selecting previously unselected package libxcb-render0:armhf. 257s Preparing to unpack .../08-libxcb-render0_1.17.0-2_armhf.deb ... 257s Unpacking libxcb-render0:armhf (1.17.0-2) ... 257s Selecting previously unselected package libxcb-shm0:armhf. 257s Preparing to unpack .../09-libxcb-shm0_1.17.0-2_armhf.deb ... 257s Unpacking libxcb-shm0:armhf (1.17.0-2) ... 257s Selecting previously unselected package libxrender1:armhf. 257s Preparing to unpack .../10-libxrender1_1%3a0.9.10-1.1build1_armhf.deb ... 257s Unpacking libxrender1:armhf (1:0.9.10-1.1build1) ... 257s Selecting previously unselected package libcairo2:armhf. 257s Preparing to unpack .../11-libcairo2_1.18.2-2_armhf.deb ... 257s Unpacking libcairo2:armhf (1.18.2-2) ... 257s Selecting previously unselected package libdatrie1:armhf. 257s Preparing to unpack .../12-libdatrie1_0.2.13-3build1_armhf.deb ... 257s Unpacking libdatrie1:armhf (0.2.13-3build1) ... 257s Selecting previously unselected package libdeflate0:armhf. 257s Preparing to unpack .../13-libdeflate0_1.23-1_armhf.deb ... 257s Unpacking libdeflate0:armhf (1.23-1) ... 257s Selecting previously unselected package libgfortran5:armhf. 257s Preparing to unpack .../14-libgfortran5_15-20250222-0ubuntu1_armhf.deb ... 257s Unpacking libgfortran5:armhf (15-20250222-0ubuntu1) ... 257s Selecting previously unselected package libgomp1:armhf. 257s Preparing to unpack .../15-libgomp1_15-20250222-0ubuntu1_armhf.deb ... 257s Unpacking libgomp1:armhf (15-20250222-0ubuntu1) ... 257s Selecting previously unselected package libgraphite2-3:armhf. 257s Preparing to unpack .../16-libgraphite2-3_1.3.14-2ubuntu1_armhf.deb ... 257s Unpacking libgraphite2-3:armhf (1.3.14-2ubuntu1) ... 257s Selecting previously unselected package libharfbuzz0b:armhf. 257s Preparing to unpack .../17-libharfbuzz0b_10.2.0-1_armhf.deb ... 257s Unpacking libharfbuzz0b:armhf (10.2.0-1) ... 257s Selecting previously unselected package x11-common. 257s Preparing to unpack .../18-x11-common_1%3a7.7+23ubuntu3_all.deb ... 257s Unpacking x11-common (1:7.7+23ubuntu3) ... 257s Selecting previously unselected package libice6:armhf. 257s Preparing to unpack .../19-libice6_2%3a1.1.1-1_armhf.deb ... 257s Unpacking libice6:armhf (2:1.1.1-1) ... 257s Selecting previously unselected package libjpeg-turbo8:armhf. 257s Preparing to unpack .../20-libjpeg-turbo8_2.1.5-3ubuntu2_armhf.deb ... 257s Unpacking libjpeg-turbo8:armhf (2.1.5-3ubuntu2) ... 257s Selecting previously unselected package libjpeg8:armhf. 257s Preparing to unpack .../21-libjpeg8_8c-2ubuntu11_armhf.deb ... 257s Unpacking libjpeg8:armhf (8c-2ubuntu11) ... 257s Selecting previously unselected package liblapack3:armhf. 258s Preparing to unpack .../22-liblapack3_3.12.1-2_armhf.deb ... 258s Unpacking liblapack3:armhf (3.12.1-2) ... 258s Selecting previously unselected package liblerc4:armhf. 258s Preparing to unpack .../23-liblerc4_4.0.0+ds-5ubuntu1_armhf.deb ... 258s Unpacking liblerc4:armhf (4.0.0+ds-5ubuntu1) ... 258s Selecting previously unselected package libthai-data. 258s Preparing to unpack .../24-libthai-data_0.1.29-2build1_all.deb ... 258s Unpacking libthai-data (0.1.29-2build1) ... 258s Selecting previously unselected package libthai0:armhf. 258s Preparing to unpack .../25-libthai0_0.1.29-2build1_armhf.deb ... 258s Unpacking libthai0:armhf (0.1.29-2build1) ... 258s Selecting previously unselected package libpango-1.0-0:armhf. 258s Preparing to unpack .../26-libpango-1.0-0_1.56.2-1_armhf.deb ... 258s Unpacking libpango-1.0-0:armhf (1.56.2-1) ... 258s Selecting previously unselected package libpangoft2-1.0-0:armhf. 258s Preparing to unpack .../27-libpangoft2-1.0-0_1.56.2-1_armhf.deb ... 258s Unpacking libpangoft2-1.0-0:armhf (1.56.2-1) ... 258s Selecting previously unselected package libpangocairo-1.0-0:armhf. 258s Preparing to unpack .../28-libpangocairo-1.0-0_1.56.2-1_armhf.deb ... 258s Unpacking libpangocairo-1.0-0:armhf (1.56.2-1) ... 258s Selecting previously unselected package libpaper2:armhf. 258s Preparing to unpack .../29-libpaper2_2.2.5-0.3_armhf.deb ... 258s Unpacking libpaper2:armhf (2.2.5-0.3) ... 258s Selecting previously unselected package libpaper-utils. 258s Preparing to unpack .../30-libpaper-utils_2.2.5-0.3_armhf.deb ... 258s Unpacking libpaper-utils (2.2.5-0.3) ... 258s Selecting previously unselected package libsharpyuv0:armhf. 258s Preparing to unpack .../31-libsharpyuv0_1.5.0-0.1_armhf.deb ... 258s Unpacking libsharpyuv0:armhf (1.5.0-0.1) ... 258s Selecting previously unselected package libsm6:armhf. 258s Preparing to unpack .../32-libsm6_2%3a1.2.4-1_armhf.deb ... 258s Unpacking libsm6:armhf (2:1.2.4-1) ... 258s Selecting previously unselected package libtcl8.6:armhf. 258s Preparing to unpack .../33-libtcl8.6_8.6.16+dfsg-1_armhf.deb ... 258s Unpacking libtcl8.6:armhf (8.6.16+dfsg-1) ... 258s Selecting previously unselected package libjbig0:armhf. 258s Preparing to unpack .../34-libjbig0_2.1-6.1ubuntu2_armhf.deb ... 258s Unpacking libjbig0:armhf (2.1-6.1ubuntu2) ... 258s Selecting previously unselected package libwebp7:armhf. 258s Preparing to unpack .../35-libwebp7_1.5.0-0.1_armhf.deb ... 258s Unpacking libwebp7:armhf (1.5.0-0.1) ... 258s Selecting previously unselected package libtiff6:armhf. 258s Preparing to unpack .../36-libtiff6_4.5.1+git230720-4ubuntu4_armhf.deb ... 258s Unpacking libtiff6:armhf (4.5.1+git230720-4ubuntu4) ... 258s Selecting previously unselected package libxft2:armhf. 258s Preparing to unpack .../37-libxft2_2.3.6-1build1_armhf.deb ... 258s Unpacking libxft2:armhf (2.3.6-1build1) ... 258s Selecting previously unselected package libxss1:armhf. 258s Preparing to unpack .../38-libxss1_1%3a1.2.3-1build3_armhf.deb ... 258s Unpacking libxss1:armhf (1:1.2.3-1build3) ... 258s Selecting previously unselected package libtk8.6:armhf. 258s Preparing to unpack .../39-libtk8.6_8.6.16-1_armhf.deb ... 258s Unpacking libtk8.6:armhf (8.6.16-1) ... 259s Selecting previously unselected package libxt6t64:armhf. 259s Preparing to unpack .../40-libxt6t64_1%3a1.2.1-1.2build1_armhf.deb ... 259s Unpacking libxt6t64:armhf (1:1.2.1-1.2build1) ... 259s Selecting previously unselected package zip. 259s Preparing to unpack .../41-zip_3.0-14ubuntu2_armhf.deb ... 259s Unpacking zip (3.0-14ubuntu2) ... 259s Selecting previously unselected package unzip. 259s Preparing to unpack .../42-unzip_6.0-28ubuntu6_armhf.deb ... 259s Unpacking unzip (6.0-28ubuntu6) ... 259s Selecting previously unselected package xdg-utils. 259s Preparing to unpack .../43-xdg-utils_1.2.1-2ubuntu1_all.deb ... 259s Unpacking xdg-utils (1.2.1-2ubuntu1) ... 259s Selecting previously unselected package r-base-core. 259s Preparing to unpack .../44-r-base-core_4.4.3-1_armhf.deb ... 259s Unpacking r-base-core (4.4.3-1) ... 259s Selecting previously unselected package r-cran-iso. 259s Preparing to unpack .../45-r-cran-iso_0.0-21-1_armhf.deb ... 259s Unpacking r-cran-iso (0.0-21-1) ... 259s Selecting previously unselected package r-cran-mcmc. 259s Preparing to unpack .../46-r-cran-mcmc_0.9-8-1_armhf.deb ... 259s Unpacking r-cran-mcmc (0.9-8-1) ... 259s Selecting previously unselected package r-cran-xtable. 259s Preparing to unpack .../47-r-cran-xtable_1%3a1.8-4-2_all.deb ... 259s Unpacking r-cran-xtable (1:1.8-4-2) ... 259s Setting up libgraphite2-3:armhf (1.3.14-2ubuntu1) ... 259s Setting up libpixman-1-0:armhf (0.44.0-3) ... 259s Setting up libsharpyuv0:armhf (1.5.0-0.1) ... 259s Setting up liblerc4:armhf (4.0.0+ds-5ubuntu1) ... 259s Setting up libxrender1:armhf (1:0.9.10-1.1build1) ... 259s Setting up libdatrie1:armhf (0.2.13-3build1) ... 259s Setting up libxcb-render0:armhf (1.17.0-2) ... 259s Setting up unzip (6.0-28ubuntu6) ... 259s Setting up x11-common (1:7.7+23ubuntu3) ... 259s Setting up libdeflate0:armhf (1.23-1) ... 259s Setting up libxcb-shm0:armhf (1.17.0-2) ... 259s Setting up libgomp1:armhf (15-20250222-0ubuntu1) ... 259s Setting up libjbig0:armhf (2.1-6.1ubuntu2) ... 259s Setting up zip (3.0-14ubuntu2) ... 259s Setting up libblas3:armhf (3.12.1-2) ... 259s update-alternatives: using /usr/lib/arm-linux-gnueabihf/blas/libblas.so.3 to provide /usr/lib/arm-linux-gnueabihf/libblas.so.3 (libblas.so.3-arm-linux-gnueabihf) in auto mode 259s Setting up libfreetype6:armhf (2.13.3+dfsg-1) ... 259s Setting up fonts-dejavu-mono (2.37-8) ... 259s Setting up libtcl8.6:armhf (8.6.16+dfsg-1) ... 259s Setting up fonts-dejavu-core (2.37-8) ... 259s Setting up libjpeg-turbo8:armhf (2.1.5-3ubuntu2) ... 259s Setting up libgfortran5:armhf (15-20250222-0ubuntu1) ... 259s Setting up libwebp7:armhf (1.5.0-0.1) ... 259s Setting up libharfbuzz0b:armhf (10.2.0-1) ... 259s Setting up libthai-data (0.1.29-2build1) ... 259s Setting up libxss1:armhf (1:1.2.3-1build3) ... 259s Setting up libpaper2:armhf (2.2.5-0.3) ... 260s Setting up xdg-utils (1.2.1-2ubuntu1) ... 260s update-alternatives: using /usr/bin/xdg-open to provide /usr/bin/open (open) in auto mode 260s Setting up libjpeg8:armhf (8c-2ubuntu11) ... 260s Setting up libice6:armhf (2:1.1.1-1) ... 260s Setting up liblapack3:armhf (3.12.1-2) ... 260s update-alternatives: using /usr/lib/arm-linux-gnueabihf/lapack/liblapack.so.3 to provide /usr/lib/arm-linux-gnueabihf/liblapack.so.3 (liblapack.so.3-arm-linux-gnueabihf) in auto mode 260s Setting up fontconfig-config (2.15.0-2ubuntu1) ... 260s Setting up libpaper-utils (2.2.5-0.3) ... 260s Setting up libthai0:armhf (0.1.29-2build1) ... 260s Setting up libtiff6:armhf (4.5.1+git230720-4ubuntu4) ... 260s Setting up libfontconfig1:armhf (2.15.0-2ubuntu1) ... 260s Setting up libsm6:armhf (2:1.2.4-1) ... 260s Setting up fontconfig (2.15.0-2ubuntu1) ... 262s Regenerating fonts cache... done. 262s Setting up libxft2:armhf (2.3.6-1build1) ... 262s Setting up libtk8.6:armhf (8.6.16-1) ... 262s Setting up libpango-1.0-0:armhf (1.56.2-1) ... 262s Setting up libcairo2:armhf (1.18.2-2) ... 262s Setting up libxt6t64:armhf (1:1.2.1-1.2build1) ... 262s Setting up libpangoft2-1.0-0:armhf (1.56.2-1) ... 262s Setting up libpangocairo-1.0-0:armhf (1.56.2-1) ... 262s Setting up r-base-core (4.4.3-1) ... 262s Creating config file /etc/R/Renviron with new version 262s Setting up r-cran-mcmc (0.9-8-1) ... 262s Setting up r-cran-iso (0.0-21-1) ... 262s Setting up r-cran-xtable (1:1.8-4-2) ... 262s Processing triggers for libc-bin (2.41-1ubuntu2) ... 262s Processing triggers for man-db (2.13.0-1) ... 263s Processing triggers for install-info (7.1.1-1) ... 271s autopkgtest [16:24:20]: test generic: [----------------------- 273s BEGIN TEST tests/accept-batch.R 273s 273s R version 4.4.3 (2025-02-28) -- "Trophy Case" 273s Copyright (C) 2025 The R Foundation for Statistical Computing 273s Platform: arm-unknown-linux-gnueabihf (32-bit) 273s 273s R is free software and comes with ABSOLUTELY NO WARRANTY. 273s You are welcome to redistribute it under certain conditions. 273s Type 'license()' or 'licence()' for distribution details. 273s 273s R is a collaborative project with many contributors. 273s Type 'contributors()' for more information and 273s 'citation()' on how to cite R or R packages in publications. 273s 273s Type 'demo()' for some demos, 'help()' for on-line help, or 273s 'help.start()' for an HTML browser interface to help. 273s Type 'q()' to quit R. 273s 273s > 273s > # new feature batching acceptance rates 273s > 273s > set.seed(42) 273s > 273s > library(mcmc) 273s > 273s > h <- function(x) if (all(x >= 0) && sum(x) <= 1) return(1) else return(-Inf) 273s > out <- metrop(h, rep(0, 5), nbatch = 100, blen = 100, scale = 0.1, 273s + debug = TRUE) 273s > 273s > all.equal(out$accept, mean(out$accept.batch)) 273s [1] TRUE 273s > 273s > foo <- matrix(out$debug.accept, nrow = out$blen) 273s > bar <- colMeans(foo) 273s > all.equal(out$accept.batch, bar) 273s [1] TRUE 273s > 273s > options(digits = 4) # try to keep insanity of computer arithmetic under control 273s > 273s > out$accept 273s [1] 0.2257 273s > t.test(out$accept.batch)$conf.int 273s [1] 0.2124 0.2390 273s attr(,"conf.level") 273s [1] 0.95 273s > 273s > 273s BEGIN TEST tests/circle.R 273s 273s R version 4.4.3 (2025-02-28) -- "Trophy Case" 273s Copyright (C) 2025 The R Foundation for Statistical Computing 273s Platform: arm-unknown-linux-gnueabihf (32-bit) 273s 273s R is free software and comes with ABSOLUTELY NO WARRANTY. 273s You are welcome to redistribute it under certain conditions. 273s Type 'license()' or 'licence()' for distribution details. 273s 273s R is a collaborative project with many contributors. 273s Type 'contributors()' for more information and 273s 'citation()' on how to cite R or R packages in publications. 273s 273s Type 'demo()' for some demos, 'help()' for on-line help, or 273s 'help.start()' for an HTML browser interface to help. 273s Type 'q()' to quit R. 273s 273s > 273s > epsilon <- 1e-15 273s > 273s > library(mcmc) 273s > 273s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 273s > set.seed(42) 273s > 273s > d <- 5 273s > 273s > logh <- function(x) { 273s + if (! is.numeric(x)) stop("x not numeric") 273s + if (length(x) != d) stop("length(x) != d") 273s + fred <- 1 - sum(x^2) 273s + if (fred > 0) return(log(fred)) else return(-Inf) 273s + } 273s > 273s > out.metro <- metrop(logh, rep(0, d), 1e3, scale = 0.01) 273s > out.metro$accept 273s [1] 0.979 273s > 273s > out.metro <- metrop(out.metro, scale = 0.1) 273s > out.metro$accept 273s [1] 0.72 273s > 273s > out.metro <- metrop(out.metro, scale = 0.5) 274s > out.metro$accept 274s [1] 0.16 274s > 274s > out.metro <- metrop(out.metro, scale = 0.4) 274s > out.metro$accept 274s [1] 0.228 274s > 274s > out.metro <- metrop(out.metro, nbatch = 1e2, debug = TRUE) 274s > 274s > all(out.metro$batch[- out.metro$nbatch, ] == out.metro$current[- 1, ]) 274s [1] TRUE 274s > all(out.metro$current[1, ] == out.metro$initial) 274s [1] TRUE 274s > all(out.metro$batch[out.metro$nbatch, ] == out.metro$final) 274s [1] TRUE 274s > 274s > .Random.seed <- out.metro$initial.seed 274s > d <- ncol(out.metro$proposal) 274s > n <- nrow(out.metro$proposal) 274s > my.proposal <- matrix(NA, n, d) 274s > my.u <- double(n) 274s > ska <- out.metro$scale 274s > for (i in 1:n) { 274s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 274s + if (is.na(out.metro$u[i])) { 274s + my.u[i] <- NA 274s + } else { 274s + my.u[i] <- runif(1) 274s + } 274s + } 274s > max(abs(out.metro$proposal - my.proposal)) < epsilon 274s [1] TRUE 274s > all(is.na(out.metro$u) == is.na(my.u)) 274s [1] TRUE 274s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 274s [1] TRUE 274s > 274s > my.curr.log.green <- apply(out.metro$current, 1, logh) 274s > my.prop.log.green <- apply(out.metro$proposal, 1, logh) 274s > all(is.na(out.metro$u) == ((my.prop.log.green == -Inf) | 274s + (my.prop.log.green > my.curr.log.green))) 274s [1] TRUE 274s > foo <- my.prop.log.green - my.curr.log.green 274s > blurfle <- foo - out.metro$log.green 274s > blurfle[foo == -Inf & out.metro$log.green == -Inf] <- 0 274s > max(blurfle) < epsilon 274s [1] TRUE 274s > 274s > my.accept <- (my.prop.log.green > -Inf) & (is.na(my.u) | my.u < exp(foo)) 274s > sum(my.accept) == round(n * out.metro$accept) 274s [1] TRUE 274s > 274s > my.path <- matrix(NA, n, d) 274s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 274s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 274s > 274s > all(my.path == out.metro$batch) 274s [1] TRUE 274s > 274s > 274s BEGIN TEST tests/initseq.R 274s 274s R version 4.4.3 (2025-02-28) -- "Trophy Case" 274s Copyright (C) 2025 The R Foundation for Statistical Computing 274s Platform: arm-unknown-linux-gnueabihf (32-bit) 274s 274s R is free software and comes with ABSOLUTELY NO WARRANTY. 274s You are welcome to redistribute it under certain conditions. 274s Type 'license()' or 'licence()' for distribution details. 274s 274s R is a collaborative project with many contributors. 274s Type 'contributors()' for more information and 274s 'citation()' on how to cite R or R packages in publications. 274s 274s Type 'demo()' for some demos, 'help()' for on-line help, or 274s 'help.start()' for an HTML browser interface to help. 274s Type 'q()' to quit R. 274s 274s > 274s > library(mcmc) 274s > 274s > set.seed(42) 274s > 274s > n <- 1e5 274s > rho <- 0.99 274s > 274s > x <- arima.sim(model = list(ar = rho), n = n) 274s > gamma <- acf(x, lag.max = 1999, type = "covariance", 274s + plot = FALSE)$acf 274s > k <- seq(along = gamma) 274s > Gamma <- gamma[k %% 2 == 1] + gamma[k %% 2 == 0] 274s > k <- min(seq(along = Gamma)[Gamma < 0]) 274s > Gamma <- Gamma[1:k] 274s > Gamma[k] < 0 274s [1] TRUE 274s > Gamma[k] <- 0 274s > 274s > out <- .Call(mcmc:::C_initseq, x - mean(x)) 274s > names(out) 274s [1] "gamma0" "Gamma.pos" "Gamma.dec" "Gamma.con" "var.pos" "var.dec" 274s [7] "var.con" 274s > 274s > all.equal(gamma[1], out$gamma0) 274s [1] TRUE 274s > 274s > length(out$Gamma.pos) == length(Gamma) 274s [1] TRUE 274s > all.equal(out$Gamma.pos, Gamma) 274s [1] TRUE 274s > 274s > Gamma.dec <- cummin(Gamma) 274s > all.equal(out$Gamma.dec, Gamma.dec) 274s [1] TRUE 274s > 274s > ## IGNORE_RDIFF_BEGIN 274s > library(Iso) 274s Iso 0.0-21 274s 274s An "infelicity" in the function ufit() (whereby 274s it was all too easy to conflate the location of 274s the mode with its index in the entries of the 274s "x" argument) has been corrected. To this end, 274s ufit() now has arguments "lmode" (the location 274s of the mode), and "imode" (its index). At most 274s one of these arguments should be specified. See 274s the help for ufit(). 274s > ## IGNORE_RDIFF_END 274s > Gamma.con <- Gamma.dec[1] + cumsum(c(0, pava(diff(Gamma.dec)))) 274s > all.equal(out$Gamma.con, Gamma.con) 274s [1] TRUE 274s > 274s > all.equal(0, min(out$Gamma.pos - out$Gamma.dec)) 274s [1] TRUE 274s > max(diff(out$Gamma.dec)) < sqrt(.Machine$double.eps) 274s [1] TRUE 274s > 274s > all.equal(0, min(out$Gamma.dec - out$Gamma.con)) 274s [1] TRUE 274s > min(diff(diff(out$Gamma.con))) > (- sqrt(.Machine$double.eps)) 274s [1] TRUE 274s > 274s > all.equal(2 * sum(out$Gamma.pos) - out$gamma0, out$var.pos) 274s [1] TRUE 274s > all.equal(2 * sum(out$Gamma.dec) - out$gamma0, out$var.dec) 274s [1] TRUE 274s > all.equal(2 * sum(out$Gamma.con) - out$gamma0, out$var.con) 274s [1] TRUE 274s > 274s > rev(out$Gamma.pos)[1] == 0 274s [1] TRUE 274s > rev(out$Gamma.dec)[1] == 0 274s [1] TRUE 274s > all.equal(rev(out$Gamma.con)[1], 0) 274s [1] TRUE 274s > 274s > 274s BEGIN TEST tests/isotropic.R 274s 274s R version 4.4.3 (2025-02-28) -- "Trophy Case" 274s Copyright (C) 2025 The R Foundation for Statistical Computing 274s Platform: arm-unknown-linux-gnueabihf (32-bit) 274s 274s R is free software and comes with ABSOLUTELY NO WARRANTY. 274s You are welcome to redistribute it under certain conditions. 274s Type 'license()' or 'licence()' for distribution details. 274s 274s R is a collaborative project with many contributors. 274s Type 'contributors()' for more information and 274s 'citation()' on how to cite R or R packages in publications. 274s 274s Type 'demo()' for some demos, 'help()' for on-line help, or 274s 'help.start()' for an HTML browser interface to help. 274s Type 'q()' to quit R. 274s 274s > library(mcmc) 274s > isotropic <- mcmc:::isotropic 274s > isotropic.logjacobian <- mcmc:::isotropic.logjacobian 274s > 274s > # create identity test function 274s > identity <- function(x) x 274s > d.identity <- function(x) 1 274s > 274s > # check that isotropic is length preserving for vectors of lengths 1--1000 274s > all(sapply(1:1000, function(x) length(isotropic(identity)(rep(1, x))) == x)) 275s [1] TRUE 275s > 275s > # test that isotropic(identity) is an identity function 275s > all.equal(isotropic(identity)(1:10), 1:10) 275s [1] TRUE 275s > x <- seq(0, 1, length.out=200) 275s > all.equal(isotropic(identity)(x), x) 275s [1] TRUE 275s > 275s > # make sure that isotropic.logjacobian(identity, d.identity) is a 0 function 275s > all.equal(isotropic.logjacobian(identity, d.identity)(1:10), 0) 275s [1] TRUE 275s > 275s > # make sure that 0 as an input does not cause divide-by-zero errors 275s > all.equal(isotropic(identity)(0), 0) 275s [1] TRUE 275s > all.equal(isotropic(identity)(0 * 1:4), rep(0, 4)) 275s [1] TRUE 275s > all.equal(isotropic.logjacobian(identity, d.identity)(0), 0) 275s [1] TRUE 275s > all.equal(isotropic.logjacobian(identity, d.identity)(0 * 1:4), 0) 275s [1] TRUE 275s > 275s > # try isotropic with f(x) = x^2, then we should get 275s > # istropic(f)(x) := |x| * x 275s > f <- function(x) x^2 275s > all.equal(isotropic(f)(1), 1) 275s [1] TRUE 275s > all.equal(isotropic(f)(c(1, 1)), sqrt(2) * c(1, 1)) 275s [1] TRUE 275s > all.equal(isotropic(f)(c(1, 0, 1)), sqrt(2) * c(1, 0, 1)) 275s [1] TRUE 275s > 275s > # make sure lazy-loading works properly. 275s > g <- function(x) x^2 275s > g.iso <- isotropic(g) 275s > g <- function(x) x 275s > all.equal(g.iso(2), 2*2) 275s [1] TRUE 275s > 275s BEGIN TEST tests/logit.R 275s 275s R version 4.4.3 (2025-02-28) -- "Trophy Case" 275s Copyright (C) 2025 The R Foundation for Statistical Computing 275s Platform: arm-unknown-linux-gnueabihf (32-bit) 275s 275s R is free software and comes with ABSOLUTELY NO WARRANTY. 275s You are welcome to redistribute it under certain conditions. 275s Type 'license()' or 'licence()' for distribution details. 275s 275s R is a collaborative project with many contributors. 275s Type 'contributors()' for more information and 275s 'citation()' on how to cite R or R packages in publications. 275s 275s Type 'demo()' for some demos, 'help()' for on-line help, or 275s 'help.start()' for an HTML browser interface to help. 275s Type 'q()' to quit R. 275s 275s > 275s > epsilon <- 1e-15 275s > 275s > library(mcmc) 275s > 275s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 275s > set.seed(42) 275s > 275s > options(digits = 3) 275s > 275s > n <- 100 275s > rho <- 0.5 275s > beta0 <- 0.25 275s > beta1 <- 1 275s > beta2 <- 0.5 275s > 275s > x1 <- rnorm(n) 275s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 275s > eta <- beta0 + beta1 * x1 + beta2 * x2 275s > p <- 1 / (1 + exp(- eta)) 275s > y <- as.numeric(runif(n) < p) 275s > 275s > out <- glm(y ~ x1 + x2, family = binomial()) 275s > ## IGNORE_RDIFF_BEGIN 275s > summary(out) 275s 275s Call: 275s glm(formula = y ~ x1 + x2, family = binomial()) 275s 275s Coefficients: 275s Estimate Std. Error z value Pr(>|z|) 275s (Intercept) 0.0599 0.2477 0.24 0.80905 275s x1 1.3682 0.3844 3.56 0.00037 *** 275s x2 0.4760 0.3135 1.52 0.12886 275s --- 275s Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 275s 275s (Dispersion parameter for binomial family taken to be 1) 275s 275s Null deviance: 138.469 on 99 degrees of freedom 275s Residual deviance: 99.293 on 97 degrees of freedom 275s AIC: 105.3 275s 275s Number of Fisher Scoring iterations: 5 275s 275s > ## IGNORE_RDIFF_END 275s > 275s > mlogl <- function(beta) { 275s + if (length(beta) != 3) stop("length(beta) != 3") 275s + beta0 <- beta[1] 275s + beta1 <- beta[2] 275s + beta2 <- beta[3] 275s + eta <- beta0 + beta1 * x1 + beta2 * x2 275s + p <- exp(eta) / (1 + exp(eta)) 275s + return(- sum(log(p[y == 1])) - sum(log(1 - p[y == 0]))) 275s + } 275s > 275s > ## IGNORE_RDIFF_BEGIN 275s > out.nlm <- nlm(mlogl, coefficients(out), print.level = 2) 275s iteration = 0 275s Parameter: 275s [1] 0.0599 1.3682 0.4760 275s Function Value 275s [1] 49.6 275s Gradient: 275s [1] 8.24e-06 5.50e-06 6.08e-06 275s 275s Relative gradient close to zero. 275s Current iterate is probably solution. 275s 275s > ## IGNORE_RDIFF_END 275s > 275s > logl <- function(beta) { 275s + if (length(beta) != 3) stop("length(beta) != 3") 275s + beta0 <- beta[1] 275s + beta1 <- beta[2] 275s + beta2 <- beta[3] 275s + eta <- beta0 + beta1 * x1 + beta2 * x2 275s + p <- exp(eta) / (1 + exp(eta)) 275s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 275s + } 275s > 275s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 275s > out.metro$accept 275s [1] 0.982 275s > 275s > out.metro <- metrop(out.metro, scale = 0.1) 275s > out.metro$accept 275s [1] 0.795 275s > 275s > out.metro <- metrop(out.metro, scale = 0.5) 275s > out.metro$accept 275s [1] 0.264 275s > 275s > apply(out.metro$batch, 2, mean) 275s [1] 0.0608 1.4230 0.5263 275s > var(out.metro$batch) 275s [,1] [,2] [,3] 275s [1,] 0.06755 -0.0108 0.00989 275s [2,] -0.01080 0.1758 -0.06155 275s [3,] 0.00989 -0.0615 0.10483 275s > olbm(out.metro$batch, 25) 275s [,1] [,2] [,3] 275s [1,] 4.54e-04 9.47e-05 -1.92e-05 275s [2,] 9.47e-05 1.84e-03 -6.45e-04 275s [3,] -1.92e-05 -6.45e-04 9.09e-04 275s > 275s > saveseed <- .Random.seed 275s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 275s + scale = 0.5, debug = TRUE) 275s > 275s > all(out.metro$batch[- out.metro$nbatch, ] == out.metro$current[- 1, ]) 275s [1] TRUE 275s > all(out.metro$current[1, ] == out.metro$initial) 275s [1] TRUE 275s > all(out.metro$batch[out.metro$nbatch, ] == out.metro$final) 275s [1] TRUE 275s > 275s > .Random.seed <- saveseed 275s > d <- ncol(out.metro$proposal) 275s > n <- nrow(out.metro$proposal) 275s > my.proposal <- matrix(NA, n, d) 275s > my.u <- double(n) 275s > ska <- out.metro$scale 275s > for (i in 1:n) { 275s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 275s + if (is.na(out.metro$u[i])) { 275s + my.u[i] <- NA 275s + } else { 275s + my.u[i] <- runif(1) 275s + } 275s + } 275s > max(abs(out.metro$proposal - my.proposal)) < epsilon 275s [1] TRUE 275s > all(is.na(out.metro$u) == is.na(my.u)) 275s [1] TRUE 275s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 275s [1] TRUE 275s > 275s > my.curr.log.green <- apply(out.metro$current, 1, logl) 275s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 275s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 275s [1] TRUE 275s > foo <- my.prop.log.green - my.curr.log.green 275s > max(abs(foo - out.metro$log.green)) < epsilon 275s [1] TRUE 275s > 275s > my.accept <- is.na(my.u) | my.u < exp(foo) 275s > sum(my.accept) == round(n * out.metro$accept) 275s [1] TRUE 275s > 275s > my.path <- matrix(NA, n, d) 275s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 275s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 275s > 275s > all(my.path == out.metro$batch) 275s [1] TRUE 275s > 275s > 275s BEGIN TEST tests/logitbat.R 275s 275s R version 4.4.3 (2025-02-28) -- "Trophy Case" 275s Copyright (C) 2025 The R Foundation for Statistical Computing 275s Platform: arm-unknown-linux-gnueabihf (32-bit) 275s 275s R is free software and comes with ABSOLUTELY NO WARRANTY. 275s You are welcome to redistribute it under certain conditions. 275s Type 'license()' or 'licence()' for distribution details. 275s 275s R is a collaborative project with many contributors. 275s Type 'contributors()' for more information and 275s 'citation()' on how to cite R or R packages in publications. 275s 275s Type 'demo()' for some demos, 'help()' for on-line help, or 275s 'help.start()' for an HTML browser interface to help. 275s Type 'q()' to quit R. 275s 276s > 276s > # test batching (blen) 276s > 276s > epsilon <- 1e-15 276s > 276s > library(mcmc) 276s > 276s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 276s > set.seed(42) 276s > 276s > n <- 100 276s > rho <- 0.5 276s > beta0 <- 0.25 276s > beta1 <- 1 276s > beta2 <- 0.5 276s > 276s > x1 <- rnorm(n) 276s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 276s > eta <- beta0 + beta1 * x1 + beta2 * x2 276s > p <- 1 / (1 + exp(- eta)) 276s > y <- as.numeric(runif(n) < p) 276s > 276s > out <- glm(y ~ x1 + x2, family = binomial()) 276s > 276s > logl <- function(beta) { 276s + if (length(beta) != 3) stop("length(beta) != 3") 276s + beta0 <- beta[1] 276s + beta1 <- beta[2] 276s + beta2 <- beta[3] 276s + eta <- beta0 + beta1 * x1 + beta2 * x2 276s + p <- exp(eta) / (1 + exp(eta)) 276s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 276s + } 276s > 276s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 276s > out.metro$accept 276s [1] 0.982 276s > 276s > out.metro <- metrop(out.metro, scale = 0.1) 276s > out.metro$accept 276s [1] 0.795 276s > 276s > out.metro <- metrop(out.metro, scale = 0.5) 276s > out.metro$accept 276s [1] 0.264 276s > 276s > apply(out.metro$batch, 2, mean) 276s [1] 0.06080257 1.42304941 0.52634149 276s > 276s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 276s + scale = 0.5, debug = TRUE, blen = 5) 276s > 276s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 276s > niter == nrow(out.metro$current) 276s [1] TRUE 276s > niter == nrow(out.metro$proposal) 276s [1] TRUE 276s > all(out.metro$current[1, ] == out.metro$initial) 276s [1] TRUE 276s > all(out.metro$current[niter, ] == out.metro$final) | 276s + all(out.metro$proposal[niter, ] == out.metro$final) 276s [1] TRUE 276s > 276s > .Random.seed <- out.metro$initial.seed 276s > d <- ncol(out.metro$proposal) 276s > n <- nrow(out.metro$proposal) 276s > my.proposal <- matrix(NA, n, d) 276s > my.u <- double(n) 276s > ska <- out.metro$scale 276s > for (i in 1:n) { 276s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 276s + if (is.na(out.metro$u[i])) { 276s + my.u[i] <- NA 276s + } else { 276s + my.u[i] <- runif(1) 276s + } 276s + } 276s > max(abs(out.metro$proposal - my.proposal)) < epsilon 276s [1] TRUE 276s > all(is.na(out.metro$u) == is.na(my.u)) 276s [1] TRUE 276s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 276s [1] TRUE 276s > 276s > my.curr.log.green <- apply(out.metro$current, 1, logl) 276s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 276s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 276s [1] TRUE 276s > foo <- my.prop.log.green - my.curr.log.green 276s > max(abs(foo - out.metro$log.green)) < epsilon 276s [1] TRUE 276s > 276s > my.accept <- is.na(my.u) | my.u < exp(foo) 276s > sum(my.accept) == round(n * out.metro$accept) 276s [1] TRUE 276s > if (my.accept[niter]) { 276s + all(out.metro$proposal[niter, ] == out.metro$final) 276s + } else { 276s + all(out.metro$current[niter, ] == out.metro$final) 276s + } 276s [1] TRUE 276s > 276s > my.current <- out.metro$current 276s > my.current[my.accept, ] <- my.proposal[my.accept, ] 276s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 276s > max(abs(out.metro$current - my.current)) < epsilon 276s [1] TRUE 276s > 276s > my.path <- matrix(NA, n, d) 276s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 276s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 276s > nspac <- out.metro$nspac 276s > 276s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 276s > 276s > foom <- array(as.vector(t(my.path)), c(d, out.metro$blen, out.metro$nbatch)) 276s > boom <- t(apply(foom, c(1, 3), mean)) 276s > 276s > all(dim(boom) == dim(out.metro$batch)) 276s [1] TRUE 276s > max(abs(boom - out.metro$batch)) < epsilon 276s [1] TRUE 276s > 276s > 276s BEGIN TEST tests/logitfun.R 276s 276s R version 4.4.3 (2025-02-28) -- "Trophy Case" 276s Copyright (C) 2025 The R Foundation for Statistical Computing 276s Platform: arm-unknown-linux-gnueabihf (32-bit) 276s 276s R is free software and comes with ABSOLUTELY NO WARRANTY. 276s You are welcome to redistribute it under certain conditions. 276s Type 'license()' or 'licence()' for distribution details. 276s 276s R is a collaborative project with many contributors. 276s Type 'contributors()' for more information and 276s 'citation()' on how to cite R or R packages in publications. 276s 276s Type 'demo()' for some demos, 'help()' for on-line help, or 276s 'help.start()' for an HTML browser interface to help. 276s Type 'q()' to quit R. 276s 276s > 276s > # test outfun (function) 276s > 276s > epsilon <- 1e-15 276s > 276s > library(mcmc) 276s > 276s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 276s > set.seed(42) 276s > 276s > n <- 100 276s > rho <- 0.5 276s > beta0 <- 0.25 276s > beta1 <- 1 276s > beta2 <- 0.5 276s > 276s > x1 <- rnorm(n) 276s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 276s > eta <- beta0 + beta1 * x1 + beta2 * x2 276s > p <- 1 / (1 + exp(- eta)) 276s > y <- as.numeric(runif(n) < p) 276s > 276s > out <- glm(y ~ x1 + x2, family = binomial()) 276s > 276s > logl <- function(beta) { 276s + if (length(beta) != 3) stop("length(beta) != 3") 276s + beta0 <- beta[1] 276s + beta1 <- beta[2] 276s + beta2 <- beta[3] 276s + eta <- beta0 + beta1 * x1 + beta2 * x2 276s + p <- exp(eta) / (1 + exp(eta)) 276s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 276s + } 276s > 276s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 276s > out.metro$accept 276s [1] 0.982 276s > 276s > out.metro <- metrop(out.metro, scale = 0.1) 276s > out.metro$accept 276s [1] 0.795 276s > 276s > out.metro <- metrop(out.metro, scale = 0.5) 276s > out.metro$accept 276s [1] 0.264 276s > 276s > apply(out.metro$batch, 2, mean) 276s [1] 0.06080257 1.42304941 0.52634149 276s > 276s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 276s + scale = 0.5, debug = TRUE, outfun = function(x) c(x, x^2)) 276s > 276s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 276s > niter == nrow(out.metro$current) 276s [1] TRUE 276s > niter == nrow(out.metro$proposal) 276s [1] TRUE 276s > all(out.metro$current[1, ] == out.metro$initial) 276s [1] TRUE 276s > all(out.metro$current[niter, ] == out.metro$final) | 276s + all(out.metro$proposal[niter, ] == out.metro$final) 276s [1] TRUE 276s > 276s > .Random.seed <- out.metro$initial.seed 276s > d <- ncol(out.metro$proposal) 276s > n <- nrow(out.metro$proposal) 276s > my.proposal <- matrix(NA, n, d) 276s > my.u <- double(n) 276s > ska <- out.metro$scale 276s > for (i in 1:n) { 276s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 276s + if (is.na(out.metro$u[i])) { 276s + my.u[i] <- NA 276s + } else { 276s + my.u[i] <- runif(1) 276s + } 276s + } 276s > max(abs(out.metro$proposal - my.proposal)) < epsilon 276s [1] TRUE 276s > all(is.na(out.metro$u) == is.na(my.u)) 276s [1] TRUE 276s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 276s [1] TRUE 276s > 276s > my.curr.log.green <- apply(out.metro$current, 1, logl) 276s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 276s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 276s [1] TRUE 276s > foo <- my.prop.log.green - my.curr.log.green 276s > max(abs(foo - out.metro$log.green)) < epsilon 276s [1] TRUE 276s > 276s > my.accept <- is.na(my.u) | my.u < exp(foo) 276s > sum(my.accept) == round(n * out.metro$accept) 276s [1] TRUE 276s > if (my.accept[niter]) { 276s + all(out.metro$proposal[niter, ] == out.metro$final) 276s + } else { 276s + all(out.metro$current[niter, ] == out.metro$final) 276s + } 276s [1] TRUE 276s > 276s > my.current <- out.metro$current 276s > my.current[my.accept, ] <- my.proposal[my.accept, ] 276s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 276s > max(abs(out.metro$current - my.current)) < epsilon 276s [1] TRUE 276s > 276s > my.path <- matrix(NA, n, d) 276s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 276s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 276s > nspac <- out.metro$nspac 276s > 276s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 276s > 276s > fred <- t(apply(my.path, 1, out.metro$outfun)) 276s > k <- ncol(fred) 276s > 276s > foom <- array(as.vector(t(fred)), c(k, out.metro$blen, out.metro$nbatch)) 276s > boom <- t(apply(foom, c(1, 3), mean)) 276s > 276s > all(dim(boom) == dim(out.metro$batch)) 276s [1] TRUE 276s > max(abs(boom - out.metro$batch)) < epsilon 276s [1] TRUE 276s > 276s > goom <- cbind(my.path, my.path^2) 276s > all(dim(goom) == dim(out.metro$batch)) 276s [1] TRUE 276s > max(abs(goom - out.metro$batch)) < epsilon 276s [1] TRUE 276s > 276s BEGIN TEST tests/logitfunarg.R 276s 276s R version 4.4.3 (2025-02-28) -- "Trophy Case" 276s Copyright (C) 2025 The R Foundation for Statistical Computing 276s Platform: arm-unknown-linux-gnueabihf (32-bit) 276s 276s R is free software and comes with ABSOLUTELY NO WARRANTY. 276s You are welcome to redistribute it under certain conditions. 276s Type 'license()' or 'licence()' for distribution details. 276s 276s R is a collaborative project with many contributors. 276s Type 'contributors()' for more information and 276s 'citation()' on how to cite R or R packages in publications. 276s 276s Type 'demo()' for some demos, 'help()' for on-line help, or 276s 'help.start()' for an HTML browser interface to help. 276s Type 'q()' to quit R. 276s 277s > 277s > # test outfun (function) 277s > 277s > epsilon <- 1e-15 277s > 277s > library(mcmc) 277s > 277s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 277s > set.seed(42) 277s > 277s > n <- 100 277s > rho <- 0.5 277s > beta0 <- 0.25 277s > beta1 <- 1 277s > beta2 <- 0.5 277s > 277s > x1 <- rnorm(n) 277s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 277s > eta <- beta0 + beta1 * x1 + beta2 * x2 277s > p <- 1 / (1 + exp(- eta)) 277s > y <- as.numeric(runif(n) < p) 277s > 277s > out <- glm(y ~ x1 + x2, family = binomial()) 277s > 277s > logl <- function(beta) { 277s + if (length(beta) != 3) stop("length(beta) != 3") 277s + beta0 <- beta[1] 277s + beta1 <- beta[2] 277s + beta2 <- beta[3] 277s + eta <- beta0 + beta1 * x1 + beta2 * x2 277s + p <- exp(eta) / (1 + exp(eta)) 277s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 277s + } 277s > 277s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 277s > out.metro$accept 277s [1] 0.982 277s > 277s > out.metro <- metrop(out.metro, scale = 0.1) 277s > out.metro$accept 277s [1] 0.795 277s > 277s > out.metro <- metrop(out.metro, scale = 0.5) 277s > out.metro$accept 277s [1] 0.264 277s > 277s > apply(out.metro$batch, 2, mean) 277s [1] 0.06080257 1.42304941 0.52634149 277s > 277s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 277s + scale = 0.5, debug = TRUE, outfun = function(x) c(x, x^2)) 277s > 277s > out.metro <- metrop(out.metro) 277s > out.metro$outfun 277s function (x) 277s c(x, x^2) 277s 277s > dim(out.metro$batch) 277s [1] 100 6 277s > 277s > logl <- function(beta, x1, x2, y) { 277s + if (length(beta) != 3) stop("length(beta) != 3") 277s + beta0 <- beta[1] 277s + beta1 <- beta[2] 277s + beta2 <- beta[3] 277s + eta <- beta0 + beta1 * x1 + beta2 * x2 277s + p <- exp(eta) / (1 + exp(eta)) 277s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 277s + } 277s > 277s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 277s + scale = 0.5, debug = TRUE, x1 = x1, x2 = x2, y = y) 277s > out.metro$lud 277s function (beta, x1, x2, y) 277s { 277s if (length(beta) != 3) 277s stop("length(beta) != 3") 277s beta0 <- beta[1] 277s beta1 <- beta[2] 277s beta2 <- beta[3] 277s eta <- beta0 + beta1 * x1 + beta2 * x2 277s p <- exp(eta)/(1 + exp(eta)) 277s return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 277s } 277s > out.metro <- metrop(out.metro, x1 = x1, x2 = x2, y = y) 277s > out.metro$lud 277s function (beta, x1, x2, y) 277s { 277s if (length(beta) != 3) 277s stop("length(beta) != 3") 277s beta0 <- beta[1] 277s beta1 <- beta[2] 277s beta2 <- beta[3] 277s eta <- beta0 + beta1 * x1 + beta2 * x2 277s p <- exp(eta)/(1 + exp(eta)) 277s return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 277s } 277s > 277s > 277s BEGIN TEST tests/logitidx.R 277s 277s R version 4.4.3 (2025-02-28) -- "Trophy Case" 277s Copyright (C) 2025 The R Foundation for Statistical Computing 277s Platform: arm-unknown-linux-gnueabihf (32-bit) 277s 277s R is free software and comes with ABSOLUTELY NO WARRANTY. 277s You are welcome to redistribute it under certain conditions. 277s Type 'license()' or 'licence()' for distribution details. 277s 277s R is a collaborative project with many contributors. 277s Type 'contributors()' for more information and 277s 'citation()' on how to cite R or R packages in publications. 277s 277s Type 'demo()' for some demos, 'help()' for on-line help, or 277s 'help.start()' for an HTML browser interface to help. 277s Type 'q()' to quit R. 277s 277s > 277s > # test outfun (positive index vector) 277s > 277s > epsilon <- 1e-15 277s > 277s > library(mcmc) 277s > 277s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 277s > set.seed(42) 277s > 277s > n <- 100 277s > rho <- 0.5 277s > beta0 <- 0.25 277s > beta1 <- 1 277s > beta2 <- 0.5 277s > 277s > x1 <- rnorm(n) 277s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 277s > eta <- beta0 + beta1 * x1 + beta2 * x2 277s > p <- 1 / (1 + exp(- eta)) 277s > y <- as.numeric(runif(n) < p) 277s > 277s > out <- glm(y ~ x1 + x2, family = binomial()) 277s > 277s > logl <- function(beta) { 277s + if (length(beta) != 3) stop("length(beta) != 3") 277s + beta0 <- beta[1] 277s + beta1 <- beta[2] 277s + beta2 <- beta[3] 277s + eta <- beta0 + beta1 * x1 + beta2 * x2 277s + p <- exp(eta) / (1 + exp(eta)) 277s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 277s + } 277s > 277s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 277s > out.metro$accept 277s [1] 0.982 277s > 277s > out.metro <- metrop(out.metro, scale = 0.1) 277s > out.metro$accept 277s [1] 0.795 277s > 277s > out.metro <- metrop(out.metro, scale = 0.5) 277s > out.metro$accept 277s [1] 0.264 277s > 277s > apply(out.metro$batch, 2, mean) 277s [1] 0.06080257 1.42304941 0.52634149 277s > 277s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 277s + scale = 0.5, debug = TRUE, outfun = c(2, 3)) 277s > 277s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 277s > niter == nrow(out.metro$current) 277s [1] TRUE 277s > niter == nrow(out.metro$proposal) 277s [1] TRUE 277s > all(out.metro$current[1, ] == out.metro$initial) 277s [1] TRUE 277s > all(out.metro$current[niter, ] == out.metro$final) | 277s + all(out.metro$proposal[niter, ] == out.metro$final) 277s [1] TRUE 277s > 277s > .Random.seed <- out.metro$initial.seed 277s > d <- ncol(out.metro$proposal) 277s > n <- nrow(out.metro$proposal) 277s > my.proposal <- matrix(NA, n, d) 277s > my.u <- double(n) 277s > ska <- out.metro$scale 277s > for (i in 1:n) { 277s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 277s + if (is.na(out.metro$u[i])) { 277s + my.u[i] <- NA 277s + } else { 277s + my.u[i] <- runif(1) 277s + } 277s + } 277s > max(abs(out.metro$proposal - my.proposal)) < epsilon 277s [1] TRUE 277s > all(is.na(out.metro$u) == is.na(my.u)) 277s [1] TRUE 277s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 277s [1] TRUE 277s > 277s > my.curr.log.green <- apply(out.metro$current, 1, logl) 277s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 277s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 277s [1] TRUE 277s > foo <- my.prop.log.green - my.curr.log.green 277s > max(abs(foo - out.metro$log.green)) < epsilon 277s [1] TRUE 277s > 277s > my.accept <- is.na(my.u) | my.u < exp(foo) 277s > sum(my.accept) == round(n * out.metro$accept) 277s [1] TRUE 277s > if (my.accept[niter]) { 277s + all(out.metro$proposal[niter, ] == out.metro$final) 277s + } else { 277s + all(out.metro$current[niter, ] == out.metro$final) 277s + } 277s [1] TRUE 277s > 277s > my.current <- out.metro$current 277s > my.current[my.accept, ] <- my.proposal[my.accept, ] 277s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 277s > max(abs(out.metro$current - my.current)) < epsilon 277s [1] TRUE 277s > 277s > my.path <- matrix(NA, n, d) 277s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 277s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 277s > nspac <- out.metro$nspac 277s > 277s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 277s > 277s > fred <- my.path[ , out.metro$outfun] 277s > k <- ncol(fred) 277s > 277s > foom <- array(as.vector(t(fred)), c(k, out.metro$blen, out.metro$nbatch)) 277s > boom <- t(apply(foom, c(1, 3), mean)) 277s > 277s > all(dim(boom) == dim(out.metro$batch)) 277s [1] TRUE 277s > max(abs(boom - out.metro$batch)) < epsilon 277s [1] TRUE 277s > 277s > 277s BEGIN TEST tests/logitlogidx.R 277s 277s R version 4.4.3 (2025-02-28) -- "Trophy Case" 277s Copyright (C) 2025 The R Foundation for Statistical Computing 277s Platform: arm-unknown-linux-gnueabihf (32-bit) 277s 277s R is free software and comes with ABSOLUTELY NO WARRANTY. 277s You are welcome to redistribute it under certain conditions. 277s Type 'license()' or 'licence()' for distribution details. 277s 277s R is a collaborative project with many contributors. 277s Type 'contributors()' for more information and 277s 'citation()' on how to cite R or R packages in publications. 277s 277s Type 'demo()' for some demos, 'help()' for on-line help, or 277s 'help.start()' for an HTML browser interface to help. 277s Type 'q()' to quit R. 277s 277s > 277s > # test outfun (logical index vector) 277s > 277s > epsilon <- 1e-15 277s > 277s > library(mcmc) 277s > 277s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 277s > set.seed(42) 277s > 277s > n <- 100 277s > rho <- 0.5 277s > beta0 <- 0.25 277s > beta1 <- 1 277s > beta2 <- 0.5 277s > 277s > x1 <- rnorm(n) 277s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 277s > eta <- beta0 + beta1 * x1 + beta2 * x2 277s > p <- 1 / (1 + exp(- eta)) 277s > y <- as.numeric(runif(n) < p) 277s > 277s > out <- glm(y ~ x1 + x2, family = binomial()) 277s > 277s > logl <- function(beta) { 277s + if (length(beta) != 3) stop("length(beta) != 3") 277s + beta0 <- beta[1] 277s + beta1 <- beta[2] 277s + beta2 <- beta[3] 277s + eta <- beta0 + beta1 * x1 + beta2 * x2 277s + p <- exp(eta) / (1 + exp(eta)) 277s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 277s + } 277s > 277s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 278s > out.metro$accept 278s [1] 0.982 278s > 278s > out.metro <- metrop(out.metro, scale = 0.1) 278s > out.metro$accept 278s [1] 0.795 278s > 278s > out.metro <- metrop(out.metro, scale = 0.5) 278s > out.metro$accept 278s [1] 0.264 278s > 278s > apply(out.metro$batch, 2, mean) 278s [1] 0.06080257 1.42304941 0.52634149 278s > 278s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 278s + scale = 0.5, debug = TRUE, outfun = seq(1:3) > 1) 278s > 278s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 278s > niter == nrow(out.metro$current) 278s [1] TRUE 278s > niter == nrow(out.metro$proposal) 278s [1] TRUE 278s > all(out.metro$current[1, ] == out.metro$initial) 278s [1] TRUE 278s > all(out.metro$current[niter, ] == out.metro$final) | 278s + all(out.metro$proposal[niter, ] == out.metro$final) 278s [1] TRUE 278s > 278s > .Random.seed <- out.metro$initial.seed 278s > d <- ncol(out.metro$proposal) 278s > n <- nrow(out.metro$proposal) 278s > my.proposal <- matrix(NA, n, d) 278s > my.u <- double(n) 278s > ska <- out.metro$scale 278s > for (i in 1:n) { 278s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 278s + if (is.na(out.metro$u[i])) { 278s + my.u[i] <- NA 278s + } else { 278s + my.u[i] <- runif(1) 278s + } 278s + } 278s > max(abs(out.metro$proposal - my.proposal)) < epsilon 278s [1] TRUE 278s > all(is.na(out.metro$u) == is.na(my.u)) 278s [1] TRUE 278s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 278s [1] TRUE 278s > 278s > my.curr.log.green <- apply(out.metro$current, 1, logl) 278s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 278s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 278s [1] TRUE 278s > foo <- my.prop.log.green - my.curr.log.green 278s > max(abs(foo - out.metro$log.green)) < epsilon 278s [1] TRUE 278s > 278s > my.accept <- is.na(my.u) | my.u < exp(foo) 278s > sum(my.accept) == round(n * out.metro$accept) 278s [1] TRUE 278s > if (my.accept[niter]) { 278s + all(out.metro$proposal[niter, ] == out.metro$final) 278s + } else { 278s + all(out.metro$current[niter, ] == out.metro$final) 278s + } 278s [1] TRUE 278s > 278s > my.current <- out.metro$current 278s > my.current[my.accept, ] <- my.proposal[my.accept, ] 278s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 278s > max(abs(out.metro$current - my.current)) < epsilon 278s [1] TRUE 278s > 278s > my.path <- matrix(NA, n, d) 278s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 278s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 278s > nspac <- out.metro$nspac 278s > 278s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 278s > 278s > fred <- my.path[ , out.metro$outfun] 278s > k <- ncol(fred) 278s > 278s > foom <- array(as.vector(t(fred)), c(k, out.metro$blen, out.metro$nbatch)) 278s > boom <- t(apply(foom, c(1, 3), mean)) 278s > 278s > all(dim(boom) == dim(out.metro$batch)) 278s [1] TRUE 278s > max(abs(boom - out.metro$batch)) < epsilon 278s [1] TRUE 278s > 278s > 278s BEGIN TEST tests/logitmat.R 278s 278s R version 4.4.3 (2025-02-28) -- "Trophy Case" 278s Copyright (C) 2025 The R Foundation for Statistical Computing 278s Platform: arm-unknown-linux-gnueabihf (32-bit) 278s 278s R is free software and comes with ABSOLUTELY NO WARRANTY. 278s You are welcome to redistribute it under certain conditions. 278s Type 'license()' or 'licence()' for distribution details. 278s 278s R is a collaborative project with many contributors. 278s Type 'contributors()' for more information and 278s 'citation()' on how to cite R or R packages in publications. 278s 278s Type 'demo()' for some demos, 'help()' for on-line help, or 278s 'help.start()' for an HTML browser interface to help. 278s Type 'q()' to quit R. 278s 278s > 278s > # test matrix scaling 278s > 278s > epsilon <- 1e-15 278s > 278s > library(mcmc) 278s > 278s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 278s > set.seed(42) 278s > 278s > n <- 100 278s > rho <- 0.5 278s > beta0 <- 0.25 278s > beta1 <- 1 278s > beta2 <- 0.5 278s > 278s > x1 <- rnorm(n) 278s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 278s > eta <- beta0 + beta1 * x1 + beta2 * x2 278s > p <- 1 / (1 + exp(- eta)) 278s > y <- as.numeric(runif(n) < p) 278s > 278s > out <- glm(y ~ x1 + x2, family = binomial()) 278s > 278s > logl <- function(beta) { 278s + if (length(beta) != 3) stop("length(beta) != 3") 278s + beta0 <- beta[1] 278s + beta1 <- beta[2] 278s + beta2 <- beta[3] 278s + eta <- beta0 + beta1 * x1 + beta2 * x2 278s + p <- exp(eta) / (1 + exp(eta)) 278s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 278s + } 278s > 278s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 278s > out.metro$accept 278s [1] 0.982 278s > 278s > out.metro <- metrop(out.metro, scale = 0.1) 278s > out.metro$accept 278s [1] 0.795 278s > 278s > out.metro <- metrop(out.metro, scale = 0.5) 278s > out.metro$accept 278s [1] 0.264 278s > 278s > apply(out.metro$batch, 2, mean) 278s [1] 0.06080257 1.42304941 0.52634149 278s > fred <- var(out.metro$batch) 278s > sally <- t(chol(fred)) 278s > max(abs(fred - sally %*% t(sally))) < epsilon 278s [1] TRUE 278s > 278s > out.metro <- metrop(out.metro, scale = sally) 278s > out.metro$accept 278s [1] 0.451 278s > 278s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 278s + scale = sally, debug = TRUE) 278s > names(out.metro) 278s [1] "accept" "batch" "initial" "final" "accept.batch" 278s [6] "current" "proposal" "log.green" "u" "z" 278s [11] "debug.accept" "initial.seed" "final.seed" "time" "lud" 278s [16] "nbatch" "blen" "nspac" "scale" "debug" 278s > 278s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 278s > niter == nrow(out.metro$current) 278s [1] TRUE 278s > niter == nrow(out.metro$proposal) 278s [1] TRUE 278s > all(out.metro$current[1, ] == out.metro$initial) 278s [1] TRUE 278s > all(out.metro$current[niter, ] == out.metro$final) | 278s + all(out.metro$proposal[niter, ] == out.metro$final) 278s [1] TRUE 278s > 278s > .Random.seed <- out.metro$initial.seed 278s > d <- ncol(out.metro$proposal) 278s > n <- nrow(out.metro$proposal) 278s > my.proposal <- matrix(NA, n, d) 278s > my.u <- double(n) 278s > my.z <- matrix(NA, n, d) 278s > ska <- out.metro$scale 278s > for (i in 1:n) { 278s + zed <- rnorm(d) 278s + my.proposal[i, ] <- out.metro$current[i, ] + ska %*% zed 278s + if (is.na(out.metro$u[i])) { 278s + my.u[i] <- NA 278s + } else { 278s + my.u[i] <- runif(1) 278s + } 278s + my.z[i, ] <- zed 278s + } 278s > max(abs(out.metro$proposal - my.proposal)) < epsilon 278s [1] TRUE 278s > 278s > all(is.na(out.metro$u) == is.na(my.u)) 278s [1] TRUE 278s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 278s [1] TRUE 278s > identical(out.metro$z, my.z) 278s [1] TRUE 278s > 278s > my.curr.log.green <- apply(out.metro$current, 1, logl) 278s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 278s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 278s [1] TRUE 278s > foo <- my.prop.log.green - my.curr.log.green 278s > max(abs(foo - out.metro$log.green)) < epsilon 278s [1] TRUE 278s > 278s > my.accept <- is.na(my.u) | my.u < exp(foo) 278s > sum(my.accept) == round(n * out.metro$accept) 278s [1] TRUE 278s > if (my.accept[niter]) { 278s + all(out.metro$proposal[niter, ] == out.metro$final) 278s + } else { 278s + all(out.metro$current[niter, ] == out.metro$final) 278s + } 278s [1] TRUE 278s > identical(my.accept, out.metro$debug.accept) 278s [1] TRUE 278s > 278s > my.current <- out.metro$current 278s > my.current[my.accept, ] <- my.proposal[my.accept, ] 278s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 278s > max(abs(out.metro$current - my.current)) < epsilon 278s [1] TRUE 278s > 278s > my.path <- matrix(NA, n, d) 278s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 278s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 278s > nspac <- out.metro$nspac 278s > 278s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 278s > 278s > fred <- my.path 278s > k <- ncol(fred) 278s > 278s > foom <- array(as.vector(t(fred)), c(k, out.metro$blen, out.metro$nbatch)) 278s > boom <- t(apply(foom, c(1, 3), mean)) 278s > 278s > all(dim(boom) == dim(out.metro$batch)) 278s [1] TRUE 278s > max(abs(boom - out.metro$batch)) < epsilon 278s [1] TRUE 278s > 278s > 278s BEGIN TEST tests/logitnegidx.R 278s 278s R version 4.4.3 (2025-02-28) -- "Trophy Case" 278s Copyright (C) 2025 The R Foundation for Statistical Computing 278s Platform: arm-unknown-linux-gnueabihf (32-bit) 278s 278s R is free software and comes with ABSOLUTELY NO WARRANTY. 278s You are welcome to redistribute it under certain conditions. 278s Type 'license()' or 'licence()' for distribution details. 278s 278s R is a collaborative project with many contributors. 278s Type 'contributors()' for more information and 278s 'citation()' on how to cite R or R packages in publications. 278s 278s Type 'demo()' for some demos, 'help()' for on-line help, or 278s 'help.start()' for an HTML browser interface to help. 278s Type 'q()' to quit R. 278s 278s > 278s > # test outfun (negative index vector) 278s > 278s > epsilon <- 1e-15 278s > 278s > library(mcmc) 278s > 278s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 278s > set.seed(42) 278s > 278s > n <- 100 278s > rho <- 0.5 278s > beta0 <- 0.25 278s > beta1 <- 1 278s > beta2 <- 0.5 278s > 278s > x1 <- rnorm(n) 278s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 278s > eta <- beta0 + beta1 * x1 + beta2 * x2 278s > p <- 1 / (1 + exp(- eta)) 278s > y <- as.numeric(runif(n) < p) 278s > 278s > out <- glm(y ~ x1 + x2, family = binomial()) 278s > 278s > logl <- function(beta) { 278s + if (length(beta) != 3) stop("length(beta) != 3") 278s + beta0 <- beta[1] 278s + beta1 <- beta[2] 278s + beta2 <- beta[3] 278s + eta <- beta0 + beta1 * x1 + beta2 * x2 278s + p <- exp(eta) / (1 + exp(eta)) 278s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 278s + } 278s > 278s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 278s > out.metro$accept 278s [1] 0.982 278s > 278s > out.metro <- metrop(out.metro, scale = 0.1) 278s > out.metro$accept 278s [1] 0.795 278s > 278s > out.metro <- metrop(out.metro, scale = 0.5) 278s > out.metro$accept 278s [1] 0.264 278s > 278s > apply(out.metro$batch, 2, mean) 278s [1] 0.06080257 1.42304941 0.52634149 278s > 278s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 278s + scale = 0.5, debug = TRUE, outfun = - 2) 278s > 278s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 278s > niter == nrow(out.metro$current) 278s [1] TRUE 278s > niter == nrow(out.metro$proposal) 278s [1] TRUE 278s > all(out.metro$current[1, ] == out.metro$initial) 278s [1] TRUE 278s > all(out.metro$current[niter, ] == out.metro$final) | 278s + all(out.metro$proposal[niter, ] == out.metro$final) 278s [1] TRUE 278s > 278s > .Random.seed <- out.metro$initial.seed 278s > d <- ncol(out.metro$proposal) 278s > n <- nrow(out.metro$proposal) 278s > my.proposal <- matrix(NA, n, d) 278s > my.u <- double(n) 278s > ska <- out.metro$scale 278s > for (i in 1:n) { 278s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 278s + if (is.na(out.metro$u[i])) { 278s + my.u[i] <- NA 278s + } else { 278s + my.u[i] <- runif(1) 278s + } 278s + } 278s > max(abs(out.metro$proposal - my.proposal)) < epsilon 278s [1] TRUE 278s > all(is.na(out.metro$u) == is.na(my.u)) 278s [1] TRUE 278s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 278s [1] TRUE 278s > 278s > my.curr.log.green <- apply(out.metro$current, 1, logl) 278s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 278s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 278s [1] TRUE 278s > foo <- my.prop.log.green - my.curr.log.green 278s > max(abs(foo - out.metro$log.green)) < epsilon 278s [1] TRUE 278s > 278s > my.accept <- is.na(my.u) | my.u < exp(foo) 278s > sum(my.accept) == round(n * out.metro$accept) 278s [1] TRUE 278s > if (my.accept[niter]) { 278s + all(out.metro$proposal[niter, ] == out.metro$final) 278s + } else { 278s + all(out.metro$current[niter, ] == out.metro$final) 278s + } 278s [1] TRUE 278s > 278s > my.current <- out.metro$current 278s > my.current[my.accept, ] <- my.proposal[my.accept, ] 278s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 278s > max(abs(out.metro$current - my.current)) < epsilon 278s [1] TRUE 278s > 278s > my.path <- matrix(NA, n, d) 278s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 278s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 278s > nspac <- out.metro$nspac 278s > 278s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 278s > 278s > fred <- my.path[ , out.metro$outfun] 278s > k <- ncol(fred) 278s > 278s > foom <- array(as.vector(t(fred)), c(k, out.metro$blen, out.metro$nbatch)) 278s > boom <- t(apply(foom, c(1, 3), mean)) 278s > 278s > all(dim(boom) == dim(out.metro$batch)) 278s [1] TRUE 278s > max(abs(boom - out.metro$batch)) < epsilon 278s [1] TRUE 278s > 278s > 278s BEGIN TEST tests/logitsub.R 279s 279s R version 4.4.3 (2025-02-28) -- "Trophy Case" 279s Copyright (C) 2025 The R Foundation for Statistical Computing 279s Platform: arm-unknown-linux-gnueabihf (32-bit) 279s 279s R is free software and comes with ABSOLUTELY NO WARRANTY. 279s You are welcome to redistribute it under certain conditions. 279s Type 'license()' or 'licence()' for distribution details. 279s 279s R is a collaborative project with many contributors. 279s Type 'contributors()' for more information and 279s 'citation()' on how to cite R or R packages in publications. 279s 279s Type 'demo()' for some demos, 'help()' for on-line help, or 279s 'help.start()' for an HTML browser interface to help. 279s Type 'q()' to quit R. 279s 279s > 279s > # test spacing (nspac) 279s > 279s > epsilon <- 1e-15 279s > 279s > library(mcmc) 279s > 279s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 279s > set.seed(42) 279s > 279s > n <- 100 279s > rho <- 0.5 279s > beta0 <- 0.25 279s > beta1 <- 1 279s > beta2 <- 0.5 279s > 279s > x1 <- rnorm(n) 279s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 279s > eta <- beta0 + beta1 * x1 + beta2 * x2 279s > p <- 1 / (1 + exp(- eta)) 279s > y <- as.numeric(runif(n) < p) 279s > 279s > out <- glm(y ~ x1 + x2, family = binomial()) 279s > 279s > logl <- function(beta) { 279s + if (length(beta) != 3) stop("length(beta) != 3") 279s + beta0 <- beta[1] 279s + beta1 <- beta[2] 279s + beta2 <- beta[3] 279s + eta <- beta0 + beta1 * x1 + beta2 * x2 279s + p <- exp(eta) / (1 + exp(eta)) 279s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 279s + } 279s > 279s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 279s > out.metro$accept 279s [1] 0.982 279s > 279s > out.metro <- metrop(out.metro, scale = 0.1) 279s > out.metro$accept 279s [1] 0.795 279s > 279s > out.metro <- metrop(out.metro, scale = 0.5) 279s > out.metro$accept 279s [1] 0.264 279s > 279s > apply(out.metro$batch, 2, mean) 279s [1] 0.06080257 1.42304941 0.52634149 279s > 279s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 279s + scale = 0.5, debug = TRUE, nspac = 3) 279s > 279s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 279s > niter == nrow(out.metro$current) 279s [1] TRUE 279s > niter == nrow(out.metro$proposal) 279s [1] TRUE 279s > all(out.metro$current[1, ] == out.metro$initial) 279s [1] TRUE 279s > all(out.metro$current[niter, ] == out.metro$final) | 279s + all(out.metro$proposal[niter, ] == out.metro$final) 279s [1] TRUE 279s > 279s > .Random.seed <- out.metro$initial.seed 279s > d <- ncol(out.metro$proposal) 279s > n <- nrow(out.metro$proposal) 279s > my.proposal <- matrix(NA, n, d) 279s > my.u <- double(n) 279s > ska <- out.metro$scale 279s > for (i in 1:n) { 279s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 279s + if (is.na(out.metro$u[i])) { 279s + my.u[i] <- NA 279s + } else { 279s + my.u[i] <- runif(1) 279s + } 279s + } 279s > max(abs(out.metro$proposal - my.proposal)) < epsilon 279s [1] TRUE 279s > all(is.na(out.metro$u) == is.na(my.u)) 279s [1] TRUE 279s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 279s [1] TRUE 279s > 279s > my.curr.log.green <- apply(out.metro$current, 1, logl) 279s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 279s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 279s [1] TRUE 279s > foo <- my.prop.log.green - my.curr.log.green 279s > max(abs(foo - out.metro$log.green)) < epsilon 279s [1] TRUE 279s > 279s > my.accept <- is.na(my.u) | my.u < exp(foo) 279s > sum(my.accept) == round(n * out.metro$accept) 279s [1] TRUE 279s > if (my.accept[niter]) { 279s + all(out.metro$proposal[niter, ] == out.metro$final) 279s + } else { 279s + all(out.metro$current[niter, ] == out.metro$final) 279s + } 279s [1] TRUE 279s > 279s > my.current <- out.metro$current 279s > my.current[my.accept, ] <- my.proposal[my.accept, ] 279s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 279s > max(abs(out.metro$current - my.current)) < epsilon 279s [1] TRUE 279s > 279s > my.path <- matrix(NA, n, d) 279s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 279s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 279s > nspac <- out.metro$nspac 279s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 279s > all(dim(my.path) == dim(out.metro$batch)) 279s [1] TRUE 279s > 279s > all(my.path == out.metro$batch) 279s [1] TRUE 279s > 279s > 279s BEGIN TEST tests/logitsubbat.R 279s 279s R version 4.4.3 (2025-02-28) -- "Trophy Case" 279s Copyright (C) 2025 The R Foundation for Statistical Computing 279s Platform: arm-unknown-linux-gnueabihf (32-bit) 279s 279s R is free software and comes with ABSOLUTELY NO WARRANTY. 279s You are welcome to redistribute it under certain conditions. 279s Type 'license()' or 'licence()' for distribution details. 279s 279s R is a collaborative project with many contributors. 279s Type 'contributors()' for more information and 279s 'citation()' on how to cite R or R packages in publications. 279s 279s Type 'demo()' for some demos, 'help()' for on-line help, or 279s 'help.start()' for an HTML browser interface to help. 279s Type 'q()' to quit R. 279s 279s > 279s > # test batching (blen) and spacing (nspac) together 279s > 279s > epsilon <- 1e-15 279s > 279s > library(mcmc) 279s > 279s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 279s > set.seed(42) 279s > 279s > n <- 100 279s > rho <- 0.5 279s > beta0 <- 0.25 279s > beta1 <- 1 279s > beta2 <- 0.5 279s > 279s > x1 <- rnorm(n) 279s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 279s > eta <- beta0 + beta1 * x1 + beta2 * x2 279s > p <- 1 / (1 + exp(- eta)) 279s > y <- as.numeric(runif(n) < p) 279s > 279s > out <- glm(y ~ x1 + x2, family = binomial()) 279s > 279s > logl <- function(beta) { 279s + if (length(beta) != 3) stop("length(beta) != 3") 279s + beta0 <- beta[1] 279s + beta1 <- beta[2] 279s + beta2 <- beta[3] 279s + eta <- beta0 + beta1 * x1 + beta2 * x2 279s + p <- exp(eta) / (1 + exp(eta)) 279s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 279s + } 279s > 279s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 279s > out.metro$accept 279s [1] 0.982 279s > 279s > out.metro <- metrop(out.metro, scale = 0.1) 279s > out.metro$accept 279s [1] 0.795 279s > 279s > out.metro <- metrop(out.metro, scale = 0.5) 279s > out.metro$accept 279s [1] 0.264 279s > 279s > apply(out.metro$batch, 2, mean) 279s [1] 0.06080257 1.42304941 0.52634149 279s > 279s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 279s + scale = 0.5, debug = TRUE, blen = 5, nspac = 3) 279s > 279s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 279s > niter == nrow(out.metro$current) 279s [1] TRUE 279s > niter == nrow(out.metro$proposal) 279s [1] TRUE 279s > all(out.metro$current[1, ] == out.metro$initial) 279s [1] TRUE 279s > all(out.metro$current[niter, ] == out.metro$final) | 279s + all(out.metro$proposal[niter, ] == out.metro$final) 279s [1] TRUE 279s > 279s > .Random.seed <- out.metro$initial.seed 279s > d <- ncol(out.metro$proposal) 279s > n <- nrow(out.metro$proposal) 279s > my.proposal <- matrix(NA, n, d) 279s > my.u <- double(n) 279s > ska <- out.metro$scale 279s > for (i in 1:n) { 279s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 279s + if (is.na(out.metro$u[i])) { 279s + my.u[i] <- NA 279s + } else { 279s + my.u[i] <- runif(1) 279s + } 279s + } 279s > max(abs(out.metro$proposal - my.proposal)) < epsilon 279s [1] TRUE 279s > all(is.na(out.metro$u) == is.na(my.u)) 279s [1] TRUE 279s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 279s [1] TRUE 279s > 279s > my.curr.log.green <- apply(out.metro$current, 1, logl) 279s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 279s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 279s [1] TRUE 279s > foo <- my.prop.log.green - my.curr.log.green 279s > max(abs(foo - out.metro$log.green)) < epsilon 279s [1] TRUE 279s > 279s > my.accept <- is.na(my.u) | my.u < exp(foo) 279s > sum(my.accept) == round(n * out.metro$accept) 279s [1] TRUE 279s > if (my.accept[niter]) { 279s + all(out.metro$proposal[niter, ] == out.metro$final) 279s + } else { 279s + all(out.metro$current[niter, ] == out.metro$final) 279s + } 279s [1] TRUE 279s > 279s > my.current <- out.metro$current 279s > my.current[my.accept, ] <- my.proposal[my.accept, ] 279s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 279s > max(abs(out.metro$current - my.current)) < epsilon 279s [1] TRUE 279s > 279s > my.path <- matrix(NA, n, d) 279s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 279s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 279s > nspac <- out.metro$nspac 279s > 279s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 279s > 279s > foom <- array(as.vector(t(my.path)), c(d, out.metro$blen, out.metro$nbatch)) 279s > boom <- t(apply(foom, c(1, 3), mean)) 279s > 279s > all(dim(boom) == dim(out.metro$batch)) 279s [1] TRUE 279s > max(abs(boom - out.metro$batch)) < epsilon 279s [1] TRUE 279s > 279s > 279s BEGIN TEST tests/logitvec.R 279s 279s R version 4.4.3 (2025-02-28) -- "Trophy Case" 279s Copyright (C) 2025 The R Foundation for Statistical Computing 279s Platform: arm-unknown-linux-gnueabihf (32-bit) 279s 279s R is free software and comes with ABSOLUTELY NO WARRANTY. 279s You are welcome to redistribute it under certain conditions. 279s Type 'license()' or 'licence()' for distribution details. 279s 279s R is a collaborative project with many contributors. 279s Type 'contributors()' for more information and 279s 'citation()' on how to cite R or R packages in publications. 279s 279s Type 'demo()' for some demos, 'help()' for on-line help, or 279s 'help.start()' for an HTML browser interface to help. 279s Type 'q()' to quit R. 279s 280s > 280s > # test vector (diag(foo)) scaling 280s > 280s > epsilon <- 1e-15 280s > 280s > library(mcmc) 280s > 280s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 280s > set.seed(42) 280s > 280s > n <- 100 280s > rho <- 0.5 280s > beta0 <- 0.25 280s > beta1 <- 1 280s > beta2 <- 0.5 280s > 280s > x1 <- rnorm(n) 280s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 280s > eta <- beta0 + beta1 * x1 + beta2 * x2 280s > p <- 1 / (1 + exp(- eta)) 280s > y <- as.numeric(runif(n) < p) 280s > 280s > out <- glm(y ~ x1 + x2, family = binomial()) 280s > 280s > logl <- function(beta) { 280s + if (length(beta) != 3) stop("length(beta) != 3") 280s + beta0 <- beta[1] 280s + beta1 <- beta[2] 280s + beta2 <- beta[3] 280s + eta <- beta0 + beta1 * x1 + beta2 * x2 280s + p <- exp(eta) / (1 + exp(eta)) 280s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 280s + } 280s > 280s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 280s > out.metro$accept 280s [1] 0.982 280s > 280s > out.metro <- metrop(out.metro, scale = 0.1) 280s > out.metro$accept 280s [1] 0.795 280s > 280s > out.metro <- metrop(out.metro, scale = 0.5) 280s > out.metro$accept 280s [1] 0.264 280s > 280s > apply(out.metro$batch, 2, mean) 280s [1] 0.06080257 1.42304941 0.52634149 280s > sally <- apply(out.metro$batch, 2, sd) 280s > 280s > out.metro <- metrop(out.metro, scale = sally) 280s > out.metro$accept 280s [1] 0.398 280s > 280s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 280s + scale = sally, debug = TRUE) 280s > 280s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 280s > niter == nrow(out.metro$current) 280s [1] TRUE 280s > niter == nrow(out.metro$proposal) 280s [1] TRUE 280s > all(out.metro$current[1, ] == out.metro$initial) 280s [1] TRUE 280s > all(out.metro$current[niter, ] == out.metro$final) | 280s + all(out.metro$proposal[niter, ] == out.metro$final) 280s [1] TRUE 280s > 280s > .Random.seed <- out.metro$initial.seed 280s > d <- ncol(out.metro$proposal) 280s > n <- nrow(out.metro$proposal) 280s > my.proposal <- matrix(NA, n, d) 280s > my.u <- double(n) 280s > ska <- out.metro$scale 280s > for (i in 1:n) { 280s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 280s + if (is.na(out.metro$u[i])) { 280s + my.u[i] <- NA 280s + } else { 280s + my.u[i] <- runif(1) 280s + } 280s + } 280s > max(abs(out.metro$proposal - my.proposal)) < epsilon 280s [1] TRUE 280s > 280s > all(is.na(out.metro$u) == is.na(my.u)) 280s [1] TRUE 280s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 280s [1] TRUE 280s > 280s > my.curr.log.green <- apply(out.metro$current, 1, logl) 280s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 280s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 280s [1] TRUE 280s > foo <- my.prop.log.green - my.curr.log.green 280s > max(abs(foo - out.metro$log.green)) < epsilon 280s [1] TRUE 280s > 280s > my.accept <- is.na(my.u) | my.u < exp(foo) 280s > sum(my.accept) == round(n * out.metro$accept) 280s [1] TRUE 280s > if (my.accept[niter]) { 280s + all(out.metro$proposal[niter, ] == out.metro$final) 280s + } else { 280s + all(out.metro$current[niter, ] == out.metro$final) 280s + } 280s [1] TRUE 280s > 280s > my.current <- out.metro$current 280s > my.current[my.accept, ] <- my.proposal[my.accept, ] 280s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 280s > max(abs(out.metro$current - my.current)) < epsilon 280s [1] TRUE 280s > 280s > my.path <- matrix(NA, n, d) 280s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 280s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 280s > nspac <- out.metro$nspac 280s > 280s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 280s > 280s > fred <- my.path 280s > k <- ncol(fred) 280s > 280s > foom <- array(as.vector(t(fred)), c(k, out.metro$blen, out.metro$nbatch)) 280s > boom <- t(apply(foom, c(1, 3), mean)) 280s > 280s > all(dim(boom) == dim(out.metro$batch)) 280s [1] TRUE 280s > max(abs(boom - out.metro$batch)) < epsilon 280s [1] TRUE 280s > 280s > 280s BEGIN TEST tests/morph.R 280s 280s R version 4.4.3 (2025-02-28) -- "Trophy Case" 280s Copyright (C) 2025 The R Foundation for Statistical Computing 280s Platform: arm-unknown-linux-gnueabihf (32-bit) 280s 280s R is free software and comes with ABSOLUTELY NO WARRANTY. 280s You are welcome to redistribute it under certain conditions. 280s Type 'license()' or 'licence()' for distribution details. 280s 280s R is a collaborative project with many contributors. 280s Type 'contributors()' for more information and 280s 'citation()' on how to cite R or R packages in publications. 280s 280s Type 'demo()' for some demos, 'help()' for on-line help, or 280s 'help.start()' for an HTML browser interface to help. 280s Type 'q()' to quit R. 280s 280s > library(mcmc) 280s > isotropic <- mcmc:::isotropic 280s > isotropic.logjacobian <- mcmc:::isotropic.logjacobian 280s > 280s > # make sure morph identity works properly 280s > TestMorphIdentity <- function(m.id) { 280s + ident.func <- function(x) x 280s + if (!all.equal(m.id$transform(1:10), 1:10)) 280s + return(FALSE) 280s + if (!all.equal(m.id$inverse(1:10), 1:10)) 280s + return(FALSE) 280s + x <- seq(-1,1, length.out=15) 280s + if (!all.equal(sapply(x, m.id$lud(function(x) dnorm(x, log=TRUE))), 280s + dnorm(x, log=TRUE))) 280s + return(FALSE) 280s + if (!all.equal(m.id$outfun(ident.func)(x), x)) 280s + return(FALSE) 280s + return(TRUE) 280s + } 280s > 280s > TestMorphIdentity(morph()) 280s [1] TRUE 280s > TestMorphIdentity(morph.identity()) 280s [1] TRUE 280s > 280s > TestMorphIdentityOutfun <- function(m) { 280s + f <- m$outfun(NULL) 280s + x <- 1:20 280s + if (!identical(x, f(x))) 280s + return(FALSE) 280s + f <- m$outfun(c(6, 8)) 280s + if (!identical(x[c(6, 8)], f(x))) 280s + return(FALSE) 280s + i <- rep(FALSE, 20) 280s + i[c(1, 3, 5)] <- TRUE 280s + f <- m$outfun(i) 280s + if (!identical(x[i], f(x))) 280s + return(FALSE) 280s + return(TRUE) 280s + } 280s > 280s > TestMorphIdentityOutfun(morph()) 280s [1] TRUE 280s > TestMorphIdentityOutfun(morph.identity()) 280s [1] TRUE 280s > 280s > # make sure that morph and morph.identity give back the same things 280s > all.equal(sort(names(morph.identity())), sort(names(morph(b=1)))) 280s [1] TRUE 280s > 280s > # test center parameter, univariate version 280s > zero.func <- function(x) 0 280s > center <- 2 280s > x <- seq(-1,1, length.out=15) 280s > morph.center <- morph(center=center) 280s > all.equal(sapply(x, morph.center$transform), x-center) 280s [1] TRUE 280s > all.equal(sapply(x, morph.center$inverse), x+center) 280s [1] TRUE 280s > all.equal(sapply(x, morph.center$lud(function(y) dnorm(y, log=TRUE))), 280s + dnorm(x, log=TRUE, mean=-2)) 280s [1] TRUE 280s > 280s > # test center parameter, multivariate version 280s > center <- 1:4 280s > x <- rep(0, 4) 280s > morph.center <- morph(center=center) 280s > lud.mult.dnorm <- function(x) prod(dnorm(x, log=TRUE)) 280s > all.equal(morph.center$transform(x), x-center) 280s [1] TRUE 280s > all.equal(morph.center$inverse(x), x+center) 280s [1] TRUE 280s > all.equal(morph.center$lud(lud.mult.dnorm)(x), 280s + lud.mult.dnorm(x - center)) 280s [1] TRUE 280s > # test 'r'. 280s > r <- 1 280s > morph.r <- morph(r=r) 280s > x <- seq(-1, 1, length.out=20) 280s > all.equal(sapply(x, morph.r$lud(function(x) dnorm(x, log=TRUE))), 280s + dnorm(x, log=TRUE)) 280s [1] TRUE 280s > x <- seq(1.1, 2, length.out=10) 280s > all(sapply(x, morph.r$lud(function(x) dnorm(x, log=TRUE))) 280s + != 280s + dnorm(x, log=TRUE)) 280s [1] TRUE 280s > 280s > TestExponentialEvenPWithRInverse <- function() { 280s + r <- 0.3 280s + p <- 2.2 280s + morph.r <- morph(r=r, p=p) 280s + x <- seq(0, r, length.out=20) 280s + all.equal(x, sapply(x, morph.r$inverse)) 280s + } 280s > 280s > TestExponentialEvenPWithRInverse() 280s [1] TRUE 280s > 280s > # make sure morph$lud passes '...' arguments. 280s > mean <- 2 280s > ident.morph <- morph() 280s > dnorm.morph <- ident.morph$lud(function(x, mean=0) 280s + dnorm(x, mean=mean, log=TRUE)) 280s > all.equal(dnorm.morph(2, mean), dnorm(2, mean=mean, log=TRUE)) 280s [1] TRUE 280s > x <- seq(-3, 3, length.out=20) 280s > m2 <- morph(r=10) 280s > dnorm.morph <- m2$lud(function(x, mean) 280s + dnorm(x, mean=mean, log=TRUE)) 280s > all.equal(sapply(x, function(y) dnorm.morph(y, 2)), 280s + dnorm(x, mean=2, log=TRUE)) 280s [1] TRUE 280s > 280s > # make sure morph$outfun passes '...' arguments. 280s > outfun.orig <- function(x, mean) x + mean 280s > ident.morph <- morph() 280s > mean <- 1 280s > outfun.morph <- ident.morph$outfun(outfun.orig) 280s > all.equal(outfun.morph(1:10, mean), 1:10+mean) 280s [1] TRUE 280s > 280s > m2 <- morph(r=10) 280s > outfun.morph <- m2$outfun(outfun.orig) 280s > all.equal(sapply(1:10, function(x) outfun.morph(x, mean)), 1:10+mean) 280s [1] TRUE 280s > 280s > ########################################################################### 280s > # test built-in exponential and polynomial transformations. 280s > f <- morph(b=3) 280s > x <- seq(0, 10, length.out=100) 280s > all.equal(x, sapply(sapply(x, f$transform), f$inverse)) 280s [1] TRUE 280s > 280s > f <- morph(p=3) 280s > all.equal(x, sapply(sapply(x, f$transform), f$inverse)) 280s [1] TRUE 280s > 280s > f <- morph(p=3, r=10) 280s > all.equal(-10:10, Vectorize(f$transform)(-10:10)) 280s [1] TRUE 280s > 280s > f <- morph(p=3, b=1) 280s > all.equal(x, sapply(sapply(x, f$transform), f$inverse)) 280s [1] TRUE 280s > 280s BEGIN TEST tests/morph.metrop.R 280s 280s R version 4.4.3 (2025-02-28) -- "Trophy Case" 280s Copyright (C) 2025 The R Foundation for Statistical Computing 280s Platform: arm-unknown-linux-gnueabihf (32-bit) 280s 280s R is free software and comes with ABSOLUTELY NO WARRANTY. 280s You are welcome to redistribute it under certain conditions. 280s Type 'license()' or 'licence()' for distribution details. 280s 280s R is a collaborative project with many contributors. 280s Type 'contributors()' for more information and 280s 'citation()' on how to cite R or R packages in publications. 280s 280s Type 'demo()' for some demos, 'help()' for on-line help, or 280s 'help.start()' for an HTML browser interface to help. 280s Type 'q()' to quit R. 280s 280s > library(mcmc) 280s > 280s > .morph.unmorph <- mcmc:::.morph.unmorph 280s > 280s > ########################################################################### 280s > # basic functionality check, can morph.metro run? Can we change the 280s > # transformation? 280s > set.seed(42) 280s > obj <- morph.metrop(function(x) dt(x, df=3, log=TRUE), 280s + 100, 100, morph=morph(b=3)) 280s > obj <- morph.metrop(obj, morph=morph(b=1)) 280s > 280s > obj <- morph.metrop(function(x) prod(dt(x, df=3, log=TRUE)), 280s + rep(100, 3), 100, morph=morph(p=3, b=1)) 280s > obj <- morph.metrop(obj, morph=morph(r=1, p=3, b=1)) 280s > 280s > all.equal(class(obj), c("mcmc", "morph.metropolis")) 280s [1] TRUE 280s > 280s > ########################################################################### 280s > # check .morph.unmorph 280s > obj <- list(final=10) 280s > outfun <- function(x) x 280s > m <- morph(p=3) 280s > obj <- .morph.unmorph(obj, m, outfun) 280s > all.equal(class(obj), c("mcmc", "morph.metropolis")) 280s [1] TRUE 280s > all.equal(sort(names(obj)), 280s + sort(c("final", "morph", "morph.final", "outfun"))) 280s [1] TRUE 280s > all.equal(c(obj$final, obj$morph.final), c(m$inverse(10), 10)) 280s [1] TRUE 280s > all.equal(obj$outfun, outfun) 280s [1] TRUE 280s > all.equal(obj$morph, m) 280s [1] TRUE 280s > 280s BEGIN TEST tests/morphtoo.R 280s 280s R version 4.4.3 (2025-02-28) -- "Trophy Case" 280s Copyright (C) 2025 The R Foundation for Statistical Computing 280s Platform: arm-unknown-linux-gnueabihf (32-bit) 280s 280s R is free software and comes with ABSOLUTELY NO WARRANTY. 280s You are welcome to redistribute it under certain conditions. 280s Type 'license()' or 'licence()' for distribution details. 280s 280s R is a collaborative project with many contributors. 280s Type 'contributors()' for more information and 280s 'citation()' on how to cite R or R packages in publications. 280s 280s Type 'demo()' for some demos, 'help()' for on-line help, or 280s 'help.start()' for an HTML browser interface to help. 280s Type 'q()' to quit R. 280s 281s > 281s > library(mcmc) 281s > 281s > x <- seq(0, 10, length = 10001) 281s > 281s > ### sub-exponentially light transformation 281s > 281s > b <- 0.5 281s > fsub <- morph(b = b) 281s > 281s > y <- unlist(Map(fsub$inverse, x)) 281s > 281s > myfsub <- function(x) ifelse(x > 1 / b, exp(b * x) - exp(1) / 3, 281s + (x * b)^3 * exp(1) / 6 + x * b * exp(1) / 2) 281s > y2 <- myfsub(x) 281s > all.equal(y, y2, tolerance = 1e-14) 281s [1] TRUE 281s > 281s > z <- unlist(Map(fsub$transform, y)) 281s > all.equal(z, x, tolerance = 1e-14) 281s [1] TRUE 281s > 281s > ### exponentially light transformation 281s > 281s > r <- 5 281s > p <- 3 281s > fp3 <- morph(r = r) 281s > 281s > y <- unlist(Map(fp3$inverse, x)) 281s > 281s > myfp3 <- function(x) ifelse(x < r, x, x + (x - r)^p) 281s > y2 <- myfp3(x) 281s > all.equal(y, y2, tolerance = 1e-14) 281s [1] TRUE 281s > 281s > z <- unlist(Map(fp3$transform, y)) 281s > all.equal(z, x, tolerance = 1e-12) 281s [1] TRUE 281s > 281s > ### both together 281s > 281s > fboth <- morph(b = b, r = r) 281s > 281s > y <- unlist(Map(fboth$inverse, x)) 281s > y2 <- myfsub(myfp3(x)) 281s > all.equal(y, y2, tolerance = 1e-14) 281s [1] TRUE 281s > 281s > z <- unlist(Map(fboth$transform, y)) 281s > all.equal(z, x, tolerance = 1e-12) 281s [1] TRUE 281s > 281s > ### exponentially light transformation with p != 3 281s > 281s > r <- 5 281s > p <- 2.2 281s > fpo <- morph(r = r, p = p) 281s > 281s > y <- unlist(Map(fpo$inverse, x)) 281s > 281s > myfpo <- function(x) ifelse(x < r, x, x + (x - r)^p) 281s > y2 <- myfpo(x) 281s > all.equal(y, y2, tolerance = 1e-14) 281s [1] TRUE 281s > 281s > z <- unlist(Map(fpo$transform, y)) 282s > all.equal(z, x, tolerance = 1e-14) 282s [1] TRUE 282s > 282s > 282s BEGIN TEST tests/saveseed.R 282s 282s R version 4.4.3 (2025-02-28) -- "Trophy Case" 282s Copyright (C) 2025 The R Foundation for Statistical Computing 282s Platform: arm-unknown-linux-gnueabihf (32-bit) 282s 282s R is free software and comes with ABSOLUTELY NO WARRANTY. 282s You are welcome to redistribute it under certain conditions. 282s Type 'license()' or 'licence()' for distribution details. 282s 282s R is a collaborative project with many contributors. 282s Type 'contributors()' for more information and 282s 'citation()' on how to cite R or R packages in publications. 282s 282s Type 'demo()' for some demos, 'help()' for on-line help, or 282s 'help.start()' for an HTML browser interface to help. 282s Type 'q()' to quit R. 282s 282s > 282s > library(mcmc) 282s > 282s > set.seed(42) 282s > 282s > h <- function(x) if (all(x >= 0) && sum(x) <= 1) return(1) else return(-Inf) 282s > out <- metrop(h, initial = rep(0, 5), nbatch = 100, blen = 17, nspac = 3, 282s + scale = 0.1) 282s > 282s > save.seed <- .Random.seed 282s > 282s > out1 <- metrop(out) 282s > out2 <- metrop(out1) 282s > out3 <- metrop(out, nbatch = 2 * out$nbatch) 282s > 282s > fred <- rbind(out1$batch, out2$batch) 282s > identical(fred, out3$batch) 282s [1] TRUE 282s > 282s > 282s BEGIN TEST tests/saveseedmorph.R 282s 282s R version 4.4.3 (2025-02-28) -- "Trophy Case" 282s Copyright (C) 2025 The R Foundation for Statistical Computing 282s Platform: arm-unknown-linux-gnueabihf (32-bit) 282s 282s R is free software and comes with ABSOLUTELY NO WARRANTY. 282s You are welcome to redistribute it under certain conditions. 282s Type 'license()' or 'licence()' for distribution details. 282s 282s R is a collaborative project with many contributors. 282s Type 'contributors()' for more information and 282s 'citation()' on how to cite R or R packages in publications. 282s 282s Type 'demo()' for some demos, 'help()' for on-line help, or 282s 'help.start()' for an HTML browser interface to help. 282s Type 'q()' to quit R. 282s 282s > 282s > library(mcmc) 282s > 282s > set.seed(42) 282s > 282s > h <- function(x) if (all(x >= 0) && sum(x) <= 1) return(1) else return(-Inf) 282s > out <- morph.metrop(obj = h, initial = rep(0, 5), nbatch = 100, blen = 17, 282s + nspac = 3, scale = 0.1) 282s > 282s > out1 <- morph.metrop(out) 282s > out2 <- morph.metrop(out1) 282s > out3 <- morph.metrop(out, nbatch = 2 * out$nbatch) 282s > 282s > fred <- rbind(out1$batch, out2$batch) 282s > identical(fred, out3$batch) 282s [1] TRUE 282s > 282s > out <- morph.metrop(out, morph = morph(p = 2.2, r = 0.3)) 282s > 282s > out1 <- morph.metrop(out) 282s > out2 <- morph.metrop(out1) 282s > out3 <- morph.metrop(out, nbatch = 2 * out$nbatch) 282s > 282s > fred <- rbind(out1$batch, out2$batch) 282s > identical(fred, out3$batch) 282s [1] TRUE 282s > 282s > 283s BEGIN TEST tests/temp-par-witch.R 283s 283s R version 4.4.3 (2025-02-28) -- "Trophy Case" 283s Copyright (C) 2025 The R Foundation for Statistical Computing 283s Platform: arm-unknown-linux-gnueabihf (32-bit) 283s 283s R is free software and comes with ABSOLUTELY NO WARRANTY. 283s You are welcome to redistribute it under certain conditions. 283s Type 'license()' or 'licence()' for distribution details. 283s 283s R is a collaborative project with many contributors. 283s Type 'contributors()' for more information and 283s 'citation()' on how to cite R or R packages in publications. 283s 283s Type 'demo()' for some demos, 'help()' for on-line help, or 283s 'help.start()' for an HTML browser interface to help. 283s Type 'q()' to quit R. 283s 283s > 283s > if ((! exists("DEBUG")) || (! identical(DEBUG, TRUE))) DEBUG <- FALSE 283s > 283s > library(mcmc) 283s > 283s > options(digits=4) # avoid rounding differences 283s > 283s > set.seed(42) 283s > 283s > save.initial.seed <- .Random.seed 283s > 283s > d <- 3 283s > witch.which <- 1 - (1 / 2)^(1 / d) * (1 / 4)^(seq(0, 5) / d) 283s > witch.which 283s [1] 0.2063 0.5000 0.6850 0.8016 0.8750 0.9213 283s > 283s > ncomp <- length(witch.which) 283s > 283s > neighbors <- matrix(FALSE, ncomp, ncomp) 283s > neighbors[row(neighbors) == col(neighbors) + 1] <- TRUE 283s > neighbors[row(neighbors) == col(neighbors) - 1] <- TRUE 283s > neighbors[row(neighbors) == col(neighbors) + 2] <- TRUE 283s > neighbors[row(neighbors) == col(neighbors) - 2] <- TRUE 283s > 283s > ludfun <- function(state) { 283s + stopifnot(is.numeric(state)) 283s + stopifnot(length(state) == d + 1) 283s + icomp <- state[1] 283s + stopifnot(icomp == as.integer(icomp)) 283s + stopifnot(1 <= icomp && icomp <= ncomp) 283s + theta <- state[-1] 283s + if (any(abs(theta) > 1.0)) return(-Inf) 283s + bnd <- witch.which[icomp] 283s + if(bnd >= 1.0) 283s + stop(sprintf("witch.which[%d] >= 1.0", icomp)) 283s + if(bnd <= 0.0) 283s + stop(sprintf("witch.which[%d] <= 0.0", icomp)) 283s + if (all(abs(theta) > bnd)) 283s + return(- (d + 1) * log(2) - d * log(1 - bnd)) 283s + return(- (d + 1) * log(2) - log1p(- (1 - bnd)^d)) 283s + } 283s > 283s > thetas <- matrix(0, ncomp, d) 283s > out <- temper(ludfun, initial = thetas, neighbors = neighbors, nbatch = 50, 283s + blen = 13, nspac = 7, scale = 0.3456789, parallel = TRUE, debug = DEBUG) 283s > 283s > names(out) 283s [1] "lud" "neighbors" "nbatch" "blen" "nspac" 283s [6] "scale" "outfun" "debug" "parallel" "initial.seed" 283s [11] "final.seed" "time" "batch" "acceptx" "accepti" 283s [16] "initial" "final" 283s > 283s > out$acceptx 283s [1] 0.6336 0.4974 0.3245 0.6022 0.6130 0.5914 283s > 283s > out$accepti 283s [,1] [,2] [,3] [,4] [,5] [,6] 283s [1,] NA 0.7051 0.5497 NA NA NA 283s [2,] 0.7523 NA 0.5547 0.6288 NA NA 283s [3,] 0.5794 0.5865 NA 0.5309 0.5476 NA 283s [4,] NA 0.6667 0.5506 NA 0.8272 0.6837 283s [5,] NA NA 0.5439 0.8926 NA 0.8374 283s [6,] NA NA NA 0.8391 0.9023 NA 283s > 283s > ### check that have prob 1 / 2 for corners 283s > 283s > outfun <- function(state) { 283s + stopifnot(is.matrix(state)) 283s + ncomp <- nrow(state) 283s + d <- ncol(state) 283s + foo <- sweep(abs(state), 1, witch.which) 283s + bar <- apply(foo > 0, 1, all) 283s + return(as.numeric(bar)) 283s + } 283s > 283s > out2 <- temper(out, outfun = outfun) 283s > 283s > colMeans(out2$batch) 283s [1] 0.54923 0.40923 0.39538 0.09692 0.12923 0.60000 283s > apply(out2$batch, 2, sd) / sqrt(out$nbatch) 283s [1] 0.03482 0.04817 0.05464 0.02856 0.02113 0.05131 283s > 283s > ### try again 283s > 283s > out3 <- temper(out2, blen = 103) 285s > 285s > foo <- cbind(colMeans(out3$batch), 285s + apply(out3$batch, 2, sd) / sqrt(out$nbatch)) 285s > colnames(foo) <- c("means", "MCSE") 285s > foo 285s means MCSE 285s [1,] 0.5231 0.01390 285s [2,] 0.5361 0.02213 285s [3,] 0.4905 0.03961 285s [4,] 0.5652 0.04909 285s [5,] 0.4056 0.05107 285s [6,] 0.2450 0.05108 285s > 285s > 285s BEGIN TEST tests/temp-par.R 285s 285s R version 4.4.3 (2025-02-28) -- "Trophy Case" 285s Copyright (C) 2025 The R Foundation for Statistical Computing 285s Platform: arm-unknown-linux-gnueabihf (32-bit) 285s 285s R is free software and comes with ABSOLUTELY NO WARRANTY. 285s You are welcome to redistribute it under certain conditions. 285s Type 'license()' or 'licence()' for distribution details. 285s 285s R is a collaborative project with many contributors. 285s Type 'contributors()' for more information and 285s 'citation()' on how to cite R or R packages in publications. 285s 285s Type 'demo()' for some demos, 'help()' for on-line help, or 285s 'help.start()' for an HTML browser interface to help. 285s Type 'q()' to quit R. 285s 285s > 285s > library(mcmc) 285s > 285s > set.seed(42) 285s > 285s > data(foo) 285s > attach(foo) 285s > 285s > out <- glm(y ~ x1 + x2 + x3, family = binomial, x = TRUE) 285s > ## IGNORE_RDIFF_BEGIN 285s > summary(out) 285s 285s Call: 285s glm(formula = y ~ x1 + x2 + x3, family = binomial, x = TRUE) 285s 285s Coefficients: 285s Estimate Std. Error z value Pr(>|z|) 285s (Intercept) 0.5772 0.2766 2.087 0.036930 * 285s x1 0.3362 0.4256 0.790 0.429672 285s x2 0.8475 0.4701 1.803 0.071394 . 285s x3 1.5143 0.4426 3.422 0.000622 *** 285s --- 285s Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 285s 285s (Dispersion parameter for binomial family taken to be 1) 285s 285s Null deviance: 134.602 on 99 degrees of freedom 285s Residual deviance: 86.439 on 96 degrees of freedom 285s AIC: 94.439 285s 285s Number of Fisher Scoring iterations: 5 285s 285s > ## IGNORE_RDIFF_END 285s > 285s > modmat <- out$x 285s > 285s > models <- cbind(rep(0:1, each = 4), rep(rep(0:1, times = 2), each = 2), 285s + rep(0:1, times = 4)) 285s > 285s > exes <- paste("x", 1:3, sep = "") 285s > betas <- NULL 285s > for (i in 1:nrow(models)) { 285s + inies <- as.logical(models[i, ]) 285s + foo <- exes[inies] 285s + bar <- paste("y ~", paste(foo, collapse = " + ")) 285s + if (! any(inies)) bar <- paste(bar, "1") 285s + baz <- glm(as.formula(bar), family = binomial) 285s + beta <- rep(0, 4) 285s + beta[c(TRUE, inies)] <- baz$coef 285s + betas <- rbind(betas, beta) 285s + } 285s > 285s > neighbors <- matrix(FALSE, nrow(models), nrow(models)) 285s > for (i in 1:nrow(neighbors)) { 285s + for (j in 1:ncol(neighbors)) { 285s + foo <- models[i, ] 285s + bar <- models[j, ] 285s + if (sum(foo != bar) == 1) neighbors[i, j] <- TRUE 285s + } 285s + } 285s > 285s > ludfun <- function(state, ...) { 285s + stopifnot(is.numeric(state)) 285s + stopifnot(length(state) == ncol(models) + 2) 285s + stopifnot(length(state) == ncol(models) + 2) 285s + icomp <- state[1] 285s + stopifnot(icomp == as.integer(icomp)) 285s + stopifnot(1 <= icomp && icomp <= nrow(models)) 285s + beta <- state[-1] 285s + inies <- c(TRUE, as.logical(models[icomp, ])) 285s + beta.logl <- beta 285s + beta.logl[! inies] <- 0 285s + eta <- as.numeric(modmat %*% beta.logl) 285s + logp <- ifelse(eta < 0, eta - log1p(exp(eta)), - log1p(exp(- eta))) 285s + logq <- ifelse(eta < 0, - log1p(exp(eta)), - eta - log1p(exp(- eta))) 285s + logl <- sum(logp[y == 1]) + sum(logq[y == 0]) 285s + val <- logl - sum(beta^2) / 2 285s + return(val) 285s + } 285s > 285s > ludval <- NULL 285s > for (i in 1:nrow(models)) ludval <- c(ludval, ludfun(c(i, betas[i, ]))) 285s > all(is.finite(ludval)) 285s [1] TRUE 285s > 285s > 285s > out <- temper(ludfun, initial = betas, neighbors = neighbors, nbatch = 20, 285s + blen = 10, nspac = 5, scale = 0.56789, parallel = TRUE, debug = TRUE) 285s > 285s > names(out) 285s [1] "lud" "neighbors" "nbatch" "blen" 285s [5] "nspac" "scale" "outfun" "debug" 285s [9] "parallel" "initial.seed" "final.seed" "time" 285s [13] "batch" "acceptx" "accepti" "initial" 285s [17] "final" "which" "unif.which" "state" 285s [21] "log.hastings" "unif.hastings" "proposal" "acceptd" 285s [25] "norm" "unif.choose" "coproposal" 285s > 285s > ### check decision about within-component or jump/swap 285s > 285s > identical(out$unif.which < 0.5, out$which) 285s [1] TRUE 285s > 285s > identical(out$which, out$proposal[ , 1] == out$coproposal[ , 1]) 285s [1] TRUE 285s > 285s > ### check proposal and coproposal are actually current state or part thereof 285s > 285s > prop <- out$proposal 285s > coprop <- out$coproposal 285s > prop.i <- prop[ , 1] 285s > coprop.i <- coprop[ , 1] 285s > alt.prop <- prop 285s > alt.coprop <- coprop 285s > for (i in 1:nrow(prop)) { 285s + alt.prop[i, ] <- c(prop.i[i], out$state[i, prop.i[i], ]) 285s + alt.coprop[i, ] <- c(coprop.i[i], out$state[i, coprop.i[i], ]) 285s + } 285s > identical(coprop, alt.coprop) 285s [1] TRUE 285s > identical(prop[! out$which, ], alt.prop[! out$which, ]) 285s [1] TRUE 285s > identical(prop[out$which, 1], alt.prop[out$which, 1]) 285s [1] TRUE 285s > 285s > ### check hastings ratio calculated correctly 285s > 285s > foo <- apply(prop, 1, ludfun) 285s > fooco <- apply(coprop, 1, ludfun) 285s > prop[ , 1] <- out$coproposal[ , 1] 285s > coprop[ , 1] <- out$proposal[ , 1] 285s > foo.swap <- apply(prop, 1, ludfun) 285s > fooco.swap <- apply(coprop, 1, ludfun) 285s > log.haste <- ifelse(out$which, foo - fooco, 285s + foo.swap + fooco.swap - foo - fooco) 285s > all.equal(log.haste, out$log.hastings) 285s [1] TRUE 285s > 285s > ### check hastings rejection decided correctly 285s > 285s > identical(out$log.hastings >= 0, is.na(out$unif.hastings)) 285s [1] TRUE 285s > all(out$log.hastings < 0 | out$acceptd) 285s [1] TRUE 285s > identical(out$acceptd, 285s + out$log.hastings >= 0 | out$unif.hastings < exp(out$log.hastings)) 285s [1] TRUE 285s > 285s > ### check acceptance carried out or not (according to decision) correctly 285s > 285s > before <- out$state 285s > after <- before 285s > after[- dim(after)[1], , ] <- before[-1, , ] 285s > after[dim(after)[1], , ] <- out$final 285s > my.after <- before 285s > for (i in 1:length(out$acceptd)) { 285s + if (out$acceptd[i]) { 285s + if (out$which[i]) { 285s + j <- out$proposal[i, 1] 285s + my.after[i, j, ] <- out$proposal[i, -1] 285s + } else { 285s + j <- out$proposal[i, 1] 285s + k <- out$coproposal[i, 1] 285s + my.after[i, j, ] <- out$coproposal[i, -1] 285s + my.after[i, k, ] <- out$proposal[i, -1] 285s + } 285s + } 285s + } 285s > identical(after, my.after) 285s [1] TRUE 285s > 285s > ### check within-component proposal 285s > 285s > my.coproposal.within <- out$coproposal[out$which, ] 285s > proposal.within <- out$proposal[out$which, ] 285s > my.z <- out$norm[out$which, ] 285s > my.proposal.within <- my.coproposal.within 285s > my.proposal.within[ , -1] <- my.coproposal.within[ , -1] + out$scale * my.z 285s > all.equal(proposal.within, my.proposal.within) 285s [1] TRUE 285s > 285s > my.unif.choose <- out$unif.choose[out$which, 1] 285s > my.i <- floor(nrow(models) * my.unif.choose) + 1 285s > all(1 <= my.i & my.i <= nrow(models)) 285s [1] TRUE 285s > identical(my.i, my.coproposal.within[ , 1]) 285s [1] TRUE 285s > 285s > ### check swap proposal 285s > 285s > coproposal.swap <- out$coproposal[! out$which, ] 285s > proposal.swap <- out$proposal[! out$which, ] 285s > unif.choose.swap <- out$unif.choose[! out$which, ] 285s > my.i <- floor(nrow(models) * unif.choose.swap[ , 1]) + 1 285s > nneighbors <- apply(out$neighbors, 1, sum) 285s > my.nneighbors <- nneighbors[my.i] 285s > my.k <- floor(my.nneighbors * unif.choose.swap[ , 2]) + 1 285s > my.j <- my.k 285s > foo <- seq(1, ncol(out$neighbors)) 285s > for (i in seq(along = my.j)) { 285s + my.j[i] <- (foo[out$neighbors[my.i[i], ]])[my.k[i]] 285s + } 285s > identical(coproposal.swap[ , 1], my.i) 285s [1] TRUE 285s > identical(proposal.swap[ , 1], my.j) 285s [1] TRUE 285s > 285s > ### check standard normal and uniform random numbers are as purported 285s > 285s > save.Random.seed <- .Random.seed 285s > .Random.seed <- out$initial.seed 285s > 285s > nx <- ncol(out$initial) 285s > niter <- out$nbatch * out$blen * out$nspac 285s > my.norm <- matrix(NA, nrow = nrow(out$norm), ncol = ncol(out$norm)) 285s > my.unif.which <- rep(NA, niter) 285s > my.unif.hastings <- rep(NA, niter) 285s > my.unif.choose <- matrix(NA, niter, 2) 285s > for (iiter in 1:niter) { 285s + my.unif.which[iiter] <- runif(1) 285s + if (out$which[iiter]) { 285s + my.unif.choose[iiter, 1] <- runif(1) 285s + my.norm[iiter, ] <- rnorm(nx) 285s + if (out$log.hastings[iiter] < 0) my.unif.hastings[iiter] <- runif(1) 285s + } else { 285s + my.unif.choose[iiter, ] <- runif(2) 285s + if (out$log.hastings[iiter] < 0) my.unif.hastings[iiter] <- runif(1) 285s + } 285s + } 285s > identical(my.norm, out$norm) 285s [1] TRUE 285s > identical(my.unif.which, out$unif.which) 285s [1] TRUE 285s > identical(my.unif.hastings, out$unif.hastings) 285s [1] TRUE 285s > identical(my.unif.choose, out$unif.choose) 285s [1] TRUE 285s > 285s > .Random.seed <- save.Random.seed 285s > 285s > ### check batch means 285s > 285s > foo <- after[seq(1, niter) %% out$nspac == 0, , ] 285s > foo <- array(as.vector(foo), dim = c(out$blen, out$nbatch, dim(foo)[2:3])) 285s > foo <- apply(foo, c(2, 3, 4), mean) 285s > all.equal(foo, out$batch) 285s [1] TRUE 285s > 285s > ### check acceptance rates 285s > 285s > accept.within <- out$acceptd[out$which] 285s > my.i.within <- out$coproposal[out$which, 1] 285s > my.acceptx <- as.vector(sapply(split(accept.within, my.i.within), mean)) 285s > identical(my.acceptx, out$acceptx) 285s [1] TRUE 285s > 285s > accept.swap <- out$acceptd[! out$which] 285s > my.i.swap <- out$coproposal[! out$which, 1] 285s > my.j.swap <- out$proposal[! out$which, 1] 285s > nmodel <- nrow(out$neighbors) 285s > my.accepti <- matrix(NA, nmodel, nmodel) 285s > for (i in 1:nmodel) { 285s + for (j in 1:nmodel) { 285s + if (out$neighbors[i, j]) { 285s + my.accepti[i, j] <- 285s + mean(accept.swap[my.i.swap == i & my.j.swap == j]) 285s + } 285s + } 285s + } 285s > identical(my.accepti, out$accepti) 285s [1] TRUE 285s > 285s > ### check scale vector 285s > 285s > nx <- ncol(models) + 1 285s > newscale <- rnorm(nx, 0.5, 0.1) 285s > 285s > out <- temper(out, scale = newscale) 286s > 286s > my.coproposal.within <- out$coproposal[out$which, ] 286s > proposal.within <- out$proposal[out$which, ] 286s > my.z <- out$norm[out$which, ] 286s > my.proposal.within <- my.coproposal.within 286s > my.proposal.within[ , -1] <- my.coproposal.within[ , -1] + 286s + sweep(my.z, 2, out$scale, "*") 286s > all.equal(proposal.within, my.proposal.within) 286s [1] TRUE 286s > 286s > ### check scale matrix 286s > 286s > matscale <- matrix(rnorm(nx * nx, 0.0, 0.1), nx, nx) 286s > diag(matscale) <- 0.56789 286s > 286s > out <- temper(out, scale = matscale) 286s > 286s > my.coproposal.within <- out$coproposal[out$which, ] 286s > proposal.within <- out$proposal[out$which, ] 286s > my.z <- out$norm[out$which, ] 286s > my.proposal.within <- my.coproposal.within 286s > my.proposal.within[ , -1] <- my.coproposal.within[ , -1] + 286s + my.z %*% t(out$scale) 286s > all.equal(proposal.within, my.proposal.within) 286s [1] TRUE 286s > 286s > ### check scale list 286s > 286s > lisztscale <- list(0.56789, newscale, matscale, matscale, newscale, 286s + 0.98765, 0.98765, newscale) 286s > 286s > out <- temper(out, scale = lisztscale) 286s > 286s > my.coproposal.within <- out$coproposal[out$which, ] 286s > proposal.within <- out$proposal[out$which, ] 286s > my.z <- out$norm[out$which, ] 286s > my.proposal.within <- my.coproposal.within 286s > for (iiter in 1:nrow(my.z)) { 286s + my.i <- my.coproposal.within[iiter, 1] 286s + my.scale <- out$scale[[my.i]] 286s + if (is.matrix(my.scale)) { 286s + my.proposal.within[iiter, -1] <- my.coproposal.within[iiter, -1] + 286s + my.z[iiter, , drop = FALSE] %*% t(my.scale) 286s + } else { 286s + my.proposal.within[iiter, -1] <- my.coproposal.within[iiter, -1] + 286s + my.z[iiter, ] * my.scale 286s + } 286s + } 286s > all.equal(proposal.within, my.proposal.within) 286s [1] TRUE 286s > 286s > ### check outfun 286s > 286s > outfun <- function(state, icomp, ...) { 286s + stopifnot(is.matrix(state)) 286s + stopifnot(is.numeric(state)) 286s + nx <- ncol(betas) 286s + ncomp <- nrow(betas) 286s + stopifnot(ncol(state) == nx) 286s + stopifnot(nrow(state) == ncomp) 286s + stopifnot(1 <= icomp && icomp <= ncomp) 286s + foo <- state[icomp, ] 286s + bar <- foo^2 286s + return(c(foo, bar)) 286s + } 286s > 286s > out <- temper(out, outfun = outfun, icomp = 4) 286s > 286s > before <- out$state 286s > after <- before 286s > after[- dim(after)[1], , ] <- before[-1, , ] 286s > after[dim(after)[1], , ] <- out$final 286s > outies <- apply(after, 1, outfun, icomp = 4) 286s > outies <- t(outies) 286s > 286s > foo <- outies[seq(1, niter) %% out$nspac == 0, ] 286s > foo <- array(as.vector(foo), dim = c(out$blen, out$nbatch, dim(foo)[2])) 286s > foo <- apply(foo, c(2, 3), mean) 286s > all.equal(foo, out$batch) 286s [1] TRUE 286s > 286s > 286s BEGIN TEST tests/temp-ser-witch.R 286s 286s R version 4.4.3 (2025-02-28) -- "Trophy Case" 286s Copyright (C) 2025 The R Foundation for Statistical Computing 286s Platform: arm-unknown-linux-gnueabihf (32-bit) 286s 286s R is free software and comes with ABSOLUTELY NO WARRANTY. 286s You are welcome to redistribute it under certain conditions. 286s Type 'license()' or 'licence()' for distribution details. 286s 286s R is a collaborative project with many contributors. 286s Type 'contributors()' for more information and 286s 'citation()' on how to cite R or R packages in publications. 286s 286s Type 'demo()' for some demos, 'help()' for on-line help, or 286s 'help.start()' for an HTML browser interface to help. 286s Type 'q()' to quit R. 286s 286s > 286s > library(mcmc) 286s > 286s > set.seed(42) 286s > 286s > d <- 3 286s > witch.which <- 1 - (1 / 2)^(1 / d) * (1 / 4)^(seq(0, 5) / d) 286s > witch.which 286s [1] 0.2062995 0.5000000 0.6850197 0.8015749 0.8750000 0.9212549 286s > 286s > ncomp <- length(witch.which) 286s > 286s > neighbors <- matrix(FALSE, ncomp, ncomp) 286s > neighbors[row(neighbors) == col(neighbors) + 1] <- TRUE 286s > neighbors[row(neighbors) == col(neighbors) - 1] <- TRUE 286s > neighbors[row(neighbors) == col(neighbors) + 2] <- TRUE 286s > neighbors[row(neighbors) == col(neighbors) - 2] <- TRUE 286s > 286s > ludfun <- function(state) { 286s + stopifnot(is.numeric(state)) 286s + stopifnot(length(state) == d + 1) 286s + icomp <- state[1] 286s + stopifnot(icomp == as.integer(icomp)) 286s + stopifnot(1 <= icomp && icomp <= ncomp) 286s + theta <- state[-1] 286s + if (any(abs(theta) > 1.0)) return(-Inf) 286s + bnd <- witch.which[icomp] 286s + if(bnd >= 1.0) 286s + stop(sprintf("witch.which[%d] >= 1.0", icomp)) 286s + if(bnd <= 0.0) 286s + stop(sprintf("witch.which[%d] <= 0.0", icomp)) 286s + if (all(abs(theta) > bnd)) 286s + return(- (d + 1) * log(2) - d * log(1 - bnd)) 286s + return(- (d + 1) * log(2) - log1p(- (1 - bnd)^d)) 286s + } 286s > 286s > initial <- c(1, rep(0, d)) 286s > 286s > out <- temper(ludfun, initial = initial, neighbors = neighbors, 286s + nbatch = 50, blen = 13, nspac = 7, scale = 0.3456789) 286s > 286s > names(out) 286s [1] "lud" "neighbors" "nbatch" "blen" "nspac" 286s [6] "scale" "outfun" "debug" "parallel" "initial.seed" 286s [11] "final.seed" "time" "batch" "acceptx" "accepti" 286s [16] "initial" "final" "ibatch" 286s > 286s > out$acceptx 286s [1] 0.6388889 0.4385246 0.3631714 0.4885246 0.4709677 0.4735516 286s > 286s > out$accepti 286s [,1] [,2] [,3] [,4] [,5] [,6] 286s [1,] NA 0.5071770 0.2727273 NA NA NA 286s [2,] 0.7070064 NA 0.4355828 0.4186047 NA NA 286s [3,] 0.5816327 0.8039216 NA 0.5888889 0.5662651 NA 286s [4,] NA 0.7415730 0.8571429 NA 0.7857143 0.6626506 286s [5,] NA NA 0.5204082 0.6516854 NA 0.8378378 286s [6,] NA NA NA 0.3515152 0.5056818 NA 286s > 286s > colMeans(out$ibatch) 286s [1] 0.1830769 0.2153846 0.1630769 0.1369231 0.1353846 0.1661538 286s > 286s > ### check that have prob 1 / 2 for corners 286s > 286s > outfun <- function(state) { 286s + stopifnot(is.numeric(state)) 286s + icomp <- state[1] 286s + stopifnot(icomp == as.integer(icomp)) 286s + stopifnot(1 <= icomp && icomp <= length(witch.which)) 286s + theta <- state[-1] 286s + foo <- all(abs(theta) > witch.which[icomp]) 286s + bar <- rep(0, length(witch.which)) 286s + baz <- rep(0, length(witch.which)) 286s + bar[icomp] <- as.numeric(foo) 286s + baz[icomp] <- 1 286s + return(c(bar, baz)) 286s + } 286s > 286s > out <- temper(out, blen = 103, outfun = outfun, debug = TRUE) 287s > 287s > eta.batch <- out$batch[ , seq(1, ncomp)] 287s > noo.batch <- out$batch[ , seq(ncomp + 1, ncomp + ncomp)] 287s > eta <- colMeans(eta.batch) 287s > noo <- colMeans(noo.batch) 287s > mu <- eta / noo 287s > eta 287s [1] 0.06660194 0.06388350 0.05766990 0.06563107 0.10368932 0.22912621 287s > noo 287s [1] 0.1365049 0.1258252 0.1293204 0.1370874 0.1716505 0.2996117 287s > mu 287s [1] 0.4879090 0.5077160 0.4459459 0.4787535 0.6040724 0.7647440 287s > 287s > eta.batch.rel <- sweep(eta.batch, 2, eta, "/") 287s > noo.batch.rel <- sweep(noo.batch, 2, noo, "/") 287s > mu.batch.rel <- eta.batch.rel - noo.batch.rel 287s > 287s > mu.mcse.rel <- apply(mu.batch.rel, 2, sd) / sqrt(out$nbatch) 287s > mu.mcse.rel 287s [1] 0.05010927 0.07897321 0.09678339 0.12636113 0.11261781 0.07082685 287s > 287s > foo <- cbind(mu, mu * mu.mcse.rel) 287s > colnames(foo) <- c("means", "MCSE") 287s > foo 287s means MCSE 287s [1,] 0.4879090 0.02444876 287s [2,] 0.5077160 0.04009596 287s [3,] 0.4459459 0.04316016 287s [4,] 0.4787535 0.06049584 287s [5,] 0.6040724 0.06802931 287s [6,] 0.7647440 0.05416441 287s > 287s > ### check decision about within-component or jump/swap 287s > 287s > identical(out$unif.which < 0.5, out$which) 287s [1] TRUE 287s > 287s > identical(out$which, out$proposal[ , 1] == out$state[ , 1]) 287s [1] TRUE 287s > 287s > ### check hastings ratio calculated correctly 287s > 287s > n <- apply(neighbors, 1, sum) 287s > i <- out$state[ , 1] 287s > istar <- out$proposal[ , 1] 287s > foo <- apply(out$state, 1, ludfun) 288s > bar <- apply(out$proposal, 1, ludfun) 289s > my.log.hastings <- bar - foo - log(n[istar]) + log(n[i]) 289s > all.equal(my.log.hastings, out$log.hastings) 289s [1] TRUE 289s > 289s > 289s BEGIN TEST tests/temp-ser.R 289s 289s R version 4.4.3 (2025-02-28) -- "Trophy Case" 289s Copyright (C) 2025 The R Foundation for Statistical Computing 289s Platform: arm-unknown-linux-gnueabihf (32-bit) 289s 289s R is free software and comes with ABSOLUTELY NO WARRANTY. 289s You are welcome to redistribute it under certain conditions. 289s Type 'license()' or 'licence()' for distribution details. 289s 289s R is a collaborative project with many contributors. 289s Type 'contributors()' for more information and 289s 'citation()' on how to cite R or R packages in publications. 289s 289s Type 'demo()' for some demos, 'help()' for on-line help, or 289s 'help.start()' for an HTML browser interface to help. 289s Type 'q()' to quit R. 289s 289s > 289s > library(mcmc) 289s > 289s > set.seed(42) 289s > 289s > data(foo) 289s > attach(foo) 289s > 289s > out <- glm(y ~ x1 + x2 + x3, family = binomial, x = TRUE) 289s > ## IGNORE_RDIFF_BEGIN 289s > summary(out) 289s 289s Call: 289s glm(formula = y ~ x1 + x2 + x3, family = binomial, x = TRUE) 289s 289s Coefficients: 289s Estimate Std. Error z value Pr(>|z|) 289s (Intercept) 0.5772 0.2766 2.087 0.036930 * 289s x1 0.3362 0.4256 0.790 0.429672 289s x2 0.8475 0.4701 1.803 0.071394 . 289s x3 1.5143 0.4426 3.422 0.000622 *** 289s --- 289s Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 289s 289s (Dispersion parameter for binomial family taken to be 1) 289s 289s Null deviance: 134.602 on 99 degrees of freedom 289s Residual deviance: 86.439 on 96 degrees of freedom 289s AIC: 94.439 289s 289s Number of Fisher Scoring iterations: 5 289s 289s > ## IGNORE_RDIFF_END 289s > 289s > modmat <- out$x 289s > 289s > models <- cbind(rep(0:1, each = 4), rep(rep(0:1, times = 2), each = 2), 289s + rep(0:1, times = 4)) 289s > 289s > exes <- paste("x", 1:3, sep = "") 289s > models[nrow(models), ] 289s [1] 1 1 1 289s > beta.initial <- c(nrow(models), out$coefficients) 289s > 289s > neighbors <- matrix(FALSE, nrow(models), nrow(models)) 289s > for (i in 1:nrow(neighbors)) { 289s + for (j in 1:ncol(neighbors)) { 289s + foo <- models[i, ] 289s + bar <- models[j, ] 289s + if (sum(foo != bar) == 1) neighbors[i, j] <- TRUE 289s + } 289s + } 289s > neighbors 289s [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] 289s [1,] FALSE TRUE TRUE FALSE TRUE FALSE FALSE FALSE 289s [2,] TRUE FALSE FALSE TRUE FALSE TRUE FALSE FALSE 289s [3,] TRUE FALSE FALSE TRUE FALSE FALSE TRUE FALSE 289s [4,] FALSE TRUE TRUE FALSE FALSE FALSE FALSE TRUE 289s [5,] TRUE FALSE FALSE FALSE FALSE TRUE TRUE FALSE 289s [6,] FALSE TRUE FALSE FALSE TRUE FALSE FALSE TRUE 289s [7,] FALSE FALSE TRUE FALSE TRUE FALSE FALSE TRUE 289s [8,] FALSE FALSE FALSE TRUE FALSE TRUE TRUE FALSE 289s > 289s > ludfun <- function(state, log.pseudo.prior, ...) { 289s + stopifnot(is.numeric(state)) 289s + stopifnot(length(state) == ncol(models) + 2) 289s + icomp <- state[1] 289s + stopifnot(icomp == as.integer(icomp)) 289s + stopifnot(1 <= icomp && icomp <= nrow(models)) 289s + stopifnot(is.numeric(log.pseudo.prior)) 289s + stopifnot(length(log.pseudo.prior) == nrow(models)) 289s + beta <- state[-1] 289s + inies <- c(TRUE, as.logical(models[icomp, ])) 289s + beta.logl <- beta 289s + beta.logl[! inies] <- 0 289s + eta <- as.numeric(modmat %*% beta.logl) 289s + logp <- ifelse(eta < 0, eta - log1p(exp(eta)), - log1p(exp(- eta))) 289s + logq <- ifelse(eta < 0, - log1p(exp(eta)), - eta - log1p(exp(- eta))) 289s + logl <- sum(logp[y == 1]) + sum(logq[y == 0]) 289s + val <- logl - sum(beta^2) / 2 + log.pseudo.prior[icomp] 289s + return(val) 289s + } 289s > 289s > qux <- c(25.01, 5.875, 9.028, 0.6959, 11.73, 2.367, 5.864, 0.0) 289s > 289s > out <- temper(ludfun, initial = beta.initial, neighbors = neighbors, 289s + nbatch = 25, blen = 20, nspac = 5, scale = 0.56789, debug = TRUE, 289s + log.pseudo.prior = qux) 289s > 289s > names(out) 289s [1] "lud" "neighbors" "nbatch" "blen" 289s [5] "nspac" "scale" "outfun" "debug" 289s [9] "parallel" "initial.seed" "final.seed" "time" 289s [13] "batch" "acceptx" "accepti" "initial" 289s [17] "final" "ibatch" "which" "unif.which" 289s [21] "state" "log.hastings" "unif.hastings" "proposal" 289s [25] "acceptd" "norm" "unif.choose" 289s > 289s > apply(out$ibatch, 2, mean) 289s [1] 0.776 0.170 0.000 0.006 0.024 0.010 0.004 0.010 289s > 289s > ### check decision about within-component or jump/swap 289s > 289s > identical(out$unif.which < 0.5, out$which) 289s [1] TRUE 289s > 289s > identical(out$which, out$proposal[ , 1] == out$state[ , 1]) 289s [1] TRUE 289s > 289s > ### check hastings ratio calculated correctly 289s > 289s > foo <- apply(out$state, 1, ludfun, log.pseudo.prior = qux) 289s > bar <- apply(out$proposal, 1, ludfun, log.pseudo.prior = qux) 290s > all.equal(bar - foo, out$log.hastings) 290s [1] TRUE 290s > 290s > ### check hastings rejection decided correctly 290s > 290s > identical(out$log.hastings >= 0, is.na(out$unif.hastings)) 290s [1] TRUE 290s > all(out$log.hastings < 0 | out$acceptd) 290s [1] TRUE 290s > identical(out$acceptd, 290s + out$log.hastings >= 0 | out$unif.hastings < exp(out$log.hastings)) 290s [1] TRUE 290s > 290s > ### check acceptance carried out or not (according to decision) correctly 290s > 290s > before <- out$state 290s > after <- before 290s > after[- dim(after)[1], ] <- before[-1, ] 290s > after[dim(after)[1], ] <- out$final 290s > my.after <- before 290s > my.after[out$acceptd, ] <- out$proposal[out$acceptd, ] 290s > identical(after, my.after) 290s [1] TRUE 290s > 290s > ### check within-component proposal 290s > 290s > my.coproposal.within <- out$state[out$which, ] 290s > proposal.within <- out$proposal[out$which, ] 290s > my.z <- out$norm[out$which, ] 290s > my.proposal.within <- my.coproposal.within 290s > my.proposal.within[ , -1] <- my.coproposal.within[ , -1] + out$scale * my.z 290s > all.equal(proposal.within, my.proposal.within) 290s [1] TRUE 290s > 290s > ### check swap proposal 290s > 290s > coproposal.swap <- out$state[! out$which, ] 290s > proposal.swap <- out$proposal[! out$which, ] 290s > unif.choose.swap <- out$unif.choose[! out$which] 290s > my.i <- coproposal.swap[ , 1] 290s > nneighbors <- apply(out$neighbors, 1, sum) 290s > my.nneighbors <- nneighbors[my.i] 290s > my.k <- floor(my.nneighbors * unif.choose.swap) + 1 290s > my.j <- my.k 290s > foo <- seq(1, ncol(out$neighbors)) 290s > for (i in seq(along = my.j)) { 290s + my.j[i] <- (foo[out$neighbors[my.i[i], ]])[my.k[i]] 290s + } 290s > identical(coproposal.swap[ , 1], my.i) 290s [1] TRUE 290s > identical(proposal.swap[ , 1], my.j) 290s [1] TRUE 290s > 290s > ### check standard normal and uniform random numbers are as purported 290s > 290s > save.Random.seed <- .Random.seed 290s > .Random.seed <- out$initial.seed 290s > 290s > nx <- length(out$initial) - 1 290s > niter <- out$nbatch * out$blen * out$nspac 290s > my.norm <- matrix(NA, nrow = nrow(out$norm), ncol = ncol(out$norm)) 290s > my.unif.which <- rep(NA, niter) 290s > my.unif.hastings <- rep(NA, niter) 290s > my.unif.choose <- rep(NA, niter) 290s > for (iiter in 1:niter) { 290s + my.unif.which[iiter] <- runif(1) 290s + if (out$which[iiter]) { 290s + my.norm[iiter, ] <- rnorm(nx) 290s + if (out$log.hastings[iiter] < 0) my.unif.hastings[iiter] <- runif(1) 290s + } else { 290s + my.unif.choose[iiter] <- runif(1) 290s + if (out$log.hastings[iiter] < 0) my.unif.hastings[iiter] <- runif(1) 290s + } 290s + } 290s > identical(my.norm, out$norm) 290s [1] TRUE 290s > identical(my.unif.which, out$unif.which) 290s [1] TRUE 290s > identical(my.unif.hastings, out$unif.hastings) 290s [1] TRUE 290s > identical(my.unif.choose, out$unif.choose) 290s [1] TRUE 290s > 290s > .Random.seed <- save.Random.seed 290s > 290s > ### check batch means 290s > 290s > my.xstate <- after[ , -1] 290s > foo <- my.xstate[seq(1, niter) %% out$nspac == 0, ] 290s > foo <- array(as.vector(foo), dim = c(out$blen, out$nbatch, dim(foo)[2])) 290s > foo <- apply(foo, c(2, 3), mean) 290s > all.equal(foo, out$batch) 290s [1] TRUE 290s > 290s > ### check ibatch means 290s > 290s > my.istate <- after[ , 1] 290s > my.istate.matrix <- matrix(0, length(my.istate), nrow(models)) 290s > for (i in 1:nrow(my.istate.matrix)) 290s + my.istate.matrix[i, my.istate[i]] <- 1 290s > foo <- my.istate.matrix[seq(1, niter) %% out$nspac == 0, ] 290s > foo <- array(as.vector(foo), dim = c(out$blen, out$nbatch, dim(foo)[2])) 290s > foo <- apply(foo, c(2, 3), mean) 290s > all.equal(foo, out$ibatch) 290s [1] TRUE 290s > 290s > ### check acceptance rates 290s > 290s > nmodel <- nrow(out$neighbors) 290s > 290s > accept.within <- out$acceptd[out$which] 290s > my.i.within <- out$state[out$which, 1] 290s > my.i.within.accept <- my.i.within[accept.within] 290s > my.acceptx.numer <- tabulate(my.i.within.accept, nbins = nmodel) 290s > my.acceptx.denom <- tabulate(my.i.within, nbins = nmodel) 290s > my.acceptx <- my.acceptx.numer / my.acceptx.denom 290s > identical(my.acceptx, out$acceptx) 290s [1] TRUE 290s > 290s > accept.swap <- out$acceptd[! out$which] 290s > my.i.swap <- out$state[! out$which, 1] 290s > my.j.swap <- out$proposal[! out$which, 1] 290s > my.accepti <- matrix(NA, nmodel, nmodel) 290s > for (i in 1:nmodel) { 290s + for (j in 1:nmodel) { 290s + if (out$neighbors[i, j]) { 290s + my.accepti[i, j] <- 290s + mean(accept.swap[my.i.swap == i & my.j.swap == j]) 290s + } 290s + } 290s + } 290s > identical(my.accepti, out$accepti) 290s [1] TRUE 290s > 290s > ### check scale vector 290s > 290s > nx <- ncol(models) + 1 290s > newscale <- rnorm(nx, 0.5, 0.1) 290s > 290s > out <- temper(out, scale = newscale, log.pseudo.prior = qux) 290s > 290s > my.coproposal.within <- out$state[out$which, ] 290s > proposal.within <- out$proposal[out$which, ] 290s > my.z <- out$norm[out$which, ] 290s > my.proposal.within <- my.coproposal.within 290s > my.proposal.within[ , -1] <- my.coproposal.within[ , -1] + 290s + sweep(my.z, 2, out$scale, "*") 290s > all.equal(proposal.within, my.proposal.within) 290s [1] TRUE 290s > 290s > ### check scale matrix 290s > 290s > matscale <- matrix(rnorm(nx * nx, 0.0, 0.1), nx, nx) 290s > diag(matscale) <- 0.56789 290s > 290s > out <- temper(out, scale = matscale, log.pseudo.prior = qux) 290s > 290s > my.coproposal.within <- out$state[out$which, ] 290s > proposal.within <- out$proposal[out$which, ] 290s > my.z <- out$norm[out$which, ] 290s > my.proposal.within <- my.coproposal.within 290s > my.proposal.within[ , -1] <- my.coproposal.within[ , -1] + 290s + my.z %*% t(out$scale) 290s > all.equal(proposal.within, my.proposal.within) 290s [1] TRUE 290s > 290s > ### check scale list 290s > 290s > lisztscale <- list(0.56789, newscale, matscale, matscale, newscale, 290s + 0.98765, 0.98765, newscale) 290s > 290s > out <- temper(out, scale = lisztscale, log.pseudo.prior = qux) 290s > 290s > my.coproposal.within <- out$state[out$which, ] 290s > proposal.within <- out$proposal[out$which, ] 290s > my.z <- out$norm[out$which, ] 290s > my.proposal.within <- my.coproposal.within 290s > for (iiter in 1:nrow(my.z)) { 290s + my.i <- my.coproposal.within[iiter, 1] 290s + my.scale <- out$scale[[my.i]] 290s + if (is.matrix(my.scale)) { 290s + my.proposal.within[iiter, -1] <- my.coproposal.within[iiter, -1] + 290s + my.z[iiter, , drop = FALSE] %*% t(my.scale) 290s + } else { 290s + my.proposal.within[iiter, -1] <- my.coproposal.within[iiter, -1] + 290s + my.z[iiter, ] * my.scale 290s + } 290s + } 290s > all.equal(proposal.within, my.proposal.within) 290s [1] TRUE 290s > 290s > ### check outfun 290s > 290s > outfun <- function(state, icomp) { 290s + stopifnot(is.matrix(state)) 290s + stopifnot(is.numeric(state)) 290s + nx <- ncol(initial) 290s + ncomp <- nrow(initial) 290s + stopifnot(ncol(state) == nx) 290s + stopifnot(nrow(state) == ncomp) 290s + stopifnot(1 <= icomp & icomp <= ncomp) 290s + foo <- state[icomp, ] 290s + bar <- foo^2 290s + return(c(foo, bar)) 290s + } 290s > 290s > ncomp <- nrow(models) 290s > nx <- length(beta.initial) - 1 290s > 290s > outfun <- function(state, icomp, ...) { 290s + stopifnot(is.numeric(state)) 290s + stopifnot(length(state) == nx + 1) 290s + istate <- state[1] 290s + stopifnot(istate == as.integer(istate)) 290s + stopifnot(1 <= istate && istate <= ncomp) 290s + stopifnot(1 <= icomp && icomp <= ncomp) 290s + if (istate == icomp) { 290s + foo <- state[-1] 290s + } else { 290s + foo <- rep(0, nx) 290s + } 290s + bar <- foo^2 290s + return(c(foo, bar)) 290s + } 290s > 290s > out <- temper(ludfun, initial = out$final, neighbors = neighbors, 290s + nbatch = 25, blen = 20, nspac = 5, scale = 0.56789, debug = TRUE, 290s + outfun = outfun, log.pseudo.prior = qux, icomp = 4) 291s > 291s > before <- out$state 291s > after <- before 291s > after[- dim(after)[1], ] <- before[-1, ] 291s > after[dim(after)[1], ] <- out$final 291s > outies <- apply(after, 1, outfun, icomp = 4) 291s > outies <- t(outies) 291s > 291s > foo <- outies[seq(1, niter) %% out$nspac == 0, ] 291s > foo <- array(as.vector(foo), dim = c(out$blen, out$nbatch, dim(foo)[2])) 291s > foo <- apply(foo, c(2, 3), mean) 291s > all.equal(foo, out$batch) 291s [1] TRUE 291s > 291s > 291s BEGIN TEST tests/zero-error.R 291s 291s R version 4.4.3 (2025-02-28) -- "Trophy Case" 291s Copyright (C) 2025 The R Foundation for Statistical Computing 291s Platform: arm-unknown-linux-gnueabihf (32-bit) 291s 291s R is free software and comes with ABSOLUTELY NO WARRANTY. 291s You are welcome to redistribute it under certain conditions. 291s Type 'license()' or 'licence()' for distribution details. 291s 291s R is a collaborative project with many contributors. 291s Type 'contributors()' for more information and 291s 'citation()' on how to cite R or R packages in publications. 291s 291s Type 'demo()' for some demos, 'help()' for on-line help, or 291s 'help.start()' for an HTML browser interface to help. 291s Type 'q()' to quit R. 291s 291s > 291s > library(mcmc) 291s > 291s > # should give intelligible error (unlike before ver 0.9-8) 291s > 291s > suppressMessages(try(metrop(function(x) x, double(0), nbatch = 10))) 291s Error in system.time(out <- .Call(C_metrop, func1, initial, nbatch, blen, : 291s argument "initial" must have nonzero length 291s > 291s autopkgtest [16:24:40]: test generic: -----------------------] 295s autopkgtest [16:24:44]: test generic: - - - - - - - - - - results - - - - - - - - - - 295s generic PASS 299s autopkgtest [16:24:48]: test pkg-r-autopkgtest: preparing testbed 301s Reading package lists... 301s Building dependency tree... 301s Reading state information... 301s Starting pkgProblemResolver with broken count: 0 301s Starting 2 pkgProblemResolver with broken count: 0 301s Done 302s The following NEW packages will be installed: 302s build-essential cpp cpp-14 cpp-14-arm-linux-gnueabihf 302s cpp-arm-linux-gnueabihf dctrl-tools g++ g++-14 g++-14-arm-linux-gnueabihf 302s g++-arm-linux-gnueabihf gcc gcc-14 gcc-14-arm-linux-gnueabihf 302s gcc-arm-linux-gnueabihf gfortran gfortran-14 gfortran-14-arm-linux-gnueabihf 302s gfortran-arm-linux-gnueabihf icu-devtools libasan8 libblas-dev libbz2-dev 302s libc-dev-bin libc6-dev libcc1-0 libcrypt-dev libdeflate-dev libgcc-14-dev 302s libgfortran-14-dev libicu-dev libisl23 libjpeg-dev libjpeg-turbo8-dev 302s libjpeg8-dev liblapack-dev liblzma-dev libmpc3 libncurses-dev libpcre2-16-0 302s libpcre2-32-0 libpcre2-dev libpcre2-posix3 libpkgconf3 libpng-dev 302s libreadline-dev libstdc++-14-dev libtirpc-dev libubsan1 linux-libc-dev 302s pkg-r-autopkgtest pkgconf pkgconf-bin r-base-dev rpcsvc-proto zlib1g-dev 302s 0 upgraded, 55 newly installed, 0 to remove and 0 not upgraded. 302s Need to get 78.1 MB of archives. 302s After this operation, 243 MB of additional disk space will be used. 302s Get:1 http://ftpmaster.internal/ubuntu plucky-proposed/main armhf libc-dev-bin armhf 2.41-1ubuntu2 [23.0 kB] 303s Get:2 http://ftpmaster.internal/ubuntu plucky/main armhf linux-libc-dev armhf 6.14.0-10.10 [1683 kB] 305s Get:3 http://ftpmaster.internal/ubuntu plucky/main armhf libcrypt-dev armhf 1:4.4.38-1 [120 kB] 305s Get:4 http://ftpmaster.internal/ubuntu plucky/main armhf rpcsvc-proto armhf 1.4.2-0ubuntu7 [62.2 kB] 305s Get:5 http://ftpmaster.internal/ubuntu plucky-proposed/main armhf libc6-dev armhf 2.41-1ubuntu2 [1396 kB] 307s Get:6 http://ftpmaster.internal/ubuntu plucky/main armhf libisl23 armhf 0.27-1 [546 kB] 307s Get:7 http://ftpmaster.internal/ubuntu plucky/main armhf libmpc3 armhf 1.3.1-1build2 [47.1 kB] 307s Get:8 http://ftpmaster.internal/ubuntu plucky/main armhf cpp-14-arm-linux-gnueabihf armhf 14.2.0-17ubuntu3 [9220 kB] 318s Get:9 http://ftpmaster.internal/ubuntu plucky/main armhf cpp-14 armhf 14.2.0-17ubuntu3 [1030 B] 318s Get:10 http://ftpmaster.internal/ubuntu plucky/main armhf cpp-arm-linux-gnueabihf armhf 4:14.2.0-1ubuntu1 [5578 B] 318s Get:11 http://ftpmaster.internal/ubuntu plucky/main armhf cpp armhf 4:14.2.0-1ubuntu1 [22.4 kB] 318s Get:12 http://ftpmaster.internal/ubuntu plucky/main armhf libcc1-0 armhf 15-20250222-0ubuntu1 [38.9 kB] 318s Get:13 http://ftpmaster.internal/ubuntu plucky/main armhf libasan8 armhf 15-20250222-0ubuntu1 [2955 kB] 321s Get:14 http://ftpmaster.internal/ubuntu plucky/main armhf libubsan1 armhf 15-20250222-0ubuntu1 [1191 kB] 323s Get:15 http://ftpmaster.internal/ubuntu plucky/main armhf libgcc-14-dev armhf 14.2.0-17ubuntu3 [897 kB] 324s Get:16 http://ftpmaster.internal/ubuntu plucky/main armhf gcc-14-arm-linux-gnueabihf armhf 14.2.0-17ubuntu3 [18.0 MB] 343s Get:17 http://ftpmaster.internal/ubuntu plucky/main armhf gcc-14 armhf 14.2.0-17ubuntu3 [506 kB] 344s Get:18 http://ftpmaster.internal/ubuntu plucky/main armhf gcc-arm-linux-gnueabihf armhf 4:14.2.0-1ubuntu1 [1218 B] 344s Get:19 http://ftpmaster.internal/ubuntu plucky/main armhf gcc armhf 4:14.2.0-1ubuntu1 [5004 B] 344s Get:20 http://ftpmaster.internal/ubuntu plucky/main armhf libstdc++-14-dev armhf 14.2.0-17ubuntu3 [2573 kB] 347s Get:21 http://ftpmaster.internal/ubuntu plucky/main armhf g++-14-arm-linux-gnueabihf armhf 14.2.0-17ubuntu3 [10.5 MB] 358s Get:22 http://ftpmaster.internal/ubuntu plucky/main armhf g++-14 armhf 14.2.0-17ubuntu3 [21.8 kB] 358s Get:23 http://ftpmaster.internal/ubuntu plucky/main armhf g++-arm-linux-gnueabihf armhf 4:14.2.0-1ubuntu1 [966 B] 358s Get:24 http://ftpmaster.internal/ubuntu plucky/main armhf g++ armhf 4:14.2.0-1ubuntu1 [1084 B] 358s Get:25 http://ftpmaster.internal/ubuntu plucky/main armhf build-essential armhf 12.10ubuntu1 [4928 B] 358s Get:26 http://ftpmaster.internal/ubuntu plucky/main armhf dctrl-tools armhf 2.24-3build3 [94.7 kB] 358s Get:27 http://ftpmaster.internal/ubuntu plucky/main armhf libgfortran-14-dev armhf 14.2.0-17ubuntu3 [370 kB] 359s Get:28 http://ftpmaster.internal/ubuntu plucky/main armhf gfortran-14-arm-linux-gnueabihf armhf 14.2.0-17ubuntu3 [9763 kB] 370s Get:29 http://ftpmaster.internal/ubuntu plucky/main armhf gfortran-14 armhf 14.2.0-17ubuntu3 [13.6 kB] 370s Get:30 http://ftpmaster.internal/ubuntu plucky/main armhf gfortran-arm-linux-gnueabihf armhf 4:14.2.0-1ubuntu1 [1026 B] 370s Get:31 http://ftpmaster.internal/ubuntu plucky/main armhf gfortran armhf 4:14.2.0-1ubuntu1 [1166 B] 370s Get:32 http://ftpmaster.internal/ubuntu plucky/main armhf icu-devtools armhf 76.1-1ubuntu2 [206 kB] 370s Get:33 http://ftpmaster.internal/ubuntu plucky/main armhf libblas-dev armhf 3.12.1-2 [141 kB] 370s Get:34 http://ftpmaster.internal/ubuntu plucky/main armhf libbz2-dev armhf 1.0.8-6 [30.9 kB] 370s Get:35 http://ftpmaster.internal/ubuntu plucky/main armhf libdeflate-dev armhf 1.23-1 [45.0 kB] 370s Get:36 http://ftpmaster.internal/ubuntu plucky/main armhf libicu-dev armhf 76.1-1ubuntu2 [12.0 MB] 384s Get:37 http://ftpmaster.internal/ubuntu plucky/main armhf libjpeg-turbo8-dev armhf 2.1.5-3ubuntu2 [265 kB] 384s Get:38 http://ftpmaster.internal/ubuntu plucky/main armhf libjpeg8-dev armhf 8c-2ubuntu11 [1484 B] 384s Get:39 http://ftpmaster.internal/ubuntu plucky/main armhf libjpeg-dev armhf 8c-2ubuntu11 [1482 B] 384s Get:40 http://ftpmaster.internal/ubuntu plucky/main armhf liblapack-dev armhf 3.12.1-2 [2207 kB] 386s Get:41 http://ftpmaster.internal/ubuntu plucky/main armhf libncurses-dev armhf 6.5+20250216-2 [345 kB] 387s Get:42 http://ftpmaster.internal/ubuntu plucky/main armhf libpcre2-16-0 armhf 10.45-1 [207 kB] 387s Get:43 http://ftpmaster.internal/ubuntu plucky/main armhf libpcre2-32-0 armhf 10.45-1 [197 kB] 387s Get:44 http://ftpmaster.internal/ubuntu plucky/main armhf libpcre2-posix3 armhf 10.45-1 [6300 B] 387s Get:45 http://ftpmaster.internal/ubuntu plucky/main armhf libpcre2-dev armhf 10.45-1 [752 kB] 388s Get:46 http://ftpmaster.internal/ubuntu plucky/main armhf libpkgconf3 armhf 1.8.1-4 [26.6 kB] 388s Get:47 http://ftpmaster.internal/ubuntu plucky/main armhf zlib1g-dev armhf 1:1.3.dfsg+really1.3.1-1ubuntu1 [880 kB] 389s Get:48 http://ftpmaster.internal/ubuntu plucky/main armhf libpng-dev armhf 1.6.47-1 [251 kB] 389s Get:49 http://ftpmaster.internal/ubuntu plucky/main armhf libreadline-dev armhf 8.2-6 [153 kB] 389s Get:50 http://ftpmaster.internal/ubuntu plucky/main armhf liblzma-dev armhf 5.6.4-1 [166 kB] 389s Get:51 http://ftpmaster.internal/ubuntu plucky/main armhf pkgconf-bin armhf 1.8.1-4 [21.2 kB] 389s Get:52 http://ftpmaster.internal/ubuntu plucky/main armhf pkgconf armhf 1.8.1-4 [16.8 kB] 389s Get:53 http://ftpmaster.internal/ubuntu plucky/main armhf libtirpc-dev armhf 1.3.4+ds-1.3 [184 kB] 390s Get:54 http://ftpmaster.internal/ubuntu plucky/universe armhf r-base-dev all 4.4.3-1 [4176 B] 390s Get:55 http://ftpmaster.internal/ubuntu plucky/universe armhf pkg-r-autopkgtest all 20231212ubuntu1 [6448 B] 390s Fetched 78.1 MB in 1min 27s (893 kB/s) 390s Selecting previously unselected package libc-dev-bin. 390s (Reading database ... (Reading database ... 5% (Reading database ... 10% (Reading database ... 15% (Reading database ... 20% (Reading database ... 25% (Reading database ... 30% (Reading database ... 35% (Reading database ... 40% (Reading database ... 45% (Reading database ... 50% (Reading database ... 55% (Reading database ... 60% (Reading database ... 65% (Reading database ... 70% (Reading database ... 75% (Reading database ... 80% (Reading database ... 85% (Reading database ... 90% (Reading database ... 95% (Reading database ... 100% (Reading database ... 66978 files and directories currently installed.) 390s Preparing to unpack .../00-libc-dev-bin_2.41-1ubuntu2_armhf.deb ... 390s Unpacking libc-dev-bin (2.41-1ubuntu2) ... 390s Selecting previously unselected package linux-libc-dev:armhf. 390s Preparing to unpack .../01-linux-libc-dev_6.14.0-10.10_armhf.deb ... 390s Unpacking linux-libc-dev:armhf (6.14.0-10.10) ... 390s Selecting previously unselected package libcrypt-dev:armhf. 390s Preparing to unpack .../02-libcrypt-dev_1%3a4.4.38-1_armhf.deb ... 390s Unpacking libcrypt-dev:armhf (1:4.4.38-1) ... 390s Selecting previously unselected package rpcsvc-proto. 390s Preparing to unpack .../03-rpcsvc-proto_1.4.2-0ubuntu7_armhf.deb ... 390s Unpacking rpcsvc-proto (1.4.2-0ubuntu7) ... 391s Selecting previously unselected package libc6-dev:armhf. 391s Preparing to unpack .../04-libc6-dev_2.41-1ubuntu2_armhf.deb ... 391s Unpacking libc6-dev:armhf (2.41-1ubuntu2) ... 391s Selecting previously unselected package libisl23:armhf. 391s Preparing to unpack .../05-libisl23_0.27-1_armhf.deb ... 391s Unpacking libisl23:armhf (0.27-1) ... 391s Selecting previously unselected package libmpc3:armhf. 391s Preparing to unpack .../06-libmpc3_1.3.1-1build2_armhf.deb ... 391s Unpacking libmpc3:armhf (1.3.1-1build2) ... 391s Selecting previously unselected package cpp-14-arm-linux-gnueabihf. 391s Preparing to unpack .../07-cpp-14-arm-linux-gnueabihf_14.2.0-17ubuntu3_armhf.deb ... 391s Unpacking cpp-14-arm-linux-gnueabihf (14.2.0-17ubuntu3) ... 391s Selecting previously unselected package cpp-14. 391s Preparing to unpack .../08-cpp-14_14.2.0-17ubuntu3_armhf.deb ... 391s Unpacking cpp-14 (14.2.0-17ubuntu3) ... 391s Selecting previously unselected package cpp-arm-linux-gnueabihf. 391s Preparing to unpack .../09-cpp-arm-linux-gnueabihf_4%3a14.2.0-1ubuntu1_armhf.deb ... 391s Unpacking cpp-arm-linux-gnueabihf (4:14.2.0-1ubuntu1) ... 391s Selecting previously unselected package cpp. 391s Preparing to unpack .../10-cpp_4%3a14.2.0-1ubuntu1_armhf.deb ... 391s Unpacking cpp (4:14.2.0-1ubuntu1) ... 391s Selecting previously unselected package libcc1-0:armhf. 391s Preparing to unpack .../11-libcc1-0_15-20250222-0ubuntu1_armhf.deb ... 391s Unpacking libcc1-0:armhf (15-20250222-0ubuntu1) ... 391s Selecting previously unselected package libasan8:armhf. 391s Preparing to unpack .../12-libasan8_15-20250222-0ubuntu1_armhf.deb ... 391s Unpacking libasan8:armhf (15-20250222-0ubuntu1) ... 391s Selecting previously unselected package libubsan1:armhf. 391s Preparing to unpack .../13-libubsan1_15-20250222-0ubuntu1_armhf.deb ... 391s Unpacking libubsan1:armhf (15-20250222-0ubuntu1) ... 391s Selecting previously unselected package libgcc-14-dev:armhf. 391s Preparing to unpack .../14-libgcc-14-dev_14.2.0-17ubuntu3_armhf.deb ... 391s Unpacking libgcc-14-dev:armhf (14.2.0-17ubuntu3) ... 391s Selecting previously unselected package gcc-14-arm-linux-gnueabihf. 391s Preparing to unpack .../15-gcc-14-arm-linux-gnueabihf_14.2.0-17ubuntu3_armhf.deb ... 391s Unpacking gcc-14-arm-linux-gnueabihf (14.2.0-17ubuntu3) ... 392s Selecting previously unselected package gcc-14. 392s Preparing to unpack .../16-gcc-14_14.2.0-17ubuntu3_armhf.deb ... 392s Unpacking gcc-14 (14.2.0-17ubuntu3) ... 392s Selecting previously unselected package gcc-arm-linux-gnueabihf. 392s Preparing to unpack .../17-gcc-arm-linux-gnueabihf_4%3a14.2.0-1ubuntu1_armhf.deb ... 392s Unpacking gcc-arm-linux-gnueabihf (4:14.2.0-1ubuntu1) ... 392s Selecting previously unselected package gcc. 392s Preparing to unpack .../18-gcc_4%3a14.2.0-1ubuntu1_armhf.deb ... 392s Unpacking gcc (4:14.2.0-1ubuntu1) ... 392s Selecting previously unselected package libstdc++-14-dev:armhf. 392s Preparing to unpack .../19-libstdc++-14-dev_14.2.0-17ubuntu3_armhf.deb ... 392s Unpacking libstdc++-14-dev:armhf (14.2.0-17ubuntu3) ... 392s Selecting previously unselected package g++-14-arm-linux-gnueabihf. 392s Preparing to unpack .../20-g++-14-arm-linux-gnueabihf_14.2.0-17ubuntu3_armhf.deb ... 392s Unpacking g++-14-arm-linux-gnueabihf (14.2.0-17ubuntu3) ... 392s Selecting previously unselected package g++-14. 392s Preparing to unpack .../21-g++-14_14.2.0-17ubuntu3_armhf.deb ... 392s Unpacking g++-14 (14.2.0-17ubuntu3) ... 392s Selecting previously unselected package g++-arm-linux-gnueabihf. 392s Preparing to unpack .../22-g++-arm-linux-gnueabihf_4%3a14.2.0-1ubuntu1_armhf.deb ... 392s Unpacking g++-arm-linux-gnueabihf (4:14.2.0-1ubuntu1) ... 392s Selecting previously unselected package g++. 392s Preparing to unpack .../23-g++_4%3a14.2.0-1ubuntu1_armhf.deb ... 392s Unpacking g++ (4:14.2.0-1ubuntu1) ... 392s Selecting previously unselected package build-essential. 392s Preparing to unpack .../24-build-essential_12.10ubuntu1_armhf.deb ... 392s Unpacking build-essential (12.10ubuntu1) ... 392s Selecting previously unselected package dctrl-tools. 392s Preparing to unpack .../25-dctrl-tools_2.24-3build3_armhf.deb ... 392s Unpacking dctrl-tools (2.24-3build3) ... 392s Selecting previously unselected package libgfortran-14-dev:armhf. 393s Preparing to unpack .../26-libgfortran-14-dev_14.2.0-17ubuntu3_armhf.deb ... 393s Unpacking libgfortran-14-dev:armhf (14.2.0-17ubuntu3) ... 393s Selecting previously unselected package gfortran-14-arm-linux-gnueabihf. 393s Preparing to unpack .../27-gfortran-14-arm-linux-gnueabihf_14.2.0-17ubuntu3_armhf.deb ... 393s Unpacking gfortran-14-arm-linux-gnueabihf (14.2.0-17ubuntu3) ... 393s Selecting previously unselected package gfortran-14. 393s Preparing to unpack .../28-gfortran-14_14.2.0-17ubuntu3_armhf.deb ... 393s Unpacking gfortran-14 (14.2.0-17ubuntu3) ... 393s Selecting previously unselected package gfortran-arm-linux-gnueabihf. 393s Preparing to unpack .../29-gfortran-arm-linux-gnueabihf_4%3a14.2.0-1ubuntu1_armhf.deb ... 393s Unpacking gfortran-arm-linux-gnueabihf (4:14.2.0-1ubuntu1) ... 393s Selecting previously unselected package gfortran. 393s Preparing to unpack .../30-gfortran_4%3a14.2.0-1ubuntu1_armhf.deb ... 393s Unpacking gfortran (4:14.2.0-1ubuntu1) ... 393s Selecting previously unselected package icu-devtools. 393s Preparing to unpack .../31-icu-devtools_76.1-1ubuntu2_armhf.deb ... 393s Unpacking icu-devtools (76.1-1ubuntu2) ... 393s Selecting previously unselected package libblas-dev:armhf. 393s Preparing to unpack .../32-libblas-dev_3.12.1-2_armhf.deb ... 393s Unpacking libblas-dev:armhf (3.12.1-2) ... 393s Selecting previously unselected package libbz2-dev:armhf. 393s Preparing to unpack .../33-libbz2-dev_1.0.8-6_armhf.deb ... 393s Unpacking libbz2-dev:armhf (1.0.8-6) ... 393s Selecting previously unselected package libdeflate-dev:armhf. 393s Preparing to unpack .../34-libdeflate-dev_1.23-1_armhf.deb ... 393s Unpacking libdeflate-dev:armhf (1.23-1) ... 393s Selecting previously unselected package libicu-dev:armhf. 393s Preparing to unpack .../35-libicu-dev_76.1-1ubuntu2_armhf.deb ... 393s Unpacking libicu-dev:armhf (76.1-1ubuntu2) ... 393s Selecting previously unselected package libjpeg-turbo8-dev:armhf. 393s Preparing to unpack .../36-libjpeg-turbo8-dev_2.1.5-3ubuntu2_armhf.deb ... 393s Unpacking libjpeg-turbo8-dev:armhf (2.1.5-3ubuntu2) ... 393s Selecting previously unselected package libjpeg8-dev:armhf. 393s Preparing to unpack .../37-libjpeg8-dev_8c-2ubuntu11_armhf.deb ... 393s Unpacking libjpeg8-dev:armhf (8c-2ubuntu11) ... 393s Selecting previously unselected package libjpeg-dev:armhf. 394s Preparing to unpack .../38-libjpeg-dev_8c-2ubuntu11_armhf.deb ... 394s Unpacking libjpeg-dev:armhf (8c-2ubuntu11) ... 394s Selecting previously unselected package liblapack-dev:armhf. 394s Preparing to unpack .../39-liblapack-dev_3.12.1-2_armhf.deb ... 394s Unpacking liblapack-dev:armhf (3.12.1-2) ... 394s Selecting previously unselected package libncurses-dev:armhf. 394s Preparing to unpack .../40-libncurses-dev_6.5+20250216-2_armhf.deb ... 394s Unpacking libncurses-dev:armhf (6.5+20250216-2) ... 394s Selecting previously unselected package libpcre2-16-0:armhf. 394s Preparing to unpack .../41-libpcre2-16-0_10.45-1_armhf.deb ... 394s Unpacking libpcre2-16-0:armhf (10.45-1) ... 394s Selecting previously unselected package libpcre2-32-0:armhf. 394s Preparing to unpack .../42-libpcre2-32-0_10.45-1_armhf.deb ... 394s Unpacking libpcre2-32-0:armhf (10.45-1) ... 394s Selecting previously unselected package libpcre2-posix3:armhf. 394s Preparing to unpack .../43-libpcre2-posix3_10.45-1_armhf.deb ... 394s Unpacking libpcre2-posix3:armhf (10.45-1) ... 394s Selecting previously unselected package libpcre2-dev:armhf. 394s Preparing to unpack .../44-libpcre2-dev_10.45-1_armhf.deb ... 394s Unpacking libpcre2-dev:armhf (10.45-1) ... 394s Selecting previously unselected package libpkgconf3:armhf. 394s Preparing to unpack .../45-libpkgconf3_1.8.1-4_armhf.deb ... 394s Unpacking libpkgconf3:armhf (1.8.1-4) ... 394s Selecting previously unselected package zlib1g-dev:armhf. 394s Preparing to unpack .../46-zlib1g-dev_1%3a1.3.dfsg+really1.3.1-1ubuntu1_armhf.deb ... 394s Unpacking zlib1g-dev:armhf (1:1.3.dfsg+really1.3.1-1ubuntu1) ... 394s Selecting previously unselected package libpng-dev:armhf. 394s Preparing to unpack .../47-libpng-dev_1.6.47-1_armhf.deb ... 394s Unpacking libpng-dev:armhf (1.6.47-1) ... 394s Selecting previously unselected package libreadline-dev:armhf. 394s Preparing to unpack .../48-libreadline-dev_8.2-6_armhf.deb ... 394s Unpacking libreadline-dev:armhf (8.2-6) ... 394s Selecting previously unselected package liblzma-dev:armhf. 394s Preparing to unpack .../49-liblzma-dev_5.6.4-1_armhf.deb ... 394s Unpacking liblzma-dev:armhf (5.6.4-1) ... 394s Selecting previously unselected package pkgconf-bin. 394s Preparing to unpack .../50-pkgconf-bin_1.8.1-4_armhf.deb ... 394s Unpacking pkgconf-bin (1.8.1-4) ... 394s Selecting previously unselected package pkgconf:armhf. 394s Preparing to unpack .../51-pkgconf_1.8.1-4_armhf.deb ... 394s Unpacking pkgconf:armhf (1.8.1-4) ... 394s Selecting previously unselected package libtirpc-dev:armhf. 394s Preparing to unpack .../52-libtirpc-dev_1.3.4+ds-1.3_armhf.deb ... 394s Unpacking libtirpc-dev:armhf (1.3.4+ds-1.3) ... 394s Selecting previously unselected package r-base-dev. 394s Preparing to unpack .../53-r-base-dev_4.4.3-1_all.deb ... 394s Unpacking r-base-dev (4.4.3-1) ... 394s Selecting previously unselected package pkg-r-autopkgtest. 394s Preparing to unpack .../54-pkg-r-autopkgtest_20231212ubuntu1_all.deb ... 394s Unpacking pkg-r-autopkgtest (20231212ubuntu1) ... 394s Setting up linux-libc-dev:armhf (6.14.0-10.10) ... 394s Setting up libpcre2-16-0:armhf (10.45-1) ... 394s Setting up libpcre2-32-0:armhf (10.45-1) ... 394s Setting up libtirpc-dev:armhf (1.3.4+ds-1.3) ... 394s Setting up libpkgconf3:armhf (1.8.1-4) ... 394s Setting up rpcsvc-proto (1.4.2-0ubuntu7) ... 394s Setting up libmpc3:armhf (1.3.1-1build2) ... 394s Setting up icu-devtools (76.1-1ubuntu2) ... 394s Setting up pkgconf-bin (1.8.1-4) ... 394s Setting up liblzma-dev:armhf (5.6.4-1) ... 394s Setting up libubsan1:armhf (15-20250222-0ubuntu1) ... 394s Setting up libpcre2-posix3:armhf (10.45-1) ... 394s Setting up libcrypt-dev:armhf (1:4.4.38-1) ... 394s Setting up libasan8:armhf (15-20250222-0ubuntu1) ... 394s Setting up libgcc-14-dev:armhf (14.2.0-17ubuntu3) ... 394s Setting up libisl23:armhf (0.27-1) ... 394s Setting up libc-dev-bin (2.41-1ubuntu2) ... 394s Setting up libdeflate-dev:armhf (1.23-1) ... 394s Setting up libcc1-0:armhf (15-20250222-0ubuntu1) ... 394s Setting up libblas-dev:armhf (3.12.1-2) ... 394s update-alternatives: using /usr/lib/arm-linux-gnueabihf/blas/libblas.so to provide /usr/lib/arm-linux-gnueabihf/libblas.so (libblas.so-arm-linux-gnueabihf) in auto mode 394s Setting up dctrl-tools (2.24-3build3) ... 394s Setting up cpp-14-arm-linux-gnueabihf (14.2.0-17ubuntu3) ... 394s Setting up libgfortran-14-dev:armhf (14.2.0-17ubuntu3) ... 394s Setting up gcc-14-arm-linux-gnueabihf (14.2.0-17ubuntu3) ... 394s Setting up pkgconf:armhf (1.8.1-4) ... 394s Setting up liblapack-dev:armhf (3.12.1-2) ... 394s update-alternatives: using /usr/lib/arm-linux-gnueabihf/lapack/liblapack.so to provide /usr/lib/arm-linux-gnueabihf/liblapack.so (liblapack.so-arm-linux-gnueabihf) in auto mode 394s Setting up cpp-14 (14.2.0-17ubuntu3) ... 394s Setting up libc6-dev:armhf (2.41-1ubuntu2) ... 394s Setting up libstdc++-14-dev:armhf (14.2.0-17ubuntu3) ... 394s Setting up libicu-dev:armhf (76.1-1ubuntu2) ... 394s Setting up cpp-arm-linux-gnueabihf (4:14.2.0-1ubuntu1) ... 394s Setting up gfortran-14-arm-linux-gnueabihf (14.2.0-17ubuntu3) ... 394s Setting up libbz2-dev:armhf (1.0.8-6) ... 394s Setting up gcc-arm-linux-gnueabihf (4:14.2.0-1ubuntu1) ... 394s Setting up g++-14-arm-linux-gnueabihf (14.2.0-17ubuntu3) ... 394s Setting up libjpeg-turbo8-dev:armhf (2.1.5-3ubuntu2) ... 394s Setting up libncurses-dev:armhf (6.5+20250216-2) ... 394s Setting up libpcre2-dev:armhf (10.45-1) ... 394s Setting up libreadline-dev:armhf (8.2-6) ... 394s Setting up gcc-14 (14.2.0-17ubuntu3) ... 394s Setting up gfortran-arm-linux-gnueabihf (4:14.2.0-1ubuntu1) ... 394s Setting up zlib1g-dev:armhf (1:1.3.dfsg+really1.3.1-1ubuntu1) ... 394s Setting up cpp (4:14.2.0-1ubuntu1) ... 394s Setting up g++-14 (14.2.0-17ubuntu3) ... 394s Setting up libjpeg8-dev:armhf (8c-2ubuntu11) ... 394s Setting up gfortran-14 (14.2.0-17ubuntu3) ... 394s Setting up g++-arm-linux-gnueabihf (4:14.2.0-1ubuntu1) ... 394s Setting up libpng-dev:armhf (1.6.47-1) ... 394s Setting up libjpeg-dev:armhf (8c-2ubuntu11) ... 394s Setting up gcc (4:14.2.0-1ubuntu1) ... 394s Setting up g++ (4:14.2.0-1ubuntu1) ... 394s update-alternatives: using /usr/bin/g++ to provide /usr/bin/c++ (c++) in auto mode 394s Setting up build-essential (12.10ubuntu1) ... 394s Setting up gfortran (4:14.2.0-1ubuntu1) ... 394s update-alternatives: using /usr/bin/gfortran to provide /usr/bin/f95 (f95) in auto mode 394s update-alternatives: warning: skip creation of /usr/share/man/man1/f95.1.gz because associated file /usr/share/man/man1/gfortran.1.gz (of link group f95) doesn't exist 394s update-alternatives: using /usr/bin/gfortran to provide /usr/bin/f77 (f77) in auto mode 394s update-alternatives: warning: skip creation of /usr/share/man/man1/f77.1.gz because associated file /usr/share/man/man1/gfortran.1.gz (of link group f77) doesn't exist 394s Setting up r-base-dev (4.4.3-1) ... 394s Setting up pkg-r-autopkgtest (20231212ubuntu1) ... 394s Processing triggers for libc-bin (2.41-1ubuntu2) ... 394s Processing triggers for man-db (2.13.0-1) ... 396s Processing triggers for install-info (7.1.1-1) ... 403s autopkgtest [16:26:32]: test pkg-r-autopkgtest: /usr/share/dh-r/pkg-r-autopkgtest 403s autopkgtest [16:26:32]: test pkg-r-autopkgtest: [----------------------- 405s Test: Try to load the R library mcmc 405s 405s R version 4.4.3 (2025-02-28) -- "Trophy Case" 405s Copyright (C) 2025 The R Foundation for Statistical Computing 405s Platform: arm-unknown-linux-gnueabihf (32-bit) 405s 405s R is free software and comes with ABSOLUTELY NO WARRANTY. 405s You are welcome to redistribute it under certain conditions. 405s Type 'license()' or 'licence()' for distribution details. 405s 405s R is a collaborative project with many contributors. 405s Type 'contributors()' for more information and 405s 'citation()' on how to cite R or R packages in publications. 405s 405s Type 'demo()' for some demos, 'help()' for on-line help, or 405s 'help.start()' for an HTML browser interface to help. 405s Type 'q()' to quit R. 405s 405s > library('mcmc') 406s > 406s > 406s Other tests are currently unsupported! 406s They will be progressively added. 406s autopkgtest [16:26:35]: test pkg-r-autopkgtest: -----------------------] 410s pkg-r-autopkgtest PASS 410s autopkgtest [16:26:39]: test pkg-r-autopkgtest: - - - - - - - - - - results - - - - - - - - - - 414s autopkgtest [16:26:43]: @@@@@@@@@@@@@@@@@@@@ summary 414s generic PASS 414s pkg-r-autopkgtest PASS