0s autopkgtest [15:40:05]: starting date and time: 2025-03-15 15:40:05+0000 0s autopkgtest [15:40:05]: git checkout: 325255d2 Merge branch 'pin-any-arch' into 'ubuntu/production' 0s autopkgtest [15:40:05]: host juju-7f2275-prod-proposed-migration-environment-2; command line: /home/ubuntu/autopkgtest/runner/autopkgtest --output-dir /tmp/autopkgtest-work.p7iouon1/out --timeout-copy=6000 --setup-commands /home/ubuntu/autopkgtest-cloud/worker-config-production/setup-canonical.sh --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 -- ssh -s /home/ubuntu/autopkgtest/ssh-setup/nova -- --flavor autopkgtest --security-groups autopkgtest-juju-7f2275-prod-proposed-migration-environment-2@bos03-arm64-8.secgroup --name adt-plucky-arm64-r-cran-mcmc-20250315-154005-juju-7f2275-prod-proposed-migration-environment-2-069d2904-f828-4704-9dc1-fc9634739803 --image adt/ubuntu-plucky-arm64-server --keyname testbed-juju-7f2275-prod-proposed-migration-environment-2 --net-id=net_prod-proposed-migration -e TERM=linux -e ''"'"'http_proxy=http://squid.internal:3128'"'"'' -e ''"'"'https_proxy=http://squid.internal:3128'"'"'' -e ''"'"'no_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'"'"'' --mirror=http://ftpmaster.internal/ubuntu/ 142s autopkgtest [15:42:27]: testbed dpkg architecture: arm64 142s autopkgtest [15:42:27]: testbed apt version: 2.9.33 142s autopkgtest [15:42:27]: @@@@@@@@@@@@@@@@@@@@ test bed setup 143s autopkgtest [15:42:28]: testbed release detected to be: None 144s autopkgtest [15:42:29]: updating testbed package index (apt update) 144s Get:1 http://ftpmaster.internal/ubuntu plucky-proposed InRelease [126 kB] 144s Hit:2 http://ftpmaster.internal/ubuntu plucky InRelease 145s Hit:3 http://ftpmaster.internal/ubuntu plucky-updates InRelease 145s Hit:4 http://ftpmaster.internal/ubuntu plucky-security InRelease 145s Get:5 http://ftpmaster.internal/ubuntu plucky-proposed/main Sources [99.7 kB] 145s Get:6 http://ftpmaster.internal/ubuntu plucky-proposed/multiverse Sources [15.8 kB] 145s Get:7 http://ftpmaster.internal/ubuntu plucky-proposed/universe Sources [379 kB] 145s Get:8 http://ftpmaster.internal/ubuntu plucky-proposed/main arm64 Packages [111 kB] 145s Get:9 http://ftpmaster.internal/ubuntu plucky-proposed/main arm64 c-n-f Metadata [1856 B] 145s Get:10 http://ftpmaster.internal/ubuntu plucky-proposed/restricted arm64 c-n-f Metadata [116 B] 145s Get:11 http://ftpmaster.internal/ubuntu plucky-proposed/universe arm64 Packages [324 kB] 146s Get:12 http://ftpmaster.internal/ubuntu plucky-proposed/universe arm64 c-n-f Metadata [14.7 kB] 146s Get:13 http://ftpmaster.internal/ubuntu plucky-proposed/multiverse arm64 Packages [4948 B] 146s Get:14 http://ftpmaster.internal/ubuntu plucky-proposed/multiverse arm64 c-n-f Metadata [268 B] 146s Fetched 1078 kB in 2s (601 kB/s) 147s Reading package lists... 148s Reading package lists... 148s Building dependency tree... 148s Reading state information... 149s Calculating upgrade... 150s Calculating upgrade... 151s The following packages will be upgraded: 151s pinentry-curses python3-jinja2 strace 151s 3 upgraded, 0 newly installed, 0 to remove and 0 not upgraded. 151s Need to get 647 kB of archives. 151s After this operation, 11.3 kB of additional disk space will be used. 151s Get:1 http://ftpmaster.internal/ubuntu plucky/main arm64 strace arm64 6.13+ds-1ubuntu1 [499 kB] 152s Get:2 http://ftpmaster.internal/ubuntu plucky/main arm64 pinentry-curses arm64 1.3.1-2ubuntu3 [39.2 kB] 152s Get:3 http://ftpmaster.internal/ubuntu plucky/main arm64 python3-jinja2 all 3.1.5-2ubuntu1 [109 kB] 153s Fetched 647 kB in 2s (384 kB/s) 153s (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 ... 117701 files and directories currently installed.) 153s Preparing to unpack .../strace_6.13+ds-1ubuntu1_arm64.deb ... 153s Unpacking strace (6.13+ds-1ubuntu1) over (6.11-0ubuntu1) ... 153s Preparing to unpack .../pinentry-curses_1.3.1-2ubuntu3_arm64.deb ... 153s Unpacking pinentry-curses (1.3.1-2ubuntu3) over (1.3.1-2ubuntu2) ... 153s Preparing to unpack .../python3-jinja2_3.1.5-2ubuntu1_all.deb ... 154s Unpacking python3-jinja2 (3.1.5-2ubuntu1) over (3.1.5-2) ... 154s Setting up pinentry-curses (1.3.1-2ubuntu3) ... 154s Setting up python3-jinja2 (3.1.5-2ubuntu1) ... 154s Setting up strace (6.13+ds-1ubuntu1) ... 154s Processing triggers for man-db (2.13.0-1) ... 155s Reading package lists... 155s Building dependency tree... 155s Reading state information... 155s Solving dependencies... 156s The following packages will be REMOVED: 156s libnsl2* libpython3.12-minimal* libpython3.12-stdlib* libpython3.12t64* 156s libunwind8* linux-headers-6.11.0-8* linux-headers-6.11.0-8-generic* 156s linux-image-6.11.0-8-generic* linux-modules-6.11.0-8-generic* 156s linux-tools-6.11.0-8* linux-tools-6.11.0-8-generic* 156s 0 upgraded, 0 newly installed, 11 to remove and 5 not upgraded. 156s After this operation, 267 MB disk space will be freed. 156s (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 ... 117701 files and directories currently installed.) 156s Removing linux-tools-6.11.0-8-generic (6.11.0-8.8) ... 156s Removing linux-tools-6.11.0-8 (6.11.0-8.8) ... 156s Removing libpython3.12t64:arm64 (3.12.9-1) ... 156s Removing libpython3.12-stdlib:arm64 (3.12.9-1) ... 156s Removing libnsl2:arm64 (1.3.0-3build3) ... 156s Removing libpython3.12-minimal:arm64 (3.12.9-1) ... 156s Removing libunwind8:arm64 (1.6.2-3.1) ... 156s Removing linux-headers-6.11.0-8-generic (6.11.0-8.8) ... 157s Removing linux-headers-6.11.0-8 (6.11.0-8.8) ... 159s Removing linux-image-6.11.0-8-generic (6.11.0-8.8) ... 159s I: /boot/vmlinuz.old is now a symlink to vmlinuz-6.14.0-10-generic 159s I: /boot/initrd.img.old is now a symlink to initrd.img-6.14.0-10-generic 159s /etc/kernel/postrm.d/initramfs-tools: 159s update-initramfs: Deleting /boot/initrd.img-6.11.0-8-generic 159s /etc/kernel/postrm.d/zz-flash-kernel: 159s flash-kernel: Kernel 6.11.0-8-generic has been removed. 159s flash-kernel: A higher version (6.14.0-10-generic) is still installed, no reflashing required. 159s /etc/kernel/postrm.d/zz-update-grub: 159s Sourcing file `/etc/default/grub' 159s Sourcing file `/etc/default/grub.d/50-cloudimg-settings.cfg' 159s Generating grub configuration file ... 159s Found linux image: /boot/vmlinuz-6.14.0-10-generic 159s Found initrd image: /boot/initrd.img-6.14.0-10-generic 160s Warning: os-prober will not be executed to detect other bootable partitions. 160s Systems on them will not be added to the GRUB boot configuration. 160s Check GRUB_DISABLE_OS_PROBER documentation entry. 160s Adding boot menu entry for UEFI Firmware Settings ... 160s done 160s Removing linux-modules-6.11.0-8-generic (6.11.0-8.8) ... 160s Processing triggers for libc-bin (2.41-1ubuntu1) ... 160s (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 ... 81650 files and directories currently installed.) 160s Purging configuration files for linux-image-6.11.0-8-generic (6.11.0-8.8) ... 160s Purging configuration files for libpython3.12-minimal:arm64 (3.12.9-1) ... 160s Purging configuration files for linux-modules-6.11.0-8-generic (6.11.0-8.8) ... 161s autopkgtest [15:42:46]: upgrading testbed (apt dist-upgrade and autopurge) 161s Reading package lists... 161s Building dependency tree... 161s Reading state information... 162s Calculating upgrade...Starting pkgProblemResolver with broken count: 0 163s Starting 2 pkgProblemResolver with broken count: 0 163s Done 164s Entering ResolveByKeep 165s 165s Calculating upgrade... 165s The following packages will be upgraded: 165s libc-bin libc-dev-bin libc6 libc6-dev locales 165s 5 upgraded, 0 newly installed, 0 to remove and 0 not upgraded. 165s Need to get 9530 kB of archives. 165s After this operation, 0 B of additional disk space will be used. 165s Get:1 http://ftpmaster.internal/ubuntu plucky-proposed/main arm64 libc6-dev arm64 2.41-1ubuntu2 [1750 kB] 168s Get:2 http://ftpmaster.internal/ubuntu plucky-proposed/main arm64 libc-dev-bin arm64 2.41-1ubuntu2 [24.0 kB] 168s Get:3 http://ftpmaster.internal/ubuntu plucky-proposed/main arm64 libc6 arm64 2.41-1ubuntu2 [2910 kB] 171s Get:4 http://ftpmaster.internal/ubuntu plucky-proposed/main arm64 libc-bin arm64 2.41-1ubuntu2 [600 kB] 172s Get:5 http://ftpmaster.internal/ubuntu plucky-proposed/main arm64 locales all 2.41-1ubuntu2 [4246 kB] 178s Preconfiguring packages ... 179s Fetched 9530 kB in 13s (735 kB/s) 179s (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 ... 81647 files and directories currently installed.) 179s Preparing to unpack .../libc6-dev_2.41-1ubuntu2_arm64.deb ... 179s Unpacking libc6-dev:arm64 (2.41-1ubuntu2) over (2.41-1ubuntu1) ... 179s Preparing to unpack .../libc-dev-bin_2.41-1ubuntu2_arm64.deb ... 179s Unpacking libc-dev-bin (2.41-1ubuntu2) over (2.41-1ubuntu1) ... 179s Preparing to unpack .../libc6_2.41-1ubuntu2_arm64.deb ... 179s Unpacking libc6:arm64 (2.41-1ubuntu2) over (2.41-1ubuntu1) ... 179s Setting up libc6:arm64 (2.41-1ubuntu2) ... 180s (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 ... 81647 files and directories currently installed.) 180s Preparing to unpack .../libc-bin_2.41-1ubuntu2_arm64.deb ... 180s Unpacking libc-bin (2.41-1ubuntu2) over (2.41-1ubuntu1) ... 180s Setting up libc-bin (2.41-1ubuntu2) ... 180s (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 ... 81647 files and directories currently installed.) 180s Preparing to unpack .../locales_2.41-1ubuntu2_all.deb ... 180s Unpacking locales (2.41-1ubuntu2) over (2.41-1ubuntu1) ... 180s Setting up locales (2.41-1ubuntu2) ... 181s Generating locales (this might take a while)... 183s en_US.UTF-8... done 183s Generation complete. 183s Setting up libc-dev-bin (2.41-1ubuntu2) ... 183s Setting up libc6-dev:arm64 (2.41-1ubuntu2) ... 183s Processing triggers for man-db (2.13.0-1) ... 184s Processing triggers for systemd (257.3-1ubuntu3) ... 184s Reading package lists... 185s Building dependency tree... 185s Reading state information... 185s Starting pkgProblemResolver with broken count: 0 185s Starting 2 pkgProblemResolver with broken count: 0 185s Done 186s Solving dependencies... 186s 0 upgraded, 0 newly installed, 0 to remove and 0 not upgraded. 186s autopkgtest [15:43:11]: rebooting testbed after setup commands that affected boot 210s autopkgtest [15:43:35]: testbed running kernel: Linux 6.14.0-10-generic #10-Ubuntu SMP PREEMPT_DYNAMIC Wed Mar 12 15:45:31 UTC 2025 212s autopkgtest [15:43:37]: @@@@@@@@@@@@@@@@@@@@ apt-source r-cran-mcmc 216s Get:1 http://ftpmaster.internal/ubuntu plucky/universe r-cran-mcmc 0.9-8-1 (dsc) [2083 B] 216s Get:2 http://ftpmaster.internal/ubuntu plucky/universe r-cran-mcmc 0.9-8-1 (tar) [1542 kB] 216s Get:3 http://ftpmaster.internal/ubuntu plucky/universe r-cran-mcmc 0.9-8-1 (diff) [3320 B] 216s gpgv: Signature made Tue Nov 21 10:57:44 2023 UTC 216s gpgv: using RSA key F1F007320A035541F0A663CA578A0494D1C646D1 216s gpgv: issuer "tille@debian.org" 216s gpgv: Can't check signature: No public key 216s dpkg-source: warning: cannot verify inline signature for ./r-cran-mcmc_0.9-8-1.dsc: no acceptable signature found 216s autopkgtest [15:43:41]: testing package r-cran-mcmc version 0.9-8-1 217s autopkgtest [15:43:42]: build not needed 220s autopkgtest [15:43:45]: test generic: preparing testbed 220s Reading package lists... 220s Building dependency tree... 220s Reading state information... 221s Starting pkgProblemResolver with broken count: 0 221s Starting 2 pkgProblemResolver with broken count: 0 221s Done 221s The following NEW packages will be installed: 221s fontconfig fontconfig-config fonts-dejavu-core fonts-dejavu-mono libblas3 221s libcairo2 libdatrie1 libdeflate0 libfontconfig1 libgfortran5 libgomp1 221s libgraphite2-3 libharfbuzz0b libice6 libjbig0 libjpeg-turbo8 libjpeg8 221s liblapack3 liblerc4 libpango-1.0-0 libpangocairo-1.0-0 libpangoft2-1.0-0 221s libpaper-utils libpaper2 libpixman-1-0 libsharpyuv0 libsm6 libtcl8.6 221s libthai-data libthai0 libtiff6 libtk8.6 libwebp7 libxcb-render0 libxcb-shm0 221s libxft2 libxrender1 libxss1 libxt6t64 r-base-core r-cran-iso r-cran-mcmc 221s r-cran-xtable unzip x11-common xdg-utils zip 222s 0 upgraded, 47 newly installed, 0 to remove and 0 not upgraded. 222s Need to get 40.4 MB of archives. 222s After this operation, 82.3 MB of additional disk space will be used. 222s Get:1 http://ftpmaster.internal/ubuntu plucky/main arm64 fonts-dejavu-mono all 2.37-8 [502 kB] 222s Get:2 http://ftpmaster.internal/ubuntu plucky/main arm64 fonts-dejavu-core all 2.37-8 [835 kB] 223s Get:3 http://ftpmaster.internal/ubuntu plucky/main arm64 fontconfig-config arm64 2.15.0-2ubuntu1 [37.5 kB] 223s Get:4 http://ftpmaster.internal/ubuntu plucky/main arm64 libfontconfig1 arm64 2.15.0-2ubuntu1 [144 kB] 223s Get:5 http://ftpmaster.internal/ubuntu plucky/main arm64 fontconfig arm64 2.15.0-2ubuntu1 [191 kB] 224s Get:6 http://ftpmaster.internal/ubuntu plucky/main arm64 libblas3 arm64 3.12.1-2 [161 kB] 224s Get:7 http://ftpmaster.internal/ubuntu plucky/main arm64 libpixman-1-0 arm64 0.44.0-3 [197 kB] 224s Get:8 http://ftpmaster.internal/ubuntu plucky/main arm64 libxcb-render0 arm64 1.17.0-2 [16.6 kB] 224s Get:9 http://ftpmaster.internal/ubuntu plucky/main arm64 libxcb-shm0 arm64 1.17.0-2 [5884 B] 224s Get:10 http://ftpmaster.internal/ubuntu plucky/main arm64 libxrender1 arm64 1:0.9.10-1.1build1 [18.8 kB] 224s Get:11 http://ftpmaster.internal/ubuntu plucky/main arm64 libcairo2 arm64 1.18.2-2 [560 kB] 225s Get:12 http://ftpmaster.internal/ubuntu plucky/main arm64 libdatrie1 arm64 0.2.13-3build1 [19.2 kB] 225s Get:13 http://ftpmaster.internal/ubuntu plucky/main arm64 libdeflate0 arm64 1.23-1 [46.2 kB] 225s Get:14 http://ftpmaster.internal/ubuntu plucky/main arm64 libgfortran5 arm64 15-20250222-0ubuntu1 [444 kB] 225s Get:15 http://ftpmaster.internal/ubuntu plucky/main arm64 libgomp1 arm64 15-20250222-0ubuntu1 [146 kB] 226s Get:16 http://ftpmaster.internal/ubuntu plucky/main arm64 libgraphite2-3 arm64 1.3.14-2ubuntu1 [70.6 kB] 226s Get:17 http://ftpmaster.internal/ubuntu plucky/main arm64 libharfbuzz0b arm64 10.2.0-1 [490 kB] 226s Get:18 http://ftpmaster.internal/ubuntu plucky/main arm64 x11-common all 1:7.7+23ubuntu3 [21.7 kB] 226s Get:19 http://ftpmaster.internal/ubuntu plucky/main arm64 libice6 arm64 2:1.1.1-1 [42.3 kB] 226s Get:20 http://ftpmaster.internal/ubuntu plucky/main arm64 libjpeg-turbo8 arm64 2.1.5-3ubuntu2 [165 kB] 227s Get:21 http://ftpmaster.internal/ubuntu plucky/main arm64 libjpeg8 arm64 8c-2ubuntu11 [2148 B] 227s Get:22 http://ftpmaster.internal/ubuntu plucky/main arm64 liblapack3 arm64 3.12.1-2 [2307 kB] 230s Get:23 http://ftpmaster.internal/ubuntu plucky/main arm64 liblerc4 arm64 4.0.0+ds-5ubuntu1 [167 kB] 230s Get:24 http://ftpmaster.internal/ubuntu plucky/main arm64 libthai-data all 0.1.29-2build1 [158 kB] 230s Get:25 http://ftpmaster.internal/ubuntu plucky/main arm64 libthai0 arm64 0.1.29-2build1 [18.2 kB] 230s Get:26 http://ftpmaster.internal/ubuntu plucky/main arm64 libpango-1.0-0 arm64 1.56.2-1 [237 kB] 230s Get:27 http://ftpmaster.internal/ubuntu plucky/main arm64 libpangoft2-1.0-0 arm64 1.56.2-1 [49.5 kB] 230s Get:28 http://ftpmaster.internal/ubuntu plucky/main arm64 libpangocairo-1.0-0 arm64 1.56.2-1 [27.6 kB] 230s Get:29 http://ftpmaster.internal/ubuntu plucky/main arm64 libpaper2 arm64 2.2.5-0.3 [17.3 kB] 230s Get:30 http://ftpmaster.internal/ubuntu plucky/main arm64 libpaper-utils arm64 2.2.5-0.3 [15.4 kB] 230s Get:31 http://ftpmaster.internal/ubuntu plucky/main arm64 libsharpyuv0 arm64 1.5.0-0.1 [16.9 kB] 230s Get:32 http://ftpmaster.internal/ubuntu plucky/main arm64 libsm6 arm64 2:1.2.4-1 [16.4 kB] 230s Get:33 http://ftpmaster.internal/ubuntu plucky/main arm64 libtcl8.6 arm64 8.6.16+dfsg-1 [987 kB] 232s Get:34 http://ftpmaster.internal/ubuntu plucky/main arm64 libjbig0 arm64 2.1-6.1ubuntu2 [29.3 kB] 232s Get:35 http://ftpmaster.internal/ubuntu plucky/main arm64 libwebp7 arm64 1.5.0-0.1 [194 kB] 232s Get:36 http://ftpmaster.internal/ubuntu plucky/main arm64 libtiff6 arm64 4.5.1+git230720-4ubuntu4 [193 kB] 232s Get:37 http://ftpmaster.internal/ubuntu plucky/main arm64 libxft2 arm64 2.3.6-1build1 [44.1 kB] 232s Get:38 http://ftpmaster.internal/ubuntu plucky/main arm64 libxss1 arm64 1:1.2.3-1build3 [7244 B] 232s Get:39 http://ftpmaster.internal/ubuntu plucky/main arm64 libtk8.6 arm64 8.6.16-1 [776 kB] 233s Get:40 http://ftpmaster.internal/ubuntu plucky/main arm64 libxt6t64 arm64 1:1.2.1-1.2build1 [168 kB] 233s Get:41 http://ftpmaster.internal/ubuntu plucky/main arm64 zip arm64 3.0-14ubuntu2 [173 kB] 233s Get:42 http://ftpmaster.internal/ubuntu plucky/main arm64 unzip arm64 6.0-28ubuntu6 [178 kB] 234s Get:43 http://ftpmaster.internal/ubuntu plucky/main arm64 xdg-utils all 1.2.1-2ubuntu1 [66.0 kB] 234s Get:44 http://ftpmaster.internal/ubuntu plucky/universe arm64 r-base-core arm64 4.4.3-1 [28.4 MB] 266s Get:45 http://ftpmaster.internal/ubuntu plucky/universe arm64 r-cran-iso arm64 0.0-21-1 [165 kB] 267s Get:46 http://ftpmaster.internal/ubuntu plucky/universe arm64 r-cran-mcmc arm64 0.9-8-1 [1224 kB] 268s Get:47 http://ftpmaster.internal/ubuntu plucky/universe arm64 r-cran-xtable all 1:1.8-4-2 [689 kB] 270s Preconfiguring packages ... 270s Fetched 40.4 MB in 48s (847 kB/s) 270s Selecting previously unselected package fonts-dejavu-mono. 270s (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 ... 81647 files and directories currently installed.) 270s Preparing to unpack .../00-fonts-dejavu-mono_2.37-8_all.deb ... 270s Unpacking fonts-dejavu-mono (2.37-8) ... 270s Selecting previously unselected package fonts-dejavu-core. 270s Preparing to unpack .../01-fonts-dejavu-core_2.37-8_all.deb ... 270s Unpacking fonts-dejavu-core (2.37-8) ... 270s Selecting previously unselected package fontconfig-config. 270s Preparing to unpack .../02-fontconfig-config_2.15.0-2ubuntu1_arm64.deb ... 270s Unpacking fontconfig-config (2.15.0-2ubuntu1) ... 270s Selecting previously unselected package libfontconfig1:arm64. 270s Preparing to unpack .../03-libfontconfig1_2.15.0-2ubuntu1_arm64.deb ... 270s Unpacking libfontconfig1:arm64 (2.15.0-2ubuntu1) ... 270s Selecting previously unselected package fontconfig. 270s Preparing to unpack .../04-fontconfig_2.15.0-2ubuntu1_arm64.deb ... 270s Unpacking fontconfig (2.15.0-2ubuntu1) ... 270s Selecting previously unselected package libblas3:arm64. 270s Preparing to unpack .../05-libblas3_3.12.1-2_arm64.deb ... 270s Unpacking libblas3:arm64 (3.12.1-2) ... 270s Selecting previously unselected package libpixman-1-0:arm64. 270s Preparing to unpack .../06-libpixman-1-0_0.44.0-3_arm64.deb ... 270s Unpacking libpixman-1-0:arm64 (0.44.0-3) ... 270s Selecting previously unselected package libxcb-render0:arm64. 270s Preparing to unpack .../07-libxcb-render0_1.17.0-2_arm64.deb ... 270s Unpacking libxcb-render0:arm64 (1.17.0-2) ... 270s Selecting previously unselected package libxcb-shm0:arm64. 271s Preparing to unpack .../08-libxcb-shm0_1.17.0-2_arm64.deb ... 271s Unpacking libxcb-shm0:arm64 (1.17.0-2) ... 271s Selecting previously unselected package libxrender1:arm64. 271s Preparing to unpack .../09-libxrender1_1%3a0.9.10-1.1build1_arm64.deb ... 271s Unpacking libxrender1:arm64 (1:0.9.10-1.1build1) ... 271s Selecting previously unselected package libcairo2:arm64. 271s Preparing to unpack .../10-libcairo2_1.18.2-2_arm64.deb ... 271s Unpacking libcairo2:arm64 (1.18.2-2) ... 271s Selecting previously unselected package libdatrie1:arm64. 271s Preparing to unpack .../11-libdatrie1_0.2.13-3build1_arm64.deb ... 271s Unpacking libdatrie1:arm64 (0.2.13-3build1) ... 271s Selecting previously unselected package libdeflate0:arm64. 271s Preparing to unpack .../12-libdeflate0_1.23-1_arm64.deb ... 271s Unpacking libdeflate0:arm64 (1.23-1) ... 271s Selecting previously unselected package libgfortran5:arm64. 271s Preparing to unpack .../13-libgfortran5_15-20250222-0ubuntu1_arm64.deb ... 271s Unpacking libgfortran5:arm64 (15-20250222-0ubuntu1) ... 271s Selecting previously unselected package libgomp1:arm64. 271s Preparing to unpack .../14-libgomp1_15-20250222-0ubuntu1_arm64.deb ... 271s Unpacking libgomp1:arm64 (15-20250222-0ubuntu1) ... 271s Selecting previously unselected package libgraphite2-3:arm64. 271s Preparing to unpack .../15-libgraphite2-3_1.3.14-2ubuntu1_arm64.deb ... 271s Unpacking libgraphite2-3:arm64 (1.3.14-2ubuntu1) ... 271s Selecting previously unselected package libharfbuzz0b:arm64. 271s Preparing to unpack .../16-libharfbuzz0b_10.2.0-1_arm64.deb ... 271s Unpacking libharfbuzz0b:arm64 (10.2.0-1) ... 271s Selecting previously unselected package x11-common. 271s Preparing to unpack .../17-x11-common_1%3a7.7+23ubuntu3_all.deb ... 271s Unpacking x11-common (1:7.7+23ubuntu3) ... 271s Selecting previously unselected package libice6:arm64. 271s Preparing to unpack .../18-libice6_2%3a1.1.1-1_arm64.deb ... 271s Unpacking libice6:arm64 (2:1.1.1-1) ... 271s Selecting previously unselected package libjpeg-turbo8:arm64. 271s Preparing to unpack .../19-libjpeg-turbo8_2.1.5-3ubuntu2_arm64.deb ... 271s Unpacking libjpeg-turbo8:arm64 (2.1.5-3ubuntu2) ... 271s Selecting previously unselected package libjpeg8:arm64. 271s Preparing to unpack .../20-libjpeg8_8c-2ubuntu11_arm64.deb ... 271s Unpacking libjpeg8:arm64 (8c-2ubuntu11) ... 271s Selecting previously unselected package liblapack3:arm64. 271s Preparing to unpack .../21-liblapack3_3.12.1-2_arm64.deb ... 271s Unpacking liblapack3:arm64 (3.12.1-2) ... 271s Selecting previously unselected package liblerc4:arm64. 271s Preparing to unpack .../22-liblerc4_4.0.0+ds-5ubuntu1_arm64.deb ... 271s Unpacking liblerc4:arm64 (4.0.0+ds-5ubuntu1) ... 271s Selecting previously unselected package libthai-data. 271s Preparing to unpack .../23-libthai-data_0.1.29-2build1_all.deb ... 271s Unpacking libthai-data (0.1.29-2build1) ... 271s Selecting previously unselected package libthai0:arm64. 271s Preparing to unpack .../24-libthai0_0.1.29-2build1_arm64.deb ... 271s Unpacking libthai0:arm64 (0.1.29-2build1) ... 271s Selecting previously unselected package libpango-1.0-0:arm64. 271s Preparing to unpack .../25-libpango-1.0-0_1.56.2-1_arm64.deb ... 271s Unpacking libpango-1.0-0:arm64 (1.56.2-1) ... 271s Selecting previously unselected package libpangoft2-1.0-0:arm64. 271s Preparing to unpack .../26-libpangoft2-1.0-0_1.56.2-1_arm64.deb ... 271s Unpacking libpangoft2-1.0-0:arm64 (1.56.2-1) ... 271s Selecting previously unselected package libpangocairo-1.0-0:arm64. 271s Preparing to unpack .../27-libpangocairo-1.0-0_1.56.2-1_arm64.deb ... 271s Unpacking libpangocairo-1.0-0:arm64 (1.56.2-1) ... 271s Selecting previously unselected package libpaper2:arm64. 271s Preparing to unpack .../28-libpaper2_2.2.5-0.3_arm64.deb ... 271s Unpacking libpaper2:arm64 (2.2.5-0.3) ... 271s Selecting previously unselected package libpaper-utils. 271s Preparing to unpack .../29-libpaper-utils_2.2.5-0.3_arm64.deb ... 271s Unpacking libpaper-utils (2.2.5-0.3) ... 271s Selecting previously unselected package libsharpyuv0:arm64. 271s Preparing to unpack .../30-libsharpyuv0_1.5.0-0.1_arm64.deb ... 271s Unpacking libsharpyuv0:arm64 (1.5.0-0.1) ... 271s Selecting previously unselected package libsm6:arm64. 271s Preparing to unpack .../31-libsm6_2%3a1.2.4-1_arm64.deb ... 271s Unpacking libsm6:arm64 (2:1.2.4-1) ... 271s Selecting previously unselected package libtcl8.6:arm64. 271s Preparing to unpack .../32-libtcl8.6_8.6.16+dfsg-1_arm64.deb ... 271s Unpacking libtcl8.6:arm64 (8.6.16+dfsg-1) ... 271s Selecting previously unselected package libjbig0:arm64. 272s Preparing to unpack .../33-libjbig0_2.1-6.1ubuntu2_arm64.deb ... 272s Unpacking libjbig0:arm64 (2.1-6.1ubuntu2) ... 272s Selecting previously unselected package libwebp7:arm64. 272s Preparing to unpack .../34-libwebp7_1.5.0-0.1_arm64.deb ... 272s Unpacking libwebp7:arm64 (1.5.0-0.1) ... 272s Selecting previously unselected package libtiff6:arm64. 272s Preparing to unpack .../35-libtiff6_4.5.1+git230720-4ubuntu4_arm64.deb ... 272s Unpacking libtiff6:arm64 (4.5.1+git230720-4ubuntu4) ... 272s Selecting previously unselected package libxft2:arm64. 272s Preparing to unpack .../36-libxft2_2.3.6-1build1_arm64.deb ... 272s Unpacking libxft2:arm64 (2.3.6-1build1) ... 272s Selecting previously unselected package libxss1:arm64. 272s Preparing to unpack .../37-libxss1_1%3a1.2.3-1build3_arm64.deb ... 272s Unpacking libxss1:arm64 (1:1.2.3-1build3) ... 272s Selecting previously unselected package libtk8.6:arm64. 272s Preparing to unpack .../38-libtk8.6_8.6.16-1_arm64.deb ... 272s Unpacking libtk8.6:arm64 (8.6.16-1) ... 272s Selecting previously unselected package libxt6t64:arm64. 272s Preparing to unpack .../39-libxt6t64_1%3a1.2.1-1.2build1_arm64.deb ... 272s Unpacking libxt6t64:arm64 (1:1.2.1-1.2build1) ... 272s Selecting previously unselected package zip. 272s Preparing to unpack .../40-zip_3.0-14ubuntu2_arm64.deb ... 272s Unpacking zip (3.0-14ubuntu2) ... 272s Selecting previously unselected package unzip. 272s Preparing to unpack .../41-unzip_6.0-28ubuntu6_arm64.deb ... 272s Unpacking unzip (6.0-28ubuntu6) ... 272s Selecting previously unselected package xdg-utils. 272s Preparing to unpack .../42-xdg-utils_1.2.1-2ubuntu1_all.deb ... 272s Unpacking xdg-utils (1.2.1-2ubuntu1) ... 272s Selecting previously unselected package r-base-core. 272s Preparing to unpack .../43-r-base-core_4.4.3-1_arm64.deb ... 272s Unpacking r-base-core (4.4.3-1) ... 272s Selecting previously unselected package r-cran-iso. 272s Preparing to unpack .../44-r-cran-iso_0.0-21-1_arm64.deb ... 272s Unpacking r-cran-iso (0.0-21-1) ... 272s Selecting previously unselected package r-cran-mcmc. 272s Preparing to unpack .../45-r-cran-mcmc_0.9-8-1_arm64.deb ... 272s Unpacking r-cran-mcmc (0.9-8-1) ... 272s Selecting previously unselected package r-cran-xtable. 272s Preparing to unpack .../46-r-cran-xtable_1%3a1.8-4-2_all.deb ... 272s Unpacking r-cran-xtable (1:1.8-4-2) ... 272s Setting up libgraphite2-3:arm64 (1.3.14-2ubuntu1) ... 272s Setting up libpixman-1-0:arm64 (0.44.0-3) ... 272s Setting up libsharpyuv0:arm64 (1.5.0-0.1) ... 272s Setting up liblerc4:arm64 (4.0.0+ds-5ubuntu1) ... 272s Setting up libxrender1:arm64 (1:0.9.10-1.1build1) ... 272s Setting up libdatrie1:arm64 (0.2.13-3build1) ... 272s Setting up libxcb-render0:arm64 (1.17.0-2) ... 272s Setting up unzip (6.0-28ubuntu6) ... 272s Setting up x11-common (1:7.7+23ubuntu3) ... 273s Setting up libdeflate0:arm64 (1.23-1) ... 273s Setting up libxcb-shm0:arm64 (1.17.0-2) ... 273s Setting up libgomp1:arm64 (15-20250222-0ubuntu1) ... 273s Setting up libjbig0:arm64 (2.1-6.1ubuntu2) ... 273s Setting up zip (3.0-14ubuntu2) ... 273s Setting up libblas3:arm64 (3.12.1-2) ... 273s update-alternatives: using /usr/lib/aarch64-linux-gnu/blas/libblas.so.3 to provide /usr/lib/aarch64-linux-gnu/libblas.so.3 (libblas.so.3-aarch64-linux-gnu) in auto mode 273s Setting up fonts-dejavu-mono (2.37-8) ... 273s Setting up libtcl8.6:arm64 (8.6.16+dfsg-1) ... 273s Setting up fonts-dejavu-core (2.37-8) ... 273s Setting up libjpeg-turbo8:arm64 (2.1.5-3ubuntu2) ... 273s Setting up libgfortran5:arm64 (15-20250222-0ubuntu1) ... 273s Setting up libwebp7:arm64 (1.5.0-0.1) ... 273s Setting up libharfbuzz0b:arm64 (10.2.0-1) ... 273s Setting up libthai-data (0.1.29-2build1) ... 273s Setting up libxss1:arm64 (1:1.2.3-1build3) ... 273s Setting up libpaper2:arm64 (2.2.5-0.3) ... 273s Setting up xdg-utils (1.2.1-2ubuntu1) ... 273s update-alternatives: using /usr/bin/xdg-open to provide /usr/bin/open (open) in auto mode 273s Setting up libjpeg8:arm64 (8c-2ubuntu11) ... 273s Setting up libice6:arm64 (2:1.1.1-1) ... 273s Setting up liblapack3:arm64 (3.12.1-2) ... 273s update-alternatives: using /usr/lib/aarch64-linux-gnu/lapack/liblapack.so.3 to provide /usr/lib/aarch64-linux-gnu/liblapack.so.3 (liblapack.so.3-aarch64-linux-gnu) in auto mode 273s Setting up fontconfig-config (2.15.0-2ubuntu1) ... 273s Setting up libpaper-utils (2.2.5-0.3) ... 273s Setting up libthai0:arm64 (0.1.29-2build1) ... 273s Setting up libtiff6:arm64 (4.5.1+git230720-4ubuntu4) ... 273s Setting up libfontconfig1:arm64 (2.15.0-2ubuntu1) ... 273s Setting up libsm6:arm64 (2:1.2.4-1) ... 273s Setting up fontconfig (2.15.0-2ubuntu1) ... 275s Regenerating fonts cache... done. 275s Setting up libxft2:arm64 (2.3.6-1build1) ... 275s Setting up libtk8.6:arm64 (8.6.16-1) ... 275s Setting up libpango-1.0-0:arm64 (1.56.2-1) ... 275s Setting up libcairo2:arm64 (1.18.2-2) ... 275s Setting up libxt6t64:arm64 (1:1.2.1-1.2build1) ... 275s Setting up libpangoft2-1.0-0:arm64 (1.56.2-1) ... 275s Setting up libpangocairo-1.0-0:arm64 (1.56.2-1) ... 275s Setting up r-base-core (4.4.3-1) ... 275s Creating config file /etc/R/Renviron with new version 276s Setting up r-cran-mcmc (0.9-8-1) ... 276s Setting up r-cran-iso (0.0-21-1) ... 276s Setting up r-cran-xtable (1:1.8-4-2) ... 276s Processing triggers for libc-bin (2.41-1ubuntu2) ... 276s Processing triggers for man-db (2.13.0-1) ... 277s Processing triggers for install-info (7.1.1-1) ... 278s autopkgtest [15:44:43]: test generic: [----------------------- 278s BEGIN TEST tests/accept-batch.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: aarch64-unknown-linux-gnu 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 279s > 279s > # new feature batching acceptance rates 279s > 279s > set.seed(42) 279s > 279s > library(mcmc) 279s > 279s > h <- function(x) if (all(x >= 0) && sum(x) <= 1) return(1) else return(-Inf) 279s > out <- metrop(h, rep(0, 5), nbatch = 100, blen = 100, scale = 0.1, 279s + debug = TRUE) 279s > 279s > all.equal(out$accept, mean(out$accept.batch)) 279s [1] TRUE 279s > 279s > foo <- matrix(out$debug.accept, nrow = out$blen) 279s > bar <- colMeans(foo) 279s > all.equal(out$accept.batch, bar) 279s [1] TRUE 279s > 279s > options(digits = 4) # try to keep insanity of computer arithmetic under control 279s > 279s > out$accept 279s [1] 0.2257 279s > t.test(out$accept.batch)$conf.int 279s [1] 0.2124 0.2390 279s attr(,"conf.level") 279s [1] 0.95 279s > 279s > 279s BEGIN TEST tests/circle.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: aarch64-unknown-linux-gnu 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 > epsilon <- 1e-15 279s > 279s > library(mcmc) 279s > 279s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 279s > set.seed(42) 279s > 279s > d <- 5 279s > 279s > logh <- function(x) { 279s + if (! is.numeric(x)) stop("x not numeric") 279s + if (length(x) != d) stop("length(x) != d") 279s + fred <- 1 - sum(x^2) 279s + if (fred > 0) return(log(fred)) else return(-Inf) 279s + } 279s > 279s > out.metro <- metrop(logh, rep(0, d), 1e3, scale = 0.01) 279s > out.metro$accept 279s [1] 0.979 279s > 279s > out.metro <- metrop(out.metro, scale = 0.1) 279s > out.metro$accept 279s [1] 0.72 279s > 279s > out.metro <- metrop(out.metro, scale = 0.5) 279s > out.metro$accept 279s [1] 0.16 279s > 279s > out.metro <- metrop(out.metro, scale = 0.4) 279s > out.metro$accept 279s [1] 0.228 279s > 279s > out.metro <- metrop(out.metro, nbatch = 1e2, debug = TRUE) 279s > 279s > all(out.metro$batch[- out.metro$nbatch, ] == out.metro$current[- 1, ]) 279s [1] TRUE 279s > all(out.metro$current[1, ] == out.metro$initial) 279s [1] TRUE 279s > all(out.metro$batch[out.metro$nbatch, ] == 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, logh) 279s > my.prop.log.green <- apply(out.metro$proposal, 1, logh) 279s > all(is.na(out.metro$u) == ((my.prop.log.green == -Inf) | 279s + (my.prop.log.green > my.curr.log.green))) 279s [1] TRUE 279s > foo <- my.prop.log.green - my.curr.log.green 279s > blurfle <- foo - out.metro$log.green 279s > blurfle[foo == -Inf & out.metro$log.green == -Inf] <- 0 279s > max(blurfle) < epsilon 279s [1] TRUE 279s > 279s > my.accept <- (my.prop.log.green > -Inf) & (is.na(my.u) | my.u < exp(foo)) 279s > sum(my.accept) == round(n * out.metro$accept) 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 > 279s > all(my.path == out.metro$batch) 279s [1] TRUE 279s > 279s > 279s BEGIN TEST tests/initseq.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: aarch64-unknown-linux-gnu 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 > library(mcmc) 279s > 279s > set.seed(42) 279s > 279s > n <- 1e5 279s > rho <- 0.99 279s > 279s > x <- arima.sim(model = list(ar = rho), n = n) 279s > gamma <- acf(x, lag.max = 1999, type = "covariance", 279s + plot = FALSE)$acf 279s > k <- seq(along = gamma) 279s > Gamma <- gamma[k %% 2 == 1] + gamma[k %% 2 == 0] 279s > k <- min(seq(along = Gamma)[Gamma < 0]) 279s > Gamma <- Gamma[1:k] 279s > Gamma[k] < 0 279s [1] TRUE 279s > Gamma[k] <- 0 279s > 279s > out <- .Call(mcmc:::C_initseq, x - mean(x)) 280s > names(out) 280s [1] "gamma0" "Gamma.pos" "Gamma.dec" "Gamma.con" "var.pos" "var.dec" 280s [7] "var.con" 280s > 280s > all.equal(gamma[1], out$gamma0) 280s [1] TRUE 280s > 280s > length(out$Gamma.pos) == length(Gamma) 280s [1] TRUE 280s > all.equal(out$Gamma.pos, Gamma) 280s [1] TRUE 280s > 280s > Gamma.dec <- cummin(Gamma) 280s > all.equal(out$Gamma.dec, Gamma.dec) 280s [1] TRUE 280s > 280s > ## IGNORE_RDIFF_BEGIN 280s > library(Iso) 280s > ## IGNORE_RDIFF_END 280s > Gamma.con <- Gamma.dec[1] + cumsum(c(0, pava(diff(Gamma.dec)))) 280s > all.equal(out$Gamma.con, Gamma.con) 280s [1] TRUE 280s > 280s > all.equal(0, min(out$Gamma.pos - out$Gamma.dec)) 280s Iso 0.0-21 280s 280s An "infelicity" in the function ufit() (whereby 280s it was all too easy to conflate the location of 280s the mode with its index in the entries of the 280s "x" argument) has been corrected. To this end, 280s ufit() now has arguments "lmode" (the location 280s of the mode), and "imode" (its index). At most 280s one of these arguments should be specified. See 280s the help for ufit(). 280s [1] TRUE 280s > max(diff(out$Gamma.dec)) < sqrt(.Machine$double.eps) 280s [1] TRUE 280s > 280s > all.equal(0, min(out$Gamma.dec - out$Gamma.con)) 280s [1] TRUE 280s > min(diff(diff(out$Gamma.con))) > (- sqrt(.Machine$double.eps)) 280s [1] TRUE 280s > 280s > all.equal(2 * sum(out$Gamma.pos) - out$gamma0, out$var.pos) 280s [1] TRUE 280s > all.equal(2 * sum(out$Gamma.dec) - out$gamma0, out$var.dec) 280s [1] TRUE 280s > all.equal(2 * sum(out$Gamma.con) - out$gamma0, out$var.con) 280s [1] TRUE 280s > 280s > rev(out$Gamma.pos)[1] == 0 280s [1] TRUE 280s > rev(out$Gamma.dec)[1] == 0 280s [1] TRUE 280s > all.equal(rev(out$Gamma.con)[1], 0) 280s [1] TRUE 280s > 280s > 280s BEGIN TEST tests/isotropic.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: aarch64-unknown-linux-gnu 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 > # create identity test function 280s > identity <- function(x) x 280s > d.identity <- function(x) 1 280s > 280s > # check that isotropic is length preserving for vectors of lengths 1--1000 280s > all(sapply(1:1000, function(x) length(isotropic(identity)(rep(1, x))) == x)) 280s [1] TRUE 280s > 280s > # test that isotropic(identity) is an identity function 280s > all.equal(isotropic(identity)(1:10), 1:10) 280s [1] TRUE 280s > x <- seq(0, 1, length.out=200) 280s > all.equal(isotropic(identity)(x), x) 280s [1] TRUE 280s > 280s > # make sure that isotropic.logjacobian(identity, d.identity) is a 0 function 280s > all.equal(isotropic.logjacobian(identity, d.identity)(1:10), 0) 280s [1] TRUE 280s > 280s > # make sure that 0 as an input does not cause divide-by-zero errors 280s > all.equal(isotropic(identity)(0), 0) 280s [1] TRUE 280s > all.equal(isotropic(identity)(0 * 1:4), rep(0, 4)) 280s [1] TRUE 280s > all.equal(isotropic.logjacobian(identity, d.identity)(0), 0) 280s [1] TRUE 280s > all.equal(isotropic.logjacobian(identity, d.identity)(0 * 1:4), 0) 280s [1] TRUE 280s > 280s > # try isotropic with f(x) = x^2, then we should get 280s > # istropic(f)(x) := |x| * x 280s > f <- function(x) x^2 280s > all.equal(isotropic(f)(1), 1) 280s [1] TRUE 280s > all.equal(isotropic(f)(c(1, 1)), sqrt(2) * c(1, 1)) 280s [1] TRUE 280s > all.equal(isotropic(f)(c(1, 0, 1)), sqrt(2) * c(1, 0, 1)) 280s [1] TRUE 280s > 280s > # make sure lazy-loading works properly. 280s > g <- function(x) x^2 280s > g.iso <- isotropic(g) 280s > g <- function(x) x 280s > all.equal(g.iso(2), 2*2) 280s [1] TRUE 280s > 280s BEGIN TEST tests/logit.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: aarch64-unknown-linux-gnu 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 > 280s > epsilon <- 1e-15 280s > 280s > library(mcmc) 280s > 280s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 280s > set.seed(42) 280s > 280s > options(digits = 3) 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 > ## IGNORE_RDIFF_BEGIN 280s > summary(out) 280s 280s Call: 280s glm(formula = y ~ x1 + x2, family = binomial()) 280s 280s Coefficients: 280s Estimate Std. Error z value Pr(>|z|) 280s (Intercept) 0.0599 0.2477 0.24 0.80905 280s x1 1.3682 0.3844 3.56 0.00037 *** 280s x2 0.4760 0.3135 1.52 0.12886 280s --- 280s Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 280s 280s (Dispersion parameter for binomial family taken to be 1) 280s 280s Null deviance: 138.469 on 99 degrees of freedom 280s Residual deviance: 99.293 on 97 degrees of freedom 280s AIC: 105.3 280s 280s Number of Fisher Scoring iterations: 5 280s 280s > ## IGNORE_RDIFF_END 280s > 280s > mlogl <- 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 > ## IGNORE_RDIFF_BEGIN 280s > out.nlm <- nlm(mlogl, coefficients(out), print.level = 2) 280s iteration = 0 280s Parameter: 280s [1] 0.0599 1.3682 0.4760 280s Function Value 280s [1] 49.6 280s Gradient: 280s [1] 8.24e-06 5.50e-06 6.08e-06 280s 280s Relative gradient close to zero. 280s Current iterate is probably solution. 280s 280s > ## IGNORE_RDIFF_END 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.0608 1.4230 0.5263 280s > var(out.metro$batch) 280s [,1] [,2] [,3] 280s [1,] 0.06755 -0.0108 0.00989 280s [2,] -0.01080 0.1758 -0.06155 280s [3,] 0.00989 -0.0615 0.10483 280s > olbm(out.metro$batch, 25) 280s [,1] [,2] [,3] 280s [1,] 4.54e-04 9.47e-05 -1.92e-05 280s [2,] 9.47e-05 1.84e-03 -6.45e-04 280s [3,] -1.92e-05 -6.45e-04 9.09e-04 280s > 280s > saveseed <- .Random.seed 280s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 280s + scale = 0.5, debug = TRUE) 280s > 280s > all(out.metro$batch[- out.metro$nbatch, ] == out.metro$current[- 1, ]) 280s [1] TRUE 280s > all(out.metro$current[1, ] == out.metro$initial) 280s [1] TRUE 280s > all(out.metro$batch[out.metro$nbatch, ] == out.metro$final) 280s [1] TRUE 280s > 280s > .Random.seed <- saveseed 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 > 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 > 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 > 280s > all(my.path == out.metro$batch) 280s [1] TRUE 280s > 280s > 280s BEGIN TEST tests/logitbat.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: aarch64-unknown-linux-gnu 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 > 280s > # test batching (blen) 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 > 280s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 280s + scale = 0.5, debug = TRUE, blen = 5) 281s > 281s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 281s > niter == nrow(out.metro$current) 281s [1] TRUE 281s > niter == nrow(out.metro$proposal) 281s [1] TRUE 281s > all(out.metro$current[1, ] == out.metro$initial) 281s [1] TRUE 281s > all(out.metro$current[niter, ] == out.metro$final) | 281s + all(out.metro$proposal[niter, ] == out.metro$final) 281s [1] TRUE 281s > 281s > .Random.seed <- out.metro$initial.seed 281s > d <- ncol(out.metro$proposal) 281s > n <- nrow(out.metro$proposal) 281s > my.proposal <- matrix(NA, n, d) 281s > my.u <- double(n) 281s > ska <- out.metro$scale 281s > for (i in 1:n) { 281s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 281s + if (is.na(out.metro$u[i])) { 281s + my.u[i] <- NA 281s + } else { 281s + my.u[i] <- runif(1) 281s + } 281s + } 281s > max(abs(out.metro$proposal - my.proposal)) < epsilon 281s [1] TRUE 281s > all(is.na(out.metro$u) == is.na(my.u)) 281s [1] TRUE 281s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 281s [1] TRUE 281s > 281s > my.curr.log.green <- apply(out.metro$current, 1, logl) 281s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 281s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 281s [1] TRUE 281s > foo <- my.prop.log.green - my.curr.log.green 281s > max(abs(foo - out.metro$log.green)) < epsilon 281s [1] TRUE 281s > 281s > my.accept <- is.na(my.u) | my.u < exp(foo) 281s > sum(my.accept) == round(n * out.metro$accept) 281s [1] TRUE 281s > if (my.accept[niter]) { 281s + all(out.metro$proposal[niter, ] == out.metro$final) 281s + } else { 281s + all(out.metro$current[niter, ] == out.metro$final) 281s + } 281s [1] TRUE 281s > 281s > my.current <- out.metro$current 281s > my.current[my.accept, ] <- my.proposal[my.accept, ] 281s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 281s > max(abs(out.metro$current - my.current)) < epsilon 281s [1] TRUE 281s > 281s > my.path <- matrix(NA, n, d) 281s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 281s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 281s > nspac <- out.metro$nspac 281s > 281s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 281s > 281s > foom <- array(as.vector(t(my.path)), c(d, out.metro$blen, out.metro$nbatch)) 281s > boom <- t(apply(foom, c(1, 3), mean)) 281s > 281s > all(dim(boom) == dim(out.metro$batch)) 281s [1] TRUE 281s > max(abs(boom - out.metro$batch)) < epsilon 281s [1] TRUE 281s > 281s > 281s BEGIN TEST tests/logitfun.R 281s 281s R version 4.4.3 (2025-02-28) -- "Trophy Case" 281s Copyright (C) 2025 The R Foundation for Statistical Computing 281s Platform: aarch64-unknown-linux-gnu 281s 281s R is free software and comes with ABSOLUTELY NO WARRANTY. 281s You are welcome to redistribute it under certain conditions. 281s Type 'license()' or 'licence()' for distribution details. 281s 281s R is a collaborative project with many contributors. 281s Type 'contributors()' for more information and 281s 'citation()' on how to cite R or R packages in publications. 281s 281s Type 'demo()' for some demos, 'help()' for on-line help, or 281s 'help.start()' for an HTML browser interface to help. 281s Type 'q()' to quit R. 281s 281s > 281s > # test outfun (function) 281s > 281s > epsilon <- 1e-15 281s > 281s > library(mcmc) 281s > 281s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 281s > set.seed(42) 281s > 281s > n <- 100 281s > rho <- 0.5 281s > beta0 <- 0.25 281s > beta1 <- 1 281s > beta2 <- 0.5 281s > 281s > x1 <- rnorm(n) 281s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 281s > eta <- beta0 + beta1 * x1 + beta2 * x2 281s > p <- 1 / (1 + exp(- eta)) 281s > y <- as.numeric(runif(n) < p) 281s > 281s > out <- glm(y ~ x1 + x2, family = binomial()) 281s > 281s > logl <- function(beta) { 281s + if (length(beta) != 3) stop("length(beta) != 3") 281s + beta0 <- beta[1] 281s + beta1 <- beta[2] 281s + beta2 <- beta[3] 281s + eta <- beta0 + beta1 * x1 + beta2 * x2 281s + p <- exp(eta) / (1 + exp(eta)) 281s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 281s + } 281s > 281s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 281s > out.metro$accept 281s [1] 0.982 281s > 281s > out.metro <- metrop(out.metro, scale = 0.1) 281s > out.metro$accept 281s [1] 0.795 281s > 281s > out.metro <- metrop(out.metro, scale = 0.5) 281s > out.metro$accept 281s [1] 0.264 281s > 281s > apply(out.metro$batch, 2, mean) 281s [1] 0.06080257 1.42304941 0.52634149 281s > 281s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 281s + scale = 0.5, debug = TRUE, outfun = function(x) c(x, x^2)) 281s > 281s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 281s > niter == nrow(out.metro$current) 281s [1] TRUE 281s > niter == nrow(out.metro$proposal) 281s [1] TRUE 281s > all(out.metro$current[1, ] == out.metro$initial) 281s [1] TRUE 281s > all(out.metro$current[niter, ] == out.metro$final) | 281s + all(out.metro$proposal[niter, ] == out.metro$final) 281s [1] TRUE 281s > 281s > .Random.seed <- out.metro$initial.seed 281s > d <- ncol(out.metro$proposal) 281s > n <- nrow(out.metro$proposal) 281s > my.proposal <- matrix(NA, n, d) 281s > my.u <- double(n) 281s > ska <- out.metro$scale 281s > for (i in 1:n) { 281s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 281s + if (is.na(out.metro$u[i])) { 281s + my.u[i] <- NA 281s + } else { 281s + my.u[i] <- runif(1) 281s + } 281s + } 281s > max(abs(out.metro$proposal - my.proposal)) < epsilon 281s [1] TRUE 281s > all(is.na(out.metro$u) == is.na(my.u)) 281s [1] TRUE 281s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 281s [1] TRUE 281s > 281s > my.curr.log.green <- apply(out.metro$current, 1, logl) 281s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 281s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 281s [1] TRUE 281s > foo <- my.prop.log.green - my.curr.log.green 281s > max(abs(foo - out.metro$log.green)) < epsilon 281s [1] TRUE 281s > 281s > my.accept <- is.na(my.u) | my.u < exp(foo) 281s > sum(my.accept) == round(n * out.metro$accept) 281s [1] TRUE 281s > if (my.accept[niter]) { 281s + all(out.metro$proposal[niter, ] == out.metro$final) 281s + } else { 281s + all(out.metro$current[niter, ] == out.metro$final) 281s + } 281s [1] TRUE 281s > 281s > my.current <- out.metro$current 281s > my.current[my.accept, ] <- my.proposal[my.accept, ] 281s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 281s > max(abs(out.metro$current - my.current)) < epsilon 281s [1] TRUE 281s > 281s > my.path <- matrix(NA, n, d) 281s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 281s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 281s > nspac <- out.metro$nspac 281s > 281s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 281s > 281s > fred <- t(apply(my.path, 1, out.metro$outfun)) 281s > k <- ncol(fred) 281s > 281s > foom <- array(as.vector(t(fred)), c(k, out.metro$blen, out.metro$nbatch)) 281s > boom <- t(apply(foom, c(1, 3), mean)) 281s > 281s > all(dim(boom) == dim(out.metro$batch)) 281s [1] TRUE 281s > max(abs(boom - out.metro$batch)) < epsilon 281s [1] TRUE 281s > 281s > goom <- cbind(my.path, my.path^2) 281s > all(dim(goom) == dim(out.metro$batch)) 281s [1] TRUE 281s > max(abs(goom - out.metro$batch)) < epsilon 281s [1] TRUE 281s > 281s BEGIN TEST tests/logitfunarg.R 281s 281s R version 4.4.3 (2025-02-28) -- "Trophy Case" 281s Copyright (C) 2025 The R Foundation for Statistical Computing 281s Platform: aarch64-unknown-linux-gnu 281s 281s R is free software and comes with ABSOLUTELY NO WARRANTY. 281s You are welcome to redistribute it under certain conditions. 281s Type 'license()' or 'licence()' for distribution details. 281s 281s R is a collaborative project with many contributors. 281s Type 'contributors()' for more information and 281s 'citation()' on how to cite R or R packages in publications. 281s 281s Type 'demo()' for some demos, 'help()' for on-line help, or 281s 'help.start()' for an HTML browser interface to help. 281s Type 'q()' to quit R. 281s 281s > 281s > # test outfun (function) 281s > 281s > epsilon <- 1e-15 281s > 281s > library(mcmc) 281s > 281s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 281s > set.seed(42) 281s > 281s > n <- 100 281s > rho <- 0.5 281s > beta0 <- 0.25 281s > beta1 <- 1 281s > beta2 <- 0.5 281s > 281s > x1 <- rnorm(n) 281s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 281s > eta <- beta0 + beta1 * x1 + beta2 * x2 281s > p <- 1 / (1 + exp(- eta)) 281s > y <- as.numeric(runif(n) < p) 281s > 281s > out <- glm(y ~ x1 + x2, family = binomial()) 281s > 281s > logl <- function(beta) { 281s + if (length(beta) != 3) stop("length(beta) != 3") 281s + beta0 <- beta[1] 281s + beta1 <- beta[2] 281s + beta2 <- beta[3] 281s + eta <- beta0 + beta1 * x1 + beta2 * x2 281s + p <- exp(eta) / (1 + exp(eta)) 281s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 281s + } 281s > 281s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 281s > out.metro$accept 281s [1] 0.982 281s > 281s > out.metro <- metrop(out.metro, scale = 0.1) 281s > out.metro$accept 281s [1] 0.795 281s > 281s > out.metro <- metrop(out.metro, scale = 0.5) 281s > out.metro$accept 281s [1] 0.264 281s > 281s > apply(out.metro$batch, 2, mean) 281s [1] 0.06080257 1.42304941 0.52634149 281s > 281s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 281s + scale = 0.5, debug = TRUE, outfun = function(x) c(x, x^2)) 281s > 281s > out.metro <- metrop(out.metro) 281s > out.metro$outfun 281s function (x) 281s c(x, x^2) 281s 281s > dim(out.metro$batch) 281s [1] 100 6 281s > 281s > logl <- function(beta, x1, x2, y) { 281s + if (length(beta) != 3) stop("length(beta) != 3") 281s + beta0 <- beta[1] 281s + beta1 <- beta[2] 281s + beta2 <- beta[3] 281s + eta <- beta0 + beta1 * x1 + beta2 * x2 281s + p <- exp(eta) / (1 + exp(eta)) 281s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 281s + } 281s > 281s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 281s + scale = 0.5, debug = TRUE, x1 = x1, x2 = x2, y = y) 281s > out.metro$lud 281s function (beta, x1, x2, y) 281s { 281s if (length(beta) != 3) 281s stop("length(beta) != 3") 281s beta0 <- beta[1] 281s beta1 <- beta[2] 281s beta2 <- beta[3] 281s eta <- beta0 + beta1 * x1 + beta2 * x2 281s p <- exp(eta)/(1 + exp(eta)) 281s return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 281s } 281s > out.metro <- metrop(out.metro, x1 = x1, x2 = x2, y = y) 281s > out.metro$lud 281s function (beta, x1, x2, y) 281s { 281s if (length(beta) != 3) 281s stop("length(beta) != 3") 281s beta0 <- beta[1] 281s beta1 <- beta[2] 281s beta2 <- beta[3] 281s eta <- beta0 + beta1 * x1 + beta2 * x2 281s p <- exp(eta)/(1 + exp(eta)) 281s return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 281s } 281s > 281s > 281s BEGIN TEST tests/logitidx.R 281s 281s R version 4.4.3 (2025-02-28) -- "Trophy Case" 281s Copyright (C) 2025 The R Foundation for Statistical Computing 281s Platform: aarch64-unknown-linux-gnu 281s 281s R is free software and comes with ABSOLUTELY NO WARRANTY. 281s You are welcome to redistribute it under certain conditions. 281s Type 'license()' or 'licence()' for distribution details. 281s 281s R is a collaborative project with many contributors. 281s Type 'contributors()' for more information and 281s 'citation()' on how to cite R or R packages in publications. 281s 281s Type 'demo()' for some demos, 'help()' for on-line help, or 281s 'help.start()' for an HTML browser interface to help. 281s Type 'q()' to quit R. 281s 281s > 281s > # test outfun (positive index vector) 281s > 281s > epsilon <- 1e-15 281s > 281s > library(mcmc) 281s > 281s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 281s > set.seed(42) 281s > 281s > n <- 100 281s > rho <- 0.5 281s > beta0 <- 0.25 281s > beta1 <- 1 281s > beta2 <- 0.5 281s > 281s > x1 <- rnorm(n) 281s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 281s > eta <- beta0 + beta1 * x1 + beta2 * x2 281s > p <- 1 / (1 + exp(- eta)) 281s > y <- as.numeric(runif(n) < p) 281s > 281s > out <- glm(y ~ x1 + x2, family = binomial()) 281s > 281s > logl <- function(beta) { 281s + if (length(beta) != 3) stop("length(beta) != 3") 281s + beta0 <- beta[1] 281s + beta1 <- beta[2] 281s + beta2 <- beta[3] 281s + eta <- beta0 + beta1 * x1 + beta2 * x2 281s + p <- exp(eta) / (1 + exp(eta)) 281s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 281s + } 281s > 281s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 282s > out.metro$accept 282s [1] 0.982 282s > 282s > out.metro <- metrop(out.metro, scale = 0.1) 282s > out.metro$accept 282s [1] 0.795 282s > 282s > out.metro <- metrop(out.metro, scale = 0.5) 282s > out.metro$accept 282s [1] 0.264 282s > 282s > apply(out.metro$batch, 2, mean) 282s [1] 0.06080257 1.42304941 0.52634149 282s > 282s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 282s + scale = 0.5, debug = TRUE, outfun = c(2, 3)) 282s > 282s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 282s > niter == nrow(out.metro$current) 282s [1] TRUE 282s > niter == nrow(out.metro$proposal) 282s [1] TRUE 282s > all(out.metro$current[1, ] == out.metro$initial) 282s [1] TRUE 282s > all(out.metro$current[niter, ] == out.metro$final) | 282s + all(out.metro$proposal[niter, ] == out.metro$final) 282s [1] TRUE 282s > 282s > .Random.seed <- out.metro$initial.seed 282s > d <- ncol(out.metro$proposal) 282s > n <- nrow(out.metro$proposal) 282s > my.proposal <- matrix(NA, n, d) 282s > my.u <- double(n) 282s > ska <- out.metro$scale 282s > for (i in 1:n) { 282s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 282s + if (is.na(out.metro$u[i])) { 282s + my.u[i] <- NA 282s + } else { 282s + my.u[i] <- runif(1) 282s + } 282s + } 282s > max(abs(out.metro$proposal - my.proposal)) < epsilon 282s [1] TRUE 282s > all(is.na(out.metro$u) == is.na(my.u)) 282s [1] TRUE 282s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 282s [1] TRUE 282s > 282s > my.curr.log.green <- apply(out.metro$current, 1, logl) 282s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 282s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 282s [1] TRUE 282s > foo <- my.prop.log.green - my.curr.log.green 282s > max(abs(foo - out.metro$log.green)) < epsilon 282s [1] TRUE 282s > 282s > my.accept <- is.na(my.u) | my.u < exp(foo) 282s > sum(my.accept) == round(n * out.metro$accept) 282s [1] TRUE 282s > if (my.accept[niter]) { 282s + all(out.metro$proposal[niter, ] == out.metro$final) 282s + } else { 282s + all(out.metro$current[niter, ] == out.metro$final) 282s + } 282s [1] TRUE 282s > 282s > my.current <- out.metro$current 282s > my.current[my.accept, ] <- my.proposal[my.accept, ] 282s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 282s > max(abs(out.metro$current - my.current)) < epsilon 282s [1] TRUE 282s > 282s > my.path <- matrix(NA, n, d) 282s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 282s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 282s > nspac <- out.metro$nspac 282s > 282s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 282s > 282s > fred <- my.path[ , out.metro$outfun] 282s > k <- ncol(fred) 282s > 282s > foom <- array(as.vector(t(fred)), c(k, out.metro$blen, out.metro$nbatch)) 282s > boom <- t(apply(foom, c(1, 3), mean)) 282s > 282s > all(dim(boom) == dim(out.metro$batch)) 282s [1] TRUE 282s > max(abs(boom - out.metro$batch)) < epsilon 282s [1] TRUE 282s > 282s > 282s BEGIN TEST tests/logitlogidx.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: aarch64-unknown-linux-gnu 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 > # test outfun (logical index vector) 282s > 282s > epsilon <- 1e-15 282s > 282s > library(mcmc) 282s > 282s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 282s > set.seed(42) 282s > 282s > n <- 100 282s > rho <- 0.5 282s > beta0 <- 0.25 282s > beta1 <- 1 282s > beta2 <- 0.5 282s > 282s > x1 <- rnorm(n) 282s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 282s > eta <- beta0 + beta1 * x1 + beta2 * x2 282s > p <- 1 / (1 + exp(- eta)) 282s > y <- as.numeric(runif(n) < p) 282s > 282s > out <- glm(y ~ x1 + x2, family = binomial()) 282s > 282s > logl <- function(beta) { 282s + if (length(beta) != 3) stop("length(beta) != 3") 282s + beta0 <- beta[1] 282s + beta1 <- beta[2] 282s + beta2 <- beta[3] 282s + eta <- beta0 + beta1 * x1 + beta2 * x2 282s + p <- exp(eta) / (1 + exp(eta)) 282s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 282s + } 282s > 282s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 282s > out.metro$accept 282s [1] 0.982 282s > 282s > out.metro <- metrop(out.metro, scale = 0.1) 282s > out.metro$accept 282s [1] 0.795 282s > 282s > out.metro <- metrop(out.metro, scale = 0.5) 282s > out.metro$accept 282s [1] 0.264 282s > 282s > apply(out.metro$batch, 2, mean) 282s [1] 0.06080257 1.42304941 0.52634149 282s > 282s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 282s + scale = 0.5, debug = TRUE, outfun = seq(1:3) > 1) 282s > 282s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 282s > niter == nrow(out.metro$current) 282s [1] TRUE 282s > niter == nrow(out.metro$proposal) 282s [1] TRUE 282s > all(out.metro$current[1, ] == out.metro$initial) 282s [1] TRUE 282s > all(out.metro$current[niter, ] == out.metro$final) | 282s + all(out.metro$proposal[niter, ] == out.metro$final) 282s [1] TRUE 282s > 282s > .Random.seed <- out.metro$initial.seed 282s > d <- ncol(out.metro$proposal) 282s > n <- nrow(out.metro$proposal) 282s > my.proposal <- matrix(NA, n, d) 282s > my.u <- double(n) 282s > ska <- out.metro$scale 282s > for (i in 1:n) { 282s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 282s + if (is.na(out.metro$u[i])) { 282s + my.u[i] <- NA 282s + } else { 282s + my.u[i] <- runif(1) 282s + } 282s + } 282s > max(abs(out.metro$proposal - my.proposal)) < epsilon 282s [1] TRUE 282s > all(is.na(out.metro$u) == is.na(my.u)) 282s [1] TRUE 282s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 282s [1] TRUE 282s > 282s > my.curr.log.green <- apply(out.metro$current, 1, logl) 282s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 282s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 282s [1] TRUE 282s > foo <- my.prop.log.green - my.curr.log.green 282s > max(abs(foo - out.metro$log.green)) < epsilon 282s [1] TRUE 282s > 282s > my.accept <- is.na(my.u) | my.u < exp(foo) 282s > sum(my.accept) == round(n * out.metro$accept) 282s [1] TRUE 282s > if (my.accept[niter]) { 282s + all(out.metro$proposal[niter, ] == out.metro$final) 282s + } else { 282s + all(out.metro$current[niter, ] == out.metro$final) 282s + } 282s [1] TRUE 282s > 282s > my.current <- out.metro$current 282s > my.current[my.accept, ] <- my.proposal[my.accept, ] 282s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 282s > max(abs(out.metro$current - my.current)) < epsilon 282s [1] TRUE 282s > 282s > my.path <- matrix(NA, n, d) 282s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 282s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 282s > nspac <- out.metro$nspac 282s > 282s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 282s > 282s > fred <- my.path[ , out.metro$outfun] 282s > k <- ncol(fred) 282s > 282s > foom <- array(as.vector(t(fred)), c(k, out.metro$blen, out.metro$nbatch)) 282s > boom <- t(apply(foom, c(1, 3), mean)) 282s > 282s > all(dim(boom) == dim(out.metro$batch)) 282s [1] TRUE 282s > max(abs(boom - out.metro$batch)) < epsilon 282s [1] TRUE 282s > 282s > 282s BEGIN TEST tests/logitmat.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: aarch64-unknown-linux-gnu 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 > # test matrix scaling 282s > 282s > epsilon <- 1e-15 282s > 282s > library(mcmc) 282s > 282s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 282s > set.seed(42) 282s > 282s > n <- 100 282s > rho <- 0.5 282s > beta0 <- 0.25 282s > beta1 <- 1 282s > beta2 <- 0.5 282s > 282s > x1 <- rnorm(n) 282s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 282s > eta <- beta0 + beta1 * x1 + beta2 * x2 282s > p <- 1 / (1 + exp(- eta)) 282s > y <- as.numeric(runif(n) < p) 282s > 282s > out <- glm(y ~ x1 + x2, family = binomial()) 282s > 282s > logl <- function(beta) { 282s + if (length(beta) != 3) stop("length(beta) != 3") 282s + beta0 <- beta[1] 282s + beta1 <- beta[2] 282s + beta2 <- beta[3] 282s + eta <- beta0 + beta1 * x1 + beta2 * x2 282s + p <- exp(eta) / (1 + exp(eta)) 282s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 282s + } 282s > 282s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 282s > out.metro$accept 282s [1] 0.982 282s > 282s > out.metro <- metrop(out.metro, scale = 0.1) 282s > out.metro$accept 282s [1] 0.795 282s > 282s > out.metro <- metrop(out.metro, scale = 0.5) 282s > out.metro$accept 282s [1] 0.264 282s > 282s > apply(out.metro$batch, 2, mean) 282s [1] 0.06080257 1.42304941 0.52634149 282s > fred <- var(out.metro$batch) 282s > sally <- t(chol(fred)) 282s > max(abs(fred - sally %*% t(sally))) < epsilon 282s [1] TRUE 282s > 282s > out.metro <- metrop(out.metro, scale = sally) 282s > out.metro$accept 282s [1] 0.451 282s > 282s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 282s + scale = sally, debug = TRUE) 282s > names(out.metro) 282s [1] "accept" "batch" "initial" "final" "accept.batch" 282s [6] "current" "proposal" "log.green" "u" "z" 282s [11] "debug.accept" "initial.seed" "final.seed" "time" "lud" 282s [16] "nbatch" "blen" "nspac" "scale" "debug" 282s > 282s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 282s > niter == nrow(out.metro$current) 282s [1] TRUE 282s > niter == nrow(out.metro$proposal) 282s [1] TRUE 282s > all(out.metro$current[1, ] == out.metro$initial) 282s [1] TRUE 282s > all(out.metro$current[niter, ] == out.metro$final) | 282s + all(out.metro$proposal[niter, ] == out.metro$final) 282s [1] TRUE 282s > 282s > .Random.seed <- out.metro$initial.seed 282s > d <- ncol(out.metro$proposal) 282s > n <- nrow(out.metro$proposal) 282s > my.proposal <- matrix(NA, n, d) 282s > my.u <- double(n) 282s > my.z <- matrix(NA, n, d) 282s > ska <- out.metro$scale 282s > for (i in 1:n) { 282s + zed <- rnorm(d) 282s + my.proposal[i, ] <- out.metro$current[i, ] + ska %*% zed 282s + if (is.na(out.metro$u[i])) { 282s + my.u[i] <- NA 282s + } else { 282s + my.u[i] <- runif(1) 282s + } 282s + my.z[i, ] <- zed 282s + } 282s > max(abs(out.metro$proposal - my.proposal)) < epsilon 282s [1] TRUE 282s > 282s > all(is.na(out.metro$u) == is.na(my.u)) 282s [1] TRUE 282s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 282s [1] TRUE 282s > identical(out.metro$z, my.z) 282s [1] TRUE 282s > 282s > my.curr.log.green <- apply(out.metro$current, 1, logl) 282s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 282s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 282s [1] TRUE 282s > foo <- my.prop.log.green - my.curr.log.green 282s > max(abs(foo - out.metro$log.green)) < epsilon 282s [1] TRUE 282s > 282s > my.accept <- is.na(my.u) | my.u < exp(foo) 282s > sum(my.accept) == round(n * out.metro$accept) 282s [1] TRUE 282s > if (my.accept[niter]) { 282s + all(out.metro$proposal[niter, ] == out.metro$final) 282s + } else { 282s + all(out.metro$current[niter, ] == out.metro$final) 282s + } 282s [1] TRUE 282s > identical(my.accept, out.metro$debug.accept) 282s [1] TRUE 282s > 282s > my.current <- out.metro$current 282s > my.current[my.accept, ] <- my.proposal[my.accept, ] 282s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 282s > max(abs(out.metro$current - my.current)) < epsilon 282s [1] TRUE 282s > 282s > my.path <- matrix(NA, n, d) 282s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 282s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 282s > nspac <- out.metro$nspac 282s > 282s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 282s > 282s > fred <- my.path 282s > k <- ncol(fred) 282s > 282s > foom <- array(as.vector(t(fred)), c(k, out.metro$blen, out.metro$nbatch)) 282s > boom <- t(apply(foom, c(1, 3), mean)) 282s > 282s > all(dim(boom) == dim(out.metro$batch)) 282s [1] TRUE 282s > max(abs(boom - out.metro$batch)) < epsilon 282s [1] TRUE 282s > 282s > 282s BEGIN TEST tests/logitnegidx.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: aarch64-unknown-linux-gnu 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 283s > 283s > # test outfun (negative index vector) 283s > 283s > epsilon <- 1e-15 283s > 283s > library(mcmc) 283s > 283s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 283s > set.seed(42) 283s > 283s > n <- 100 283s > rho <- 0.5 283s > beta0 <- 0.25 283s > beta1 <- 1 283s > beta2 <- 0.5 283s > 283s > x1 <- rnorm(n) 283s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 283s > eta <- beta0 + beta1 * x1 + beta2 * x2 283s > p <- 1 / (1 + exp(- eta)) 283s > y <- as.numeric(runif(n) < p) 283s > 283s > out <- glm(y ~ x1 + x2, family = binomial()) 283s > 283s > logl <- function(beta) { 283s + if (length(beta) != 3) stop("length(beta) != 3") 283s + beta0 <- beta[1] 283s + beta1 <- beta[2] 283s + beta2 <- beta[3] 283s + eta <- beta0 + beta1 * x1 + beta2 * x2 283s + p <- exp(eta) / (1 + exp(eta)) 283s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 283s + } 283s > 283s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 283s > out.metro$accept 283s [1] 0.982 283s > 283s > out.metro <- metrop(out.metro, scale = 0.1) 283s > out.metro$accept 283s [1] 0.795 283s > 283s > out.metro <- metrop(out.metro, scale = 0.5) 283s > out.metro$accept 283s [1] 0.264 283s > 283s > apply(out.metro$batch, 2, mean) 283s [1] 0.06080257 1.42304941 0.52634149 283s > 283s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 283s + scale = 0.5, debug = TRUE, outfun = - 2) 283s > 283s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 283s > niter == nrow(out.metro$current) 283s [1] TRUE 283s > niter == nrow(out.metro$proposal) 283s [1] TRUE 283s > all(out.metro$current[1, ] == out.metro$initial) 283s [1] TRUE 283s > all(out.metro$current[niter, ] == out.metro$final) | 283s + all(out.metro$proposal[niter, ] == out.metro$final) 283s [1] TRUE 283s > 283s > .Random.seed <- out.metro$initial.seed 283s > d <- ncol(out.metro$proposal) 283s > n <- nrow(out.metro$proposal) 283s > my.proposal <- matrix(NA, n, d) 283s > my.u <- double(n) 283s > ska <- out.metro$scale 283s > for (i in 1:n) { 283s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 283s + if (is.na(out.metro$u[i])) { 283s + my.u[i] <- NA 283s + } else { 283s + my.u[i] <- runif(1) 283s + } 283s + } 283s > max(abs(out.metro$proposal - my.proposal)) < epsilon 283s [1] TRUE 283s > all(is.na(out.metro$u) == is.na(my.u)) 283s [1] TRUE 283s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 283s [1] TRUE 283s > 283s > my.curr.log.green <- apply(out.metro$current, 1, logl) 283s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 283s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 283s [1] TRUE 283s > foo <- my.prop.log.green - my.curr.log.green 283s > max(abs(foo - out.metro$log.green)) < epsilon 283s [1] TRUE 283s > 283s > my.accept <- is.na(my.u) | my.u < exp(foo) 283s > sum(my.accept) == round(n * out.metro$accept) 283s [1] TRUE 283s > if (my.accept[niter]) { 283s + all(out.metro$proposal[niter, ] == out.metro$final) 283s + } else { 283s + all(out.metro$current[niter, ] == out.metro$final) 283s + } 283s [1] TRUE 283s > 283s > my.current <- out.metro$current 283s > my.current[my.accept, ] <- my.proposal[my.accept, ] 283s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 283s > max(abs(out.metro$current - my.current)) < epsilon 283s [1] TRUE 283s > 283s > my.path <- matrix(NA, n, d) 283s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 283s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 283s > nspac <- out.metro$nspac 283s > 283s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 283s > 283s > fred <- my.path[ , out.metro$outfun] 283s > k <- ncol(fred) 283s > 283s > foom <- array(as.vector(t(fred)), c(k, out.metro$blen, out.metro$nbatch)) 283s > boom <- t(apply(foom, c(1, 3), mean)) 283s > 283s > all(dim(boom) == dim(out.metro$batch)) 283s [1] TRUE 283s > max(abs(boom - out.metro$batch)) < epsilon 283s [1] TRUE 283s > 283s > 283s BEGIN TEST tests/logitsub.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: aarch64-unknown-linux-gnu 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 > # test spacing (nspac) 283s > 283s > epsilon <- 1e-15 283s > 283s > library(mcmc) 283s > 283s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 283s > set.seed(42) 283s > 283s > n <- 100 283s > rho <- 0.5 283s > beta0 <- 0.25 283s > beta1 <- 1 283s > beta2 <- 0.5 283s > 283s > x1 <- rnorm(n) 283s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 283s > eta <- beta0 + beta1 * x1 + beta2 * x2 283s > p <- 1 / (1 + exp(- eta)) 283s > y <- as.numeric(runif(n) < p) 283s > 283s > out <- glm(y ~ x1 + x2, family = binomial()) 283s > 283s > logl <- function(beta) { 283s + if (length(beta) != 3) stop("length(beta) != 3") 283s + beta0 <- beta[1] 283s + beta1 <- beta[2] 283s + beta2 <- beta[3] 283s + eta <- beta0 + beta1 * x1 + beta2 * x2 283s + p <- exp(eta) / (1 + exp(eta)) 283s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 283s + } 283s > 283s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 283s > out.metro$accept 283s [1] 0.982 283s > 283s > out.metro <- metrop(out.metro, scale = 0.1) 283s > out.metro$accept 283s [1] 0.795 283s > 283s > out.metro <- metrop(out.metro, scale = 0.5) 283s > out.metro$accept 283s [1] 0.264 283s > 283s > apply(out.metro$batch, 2, mean) 283s [1] 0.06080257 1.42304941 0.52634149 283s > 283s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 283s + scale = 0.5, debug = TRUE, nspac = 3) 283s > 283s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 283s > niter == nrow(out.metro$current) 283s [1] TRUE 283s > niter == nrow(out.metro$proposal) 283s [1] TRUE 283s > all(out.metro$current[1, ] == out.metro$initial) 283s [1] TRUE 283s > all(out.metro$current[niter, ] == out.metro$final) | 283s + all(out.metro$proposal[niter, ] == out.metro$final) 283s [1] TRUE 283s > 283s > .Random.seed <- out.metro$initial.seed 283s > d <- ncol(out.metro$proposal) 283s > n <- nrow(out.metro$proposal) 283s > my.proposal <- matrix(NA, n, d) 283s > my.u <- double(n) 283s > ska <- out.metro$scale 283s > for (i in 1:n) { 283s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 283s + if (is.na(out.metro$u[i])) { 283s + my.u[i] <- NA 283s + } else { 283s + my.u[i] <- runif(1) 283s + } 283s + } 283s > max(abs(out.metro$proposal - my.proposal)) < epsilon 283s [1] TRUE 283s > all(is.na(out.metro$u) == is.na(my.u)) 283s [1] TRUE 283s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 283s [1] TRUE 283s > 283s > my.curr.log.green <- apply(out.metro$current, 1, logl) 283s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 283s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 283s [1] TRUE 283s > foo <- my.prop.log.green - my.curr.log.green 283s > max(abs(foo - out.metro$log.green)) < epsilon 283s [1] TRUE 283s > 283s > my.accept <- is.na(my.u) | my.u < exp(foo) 283s > sum(my.accept) == round(n * out.metro$accept) 283s [1] TRUE 283s > if (my.accept[niter]) { 283s + all(out.metro$proposal[niter, ] == out.metro$final) 283s + } else { 283s + all(out.metro$current[niter, ] == out.metro$final) 283s + } 283s [1] TRUE 283s > 283s > my.current <- out.metro$current 283s > my.current[my.accept, ] <- my.proposal[my.accept, ] 283s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 283s > max(abs(out.metro$current - my.current)) < epsilon 283s [1] TRUE 283s > 283s > my.path <- matrix(NA, n, d) 283s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 283s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 283s > nspac <- out.metro$nspac 283s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 283s > all(dim(my.path) == dim(out.metro$batch)) 283s [1] TRUE 283s > 283s > all(my.path == out.metro$batch) 283s [1] TRUE 283s > 283s > 283s BEGIN TEST tests/logitsubbat.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: aarch64-unknown-linux-gnu 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 > # test batching (blen) and spacing (nspac) together 283s > 283s > epsilon <- 1e-15 283s > 283s > library(mcmc) 283s > 283s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 283s > set.seed(42) 283s > 283s > n <- 100 283s > rho <- 0.5 283s > beta0 <- 0.25 283s > beta1 <- 1 283s > beta2 <- 0.5 283s > 283s > x1 <- rnorm(n) 283s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 283s > eta <- beta0 + beta1 * x1 + beta2 * x2 283s > p <- 1 / (1 + exp(- eta)) 283s > y <- as.numeric(runif(n) < p) 283s > 283s > out <- glm(y ~ x1 + x2, family = binomial()) 283s > 283s > logl <- function(beta) { 283s + if (length(beta) != 3) stop("length(beta) != 3") 283s + beta0 <- beta[1] 283s + beta1 <- beta[2] 283s + beta2 <- beta[3] 283s + eta <- beta0 + beta1 * x1 + beta2 * x2 283s + p <- exp(eta) / (1 + exp(eta)) 283s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 283s + } 283s > 283s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 283s > out.metro$accept 283s [1] 0.982 283s > 283s > out.metro <- metrop(out.metro, scale = 0.1) 283s > out.metro$accept 283s [1] 0.795 283s > 283s > out.metro <- metrop(out.metro, scale = 0.5) 283s > out.metro$accept 283s [1] 0.264 283s > 283s > apply(out.metro$batch, 2, mean) 283s [1] 0.06080257 1.42304941 0.52634149 283s > 283s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 283s + scale = 0.5, debug = TRUE, blen = 5, nspac = 3) 283s > 283s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 283s > niter == nrow(out.metro$current) 283s [1] TRUE 283s > niter == nrow(out.metro$proposal) 283s [1] TRUE 283s > all(out.metro$current[1, ] == out.metro$initial) 283s [1] TRUE 283s > all(out.metro$current[niter, ] == out.metro$final) | 283s + all(out.metro$proposal[niter, ] == out.metro$final) 283s [1] TRUE 283s > 283s > .Random.seed <- out.metro$initial.seed 283s > d <- ncol(out.metro$proposal) 283s > n <- nrow(out.metro$proposal) 283s > my.proposal <- matrix(NA, n, d) 283s > my.u <- double(n) 283s > ska <- out.metro$scale 283s > for (i in 1:n) { 283s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 283s + if (is.na(out.metro$u[i])) { 283s + my.u[i] <- NA 283s + } else { 283s + my.u[i] <- runif(1) 283s + } 283s + } 284s > max(abs(out.metro$proposal - my.proposal)) < epsilon 284s [1] TRUE 284s > all(is.na(out.metro$u) == is.na(my.u)) 284s [1] TRUE 284s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 284s [1] TRUE 284s > 284s > my.curr.log.green <- apply(out.metro$current, 1, logl) 284s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 284s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 284s [1] TRUE 284s > foo <- my.prop.log.green - my.curr.log.green 284s > max(abs(foo - out.metro$log.green)) < epsilon 284s [1] TRUE 284s > 284s > my.accept <- is.na(my.u) | my.u < exp(foo) 284s > sum(my.accept) == round(n * out.metro$accept) 284s [1] TRUE 284s > if (my.accept[niter]) { 284s + all(out.metro$proposal[niter, ] == out.metro$final) 284s + } else { 284s + all(out.metro$current[niter, ] == out.metro$final) 284s + } 284s [1] TRUE 284s > 284s > my.current <- out.metro$current 284s > my.current[my.accept, ] <- my.proposal[my.accept, ] 284s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 284s > max(abs(out.metro$current - my.current)) < epsilon 284s [1] TRUE 284s > 284s > my.path <- matrix(NA, n, d) 284s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 284s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 284s > nspac <- out.metro$nspac 284s > 284s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 284s > 284s > foom <- array(as.vector(t(my.path)), c(d, out.metro$blen, out.metro$nbatch)) 284s > boom <- t(apply(foom, c(1, 3), mean)) 284s > 284s > all(dim(boom) == dim(out.metro$batch)) 284s [1] TRUE 284s > max(abs(boom - out.metro$batch)) < epsilon 284s [1] TRUE 284s > 284s > 284s BEGIN TEST tests/logitvec.R 284s 284s R version 4.4.3 (2025-02-28) -- "Trophy Case" 284s Copyright (C) 2025 The R Foundation for Statistical Computing 284s Platform: aarch64-unknown-linux-gnu 284s 284s R is free software and comes with ABSOLUTELY NO WARRANTY. 284s You are welcome to redistribute it under certain conditions. 284s Type 'license()' or 'licence()' for distribution details. 284s 284s R is a collaborative project with many contributors. 284s Type 'contributors()' for more information and 284s 'citation()' on how to cite R or R packages in publications. 284s 284s Type 'demo()' for some demos, 'help()' for on-line help, or 284s 'help.start()' for an HTML browser interface to help. 284s Type 'q()' to quit R. 284s 284s > 284s > # test vector (diag(foo)) scaling 284s > 284s > epsilon <- 1e-15 284s > 284s > library(mcmc) 284s > 284s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 284s > set.seed(42) 284s > 284s > n <- 100 284s > rho <- 0.5 284s > beta0 <- 0.25 284s > beta1 <- 1 284s > beta2 <- 0.5 284s > 284s > x1 <- rnorm(n) 284s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 284s > eta <- beta0 + beta1 * x1 + beta2 * x2 284s > p <- 1 / (1 + exp(- eta)) 284s > y <- as.numeric(runif(n) < p) 284s > 284s > out <- glm(y ~ x1 + x2, family = binomial()) 284s > 284s > logl <- function(beta) { 284s + if (length(beta) != 3) stop("length(beta) != 3") 284s + beta0 <- beta[1] 284s + beta1 <- beta[2] 284s + beta2 <- beta[3] 284s + eta <- beta0 + beta1 * x1 + beta2 * x2 284s + p <- exp(eta) / (1 + exp(eta)) 284s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 284s + } 284s > 284s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 284s > out.metro$accept 284s [1] 0.982 284s > 284s > out.metro <- metrop(out.metro, scale = 0.1) 284s > out.metro$accept 284s [1] 0.795 284s > 284s > out.metro <- metrop(out.metro, scale = 0.5) 284s > out.metro$accept 284s [1] 0.264 284s > 284s > apply(out.metro$batch, 2, mean) 284s [1] 0.06080257 1.42304941 0.52634149 284s > sally <- apply(out.metro$batch, 2, sd) 284s > 284s > out.metro <- metrop(out.metro, scale = sally) 284s > out.metro$accept 284s [1] 0.398 284s > 284s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 284s + scale = sally, debug = TRUE) 284s > 284s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 284s > niter == nrow(out.metro$current) 284s [1] TRUE 284s > niter == nrow(out.metro$proposal) 284s [1] TRUE 284s > all(out.metro$current[1, ] == out.metro$initial) 284s [1] TRUE 284s > all(out.metro$current[niter, ] == out.metro$final) | 284s + all(out.metro$proposal[niter, ] == out.metro$final) 284s [1] TRUE 284s > 284s > .Random.seed <- out.metro$initial.seed 284s > d <- ncol(out.metro$proposal) 284s > n <- nrow(out.metro$proposal) 284s > my.proposal <- matrix(NA, n, d) 284s > my.u <- double(n) 284s > ska <- out.metro$scale 284s > for (i in 1:n) { 284s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 284s + if (is.na(out.metro$u[i])) { 284s + my.u[i] <- NA 284s + } else { 284s + my.u[i] <- runif(1) 284s + } 284s + } 284s > max(abs(out.metro$proposal - my.proposal)) < epsilon 284s [1] TRUE 284s > 284s > all(is.na(out.metro$u) == is.na(my.u)) 284s [1] TRUE 284s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 284s [1] TRUE 284s > 284s > my.curr.log.green <- apply(out.metro$current, 1, logl) 284s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 284s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 284s [1] TRUE 284s > foo <- my.prop.log.green - my.curr.log.green 284s > max(abs(foo - out.metro$log.green)) < epsilon 284s [1] TRUE 284s > 284s > my.accept <- is.na(my.u) | my.u < exp(foo) 284s > sum(my.accept) == round(n * out.metro$accept) 284s [1] TRUE 284s > if (my.accept[niter]) { 284s + all(out.metro$proposal[niter, ] == out.metro$final) 284s + } else { 284s + all(out.metro$current[niter, ] == out.metro$final) 284s + } 284s [1] TRUE 284s > 284s > my.current <- out.metro$current 284s > my.current[my.accept, ] <- my.proposal[my.accept, ] 284s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 284s > max(abs(out.metro$current - my.current)) < epsilon 284s [1] TRUE 284s > 284s > my.path <- matrix(NA, n, d) 284s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 284s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 284s > nspac <- out.metro$nspac 284s > 284s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 284s > 284s > fred <- my.path 284s > k <- ncol(fred) 284s > 284s > foom <- array(as.vector(t(fred)), c(k, out.metro$blen, out.metro$nbatch)) 284s > boom <- t(apply(foom, c(1, 3), mean)) 284s > 284s > all(dim(boom) == dim(out.metro$batch)) 284s [1] TRUE 284s > max(abs(boom - out.metro$batch)) < epsilon 284s [1] TRUE 284s > 284s > 284s BEGIN TEST tests/morph.R 284s 284s R version 4.4.3 (2025-02-28) -- "Trophy Case" 284s Copyright (C) 2025 The R Foundation for Statistical Computing 284s Platform: aarch64-unknown-linux-gnu 284s 284s R is free software and comes with ABSOLUTELY NO WARRANTY. 284s You are welcome to redistribute it under certain conditions. 284s Type 'license()' or 'licence()' for distribution details. 284s 284s R is a collaborative project with many contributors. 284s Type 'contributors()' for more information and 284s 'citation()' on how to cite R or R packages in publications. 284s 284s Type 'demo()' for some demos, 'help()' for on-line help, or 284s 'help.start()' for an HTML browser interface to help. 284s Type 'q()' to quit R. 284s 284s > library(mcmc) 284s > isotropic <- mcmc:::isotropic 284s > isotropic.logjacobian <- mcmc:::isotropic.logjacobian 284s > 284s > # make sure morph identity works properly 284s > TestMorphIdentity <- function(m.id) { 284s + ident.func <- function(x) x 284s + if (!all.equal(m.id$transform(1:10), 1:10)) 284s + return(FALSE) 284s + if (!all.equal(m.id$inverse(1:10), 1:10)) 284s + return(FALSE) 284s + x <- seq(-1,1, length.out=15) 284s + if (!all.equal(sapply(x, m.id$lud(function(x) dnorm(x, log=TRUE))), 284s + dnorm(x, log=TRUE))) 284s + return(FALSE) 284s + if (!all.equal(m.id$outfun(ident.func)(x), x)) 284s + return(FALSE) 284s + return(TRUE) 284s + } 284s > 284s > TestMorphIdentity(morph()) 284s [1] TRUE 284s > TestMorphIdentity(morph.identity()) 284s [1] TRUE 284s > 284s > TestMorphIdentityOutfun <- function(m) { 284s + f <- m$outfun(NULL) 284s + x <- 1:20 284s + if (!identical(x, f(x))) 284s + return(FALSE) 284s + f <- m$outfun(c(6, 8)) 284s + if (!identical(x[c(6, 8)], f(x))) 284s + return(FALSE) 284s + i <- rep(FALSE, 20) 284s + i[c(1, 3, 5)] <- TRUE 284s + f <- m$outfun(i) 284s + if (!identical(x[i], f(x))) 284s + return(FALSE) 284s + return(TRUE) 284s + } 284s > 284s > TestMorphIdentityOutfun(morph()) 284s [1] TRUE 284s > TestMorphIdentityOutfun(morph.identity()) 284s [1] TRUE 284s > 284s > # make sure that morph and morph.identity give back the same things 284s > all.equal(sort(names(morph.identity())), sort(names(morph(b=1)))) 284s [1] TRUE 284s > 284s > # test center parameter, univariate version 284s > zero.func <- function(x) 0 284s > center <- 2 284s > x <- seq(-1,1, length.out=15) 284s > morph.center <- morph(center=center) 284s > all.equal(sapply(x, morph.center$transform), x-center) 284s [1] TRUE 284s > all.equal(sapply(x, morph.center$inverse), x+center) 284s [1] TRUE 284s > all.equal(sapply(x, morph.center$lud(function(y) dnorm(y, log=TRUE))), 284s + dnorm(x, log=TRUE, mean=-2)) 284s [1] TRUE 284s > 284s > # test center parameter, multivariate version 284s > center <- 1:4 284s > x <- rep(0, 4) 284s > morph.center <- morph(center=center) 284s > lud.mult.dnorm <- function(x) prod(dnorm(x, log=TRUE)) 284s > all.equal(morph.center$transform(x), x-center) 284s [1] TRUE 284s > all.equal(morph.center$inverse(x), x+center) 284s [1] TRUE 284s > all.equal(morph.center$lud(lud.mult.dnorm)(x), 284s + lud.mult.dnorm(x - center)) 284s [1] TRUE 284s > # test 'r'. 284s > r <- 1 284s > morph.r <- morph(r=r) 284s > x <- seq(-1, 1, length.out=20) 284s > all.equal(sapply(x, morph.r$lud(function(x) dnorm(x, log=TRUE))), 284s + dnorm(x, log=TRUE)) 284s [1] TRUE 284s > x <- seq(1.1, 2, length.out=10) 284s > all(sapply(x, morph.r$lud(function(x) dnorm(x, log=TRUE))) 284s + != 284s + dnorm(x, log=TRUE)) 284s [1] TRUE 284s > 284s > TestExponentialEvenPWithRInverse <- function() { 284s + r <- 0.3 284s + p <- 2.2 284s + morph.r <- morph(r=r, p=p) 284s + x <- seq(0, r, length.out=20) 284s + all.equal(x, sapply(x, morph.r$inverse)) 284s + } 284s > 284s > TestExponentialEvenPWithRInverse() 284s [1] TRUE 284s > 284s > # make sure morph$lud passes '...' arguments. 284s > mean <- 2 284s > ident.morph <- morph() 284s > dnorm.morph <- ident.morph$lud(function(x, mean=0) 284s + dnorm(x, mean=mean, log=TRUE)) 284s > all.equal(dnorm.morph(2, mean), dnorm(2, mean=mean, log=TRUE)) 284s [1] TRUE 284s > x <- seq(-3, 3, length.out=20) 284s > m2 <- morph(r=10) 284s > dnorm.morph <- m2$lud(function(x, mean) 284s + dnorm(x, mean=mean, log=TRUE)) 284s > all.equal(sapply(x, function(y) dnorm.morph(y, 2)), 284s + dnorm(x, mean=2, log=TRUE)) 284s [1] TRUE 284s > 284s > # make sure morph$outfun passes '...' arguments. 284s > outfun.orig <- function(x, mean) x + mean 284s > ident.morph <- morph() 284s > mean <- 1 284s > outfun.morph <- ident.morph$outfun(outfun.orig) 284s > all.equal(outfun.morph(1:10, mean), 1:10+mean) 284s [1] TRUE 284s > 284s > m2 <- morph(r=10) 284s > outfun.morph <- m2$outfun(outfun.orig) 284s > all.equal(sapply(1:10, function(x) outfun.morph(x, mean)), 1:10+mean) 284s [1] TRUE 284s > 284s > ########################################################################### 284s > # test built-in exponential and polynomial transformations. 284s > f <- morph(b=3) 284s > x <- seq(0, 10, length.out=100) 284s > all.equal(x, sapply(sapply(x, f$transform), f$inverse)) 284s [1] TRUE 284s > 284s > f <- morph(p=3) 284s > all.equal(x, sapply(sapply(x, f$transform), f$inverse)) 284s [1] TRUE 284s > 284s > f <- morph(p=3, r=10) 284s > all.equal(-10:10, Vectorize(f$transform)(-10:10)) 284s [1] TRUE 284s > 284s > f <- morph(p=3, b=1) 284s > all.equal(x, sapply(sapply(x, f$transform), f$inverse)) 284s [1] TRUE 284s > 284s BEGIN TEST tests/morph.metrop.R 284s 284s R version 4.4.3 (2025-02-28) -- "Trophy Case" 284s Copyright (C) 2025 The R Foundation for Statistical Computing 284s Platform: aarch64-unknown-linux-gnu 284s 284s R is free software and comes with ABSOLUTELY NO WARRANTY. 284s You are welcome to redistribute it under certain conditions. 284s Type 'license()' or 'licence()' for distribution details. 284s 284s R is a collaborative project with many contributors. 284s Type 'contributors()' for more information and 284s 'citation()' on how to cite R or R packages in publications. 284s 284s Type 'demo()' for some demos, 'help()' for on-line help, or 284s 'help.start()' for an HTML browser interface to help. 284s Type 'q()' to quit R. 284s 284s > library(mcmc) 284s > 284s > .morph.unmorph <- mcmc:::.morph.unmorph 284s > 284s > ########################################################################### 284s > # basic functionality check, can morph.metro run? Can we change the 284s > # transformation? 284s > set.seed(42) 284s > obj <- morph.metrop(function(x) dt(x, df=3, log=TRUE), 284s + 100, 100, morph=morph(b=3)) 284s > obj <- morph.metrop(obj, morph=morph(b=1)) 284s > 284s > obj <- morph.metrop(function(x) prod(dt(x, df=3, log=TRUE)), 284s + rep(100, 3), 100, morph=morph(p=3, b=1)) 284s > obj <- morph.metrop(obj, morph=morph(r=1, p=3, b=1)) 285s > 285s > all.equal(class(obj), c("mcmc", "morph.metropolis")) 285s [1] TRUE 285s > 285s > ########################################################################### 285s > # check .morph.unmorph 285s > obj <- list(final=10) 285s > outfun <- function(x) x 285s > m <- morph(p=3) 285s > obj <- .morph.unmorph(obj, m, outfun) 285s > all.equal(class(obj), c("mcmc", "morph.metropolis")) 285s [1] TRUE 285s > all.equal(sort(names(obj)), 285s + sort(c("final", "morph", "morph.final", "outfun"))) 285s [1] TRUE 285s > all.equal(c(obj$final, obj$morph.final), c(m$inverse(10), 10)) 285s [1] TRUE 285s > all.equal(obj$outfun, outfun) 285s [1] TRUE 285s > all.equal(obj$morph, m) 285s [1] TRUE 285s > 285s BEGIN TEST tests/morphtoo.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: aarch64-unknown-linux-gnu 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 > x <- seq(0, 10, length = 10001) 285s > 285s > ### sub-exponentially light transformation 285s > 285s > b <- 0.5 285s > fsub <- morph(b = b) 285s > 285s > y <- unlist(Map(fsub$inverse, x)) 285s > 285s > myfsub <- function(x) ifelse(x > 1 / b, exp(b * x) - exp(1) / 3, 285s + (x * b)^3 * exp(1) / 6 + x * b * exp(1) / 2) 285s > y2 <- myfsub(x) 285s > all.equal(y, y2, tolerance = 1e-14) 285s [1] TRUE 285s > 285s > z <- unlist(Map(fsub$transform, y)) 285s > all.equal(z, x, tolerance = 1e-14) 285s [1] TRUE 285s > 285s > ### exponentially light transformation 285s > 285s > r <- 5 285s > p <- 3 285s > fp3 <- morph(r = r) 285s > 285s > y <- unlist(Map(fp3$inverse, x)) 285s > 285s > myfp3 <- function(x) ifelse(x < r, x, x + (x - r)^p) 285s > y2 <- myfp3(x) 285s > all.equal(y, y2, tolerance = 1e-14) 285s [1] TRUE 285s > 285s > z <- unlist(Map(fp3$transform, y)) 285s > all.equal(z, x, tolerance = 1e-12) 285s [1] TRUE 285s > 285s > ### both together 285s > 285s > fboth <- morph(b = b, r = r) 285s > 285s > y <- unlist(Map(fboth$inverse, x)) 285s > y2 <- myfsub(myfp3(x)) 285s > all.equal(y, y2, tolerance = 1e-14) 285s [1] TRUE 285s > 285s > z <- unlist(Map(fboth$transform, y)) 285s > all.equal(z, x, tolerance = 1e-12) 285s [1] TRUE 285s > 285s > ### exponentially light transformation with p != 3 285s > 285s > r <- 5 285s > p <- 2.2 285s > fpo <- morph(r = r, p = p) 285s > 285s > y <- unlist(Map(fpo$inverse, x)) 285s > 285s > myfpo <- function(x) ifelse(x < r, x, x + (x - r)^p) 285s > y2 <- myfpo(x) 285s > all.equal(y, y2, tolerance = 1e-14) 285s [1] TRUE 285s > 285s > z <- unlist(Map(fpo$transform, y)) 286s > all.equal(z, x, tolerance = 1e-14) 286s [1] TRUE 286s > 286s > 286s BEGIN TEST tests/saveseed.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: aarch64-unknown-linux-gnu 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 > h <- function(x) if (all(x >= 0) && sum(x) <= 1) return(1) else return(-Inf) 286s > out <- metrop(h, initial = rep(0, 5), nbatch = 100, blen = 17, nspac = 3, 286s + scale = 0.1) 286s > 286s > save.seed <- .Random.seed 286s > 286s > out1 <- metrop(out) 286s > out2 <- metrop(out1) 286s > out3 <- metrop(out, nbatch = 2 * out$nbatch) 286s > 286s > fred <- rbind(out1$batch, out2$batch) 286s > identical(fred, out3$batch) 286s [1] TRUE 286s > 286s > 286s BEGIN TEST tests/saveseedmorph.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: aarch64-unknown-linux-gnu 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 > h <- function(x) if (all(x >= 0) && sum(x) <= 1) return(1) else return(-Inf) 286s > out <- morph.metrop(obj = h, initial = rep(0, 5), nbatch = 100, blen = 17, 286s + nspac = 3, scale = 0.1) 286s > 286s > out1 <- morph.metrop(out) 286s > out2 <- morph.metrop(out1) 286s > out3 <- morph.metrop(out, nbatch = 2 * out$nbatch) 286s > 286s > fred <- rbind(out1$batch, out2$batch) 286s > identical(fred, out3$batch) 286s [1] TRUE 286s > 286s > out <- morph.metrop(out, morph = morph(p = 2.2, r = 0.3)) 286s > 286s > out1 <- morph.metrop(out) 286s > out2 <- morph.metrop(out1) 286s > out3 <- morph.metrop(out, nbatch = 2 * out$nbatch) 286s > 286s > fred <- rbind(out1$batch, out2$batch) 286s > identical(fred, out3$batch) 286s [1] TRUE 286s > 286s > 286s BEGIN TEST tests/temp-par-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: aarch64-unknown-linux-gnu 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 287s > 287s > if ((! exists("DEBUG")) || (! identical(DEBUG, TRUE))) DEBUG <- FALSE 287s > 287s > library(mcmc) 287s > 287s > options(digits=4) # avoid rounding differences 287s > 287s > set.seed(42) 287s > 287s > save.initial.seed <- .Random.seed 287s > 287s > d <- 3 287s > witch.which <- 1 - (1 / 2)^(1 / d) * (1 / 4)^(seq(0, 5) / d) 287s > witch.which 287s [1] 0.2063 0.5000 0.6850 0.8016 0.8750 0.9213 287s > 287s > ncomp <- length(witch.which) 287s > 287s > neighbors <- matrix(FALSE, ncomp, ncomp) 287s > neighbors[row(neighbors) == col(neighbors) + 1] <- TRUE 287s > neighbors[row(neighbors) == col(neighbors) - 1] <- TRUE 287s > neighbors[row(neighbors) == col(neighbors) + 2] <- TRUE 287s > neighbors[row(neighbors) == col(neighbors) - 2] <- TRUE 287s > 287s > ludfun <- function(state) { 287s + stopifnot(is.numeric(state)) 287s + stopifnot(length(state) == d + 1) 287s + icomp <- state[1] 287s + stopifnot(icomp == as.integer(icomp)) 287s + stopifnot(1 <= icomp && icomp <= ncomp) 287s + theta <- state[-1] 287s + if (any(abs(theta) > 1.0)) return(-Inf) 287s + bnd <- witch.which[icomp] 287s + if(bnd >= 1.0) 287s + stop(sprintf("witch.which[%d] >= 1.0", icomp)) 287s + if(bnd <= 0.0) 287s + stop(sprintf("witch.which[%d] <= 0.0", icomp)) 287s + if (all(abs(theta) > bnd)) 287s + return(- (d + 1) * log(2) - d * log(1 - bnd)) 287s + return(- (d + 1) * log(2) - log1p(- (1 - bnd)^d)) 287s + } 287s > 287s > thetas <- matrix(0, ncomp, d) 287s > out <- temper(ludfun, initial = thetas, neighbors = neighbors, nbatch = 50, 287s + blen = 13, nspac = 7, scale = 0.3456789, parallel = TRUE, debug = DEBUG) 287s > 287s > names(out) 287s [1] "lud" "neighbors" "nbatch" "blen" "nspac" 287s [6] "scale" "outfun" "debug" "parallel" "initial.seed" 287s [11] "final.seed" "time" "batch" "acceptx" "accepti" 287s [16] "initial" "final" 287s > 287s > out$acceptx 287s [1] 0.6336 0.4974 0.3245 0.6022 0.6130 0.5914 287s > 287s > out$accepti 287s [,1] [,2] [,3] [,4] [,5] [,6] 287s [1,] NA 0.7051 0.5497 NA NA NA 287s [2,] 0.7523 NA 0.5547 0.6288 NA NA 287s [3,] 0.5794 0.5865 NA 0.5309 0.5476 NA 287s [4,] NA 0.6667 0.5506 NA 0.8272 0.6837 287s [5,] NA NA 0.5439 0.8926 NA 0.8374 287s [6,] NA NA NA 0.8391 0.9023 NA 287s > 287s > ### check that have prob 1 / 2 for corners 287s > 287s > outfun <- function(state) { 287s + stopifnot(is.matrix(state)) 287s + ncomp <- nrow(state) 287s + d <- ncol(state) 287s + foo <- sweep(abs(state), 1, witch.which) 287s + bar <- apply(foo > 0, 1, all) 287s + return(as.numeric(bar)) 287s + } 287s > 287s > out2 <- temper(out, outfun = outfun) 287s > 287s > colMeans(out2$batch) 287s [1] 0.54923 0.40923 0.39538 0.09692 0.12923 0.60000 287s > apply(out2$batch, 2, sd) / sqrt(out$nbatch) 287s [1] 0.03482 0.04817 0.05464 0.02856 0.02113 0.05131 287s > 287s > ### try again 287s > 287s > out3 <- temper(out2, blen = 103) 288s > 288s > foo <- cbind(colMeans(out3$batch), 288s + apply(out3$batch, 2, sd) / sqrt(out$nbatch)) 288s > colnames(foo) <- c("means", "MCSE") 288s > foo 288s means MCSE 288s [1,] 0.5231 0.01390 288s [2,] 0.5361 0.02213 288s [3,] 0.4905 0.03961 288s [4,] 0.5652 0.04909 288s [5,] 0.4056 0.05107 288s [6,] 0.2450 0.05108 288s > 288s > 288s BEGIN TEST tests/temp-par.R 288s 288s R version 4.4.3 (2025-02-28) -- "Trophy Case" 288s Copyright (C) 2025 The R Foundation for Statistical Computing 288s Platform: aarch64-unknown-linux-gnu 288s 288s R is free software and comes with ABSOLUTELY NO WARRANTY. 288s You are welcome to redistribute it under certain conditions. 288s Type 'license()' or 'licence()' for distribution details. 288s 288s R is a collaborative project with many contributors. 288s Type 'contributors()' for more information and 288s 'citation()' on how to cite R or R packages in publications. 288s 288s Type 'demo()' for some demos, 'help()' for on-line help, or 288s 'help.start()' for an HTML browser interface to help. 288s Type 'q()' to quit R. 288s 288s > 288s > library(mcmc) 288s > 288s > set.seed(42) 288s > 288s > data(foo) 288s > attach(foo) 288s > 288s > out <- glm(y ~ x1 + x2 + x3, family = binomial, x = TRUE) 288s > ## IGNORE_RDIFF_BEGIN 288s > summary(out) 288s 288s Call: 288s glm(formula = y ~ x1 + x2 + x3, family = binomial, x = TRUE) 288s 288s Coefficients: 288s Estimate Std. Error z value Pr(>|z|) 288s (Intercept) 0.5772 0.2766 2.087 0.036930 * 288s x1 0.3362 0.4256 0.790 0.429672 288s x2 0.8475 0.4701 1.803 0.071394 . 288s x3 1.5143 0.4426 3.422 0.000622 *** 288s --- 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 > betas <- NULL 289s > for (i in 1:nrow(models)) { 289s + inies <- as.logical(models[i, ]) 289s + foo <- exes[inies] 289s + bar <- paste("y ~", paste(foo, collapse = " + ")) 289s + if (! any(inies)) bar <- paste(bar, "1") 289s + baz <- glm(as.formula(bar), family = binomial) 289s + beta <- rep(0, 4) 289s + beta[c(TRUE, inies)] <- baz$coef 289s + betas <- rbind(betas, beta) 289s + } 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 > 289s > ludfun <- function(state, ...) { 289s + stopifnot(is.numeric(state)) 289s + stopifnot(length(state) == ncol(models) + 2) 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 + 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 289s + return(val) 289s + } 289s > 289s > ludval <- NULL 289s > for (i in 1:nrow(models)) ludval <- c(ludval, ludfun(c(i, betas[i, ]))) 289s > all(is.finite(ludval)) 289s [1] TRUE 289s > 289s > 289s > out <- temper(ludfun, initial = betas, neighbors = neighbors, nbatch = 20, 289s + blen = 10, nspac = 5, scale = 0.56789, parallel = TRUE, debug = TRUE) 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" "which" "unif.which" "state" 289s [21] "log.hastings" "unif.hastings" "proposal" "acceptd" 289s [25] "norm" "unif.choose" "coproposal" 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$coproposal[ , 1]) 289s [1] TRUE 289s > 289s > ### check proposal and coproposal are actually current state or part thereof 289s > 289s > prop <- out$proposal 289s > coprop <- out$coproposal 289s > prop.i <- prop[ , 1] 289s > coprop.i <- coprop[ , 1] 289s > alt.prop <- prop 289s > alt.coprop <- coprop 289s > for (i in 1:nrow(prop)) { 289s + alt.prop[i, ] <- c(prop.i[i], out$state[i, prop.i[i], ]) 289s + alt.coprop[i, ] <- c(coprop.i[i], out$state[i, coprop.i[i], ]) 289s + } 289s > identical(coprop, alt.coprop) 289s [1] TRUE 289s > identical(prop[! out$which, ], alt.prop[! out$which, ]) 289s [1] TRUE 289s > identical(prop[out$which, 1], alt.prop[out$which, 1]) 289s [1] TRUE 289s > 289s > ### check hastings ratio calculated correctly 289s > 289s > foo <- apply(prop, 1, ludfun) 289s > fooco <- apply(coprop, 1, ludfun) 289s > prop[ , 1] <- out$coproposal[ , 1] 289s > coprop[ , 1] <- out$proposal[ , 1] 289s > foo.swap <- apply(prop, 1, ludfun) 289s > fooco.swap <- apply(coprop, 1, ludfun) 289s > log.haste <- ifelse(out$which, foo - fooco, 289s + foo.swap + fooco.swap - foo - fooco) 289s > all.equal(log.haste, out$log.hastings) 289s [1] TRUE 289s > 289s > ### check hastings rejection decided correctly 289s > 289s > identical(out$log.hastings >= 0, is.na(out$unif.hastings)) 289s [1] TRUE 289s > all(out$log.hastings < 0 | out$acceptd) 289s [1] TRUE 289s > identical(out$acceptd, 289s + out$log.hastings >= 0 | out$unif.hastings < exp(out$log.hastings)) 289s [1] TRUE 289s > 289s > ### check acceptance carried out or not (according to decision) correctly 289s > 289s > before <- out$state 289s > after <- before 289s > after[- dim(after)[1], , ] <- before[-1, , ] 289s > after[dim(after)[1], , ] <- out$final 289s > my.after <- before 289s > for (i in 1:length(out$acceptd)) { 289s + if (out$acceptd[i]) { 289s + if (out$which[i]) { 289s + j <- out$proposal[i, 1] 289s + my.after[i, j, ] <- out$proposal[i, -1] 289s + } else { 289s + j <- out$proposal[i, 1] 289s + k <- out$coproposal[i, 1] 289s + my.after[i, j, ] <- out$coproposal[i, -1] 289s + my.after[i, k, ] <- out$proposal[i, -1] 289s + } 289s + } 289s + } 289s > identical(after, my.after) 289s [1] TRUE 289s > 289s > ### check within-component proposal 289s > 289s > my.coproposal.within <- out$coproposal[out$which, ] 289s > proposal.within <- out$proposal[out$which, ] 289s > my.z <- out$norm[out$which, ] 289s > my.proposal.within <- my.coproposal.within 289s > my.proposal.within[ , -1] <- my.coproposal.within[ , -1] + out$scale * my.z 289s > all.equal(proposal.within, my.proposal.within) 289s [1] TRUE 289s > 289s > my.unif.choose <- out$unif.choose[out$which, 1] 289s > my.i <- floor(nrow(models) * my.unif.choose) + 1 289s > all(1 <= my.i & my.i <= nrow(models)) 289s [1] TRUE 289s > identical(my.i, my.coproposal.within[ , 1]) 289s [1] TRUE 289s > 289s > ### check swap proposal 289s > 289s > coproposal.swap <- out$coproposal[! out$which, ] 289s > proposal.swap <- out$proposal[! out$which, ] 289s > unif.choose.swap <- out$unif.choose[! out$which, ] 289s > my.i <- floor(nrow(models) * unif.choose.swap[ , 1]) + 1 289s > nneighbors <- apply(out$neighbors, 1, sum) 289s > my.nneighbors <- nneighbors[my.i] 289s > my.k <- floor(my.nneighbors * unif.choose.swap[ , 2]) + 1 289s > my.j <- my.k 289s > foo <- seq(1, ncol(out$neighbors)) 289s > for (i in seq(along = my.j)) { 289s + my.j[i] <- (foo[out$neighbors[my.i[i], ]])[my.k[i]] 289s + } 289s > identical(coproposal.swap[ , 1], my.i) 289s [1] TRUE 289s > identical(proposal.swap[ , 1], my.j) 289s [1] TRUE 289s > 289s > ### check standard normal and uniform random numbers are as purported 289s > 289s > save.Random.seed <- .Random.seed 289s > .Random.seed <- out$initial.seed 289s > 289s > nx <- ncol(out$initial) 289s > niter <- out$nbatch * out$blen * out$nspac 289s > my.norm <- matrix(NA, nrow = nrow(out$norm), ncol = ncol(out$norm)) 289s > my.unif.which <- rep(NA, niter) 289s > my.unif.hastings <- rep(NA, niter) 289s > my.unif.choose <- matrix(NA, niter, 2) 289s > for (iiter in 1:niter) { 289s + my.unif.which[iiter] <- runif(1) 289s + if (out$which[iiter]) { 289s + my.unif.choose[iiter, 1] <- runif(1) 289s + my.norm[iiter, ] <- rnorm(nx) 289s + if (out$log.hastings[iiter] < 0) my.unif.hastings[iiter] <- runif(1) 289s + } else { 289s + my.unif.choose[iiter, ] <- runif(2) 289s + if (out$log.hastings[iiter] < 0) my.unif.hastings[iiter] <- runif(1) 289s + } 289s + } 289s > identical(my.norm, out$norm) 289s [1] TRUE 289s > identical(my.unif.which, out$unif.which) 289s [1] TRUE 289s > identical(my.unif.hastings, out$unif.hastings) 289s [1] TRUE 289s > identical(my.unif.choose, out$unif.choose) 289s [1] TRUE 289s > 289s > .Random.seed <- save.Random.seed 289s > 289s > ### check batch means 289s > 289s > foo <- after[seq(1, niter) %% out$nspac == 0, , ] 289s > foo <- array(as.vector(foo), dim = c(out$blen, out$nbatch, dim(foo)[2:3])) 289s > foo <- apply(foo, c(2, 3, 4), mean) 289s > all.equal(foo, out$batch) 289s [1] TRUE 289s > 289s > ### check acceptance rates 289s > 289s > accept.within <- out$acceptd[out$which] 289s > my.i.within <- out$coproposal[out$which, 1] 289s > my.acceptx <- as.vector(sapply(split(accept.within, my.i.within), mean)) 289s > identical(my.acceptx, out$acceptx) 289s [1] TRUE 289s > 289s > accept.swap <- out$acceptd[! out$which] 289s > my.i.swap <- out$coproposal[! out$which, 1] 289s > my.j.swap <- out$proposal[! out$which, 1] 289s > nmodel <- nrow(out$neighbors) 289s > my.accepti <- matrix(NA, nmodel, nmodel) 289s > for (i in 1:nmodel) { 289s + for (j in 1:nmodel) { 289s + if (out$neighbors[i, j]) { 289s + my.accepti[i, j] <- 289s + mean(accept.swap[my.i.swap == i & my.j.swap == j]) 289s + } 289s + } 289s + } 289s > identical(my.accepti, out$accepti) 289s [1] TRUE 289s > 289s > ### check scale vector 289s > 289s > nx <- ncol(models) + 1 289s > newscale <- rnorm(nx, 0.5, 0.1) 289s > 289s > out <- temper(out, scale = newscale) 289s > 289s > my.coproposal.within <- out$coproposal[out$which, ] 289s > proposal.within <- out$proposal[out$which, ] 289s > my.z <- out$norm[out$which, ] 289s > my.proposal.within <- my.coproposal.within 289s > my.proposal.within[ , -1] <- my.coproposal.within[ , -1] + 289s + sweep(my.z, 2, out$scale, "*") 289s > all.equal(proposal.within, my.proposal.within) 289s [1] TRUE 289s > 289s > ### check scale matrix 289s > 289s > matscale <- matrix(rnorm(nx * nx, 0.0, 0.1), nx, nx) 289s > diag(matscale) <- 0.56789 289s > 289s > out <- temper(out, scale = matscale) 289s > 289s > my.coproposal.within <- out$coproposal[out$which, ] 289s > proposal.within <- out$proposal[out$which, ] 289s > my.z <- out$norm[out$which, ] 289s > my.proposal.within <- my.coproposal.within 289s > my.proposal.within[ , -1] <- my.coproposal.within[ , -1] + 289s + my.z %*% t(out$scale) 289s > all.equal(proposal.within, my.proposal.within) 289s [1] TRUE 289s > 289s > ### check scale list 289s > 289s > lisztscale <- list(0.56789, newscale, matscale, matscale, newscale, 289s + 0.98765, 0.98765, newscale) 289s > 289s > out <- temper(out, scale = lisztscale) 289s > 289s > my.coproposal.within <- out$coproposal[out$which, ] 289s > proposal.within <- out$proposal[out$which, ] 289s > my.z <- out$norm[out$which, ] 289s > my.proposal.within <- my.coproposal.within 289s > for (iiter in 1:nrow(my.z)) { 289s + my.i <- my.coproposal.within[iiter, 1] 289s + my.scale <- out$scale[[my.i]] 289s + if (is.matrix(my.scale)) { 289s + my.proposal.within[iiter, -1] <- my.coproposal.within[iiter, -1] + 289s + my.z[iiter, , drop = FALSE] %*% t(my.scale) 289s + } else { 289s + my.proposal.within[iiter, -1] <- my.coproposal.within[iiter, -1] + 289s + my.z[iiter, ] * my.scale 289s + } 289s + } 289s > all.equal(proposal.within, my.proposal.within) 289s [1] TRUE 289s > 289s > ### check outfun 289s > 289s > outfun <- function(state, icomp, ...) { 289s + stopifnot(is.matrix(state)) 289s + stopifnot(is.numeric(state)) 289s + nx <- ncol(betas) 289s + ncomp <- nrow(betas) 289s + stopifnot(ncol(state) == nx) 289s + stopifnot(nrow(state) == ncomp) 289s + stopifnot(1 <= icomp && icomp <= ncomp) 289s + foo <- state[icomp, ] 289s + bar <- foo^2 289s + return(c(foo, bar)) 289s + } 289s > 289s > out <- temper(out, outfun = outfun, icomp = 4) 290s > 290s > before <- out$state 290s > after <- before 290s > after[- dim(after)[1], , ] <- before[-1, , ] 290s > after[dim(after)[1], , ] <- out$final 290s > outies <- apply(after, 1, outfun, icomp = 4) 290s > outies <- t(outies) 290s > 290s > foo <- outies[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 > 290s BEGIN TEST tests/temp-ser-witch.R 290s 290s R version 4.4.3 (2025-02-28) -- "Trophy Case" 290s Copyright (C) 2025 The R Foundation for Statistical Computing 290s Platform: aarch64-unknown-linux-gnu 290s 290s R is free software and comes with ABSOLUTELY NO WARRANTY. 290s You are welcome to redistribute it under certain conditions. 290s Type 'license()' or 'licence()' for distribution details. 290s 290s R is a collaborative project with many contributors. 290s Type 'contributors()' for more information and 290s 'citation()' on how to cite R or R packages in publications. 290s 290s Type 'demo()' for some demos, 'help()' for on-line help, or 290s 'help.start()' for an HTML browser interface to help. 290s Type 'q()' to quit R. 290s 290s > 290s > library(mcmc) 290s > 290s > set.seed(42) 290s > 290s > d <- 3 290s > witch.which <- 1 - (1 / 2)^(1 / d) * (1 / 4)^(seq(0, 5) / d) 290s > witch.which 290s [1] 0.2062995 0.5000000 0.6850197 0.8015749 0.8750000 0.9212549 290s > 290s > ncomp <- length(witch.which) 290s > 290s > neighbors <- matrix(FALSE, ncomp, ncomp) 290s > neighbors[row(neighbors) == col(neighbors) + 1] <- TRUE 290s > neighbors[row(neighbors) == col(neighbors) - 1] <- TRUE 290s > neighbors[row(neighbors) == col(neighbors) + 2] <- TRUE 290s > neighbors[row(neighbors) == col(neighbors) - 2] <- TRUE 290s > 290s > ludfun <- function(state) { 290s + stopifnot(is.numeric(state)) 290s + stopifnot(length(state) == d + 1) 290s + icomp <- state[1] 290s + stopifnot(icomp == as.integer(icomp)) 290s + stopifnot(1 <= icomp && icomp <= ncomp) 290s + theta <- state[-1] 290s + if (any(abs(theta) > 1.0)) return(-Inf) 290s + bnd <- witch.which[icomp] 290s + if(bnd >= 1.0) 290s + stop(sprintf("witch.which[%d] >= 1.0", icomp)) 290s + if(bnd <= 0.0) 290s + stop(sprintf("witch.which[%d] <= 0.0", icomp)) 290s + if (all(abs(theta) > bnd)) 290s + return(- (d + 1) * log(2) - d * log(1 - bnd)) 290s + return(- (d + 1) * log(2) - log1p(- (1 - bnd)^d)) 290s + } 290s > 290s > initial <- c(1, rep(0, d)) 290s > 290s > out <- temper(ludfun, initial = initial, neighbors = neighbors, 290s + nbatch = 50, blen = 13, nspac = 7, scale = 0.3456789) 290s > 290s > names(out) 290s [1] "lud" "neighbors" "nbatch" "blen" "nspac" 290s [6] "scale" "outfun" "debug" "parallel" "initial.seed" 290s [11] "final.seed" "time" "batch" "acceptx" "accepti" 290s [16] "initial" "final" "ibatch" 290s > 290s > out$acceptx 290s [1] 0.6388889 0.4385246 0.3631714 0.4885246 0.4709677 0.4735516 290s > 290s > out$accepti 290s [,1] [,2] [,3] [,4] [,5] [,6] 290s [1,] NA 0.5071770 0.2727273 NA NA NA 290s [2,] 0.7070064 NA 0.4355828 0.4186047 NA NA 290s [3,] 0.5816327 0.8039216 NA 0.5888889 0.5662651 NA 290s [4,] NA 0.7415730 0.8571429 NA 0.7857143 0.6626506 290s [5,] NA NA 0.5204082 0.6516854 NA 0.8378378 290s [6,] NA NA NA 0.3515152 0.5056818 NA 290s > 290s > colMeans(out$ibatch) 290s [1] 0.1830769 0.2153846 0.1630769 0.1369231 0.1353846 0.1661538 290s > 290s > ### check that have prob 1 / 2 for corners 290s > 290s > outfun <- function(state) { 290s + stopifnot(is.numeric(state)) 290s + icomp <- state[1] 290s + stopifnot(icomp == as.integer(icomp)) 290s + stopifnot(1 <= icomp && icomp <= length(witch.which)) 290s + theta <- state[-1] 290s + foo <- all(abs(theta) > witch.which[icomp]) 290s + bar <- rep(0, length(witch.which)) 290s + baz <- rep(0, length(witch.which)) 290s + bar[icomp] <- as.numeric(foo) 290s + baz[icomp] <- 1 290s + return(c(bar, baz)) 290s + } 290s > 290s > out <- temper(out, blen = 103, outfun = outfun, debug = TRUE) 291s > 291s > eta.batch <- out$batch[ , seq(1, ncomp)] 291s > noo.batch <- out$batch[ , seq(ncomp + 1, ncomp + ncomp)] 291s > eta <- colMeans(eta.batch) 291s > noo <- colMeans(noo.batch) 291s > mu <- eta / noo 291s > eta 291s [1] 0.06660194 0.06388350 0.05766990 0.06563107 0.10368932 0.22912621 291s > noo 291s [1] 0.1365049 0.1258252 0.1293204 0.1370874 0.1716505 0.2996117 291s > mu 291s [1] 0.4879090 0.5077160 0.4459459 0.4787535 0.6040724 0.7647440 291s > 291s > eta.batch.rel <- sweep(eta.batch, 2, eta, "/") 291s > noo.batch.rel <- sweep(noo.batch, 2, noo, "/") 291s > mu.batch.rel <- eta.batch.rel - noo.batch.rel 291s > 291s > mu.mcse.rel <- apply(mu.batch.rel, 2, sd) / sqrt(out$nbatch) 291s > mu.mcse.rel 291s [1] 0.05010927 0.07897321 0.09678339 0.12636113 0.11261781 0.07082685 291s > 291s > foo <- cbind(mu, mu * mu.mcse.rel) 291s > colnames(foo) <- c("means", "MCSE") 291s > foo 291s means MCSE 291s [1,] 0.4879090 0.02444876 291s [2,] 0.5077160 0.04009596 291s [3,] 0.4459459 0.04316016 291s [4,] 0.4787535 0.06049584 291s [5,] 0.6040724 0.06802931 291s [6,] 0.7647440 0.05416441 291s > 291s > ### check decision about within-component or jump/swap 291s > 291s > identical(out$unif.which < 0.5, out$which) 291s [1] TRUE 291s > 291s > identical(out$which, out$proposal[ , 1] == out$state[ , 1]) 291s [1] TRUE 291s > 291s > ### check hastings ratio calculated correctly 291s > 291s > n <- apply(neighbors, 1, sum) 291s > i <- out$state[ , 1] 291s > istar <- out$proposal[ , 1] 291s > foo <- apply(out$state, 1, ludfun) 291s > bar <- apply(out$proposal, 1, ludfun) 292s > my.log.hastings <- bar - foo - log(n[istar]) + log(n[i]) 292s > all.equal(my.log.hastings, out$log.hastings) 292s [1] TRUE 292s > 292s > 292s BEGIN TEST tests/temp-ser.R 292s 292s R version 4.4.3 (2025-02-28) -- "Trophy Case" 292s Copyright (C) 2025 The R Foundation for Statistical Computing 292s Platform: aarch64-unknown-linux-gnu 292s 292s R is free software and comes with ABSOLUTELY NO WARRANTY. 292s You are welcome to redistribute it under certain conditions. 292s Type 'license()' or 'licence()' for distribution details. 292s 292s R is a collaborative project with many contributors. 292s Type 'contributors()' for more information and 292s 'citation()' on how to cite R or R packages in publications. 292s 292s Type 'demo()' for some demos, 'help()' for on-line help, or 292s 'help.start()' for an HTML browser interface to help. 292s Type 'q()' to quit R. 292s 292s > 292s > library(mcmc) 292s > 292s > set.seed(42) 292s > 292s > data(foo) 292s > attach(foo) 292s > 292s > out <- glm(y ~ x1 + x2 + x3, family = binomial, x = TRUE) 292s > ## IGNORE_RDIFF_BEGIN 292s > summary(out) 292s 292s Call: 292s glm(formula = y ~ x1 + x2 + x3, family = binomial, x = TRUE) 292s 292s Coefficients: 292s Estimate Std. Error z value Pr(>|z|) 292s (Intercept) 0.5772 0.2766 2.087 0.036930 * 292s x1 0.3362 0.4256 0.790 0.429672 292s x2 0.8475 0.4701 1.803 0.071394 . 292s x3 1.5143 0.4426 3.422 0.000622 *** 292s --- 292s Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 292s 292s (Dispersion parameter for binomial family taken to be 1) 292s 292s Null deviance: 134.602 on 99 degrees of freedom 292s Residual deviance: 86.439 on 96 degrees of freedom 292s AIC: 94.439 292s 292s Number of Fisher Scoring iterations: 5 292s 292s > ## IGNORE_RDIFF_END 292s > 292s > modmat <- out$x 292s > 292s > models <- cbind(rep(0:1, each = 4), rep(rep(0:1, times = 2), each = 2), 292s + rep(0:1, times = 4)) 292s > 292s > exes <- paste("x", 1:3, sep = "") 292s > models[nrow(models), ] 292s [1] 1 1 1 292s > beta.initial <- c(nrow(models), out$coefficients) 292s > 292s > neighbors <- matrix(FALSE, nrow(models), nrow(models)) 292s > for (i in 1:nrow(neighbors)) { 292s + for (j in 1:ncol(neighbors)) { 292s + foo <- models[i, ] 292s + bar <- models[j, ] 292s + if (sum(foo != bar) == 1) neighbors[i, j] <- TRUE 292s + } 292s + } 292s > neighbors 292s [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] 292s [1,] FALSE TRUE TRUE FALSE TRUE FALSE FALSE FALSE 292s [2,] TRUE FALSE FALSE TRUE FALSE TRUE FALSE FALSE 292s [3,] TRUE FALSE FALSE TRUE FALSE FALSE TRUE FALSE 292s [4,] FALSE TRUE TRUE FALSE FALSE FALSE FALSE TRUE 292s [5,] TRUE FALSE FALSE FALSE FALSE TRUE TRUE FALSE 292s [6,] FALSE TRUE FALSE FALSE TRUE FALSE FALSE TRUE 292s [7,] FALSE FALSE TRUE FALSE TRUE FALSE FALSE TRUE 292s [8,] FALSE FALSE FALSE TRUE FALSE TRUE TRUE FALSE 292s > 292s > ludfun <- function(state, log.pseudo.prior, ...) { 292s + stopifnot(is.numeric(state)) 292s + stopifnot(length(state) == ncol(models) + 2) 292s + icomp <- state[1] 292s + stopifnot(icomp == as.integer(icomp)) 292s + stopifnot(1 <= icomp && icomp <= nrow(models)) 292s + stopifnot(is.numeric(log.pseudo.prior)) 292s + stopifnot(length(log.pseudo.prior) == nrow(models)) 292s + beta <- state[-1] 292s + inies <- c(TRUE, as.logical(models[icomp, ])) 292s + beta.logl <- beta 292s + beta.logl[! inies] <- 0 292s + eta <- as.numeric(modmat %*% beta.logl) 292s + logp <- ifelse(eta < 0, eta - log1p(exp(eta)), - log1p(exp(- eta))) 292s + logq <- ifelse(eta < 0, - log1p(exp(eta)), - eta - log1p(exp(- eta))) 292s + logl <- sum(logp[y == 1]) + sum(logq[y == 0]) 292s + val <- logl - sum(beta^2) / 2 + log.pseudo.prior[icomp] 292s + return(val) 292s + } 292s > 292s > qux <- c(25.01, 5.875, 9.028, 0.6959, 11.73, 2.367, 5.864, 0.0) 292s > 292s > out <- temper(ludfun, initial = beta.initial, neighbors = neighbors, 292s + nbatch = 25, blen = 20, nspac = 5, scale = 0.56789, debug = TRUE, 292s + log.pseudo.prior = qux) 292s > 292s > names(out) 292s [1] "lud" "neighbors" "nbatch" "blen" 292s [5] "nspac" "scale" "outfun" "debug" 292s [9] "parallel" "initial.seed" "final.seed" "time" 292s [13] "batch" "acceptx" "accepti" "initial" 292s [17] "final" "ibatch" "which" "unif.which" 292s [21] "state" "log.hastings" "unif.hastings" "proposal" 292s [25] "acceptd" "norm" "unif.choose" 292s > 292s > apply(out$ibatch, 2, mean) 292s [1] 0.776 0.170 0.000 0.006 0.024 0.010 0.004 0.010 292s > 292s > ### check decision about within-component or jump/swap 292s > 292s > identical(out$unif.which < 0.5, out$which) 292s [1] TRUE 292s > 292s > identical(out$which, out$proposal[ , 1] == out$state[ , 1]) 292s [1] TRUE 292s > 292s > ### check hastings ratio calculated correctly 292s > 292s > foo <- apply(out$state, 1, ludfun, log.pseudo.prior = qux) 293s > bar <- apply(out$proposal, 1, ludfun, log.pseudo.prior = qux) 293s > all.equal(bar - foo, out$log.hastings) 293s [1] TRUE 293s > 293s > ### check hastings rejection decided correctly 293s > 293s > identical(out$log.hastings >= 0, is.na(out$unif.hastings)) 293s [1] TRUE 293s > all(out$log.hastings < 0 | out$acceptd) 293s [1] TRUE 293s > identical(out$acceptd, 293s + out$log.hastings >= 0 | out$unif.hastings < exp(out$log.hastings)) 293s [1] TRUE 293s > 293s > ### check acceptance carried out or not (according to decision) correctly 293s > 293s > before <- out$state 293s > after <- before 293s > after[- dim(after)[1], ] <- before[-1, ] 293s > after[dim(after)[1], ] <- out$final 293s > my.after <- before 293s > my.after[out$acceptd, ] <- out$proposal[out$acceptd, ] 293s > identical(after, my.after) 293s [1] TRUE 293s > 293s > ### check within-component proposal 293s > 293s > my.coproposal.within <- out$state[out$which, ] 293s > proposal.within <- out$proposal[out$which, ] 293s > my.z <- out$norm[out$which, ] 293s > my.proposal.within <- my.coproposal.within 293s > my.proposal.within[ , -1] <- my.coproposal.within[ , -1] + out$scale * my.z 293s > all.equal(proposal.within, my.proposal.within) 293s [1] TRUE 293s > 293s > ### check swap proposal 293s > 293s > coproposal.swap <- out$state[! out$which, ] 293s > proposal.swap <- out$proposal[! out$which, ] 293s > unif.choose.swap <- out$unif.choose[! out$which] 293s > my.i <- coproposal.swap[ , 1] 293s > nneighbors <- apply(out$neighbors, 1, sum) 293s > my.nneighbors <- nneighbors[my.i] 293s > my.k <- floor(my.nneighbors * unif.choose.swap) + 1 293s > my.j <- my.k 293s > foo <- seq(1, ncol(out$neighbors)) 293s > for (i in seq(along = my.j)) { 293s + my.j[i] <- (foo[out$neighbors[my.i[i], ]])[my.k[i]] 293s + } 293s > identical(coproposal.swap[ , 1], my.i) 293s [1] TRUE 293s > identical(proposal.swap[ , 1], my.j) 293s [1] TRUE 293s > 293s > ### check standard normal and uniform random numbers are as purported 293s > 293s > save.Random.seed <- .Random.seed 293s > .Random.seed <- out$initial.seed 293s > 293s > nx <- length(out$initial) - 1 293s > niter <- out$nbatch * out$blen * out$nspac 293s > my.norm <- matrix(NA, nrow = nrow(out$norm), ncol = ncol(out$norm)) 293s > my.unif.which <- rep(NA, niter) 293s > my.unif.hastings <- rep(NA, niter) 293s > my.unif.choose <- rep(NA, niter) 293s > for (iiter in 1:niter) { 293s + my.unif.which[iiter] <- runif(1) 293s + if (out$which[iiter]) { 293s + my.norm[iiter, ] <- rnorm(nx) 293s + if (out$log.hastings[iiter] < 0) my.unif.hastings[iiter] <- runif(1) 293s + } else { 293s + my.unif.choose[iiter] <- runif(1) 293s + if (out$log.hastings[iiter] < 0) my.unif.hastings[iiter] <- runif(1) 293s + } 293s + } 293s > identical(my.norm, out$norm) 293s [1] TRUE 293s > identical(my.unif.which, out$unif.which) 293s [1] TRUE 293s > identical(my.unif.hastings, out$unif.hastings) 293s [1] TRUE 293s > identical(my.unif.choose, out$unif.choose) 293s [1] TRUE 293s > 293s > .Random.seed <- save.Random.seed 293s > 293s > ### check batch means 293s > 293s > my.xstate <- after[ , -1] 293s > foo <- my.xstate[seq(1, niter) %% out$nspac == 0, ] 293s > foo <- array(as.vector(foo), dim = c(out$blen, out$nbatch, dim(foo)[2])) 293s > foo <- apply(foo, c(2, 3), mean) 293s > all.equal(foo, out$batch) 293s [1] TRUE 293s > 293s > ### check ibatch means 293s > 293s > my.istate <- after[ , 1] 293s > my.istate.matrix <- matrix(0, length(my.istate), nrow(models)) 293s > for (i in 1:nrow(my.istate.matrix)) 293s + my.istate.matrix[i, my.istate[i]] <- 1 293s > foo <- my.istate.matrix[seq(1, niter) %% out$nspac == 0, ] 293s > foo <- array(as.vector(foo), dim = c(out$blen, out$nbatch, dim(foo)[2])) 293s > foo <- apply(foo, c(2, 3), mean) 293s > all.equal(foo, out$ibatch) 293s [1] TRUE 293s > 293s > ### check acceptance rates 293s > 293s > nmodel <- nrow(out$neighbors) 293s > 293s > accept.within <- out$acceptd[out$which] 293s > my.i.within <- out$state[out$which, 1] 293s > my.i.within.accept <- my.i.within[accept.within] 293s > my.acceptx.numer <- tabulate(my.i.within.accept, nbins = nmodel) 293s > my.acceptx.denom <- tabulate(my.i.within, nbins = nmodel) 293s > my.acceptx <- my.acceptx.numer / my.acceptx.denom 293s > identical(my.acceptx, out$acceptx) 293s [1] TRUE 293s > 293s > accept.swap <- out$acceptd[! out$which] 293s > my.i.swap <- out$state[! out$which, 1] 293s > my.j.swap <- out$proposal[! out$which, 1] 293s > my.accepti <- matrix(NA, nmodel, nmodel) 293s > for (i in 1:nmodel) { 293s + for (j in 1:nmodel) { 293s + if (out$neighbors[i, j]) { 293s + my.accepti[i, j] <- 293s + mean(accept.swap[my.i.swap == i & my.j.swap == j]) 293s + } 293s + } 293s + } 293s > identical(my.accepti, out$accepti) 293s [1] TRUE 293s > 293s > ### check scale vector 293s > 293s > nx <- ncol(models) + 1 293s > newscale <- rnorm(nx, 0.5, 0.1) 293s > 293s > out <- temper(out, scale = newscale, log.pseudo.prior = qux) 293s > 293s > my.coproposal.within <- out$state[out$which, ] 293s > proposal.within <- out$proposal[out$which, ] 293s > my.z <- out$norm[out$which, ] 293s > my.proposal.within <- my.coproposal.within 293s > my.proposal.within[ , -1] <- my.coproposal.within[ , -1] + 293s + sweep(my.z, 2, out$scale, "*") 293s > all.equal(proposal.within, my.proposal.within) 293s [1] TRUE 293s > 293s > ### check scale matrix 293s > 293s > matscale <- matrix(rnorm(nx * nx, 0.0, 0.1), nx, nx) 293s > diag(matscale) <- 0.56789 293s > 293s > out <- temper(out, scale = matscale, log.pseudo.prior = qux) 293s > 293s > my.coproposal.within <- out$state[out$which, ] 293s > proposal.within <- out$proposal[out$which, ] 293s > my.z <- out$norm[out$which, ] 293s > my.proposal.within <- my.coproposal.within 293s > my.proposal.within[ , -1] <- my.coproposal.within[ , -1] + 293s + my.z %*% t(out$scale) 293s > all.equal(proposal.within, my.proposal.within) 293s [1] TRUE 293s > 293s > ### check scale list 293s > 293s > lisztscale <- list(0.56789, newscale, matscale, matscale, newscale, 293s + 0.98765, 0.98765, newscale) 293s > 293s > out <- temper(out, scale = lisztscale, log.pseudo.prior = qux) 293s > 293s > my.coproposal.within <- out$state[out$which, ] 293s > proposal.within <- out$proposal[out$which, ] 293s > my.z <- out$norm[out$which, ] 293s > my.proposal.within <- my.coproposal.within 293s > for (iiter in 1:nrow(my.z)) { 293s + my.i <- my.coproposal.within[iiter, 1] 293s + my.scale <- out$scale[[my.i]] 293s + if (is.matrix(my.scale)) { 293s + my.proposal.within[iiter, -1] <- my.coproposal.within[iiter, -1] + 293s + my.z[iiter, , drop = FALSE] %*% t(my.scale) 293s + } else { 293s + my.proposal.within[iiter, -1] <- my.coproposal.within[iiter, -1] + 293s + my.z[iiter, ] * my.scale 293s + } 293s + } 293s > all.equal(proposal.within, my.proposal.within) 293s [1] TRUE 293s > 293s > ### check outfun 293s > 293s > outfun <- function(state, icomp) { 293s + stopifnot(is.matrix(state)) 293s + stopifnot(is.numeric(state)) 293s + nx <- ncol(initial) 293s + ncomp <- nrow(initial) 293s + stopifnot(ncol(state) == nx) 293s + stopifnot(nrow(state) == ncomp) 293s + stopifnot(1 <= icomp & icomp <= ncomp) 293s + foo <- state[icomp, ] 293s + bar <- foo^2 293s + return(c(foo, bar)) 293s + } 293s > 293s > ncomp <- nrow(models) 293s > nx <- length(beta.initial) - 1 293s > 293s > outfun <- function(state, icomp, ...) { 293s + stopifnot(is.numeric(state)) 293s + stopifnot(length(state) == nx + 1) 293s + istate <- state[1] 293s + stopifnot(istate == as.integer(istate)) 293s + stopifnot(1 <= istate && istate <= ncomp) 293s + stopifnot(1 <= icomp && icomp <= ncomp) 293s + if (istate == icomp) { 293s + foo <- state[-1] 293s + } else { 293s + foo <- rep(0, nx) 293s + } 293s + bar <- foo^2 293s + return(c(foo, bar)) 293s + } 293s > 293s > out <- temper(ludfun, initial = out$final, neighbors = neighbors, 293s + nbatch = 25, blen = 20, nspac = 5, scale = 0.56789, debug = TRUE, 293s + outfun = outfun, log.pseudo.prior = qux, icomp = 4) 294s > 294s > before <- out$state 294s > after <- before 294s > after[- dim(after)[1], ] <- before[-1, ] 294s > after[dim(after)[1], ] <- out$final 294s > outies <- apply(after, 1, outfun, icomp = 4) 294s > outies <- t(outies) 294s > 294s > foo <- outies[seq(1, niter) %% out$nspac == 0, ] 294s > foo <- array(as.vector(foo), dim = c(out$blen, out$nbatch, dim(foo)[2])) 294s > foo <- apply(foo, c(2, 3), mean) 294s > all.equal(foo, out$batch) 294s [1] TRUE 294s > 294s > 294s BEGIN TEST tests/zero-error.R 294s 294s R version 4.4.3 (2025-02-28) -- "Trophy Case" 294s Copyright (C) 2025 The R Foundation for Statistical Computing 294s Platform: aarch64-unknown-linux-gnu 294s 294s R is free software and comes with ABSOLUTELY NO WARRANTY. 294s You are welcome to redistribute it under certain conditions. 294s Type 'license()' or 'licence()' for distribution details. 294s 294s R is a collaborative project with many contributors. 294s Type 'contributors()' for more information and 294s 'citation()' on how to cite R or R packages in publications. 294s 294s Type 'demo()' for some demos, 'help()' for on-line help, or 294s 'help.start()' for an HTML browser interface to help. 294s Type 'q()' to quit R. 294s 294s > 294s > library(mcmc) 294s > 294s > # should give intelligible error (unlike before ver 0.9-8) 294s > 294s > suppressMessages(try(metrop(function(x) x, double(0), nbatch = 10))) 294s Error in system.time(out <- .Call(C_metrop, func1, initial, nbatch, blen, : 294s argument "initial" must have nonzero length 294s > 294s autopkgtest [15:44:59]: test generic: -----------------------] 295s generic PASS 295s autopkgtest [15:45:00]: test generic: - - - - - - - - - - results - - - - - - - - - - 295s autopkgtest [15:45:00]: test pkg-r-autopkgtest: preparing testbed 296s Reading package lists... 296s Building dependency tree... 296s Reading state information... 296s Starting pkgProblemResolver with broken count: 0 296s Starting 2 pkgProblemResolver with broken count: 0 296s Done 297s The following NEW packages will be installed: 297s build-essential cpp cpp-14 cpp-14-aarch64-linux-gnu cpp-aarch64-linux-gnu 297s dctrl-tools g++ g++-14 g++-14-aarch64-linux-gnu g++-aarch64-linux-gnu gcc 297s gcc-14 gcc-14-aarch64-linux-gnu gcc-aarch64-linux-gnu gfortran gfortran-14 297s gfortran-14-aarch64-linux-gnu gfortran-aarch64-linux-gnu icu-devtools 297s libasan8 libblas-dev libbz2-dev libcc1-0 libdeflate-dev libgcc-14-dev 297s libgfortran-14-dev libhwasan0 libicu-dev libisl23 libitm1 libjpeg-dev 297s libjpeg-turbo8-dev libjpeg8-dev liblapack-dev liblsan0 liblzma-dev libmpc3 297s libncurses-dev libpcre2-16-0 libpcre2-32-0 libpcre2-dev libpcre2-posix3 297s libpkgconf3 libpng-dev libreadline-dev libstdc++-14-dev libtirpc-dev 297s libtsan2 libubsan1 pkg-r-autopkgtest pkgconf pkgconf-bin r-base-dev 297s zlib1g-dev 297s 0 upgraded, 54 newly installed, 0 to remove and 0 not upgraded. 297s Need to get 92.7 MB of archives. 297s After this operation, 334 MB of additional disk space will be used. 297s Get:1 http://ftpmaster.internal/ubuntu plucky/main arm64 libisl23 arm64 0.27-1 [676 kB] 298s Get:2 http://ftpmaster.internal/ubuntu plucky/main arm64 libmpc3 arm64 1.3.1-1build2 [56.8 kB] 298s Get:3 http://ftpmaster.internal/ubuntu plucky/main arm64 cpp-14-aarch64-linux-gnu arm64 14.2.0-17ubuntu3 [10.6 MB] 311s Get:4 http://ftpmaster.internal/ubuntu plucky/main arm64 cpp-14 arm64 14.2.0-17ubuntu3 [1028 B] 311s Get:5 http://ftpmaster.internal/ubuntu plucky/main arm64 cpp-aarch64-linux-gnu arm64 4:14.2.0-1ubuntu1 [5558 B] 311s Get:6 http://ftpmaster.internal/ubuntu plucky/main arm64 cpp arm64 4:14.2.0-1ubuntu1 [22.4 kB] 311s Get:7 http://ftpmaster.internal/ubuntu plucky/main arm64 libcc1-0 arm64 15-20250222-0ubuntu1 [44.2 kB] 311s Get:8 http://ftpmaster.internal/ubuntu plucky/main arm64 libitm1 arm64 15-20250222-0ubuntu1 [28.0 kB] 311s Get:9 http://ftpmaster.internal/ubuntu plucky/main arm64 libasan8 arm64 15-20250222-0ubuntu1 [2924 kB] 314s Get:10 http://ftpmaster.internal/ubuntu plucky/main arm64 liblsan0 arm64 15-20250222-0ubuntu1 [1319 kB] 315s Get:11 http://ftpmaster.internal/ubuntu plucky/main arm64 libtsan2 arm64 15-20250222-0ubuntu1 [2694 kB] 318s Get:12 http://ftpmaster.internal/ubuntu plucky/main arm64 libubsan1 arm64 15-20250222-0ubuntu1 [1178 kB] 319s Get:13 http://ftpmaster.internal/ubuntu plucky/main arm64 libhwasan0 arm64 15-20250222-0ubuntu1 [1642 kB] 321s Get:14 http://ftpmaster.internal/ubuntu plucky/main arm64 libgcc-14-dev arm64 14.2.0-17ubuntu3 [2593 kB] 324s Get:15 http://ftpmaster.internal/ubuntu plucky/main arm64 gcc-14-aarch64-linux-gnu arm64 14.2.0-17ubuntu3 [20.9 MB] 351s Get:16 http://ftpmaster.internal/ubuntu plucky/main arm64 gcc-14 arm64 14.2.0-17ubuntu3 [526 kB] 352s Get:17 http://ftpmaster.internal/ubuntu plucky/main arm64 gcc-aarch64-linux-gnu arm64 4:14.2.0-1ubuntu1 [1200 B] 352s Get:18 http://ftpmaster.internal/ubuntu plucky/main arm64 gcc arm64 4:14.2.0-1ubuntu1 [4998 B] 352s Get:19 http://ftpmaster.internal/ubuntu plucky/main arm64 libstdc++-14-dev arm64 14.2.0-17ubuntu3 [2499 kB] 355s Get:20 http://ftpmaster.internal/ubuntu plucky/main arm64 g++-14-aarch64-linux-gnu arm64 14.2.0-17ubuntu3 [12.1 MB] 373s Get:21 http://ftpmaster.internal/ubuntu plucky/main arm64 g++-14 arm64 14.2.0-17ubuntu3 [21.8 kB] 373s Get:22 http://ftpmaster.internal/ubuntu plucky/main arm64 g++-aarch64-linux-gnu arm64 4:14.2.0-1ubuntu1 [956 B] 373s Get:23 http://ftpmaster.internal/ubuntu plucky/main arm64 g++ arm64 4:14.2.0-1ubuntu1 [1080 B] 373s Get:24 http://ftpmaster.internal/ubuntu plucky/main arm64 build-essential arm64 12.10ubuntu1 [4932 B] 373s Get:25 http://ftpmaster.internal/ubuntu plucky/main arm64 dctrl-tools arm64 2.24-3build3 [103 kB] 374s Get:26 http://ftpmaster.internal/ubuntu plucky/main arm64 libgfortran-14-dev arm64 14.2.0-17ubuntu3 [498 kB] 374s Get:27 http://ftpmaster.internal/ubuntu plucky/main arm64 gfortran-14-aarch64-linux-gnu arm64 14.2.0-17ubuntu3 [11.4 MB] 392s Get:28 http://ftpmaster.internal/ubuntu plucky/main arm64 gfortran-14 arm64 14.2.0-17ubuntu3 [13.6 kB] 392s Get:29 http://ftpmaster.internal/ubuntu plucky/main arm64 gfortran-aarch64-linux-gnu arm64 4:14.2.0-1ubuntu1 [1022 B] 392s Get:30 http://ftpmaster.internal/ubuntu plucky/main arm64 gfortran arm64 4:14.2.0-1ubuntu1 [1166 B] 393s Get:31 http://ftpmaster.internal/ubuntu plucky/main arm64 icu-devtools arm64 76.1-1ubuntu2 [213 kB] 393s Get:32 http://ftpmaster.internal/ubuntu plucky/main arm64 libblas-dev arm64 3.12.1-2 [126 kB] 393s Get:33 http://ftpmaster.internal/ubuntu plucky/main arm64 libbz2-dev arm64 1.0.8-6 [36.1 kB] 393s Get:34 http://ftpmaster.internal/ubuntu plucky/main arm64 libdeflate-dev arm64 1.23-1 [53.7 kB] 393s Get:35 http://ftpmaster.internal/ubuntu plucky/main arm64 libicu-dev arm64 76.1-1ubuntu2 [12.2 MB] 408s Get:36 http://ftpmaster.internal/ubuntu plucky/main arm64 libjpeg-turbo8-dev arm64 2.1.5-3ubuntu2 [306 kB] 408s Get:37 http://ftpmaster.internal/ubuntu plucky/main arm64 libjpeg8-dev arm64 8c-2ubuntu11 [1484 B] 408s Get:38 http://ftpmaster.internal/ubuntu plucky/main arm64 libjpeg-dev arm64 8c-2ubuntu11 [1482 B] 408s Get:39 http://ftpmaster.internal/ubuntu plucky/main arm64 liblapack-dev arm64 3.12.1-2 [4439 kB] 413s Get:40 http://ftpmaster.internal/ubuntu plucky/main arm64 libncurses-dev arm64 6.5+20250216-2 [389 kB] 414s Get:41 http://ftpmaster.internal/ubuntu plucky/main arm64 libpcre2-16-0 arm64 10.45-1 [222 kB] 414s Get:42 http://ftpmaster.internal/ubuntu plucky/main arm64 libpcre2-32-0 arm64 10.45-1 [210 kB] 414s Get:43 http://ftpmaster.internal/ubuntu plucky/main arm64 libpcre2-posix3 arm64 10.45-1 [7084 B] 414s Get:44 http://ftpmaster.internal/ubuntu plucky/main arm64 libpcre2-dev arm64 10.45-1 [768 kB] 415s Get:45 http://ftpmaster.internal/ubuntu plucky/main arm64 libpkgconf3 arm64 1.8.1-4 [31.4 kB] 415s Get:46 http://ftpmaster.internal/ubuntu plucky/main arm64 zlib1g-dev arm64 1:1.3.dfsg+really1.3.1-1ubuntu1 [894 kB] 417s Get:47 http://ftpmaster.internal/ubuntu plucky/main arm64 libpng-dev arm64 1.6.47-1 [269 kB] 417s Get:48 http://ftpmaster.internal/ubuntu plucky/main arm64 libreadline-dev arm64 8.2-6 [179 kB] 417s Get:49 http://ftpmaster.internal/ubuntu plucky/main arm64 liblzma-dev arm64 5.6.4-1 [180 kB] 418s Get:50 http://ftpmaster.internal/ubuntu plucky/main arm64 pkgconf-bin arm64 1.8.1-4 [20.9 kB] 418s Get:51 http://ftpmaster.internal/ubuntu plucky/main arm64 pkgconf arm64 1.8.1-4 [16.7 kB] 418s Get:52 http://ftpmaster.internal/ubuntu plucky/main arm64 libtirpc-dev arm64 1.3.4+ds-1.3 [201 kB] 418s Get:53 http://ftpmaster.internal/ubuntu plucky/universe arm64 r-base-dev all 4.4.3-1 [4176 B] 418s Get:54 http://ftpmaster.internal/ubuntu plucky/universe arm64 pkg-r-autopkgtest all 20231212ubuntu1 [6448 B] 419s Fetched 92.7 MB in 2min 1s (765 kB/s) 419s Selecting previously unselected package libisl23:arm64. 419s (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 ... 83964 files and directories currently installed.) 419s Preparing to unpack .../00-libisl23_0.27-1_arm64.deb ... 419s Unpacking libisl23:arm64 (0.27-1) ... 419s Selecting previously unselected package libmpc3:arm64. 419s Preparing to unpack .../01-libmpc3_1.3.1-1build2_arm64.deb ... 419s Unpacking libmpc3:arm64 (1.3.1-1build2) ... 419s Selecting previously unselected package cpp-14-aarch64-linux-gnu. 419s Preparing to unpack .../02-cpp-14-aarch64-linux-gnu_14.2.0-17ubuntu3_arm64.deb ... 419s Unpacking cpp-14-aarch64-linux-gnu (14.2.0-17ubuntu3) ... 419s Selecting previously unselected package cpp-14. 419s Preparing to unpack .../03-cpp-14_14.2.0-17ubuntu3_arm64.deb ... 419s Unpacking cpp-14 (14.2.0-17ubuntu3) ... 419s Selecting previously unselected package cpp-aarch64-linux-gnu. 419s Preparing to unpack .../04-cpp-aarch64-linux-gnu_4%3a14.2.0-1ubuntu1_arm64.deb ... 419s Unpacking cpp-aarch64-linux-gnu (4:14.2.0-1ubuntu1) ... 419s Selecting previously unselected package cpp. 419s Preparing to unpack .../05-cpp_4%3a14.2.0-1ubuntu1_arm64.deb ... 419s Unpacking cpp (4:14.2.0-1ubuntu1) ... 419s Selecting previously unselected package libcc1-0:arm64. 419s Preparing to unpack .../06-libcc1-0_15-20250222-0ubuntu1_arm64.deb ... 419s Unpacking libcc1-0:arm64 (15-20250222-0ubuntu1) ... 419s Selecting previously unselected package libitm1:arm64. 419s Preparing to unpack .../07-libitm1_15-20250222-0ubuntu1_arm64.deb ... 419s Unpacking libitm1:arm64 (15-20250222-0ubuntu1) ... 419s Selecting previously unselected package libasan8:arm64. 419s Preparing to unpack .../08-libasan8_15-20250222-0ubuntu1_arm64.deb ... 419s Unpacking libasan8:arm64 (15-20250222-0ubuntu1) ... 419s Selecting previously unselected package liblsan0:arm64. 419s Preparing to unpack .../09-liblsan0_15-20250222-0ubuntu1_arm64.deb ... 419s Unpacking liblsan0:arm64 (15-20250222-0ubuntu1) ... 419s Selecting previously unselected package libtsan2:arm64. 419s Preparing to unpack .../10-libtsan2_15-20250222-0ubuntu1_arm64.deb ... 419s Unpacking libtsan2:arm64 (15-20250222-0ubuntu1) ... 420s Selecting previously unselected package libubsan1:arm64. 420s Preparing to unpack .../11-libubsan1_15-20250222-0ubuntu1_arm64.deb ... 420s Unpacking libubsan1:arm64 (15-20250222-0ubuntu1) ... 420s Selecting previously unselected package libhwasan0:arm64. 420s Preparing to unpack .../12-libhwasan0_15-20250222-0ubuntu1_arm64.deb ... 420s Unpacking libhwasan0:arm64 (15-20250222-0ubuntu1) ... 420s Selecting previously unselected package libgcc-14-dev:arm64. 420s Preparing to unpack .../13-libgcc-14-dev_14.2.0-17ubuntu3_arm64.deb ... 420s Unpacking libgcc-14-dev:arm64 (14.2.0-17ubuntu3) ... 420s Selecting previously unselected package gcc-14-aarch64-linux-gnu. 420s Preparing to unpack .../14-gcc-14-aarch64-linux-gnu_14.2.0-17ubuntu3_arm64.deb ... 420s Unpacking gcc-14-aarch64-linux-gnu (14.2.0-17ubuntu3) ... 420s Selecting previously unselected package gcc-14. 420s Preparing to unpack .../15-gcc-14_14.2.0-17ubuntu3_arm64.deb ... 420s Unpacking gcc-14 (14.2.0-17ubuntu3) ... 420s Selecting previously unselected package gcc-aarch64-linux-gnu. 420s Preparing to unpack .../16-gcc-aarch64-linux-gnu_4%3a14.2.0-1ubuntu1_arm64.deb ... 420s Unpacking gcc-aarch64-linux-gnu (4:14.2.0-1ubuntu1) ... 420s Selecting previously unselected package gcc. 420s Preparing to unpack .../17-gcc_4%3a14.2.0-1ubuntu1_arm64.deb ... 420s Unpacking gcc (4:14.2.0-1ubuntu1) ... 420s Selecting previously unselected package libstdc++-14-dev:arm64. 420s Preparing to unpack .../18-libstdc++-14-dev_14.2.0-17ubuntu3_arm64.deb ... 420s Unpacking libstdc++-14-dev:arm64 (14.2.0-17ubuntu3) ... 420s Selecting previously unselected package g++-14-aarch64-linux-gnu. 421s Preparing to unpack .../19-g++-14-aarch64-linux-gnu_14.2.0-17ubuntu3_arm64.deb ... 421s Unpacking g++-14-aarch64-linux-gnu (14.2.0-17ubuntu3) ... 421s Selecting previously unselected package g++-14. 421s Preparing to unpack .../20-g++-14_14.2.0-17ubuntu3_arm64.deb ... 421s Unpacking g++-14 (14.2.0-17ubuntu3) ... 421s Selecting previously unselected package g++-aarch64-linux-gnu. 421s Preparing to unpack .../21-g++-aarch64-linux-gnu_4%3a14.2.0-1ubuntu1_arm64.deb ... 421s Unpacking g++-aarch64-linux-gnu (4:14.2.0-1ubuntu1) ... 421s Selecting previously unselected package g++. 421s Preparing to unpack .../22-g++_4%3a14.2.0-1ubuntu1_arm64.deb ... 421s Unpacking g++ (4:14.2.0-1ubuntu1) ... 421s Selecting previously unselected package build-essential. 421s Preparing to unpack .../23-build-essential_12.10ubuntu1_arm64.deb ... 421s Unpacking build-essential (12.10ubuntu1) ... 421s Selecting previously unselected package dctrl-tools. 421s Preparing to unpack .../24-dctrl-tools_2.24-3build3_arm64.deb ... 421s Unpacking dctrl-tools (2.24-3build3) ... 421s Selecting previously unselected package libgfortran-14-dev:arm64. 421s Preparing to unpack .../25-libgfortran-14-dev_14.2.0-17ubuntu3_arm64.deb ... 421s Unpacking libgfortran-14-dev:arm64 (14.2.0-17ubuntu3) ... 421s Selecting previously unselected package gfortran-14-aarch64-linux-gnu. 421s Preparing to unpack .../26-gfortran-14-aarch64-linux-gnu_14.2.0-17ubuntu3_arm64.deb ... 421s Unpacking gfortran-14-aarch64-linux-gnu (14.2.0-17ubuntu3) ... 421s Selecting previously unselected package gfortran-14. 421s Preparing to unpack .../27-gfortran-14_14.2.0-17ubuntu3_arm64.deb ... 421s Unpacking gfortran-14 (14.2.0-17ubuntu3) ... 421s Selecting previously unselected package gfortran-aarch64-linux-gnu. 421s Preparing to unpack .../28-gfortran-aarch64-linux-gnu_4%3a14.2.0-1ubuntu1_arm64.deb ... 421s Unpacking gfortran-aarch64-linux-gnu (4:14.2.0-1ubuntu1) ... 421s Selecting previously unselected package gfortran. 421s Preparing to unpack .../29-gfortran_4%3a14.2.0-1ubuntu1_arm64.deb ... 421s Unpacking gfortran (4:14.2.0-1ubuntu1) ... 421s Selecting previously unselected package icu-devtools. 421s Preparing to unpack .../30-icu-devtools_76.1-1ubuntu2_arm64.deb ... 421s Unpacking icu-devtools (76.1-1ubuntu2) ... 421s Selecting previously unselected package libblas-dev:arm64. 421s Preparing to unpack .../31-libblas-dev_3.12.1-2_arm64.deb ... 421s Unpacking libblas-dev:arm64 (3.12.1-2) ... 421s Selecting previously unselected package libbz2-dev:arm64. 421s Preparing to unpack .../32-libbz2-dev_1.0.8-6_arm64.deb ... 421s Unpacking libbz2-dev:arm64 (1.0.8-6) ... 421s Selecting previously unselected package libdeflate-dev:arm64. 421s Preparing to unpack .../33-libdeflate-dev_1.23-1_arm64.deb ... 421s Unpacking libdeflate-dev:arm64 (1.23-1) ... 421s Selecting previously unselected package libicu-dev:arm64. 422s Preparing to unpack .../34-libicu-dev_76.1-1ubuntu2_arm64.deb ... 422s Unpacking libicu-dev:arm64 (76.1-1ubuntu2) ... 422s Selecting previously unselected package libjpeg-turbo8-dev:arm64. 422s Preparing to unpack .../35-libjpeg-turbo8-dev_2.1.5-3ubuntu2_arm64.deb ... 422s Unpacking libjpeg-turbo8-dev:arm64 (2.1.5-3ubuntu2) ... 422s Selecting previously unselected package libjpeg8-dev:arm64. 422s Preparing to unpack .../36-libjpeg8-dev_8c-2ubuntu11_arm64.deb ... 422s Unpacking libjpeg8-dev:arm64 (8c-2ubuntu11) ... 422s Selecting previously unselected package libjpeg-dev:arm64. 422s Preparing to unpack .../37-libjpeg-dev_8c-2ubuntu11_arm64.deb ... 422s Unpacking libjpeg-dev:arm64 (8c-2ubuntu11) ... 422s Selecting previously unselected package liblapack-dev:arm64. 422s Preparing to unpack .../38-liblapack-dev_3.12.1-2_arm64.deb ... 422s Unpacking liblapack-dev:arm64 (3.12.1-2) ... 422s Selecting previously unselected package libncurses-dev:arm64. 422s Preparing to unpack .../39-libncurses-dev_6.5+20250216-2_arm64.deb ... 422s Unpacking libncurses-dev:arm64 (6.5+20250216-2) ... 422s Selecting previously unselected package libpcre2-16-0:arm64. 422s Preparing to unpack .../40-libpcre2-16-0_10.45-1_arm64.deb ... 422s Unpacking libpcre2-16-0:arm64 (10.45-1) ... 422s Selecting previously unselected package libpcre2-32-0:arm64. 422s Preparing to unpack .../41-libpcre2-32-0_10.45-1_arm64.deb ... 422s Unpacking libpcre2-32-0:arm64 (10.45-1) ... 422s Selecting previously unselected package libpcre2-posix3:arm64. 422s Preparing to unpack .../42-libpcre2-posix3_10.45-1_arm64.deb ... 422s Unpacking libpcre2-posix3:arm64 (10.45-1) ... 422s Selecting previously unselected package libpcre2-dev:arm64. 422s Preparing to unpack .../43-libpcre2-dev_10.45-1_arm64.deb ... 422s Unpacking libpcre2-dev:arm64 (10.45-1) ... 422s Selecting previously unselected package libpkgconf3:arm64. 422s Preparing to unpack .../44-libpkgconf3_1.8.1-4_arm64.deb ... 422s Unpacking libpkgconf3:arm64 (1.8.1-4) ... 422s Selecting previously unselected package zlib1g-dev:arm64. 422s Preparing to unpack .../45-zlib1g-dev_1%3a1.3.dfsg+really1.3.1-1ubuntu1_arm64.deb ... 422s Unpacking zlib1g-dev:arm64 (1:1.3.dfsg+really1.3.1-1ubuntu1) ... 422s Selecting previously unselected package libpng-dev:arm64. 422s Preparing to unpack .../46-libpng-dev_1.6.47-1_arm64.deb ... 422s Unpacking libpng-dev:arm64 (1.6.47-1) ... 422s Selecting previously unselected package libreadline-dev:arm64. 422s Preparing to unpack .../47-libreadline-dev_8.2-6_arm64.deb ... 422s Unpacking libreadline-dev:arm64 (8.2-6) ... 423s Selecting previously unselected package liblzma-dev:arm64. 423s Preparing to unpack .../48-liblzma-dev_5.6.4-1_arm64.deb ... 423s Unpacking liblzma-dev:arm64 (5.6.4-1) ... 423s Selecting previously unselected package pkgconf-bin. 423s Preparing to unpack .../49-pkgconf-bin_1.8.1-4_arm64.deb ... 423s Unpacking pkgconf-bin (1.8.1-4) ... 423s Selecting previously unselected package pkgconf:arm64. 423s Preparing to unpack .../50-pkgconf_1.8.1-4_arm64.deb ... 423s Unpacking pkgconf:arm64 (1.8.1-4) ... 423s Selecting previously unselected package libtirpc-dev:arm64. 423s Preparing to unpack .../51-libtirpc-dev_1.3.4+ds-1.3_arm64.deb ... 423s Unpacking libtirpc-dev:arm64 (1.3.4+ds-1.3) ... 423s Selecting previously unselected package r-base-dev. 423s Preparing to unpack .../52-r-base-dev_4.4.3-1_all.deb ... 423s Unpacking r-base-dev (4.4.3-1) ... 423s Selecting previously unselected package pkg-r-autopkgtest. 423s Preparing to unpack .../53-pkg-r-autopkgtest_20231212ubuntu1_all.deb ... 423s Unpacking pkg-r-autopkgtest (20231212ubuntu1) ... 423s Setting up libjpeg-turbo8-dev:arm64 (2.1.5-3ubuntu2) ... 423s Setting up libncurses-dev:arm64 (6.5+20250216-2) ... 423s Setting up libreadline-dev:arm64 (8.2-6) ... 423s Setting up libpcre2-16-0:arm64 (10.45-1) ... 423s Setting up libpcre2-32-0:arm64 (10.45-1) ... 423s Setting up libtirpc-dev:arm64 (1.3.4+ds-1.3) ... 423s Setting up libpkgconf3:arm64 (1.8.1-4) ... 423s Setting up libmpc3:arm64 (1.3.1-1build2) ... 423s Setting up icu-devtools (76.1-1ubuntu2) ... 423s Setting up pkgconf-bin (1.8.1-4) ... 423s Setting up liblzma-dev:arm64 (5.6.4-1) ... 423s Setting up libubsan1:arm64 (15-20250222-0ubuntu1) ... 423s Setting up zlib1g-dev:arm64 (1:1.3.dfsg+really1.3.1-1ubuntu1) ... 423s Setting up libpcre2-posix3:arm64 (10.45-1) ... 423s Setting up libhwasan0:arm64 (15-20250222-0ubuntu1) ... 423s Setting up libasan8:arm64 (15-20250222-0ubuntu1) ... 423s Setting up libtsan2:arm64 (15-20250222-0ubuntu1) ... 423s Setting up libjpeg8-dev:arm64 (8c-2ubuntu11) ... 423s Setting up libisl23:arm64 (0.27-1) ... 423s Setting up libdeflate-dev:arm64 (1.23-1) ... 423s Setting up libicu-dev:arm64 (76.1-1ubuntu2) ... 423s Setting up libcc1-0:arm64 (15-20250222-0ubuntu1) ... 423s Setting up liblsan0:arm64 (15-20250222-0ubuntu1) ... 423s Setting up libblas-dev:arm64 (3.12.1-2) ... 423s update-alternatives: using /usr/lib/aarch64-linux-gnu/blas/libblas.so to provide /usr/lib/aarch64-linux-gnu/libblas.so (libblas.so-aarch64-linux-gnu) in auto mode 423s Setting up dctrl-tools (2.24-3build3) ... 423s Setting up libitm1:arm64 (15-20250222-0ubuntu1) ... 423s Setting up libbz2-dev:arm64 (1.0.8-6) ... 423s Setting up libpcre2-dev:arm64 (10.45-1) ... 423s Setting up libpng-dev:arm64 (1.6.47-1) ... 423s Setting up libjpeg-dev:arm64 (8c-2ubuntu11) ... 423s Setting up pkgconf:arm64 (1.8.1-4) ... 423s Setting up liblapack-dev:arm64 (3.12.1-2) ... 423s update-alternatives: using /usr/lib/aarch64-linux-gnu/lapack/liblapack.so to provide /usr/lib/aarch64-linux-gnu/liblapack.so (liblapack.so-aarch64-linux-gnu) in auto mode 423s Setting up cpp-14-aarch64-linux-gnu (14.2.0-17ubuntu3) ... 423s Setting up libgcc-14-dev:arm64 (14.2.0-17ubuntu3) ... 423s Setting up libstdc++-14-dev:arm64 (14.2.0-17ubuntu3) ... 423s Setting up libgfortran-14-dev:arm64 (14.2.0-17ubuntu3) ... 423s Setting up cpp-aarch64-linux-gnu (4:14.2.0-1ubuntu1) ... 423s Setting up cpp-14 (14.2.0-17ubuntu3) ... 423s Setting up cpp (4:14.2.0-1ubuntu1) ... 423s Setting up gcc-14-aarch64-linux-gnu (14.2.0-17ubuntu3) ... 423s Setting up gcc-aarch64-linux-gnu (4:14.2.0-1ubuntu1) ... 423s Setting up g++-14-aarch64-linux-gnu (14.2.0-17ubuntu3) ... 423s Setting up gcc-14 (14.2.0-17ubuntu3) ... 423s Setting up gfortran-14-aarch64-linux-gnu (14.2.0-17ubuntu3) ... 423s Setting up g++-aarch64-linux-gnu (4:14.2.0-1ubuntu1) ... 423s Setting up gfortran-aarch64-linux-gnu (4:14.2.0-1ubuntu1) ... 423s Setting up g++-14 (14.2.0-17ubuntu3) ... 423s Setting up gfortran-14 (14.2.0-17ubuntu3) ... 423s Setting up gcc (4:14.2.0-1ubuntu1) ... 423s Setting up g++ (4:14.2.0-1ubuntu1) ... 423s update-alternatives: using /usr/bin/g++ to provide /usr/bin/c++ (c++) in auto mode 423s Setting up build-essential (12.10ubuntu1) ... 423s Setting up gfortran (4:14.2.0-1ubuntu1) ... 423s update-alternatives: using /usr/bin/gfortran to provide /usr/bin/f95 (f95) in auto mode 423s 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 423s update-alternatives: using /usr/bin/gfortran to provide /usr/bin/f77 (f77) in auto mode 423s 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 423s Setting up r-base-dev (4.4.3-1) ... 423s Setting up pkg-r-autopkgtest (20231212ubuntu1) ... 423s Processing triggers for libc-bin (2.41-1ubuntu2) ... 423s Processing triggers for man-db (2.13.0-1) ... 424s Processing triggers for install-info (7.1.1-1) ... 425s autopkgtest [15:47:10]: test pkg-r-autopkgtest: /usr/share/dh-r/pkg-r-autopkgtest 425s autopkgtest [15:47:10]: test pkg-r-autopkgtest: [----------------------- 425s Test: Try to load the R library mcmc 425s 425s R version 4.4.3 (2025-02-28) -- "Trophy Case" 425s Copyright (C) 2025 The R Foundation for Statistical Computing 425s Platform: aarch64-unknown-linux-gnu 425s 425s R is free software and comes with ABSOLUTELY NO WARRANTY. 425s You are welcome to redistribute it under certain conditions. 425s Type 'license()' or 'licence()' for distribution details. 425s 425s R is a collaborative project with many contributors. 425s Type 'contributors()' for more information and 425s 'citation()' on how to cite R or R packages in publications. 425s 425s Type 'demo()' for some demos, 'help()' for on-line help, or 425s 'help.start()' for an HTML browser interface to help. 425s Type 'q()' to quit R. 425s 425s > library('mcmc') 425s > 425s > 425s Other tests are currently unsupported! 425s They will be progressively added. 426s autopkgtest [15:47:11]: test pkg-r-autopkgtest: -----------------------] 426s pkg-r-autopkgtest PASS 426s autopkgtest [15:47:11]: test pkg-r-autopkgtest: - - - - - - - - - - results - - - - - - - - - - 427s autopkgtest [15:47:12]: @@@@@@@@@@@@@@@@@@@@ summary 427s generic PASS 427s pkg-r-autopkgtest PASS 447s nova [W] Using flock in prodstack6-arm64 447s Creating nova instance adt-plucky-arm64-r-cran-mcmc-20250315-154005-juju-7f2275-prod-proposed-migration-environment-2-069d2904-f828-4704-9dc1-fc9634739803 from image adt/ubuntu-plucky-arm64-server-20250315.img (UUID bd6e766c-b51f-4b53-86d6-23aa4d18f524)... 447s nova [W] Timed out waiting for 59585a43-ce0b-4066-b1da-ec3ddc8169f0 to get deleted.