0s autopkgtest [18:10:37]: starting date and time: 2025-03-15 18:10:37+0000 0s autopkgtest [18:10:37]: git checkout: 325255d2 Merge branch 'pin-any-arch' into 'ubuntu/production' 0s autopkgtest [18:10:37]: host juju-7f2275-prod-proposed-migration-environment-15; command line: /home/ubuntu/autopkgtest/runner/autopkgtest --output-dir /tmp/autopkgtest-work.yz782lft/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-s390x --security-groups autopkgtest-juju-7f2275-prod-proposed-migration-environment-15@bos03-s390x-24.secgroup --name adt-plucky-s390x-r-cran-mcmc-20250315-181037-juju-7f2275-prod-proposed-migration-environment-15-ad63e06a-a072-4350-8fce-11e55a7758eb --image adt/ubuntu-plucky-s390x-server --keyname testbed-juju-7f2275-prod-proposed-migration-environment-15 --net-id=net_prod-proposed-migration-s390x -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/ 1048s autopkgtest [18:28:05]: testbed dpkg architecture: s390x 1048s autopkgtest [18:28:05]: testbed apt version: 2.9.33 1048s autopkgtest [18:28:05]: @@@@@@@@@@@@@@@@@@@@ test bed setup 1049s autopkgtest [18:28:06]: testbed release detected to be: None 1049s autopkgtest [18:28:06]: updating testbed package index (apt update) 1050s Get:1 http://ftpmaster.internal/ubuntu plucky-proposed InRelease [126 kB] 1050s Hit:2 http://ftpmaster.internal/ubuntu plucky InRelease 1051s Hit:3 http://ftpmaster.internal/ubuntu plucky-updates InRelease 1051s Hit:4 http://ftpmaster.internal/ubuntu plucky-security InRelease 1051s Get:5 http://ftpmaster.internal/ubuntu plucky-proposed/multiverse Sources [15.8 kB] 1051s Get:6 http://ftpmaster.internal/ubuntu plucky-proposed/main Sources [99.7 kB] 1051s Get:7 http://ftpmaster.internal/ubuntu plucky-proposed/universe Sources [379 kB] 1051s Get:8 http://ftpmaster.internal/ubuntu plucky-proposed/main s390x Packages [113 kB] 1051s Get:9 http://ftpmaster.internal/ubuntu plucky-proposed/main s390x c-n-f Metadata [1824 B] 1051s Get:10 http://ftpmaster.internal/ubuntu plucky-proposed/restricted s390x c-n-f Metadata [116 B] 1051s Get:11 http://ftpmaster.internal/ubuntu plucky-proposed/universe s390x Packages [320 kB] 1051s Get:12 http://ftpmaster.internal/ubuntu plucky-proposed/universe s390x c-n-f Metadata [13.4 kB] 1051s Get:13 http://ftpmaster.internal/ubuntu plucky-proposed/multiverse s390x Packages [3776 B] 1051s Get:14 http://ftpmaster.internal/ubuntu plucky-proposed/multiverse s390x c-n-f Metadata [240 B] 1052s Fetched 1073 kB in 2s (580 kB/s) 1052s Reading package lists... 1053s + lsb_release --codename --short 1053s + RELEASE=plucky 1053s + cat 1053s + [ plucky != trusty ] 1053s + DEBIAN_FRONTEND=noninteractive eatmydata apt-get -y --allow-downgrades -o Dpkg::Options::=--force-confnew dist-upgrade 1053s Reading package lists... 1053s Building dependency tree... 1053s Reading state information... 1053s Calculating upgrade... 1053s Calculating upgrade... 1053s The following packages were automatically installed and are no longer required: 1053s libnsl2 libpython3.12-minimal libpython3.12-stdlib libpython3.12t64 1053s linux-headers-6.11.0-8 linux-headers-6.11.0-8-generic 1053s linux-modules-6.11.0-8-generic linux-tools-6.11.0-8 1053s linux-tools-6.11.0-8-generic 1053s Use 'sudo apt autoremove' to remove them. 1053s The following packages will be upgraded: 1053s pinentry-curses python3-jinja2 strace 1053s 3 upgraded, 0 newly installed, 0 to remove and 0 not upgraded. 1053s Need to get 652 kB of archives. 1053s After this operation, 27.6 kB of additional disk space will be used. 1053s Get:1 http://ftpmaster.internal/ubuntu plucky/main s390x strace s390x 6.13+ds-1ubuntu1 [500 kB] 1054s Get:2 http://ftpmaster.internal/ubuntu plucky/main s390x pinentry-curses s390x 1.3.1-2ubuntu3 [42.9 kB] 1054s Get:3 http://ftpmaster.internal/ubuntu plucky/main s390x python3-jinja2 all 3.1.5-2ubuntu1 [109 kB] 1055s Fetched 652 kB in 1s (578 kB/s) 1055s (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 ... 81428 files and directories currently installed.) 1055s Preparing to unpack .../strace_6.13+ds-1ubuntu1_s390x.deb ... 1055s Unpacking strace (6.13+ds-1ubuntu1) over (6.11-0ubuntu1) ... 1055s Preparing to unpack .../pinentry-curses_1.3.1-2ubuntu3_s390x.deb ... 1055s Unpacking pinentry-curses (1.3.1-2ubuntu3) over (1.3.1-2ubuntu2) ... 1055s Preparing to unpack .../python3-jinja2_3.1.5-2ubuntu1_all.deb ... 1055s Unpacking python3-jinja2 (3.1.5-2ubuntu1) over (3.1.5-2) ... 1055s Setting up pinentry-curses (1.3.1-2ubuntu3) ... 1055s Setting up python3-jinja2 (3.1.5-2ubuntu1) ... 1055s Setting up strace (6.13+ds-1ubuntu1) ... 1055s Processing triggers for man-db (2.13.0-1) ... 1056s + rm /etc/apt/preferences.d/force-downgrade-to-release.pref 1056s + /usr/lib/apt/apt-helper analyze-pattern ?true 1056s + uname -r 1056s + sed s/\./\\./g 1056s + running_kernel_pattern=^linux-.*6\.14\.0-10-generic.* 1056s + apt list ?obsolete 1056s + tail -n+2 1056s + cut+ grep -v ^linux-.*6\.14\.0-10-generic.* 1056s -d/ -f1 1056s + obsolete_pkgs=linux-headers-6.11.0-8-generic 1056s linux-headers-6.11.0-8 1056s linux-modules-6.11.0-8-generic 1056s linux-tools-6.11.0-8-generic 1056s linux-tools-6.11.0-8 1056s + DEBIAN_FRONTEND=noninteractive eatmydata apt-get -y purge --autoremove linux-headers-6.11.0-8-generic linux-headers-6.11.0-8 linux-modules-6.11.0-8-generic linux-tools-6.11.0-8-generic linux-tools-6.11.0-8 1056s Reading package lists... 1056s Building dependency tree... 1056s Reading state information... 1056s Solving dependencies... 1056s The following packages will be REMOVED: 1056s libnsl2* libpython3.12-minimal* libpython3.12-stdlib* libpython3.12t64* 1056s linux-headers-6.11.0-8* linux-headers-6.11.0-8-generic* 1056s linux-modules-6.11.0-8-generic* linux-tools-6.11.0-8* 1056s linux-tools-6.11.0-8-generic* 1056s 0 upgraded, 0 newly installed, 9 to remove and 5 not upgraded. 1056s After this operation, 167 MB disk space will be freed. 1056s (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 ... 81428 files and directories currently installed.) 1056s Removing linux-tools-6.11.0-8-generic (6.11.0-8.8) ... 1056s Removing linux-tools-6.11.0-8 (6.11.0-8.8) ... 1056s Removing libpython3.12t64:s390x (3.12.9-1) ... 1056s Removing libpython3.12-stdlib:s390x (3.12.9-1) ... 1056s Removing libnsl2:s390x (1.3.0-3build3) ... 1056s Removing libpython3.12-minimal:s390x (3.12.9-1) ... 1056s Removing linux-headers-6.11.0-8-generic (6.11.0-8.8) ... 1056s Removing linux-headers-6.11.0-8 (6.11.0-8.8) ... 1057s Removing linux-modules-6.11.0-8-generic (6.11.0-8.8) ... 1057s Processing triggers for libc-bin (2.41-1ubuntu1) ... 1057s (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 ... 56328 files and directories currently installed.) 1057s Purging configuration files for libpython3.12-minimal:s390x (3.12.9-1) ... 1057s Purging configuration files for linux-modules-6.11.0-8-generic (6.11.0-8.8) ... 1058s + grep -q trusty /etc/lsb-release 1058s + [ ! -d /usr/share/doc/unattended-upgrades ] 1058s + [ ! -d /usr/share/doc/lxd ] 1058s + [ ! -d /usr/share/doc/lxd-client ] 1058s + [ ! -d /usr/share/doc/snapd ] 1058s + type iptables 1058s + cat 1058s + chmod 755 /etc/rc.local 1058s + . /etc/rc.local 1058s + iptables -w -t mangle -A FORWARD -p tcp --tcp-flags SYN,RST SYN -j TCPMSS --clamp-mss-to-pmtu 1058s + iptables -A OUTPUT -d 10.255.255.1/32 -p tcp -j DROP 1058s + iptables -A OUTPUT -d 10.255.255.2/32 -p tcp -j DROP 1058s + uname -m 1058s + [ s390x = ppc64le ] 1058s + [ -d /run/systemd/system ] 1058s + systemd-detect-virt --quiet --vm 1058s + mkdir -p /etc/systemd/system/systemd-random-seed.service.d/ 1058s + cat 1058s + grep -q lz4 /etc/initramfs-tools/initramfs.conf 1058s + echo COMPRESS=lz4 1058s autopkgtest [18:28:15]: upgrading testbed (apt dist-upgrade and autopurge) 1058s Reading package lists... 1058s Building dependency tree... 1058s Reading state information... 1058s Calculating upgrade...Starting pkgProblemResolver with broken count: 0 1058s Starting 2 pkgProblemResolver with broken count: 0 1058s Done 1058s Entering ResolveByKeep 1058s 1058s Calculating upgrade... 1059s The following packages will be upgraded: 1059s libc-bin libc-dev-bin libc6 libc6-dev locales 1059s 5 upgraded, 0 newly installed, 0 to remove and 0 not upgraded. 1059s Need to get 9512 kB of archives. 1059s After this operation, 8192 B of additional disk space will be used. 1059s Get:1 http://ftpmaster.internal/ubuntu plucky-proposed/main s390x libc6-dev s390x 2.41-1ubuntu2 [1678 kB] 1061s Get:2 http://ftpmaster.internal/ubuntu plucky-proposed/main s390x libc-dev-bin s390x 2.41-1ubuntu2 [24.3 kB] 1061s Get:3 http://ftpmaster.internal/ubuntu plucky-proposed/main s390x libc6 s390x 2.41-1ubuntu2 [2892 kB] 1064s Get:4 http://ftpmaster.internal/ubuntu plucky-proposed/main s390x libc-bin s390x 2.41-1ubuntu2 [671 kB] 1065s Get:5 http://ftpmaster.internal/ubuntu plucky-proposed/main s390x locales all 2.41-1ubuntu2 [4246 kB] 1069s Preconfiguring packages ... 1069s Fetched 9512 kB in 11s (904 kB/s) 1069s (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 ... 56326 files and directories currently installed.) 1069s Preparing to unpack .../libc6-dev_2.41-1ubuntu2_s390x.deb ... 1069s Unpacking libc6-dev:s390x (2.41-1ubuntu2) over (2.41-1ubuntu1) ... 1069s Preparing to unpack .../libc-dev-bin_2.41-1ubuntu2_s390x.deb ... 1069s Unpacking libc-dev-bin (2.41-1ubuntu2) over (2.41-1ubuntu1) ... 1069s Preparing to unpack .../libc6_2.41-1ubuntu2_s390x.deb ... 1069s Unpacking libc6:s390x (2.41-1ubuntu2) over (2.41-1ubuntu1) ... 1070s Setting up libc6:s390x (2.41-1ubuntu2) ... 1070s (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 ... 56326 files and directories currently installed.) 1070s Preparing to unpack .../libc-bin_2.41-1ubuntu2_s390x.deb ... 1070s Unpacking libc-bin (2.41-1ubuntu2) over (2.41-1ubuntu1) ... 1070s Setting up libc-bin (2.41-1ubuntu2) ... 1070s (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 ... 56326 files and directories currently installed.) 1070s Preparing to unpack .../locales_2.41-1ubuntu2_all.deb ... 1070s Unpacking locales (2.41-1ubuntu2) over (2.41-1ubuntu1) ... 1070s Setting up locales (2.41-1ubuntu2) ... 1070s Generating locales (this might take a while)... 1071s en_US.UTF-8... done 1071s Generation complete. 1071s Setting up libc-dev-bin (2.41-1ubuntu2) ... 1071s Setting up libc6-dev:s390x (2.41-1ubuntu2) ... 1071s Processing triggers for man-db (2.13.0-1) ... 1072s Processing triggers for systemd (257.3-1ubuntu3) ... 1073s Reading package lists... 1073s Building dependency tree... 1073s Reading state information... 1073s Starting pkgProblemResolver with broken count: 0 1073s Starting 2 pkgProblemResolver with broken count: 0 1073s Done 1073s Solving dependencies... 1073s 0 upgraded, 0 newly installed, 0 to remove and 0 not upgraded. 1073s autopkgtest [18:28:30]: rebooting testbed after setup commands that affected boot 1077s autopkgtest-virt-ssh: WARNING: ssh connection failed. Retrying in 3 seconds... 1091s autopkgtest [18:28:48]: testbed running kernel: Linux 6.14.0-10-generic #10-Ubuntu SMP Wed Mar 12 14:53:49 UTC 2025 1094s autopkgtest [18:28:51]: @@@@@@@@@@@@@@@@@@@@ apt-source r-cran-mcmc 1096s Get:1 http://ftpmaster.internal/ubuntu plucky/universe r-cran-mcmc 0.9-8-1 (dsc) [2083 B] 1096s Get:2 http://ftpmaster.internal/ubuntu plucky/universe r-cran-mcmc 0.9-8-1 (tar) [1542 kB] 1096s Get:3 http://ftpmaster.internal/ubuntu plucky/universe r-cran-mcmc 0.9-8-1 (diff) [3320 B] 1097s gpgv: Signature made Tue Nov 21 10:57:44 2023 UTC 1097s gpgv: using RSA key F1F007320A035541F0A663CA578A0494D1C646D1 1097s gpgv: issuer "tille@debian.org" 1097s gpgv: Can't check signature: No public key 1097s dpkg-source: warning: cannot verify inline signature for ./r-cran-mcmc_0.9-8-1.dsc: no acceptable signature found 1097s autopkgtest [18:28:54]: testing package r-cran-mcmc version 0.9-8-1 1097s autopkgtest [18:28:54]: build not needed 1099s autopkgtest [18:28:56]: test generic: preparing testbed 1099s Reading package lists... 1099s Building dependency tree... 1099s Reading state information... 1099s Starting pkgProblemResolver with broken count: 0 1099s Starting 2 pkgProblemResolver with broken count: 0 1099s Done 1100s The following NEW packages will be installed: 1100s fontconfig fontconfig-config fonts-dejavu-core fonts-dejavu-mono libblas3 1100s libcairo2 libdatrie1 libdeflate0 libfontconfig1 libfreetype6 libgfortran5 1100s libgomp1 libgraphite2-3 libharfbuzz0b libice6 libjbig0 libjpeg-turbo8 1100s libjpeg8 liblapack3 libpango-1.0-0 libpangocairo-1.0-0 libpangoft2-1.0-0 1100s libpaper-utils libpaper2 libpixman-1-0 libsharpyuv0 libsm6 libtcl8.6 1100s libthai-data libthai0 libtiff6 libtk8.6 libwebp7 libxcb-render0 libxcb-shm0 1100s libxft2 libxrender1 libxss1 libxt6t64 r-base-core r-cran-iso r-cran-mcmc 1100s r-cran-xtable unzip x11-common xdg-utils zip 1100s 0 upgraded, 47 newly installed, 0 to remove and 0 not upgraded. 1100s Need to get 42.2 MB of archives. 1100s After this operation, 83.8 MB of additional disk space will be used. 1100s Get:1 http://ftpmaster.internal/ubuntu plucky/main s390x libfreetype6 s390x 2.13.3+dfsg-1 [431 kB] 1100s Get:2 http://ftpmaster.internal/ubuntu plucky/main s390x fonts-dejavu-mono all 2.37-8 [502 kB] 1101s Get:3 http://ftpmaster.internal/ubuntu plucky/main s390x fonts-dejavu-core all 2.37-8 [835 kB] 1102s Get:4 http://ftpmaster.internal/ubuntu plucky/main s390x fontconfig-config s390x 2.15.0-2ubuntu1 [37.5 kB] 1102s Get:5 http://ftpmaster.internal/ubuntu plucky/main s390x libfontconfig1 s390x 2.15.0-2ubuntu1 [150 kB] 1102s Get:6 http://ftpmaster.internal/ubuntu plucky/main s390x fontconfig s390x 2.15.0-2ubuntu1 [191 kB] 1102s Get:7 http://ftpmaster.internal/ubuntu plucky/main s390x libblas3 s390x 3.12.1-2 [252 kB] 1102s Get:8 http://ftpmaster.internal/ubuntu plucky/main s390x libpixman-1-0 s390x 0.44.0-3 [201 kB] 1102s Get:9 http://ftpmaster.internal/ubuntu plucky/main s390x libxcb-render0 s390x 1.17.0-2 [17.0 kB] 1102s Get:10 http://ftpmaster.internal/ubuntu plucky/main s390x libxcb-shm0 s390x 1.17.0-2 [5862 B] 1102s Get:11 http://ftpmaster.internal/ubuntu plucky/main s390x libxrender1 s390x 1:0.9.10-1.1build1 [20.4 kB] 1102s Get:12 http://ftpmaster.internal/ubuntu plucky/main s390x libcairo2 s390x 1.18.2-2 [580 kB] 1103s Get:13 http://ftpmaster.internal/ubuntu plucky/main s390x libdatrie1 s390x 0.2.13-3build1 [20.6 kB] 1103s Get:14 http://ftpmaster.internal/ubuntu plucky/main s390x libdeflate0 s390x 1.23-1 [46.1 kB] 1103s Get:15 http://ftpmaster.internal/ubuntu plucky/main s390x libgfortran5 s390x 15-20250222-0ubuntu1 [620 kB] 1103s Get:16 http://ftpmaster.internal/ubuntu plucky/main s390x libgomp1 s390x 15-20250222-0ubuntu1 [152 kB] 1103s Get:17 http://ftpmaster.internal/ubuntu plucky/main s390x libgraphite2-3 s390x 1.3.14-2ubuntu1 [79.8 kB] 1103s Get:18 http://ftpmaster.internal/ubuntu plucky/main s390x libharfbuzz0b s390x 10.2.0-1 [538 kB] 1104s Get:19 http://ftpmaster.internal/ubuntu plucky/main s390x x11-common all 1:7.7+23ubuntu3 [21.7 kB] 1104s Get:20 http://ftpmaster.internal/ubuntu plucky/main s390x libice6 s390x 2:1.1.1-1 [45.4 kB] 1104s Get:21 http://ftpmaster.internal/ubuntu plucky/main s390x libjpeg-turbo8 s390x 2.1.5-3ubuntu2 [147 kB] 1104s Get:22 http://ftpmaster.internal/ubuntu plucky/main s390x libjpeg8 s390x 8c-2ubuntu11 [2146 B] 1104s Get:23 http://ftpmaster.internal/ubuntu plucky/main s390x liblapack3 s390x 3.12.1-2 [2971 kB] 1106s Get:24 http://ftpmaster.internal/ubuntu plucky/main s390x libthai-data all 0.1.29-2build1 [158 kB] 1107s Get:25 http://ftpmaster.internal/ubuntu plucky/main s390x libthai0 s390x 0.1.29-2build1 [20.7 kB] 1107s Get:26 http://ftpmaster.internal/ubuntu plucky/main s390x libpango-1.0-0 s390x 1.56.2-1 [253 kB] 1107s Get:27 http://ftpmaster.internal/ubuntu plucky/main s390x libpangoft2-1.0-0 s390x 1.56.2-1 [50.2 kB] 1107s Get:28 http://ftpmaster.internal/ubuntu plucky/main s390x libpangocairo-1.0-0 s390x 1.56.2-1 [28.2 kB] 1107s Get:29 http://ftpmaster.internal/ubuntu plucky/main s390x libpaper2 s390x 2.2.5-0.3 [17.2 kB] 1107s Get:30 http://ftpmaster.internal/ubuntu plucky/main s390x libpaper-utils s390x 2.2.5-0.3 [15.3 kB] 1107s Get:31 http://ftpmaster.internal/ubuntu plucky/main s390x libsharpyuv0 s390x 1.5.0-0.1 [16.7 kB] 1107s Get:32 http://ftpmaster.internal/ubuntu plucky/main s390x libsm6 s390x 2:1.2.4-1 [18.4 kB] 1107s Get:33 http://ftpmaster.internal/ubuntu plucky/main s390x libtcl8.6 s390x 8.6.16+dfsg-1 [1034 kB] 1108s Get:34 http://ftpmaster.internal/ubuntu plucky/main s390x libjbig0 s390x 2.1-6.1ubuntu2 [33.1 kB] 1108s Get:35 http://ftpmaster.internal/ubuntu plucky/main s390x libwebp7 s390x 1.5.0-0.1 [210 kB] 1108s Get:36 http://ftpmaster.internal/ubuntu plucky/main s390x libtiff6 s390x 4.5.1+git230720-4ubuntu4 [217 kB] 1108s Get:37 http://ftpmaster.internal/ubuntu plucky/main s390x libxft2 s390x 2.3.6-1build1 [49.6 kB] 1108s Get:38 http://ftpmaster.internal/ubuntu plucky/main s390x libxss1 s390x 1:1.2.3-1build3 [7396 B] 1108s Get:39 http://ftpmaster.internal/ubuntu plucky/main s390x libtk8.6 s390x 8.6.16-1 [830 kB] 1109s Get:40 http://ftpmaster.internal/ubuntu plucky/main s390x libxt6t64 s390x 1:1.2.1-1.2build1 [184 kB] 1109s Get:41 http://ftpmaster.internal/ubuntu plucky/main s390x zip s390x 3.0-14ubuntu2 [187 kB] 1109s Get:42 http://ftpmaster.internal/ubuntu plucky/main s390x unzip s390x 6.0-28ubuntu6 [186 kB] 1109s Get:43 http://ftpmaster.internal/ubuntu plucky/main s390x xdg-utils all 1.2.1-2ubuntu1 [66.0 kB] 1109s Get:44 http://ftpmaster.internal/ubuntu plucky/universe s390x r-base-core s390x 4.4.3-1 [28.6 MB] 1132s Get:45 http://ftpmaster.internal/ubuntu plucky/universe s390x r-cran-iso s390x 0.0-21-1 [167 kB] 1132s Get:46 http://ftpmaster.internal/ubuntu plucky/universe s390x r-cran-mcmc s390x 0.9-8-1 [1228 kB] 1133s Get:47 http://ftpmaster.internal/ubuntu plucky/universe s390x r-cran-xtable all 1:1.8-4-2 [689 kB] 1134s Preconfiguring packages ... 1134s Fetched 42.2 MB in 34s (1233 kB/s) 1134s Selecting previously unselected package libfreetype6:s390x. 1134s (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 ... 56326 files and directories currently installed.) 1134s Preparing to unpack .../00-libfreetype6_2.13.3+dfsg-1_s390x.deb ... 1134s Unpacking libfreetype6:s390x (2.13.3+dfsg-1) ... 1134s Selecting previously unselected package fonts-dejavu-mono. 1134s Preparing to unpack .../01-fonts-dejavu-mono_2.37-8_all.deb ... 1134s Unpacking fonts-dejavu-mono (2.37-8) ... 1134s Selecting previously unselected package fonts-dejavu-core. 1134s Preparing to unpack .../02-fonts-dejavu-core_2.37-8_all.deb ... 1134s Unpacking fonts-dejavu-core (2.37-8) ... 1134s Selecting previously unselected package fontconfig-config. 1134s Preparing to unpack .../03-fontconfig-config_2.15.0-2ubuntu1_s390x.deb ... 1134s Unpacking fontconfig-config (2.15.0-2ubuntu1) ... 1134s Selecting previously unselected package libfontconfig1:s390x. 1134s Preparing to unpack .../04-libfontconfig1_2.15.0-2ubuntu1_s390x.deb ... 1134s Unpacking libfontconfig1:s390x (2.15.0-2ubuntu1) ... 1134s Selecting previously unselected package fontconfig. 1134s Preparing to unpack .../05-fontconfig_2.15.0-2ubuntu1_s390x.deb ... 1134s Unpacking fontconfig (2.15.0-2ubuntu1) ... 1135s Selecting previously unselected package libblas3:s390x. 1135s Preparing to unpack .../06-libblas3_3.12.1-2_s390x.deb ... 1135s Unpacking libblas3:s390x (3.12.1-2) ... 1135s Selecting previously unselected package libpixman-1-0:s390x. 1135s Preparing to unpack .../07-libpixman-1-0_0.44.0-3_s390x.deb ... 1135s Unpacking libpixman-1-0:s390x (0.44.0-3) ... 1135s Selecting previously unselected package libxcb-render0:s390x. 1135s Preparing to unpack .../08-libxcb-render0_1.17.0-2_s390x.deb ... 1135s Unpacking libxcb-render0:s390x (1.17.0-2) ... 1135s Selecting previously unselected package libxcb-shm0:s390x. 1135s Preparing to unpack .../09-libxcb-shm0_1.17.0-2_s390x.deb ... 1135s Unpacking libxcb-shm0:s390x (1.17.0-2) ... 1135s Selecting previously unselected package libxrender1:s390x. 1135s Preparing to unpack .../10-libxrender1_1%3a0.9.10-1.1build1_s390x.deb ... 1135s Unpacking libxrender1:s390x (1:0.9.10-1.1build1) ... 1135s Selecting previously unselected package libcairo2:s390x. 1135s Preparing to unpack .../11-libcairo2_1.18.2-2_s390x.deb ... 1135s Unpacking libcairo2:s390x (1.18.2-2) ... 1135s Selecting previously unselected package libdatrie1:s390x. 1135s Preparing to unpack .../12-libdatrie1_0.2.13-3build1_s390x.deb ... 1135s Unpacking libdatrie1:s390x (0.2.13-3build1) ... 1135s Selecting previously unselected package libdeflate0:s390x. 1135s Preparing to unpack .../13-libdeflate0_1.23-1_s390x.deb ... 1135s Unpacking libdeflate0:s390x (1.23-1) ... 1135s Selecting previously unselected package libgfortran5:s390x. 1135s Preparing to unpack .../14-libgfortran5_15-20250222-0ubuntu1_s390x.deb ... 1135s Unpacking libgfortran5:s390x (15-20250222-0ubuntu1) ... 1135s Selecting previously unselected package libgomp1:s390x. 1135s Preparing to unpack .../15-libgomp1_15-20250222-0ubuntu1_s390x.deb ... 1135s Unpacking libgomp1:s390x (15-20250222-0ubuntu1) ... 1135s Selecting previously unselected package libgraphite2-3:s390x. 1135s Preparing to unpack .../16-libgraphite2-3_1.3.14-2ubuntu1_s390x.deb ... 1135s Unpacking libgraphite2-3:s390x (1.3.14-2ubuntu1) ... 1135s Selecting previously unselected package libharfbuzz0b:s390x. 1135s Preparing to unpack .../17-libharfbuzz0b_10.2.0-1_s390x.deb ... 1135s Unpacking libharfbuzz0b:s390x (10.2.0-1) ... 1135s Selecting previously unselected package x11-common. 1135s Preparing to unpack .../18-x11-common_1%3a7.7+23ubuntu3_all.deb ... 1135s Unpacking x11-common (1:7.7+23ubuntu3) ... 1135s Selecting previously unselected package libice6:s390x. 1135s Preparing to unpack .../19-libice6_2%3a1.1.1-1_s390x.deb ... 1135s Unpacking libice6:s390x (2:1.1.1-1) ... 1135s Selecting previously unselected package libjpeg-turbo8:s390x. 1135s Preparing to unpack .../20-libjpeg-turbo8_2.1.5-3ubuntu2_s390x.deb ... 1135s Unpacking libjpeg-turbo8:s390x (2.1.5-3ubuntu2) ... 1135s Selecting previously unselected package libjpeg8:s390x. 1135s Preparing to unpack .../21-libjpeg8_8c-2ubuntu11_s390x.deb ... 1135s Unpacking libjpeg8:s390x (8c-2ubuntu11) ... 1135s Selecting previously unselected package liblapack3:s390x. 1135s Preparing to unpack .../22-liblapack3_3.12.1-2_s390x.deb ... 1135s Unpacking liblapack3:s390x (3.12.1-2) ... 1135s Selecting previously unselected package libthai-data. 1135s Preparing to unpack .../23-libthai-data_0.1.29-2build1_all.deb ... 1135s Unpacking libthai-data (0.1.29-2build1) ... 1135s Selecting previously unselected package libthai0:s390x. 1135s Preparing to unpack .../24-libthai0_0.1.29-2build1_s390x.deb ... 1135s Unpacking libthai0:s390x (0.1.29-2build1) ... 1135s Selecting previously unselected package libpango-1.0-0:s390x. 1135s Preparing to unpack .../25-libpango-1.0-0_1.56.2-1_s390x.deb ... 1135s Unpacking libpango-1.0-0:s390x (1.56.2-1) ... 1135s Selecting previously unselected package libpangoft2-1.0-0:s390x. 1135s Preparing to unpack .../26-libpangoft2-1.0-0_1.56.2-1_s390x.deb ... 1135s Unpacking libpangoft2-1.0-0:s390x (1.56.2-1) ... 1135s Selecting previously unselected package libpangocairo-1.0-0:s390x. 1135s Preparing to unpack .../27-libpangocairo-1.0-0_1.56.2-1_s390x.deb ... 1135s Unpacking libpangocairo-1.0-0:s390x (1.56.2-1) ... 1135s Selecting previously unselected package libpaper2:s390x. 1135s Preparing to unpack .../28-libpaper2_2.2.5-0.3_s390x.deb ... 1135s Unpacking libpaper2:s390x (2.2.5-0.3) ... 1135s Selecting previously unselected package libpaper-utils. 1135s Preparing to unpack .../29-libpaper-utils_2.2.5-0.3_s390x.deb ... 1135s Unpacking libpaper-utils (2.2.5-0.3) ... 1135s Selecting previously unselected package libsharpyuv0:s390x. 1135s Preparing to unpack .../30-libsharpyuv0_1.5.0-0.1_s390x.deb ... 1135s Unpacking libsharpyuv0:s390x (1.5.0-0.1) ... 1135s Selecting previously unselected package libsm6:s390x. 1135s Preparing to unpack .../31-libsm6_2%3a1.2.4-1_s390x.deb ... 1135s Unpacking libsm6:s390x (2:1.2.4-1) ... 1135s Selecting previously unselected package libtcl8.6:s390x. 1135s Preparing to unpack .../32-libtcl8.6_8.6.16+dfsg-1_s390x.deb ... 1135s Unpacking libtcl8.6:s390x (8.6.16+dfsg-1) ... 1135s Selecting previously unselected package libjbig0:s390x. 1135s Preparing to unpack .../33-libjbig0_2.1-6.1ubuntu2_s390x.deb ... 1135s Unpacking libjbig0:s390x (2.1-6.1ubuntu2) ... 1135s Selecting previously unselected package libwebp7:s390x. 1135s Preparing to unpack .../34-libwebp7_1.5.0-0.1_s390x.deb ... 1135s Unpacking libwebp7:s390x (1.5.0-0.1) ... 1135s Selecting previously unselected package libtiff6:s390x. 1135s Preparing to unpack .../35-libtiff6_4.5.1+git230720-4ubuntu4_s390x.deb ... 1135s Unpacking libtiff6:s390x (4.5.1+git230720-4ubuntu4) ... 1135s Selecting previously unselected package libxft2:s390x. 1135s Preparing to unpack .../36-libxft2_2.3.6-1build1_s390x.deb ... 1135s Unpacking libxft2:s390x (2.3.6-1build1) ... 1135s Selecting previously unselected package libxss1:s390x. 1135s Preparing to unpack .../37-libxss1_1%3a1.2.3-1build3_s390x.deb ... 1135s Unpacking libxss1:s390x (1:1.2.3-1build3) ... 1135s Selecting previously unselected package libtk8.6:s390x. 1135s Preparing to unpack .../38-libtk8.6_8.6.16-1_s390x.deb ... 1135s Unpacking libtk8.6:s390x (8.6.16-1) ... 1135s Selecting previously unselected package libxt6t64:s390x. 1135s Preparing to unpack .../39-libxt6t64_1%3a1.2.1-1.2build1_s390x.deb ... 1135s Unpacking libxt6t64:s390x (1:1.2.1-1.2build1) ... 1135s Selecting previously unselected package zip. 1135s Preparing to unpack .../40-zip_3.0-14ubuntu2_s390x.deb ... 1135s Unpacking zip (3.0-14ubuntu2) ... 1135s Selecting previously unselected package unzip. 1135s Preparing to unpack .../41-unzip_6.0-28ubuntu6_s390x.deb ... 1135s Unpacking unzip (6.0-28ubuntu6) ... 1135s Selecting previously unselected package xdg-utils. 1135s Preparing to unpack .../42-xdg-utils_1.2.1-2ubuntu1_all.deb ... 1135s Unpacking xdg-utils (1.2.1-2ubuntu1) ... 1135s Selecting previously unselected package r-base-core. 1135s Preparing to unpack .../43-r-base-core_4.4.3-1_s390x.deb ... 1135s Unpacking r-base-core (4.4.3-1) ... 1135s Selecting previously unselected package r-cran-iso. 1135s Preparing to unpack .../44-r-cran-iso_0.0-21-1_s390x.deb ... 1135s Unpacking r-cran-iso (0.0-21-1) ... 1135s Selecting previously unselected package r-cran-mcmc. 1135s Preparing to unpack .../45-r-cran-mcmc_0.9-8-1_s390x.deb ... 1135s Unpacking r-cran-mcmc (0.9-8-1) ... 1135s Selecting previously unselected package r-cran-xtable. 1135s Preparing to unpack .../46-r-cran-xtable_1%3a1.8-4-2_all.deb ... 1135s Unpacking r-cran-xtable (1:1.8-4-2) ... 1135s Setting up libgraphite2-3:s390x (1.3.14-2ubuntu1) ... 1135s Setting up libpixman-1-0:s390x (0.44.0-3) ... 1135s Setting up libsharpyuv0:s390x (1.5.0-0.1) ... 1135s Setting up libxrender1:s390x (1:0.9.10-1.1build1) ... 1135s Setting up libdatrie1:s390x (0.2.13-3build1) ... 1135s Setting up libxcb-render0:s390x (1.17.0-2) ... 1135s Setting up unzip (6.0-28ubuntu6) ... 1135s Setting up x11-common (1:7.7+23ubuntu3) ... 1136s Setting up libdeflate0:s390x (1.23-1) ... 1136s Setting up libxcb-shm0:s390x (1.17.0-2) ... 1136s Setting up libgomp1:s390x (15-20250222-0ubuntu1) ... 1136s Setting up libjbig0:s390x (2.1-6.1ubuntu2) ... 1136s Setting up zip (3.0-14ubuntu2) ... 1136s Setting up libblas3:s390x (3.12.1-2) ... 1136s update-alternatives: using /usr/lib/s390x-linux-gnu/blas/libblas.so.3 to provide /usr/lib/s390x-linux-gnu/libblas.so.3 (libblas.so.3-s390x-linux-gnu) in auto mode 1136s Setting up libfreetype6:s390x (2.13.3+dfsg-1) ... 1136s Setting up fonts-dejavu-mono (2.37-8) ... 1136s Setting up libtcl8.6:s390x (8.6.16+dfsg-1) ... 1136s Setting up fonts-dejavu-core (2.37-8) ... 1136s Setting up libjpeg-turbo8:s390x (2.1.5-3ubuntu2) ... 1136s Setting up libgfortran5:s390x (15-20250222-0ubuntu1) ... 1136s Setting up libwebp7:s390x (1.5.0-0.1) ... 1136s Setting up libharfbuzz0b:s390x (10.2.0-1) ... 1136s Setting up libthai-data (0.1.29-2build1) ... 1136s Setting up libxss1:s390x (1:1.2.3-1build3) ... 1136s Setting up libpaper2:s390x (2.2.5-0.3) ... 1136s Setting up xdg-utils (1.2.1-2ubuntu1) ... 1136s update-alternatives: using /usr/bin/xdg-open to provide /usr/bin/open (open) in auto mode 1136s Setting up libjpeg8:s390x (8c-2ubuntu11) ... 1136s Setting up libice6:s390x (2:1.1.1-1) ... 1136s Setting up liblapack3:s390x (3.12.1-2) ... 1136s update-alternatives: using /usr/lib/s390x-linux-gnu/lapack/liblapack.so.3 to provide /usr/lib/s390x-linux-gnu/liblapack.so.3 (liblapack.so.3-s390x-linux-gnu) in auto mode 1136s Setting up fontconfig-config (2.15.0-2ubuntu1) ... 1136s Setting up libpaper-utils (2.2.5-0.3) ... 1136s Setting up libthai0:s390x (0.1.29-2build1) ... 1136s Setting up libtiff6:s390x (4.5.1+git230720-4ubuntu4) ... 1136s Setting up libfontconfig1:s390x (2.15.0-2ubuntu1) ... 1136s Setting up libsm6:s390x (2:1.2.4-1) ... 1136s Setting up fontconfig (2.15.0-2ubuntu1) ... 1138s Regenerating fonts cache... done. 1138s Setting up libxft2:s390x (2.3.6-1build1) ... 1138s Setting up libtk8.6:s390x (8.6.16-1) ... 1138s Setting up libpango-1.0-0:s390x (1.56.2-1) ... 1138s Setting up libcairo2:s390x (1.18.2-2) ... 1138s Setting up libxt6t64:s390x (1:1.2.1-1.2build1) ... 1138s Setting up libpangoft2-1.0-0:s390x (1.56.2-1) ... 1138s Setting up libpangocairo-1.0-0:s390x (1.56.2-1) ... 1138s Setting up r-base-core (4.4.3-1) ... 1138s Creating config file /etc/R/Renviron with new version 1138s Setting up r-cran-mcmc (0.9-8-1) ... 1138s Setting up r-cran-iso (0.0-21-1) ... 1138s Setting up r-cran-xtable (1:1.8-4-2) ... 1138s Processing triggers for libc-bin (2.41-1ubuntu2) ... 1138s Processing triggers for man-db (2.13.0-1) ... 1139s Processing triggers for install-info (7.1.1-1) ... 1140s autopkgtest [18:29:37]: test generic: [----------------------- 1140s BEGIN TEST tests/accept-batch.R 1140s 1140s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1140s Copyright (C) 2025 The R Foundation for Statistical Computing 1140s Platform: s390x-ibm-linux-gnu 1140s 1140s R is free software and comes with ABSOLUTELY NO WARRANTY. 1140s You are welcome to redistribute it under certain conditions. 1140s Type 'license()' or 'licence()' for distribution details. 1140s 1140s R is a collaborative project with many contributors. 1140s Type 'contributors()' for more information and 1140s 'citation()' on how to cite R or R packages in publications. 1140s 1140s Type 'demo()' for some demos, 'help()' for on-line help, or 1140s 'help.start()' for an HTML browser interface to help. 1140s Type 'q()' to quit R. 1140s 1140s > 1140s > # new feature batching acceptance rates 1140s > 1140s > set.seed(42) 1140s > 1140s > library(mcmc) 1140s > 1140s > h <- function(x) if (all(x >= 0) && sum(x) <= 1) return(1) else return(-Inf) 1140s > out <- metrop(h, rep(0, 5), nbatch = 100, blen = 100, scale = 0.1, 1140s + debug = TRUE) 1140s > 1140s > all.equal(out$accept, mean(out$accept.batch)) 1140s [1] TRUE 1140s > 1140s > foo <- matrix(out$debug.accept, nrow = out$blen) 1140s > bar <- colMeans(foo) 1140s > all.equal(out$accept.batch, bar) 1140s [1] TRUE 1140s > 1140s > options(digits = 4) # try to keep insanity of computer arithmetic under control 1140s > 1140s > out$accept 1140s [1] 0.2257 1140s > t.test(out$accept.batch)$conf.int 1140s [1] 0.2124 0.2390 1140s attr(,"conf.level") 1140s [1] 0.95 1140s > 1140s > 1140s BEGIN TEST tests/circle.R 1140s 1140s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1140s Copyright (C) 2025 The R Foundation for Statistical Computing 1140s Platform: s390x-ibm-linux-gnu 1140s 1140s R is free software and comes with ABSOLUTELY NO WARRANTY. 1140s You are welcome to redistribute it under certain conditions. 1140s Type 'license()' or 'licence()' for distribution details. 1140s 1140s R is a collaborative project with many contributors. 1140s Type 'contributors()' for more information and 1140s 'citation()' on how to cite R or R packages in publications. 1140s 1140s Type 'demo()' for some demos, 'help()' for on-line help, or 1140s 'help.start()' for an HTML browser interface to help. 1140s Type 'q()' to quit R. 1140s 1140s > 1140s > epsilon <- 1e-15 1140s > 1140s > library(mcmc) 1140s > 1140s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 1140s > set.seed(42) 1140s > 1140s > d <- 5 1140s > 1140s > logh <- function(x) { 1140s + if (! is.numeric(x)) stop("x not numeric") 1140s + if (length(x) != d) stop("length(x) != d") 1140s + fred <- 1 - sum(x^2) 1140s + if (fred > 0) return(log(fred)) else return(-Inf) 1140s + } 1140s > 1140s > out.metro <- metrop(logh, rep(0, d), 1e3, scale = 0.01) 1140s > out.metro$accept 1140s [1] 0.979 1140s > 1140s > out.metro <- metrop(out.metro, scale = 0.1) 1140s > out.metro$accept 1140s [1] 0.72 1140s > 1140s > out.metro <- metrop(out.metro, scale = 0.5) 1140s > out.metro$accept 1140s [1] 0.16 1140s > 1140s > out.metro <- metrop(out.metro, scale = 0.4) 1140s > out.metro$accept 1140s [1] 0.228 1140s > 1140s > out.metro <- metrop(out.metro, nbatch = 1e2, debug = TRUE) 1140s > 1140s > all(out.metro$batch[- out.metro$nbatch, ] == out.metro$current[- 1, ]) 1140s [1] TRUE 1140s > all(out.metro$current[1, ] == out.metro$initial) 1140s [1] TRUE 1140s > all(out.metro$batch[out.metro$nbatch, ] == out.metro$final) 1140s [1] TRUE 1140s > 1140s > .Random.seed <- out.metro$initial.seed 1140s > d <- ncol(out.metro$proposal) 1140s > n <- nrow(out.metro$proposal) 1140s > my.proposal <- matrix(NA, n, d) 1140s > my.u <- double(n) 1140s > ska <- out.metro$scale 1140s > for (i in 1:n) { 1140s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 1140s + if (is.na(out.metro$u[i])) { 1140s + my.u[i] <- NA 1140s + } else { 1140s + my.u[i] <- runif(1) 1140s + } 1140s + } 1140s > max(abs(out.metro$proposal - my.proposal)) < epsilon 1140s [1] TRUE 1140s > all(is.na(out.metro$u) == is.na(my.u)) 1140s [1] TRUE 1140s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 1140s [1] TRUE 1140s > 1140s > my.curr.log.green <- apply(out.metro$current, 1, logh) 1140s > my.prop.log.green <- apply(out.metro$proposal, 1, logh) 1140s > all(is.na(out.metro$u) == ((my.prop.log.green == -Inf) | 1140s + (my.prop.log.green > my.curr.log.green))) 1140s [1] TRUE 1140s > foo <- my.prop.log.green - my.curr.log.green 1140s > blurfle <- foo - out.metro$log.green 1140s > blurfle[foo == -Inf & out.metro$log.green == -Inf] <- 0 1140s > max(blurfle) < epsilon 1140s [1] TRUE 1140s > 1140s > my.accept <- (my.prop.log.green > -Inf) & (is.na(my.u) | my.u < exp(foo)) 1140s > sum(my.accept) == round(n * out.metro$accept) 1140s [1] TRUE 1140s > 1140s > my.path <- matrix(NA, n, d) 1140s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 1140s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 1140s > 1140s > all(my.path == out.metro$batch) 1140s [1] TRUE 1140s > 1140s > 1140s BEGIN TEST tests/initseq.R 1140s 1140s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1140s Copyright (C) 2025 The R Foundation for Statistical Computing 1140s Platform: s390x-ibm-linux-gnu 1140s 1140s R is free software and comes with ABSOLUTELY NO WARRANTY. 1140s You are welcome to redistribute it under certain conditions. 1140s Type 'license()' or 'licence()' for distribution details. 1140s 1140s R is a collaborative project with many contributors. 1140s Type 'contributors()' for more information and 1140s 'citation()' on how to cite R or R packages in publications. 1140s 1140s Type 'demo()' for some demos, 'help()' for on-line help, or 1140s 'help.start()' for an HTML browser interface to help. 1140s Type 'q()' to quit R. 1140s 1140s > 1140s > library(mcmc) 1140s > 1140s > set.seed(42) 1140s > 1140s > n <- 1e5 1140s > rho <- 0.99 1140s > 1140s > x <- arima.sim(model = list(ar = rho), n = n) 1140s > gamma <- acf(x, lag.max = 1999, type = "covariance", 1140s + plot = FALSE)$acf 1141s > k <- seq(along = gamma) 1141s > Gamma <- gamma[k %% 2 == 1] + gamma[k %% 2 == 0] 1141s > k <- min(seq(along = Gamma)[Gamma < 0]) 1141s > Gamma <- Gamma[1:k] 1141s > Gamma[k] < 0 1141s [1] TRUE 1141s > Gamma[k] <- 0 1141s > 1141s > out <- .Call(mcmc:::C_initseq, x - mean(x)) 1141s > names(out) 1141s [1] "gamma0" "Gamma.pos" "Gamma.dec" "Gamma.con" "var.pos" "var.dec" 1141s [7] "var.con" 1141s > 1141s > all.equal(gamma[1], out$gamma0) 1141s [1] TRUE 1141s > 1141s > length(out$Gamma.pos) == length(Gamma) 1141s [1] TRUE 1141s > all.equal(out$Gamma.pos, Gamma) 1141s [1] TRUE 1141s > 1141s > Gamma.dec <- cummin(Gamma) 1141s > all.equal(out$Gamma.dec, Gamma.dec) 1141s [1] TRUE 1141s > 1141s > ## IGNORE_RDIFF_BEGIN 1141s > library(Iso) 1141s > ## IGNORE_RDIFF_END 1141s > Gamma.con <- Gamma.dec[1] + cumsum(c(0, pava(diff(Gamma.dec)))) 1141s > all.equal(out$Gamma.con, Gamma.con) 1141s [1] TRUE 1141s > 1141s > all.equal(0, min(out$Gamma.pos - out$Gamma.dec)) 1141s [1] TRUE 1141s > max(diff(out$Gamma.dec)) < sqrt(.Machine$double.eps) 1141s [1] TRUE 1141s > 1141s > all.equal(0, min(out$Gamma.dec - out$Gamma.con)) 1141s [1] TRUE 1141s > min(diff(diff(out$Gamma.con))) > (- sqrt(.Machine$double.eps)) 1141s [1] TRUE 1141s > 1141s > all.equal(2 * sum(out$Gamma.pos) - out$gamma0, out$var.pos) 1141s [1] TRUE 1141s > all.equal(2 * sum(out$Gamma.dec) - out$gamma0, out$var.dec) 1141s [1] TRUE 1141s > all.equal(2 * sum(out$Gamma.con) - out$gamma0, out$var.con) 1141s [1] TRUE 1141s > 1141s > rev(out$Gamma.pos)[1] == 0 1141s [1] TRUE 1141s > rev(out$Gamma.dec)[1] == 0 1141s [1] TRUE 1141s > all.equal(rev(out$Gamma.con)[1], 0) 1141s [1] TRUE 1141s > 1141s > 1141s Iso 0.0-21 1141s 1141s An "infelicity" in the function ufit() (whereby 1141s it was all too easy to conflate the location of 1141s the mode with its index in the entries of the 1141s "x" argument) has been corrected. To this end, 1141s ufit() now has arguments "lmode" (the location 1141s of the mode), and "imode" (its index). At most 1141s one of these arguments should be specified. See 1141s the help for ufit(). 1141s BEGIN TEST tests/isotropic.R 1141s 1141s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1141s Copyright (C) 2025 The R Foundation for Statistical Computing 1141s Platform: s390x-ibm-linux-gnu 1141s 1141s R is free software and comes with ABSOLUTELY NO WARRANTY. 1141s You are welcome to redistribute it under certain conditions. 1141s Type 'license()' or 'licence()' for distribution details. 1141s 1141s R is a collaborative project with many contributors. 1141s Type 'contributors()' for more information and 1141s 'citation()' on how to cite R or R packages in publications. 1141s 1141s Type 'demo()' for some demos, 'help()' for on-line help, or 1141s 'help.start()' for an HTML browser interface to help. 1141s Type 'q()' to quit R. 1141s 1141s > library(mcmc) 1141s > isotropic <- mcmc:::isotropic 1141s > isotropic.logjacobian <- mcmc:::isotropic.logjacobian 1141s > 1141s > # create identity test function 1141s > identity <- function(x) x 1141s > d.identity <- function(x) 1 1141s > 1141s > # check that isotropic is length preserving for vectors of lengths 1--1000 1141s > all(sapply(1:1000, function(x) length(isotropic(identity)(rep(1, x))) == x)) 1141s [1] TRUE 1141s > 1141s > # test that isotropic(identity) is an identity function 1141s > all.equal(isotropic(identity)(1:10), 1:10) 1141s [1] TRUE 1141s > x <- seq(0, 1, length.out=200) 1141s > all.equal(isotropic(identity)(x), x) 1141s [1] TRUE 1141s > 1141s > # make sure that isotropic.logjacobian(identity, d.identity) is a 0 function 1141s > all.equal(isotropic.logjacobian(identity, d.identity)(1:10), 0) 1141s [1] TRUE 1141s > 1141s > # make sure that 0 as an input does not cause divide-by-zero errors 1141s > all.equal(isotropic(identity)(0), 0) 1141s [1] TRUE 1141s > all.equal(isotropic(identity)(0 * 1:4), rep(0, 4)) 1141s [1] TRUE 1141s > all.equal(isotropic.logjacobian(identity, d.identity)(0), 0) 1141s [1] TRUE 1141s > all.equal(isotropic.logjacobian(identity, d.identity)(0 * 1:4), 0) 1141s [1] TRUE 1141s > 1141s > # try isotropic with f(x) = x^2, then we should get 1141s > # istropic(f)(x) := |x| * x 1141s > f <- function(x) x^2 1141s > all.equal(isotropic(f)(1), 1) 1141s [1] TRUE 1141s > all.equal(isotropic(f)(c(1, 1)), sqrt(2) * c(1, 1)) 1141s [1] TRUE 1141s > all.equal(isotropic(f)(c(1, 0, 1)), sqrt(2) * c(1, 0, 1)) 1141s [1] TRUE 1141s > 1141s > # make sure lazy-loading works properly. 1141s > g <- function(x) x^2 1141s > g.iso <- isotropic(g) 1141s > g <- function(x) x 1141s > all.equal(g.iso(2), 2*2) 1141s [1] TRUE 1141s > 1141s BEGIN TEST tests/logit.R 1141s 1141s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1141s Copyright (C) 2025 The R Foundation for Statistical Computing 1141s Platform: s390x-ibm-linux-gnu 1141s 1141s R is free software and comes with ABSOLUTELY NO WARRANTY. 1141s You are welcome to redistribute it under certain conditions. 1141s Type 'license()' or 'licence()' for distribution details. 1141s 1141s R is a collaborative project with many contributors. 1141s Type 'contributors()' for more information and 1141s 'citation()' on how to cite R or R packages in publications. 1141s 1141s Type 'demo()' for some demos, 'help()' for on-line help, or 1141s 'help.start()' for an HTML browser interface to help. 1141s Type 'q()' to quit R. 1141s 1141s > 1141s > epsilon <- 1e-15 1141s > 1141s > library(mcmc) 1141s > 1141s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 1141s > set.seed(42) 1141s > 1141s > options(digits = 3) 1141s > 1141s > n <- 100 1141s > rho <- 0.5 1141s > beta0 <- 0.25 1141s > beta1 <- 1 1141s > beta2 <- 0.5 1141s > 1141s > x1 <- rnorm(n) 1141s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 1141s > eta <- beta0 + beta1 * x1 + beta2 * x2 1141s > p <- 1 / (1 + exp(- eta)) 1141s > y <- as.numeric(runif(n) < p) 1141s > 1141s > out <- glm(y ~ x1 + x2, family = binomial()) 1141s > ## IGNORE_RDIFF_BEGIN 1141s > summary(out) 1141s 1141s Call: 1141s glm(formula = y ~ x1 + x2, family = binomial()) 1141s 1141s Coefficients: 1141s Estimate Std. Error z value Pr(>|z|) 1141s (Intercept) 0.0599 0.2477 0.24 0.80905 1141s x1 1.3682 0.3844 3.56 0.00037 *** 1141s x2 0.4760 0.3135 1.52 0.12886 1141s --- 1141s Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 1141s 1141s (Dispersion parameter for binomial family taken to be 1) 1141s 1141s Null deviance: 138.469 on 99 degrees of freedom 1141s Residual deviance: 99.293 on 97 degrees of freedom 1141s AIC: 105.3 1141s 1141s Number of Fisher Scoring iterations: 5 1141s 1141s > ## IGNORE_RDIFF_END 1141s > 1141s > mlogl <- function(beta) { 1141s + if (length(beta) != 3) stop("length(beta) != 3") 1141s + beta0 <- beta[1] 1141s + beta1 <- beta[2] 1141s + beta2 <- beta[3] 1141s + eta <- beta0 + beta1 * x1 + beta2 * x2 1141s + p <- exp(eta) / (1 + exp(eta)) 1141s + return(- sum(log(p[y == 1])) - sum(log(1 - p[y == 0]))) 1141s + } 1141s > 1141s > ## IGNORE_RDIFF_BEGIN 1141s > out.nlm <- nlm(mlogl, coefficients(out), print.level = 2) 1141s iteration = 0 1141s Parameter: 1141s [1] 0.0599 1.3682 0.4760 1141s Function Value 1141s [1] 49.6 1141s Gradient: 1141s [1] 8.24e-06 5.50e-06 6.08e-06 1141s 1141s Relative gradient close to zero. 1141s Current iterate is probably solution. 1141s 1141s > ## IGNORE_RDIFF_END 1141s > 1141s > logl <- function(beta) { 1141s + if (length(beta) != 3) stop("length(beta) != 3") 1141s + beta0 <- beta[1] 1141s + beta1 <- beta[2] 1141s + beta2 <- beta[3] 1141s + eta <- beta0 + beta1 * x1 + beta2 * x2 1141s + p <- exp(eta) / (1 + exp(eta)) 1141s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 1141s + } 1141s > 1141s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 1141s > out.metro$accept 1141s [1] 0.982 1141s > 1141s > out.metro <- metrop(out.metro, scale = 0.1) 1141s > out.metro$accept 1141s [1] 0.795 1141s > 1141s > out.metro <- metrop(out.metro, scale = 0.5) 1141s > out.metro$accept 1141s [1] 0.264 1141s > 1141s > apply(out.metro$batch, 2, mean) 1141s [1] 0.0608 1.4230 0.5263 1141s > var(out.metro$batch) 1141s [,1] [,2] [,3] 1141s [1,] 0.06755 -0.0108 0.00989 1141s [2,] -0.01080 0.1758 -0.06155 1141s [3,] 0.00989 -0.0615 0.10483 1141s > olbm(out.metro$batch, 25) 1141s [,1] [,2] [,3] 1141s [1,] 4.54e-04 9.47e-05 -1.92e-05 1141s [2,] 9.47e-05 1.84e-03 -6.45e-04 1141s [3,] -1.92e-05 -6.45e-04 9.09e-04 1141s > 1141s > saveseed <- .Random.seed 1141s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 1141s + scale = 0.5, debug = TRUE) 1141s > 1141s > all(out.metro$batch[- out.metro$nbatch, ] == out.metro$current[- 1, ]) 1141s [1] TRUE 1141s > all(out.metro$current[1, ] == out.metro$initial) 1141s [1] TRUE 1141s > all(out.metro$batch[out.metro$nbatch, ] == out.metro$final) 1141s [1] TRUE 1141s > 1141s > .Random.seed <- saveseed 1141s > d <- ncol(out.metro$proposal) 1141s > n <- nrow(out.metro$proposal) 1141s > my.proposal <- matrix(NA, n, d) 1141s > my.u <- double(n) 1141s > ska <- out.metro$scale 1141s > for (i in 1:n) { 1141s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 1141s + if (is.na(out.metro$u[i])) { 1141s + my.u[i] <- NA 1141s + } else { 1141s + my.u[i] <- runif(1) 1141s + } 1141s + } 1141s > max(abs(out.metro$proposal - my.proposal)) < epsilon 1141s [1] TRUE 1141s > all(is.na(out.metro$u) == is.na(my.u)) 1141s [1] TRUE 1141s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 1141s [1] TRUE 1141s > 1141s > my.curr.log.green <- apply(out.metro$current, 1, logl) 1141s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 1141s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 1141s [1] TRUE 1141s > foo <- my.prop.log.green - my.curr.log.green 1141s > max(abs(foo - out.metro$log.green)) < epsilon 1141s [1] TRUE 1141s > 1141s > my.accept <- is.na(my.u) | my.u < exp(foo) 1141s > sum(my.accept) == round(n * out.metro$accept) 1141s [1] TRUE 1141s > 1141s > my.path <- matrix(NA, n, d) 1141s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 1141s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 1141s > 1141s > all(my.path == out.metro$batch) 1141s [1] TRUE 1141s > 1141s > 1141s BEGIN TEST tests/logitbat.R 1141s 1141s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1141s Copyright (C) 2025 The R Foundation for Statistical Computing 1141s Platform: s390x-ibm-linux-gnu 1141s 1141s R is free software and comes with ABSOLUTELY NO WARRANTY. 1141s You are welcome to redistribute it under certain conditions. 1141s Type 'license()' or 'licence()' for distribution details. 1141s 1141s R is a collaborative project with many contributors. 1141s Type 'contributors()' for more information and 1141s 'citation()' on how to cite R or R packages in publications. 1141s 1141s Type 'demo()' for some demos, 'help()' for on-line help, or 1141s 'help.start()' for an HTML browser interface to help. 1141s Type 'q()' to quit R. 1141s 1141s > 1141s > # test batching (blen) 1141s > 1141s > epsilon <- 1e-15 1141s > 1141s > library(mcmc) 1141s > 1141s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 1141s > set.seed(42) 1141s > 1141s > n <- 100 1141s > rho <- 0.5 1141s > beta0 <- 0.25 1141s > beta1 <- 1 1141s > beta2 <- 0.5 1141s > 1141s > x1 <- rnorm(n) 1141s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 1141s > eta <- beta0 + beta1 * x1 + beta2 * x2 1141s > p <- 1 / (1 + exp(- eta)) 1141s > y <- as.numeric(runif(n) < p) 1141s > 1141s > out <- glm(y ~ x1 + x2, family = binomial()) 1141s > 1141s > logl <- function(beta) { 1141s + if (length(beta) != 3) stop("length(beta) != 3") 1141s + beta0 <- beta[1] 1141s + beta1 <- beta[2] 1141s + beta2 <- beta[3] 1141s + eta <- beta0 + beta1 * x1 + beta2 * x2 1141s + p <- exp(eta) / (1 + exp(eta)) 1141s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 1141s + } 1141s > 1141s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 1141s > out.metro$accept 1141s [1] 0.982 1141s > 1141s > out.metro <- metrop(out.metro, scale = 0.1) 1142s > out.metro$accept 1142s [1] 0.795 1142s > 1142s > out.metro <- metrop(out.metro, scale = 0.5) 1142s > out.metro$accept 1142s [1] 0.264 1142s > 1142s > apply(out.metro$batch, 2, mean) 1142s [1] 0.06080257 1.42304941 0.52634149 1142s > 1142s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 1142s + scale = 0.5, debug = TRUE, blen = 5) 1142s > 1142s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 1142s > niter == nrow(out.metro$current) 1142s [1] TRUE 1142s > niter == nrow(out.metro$proposal) 1142s [1] TRUE 1142s > all(out.metro$current[1, ] == out.metro$initial) 1142s [1] TRUE 1142s > all(out.metro$current[niter, ] == out.metro$final) | 1142s + all(out.metro$proposal[niter, ] == out.metro$final) 1142s [1] TRUE 1142s > 1142s > .Random.seed <- out.metro$initial.seed 1142s > d <- ncol(out.metro$proposal) 1142s > n <- nrow(out.metro$proposal) 1142s > my.proposal <- matrix(NA, n, d) 1142s > my.u <- double(n) 1142s > ska <- out.metro$scale 1142s > for (i in 1:n) { 1142s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 1142s + if (is.na(out.metro$u[i])) { 1142s + my.u[i] <- NA 1142s + } else { 1142s + my.u[i] <- runif(1) 1142s + } 1142s + } 1142s > max(abs(out.metro$proposal - my.proposal)) < epsilon 1142s [1] TRUE 1142s > all(is.na(out.metro$u) == is.na(my.u)) 1142s [1] TRUE 1142s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 1142s [1] TRUE 1142s > 1142s > my.curr.log.green <- apply(out.metro$current, 1, logl) 1142s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 1142s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 1142s [1] TRUE 1142s > foo <- my.prop.log.green - my.curr.log.green 1142s > max(abs(foo - out.metro$log.green)) < epsilon 1142s [1] TRUE 1142s > 1142s > my.accept <- is.na(my.u) | my.u < exp(foo) 1142s > sum(my.accept) == round(n * out.metro$accept) 1142s [1] TRUE 1142s > if (my.accept[niter]) { 1142s + all(out.metro$proposal[niter, ] == out.metro$final) 1142s + } else { 1142s + all(out.metro$current[niter, ] == out.metro$final) 1142s + } 1142s [1] TRUE 1142s > 1142s > my.current <- out.metro$current 1142s > my.current[my.accept, ] <- my.proposal[my.accept, ] 1142s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 1142s > max(abs(out.metro$current - my.current)) < epsilon 1142s [1] TRUE 1142s > 1142s > my.path <- matrix(NA, n, d) 1142s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 1142s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 1142s > nspac <- out.metro$nspac 1142s > 1142s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 1142s > 1142s > foom <- array(as.vector(t(my.path)), c(d, out.metro$blen, out.metro$nbatch)) 1142s > boom <- t(apply(foom, c(1, 3), mean)) 1142s > 1142s > all(dim(boom) == dim(out.metro$batch)) 1142s [1] TRUE 1142s > max(abs(boom - out.metro$batch)) < epsilon 1142s [1] TRUE 1142s > 1142s > 1142s BEGIN TEST tests/logitfun.R 1142s 1142s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1142s Copyright (C) 2025 The R Foundation for Statistical Computing 1142s Platform: s390x-ibm-linux-gnu 1142s 1142s R is free software and comes with ABSOLUTELY NO WARRANTY. 1142s You are welcome to redistribute it under certain conditions. 1142s Type 'license()' or 'licence()' for distribution details. 1142s 1142s R is a collaborative project with many contributors. 1142s Type 'contributors()' for more information and 1142s 'citation()' on how to cite R or R packages in publications. 1142s 1142s Type 'demo()' for some demos, 'help()' for on-line help, or 1142s 'help.start()' for an HTML browser interface to help. 1142s Type 'q()' to quit R. 1142s 1142s > 1142s > # test outfun (function) 1142s > 1142s > epsilon <- 1e-15 1142s > 1142s > library(mcmc) 1142s > 1142s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 1142s > set.seed(42) 1142s > 1142s > n <- 100 1142s > rho <- 0.5 1142s > beta0 <- 0.25 1142s > beta1 <- 1 1142s > beta2 <- 0.5 1142s > 1142s > x1 <- rnorm(n) 1142s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 1142s > eta <- beta0 + beta1 * x1 + beta2 * x2 1142s > p <- 1 / (1 + exp(- eta)) 1142s > y <- as.numeric(runif(n) < p) 1142s > 1142s > out <- glm(y ~ x1 + x2, family = binomial()) 1142s > 1142s > logl <- function(beta) { 1142s + if (length(beta) != 3) stop("length(beta) != 3") 1142s + beta0 <- beta[1] 1142s + beta1 <- beta[2] 1142s + beta2 <- beta[3] 1142s + eta <- beta0 + beta1 * x1 + beta2 * x2 1142s + p <- exp(eta) / (1 + exp(eta)) 1142s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 1142s + } 1142s > 1142s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 1142s > out.metro$accept 1142s [1] 0.982 1142s > 1142s > out.metro <- metrop(out.metro, scale = 0.1) 1142s > out.metro$accept 1142s [1] 0.795 1142s > 1142s > out.metro <- metrop(out.metro, scale = 0.5) 1142s > out.metro$accept 1142s [1] 0.264 1142s > 1142s > apply(out.metro$batch, 2, mean) 1142s [1] 0.06080257 1.42304941 0.52634149 1142s > 1142s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 1142s + scale = 0.5, debug = TRUE, outfun = function(x) c(x, x^2)) 1142s > 1142s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 1142s > niter == nrow(out.metro$current) 1142s [1] TRUE 1142s > niter == nrow(out.metro$proposal) 1142s [1] TRUE 1142s > all(out.metro$current[1, ] == out.metro$initial) 1142s [1] TRUE 1142s > all(out.metro$current[niter, ] == out.metro$final) | 1142s + all(out.metro$proposal[niter, ] == out.metro$final) 1142s [1] TRUE 1142s > 1142s > .Random.seed <- out.metro$initial.seed 1142s > d <- ncol(out.metro$proposal) 1142s > n <- nrow(out.metro$proposal) 1142s > my.proposal <- matrix(NA, n, d) 1142s > my.u <- double(n) 1142s > ska <- out.metro$scale 1142s > for (i in 1:n) { 1142s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 1142s + if (is.na(out.metro$u[i])) { 1142s + my.u[i] <- NA 1142s + } else { 1142s + my.u[i] <- runif(1) 1142s + } 1142s + } 1142s > max(abs(out.metro$proposal - my.proposal)) < epsilon 1142s [1] TRUE 1142s > all(is.na(out.metro$u) == is.na(my.u)) 1142s [1] TRUE 1142s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 1142s [1] TRUE 1142s > 1142s > my.curr.log.green <- apply(out.metro$current, 1, logl) 1142s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 1142s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 1142s [1] TRUE 1142s > foo <- my.prop.log.green - my.curr.log.green 1142s > max(abs(foo - out.metro$log.green)) < epsilon 1142s [1] TRUE 1142s > 1142s > my.accept <- is.na(my.u) | my.u < exp(foo) 1142s > sum(my.accept) == round(n * out.metro$accept) 1142s [1] TRUE 1142s > if (my.accept[niter]) { 1142s + all(out.metro$proposal[niter, ] == out.metro$final) 1142s + } else { 1142s + all(out.metro$current[niter, ] == out.metro$final) 1142s + } 1142s [1] TRUE 1142s > 1142s > my.current <- out.metro$current 1142s > my.current[my.accept, ] <- my.proposal[my.accept, ] 1142s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 1142s > max(abs(out.metro$current - my.current)) < epsilon 1142s [1] TRUE 1142s > 1142s > my.path <- matrix(NA, n, d) 1142s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 1142s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 1142s > nspac <- out.metro$nspac 1142s > 1142s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 1142s > 1142s > fred <- t(apply(my.path, 1, out.metro$outfun)) 1142s > k <- ncol(fred) 1142s > 1142s > foom <- array(as.vector(t(fred)), c(k, out.metro$blen, out.metro$nbatch)) 1142s > boom <- t(apply(foom, c(1, 3), mean)) 1142s > 1142s > all(dim(boom) == dim(out.metro$batch)) 1142s [1] TRUE 1142s > max(abs(boom - out.metro$batch)) < epsilon 1142s [1] TRUE 1142s > 1142s > goom <- cbind(my.path, my.path^2) 1142s > all(dim(goom) == dim(out.metro$batch)) 1142s [1] TRUE 1142s > max(abs(goom - out.metro$batch)) < epsilon 1142s [1] TRUE 1142s > 1142s BEGIN TEST tests/logitfunarg.R 1142s 1142s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1142s Copyright (C) 2025 The R Foundation for Statistical Computing 1142s Platform: s390x-ibm-linux-gnu 1142s 1142s R is free software and comes with ABSOLUTELY NO WARRANTY. 1142s You are welcome to redistribute it under certain conditions. 1142s Type 'license()' or 'licence()' for distribution details. 1142s 1142s R is a collaborative project with many contributors. 1142s Type 'contributors()' for more information and 1142s 'citation()' on how to cite R or R packages in publications. 1142s 1142s Type 'demo()' for some demos, 'help()' for on-line help, or 1142s 'help.start()' for an HTML browser interface to help. 1142s Type 'q()' to quit R. 1142s 1142s > 1142s > # test outfun (function) 1142s > 1142s > epsilon <- 1e-15 1142s > 1142s > library(mcmc) 1142s > 1142s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 1142s > set.seed(42) 1142s > 1142s > n <- 100 1142s > rho <- 0.5 1142s > beta0 <- 0.25 1142s > beta1 <- 1 1142s > beta2 <- 0.5 1142s > 1142s > x1 <- rnorm(n) 1142s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 1142s > eta <- beta0 + beta1 * x1 + beta2 * x2 1142s > p <- 1 / (1 + exp(- eta)) 1142s > y <- as.numeric(runif(n) < p) 1142s > 1142s > out <- glm(y ~ x1 + x2, family = binomial()) 1142s > 1142s > logl <- function(beta) { 1142s + if (length(beta) != 3) stop("length(beta) != 3") 1142s + beta0 <- beta[1] 1142s + beta1 <- beta[2] 1142s + beta2 <- beta[3] 1142s + eta <- beta0 + beta1 * x1 + beta2 * x2 1142s + p <- exp(eta) / (1 + exp(eta)) 1142s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 1142s + } 1142s > 1142s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 1142s > out.metro$accept 1142s [1] 0.982 1142s > 1142s > out.metro <- metrop(out.metro, scale = 0.1) 1142s > out.metro$accept 1142s [1] 0.795 1142s > 1142s > out.metro <- metrop(out.metro, scale = 0.5) 1142s > out.metro$accept 1142s [1] 0.264 1142s > 1142s > apply(out.metro$batch, 2, mean) 1142s [1] 0.06080257 1.42304941 0.52634149 1142s > 1142s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 1142s + scale = 0.5, debug = TRUE, outfun = function(x) c(x, x^2)) 1142s > 1142s > out.metro <- metrop(out.metro) 1142s > out.metro$outfun 1142s function (x) 1142s c(x, x^2) 1142s 1142s > dim(out.metro$batch) 1142s [1] 100 6 1142s > 1142s > logl <- function(beta, x1, x2, y) { 1142s + if (length(beta) != 3) stop("length(beta) != 3") 1142s + beta0 <- beta[1] 1142s + beta1 <- beta[2] 1142s + beta2 <- beta[3] 1142s + eta <- beta0 + beta1 * x1 + beta2 * x2 1142s + p <- exp(eta) / (1 + exp(eta)) 1142s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 1142s + } 1142s > 1142s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 1142s + scale = 0.5, debug = TRUE, x1 = x1, x2 = x2, y = y) 1142s > out.metro$lud 1142s function (beta, x1, x2, y) 1142s { 1142s if (length(beta) != 3) 1142s stop("length(beta) != 3") 1142s beta0 <- beta[1] 1142s beta1 <- beta[2] 1142s beta2 <- beta[3] 1142s eta <- beta0 + beta1 * x1 + beta2 * x2 1142s p <- exp(eta)/(1 + exp(eta)) 1142s return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 1142s } 1142s > out.metro <- metrop(out.metro, x1 = x1, x2 = x2, y = y) 1142s > out.metro$lud 1142s function (beta, x1, x2, y) 1142s { 1142s if (length(beta) != 3) 1142s stop("length(beta) != 3") 1142s beta0 <- beta[1] 1142s beta1 <- beta[2] 1142s beta2 <- beta[3] 1142s eta <- beta0 + beta1 * x1 + beta2 * x2 1142s p <- exp(eta)/(1 + exp(eta)) 1142s return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 1142s } 1142s > 1142s > 1142s BEGIN TEST tests/logitidx.R 1142s 1142s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1142s Copyright (C) 2025 The R Foundation for Statistical Computing 1142s Platform: s390x-ibm-linux-gnu 1142s 1142s R is free software and comes with ABSOLUTELY NO WARRANTY. 1142s You are welcome to redistribute it under certain conditions. 1142s Type 'license()' or 'licence()' for distribution details. 1142s 1142s R is a collaborative project with many contributors. 1142s Type 'contributors()' for more information and 1142s 'citation()' on how to cite R or R packages in publications. 1142s 1142s Type 'demo()' for some demos, 'help()' for on-line help, or 1142s 'help.start()' for an HTML browser interface to help. 1142s Type 'q()' to quit R. 1142s 1142s > 1142s > # test outfun (positive index vector) 1142s > 1142s > epsilon <- 1e-15 1142s > 1142s > library(mcmc) 1142s > 1142s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 1142s > set.seed(42) 1142s > 1142s > n <- 100 1142s > rho <- 0.5 1142s > beta0 <- 0.25 1142s > beta1 <- 1 1142s > beta2 <- 0.5 1142s > 1142s > x1 <- rnorm(n) 1142s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 1142s > eta <- beta0 + beta1 * x1 + beta2 * x2 1142s > p <- 1 / (1 + exp(- eta)) 1142s > y <- as.numeric(runif(n) < p) 1142s > 1142s > out <- glm(y ~ x1 + x2, family = binomial()) 1142s > 1142s > logl <- function(beta) { 1142s + if (length(beta) != 3) stop("length(beta) != 3") 1142s + beta0 <- beta[1] 1142s + beta1 <- beta[2] 1142s + beta2 <- beta[3] 1142s + eta <- beta0 + beta1 * x1 + beta2 * x2 1142s + p <- exp(eta) / (1 + exp(eta)) 1142s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 1142s + } 1142s > 1142s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 1142s > out.metro$accept 1142s [1] 0.982 1142s > 1142s > out.metro <- metrop(out.metro, scale = 0.1) 1142s > out.metro$accept 1142s [1] 0.795 1142s > 1142s > out.metro <- metrop(out.metro, scale = 0.5) 1142s > out.metro$accept 1142s [1] 0.264 1142s > 1142s > apply(out.metro$batch, 2, mean) 1142s [1] 0.06080257 1.42304941 0.52634149 1142s > 1142s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 1142s + scale = 0.5, debug = TRUE, outfun = c(2, 3)) 1142s > 1142s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 1142s > niter == nrow(out.metro$current) 1142s [1] TRUE 1142s > niter == nrow(out.metro$proposal) 1142s [1] TRUE 1142s > all(out.metro$current[1, ] == out.metro$initial) 1142s [1] TRUE 1142s > all(out.metro$current[niter, ] == out.metro$final) | 1142s + all(out.metro$proposal[niter, ] == out.metro$final) 1142s [1] TRUE 1142s > 1142s > .Random.seed <- out.metro$initial.seed 1142s > d <- ncol(out.metro$proposal) 1142s > n <- nrow(out.metro$proposal) 1142s > my.proposal <- matrix(NA, n, d) 1142s > my.u <- double(n) 1142s > ska <- out.metro$scale 1142s > for (i in 1:n) { 1142s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 1142s + if (is.na(out.metro$u[i])) { 1142s + my.u[i] <- NA 1142s + } else { 1142s + my.u[i] <- runif(1) 1142s + } 1142s + } 1142s > max(abs(out.metro$proposal - my.proposal)) < epsilon 1142s [1] TRUE 1142s > all(is.na(out.metro$u) == is.na(my.u)) 1142s [1] TRUE 1142s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 1142s [1] TRUE 1142s > 1142s > my.curr.log.green <- apply(out.metro$current, 1, logl) 1142s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 1142s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 1142s [1] TRUE 1142s > foo <- my.prop.log.green - my.curr.log.green 1142s > max(abs(foo - out.metro$log.green)) < epsilon 1142s [1] TRUE 1142s > 1142s > my.accept <- is.na(my.u) | my.u < exp(foo) 1142s > sum(my.accept) == round(n * out.metro$accept) 1142s [1] TRUE 1142s > if (my.accept[niter]) { 1142s + all(out.metro$proposal[niter, ] == out.metro$final) 1142s + } else { 1142s + all(out.metro$current[niter, ] == out.metro$final) 1142s + } 1142s [1] TRUE 1142s > 1142s > my.current <- out.metro$current 1142s > my.current[my.accept, ] <- my.proposal[my.accept, ] 1142s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 1142s > max(abs(out.metro$current - my.current)) < epsilon 1142s [1] TRUE 1142s > 1142s > my.path <- matrix(NA, n, d) 1142s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 1142s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 1142s > nspac <- out.metro$nspac 1142s > 1142s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 1142s > 1142s > fred <- my.path[ , out.metro$outfun] 1142s > k <- ncol(fred) 1142s > 1142s > foom <- array(as.vector(t(fred)), c(k, out.metro$blen, out.metro$nbatch)) 1142s > boom <- t(apply(foom, c(1, 3), mean)) 1142s > 1142s > all(dim(boom) == dim(out.metro$batch)) 1142s [1] TRUE 1142s > max(abs(boom - out.metro$batch)) < epsilon 1142s [1] TRUE 1142s > 1142s > 1142s BEGIN TEST tests/logitlogidx.R 1142s 1142s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1142s Copyright (C) 2025 The R Foundation for Statistical Computing 1142s Platform: s390x-ibm-linux-gnu 1142s 1142s R is free software and comes with ABSOLUTELY NO WARRANTY. 1142s You are welcome to redistribute it under certain conditions. 1142s Type 'license()' or 'licence()' for distribution details. 1142s 1142s R is a collaborative project with many contributors. 1142s Type 'contributors()' for more information and 1142s 'citation()' on how to cite R or R packages in publications. 1142s 1142s Type 'demo()' for some demos, 'help()' for on-line help, or 1142s 'help.start()' for an HTML browser interface to help. 1142s Type 'q()' to quit R. 1142s 1142s > 1142s > # test outfun (logical index vector) 1142s > 1142s > epsilon <- 1e-15 1142s > 1142s > library(mcmc) 1142s > 1142s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 1142s > set.seed(42) 1142s > 1142s > n <- 100 1142s > rho <- 0.5 1142s > beta0 <- 0.25 1142s > beta1 <- 1 1142s > beta2 <- 0.5 1142s > 1142s > x1 <- rnorm(n) 1142s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 1142s > eta <- beta0 + beta1 * x1 + beta2 * x2 1142s > p <- 1 / (1 + exp(- eta)) 1142s > y <- as.numeric(runif(n) < p) 1142s > 1142s > out <- glm(y ~ x1 + x2, family = binomial()) 1142s > 1142s > logl <- function(beta) { 1142s + if (length(beta) != 3) stop("length(beta) != 3") 1142s + beta0 <- beta[1] 1142s + beta1 <- beta[2] 1142s + beta2 <- beta[3] 1142s + eta <- beta0 + beta1 * x1 + beta2 * x2 1142s + p <- exp(eta) / (1 + exp(eta)) 1142s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 1142s + } 1142s > 1142s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 1142s > out.metro$accept 1142s [1] 0.982 1142s > 1142s > out.metro <- metrop(out.metro, scale = 0.1) 1142s > out.metro$accept 1142s [1] 0.795 1142s > 1142s > out.metro <- metrop(out.metro, scale = 0.5) 1143s > out.metro$accept 1143s [1] 0.264 1143s > 1143s > apply(out.metro$batch, 2, mean) 1143s [1] 0.06080257 1.42304941 0.52634149 1143s > 1143s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 1143s + scale = 0.5, debug = TRUE, outfun = seq(1:3) > 1) 1143s > 1143s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 1143s > niter == nrow(out.metro$current) 1143s [1] TRUE 1143s > niter == nrow(out.metro$proposal) 1143s [1] TRUE 1143s > all(out.metro$current[1, ] == out.metro$initial) 1143s [1] TRUE 1143s > all(out.metro$current[niter, ] == out.metro$final) | 1143s + all(out.metro$proposal[niter, ] == out.metro$final) 1143s [1] TRUE 1143s > 1143s > .Random.seed <- out.metro$initial.seed 1143s > d <- ncol(out.metro$proposal) 1143s > n <- nrow(out.metro$proposal) 1143s > my.proposal <- matrix(NA, n, d) 1143s > my.u <- double(n) 1143s > ska <- out.metro$scale 1143s > for (i in 1:n) { 1143s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 1143s + if (is.na(out.metro$u[i])) { 1143s + my.u[i] <- NA 1143s + } else { 1143s + my.u[i] <- runif(1) 1143s + } 1143s + } 1143s > max(abs(out.metro$proposal - my.proposal)) < epsilon 1143s [1] TRUE 1143s > all(is.na(out.metro$u) == is.na(my.u)) 1143s [1] TRUE 1143s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 1143s [1] TRUE 1143s > 1143s > my.curr.log.green <- apply(out.metro$current, 1, logl) 1143s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 1143s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 1143s [1] TRUE 1143s > foo <- my.prop.log.green - my.curr.log.green 1143s > max(abs(foo - out.metro$log.green)) < epsilon 1143s [1] TRUE 1143s > 1143s > my.accept <- is.na(my.u) | my.u < exp(foo) 1143s > sum(my.accept) == round(n * out.metro$accept) 1143s [1] TRUE 1143s > if (my.accept[niter]) { 1143s + all(out.metro$proposal[niter, ] == out.metro$final) 1143s + } else { 1143s + all(out.metro$current[niter, ] == out.metro$final) 1143s + } 1143s [1] TRUE 1143s > 1143s > my.current <- out.metro$current 1143s > my.current[my.accept, ] <- my.proposal[my.accept, ] 1143s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 1143s > max(abs(out.metro$current - my.current)) < epsilon 1143s [1] TRUE 1143s > 1143s > my.path <- matrix(NA, n, d) 1143s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 1143s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 1143s > nspac <- out.metro$nspac 1143s > 1143s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 1143s > 1143s > fred <- my.path[ , out.metro$outfun] 1143s > k <- ncol(fred) 1143s > 1143s > foom <- array(as.vector(t(fred)), c(k, out.metro$blen, out.metro$nbatch)) 1143s > boom <- t(apply(foom, c(1, 3), mean)) 1143s > 1143s > all(dim(boom) == dim(out.metro$batch)) 1143s [1] TRUE 1143s > max(abs(boom - out.metro$batch)) < epsilon 1143s [1] TRUE 1143s > 1143s > 1143s BEGIN TEST tests/logitmat.R 1143s 1143s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1143s Copyright (C) 2025 The R Foundation for Statistical Computing 1143s Platform: s390x-ibm-linux-gnu 1143s 1143s R is free software and comes with ABSOLUTELY NO WARRANTY. 1143s You are welcome to redistribute it under certain conditions. 1143s Type 'license()' or 'licence()' for distribution details. 1143s 1143s R is a collaborative project with many contributors. 1143s Type 'contributors()' for more information and 1143s 'citation()' on how to cite R or R packages in publications. 1143s 1143s Type 'demo()' for some demos, 'help()' for on-line help, or 1143s 'help.start()' for an HTML browser interface to help. 1143s Type 'q()' to quit R. 1143s 1143s > 1143s > # test matrix scaling 1143s > 1143s > epsilon <- 1e-15 1143s > 1143s > library(mcmc) 1143s > 1143s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 1143s > set.seed(42) 1143s > 1143s > n <- 100 1143s > rho <- 0.5 1143s > beta0 <- 0.25 1143s > beta1 <- 1 1143s > beta2 <- 0.5 1143s > 1143s > x1 <- rnorm(n) 1143s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 1143s > eta <- beta0 + beta1 * x1 + beta2 * x2 1143s > p <- 1 / (1 + exp(- eta)) 1143s > y <- as.numeric(runif(n) < p) 1143s > 1143s > out <- glm(y ~ x1 + x2, family = binomial()) 1143s > 1143s > logl <- function(beta) { 1143s + if (length(beta) != 3) stop("length(beta) != 3") 1143s + beta0 <- beta[1] 1143s + beta1 <- beta[2] 1143s + beta2 <- beta[3] 1143s + eta <- beta0 + beta1 * x1 + beta2 * x2 1143s + p <- exp(eta) / (1 + exp(eta)) 1143s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 1143s + } 1143s > 1143s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 1143s > out.metro$accept 1143s [1] 0.982 1143s > 1143s > out.metro <- metrop(out.metro, scale = 0.1) 1143s > out.metro$accept 1143s [1] 0.795 1143s > 1143s > out.metro <- metrop(out.metro, scale = 0.5) 1143s > out.metro$accept 1143s [1] 0.264 1143s > 1143s > apply(out.metro$batch, 2, mean) 1143s [1] 0.06080257 1.42304941 0.52634149 1143s > fred <- var(out.metro$batch) 1143s > sally <- t(chol(fred)) 1143s > max(abs(fred - sally %*% t(sally))) < epsilon 1143s [1] TRUE 1143s > 1143s > out.metro <- metrop(out.metro, scale = sally) 1143s > out.metro$accept 1143s [1] 0.451 1143s > 1143s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 1143s + scale = sally, debug = TRUE) 1143s > names(out.metro) 1143s [1] "accept" "batch" "initial" "final" "accept.batch" 1143s [6] "current" "proposal" "log.green" "u" "z" 1143s [11] "debug.accept" "initial.seed" "final.seed" "time" "lud" 1143s [16] "nbatch" "blen" "nspac" "scale" "debug" 1143s > 1143s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 1143s > niter == nrow(out.metro$current) 1143s [1] TRUE 1143s > niter == nrow(out.metro$proposal) 1143s [1] TRUE 1143s > all(out.metro$current[1, ] == out.metro$initial) 1143s [1] TRUE 1143s > all(out.metro$current[niter, ] == out.metro$final) | 1143s + all(out.metro$proposal[niter, ] == out.metro$final) 1143s [1] TRUE 1143s > 1143s > .Random.seed <- out.metro$initial.seed 1143s > d <- ncol(out.metro$proposal) 1143s > n <- nrow(out.metro$proposal) 1143s > my.proposal <- matrix(NA, n, d) 1143s > my.u <- double(n) 1143s > my.z <- matrix(NA, n, d) 1143s > ska <- out.metro$scale 1143s > for (i in 1:n) { 1143s + zed <- rnorm(d) 1143s + my.proposal[i, ] <- out.metro$current[i, ] + ska %*% zed 1143s + if (is.na(out.metro$u[i])) { 1143s + my.u[i] <- NA 1143s + } else { 1143s + my.u[i] <- runif(1) 1143s + } 1143s + my.z[i, ] <- zed 1143s + } 1143s > max(abs(out.metro$proposal - my.proposal)) < epsilon 1143s [1] TRUE 1143s > 1143s > all(is.na(out.metro$u) == is.na(my.u)) 1143s [1] TRUE 1143s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 1143s [1] TRUE 1143s > identical(out.metro$z, my.z) 1143s [1] TRUE 1143s > 1143s > my.curr.log.green <- apply(out.metro$current, 1, logl) 1143s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 1143s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 1143s [1] TRUE 1143s > foo <- my.prop.log.green - my.curr.log.green 1143s > max(abs(foo - out.metro$log.green)) < epsilon 1143s [1] TRUE 1143s > 1143s > my.accept <- is.na(my.u) | my.u < exp(foo) 1143s > sum(my.accept) == round(n * out.metro$accept) 1143s [1] TRUE 1143s > if (my.accept[niter]) { 1143s + all(out.metro$proposal[niter, ] == out.metro$final) 1143s + } else { 1143s + all(out.metro$current[niter, ] == out.metro$final) 1143s + } 1143s [1] TRUE 1143s > identical(my.accept, out.metro$debug.accept) 1143s [1] TRUE 1143s > 1143s > my.current <- out.metro$current 1143s > my.current[my.accept, ] <- my.proposal[my.accept, ] 1143s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 1143s > max(abs(out.metro$current - my.current)) < epsilon 1143s [1] TRUE 1143s > 1143s > my.path <- matrix(NA, n, d) 1143s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 1143s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 1143s > nspac <- out.metro$nspac 1143s > 1143s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 1143s > 1143s > fred <- my.path 1143s > k <- ncol(fred) 1143s > 1143s > foom <- array(as.vector(t(fred)), c(k, out.metro$blen, out.metro$nbatch)) 1143s > boom <- t(apply(foom, c(1, 3), mean)) 1143s > 1143s > all(dim(boom) == dim(out.metro$batch)) 1143s [1] TRUE 1143s > max(abs(boom - out.metro$batch)) < epsilon 1143s [1] TRUE 1143s > 1143s > 1143s BEGIN TEST tests/logitnegidx.R 1143s 1143s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1143s Copyright (C) 2025 The R Foundation for Statistical Computing 1143s Platform: s390x-ibm-linux-gnu 1143s 1143s R is free software and comes with ABSOLUTELY NO WARRANTY. 1143s You are welcome to redistribute it under certain conditions. 1143s Type 'license()' or 'licence()' for distribution details. 1143s 1143s R is a collaborative project with many contributors. 1143s Type 'contributors()' for more information and 1143s 'citation()' on how to cite R or R packages in publications. 1143s 1143s Type 'demo()' for some demos, 'help()' for on-line help, or 1143s 'help.start()' for an HTML browser interface to help. 1143s Type 'q()' to quit R. 1143s 1143s > 1143s > # test outfun (negative index vector) 1143s > 1143s > epsilon <- 1e-15 1143s > 1143s > library(mcmc) 1143s > 1143s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 1143s > set.seed(42) 1143s > 1143s > n <- 100 1143s > rho <- 0.5 1143s > beta0 <- 0.25 1143s > beta1 <- 1 1143s > beta2 <- 0.5 1143s > 1143s > x1 <- rnorm(n) 1143s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 1143s > eta <- beta0 + beta1 * x1 + beta2 * x2 1143s > p <- 1 / (1 + exp(- eta)) 1143s > y <- as.numeric(runif(n) < p) 1143s > 1143s > out <- glm(y ~ x1 + x2, family = binomial()) 1143s > 1143s > logl <- function(beta) { 1143s + if (length(beta) != 3) stop("length(beta) != 3") 1143s + beta0 <- beta[1] 1143s + beta1 <- beta[2] 1143s + beta2 <- beta[3] 1143s + eta <- beta0 + beta1 * x1 + beta2 * x2 1143s + p <- exp(eta) / (1 + exp(eta)) 1143s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 1143s + } 1143s > 1143s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 1143s > out.metro$accept 1143s [1] 0.982 1143s > 1143s > out.metro <- metrop(out.metro, scale = 0.1) 1143s > out.metro$accept 1143s [1] 0.795 1143s > 1143s > out.metro <- metrop(out.metro, scale = 0.5) 1143s > out.metro$accept 1143s [1] 0.264 1143s > 1143s > apply(out.metro$batch, 2, mean) 1143s [1] 0.06080257 1.42304941 0.52634149 1143s > 1143s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 1143s + scale = 0.5, debug = TRUE, outfun = - 2) 1143s > 1143s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 1143s > niter == nrow(out.metro$current) 1143s [1] TRUE 1143s > niter == nrow(out.metro$proposal) 1143s [1] TRUE 1143s > all(out.metro$current[1, ] == out.metro$initial) 1143s [1] TRUE 1143s > all(out.metro$current[niter, ] == out.metro$final) | 1143s + all(out.metro$proposal[niter, ] == out.metro$final) 1143s [1] TRUE 1143s > 1143s > .Random.seed <- out.metro$initial.seed 1143s > d <- ncol(out.metro$proposal) 1143s > n <- nrow(out.metro$proposal) 1143s > my.proposal <- matrix(NA, n, d) 1143s > my.u <- double(n) 1143s > ska <- out.metro$scale 1143s > for (i in 1:n) { 1143s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 1143s + if (is.na(out.metro$u[i])) { 1143s + my.u[i] <- NA 1143s + } else { 1143s + my.u[i] <- runif(1) 1143s + } 1143s + } 1143s > max(abs(out.metro$proposal - my.proposal)) < epsilon 1143s [1] TRUE 1143s > all(is.na(out.metro$u) == is.na(my.u)) 1143s [1] TRUE 1143s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 1143s [1] TRUE 1143s > 1143s > my.curr.log.green <- apply(out.metro$current, 1, logl) 1143s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 1143s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 1143s [1] TRUE 1143s > foo <- my.prop.log.green - my.curr.log.green 1143s > max(abs(foo - out.metro$log.green)) < epsilon 1143s [1] TRUE 1143s > 1143s > my.accept <- is.na(my.u) | my.u < exp(foo) 1143s > sum(my.accept) == round(n * out.metro$accept) 1143s [1] TRUE 1143s > if (my.accept[niter]) { 1143s + all(out.metro$proposal[niter, ] == out.metro$final) 1143s + } else { 1143s + all(out.metro$current[niter, ] == out.metro$final) 1143s + } 1143s [1] TRUE 1143s > 1143s > my.current <- out.metro$current 1143s > my.current[my.accept, ] <- my.proposal[my.accept, ] 1143s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 1143s > max(abs(out.metro$current - my.current)) < epsilon 1143s [1] TRUE 1143s > 1143s > my.path <- matrix(NA, n, d) 1143s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 1143s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 1143s > nspac <- out.metro$nspac 1143s > 1143s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 1143s > 1143s > fred <- my.path[ , out.metro$outfun] 1143s > k <- ncol(fred) 1143s > 1143s > foom <- array(as.vector(t(fred)), c(k, out.metro$blen, out.metro$nbatch)) 1143s > boom <- t(apply(foom, c(1, 3), mean)) 1143s > 1143s > all(dim(boom) == dim(out.metro$batch)) 1143s [1] TRUE 1143s > max(abs(boom - out.metro$batch)) < epsilon 1143s [1] TRUE 1143s > 1143s > 1143s BEGIN TEST tests/logitsub.R 1143s 1143s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1143s Copyright (C) 2025 The R Foundation for Statistical Computing 1143s Platform: s390x-ibm-linux-gnu 1143s 1143s R is free software and comes with ABSOLUTELY NO WARRANTY. 1143s You are welcome to redistribute it under certain conditions. 1143s Type 'license()' or 'licence()' for distribution details. 1143s 1143s R is a collaborative project with many contributors. 1143s Type 'contributors()' for more information and 1143s 'citation()' on how to cite R or R packages in publications. 1143s 1143s Type 'demo()' for some demos, 'help()' for on-line help, or 1143s 'help.start()' for an HTML browser interface to help. 1143s Type 'q()' to quit R. 1143s 1143s > 1143s > # test spacing (nspac) 1143s > 1143s > epsilon <- 1e-15 1143s > 1143s > library(mcmc) 1143s > 1143s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 1143s > set.seed(42) 1143s > 1143s > n <- 100 1143s > rho <- 0.5 1143s > beta0 <- 0.25 1143s > beta1 <- 1 1143s > beta2 <- 0.5 1143s > 1143s > x1 <- rnorm(n) 1143s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 1143s > eta <- beta0 + beta1 * x1 + beta2 * x2 1143s > p <- 1 / (1 + exp(- eta)) 1143s > y <- as.numeric(runif(n) < p) 1143s > 1143s > out <- glm(y ~ x1 + x2, family = binomial()) 1143s > 1143s > logl <- function(beta) { 1143s + if (length(beta) != 3) stop("length(beta) != 3") 1143s + beta0 <- beta[1] 1143s + beta1 <- beta[2] 1143s + beta2 <- beta[3] 1143s + eta <- beta0 + beta1 * x1 + beta2 * x2 1143s + p <- exp(eta) / (1 + exp(eta)) 1143s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 1143s + } 1143s > 1143s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 1143s > out.metro$accept 1143s [1] 0.982 1143s > 1143s > out.metro <- metrop(out.metro, scale = 0.1) 1143s > out.metro$accept 1143s [1] 0.795 1143s > 1143s > out.metro <- metrop(out.metro, scale = 0.5) 1143s > out.metro$accept 1143s [1] 0.264 1143s > 1143s > apply(out.metro$batch, 2, mean) 1143s [1] 0.06080257 1.42304941 0.52634149 1143s > 1143s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 1143s + scale = 0.5, debug = TRUE, nspac = 3) 1143s > 1143s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 1143s > niter == nrow(out.metro$current) 1143s [1] TRUE 1143s > niter == nrow(out.metro$proposal) 1143s [1] TRUE 1143s > all(out.metro$current[1, ] == out.metro$initial) 1143s [1] TRUE 1143s > all(out.metro$current[niter, ] == out.metro$final) | 1143s + all(out.metro$proposal[niter, ] == out.metro$final) 1143s [1] TRUE 1143s > 1143s > .Random.seed <- out.metro$initial.seed 1143s > d <- ncol(out.metro$proposal) 1143s > n <- nrow(out.metro$proposal) 1143s > my.proposal <- matrix(NA, n, d) 1143s > my.u <- double(n) 1143s > ska <- out.metro$scale 1143s > for (i in 1:n) { 1143s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 1143s + if (is.na(out.metro$u[i])) { 1143s + my.u[i] <- NA 1143s + } else { 1143s + my.u[i] <- runif(1) 1143s + } 1143s + } 1143s > max(abs(out.metro$proposal - my.proposal)) < epsilon 1143s [1] TRUE 1143s > all(is.na(out.metro$u) == is.na(my.u)) 1143s [1] TRUE 1143s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 1143s [1] TRUE 1143s > 1143s > my.curr.log.green <- apply(out.metro$current, 1, logl) 1143s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 1143s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 1143s [1] TRUE 1143s > foo <- my.prop.log.green - my.curr.log.green 1143s > max(abs(foo - out.metro$log.green)) < epsilon 1143s [1] TRUE 1143s > 1143s > my.accept <- is.na(my.u) | my.u < exp(foo) 1143s > sum(my.accept) == round(n * out.metro$accept) 1143s [1] TRUE 1143s > if (my.accept[niter]) { 1143s + all(out.metro$proposal[niter, ] == out.metro$final) 1143s + } else { 1143s + all(out.metro$current[niter, ] == out.metro$final) 1143s + } 1143s [1] TRUE 1143s > 1143s > my.current <- out.metro$current 1143s > my.current[my.accept, ] <- my.proposal[my.accept, ] 1143s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 1143s > max(abs(out.metro$current - my.current)) < epsilon 1143s [1] TRUE 1143s > 1143s > my.path <- matrix(NA, n, d) 1143s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 1143s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 1143s > nspac <- out.metro$nspac 1143s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 1143s > all(dim(my.path) == dim(out.metro$batch)) 1143s [1] TRUE 1143s > 1143s > all(my.path == out.metro$batch) 1143s [1] TRUE 1143s > 1143s > 1143s BEGIN TEST tests/logitsubbat.R 1143s 1143s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1143s Copyright (C) 2025 The R Foundation for Statistical Computing 1143s Platform: s390x-ibm-linux-gnu 1143s 1143s R is free software and comes with ABSOLUTELY NO WARRANTY. 1143s You are welcome to redistribute it under certain conditions. 1143s Type 'license()' or 'licence()' for distribution details. 1143s 1143s R is a collaborative project with many contributors. 1143s Type 'contributors()' for more information and 1143s 'citation()' on how to cite R or R packages in publications. 1143s 1143s Type 'demo()' for some demos, 'help()' for on-line help, or 1143s 'help.start()' for an HTML browser interface to help. 1143s Type 'q()' to quit R. 1143s 1143s > 1143s > # test batching (blen) and spacing (nspac) together 1143s > 1143s > epsilon <- 1e-15 1143s > 1143s > library(mcmc) 1143s > 1143s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 1143s > set.seed(42) 1143s > 1143s > n <- 100 1143s > rho <- 0.5 1143s > beta0 <- 0.25 1143s > beta1 <- 1 1143s > beta2 <- 0.5 1143s > 1143s > x1 <- rnorm(n) 1143s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 1143s > eta <- beta0 + beta1 * x1 + beta2 * x2 1143s > p <- 1 / (1 + exp(- eta)) 1143s > y <- as.numeric(runif(n) < p) 1143s > 1143s > out <- glm(y ~ x1 + x2, family = binomial()) 1143s > 1143s > logl <- function(beta) { 1143s + if (length(beta) != 3) stop("length(beta) != 3") 1143s + beta0 <- beta[1] 1143s + beta1 <- beta[2] 1143s + beta2 <- beta[3] 1143s + eta <- beta0 + beta1 * x1 + beta2 * x2 1143s + p <- exp(eta) / (1 + exp(eta)) 1143s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 1143s + } 1143s > 1143s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 1143s > out.metro$accept 1143s [1] 0.982 1143s > 1143s > out.metro <- metrop(out.metro, scale = 0.1) 1143s > out.metro$accept 1143s [1] 0.795 1143s > 1143s > out.metro <- metrop(out.metro, scale = 0.5) 1143s > out.metro$accept 1143s [1] 0.264 1143s > 1143s > apply(out.metro$batch, 2, mean) 1143s [1] 0.06080257 1.42304941 0.52634149 1143s > 1143s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 1143s + scale = 0.5, debug = TRUE, blen = 5, nspac = 3) 1144s > 1144s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 1144s > niter == nrow(out.metro$current) 1144s [1] TRUE 1144s > niter == nrow(out.metro$proposal) 1144s [1] TRUE 1144s > all(out.metro$current[1, ] == out.metro$initial) 1144s [1] TRUE 1144s > all(out.metro$current[niter, ] == out.metro$final) | 1144s + all(out.metro$proposal[niter, ] == out.metro$final) 1144s [1] TRUE 1144s > 1144s > .Random.seed <- out.metro$initial.seed 1144s > d <- ncol(out.metro$proposal) 1144s > n <- nrow(out.metro$proposal) 1144s > my.proposal <- matrix(NA, n, d) 1144s > my.u <- double(n) 1144s > ska <- out.metro$scale 1144s > for (i in 1:n) { 1144s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 1144s + if (is.na(out.metro$u[i])) { 1144s + my.u[i] <- NA 1144s + } else { 1144s + my.u[i] <- runif(1) 1144s + } 1144s + } 1144s > max(abs(out.metro$proposal - my.proposal)) < epsilon 1144s [1] TRUE 1144s > all(is.na(out.metro$u) == is.na(my.u)) 1144s [1] TRUE 1144s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 1144s [1] TRUE 1144s > 1144s > my.curr.log.green <- apply(out.metro$current, 1, logl) 1144s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 1144s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 1144s [1] TRUE 1144s > foo <- my.prop.log.green - my.curr.log.green 1144s > max(abs(foo - out.metro$log.green)) < epsilon 1144s [1] TRUE 1144s > 1144s > my.accept <- is.na(my.u) | my.u < exp(foo) 1144s > sum(my.accept) == round(n * out.metro$accept) 1144s [1] TRUE 1144s > if (my.accept[niter]) { 1144s + all(out.metro$proposal[niter, ] == out.metro$final) 1144s + } else { 1144s + all(out.metro$current[niter, ] == out.metro$final) 1144s + } 1144s [1] TRUE 1144s > 1144s > my.current <- out.metro$current 1144s > my.current[my.accept, ] <- my.proposal[my.accept, ] 1144s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 1144s > max(abs(out.metro$current - my.current)) < epsilon 1144s [1] TRUE 1144s > 1144s > my.path <- matrix(NA, n, d) 1144s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 1144s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 1144s > nspac <- out.metro$nspac 1144s > 1144s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 1144s > 1144s > foom <- array(as.vector(t(my.path)), c(d, out.metro$blen, out.metro$nbatch)) 1144s > boom <- t(apply(foom, c(1, 3), mean)) 1144s > 1144s > all(dim(boom) == dim(out.metro$batch)) 1144s [1] TRUE 1144s > max(abs(boom - out.metro$batch)) < epsilon 1144s [1] TRUE 1144s > 1144s > 1144s BEGIN TEST tests/logitvec.R 1144s 1144s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1144s Copyright (C) 2025 The R Foundation for Statistical Computing 1144s Platform: s390x-ibm-linux-gnu 1144s 1144s R is free software and comes with ABSOLUTELY NO WARRANTY. 1144s You are welcome to redistribute it under certain conditions. 1144s Type 'license()' or 'licence()' for distribution details. 1144s 1144s R is a collaborative project with many contributors. 1144s Type 'contributors()' for more information and 1144s 'citation()' on how to cite R or R packages in publications. 1144s 1144s Type 'demo()' for some demos, 'help()' for on-line help, or 1144s 'help.start()' for an HTML browser interface to help. 1144s Type 'q()' to quit R. 1144s 1144s > 1144s > # test vector (diag(foo)) scaling 1144s > 1144s > epsilon <- 1e-15 1144s > 1144s > library(mcmc) 1144s > 1144s > suppressWarnings(RNGkind("Marsaglia-Multicarry")) 1144s > set.seed(42) 1144s > 1144s > n <- 100 1144s > rho <- 0.5 1144s > beta0 <- 0.25 1144s > beta1 <- 1 1144s > beta2 <- 0.5 1144s > 1144s > x1 <- rnorm(n) 1144s > x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n) 1144s > eta <- beta0 + beta1 * x1 + beta2 * x2 1144s > p <- 1 / (1 + exp(- eta)) 1144s > y <- as.numeric(runif(n) < p) 1144s > 1144s > out <- glm(y ~ x1 + x2, family = binomial()) 1144s > 1144s > logl <- function(beta) { 1144s + if (length(beta) != 3) stop("length(beta) != 3") 1144s + beta0 <- beta[1] 1144s + beta1 <- beta[2] 1144s + beta2 <- beta[3] 1144s + eta <- beta0 + beta1 * x1 + beta2 * x2 1144s + p <- exp(eta) / (1 + exp(eta)) 1144s + return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0]))) 1144s + } 1144s > 1144s > out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01) 1144s > out.metro$accept 1144s [1] 0.982 1144s > 1144s > out.metro <- metrop(out.metro, scale = 0.1) 1144s > out.metro$accept 1144s [1] 0.795 1144s > 1144s > out.metro <- metrop(out.metro, scale = 0.5) 1144s > out.metro$accept 1144s [1] 0.264 1144s > 1144s > apply(out.metro$batch, 2, mean) 1144s [1] 0.06080257 1.42304941 0.52634149 1144s > sally <- apply(out.metro$batch, 2, sd) 1144s > 1144s > out.metro <- metrop(out.metro, scale = sally) 1144s > out.metro$accept 1144s [1] 0.398 1144s > 1144s > out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2, 1144s + scale = sally, debug = TRUE) 1144s > 1144s > niter <- out.metro$nbatch * out.metro$blen * out.metro$nspac 1144s > niter == nrow(out.metro$current) 1144s [1] TRUE 1144s > niter == nrow(out.metro$proposal) 1144s [1] TRUE 1144s > all(out.metro$current[1, ] == out.metro$initial) 1144s [1] TRUE 1144s > all(out.metro$current[niter, ] == out.metro$final) | 1144s + all(out.metro$proposal[niter, ] == out.metro$final) 1144s [1] TRUE 1144s > 1144s > .Random.seed <- out.metro$initial.seed 1144s > d <- ncol(out.metro$proposal) 1144s > n <- nrow(out.metro$proposal) 1144s > my.proposal <- matrix(NA, n, d) 1144s > my.u <- double(n) 1144s > ska <- out.metro$scale 1144s > for (i in 1:n) { 1144s + my.proposal[i, ] <- out.metro$current[i, ] + ska * rnorm(d) 1144s + if (is.na(out.metro$u[i])) { 1144s + my.u[i] <- NA 1144s + } else { 1144s + my.u[i] <- runif(1) 1144s + } 1144s + } 1144s > max(abs(out.metro$proposal - my.proposal)) < epsilon 1144s [1] TRUE 1144s > 1144s > all(is.na(out.metro$u) == is.na(my.u)) 1144s [1] TRUE 1144s > all(out.metro$u[!is.na(out.metro$u)] == my.u[!is.na(my.u)]) 1144s [1] TRUE 1144s > 1144s > my.curr.log.green <- apply(out.metro$current, 1, logl) 1144s > my.prop.log.green <- apply(out.metro$proposal, 1, logl) 1144s > all(is.na(out.metro$u) == (my.prop.log.green > my.curr.log.green)) 1144s [1] TRUE 1144s > foo <- my.prop.log.green - my.curr.log.green 1144s > max(abs(foo - out.metro$log.green)) < epsilon 1144s [1] TRUE 1144s > 1144s > my.accept <- is.na(my.u) | my.u < exp(foo) 1144s > sum(my.accept) == round(n * out.metro$accept) 1144s [1] TRUE 1144s > if (my.accept[niter]) { 1144s + all(out.metro$proposal[niter, ] == out.metro$final) 1144s + } else { 1144s + all(out.metro$current[niter, ] == out.metro$final) 1144s + } 1144s [1] TRUE 1144s > 1144s > my.current <- out.metro$current 1144s > my.current[my.accept, ] <- my.proposal[my.accept, ] 1144s > my.current <- rbind(out.metro$initial, my.current[- niter, ]) 1144s > max(abs(out.metro$current - my.current)) < epsilon 1144s [1] TRUE 1144s > 1144s > my.path <- matrix(NA, n, d) 1144s > my.path[my.accept, ] <- out.metro$proposal[my.accept, ] 1144s > my.path[! my.accept, ] <- out.metro$current[! my.accept, ] 1144s > nspac <- out.metro$nspac 1144s > 1144s > my.path <- my.path[seq(nspac, niter, by = nspac), ] 1144s > 1144s > fred <- my.path 1144s > k <- ncol(fred) 1144s > 1144s > foom <- array(as.vector(t(fred)), c(k, out.metro$blen, out.metro$nbatch)) 1144s > boom <- t(apply(foom, c(1, 3), mean)) 1144s > 1144s > all(dim(boom) == dim(out.metro$batch)) 1144s [1] TRUE 1144s > max(abs(boom - out.metro$batch)) < epsilon 1144s [1] TRUE 1144s > 1144s > 1144s BEGIN TEST tests/morph.R 1144s 1144s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1144s Copyright (C) 2025 The R Foundation for Statistical Computing 1144s Platform: s390x-ibm-linux-gnu 1144s 1144s R is free software and comes with ABSOLUTELY NO WARRANTY. 1144s You are welcome to redistribute it under certain conditions. 1144s Type 'license()' or 'licence()' for distribution details. 1144s 1144s R is a collaborative project with many contributors. 1144s Type 'contributors()' for more information and 1144s 'citation()' on how to cite R or R packages in publications. 1144s 1144s Type 'demo()' for some demos, 'help()' for on-line help, or 1144s 'help.start()' for an HTML browser interface to help. 1144s Type 'q()' to quit R. 1144s 1144s > library(mcmc) 1144s > isotropic <- mcmc:::isotropic 1144s > isotropic.logjacobian <- mcmc:::isotropic.logjacobian 1144s > 1144s > # make sure morph identity works properly 1144s > TestMorphIdentity <- function(m.id) { 1144s + ident.func <- function(x) x 1144s + if (!all.equal(m.id$transform(1:10), 1:10)) 1144s + return(FALSE) 1144s + if (!all.equal(m.id$inverse(1:10), 1:10)) 1144s + return(FALSE) 1144s + x <- seq(-1,1, length.out=15) 1144s + if (!all.equal(sapply(x, m.id$lud(function(x) dnorm(x, log=TRUE))), 1144s + dnorm(x, log=TRUE))) 1144s + return(FALSE) 1144s + if (!all.equal(m.id$outfun(ident.func)(x), x)) 1144s + return(FALSE) 1144s + return(TRUE) 1144s + } 1144s > 1144s > TestMorphIdentity(morph()) 1144s [1] TRUE 1144s > TestMorphIdentity(morph.identity()) 1144s [1] TRUE 1144s > 1144s > TestMorphIdentityOutfun <- function(m) { 1144s + f <- m$outfun(NULL) 1144s + x <- 1:20 1144s + if (!identical(x, f(x))) 1144s + return(FALSE) 1144s + f <- m$outfun(c(6, 8)) 1144s + if (!identical(x[c(6, 8)], f(x))) 1144s + return(FALSE) 1144s + i <- rep(FALSE, 20) 1144s + i[c(1, 3, 5)] <- TRUE 1144s + f <- m$outfun(i) 1144s + if (!identical(x[i], f(x))) 1144s + return(FALSE) 1144s + return(TRUE) 1144s + } 1144s > 1144s > TestMorphIdentityOutfun(morph()) 1144s [1] TRUE 1144s > TestMorphIdentityOutfun(morph.identity()) 1144s [1] TRUE 1144s > 1144s > # make sure that morph and morph.identity give back the same things 1144s > all.equal(sort(names(morph.identity())), sort(names(morph(b=1)))) 1144s [1] TRUE 1144s > 1144s > # test center parameter, univariate version 1144s > zero.func <- function(x) 0 1144s > center <- 2 1144s > x <- seq(-1,1, length.out=15) 1144s > morph.center <- morph(center=center) 1144s > all.equal(sapply(x, morph.center$transform), x-center) 1144s [1] TRUE 1144s > all.equal(sapply(x, morph.center$inverse), x+center) 1144s [1] TRUE 1144s > all.equal(sapply(x, morph.center$lud(function(y) dnorm(y, log=TRUE))), 1144s + dnorm(x, log=TRUE, mean=-2)) 1144s [1] TRUE 1144s > 1144s > # test center parameter, multivariate version 1144s > center <- 1:4 1144s > x <- rep(0, 4) 1144s > morph.center <- morph(center=center) 1144s > lud.mult.dnorm <- function(x) prod(dnorm(x, log=TRUE)) 1144s > all.equal(morph.center$transform(x), x-center) 1144s [1] TRUE 1144s > all.equal(morph.center$inverse(x), x+center) 1144s [1] TRUE 1144s > all.equal(morph.center$lud(lud.mult.dnorm)(x), 1144s + lud.mult.dnorm(x - center)) 1144s [1] TRUE 1144s > # test 'r'. 1144s > r <- 1 1144s > morph.r <- morph(r=r) 1144s > x <- seq(-1, 1, length.out=20) 1144s > all.equal(sapply(x, morph.r$lud(function(x) dnorm(x, log=TRUE))), 1144s + dnorm(x, log=TRUE)) 1144s [1] TRUE 1144s > x <- seq(1.1, 2, length.out=10) 1144s > all(sapply(x, morph.r$lud(function(x) dnorm(x, log=TRUE))) 1144s + != 1144s + dnorm(x, log=TRUE)) 1144s [1] TRUE 1144s > 1144s > TestExponentialEvenPWithRInverse <- function() { 1144s + r <- 0.3 1144s + p <- 2.2 1144s + morph.r <- morph(r=r, p=p) 1144s + x <- seq(0, r, length.out=20) 1144s + all.equal(x, sapply(x, morph.r$inverse)) 1144s + } 1144s > 1144s > TestExponentialEvenPWithRInverse() 1144s [1] TRUE 1144s > 1144s > # make sure morph$lud passes '...' arguments. 1144s > mean <- 2 1144s > ident.morph <- morph() 1144s > dnorm.morph <- ident.morph$lud(function(x, mean=0) 1144s + dnorm(x, mean=mean, log=TRUE)) 1144s > all.equal(dnorm.morph(2, mean), dnorm(2, mean=mean, log=TRUE)) 1144s [1] TRUE 1144s > x <- seq(-3, 3, length.out=20) 1144s > m2 <- morph(r=10) 1144s > dnorm.morph <- m2$lud(function(x, mean) 1144s + dnorm(x, mean=mean, log=TRUE)) 1144s > all.equal(sapply(x, function(y) dnorm.morph(y, 2)), 1144s + dnorm(x, mean=2, log=TRUE)) 1144s [1] TRUE 1144s > 1144s > # make sure morph$outfun passes '...' arguments. 1144s > outfun.orig <- function(x, mean) x + mean 1144s > ident.morph <- morph() 1144s > mean <- 1 1144s > outfun.morph <- ident.morph$outfun(outfun.orig) 1144s > all.equal(outfun.morph(1:10, mean), 1:10+mean) 1144s [1] TRUE 1144s > 1144s > m2 <- morph(r=10) 1144s > outfun.morph <- m2$outfun(outfun.orig) 1144s > all.equal(sapply(1:10, function(x) outfun.morph(x, mean)), 1:10+mean) 1144s [1] TRUE 1144s > 1144s > ########################################################################### 1144s > # test built-in exponential and polynomial transformations. 1144s > f <- morph(b=3) 1144s > x <- seq(0, 10, length.out=100) 1144s > all.equal(x, sapply(sapply(x, f$transform), f$inverse)) 1144s [1] TRUE 1144s > 1144s > f <- morph(p=3) 1144s > all.equal(x, sapply(sapply(x, f$transform), f$inverse)) 1144s [1] TRUE 1144s > 1144s > f <- morph(p=3, r=10) 1144s > all.equal(-10:10, Vectorize(f$transform)(-10:10)) 1144s [1] TRUE 1144s > 1144s > f <- morph(p=3, b=1) 1144s > all.equal(x, sapply(sapply(x, f$transform), f$inverse)) 1144s [1] TRUE 1144s > 1144s BEGIN TEST tests/morph.metrop.R 1144s 1144s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1144s Copyright (C) 2025 The R Foundation for Statistical Computing 1144s Platform: s390x-ibm-linux-gnu 1144s 1144s R is free software and comes with ABSOLUTELY NO WARRANTY. 1144s You are welcome to redistribute it under certain conditions. 1144s Type 'license()' or 'licence()' for distribution details. 1144s 1144s R is a collaborative project with many contributors. 1144s Type 'contributors()' for more information and 1144s 'citation()' on how to cite R or R packages in publications. 1144s 1144s Type 'demo()' for some demos, 'help()' for on-line help, or 1144s 'help.start()' for an HTML browser interface to help. 1144s Type 'q()' to quit R. 1144s 1144s > library(mcmc) 1144s > 1144s > .morph.unmorph <- mcmc:::.morph.unmorph 1144s > 1144s > ########################################################################### 1144s > # basic functionality check, can morph.metro run? Can we change the 1144s > # transformation? 1144s > set.seed(42) 1144s > obj <- morph.metrop(function(x) dt(x, df=3, log=TRUE), 1144s + 100, 100, morph=morph(b=3)) 1144s > obj <- morph.metrop(obj, morph=morph(b=1)) 1144s > 1144s > obj <- morph.metrop(function(x) prod(dt(x, df=3, log=TRUE)), 1144s + rep(100, 3), 100, morph=morph(p=3, b=1)) 1144s > obj <- morph.metrop(obj, morph=morph(r=1, p=3, b=1)) 1144s > 1144s > all.equal(class(obj), c("mcmc", "morph.metropolis")) 1144s [1] TRUE 1144s > 1144s > ########################################################################### 1144s > # check .morph.unmorph 1144s > obj <- list(final=10) 1144s > outfun <- function(x) x 1144s > m <- morph(p=3) 1144s > obj <- .morph.unmorph(obj, m, outfun) 1144s > all.equal(class(obj), c("mcmc", "morph.metropolis")) 1144s [1] TRUE 1144s > all.equal(sort(names(obj)), 1144s + sort(c("final", "morph", "morph.final", "outfun"))) 1144s [1] TRUE 1144s > all.equal(c(obj$final, obj$morph.final), c(m$inverse(10), 10)) 1144s [1] TRUE 1144s > all.equal(obj$outfun, outfun) 1144s [1] TRUE 1144s > all.equal(obj$morph, m) 1144s [1] TRUE 1144s > 1144s BEGIN TEST tests/morphtoo.R 1144s 1144s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1144s Copyright (C) 2025 The R Foundation for Statistical Computing 1144s Platform: s390x-ibm-linux-gnu 1144s 1144s R is free software and comes with ABSOLUTELY NO WARRANTY. 1144s You are welcome to redistribute it under certain conditions. 1144s Type 'license()' or 'licence()' for distribution details. 1144s 1144s R is a collaborative project with many contributors. 1144s Type 'contributors()' for more information and 1144s 'citation()' on how to cite R or R packages in publications. 1144s 1144s Type 'demo()' for some demos, 'help()' for on-line help, or 1144s 'help.start()' for an HTML browser interface to help. 1144s Type 'q()' to quit R. 1144s 1144s > 1144s > library(mcmc) 1144s > 1144s > x <- seq(0, 10, length = 10001) 1144s > 1144s > ### sub-exponentially light transformation 1144s > 1144s > b <- 0.5 1144s > fsub <- morph(b = b) 1144s > 1144s > y <- unlist(Map(fsub$inverse, x)) 1144s > 1144s > myfsub <- function(x) ifelse(x > 1 / b, exp(b * x) - exp(1) / 3, 1144s + (x * b)^3 * exp(1) / 6 + x * b * exp(1) / 2) 1144s > y2 <- myfsub(x) 1144s > all.equal(y, y2, tolerance = 1e-14) 1144s [1] TRUE 1144s > 1144s > z <- unlist(Map(fsub$transform, y)) 1144s > all.equal(z, x, tolerance = 1e-14) 1144s [1] TRUE 1144s > 1144s > ### exponentially light transformation 1144s > 1144s > r <- 5 1144s > p <- 3 1144s > fp3 <- morph(r = r) 1144s > 1144s > y <- unlist(Map(fp3$inverse, x)) 1144s > 1144s > myfp3 <- function(x) ifelse(x < r, x, x + (x - r)^p) 1144s > y2 <- myfp3(x) 1144s > all.equal(y, y2, tolerance = 1e-14) 1144s [1] TRUE 1144s > 1144s > z <- unlist(Map(fp3$transform, y)) 1144s > all.equal(z, x, tolerance = 1e-12) 1144s [1] TRUE 1144s > 1144s > ### both together 1144s > 1144s > fboth <- morph(b = b, r = r) 1144s > 1144s > y <- unlist(Map(fboth$inverse, x)) 1145s > y2 <- myfsub(myfp3(x)) 1145s > all.equal(y, y2, tolerance = 1e-14) 1145s [1] TRUE 1145s > 1145s > z <- unlist(Map(fboth$transform, y)) 1145s > all.equal(z, x, tolerance = 1e-12) 1145s [1] TRUE 1145s > 1145s > ### exponentially light transformation with p != 3 1145s > 1145s > r <- 5 1145s > p <- 2.2 1145s > fpo <- morph(r = r, p = p) 1145s > 1145s > y <- unlist(Map(fpo$inverse, x)) 1145s > 1145s > myfpo <- function(x) ifelse(x < r, x, x + (x - r)^p) 1145s > y2 <- myfpo(x) 1145s > all.equal(y, y2, tolerance = 1e-14) 1145s [1] TRUE 1145s > 1145s > z <- unlist(Map(fpo$transform, y)) 1145s > all.equal(z, x, tolerance = 1e-14) 1145s [1] TRUE 1145s > 1145s > 1145s BEGIN TEST tests/saveseed.R 1145s 1145s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1145s Copyright (C) 2025 The R Foundation for Statistical Computing 1145s Platform: s390x-ibm-linux-gnu 1145s 1145s R is free software and comes with ABSOLUTELY NO WARRANTY. 1145s You are welcome to redistribute it under certain conditions. 1145s Type 'license()' or 'licence()' for distribution details. 1145s 1145s R is a collaborative project with many contributors. 1145s Type 'contributors()' for more information and 1145s 'citation()' on how to cite R or R packages in publications. 1145s 1145s Type 'demo()' for some demos, 'help()' for on-line help, or 1145s 'help.start()' for an HTML browser interface to help. 1145s Type 'q()' to quit R. 1145s 1145s > 1145s > library(mcmc) 1145s > 1145s > set.seed(42) 1145s > 1145s > h <- function(x) if (all(x >= 0) && sum(x) <= 1) return(1) else return(-Inf) 1145s > out <- metrop(h, initial = rep(0, 5), nbatch = 100, blen = 17, nspac = 3, 1145s + scale = 0.1) 1145s > 1145s > save.seed <- .Random.seed 1145s > 1145s > out1 <- metrop(out) 1145s > out2 <- metrop(out1) 1145s > out3 <- metrop(out, nbatch = 2 * out$nbatch) 1145s > 1145s > fred <- rbind(out1$batch, out2$batch) 1145s > identical(fred, out3$batch) 1145s [1] TRUE 1145s > 1145s > 1145s BEGIN TEST tests/saveseedmorph.R 1145s 1145s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1145s Copyright (C) 2025 The R Foundation for Statistical Computing 1145s Platform: s390x-ibm-linux-gnu 1145s 1145s R is free software and comes with ABSOLUTELY NO WARRANTY. 1145s You are welcome to redistribute it under certain conditions. 1145s Type 'license()' or 'licence()' for distribution details. 1145s 1145s R is a collaborative project with many contributors. 1145s Type 'contributors()' for more information and 1145s 'citation()' on how to cite R or R packages in publications. 1145s 1145s Type 'demo()' for some demos, 'help()' for on-line help, or 1145s 'help.start()' for an HTML browser interface to help. 1145s Type 'q()' to quit R. 1145s 1145s > 1145s > library(mcmc) 1145s > 1145s > set.seed(42) 1145s > 1145s > h <- function(x) if (all(x >= 0) && sum(x) <= 1) return(1) else return(-Inf) 1145s > out <- morph.metrop(obj = h, initial = rep(0, 5), nbatch = 100, blen = 17, 1145s + nspac = 3, scale = 0.1) 1145s > 1145s > out1 <- morph.metrop(out) 1145s > out2 <- morph.metrop(out1) 1145s > out3 <- morph.metrop(out, nbatch = 2 * out$nbatch) 1145s > 1145s > fred <- rbind(out1$batch, out2$batch) 1145s > identical(fred, out3$batch) 1145s [1] TRUE 1145s > 1145s > out <- morph.metrop(out, morph = morph(p = 2.2, r = 0.3)) 1145s > 1145s > out1 <- morph.metrop(out) 1145s > out2 <- morph.metrop(out1) 1145s > out3 <- morph.metrop(out, nbatch = 2 * out$nbatch) 1145s > 1145s > fred <- rbind(out1$batch, out2$batch) 1145s > identical(fred, out3$batch) 1145s [1] TRUE 1145s > 1145s > 1145s BEGIN TEST tests/temp-par-witch.R 1145s 1145s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1145s Copyright (C) 2025 The R Foundation for Statistical Computing 1145s Platform: s390x-ibm-linux-gnu 1145s 1145s R is free software and comes with ABSOLUTELY NO WARRANTY. 1145s You are welcome to redistribute it under certain conditions. 1145s Type 'license()' or 'licence()' for distribution details. 1145s 1145s R is a collaborative project with many contributors. 1145s Type 'contributors()' for more information and 1145s 'citation()' on how to cite R or R packages in publications. 1145s 1145s Type 'demo()' for some demos, 'help()' for on-line help, or 1145s 'help.start()' for an HTML browser interface to help. 1145s Type 'q()' to quit R. 1145s 1146s > 1146s > if ((! exists("DEBUG")) || (! identical(DEBUG, TRUE))) DEBUG <- FALSE 1146s > 1146s > library(mcmc) 1146s > 1146s > options(digits=4) # avoid rounding differences 1146s > 1146s > set.seed(42) 1146s > 1146s > save.initial.seed <- .Random.seed 1146s > 1146s > d <- 3 1146s > witch.which <- 1 - (1 / 2)^(1 / d) * (1 / 4)^(seq(0, 5) / d) 1146s > witch.which 1146s [1] 0.2063 0.5000 0.6850 0.8016 0.8750 0.9213 1146s > 1146s > ncomp <- length(witch.which) 1146s > 1146s > neighbors <- matrix(FALSE, ncomp, ncomp) 1146s > neighbors[row(neighbors) == col(neighbors) + 1] <- TRUE 1146s > neighbors[row(neighbors) == col(neighbors) - 1] <- TRUE 1146s > neighbors[row(neighbors) == col(neighbors) + 2] <- TRUE 1146s > neighbors[row(neighbors) == col(neighbors) - 2] <- TRUE 1146s > 1146s > ludfun <- function(state) { 1146s + stopifnot(is.numeric(state)) 1146s + stopifnot(length(state) == d + 1) 1146s + icomp <- state[1] 1146s + stopifnot(icomp == as.integer(icomp)) 1146s + stopifnot(1 <= icomp && icomp <= ncomp) 1146s + theta <- state[-1] 1146s + if (any(abs(theta) > 1.0)) return(-Inf) 1146s + bnd <- witch.which[icomp] 1146s + if(bnd >= 1.0) 1146s + stop(sprintf("witch.which[%d] >= 1.0", icomp)) 1146s + if(bnd <= 0.0) 1146s + stop(sprintf("witch.which[%d] <= 0.0", icomp)) 1146s + if (all(abs(theta) > bnd)) 1146s + return(- (d + 1) * log(2) - d * log(1 - bnd)) 1146s + return(- (d + 1) * log(2) - log1p(- (1 - bnd)^d)) 1146s + } 1146s > 1146s > thetas <- matrix(0, ncomp, d) 1146s > out <- temper(ludfun, initial = thetas, neighbors = neighbors, nbatch = 50, 1146s + blen = 13, nspac = 7, scale = 0.3456789, parallel = TRUE, debug = DEBUG) 1146s > 1146s > names(out) 1146s [1] "lud" "neighbors" "nbatch" "blen" "nspac" 1146s [6] "scale" "outfun" "debug" "parallel" "initial.seed" 1146s [11] "final.seed" "time" "batch" "acceptx" "accepti" 1146s [16] "initial" "final" 1146s > 1146s > out$acceptx 1146s [1] 0.6336 0.4974 0.3245 0.6022 0.6130 0.5914 1146s > 1146s > out$accepti 1146s [,1] [,2] [,3] [,4] [,5] [,6] 1146s [1,] NA 0.7051 0.5497 NA NA NA 1146s [2,] 0.7523 NA 0.5547 0.6288 NA NA 1146s [3,] 0.5794 0.5865 NA 0.5309 0.5476 NA 1146s [4,] NA 0.6667 0.5506 NA 0.8272 0.6837 1146s [5,] NA NA 0.5439 0.8926 NA 0.8374 1146s [6,] NA NA NA 0.8391 0.9023 NA 1146s > 1146s > ### check that have prob 1 / 2 for corners 1146s > 1146s > outfun <- function(state) { 1146s + stopifnot(is.matrix(state)) 1146s + ncomp <- nrow(state) 1146s + d <- ncol(state) 1146s + foo <- sweep(abs(state), 1, witch.which) 1146s + bar <- apply(foo > 0, 1, all) 1146s + return(as.numeric(bar)) 1146s + } 1146s > 1146s > out2 <- temper(out, outfun = outfun) 1146s > 1146s > colMeans(out2$batch) 1146s [1] 0.54923 0.40923 0.39538 0.09692 0.12923 0.60000 1146s > apply(out2$batch, 2, sd) / sqrt(out$nbatch) 1146s [1] 0.03482 0.04817 0.05464 0.02856 0.02113 0.05131 1146s > 1146s > ### try again 1146s > 1146s > out3 <- temper(out2, blen = 103) 1147s > 1147s > foo <- cbind(colMeans(out3$batch), 1147s + apply(out3$batch, 2, sd) / sqrt(out$nbatch)) 1147s > colnames(foo) <- c("means", "MCSE") 1147s > foo 1147s means MCSE 1147s [1,] 0.5231 0.01390 1147s [2,] 0.5361 0.02213 1147s [3,] 0.4905 0.03961 1147s [4,] 0.5652 0.04909 1147s [5,] 0.4056 0.05107 1147s [6,] 0.2450 0.05108 1147s > 1147s > 1147s BEGIN TEST tests/temp-par.R 1147s 1147s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1147s Copyright (C) 2025 The R Foundation for Statistical Computing 1147s Platform: s390x-ibm-linux-gnu 1147s 1147s R is free software and comes with ABSOLUTELY NO WARRANTY. 1147s You are welcome to redistribute it under certain conditions. 1147s Type 'license()' or 'licence()' for distribution details. 1147s 1147s R is a collaborative project with many contributors. 1147s Type 'contributors()' for more information and 1147s 'citation()' on how to cite R or R packages in publications. 1147s 1147s Type 'demo()' for some demos, 'help()' for on-line help, or 1147s 'help.start()' for an HTML browser interface to help. 1147s Type 'q()' to quit R. 1147s 1147s > 1147s > library(mcmc) 1147s > 1147s > set.seed(42) 1147s > 1147s > data(foo) 1147s > attach(foo) 1147s > 1147s > out <- glm(y ~ x1 + x2 + x3, family = binomial, x = TRUE) 1147s > ## IGNORE_RDIFF_BEGIN 1147s > summary(out) 1147s 1147s Call: 1147s glm(formula = y ~ x1 + x2 + x3, family = binomial, x = TRUE) 1147s 1147s Coefficients: 1147s Estimate Std. Error z value Pr(>|z|) 1147s (Intercept) 0.5772 0.2766 2.087 0.036930 * 1147s x1 0.3362 0.4256 0.790 0.429672 1147s x2 0.8475 0.4701 1.803 0.071394 . 1147s x3 1.5143 0.4426 3.422 0.000622 *** 1147s --- 1147s Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 1147s 1147s (Dispersion parameter for binomial family taken to be 1) 1147s 1147s Null deviance: 134.602 on 99 degrees of freedom 1147s Residual deviance: 86.439 on 96 degrees of freedom 1147s AIC: 94.439 1147s 1147s Number of Fisher Scoring iterations: 5 1147s 1147s > ## IGNORE_RDIFF_END 1147s > 1147s > modmat <- out$x 1147s > 1147s > models <- cbind(rep(0:1, each = 4), rep(rep(0:1, times = 2), each = 2), 1147s + rep(0:1, times = 4)) 1147s > 1147s > exes <- paste("x", 1:3, sep = "") 1147s > betas <- NULL 1147s > for (i in 1:nrow(models)) { 1147s + inies <- as.logical(models[i, ]) 1147s + foo <- exes[inies] 1147s + bar <- paste("y ~", paste(foo, collapse = " + ")) 1147s + if (! any(inies)) bar <- paste(bar, "1") 1147s + baz <- glm(as.formula(bar), family = binomial) 1147s + beta <- rep(0, 4) 1147s + beta[c(TRUE, inies)] <- baz$coef 1147s + betas <- rbind(betas, beta) 1147s + } 1147s > 1147s > neighbors <- matrix(FALSE, nrow(models), nrow(models)) 1147s > for (i in 1:nrow(neighbors)) { 1147s + for (j in 1:ncol(neighbors)) { 1147s + foo <- models[i, ] 1147s + bar <- models[j, ] 1147s + if (sum(foo != bar) == 1) neighbors[i, j] <- TRUE 1147s + } 1147s + } 1147s > 1147s > ludfun <- function(state, ...) { 1147s + stopifnot(is.numeric(state)) 1147s + stopifnot(length(state) == ncol(models) + 2) 1147s + stopifnot(length(state) == ncol(models) + 2) 1147s + icomp <- state[1] 1147s + stopifnot(icomp == as.integer(icomp)) 1147s + stopifnot(1 <= icomp && icomp <= nrow(models)) 1147s + beta <- state[-1] 1147s + inies <- c(TRUE, as.logical(models[icomp, ])) 1147s + beta.logl <- beta 1147s + beta.logl[! inies] <- 0 1147s + eta <- as.numeric(modmat %*% beta.logl) 1147s + logp <- ifelse(eta < 0, eta - log1p(exp(eta)), - log1p(exp(- eta))) 1147s + logq <- ifelse(eta < 0, - log1p(exp(eta)), - eta - log1p(exp(- eta))) 1147s + logl <- sum(logp[y == 1]) + sum(logq[y == 0]) 1147s + val <- logl - sum(beta^2) / 2 1147s + return(val) 1147s + } 1147s > 1147s > ludval <- NULL 1147s > for (i in 1:nrow(models)) ludval <- c(ludval, ludfun(c(i, betas[i, ]))) 1147s > all(is.finite(ludval)) 1147s [1] TRUE 1147s > 1147s > 1147s > out <- temper(ludfun, initial = betas, neighbors = neighbors, nbatch = 20, 1147s + blen = 10, nspac = 5, scale = 0.56789, parallel = TRUE, debug = TRUE) 1147s > 1147s > names(out) 1147s [1] "lud" "neighbors" "nbatch" "blen" 1147s [5] "nspac" "scale" "outfun" "debug" 1147s [9] "parallel" "initial.seed" "final.seed" "time" 1147s [13] "batch" "acceptx" "accepti" "initial" 1147s [17] "final" "which" "unif.which" "state" 1147s [21] "log.hastings" "unif.hastings" "proposal" "acceptd" 1147s [25] "norm" "unif.choose" "coproposal" 1147s > 1147s > ### check decision about within-component or jump/swap 1147s > 1147s > identical(out$unif.which < 0.5, out$which) 1147s [1] TRUE 1147s > 1147s > identical(out$which, out$proposal[ , 1] == out$coproposal[ , 1]) 1147s [1] TRUE 1147s > 1147s > ### check proposal and coproposal are actually current state or part thereof 1147s > 1147s > prop <- out$proposal 1147s > coprop <- out$coproposal 1147s > prop.i <- prop[ , 1] 1147s > coprop.i <- coprop[ , 1] 1147s > alt.prop <- prop 1147s > alt.coprop <- coprop 1147s > for (i in 1:nrow(prop)) { 1147s + alt.prop[i, ] <- c(prop.i[i], out$state[i, prop.i[i], ]) 1147s + alt.coprop[i, ] <- c(coprop.i[i], out$state[i, coprop.i[i], ]) 1147s + } 1147s > identical(coprop, alt.coprop) 1147s [1] TRUE 1147s > identical(prop[! out$which, ], alt.prop[! out$which, ]) 1147s [1] TRUE 1147s > identical(prop[out$which, 1], alt.prop[out$which, 1]) 1147s [1] TRUE 1147s > 1147s > ### check hastings ratio calculated correctly 1147s > 1147s > foo <- apply(prop, 1, ludfun) 1147s > fooco <- apply(coprop, 1, ludfun) 1147s > prop[ , 1] <- out$coproposal[ , 1] 1147s > coprop[ , 1] <- out$proposal[ , 1] 1147s > foo.swap <- apply(prop, 1, ludfun) 1147s > fooco.swap <- apply(coprop, 1, ludfun) 1147s > log.haste <- ifelse(out$which, foo - fooco, 1147s + foo.swap + fooco.swap - foo - fooco) 1147s > all.equal(log.haste, out$log.hastings) 1147s [1] TRUE 1147s > 1147s > ### check hastings rejection decided correctly 1147s > 1147s > identical(out$log.hastings >= 0, is.na(out$unif.hastings)) 1147s [1] TRUE 1147s > all(out$log.hastings < 0 | out$acceptd) 1147s [1] TRUE 1147s > identical(out$acceptd, 1147s + out$log.hastings >= 0 | out$unif.hastings < exp(out$log.hastings)) 1147s [1] TRUE 1147s > 1147s > ### check acceptance carried out or not (according to decision) correctly 1147s > 1147s > before <- out$state 1147s > after <- before 1147s > after[- dim(after)[1], , ] <- before[-1, , ] 1147s > after[dim(after)[1], , ] <- out$final 1147s > my.after <- before 1147s > for (i in 1:length(out$acceptd)) { 1147s + if (out$acceptd[i]) { 1147s + if (out$which[i]) { 1147s + j <- out$proposal[i, 1] 1147s + my.after[i, j, ] <- out$proposal[i, -1] 1147s + } else { 1147s + j <- out$proposal[i, 1] 1147s + k <- out$coproposal[i, 1] 1147s + my.after[i, j, ] <- out$coproposal[i, -1] 1147s + my.after[i, k, ] <- out$proposal[i, -1] 1147s + } 1147s + } 1147s + } 1147s > identical(after, my.after) 1147s [1] TRUE 1147s > 1147s > ### check within-component proposal 1147s > 1147s > my.coproposal.within <- out$coproposal[out$which, ] 1147s > proposal.within <- out$proposal[out$which, ] 1147s > my.z <- out$norm[out$which, ] 1147s > my.proposal.within <- my.coproposal.within 1147s > my.proposal.within[ , -1] <- my.coproposal.within[ , -1] + out$scale * my.z 1147s > all.equal(proposal.within, my.proposal.within) 1147s [1] TRUE 1147s > 1147s > my.unif.choose <- out$unif.choose[out$which, 1] 1147s > my.i <- floor(nrow(models) * my.unif.choose) + 1 1147s > all(1 <= my.i & my.i <= nrow(models)) 1147s [1] TRUE 1147s > identical(my.i, my.coproposal.within[ , 1]) 1147s [1] TRUE 1147s > 1147s > ### check swap proposal 1147s > 1147s > coproposal.swap <- out$coproposal[! out$which, ] 1147s > proposal.swap <- out$proposal[! out$which, ] 1147s > unif.choose.swap <- out$unif.choose[! out$which, ] 1147s > my.i <- floor(nrow(models) * unif.choose.swap[ , 1]) + 1 1147s > nneighbors <- apply(out$neighbors, 1, sum) 1147s > my.nneighbors <- nneighbors[my.i] 1147s > my.k <- floor(my.nneighbors * unif.choose.swap[ , 2]) + 1 1147s > my.j <- my.k 1147s > foo <- seq(1, ncol(out$neighbors)) 1147s > for (i in seq(along = my.j)) { 1147s + my.j[i] <- (foo[out$neighbors[my.i[i], ]])[my.k[i]] 1147s + } 1147s > identical(coproposal.swap[ , 1], my.i) 1147s [1] TRUE 1147s > identical(proposal.swap[ , 1], my.j) 1147s [1] TRUE 1147s > 1147s > ### check standard normal and uniform random numbers are as purported 1147s > 1147s > save.Random.seed <- .Random.seed 1147s > .Random.seed <- out$initial.seed 1147s > 1147s > nx <- ncol(out$initial) 1147s > niter <- out$nbatch * out$blen * out$nspac 1147s > my.norm <- matrix(NA, nrow = nrow(out$norm), ncol = ncol(out$norm)) 1147s > my.unif.which <- rep(NA, niter) 1147s > my.unif.hastings <- rep(NA, niter) 1147s > my.unif.choose <- matrix(NA, niter, 2) 1147s > for (iiter in 1:niter) { 1147s + my.unif.which[iiter] <- runif(1) 1147s + if (out$which[iiter]) { 1147s + my.unif.choose[iiter, 1] <- runif(1) 1147s + my.norm[iiter, ] <- rnorm(nx) 1147s + if (out$log.hastings[iiter] < 0) my.unif.hastings[iiter] <- runif(1) 1147s + } else { 1147s + my.unif.choose[iiter, ] <- runif(2) 1147s + if (out$log.hastings[iiter] < 0) my.unif.hastings[iiter] <- runif(1) 1147s + } 1147s + } 1147s > identical(my.norm, out$norm) 1147s [1] TRUE 1147s > identical(my.unif.which, out$unif.which) 1147s [1] TRUE 1147s > identical(my.unif.hastings, out$unif.hastings) 1147s [1] TRUE 1147s > identical(my.unif.choose, out$unif.choose) 1147s [1] TRUE 1147s > 1147s > .Random.seed <- save.Random.seed 1147s > 1147s > ### check batch means 1147s > 1147s > foo <- after[seq(1, niter) %% out$nspac == 0, , ] 1147s > foo <- array(as.vector(foo), dim = c(out$blen, out$nbatch, dim(foo)[2:3])) 1147s > foo <- apply(foo, c(2, 3, 4), mean) 1147s > all.equal(foo, out$batch) 1147s [1] TRUE 1147s > 1147s > ### check acceptance rates 1147s > 1147s > accept.within <- out$acceptd[out$which] 1147s > my.i.within <- out$coproposal[out$which, 1] 1147s > my.acceptx <- as.vector(sapply(split(accept.within, my.i.within), mean)) 1147s > identical(my.acceptx, out$acceptx) 1147s [1] TRUE 1147s > 1147s > accept.swap <- out$acceptd[! out$which] 1147s > my.i.swap <- out$coproposal[! out$which, 1] 1147s > my.j.swap <- out$proposal[! out$which, 1] 1147s > nmodel <- nrow(out$neighbors) 1147s > my.accepti <- matrix(NA, nmodel, nmodel) 1147s > for (i in 1:nmodel) { 1147s + for (j in 1:nmodel) { 1147s + if (out$neighbors[i, j]) { 1147s + my.accepti[i, j] <- 1147s + mean(accept.swap[my.i.swap == i & my.j.swap == j]) 1147s + } 1147s + } 1147s + } 1147s > identical(my.accepti, out$accepti) 1147s [1] TRUE 1147s > 1147s > ### check scale vector 1147s > 1147s > nx <- ncol(models) + 1 1147s > newscale <- rnorm(nx, 0.5, 0.1) 1147s > 1147s > out <- temper(out, scale = newscale) 1147s > 1147s > my.coproposal.within <- out$coproposal[out$which, ] 1147s > proposal.within <- out$proposal[out$which, ] 1147s > my.z <- out$norm[out$which, ] 1147s > my.proposal.within <- my.coproposal.within 1147s > my.proposal.within[ , -1] <- my.coproposal.within[ , -1] + 1147s + sweep(my.z, 2, out$scale, "*") 1147s > all.equal(proposal.within, my.proposal.within) 1147s [1] TRUE 1147s > 1147s > ### check scale matrix 1147s > 1147s > matscale <- matrix(rnorm(nx * nx, 0.0, 0.1), nx, nx) 1147s > diag(matscale) <- 0.56789 1147s > 1147s > out <- temper(out, scale = matscale) 1147s > 1147s > my.coproposal.within <- out$coproposal[out$which, ] 1147s > proposal.within <- out$proposal[out$which, ] 1147s > my.z <- out$norm[out$which, ] 1147s > my.proposal.within <- my.coproposal.within 1147s > my.proposal.within[ , -1] <- my.coproposal.within[ , -1] + 1147s + my.z %*% t(out$scale) 1147s > all.equal(proposal.within, my.proposal.within) 1147s [1] TRUE 1147s > 1147s > ### check scale list 1147s > 1147s > lisztscale <- list(0.56789, newscale, matscale, matscale, newscale, 1147s + 0.98765, 0.98765, newscale) 1147s > 1147s > out <- temper(out, scale = lisztscale) 1147s > 1147s > my.coproposal.within <- out$coproposal[out$which, ] 1147s > proposal.within <- out$proposal[out$which, ] 1147s > my.z <- out$norm[out$which, ] 1147s > my.proposal.within <- my.coproposal.within 1147s > for (iiter in 1:nrow(my.z)) { 1147s + my.i <- my.coproposal.within[iiter, 1] 1147s + my.scale <- out$scale[[my.i]] 1147s + if (is.matrix(my.scale)) { 1147s + my.proposal.within[iiter, -1] <- my.coproposal.within[iiter, -1] + 1147s + my.z[iiter, , drop = FALSE] %*% t(my.scale) 1147s + } else { 1147s + my.proposal.within[iiter, -1] <- my.coproposal.within[iiter, -1] + 1147s + my.z[iiter, ] * my.scale 1147s + } 1147s + } 1148s > all.equal(proposal.within, my.proposal.within) 1148s [1] TRUE 1148s > 1148s > ### check outfun 1148s > 1148s > outfun <- function(state, icomp, ...) { 1148s + stopifnot(is.matrix(state)) 1148s + stopifnot(is.numeric(state)) 1148s + nx <- ncol(betas) 1148s + ncomp <- nrow(betas) 1148s + stopifnot(ncol(state) == nx) 1148s + stopifnot(nrow(state) == ncomp) 1148s + stopifnot(1 <= icomp && icomp <= ncomp) 1148s + foo <- state[icomp, ] 1148s + bar <- foo^2 1148s + return(c(foo, bar)) 1148s + } 1148s > 1148s > out <- temper(out, outfun = outfun, icomp = 4) 1148s > 1148s > before <- out$state 1148s > after <- before 1148s > after[- dim(after)[1], , ] <- before[-1, , ] 1148s > after[dim(after)[1], , ] <- out$final 1148s > outies <- apply(after, 1, outfun, icomp = 4) 1148s > outies <- t(outies) 1148s > 1148s > foo <- outies[seq(1, niter) %% out$nspac == 0, ] 1148s > foo <- array(as.vector(foo), dim = c(out$blen, out$nbatch, dim(foo)[2])) 1148s > foo <- apply(foo, c(2, 3), mean) 1148s > all.equal(foo, out$batch) 1148s [1] TRUE 1148s > 1148s > 1148s BEGIN TEST tests/temp-ser-witch.R 1148s 1148s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1148s Copyright (C) 2025 The R Foundation for Statistical Computing 1148s Platform: s390x-ibm-linux-gnu 1148s 1148s R is free software and comes with ABSOLUTELY NO WARRANTY. 1148s You are welcome to redistribute it under certain conditions. 1148s Type 'license()' or 'licence()' for distribution details. 1148s 1148s R is a collaborative project with many contributors. 1148s Type 'contributors()' for more information and 1148s 'citation()' on how to cite R or R packages in publications. 1148s 1148s Type 'demo()' for some demos, 'help()' for on-line help, or 1148s 'help.start()' for an HTML browser interface to help. 1148s Type 'q()' to quit R. 1148s 1148s > 1148s > library(mcmc) 1148s > 1148s > set.seed(42) 1148s > 1148s > d <- 3 1148s > witch.which <- 1 - (1 / 2)^(1 / d) * (1 / 4)^(seq(0, 5) / d) 1148s > witch.which 1148s [1] 0.2062995 0.5000000 0.6850197 0.8015749 0.8750000 0.9212549 1148s > 1148s > ncomp <- length(witch.which) 1148s > 1148s > neighbors <- matrix(FALSE, ncomp, ncomp) 1148s > neighbors[row(neighbors) == col(neighbors) + 1] <- TRUE 1148s > neighbors[row(neighbors) == col(neighbors) - 1] <- TRUE 1148s > neighbors[row(neighbors) == col(neighbors) + 2] <- TRUE 1148s > neighbors[row(neighbors) == col(neighbors) - 2] <- TRUE 1148s > 1148s > ludfun <- function(state) { 1148s + stopifnot(is.numeric(state)) 1148s + stopifnot(length(state) == d + 1) 1148s + icomp <- state[1] 1148s + stopifnot(icomp == as.integer(icomp)) 1148s + stopifnot(1 <= icomp && icomp <= ncomp) 1148s + theta <- state[-1] 1148s + if (any(abs(theta) > 1.0)) return(-Inf) 1148s + bnd <- witch.which[icomp] 1148s + if(bnd >= 1.0) 1148s + stop(sprintf("witch.which[%d] >= 1.0", icomp)) 1148s + if(bnd <= 0.0) 1148s + stop(sprintf("witch.which[%d] <= 0.0", icomp)) 1148s + if (all(abs(theta) > bnd)) 1148s + return(- (d + 1) * log(2) - d * log(1 - bnd)) 1148s + return(- (d + 1) * log(2) - log1p(- (1 - bnd)^d)) 1148s + } 1148s > 1148s > initial <- c(1, rep(0, d)) 1148s > 1148s > out <- temper(ludfun, initial = initial, neighbors = neighbors, 1148s + nbatch = 50, blen = 13, nspac = 7, scale = 0.3456789) 1148s > 1148s > names(out) 1148s [1] "lud" "neighbors" "nbatch" "blen" "nspac" 1148s [6] "scale" "outfun" "debug" "parallel" "initial.seed" 1148s [11] "final.seed" "time" "batch" "acceptx" "accepti" 1148s [16] "initial" "final" "ibatch" 1148s > 1148s > out$acceptx 1148s [1] 0.6388889 0.4385246 0.3631714 0.4885246 0.4709677 0.4735516 1148s > 1148s > out$accepti 1148s [,1] [,2] [,3] [,4] [,5] [,6] 1148s [1,] NA 0.5071770 0.2727273 NA NA NA 1148s [2,] 0.7070064 NA 0.4355828 0.4186047 NA NA 1148s [3,] 0.5816327 0.8039216 NA 0.5888889 0.5662651 NA 1148s [4,] NA 0.7415730 0.8571429 NA 0.7857143 0.6626506 1148s [5,] NA NA 0.5204082 0.6516854 NA 0.8378378 1148s [6,] NA NA NA 0.3515152 0.5056818 NA 1148s > 1148s > colMeans(out$ibatch) 1148s [1] 0.1830769 0.2153846 0.1630769 0.1369231 0.1353846 0.1661538 1148s > 1148s > ### check that have prob 1 / 2 for corners 1148s > 1148s > outfun <- function(state) { 1148s + stopifnot(is.numeric(state)) 1148s + icomp <- state[1] 1148s + stopifnot(icomp == as.integer(icomp)) 1148s + stopifnot(1 <= icomp && icomp <= length(witch.which)) 1148s + theta <- state[-1] 1148s + foo <- all(abs(theta) > witch.which[icomp]) 1148s + bar <- rep(0, length(witch.which)) 1148s + baz <- rep(0, length(witch.which)) 1148s + bar[icomp] <- as.numeric(foo) 1148s + baz[icomp] <- 1 1148s + return(c(bar, baz)) 1148s + } 1148s > 1148s > out <- temper(out, blen = 103, outfun = outfun, debug = TRUE) 1148s > 1148s > eta.batch <- out$batch[ , seq(1, ncomp)] 1148s > noo.batch <- out$batch[ , seq(ncomp + 1, ncomp + ncomp)] 1148s > eta <- colMeans(eta.batch) 1148s > noo <- colMeans(noo.batch) 1148s > mu <- eta / noo 1148s > eta 1148s [1] 0.06660194 0.06388350 0.05766990 0.06563107 0.10368932 0.22912621 1148s > noo 1148s [1] 0.1365049 0.1258252 0.1293204 0.1370874 0.1716505 0.2996117 1148s > mu 1148s [1] 0.4879090 0.5077160 0.4459459 0.4787535 0.6040724 0.7647440 1148s > 1148s > eta.batch.rel <- sweep(eta.batch, 2, eta, "/") 1148s > noo.batch.rel <- sweep(noo.batch, 2, noo, "/") 1148s > mu.batch.rel <- eta.batch.rel - noo.batch.rel 1148s > 1148s > mu.mcse.rel <- apply(mu.batch.rel, 2, sd) / sqrt(out$nbatch) 1148s > mu.mcse.rel 1148s [1] 0.05010927 0.07897321 0.09678339 0.12636113 0.11261781 0.07082685 1148s > 1148s > foo <- cbind(mu, mu * mu.mcse.rel) 1148s > colnames(foo) <- c("means", "MCSE") 1148s > foo 1148s means MCSE 1148s [1,] 0.4879090 0.02444876 1148s [2,] 0.5077160 0.04009596 1148s [3,] 0.4459459 0.04316016 1148s [4,] 0.4787535 0.06049584 1148s [5,] 0.6040724 0.06802931 1148s [6,] 0.7647440 0.05416441 1148s > 1148s > ### check decision about within-component or jump/swap 1148s > 1148s > identical(out$unif.which < 0.5, out$which) 1148s [1] TRUE 1148s > 1148s > identical(out$which, out$proposal[ , 1] == out$state[ , 1]) 1148s [1] TRUE 1148s > 1148s > ### check hastings ratio calculated correctly 1148s > 1148s > n <- apply(neighbors, 1, sum) 1148s > i <- out$state[ , 1] 1148s > istar <- out$proposal[ , 1] 1148s > foo <- apply(out$state, 1, ludfun) 1149s > bar <- apply(out$proposal, 1, ludfun) 1149s > my.log.hastings <- bar - foo - log(n[istar]) + log(n[i]) 1149s > all.equal(my.log.hastings, out$log.hastings) 1149s [1] TRUE 1149s > 1149s > 1149s BEGIN TEST tests/temp-ser.R 1149s 1149s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1149s Copyright (C) 2025 The R Foundation for Statistical Computing 1149s Platform: s390x-ibm-linux-gnu 1149s 1149s R is free software and comes with ABSOLUTELY NO WARRANTY. 1149s You are welcome to redistribute it under certain conditions. 1149s Type 'license()' or 'licence()' for distribution details. 1149s 1149s R is a collaborative project with many contributors. 1149s Type 'contributors()' for more information and 1149s 'citation()' on how to cite R or R packages in publications. 1149s 1149s Type 'demo()' for some demos, 'help()' for on-line help, or 1149s 'help.start()' for an HTML browser interface to help. 1149s Type 'q()' to quit R. 1149s 1149s > 1149s > library(mcmc) 1149s > 1149s > set.seed(42) 1149s > 1149s > data(foo) 1149s > attach(foo) 1149s > 1149s > out <- glm(y ~ x1 + x2 + x3, family = binomial, x = TRUE) 1149s > ## IGNORE_RDIFF_BEGIN 1149s > summary(out) 1149s 1149s Call: 1149s glm(formula = y ~ x1 + x2 + x3, family = binomial, x = TRUE) 1149s 1149s Coefficients: 1149s Estimate Std. Error z value Pr(>|z|) 1149s (Intercept) 0.5772 0.2766 2.087 0.036930 * 1149s x1 0.3362 0.4256 0.790 0.429672 1149s x2 0.8475 0.4701 1.803 0.071394 . 1149s x3 1.5143 0.4426 3.422 0.000622 *** 1149s --- 1149s Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 1149s 1149s (Dispersion parameter for binomial family taken to be 1) 1149s 1149s Null deviance: 134.602 on 99 degrees of freedom 1149s Residual deviance: 86.439 on 96 degrees of freedom 1149s AIC: 94.439 1149s 1149s Number of Fisher Scoring iterations: 5 1149s 1149s > ## IGNORE_RDIFF_END 1149s > 1149s > modmat <- out$x 1149s > 1149s > models <- cbind(rep(0:1, each = 4), rep(rep(0:1, times = 2), each = 2), 1149s + rep(0:1, times = 4)) 1149s > 1149s > exes <- paste("x", 1:3, sep = "") 1149s > models[nrow(models), ] 1149s [1] 1 1 1 1149s > beta.initial <- c(nrow(models), out$coefficients) 1149s > 1149s > neighbors <- matrix(FALSE, nrow(models), nrow(models)) 1149s > for (i in 1:nrow(neighbors)) { 1149s + for (j in 1:ncol(neighbors)) { 1149s + foo <- models[i, ] 1149s + bar <- models[j, ] 1149s + if (sum(foo != bar) == 1) neighbors[i, j] <- TRUE 1149s + } 1149s + } 1149s > neighbors 1149s [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] 1149s [1,] FALSE TRUE TRUE FALSE TRUE FALSE FALSE FALSE 1149s [2,] TRUE FALSE FALSE TRUE FALSE TRUE FALSE FALSE 1149s [3,] TRUE FALSE FALSE TRUE FALSE FALSE TRUE FALSE 1149s [4,] FALSE TRUE TRUE FALSE FALSE FALSE FALSE TRUE 1149s [5,] TRUE FALSE FALSE FALSE FALSE TRUE TRUE FALSE 1149s [6,] FALSE TRUE FALSE FALSE TRUE FALSE FALSE TRUE 1149s [7,] FALSE FALSE TRUE FALSE TRUE FALSE FALSE TRUE 1149s [8,] FALSE FALSE FALSE TRUE FALSE TRUE TRUE FALSE 1149s > 1149s > ludfun <- function(state, log.pseudo.prior, ...) { 1149s + stopifnot(is.numeric(state)) 1149s + stopifnot(length(state) == ncol(models) + 2) 1149s + icomp <- state[1] 1149s + stopifnot(icomp == as.integer(icomp)) 1149s + stopifnot(1 <= icomp && icomp <= nrow(models)) 1149s + stopifnot(is.numeric(log.pseudo.prior)) 1149s + stopifnot(length(log.pseudo.prior) == nrow(models)) 1149s + beta <- state[-1] 1149s + inies <- c(TRUE, as.logical(models[icomp, ])) 1149s + beta.logl <- beta 1149s + beta.logl[! inies] <- 0 1149s + eta <- as.numeric(modmat %*% beta.logl) 1149s + logp <- ifelse(eta < 0, eta - log1p(exp(eta)), - log1p(exp(- eta))) 1149s + logq <- ifelse(eta < 0, - log1p(exp(eta)), - eta - log1p(exp(- eta))) 1149s + logl <- sum(logp[y == 1]) + sum(logq[y == 0]) 1149s + val <- logl - sum(beta^2) / 2 + log.pseudo.prior[icomp] 1149s + return(val) 1149s + } 1149s > 1149s > qux <- c(25.01, 5.875, 9.028, 0.6959, 11.73, 2.367, 5.864, 0.0) 1149s > 1149s > out <- temper(ludfun, initial = beta.initial, neighbors = neighbors, 1149s + nbatch = 25, blen = 20, nspac = 5, scale = 0.56789, debug = TRUE, 1149s + log.pseudo.prior = qux) 1149s > 1149s > names(out) 1149s [1] "lud" "neighbors" "nbatch" "blen" 1149s [5] "nspac" "scale" "outfun" "debug" 1149s [9] "parallel" "initial.seed" "final.seed" "time" 1149s [13] "batch" "acceptx" "accepti" "initial" 1149s [17] "final" "ibatch" "which" "unif.which" 1149s [21] "state" "log.hastings" "unif.hastings" "proposal" 1149s [25] "acceptd" "norm" "unif.choose" 1149s > 1149s > apply(out$ibatch, 2, mean) 1149s [1] 0.776 0.170 0.000 0.006 0.024 0.010 0.004 0.010 1149s > 1149s > ### check decision about within-component or jump/swap 1149s > 1149s > identical(out$unif.which < 0.5, out$which) 1149s [1] TRUE 1149s > 1149s > identical(out$which, out$proposal[ , 1] == out$state[ , 1]) 1149s [1] TRUE 1149s > 1149s > ### check hastings ratio calculated correctly 1149s > 1149s > foo <- apply(out$state, 1, ludfun, log.pseudo.prior = qux) 1150s > bar <- apply(out$proposal, 1, ludfun, log.pseudo.prior = qux) 1150s > all.equal(bar - foo, out$log.hastings) 1150s [1] TRUE 1150s > 1150s > ### check hastings rejection decided correctly 1150s > 1150s > identical(out$log.hastings >= 0, is.na(out$unif.hastings)) 1150s [1] TRUE 1150s > all(out$log.hastings < 0 | out$acceptd) 1150s [1] TRUE 1150s > identical(out$acceptd, 1150s + out$log.hastings >= 0 | out$unif.hastings < exp(out$log.hastings)) 1150s [1] TRUE 1150s > 1150s > ### check acceptance carried out or not (according to decision) correctly 1150s > 1150s > before <- out$state 1150s > after <- before 1150s > after[- dim(after)[1], ] <- before[-1, ] 1150s > after[dim(after)[1], ] <- out$final 1150s > my.after <- before 1150s > my.after[out$acceptd, ] <- out$proposal[out$acceptd, ] 1150s > identical(after, my.after) 1150s [1] TRUE 1150s > 1150s > ### check within-component proposal 1150s > 1150s > my.coproposal.within <- out$state[out$which, ] 1150s > proposal.within <- out$proposal[out$which, ] 1150s > my.z <- out$norm[out$which, ] 1150s > my.proposal.within <- my.coproposal.within 1150s > my.proposal.within[ , -1] <- my.coproposal.within[ , -1] + out$scale * my.z 1150s > all.equal(proposal.within, my.proposal.within) 1150s [1] TRUE 1150s > 1150s > ### check swap proposal 1150s > 1150s > coproposal.swap <- out$state[! out$which, ] 1150s > proposal.swap <- out$proposal[! out$which, ] 1150s > unif.choose.swap <- out$unif.choose[! out$which] 1150s > my.i <- coproposal.swap[ , 1] 1150s > nneighbors <- apply(out$neighbors, 1, sum) 1150s > my.nneighbors <- nneighbors[my.i] 1150s > my.k <- floor(my.nneighbors * unif.choose.swap) + 1 1150s > my.j <- my.k 1150s > foo <- seq(1, ncol(out$neighbors)) 1150s > for (i in seq(along = my.j)) { 1150s + my.j[i] <- (foo[out$neighbors[my.i[i], ]])[my.k[i]] 1150s + } 1150s > identical(coproposal.swap[ , 1], my.i) 1150s [1] TRUE 1150s > identical(proposal.swap[ , 1], my.j) 1150s [1] TRUE 1150s > 1150s > ### check standard normal and uniform random numbers are as purported 1150s > 1150s > save.Random.seed <- .Random.seed 1150s > .Random.seed <- out$initial.seed 1150s > 1150s > nx <- length(out$initial) - 1 1150s > niter <- out$nbatch * out$blen * out$nspac 1150s > my.norm <- matrix(NA, nrow = nrow(out$norm), ncol = ncol(out$norm)) 1150s > my.unif.which <- rep(NA, niter) 1150s > my.unif.hastings <- rep(NA, niter) 1150s > my.unif.choose <- rep(NA, niter) 1150s > for (iiter in 1:niter) { 1150s + my.unif.which[iiter] <- runif(1) 1150s + if (out$which[iiter]) { 1150s + my.norm[iiter, ] <- rnorm(nx) 1150s + if (out$log.hastings[iiter] < 0) my.unif.hastings[iiter] <- runif(1) 1150s + } else { 1150s + my.unif.choose[iiter] <- runif(1) 1150s + if (out$log.hastings[iiter] < 0) my.unif.hastings[iiter] <- runif(1) 1150s + } 1150s + } 1150s > identical(my.norm, out$norm) 1150s [1] TRUE 1150s > identical(my.unif.which, out$unif.which) 1150s [1] TRUE 1150s > identical(my.unif.hastings, out$unif.hastings) 1150s [1] TRUE 1150s > identical(my.unif.choose, out$unif.choose) 1150s [1] TRUE 1150s > 1150s > .Random.seed <- save.Random.seed 1150s > 1150s > ### check batch means 1150s > 1150s > my.xstate <- after[ , -1] 1150s > foo <- my.xstate[seq(1, niter) %% out$nspac == 0, ] 1150s > foo <- array(as.vector(foo), dim = c(out$blen, out$nbatch, dim(foo)[2])) 1150s > foo <- apply(foo, c(2, 3), mean) 1150s > all.equal(foo, out$batch) 1150s [1] TRUE 1150s > 1150s > ### check ibatch means 1150s > 1150s > my.istate <- after[ , 1] 1150s > my.istate.matrix <- matrix(0, length(my.istate), nrow(models)) 1150s > for (i in 1:nrow(my.istate.matrix)) 1150s + my.istate.matrix[i, my.istate[i]] <- 1 1150s > foo <- my.istate.matrix[seq(1, niter) %% out$nspac == 0, ] 1150s > foo <- array(as.vector(foo), dim = c(out$blen, out$nbatch, dim(foo)[2])) 1150s > foo <- apply(foo, c(2, 3), mean) 1150s > all.equal(foo, out$ibatch) 1150s [1] TRUE 1150s > 1150s > ### check acceptance rates 1150s > 1150s > nmodel <- nrow(out$neighbors) 1150s > 1150s > accept.within <- out$acceptd[out$which] 1150s > my.i.within <- out$state[out$which, 1] 1150s > my.i.within.accept <- my.i.within[accept.within] 1150s > my.acceptx.numer <- tabulate(my.i.within.accept, nbins = nmodel) 1150s > my.acceptx.denom <- tabulate(my.i.within, nbins = nmodel) 1150s > my.acceptx <- my.acceptx.numer / my.acceptx.denom 1150s > identical(my.acceptx, out$acceptx) 1150s [1] TRUE 1150s > 1150s > accept.swap <- out$acceptd[! out$which] 1150s > my.i.swap <- out$state[! out$which, 1] 1150s > my.j.swap <- out$proposal[! out$which, 1] 1150s > my.accepti <- matrix(NA, nmodel, nmodel) 1150s > for (i in 1:nmodel) { 1150s + for (j in 1:nmodel) { 1150s + if (out$neighbors[i, j]) { 1150s + my.accepti[i, j] <- 1150s + mean(accept.swap[my.i.swap == i & my.j.swap == j]) 1150s + } 1150s + } 1150s + } 1150s > identical(my.accepti, out$accepti) 1150s [1] TRUE 1150s > 1150s > ### check scale vector 1150s > 1150s > nx <- ncol(models) + 1 1150s > newscale <- rnorm(nx, 0.5, 0.1) 1150s > 1150s > out <- temper(out, scale = newscale, log.pseudo.prior = qux) 1150s > 1150s > my.coproposal.within <- out$state[out$which, ] 1150s > proposal.within <- out$proposal[out$which, ] 1150s > my.z <- out$norm[out$which, ] 1150s > my.proposal.within <- my.coproposal.within 1150s > my.proposal.within[ , -1] <- my.coproposal.within[ , -1] + 1150s + sweep(my.z, 2, out$scale, "*") 1150s > all.equal(proposal.within, my.proposal.within) 1150s [1] TRUE 1150s > 1150s > ### check scale matrix 1150s > 1150s > matscale <- matrix(rnorm(nx * nx, 0.0, 0.1), nx, nx) 1150s > diag(matscale) <- 0.56789 1150s > 1150s > out <- temper(out, scale = matscale, log.pseudo.prior = qux) 1150s > 1150s > my.coproposal.within <- out$state[out$which, ] 1150s > proposal.within <- out$proposal[out$which, ] 1150s > my.z <- out$norm[out$which, ] 1150s > my.proposal.within <- my.coproposal.within 1150s > my.proposal.within[ , -1] <- my.coproposal.within[ , -1] + 1150s + my.z %*% t(out$scale) 1150s > all.equal(proposal.within, my.proposal.within) 1150s [1] TRUE 1150s > 1150s > ### check scale list 1150s > 1150s > lisztscale <- list(0.56789, newscale, matscale, matscale, newscale, 1150s + 0.98765, 0.98765, newscale) 1150s > 1150s > out <- temper(out, scale = lisztscale, log.pseudo.prior = qux) 1150s > 1150s > my.coproposal.within <- out$state[out$which, ] 1150s > proposal.within <- out$proposal[out$which, ] 1150s > my.z <- out$norm[out$which, ] 1150s > my.proposal.within <- my.coproposal.within 1150s > for (iiter in 1:nrow(my.z)) { 1150s + my.i <- my.coproposal.within[iiter, 1] 1150s + my.scale <- out$scale[[my.i]] 1150s + if (is.matrix(my.scale)) { 1150s + my.proposal.within[iiter, -1] <- my.coproposal.within[iiter, -1] + 1150s + my.z[iiter, , drop = FALSE] %*% t(my.scale) 1150s + } else { 1150s + my.proposal.within[iiter, -1] <- my.coproposal.within[iiter, -1] + 1150s + my.z[iiter, ] * my.scale 1150s + } 1150s + } 1150s > all.equal(proposal.within, my.proposal.within) 1150s [1] TRUE 1150s > 1150s > ### check outfun 1150s > 1150s > outfun <- function(state, icomp) { 1150s + stopifnot(is.matrix(state)) 1150s + stopifnot(is.numeric(state)) 1150s + nx <- ncol(initial) 1150s + ncomp <- nrow(initial) 1150s + stopifnot(ncol(state) == nx) 1150s + stopifnot(nrow(state) == ncomp) 1150s + stopifnot(1 <= icomp & icomp <= ncomp) 1150s + foo <- state[icomp, ] 1150s + bar <- foo^2 1150s + return(c(foo, bar)) 1150s + } 1150s > 1150s > ncomp <- nrow(models) 1150s > nx <- length(beta.initial) - 1 1150s > 1150s > outfun <- function(state, icomp, ...) { 1150s + stopifnot(is.numeric(state)) 1150s + stopifnot(length(state) == nx + 1) 1150s + istate <- state[1] 1150s + stopifnot(istate == as.integer(istate)) 1150s + stopifnot(1 <= istate && istate <= ncomp) 1150s + stopifnot(1 <= icomp && icomp <= ncomp) 1150s + if (istate == icomp) { 1150s + foo <- state[-1] 1150s + } else { 1150s + foo <- rep(0, nx) 1150s + } 1150s + bar <- foo^2 1150s + return(c(foo, bar)) 1150s + } 1150s > 1150s > out <- temper(ludfun, initial = out$final, neighbors = neighbors, 1150s + nbatch = 25, blen = 20, nspac = 5, scale = 0.56789, debug = TRUE, 1150s + outfun = outfun, log.pseudo.prior = qux, icomp = 4) 1150s > 1150s > before <- out$state 1150s > after <- before 1150s > after[- dim(after)[1], ] <- before[-1, ] 1150s > after[dim(after)[1], ] <- out$final 1150s > outies <- apply(after, 1, outfun, icomp = 4) 1150s > outies <- t(outies) 1150s > 1150s > foo <- outies[seq(1, niter) %% out$nspac == 0, ] 1150s > foo <- array(as.vector(foo), dim = c(out$blen, out$nbatch, dim(foo)[2])) 1150s > foo <- apply(foo, c(2, 3), mean) 1150s > all.equal(foo, out$batch) 1150s [1] TRUE 1150s > 1150s > 1150s BEGIN TEST tests/zero-error.R 1150s 1150s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1150s Copyright (C) 2025 The R Foundation for Statistical Computing 1150s Platform: s390x-ibm-linux-gnu 1150s 1150s R is free software and comes with ABSOLUTELY NO WARRANTY. 1150s You are welcome to redistribute it under certain conditions. 1150s Type 'license()' or 'licence()' for distribution details. 1150s 1150s R is a collaborative project with many contributors. 1150s Type 'contributors()' for more information and 1150s 'citation()' on how to cite R or R packages in publications. 1150s 1150s Type 'demo()' for some demos, 'help()' for on-line help, or 1150s 'help.start()' for an HTML browser interface to help. 1150s Type 'q()' to quit R. 1150s 1150s > 1150s > library(mcmc) 1150s > 1150s > # should give intelligible error (unlike before ver 0.9-8) 1150s > 1150s > suppressMessages(try(metrop(function(x) x, double(0), nbatch = 10))) 1150s > 1150s Error in system.time(out <- .Call(C_metrop, func1, initial, nbatch, blen, : 1150s argument "initial" must have nonzero length 1151s autopkgtest [18:29:48]: test generic: -----------------------] 1151s autopkgtest [18:29:48]: test generic: - - - - - - - - - - results - - - - - - - - - - 1151s generic PASS 1152s autopkgtest [18:29:49]: test pkg-r-autopkgtest: preparing testbed 1152s Reading package lists... 1152s Building dependency tree... 1152s Reading state information... 1152s Starting pkgProblemResolver with broken count: 0 1152s Starting 2 pkgProblemResolver with broken count: 0 1152s Done 1152s The following NEW packages will be installed: 1152s build-essential cpp cpp-14 cpp-14-s390x-linux-gnu cpp-s390x-linux-gnu 1152s dctrl-tools g++ g++-14 g++-14-s390x-linux-gnu g++-s390x-linux-gnu gcc gcc-14 1152s gcc-14-s390x-linux-gnu gcc-s390x-linux-gnu gfortran gfortran-14 1152s gfortran-14-s390x-linux-gnu gfortran-s390x-linux-gnu icu-devtools libasan8 1152s libblas-dev libbz2-dev libcc1-0 libdeflate-dev libgcc-14-dev 1152s libgfortran-14-dev libicu-dev libisl23 libitm1 libjpeg-dev 1152s libjpeg-turbo8-dev libjpeg8-dev liblapack-dev liblzma-dev libmpc3 1152s libncurses-dev libpcre2-16-0 libpcre2-32-0 libpcre2-dev libpcre2-posix3 1152s libpkgconf3 libpng-dev libreadline-dev libstdc++-14-dev libtirpc-dev 1152s libubsan1 pkg-r-autopkgtest pkgconf pkgconf-bin r-base-dev zlib1g-dev 1152s 0 upgraded, 51 newly installed, 0 to remove and 0 not upgraded. 1152s Need to get 82.3 MB of archives. 1152s After this operation, 279 MB of additional disk space will be used. 1152s Get:1 http://ftpmaster.internal/ubuntu plucky/main s390x libisl23 s390x 0.27-1 [704 kB] 1153s Get:2 http://ftpmaster.internal/ubuntu plucky/main s390x libmpc3 s390x 1.3.1-1build2 [57.8 kB] 1153s Get:3 http://ftpmaster.internal/ubuntu plucky/main s390x cpp-14-s390x-linux-gnu s390x 14.2.0-17ubuntu3 [9572 kB] 1164s Get:4 http://ftpmaster.internal/ubuntu plucky/main s390x cpp-14 s390x 14.2.0-17ubuntu3 [1028 B] 1164s Get:5 http://ftpmaster.internal/ubuntu plucky/main s390x cpp-s390x-linux-gnu s390x 4:14.2.0-1ubuntu1 [5556 B] 1164s Get:6 http://ftpmaster.internal/ubuntu plucky/main s390x cpp s390x 4:14.2.0-1ubuntu1 [22.4 kB] 1164s Get:7 http://ftpmaster.internal/ubuntu plucky/main s390x libcc1-0 s390x 15-20250222-0ubuntu1 [49.2 kB] 1164s Get:8 http://ftpmaster.internal/ubuntu plucky/main s390x libitm1 s390x 15-20250222-0ubuntu1 [31.2 kB] 1164s Get:9 http://ftpmaster.internal/ubuntu plucky/main s390x libasan8 s390x 15-20250222-0ubuntu1 [2970 kB] 1168s Get:10 http://ftpmaster.internal/ubuntu plucky/main s390x libubsan1 s390x 15-20250222-0ubuntu1 [1212 kB] 1169s Get:11 http://ftpmaster.internal/ubuntu plucky/main s390x libgcc-14-dev s390x 14.2.0-17ubuntu3 [1037 kB] 1171s Get:12 http://ftpmaster.internal/ubuntu plucky/main s390x gcc-14-s390x-linux-gnu s390x 14.2.0-17ubuntu3 [18.7 MB] 1193s Get:13 http://ftpmaster.internal/ubuntu plucky/main s390x gcc-14 s390x 14.2.0-17ubuntu3 [526 kB] 1193s Get:14 http://ftpmaster.internal/ubuntu plucky/main s390x gcc-s390x-linux-gnu s390x 4:14.2.0-1ubuntu1 [1204 B] 1193s Get:15 http://ftpmaster.internal/ubuntu plucky/main s390x gcc s390x 4:14.2.0-1ubuntu1 [5004 B] 1193s Get:16 http://ftpmaster.internal/ubuntu plucky/main s390x libstdc++-14-dev s390x 14.2.0-17ubuntu3 [2611 kB] 1196s Get:17 http://ftpmaster.internal/ubuntu plucky/main s390x g++-14-s390x-linux-gnu s390x 14.2.0-17ubuntu3 [11.0 MB] 1209s Get:18 http://ftpmaster.internal/ubuntu plucky/main s390x g++-14 s390x 14.2.0-17ubuntu3 [21.8 kB] 1209s Get:19 http://ftpmaster.internal/ubuntu plucky/main s390x g++-s390x-linux-gnu s390x 4:14.2.0-1ubuntu1 [956 B] 1209s Get:20 http://ftpmaster.internal/ubuntu plucky/main s390x g++ s390x 4:14.2.0-1ubuntu1 [1080 B] 1209s Get:21 http://ftpmaster.internal/ubuntu plucky/main s390x build-essential s390x 12.10ubuntu1 [4930 B] 1209s Get:22 http://ftpmaster.internal/ubuntu plucky/main s390x dctrl-tools s390x 2.24-3build3 [106 kB] 1210s Get:23 http://ftpmaster.internal/ubuntu plucky/main s390x libgfortran-14-dev s390x 14.2.0-17ubuntu3 [654 kB] 1210s Get:24 http://ftpmaster.internal/ubuntu plucky/main s390x gfortran-14-s390x-linux-gnu s390x 14.2.0-17ubuntu3 [10.3 MB] 1222s Get:25 http://ftpmaster.internal/ubuntu plucky/main s390x gfortran-14 s390x 14.2.0-17ubuntu3 [13.6 kB] 1222s Get:26 http://ftpmaster.internal/ubuntu plucky/main s390x gfortran-s390x-linux-gnu s390x 4:14.2.0-1ubuntu1 [1012 B] 1222s Get:27 http://ftpmaster.internal/ubuntu plucky/main s390x gfortran s390x 4:14.2.0-1ubuntu1 [1160 B] 1222s Get:28 http://ftpmaster.internal/ubuntu plucky/main s390x icu-devtools s390x 76.1-1ubuntu2 [225 kB] 1223s Get:29 http://ftpmaster.internal/ubuntu plucky/main s390x libblas-dev s390x 3.12.1-2 [254 kB] 1223s Get:30 http://ftpmaster.internal/ubuntu plucky/main s390x libbz2-dev s390x 1.0.8-6 [39.1 kB] 1223s Get:31 http://ftpmaster.internal/ubuntu plucky/main s390x libdeflate-dev s390x 1.23-1 [52.2 kB] 1223s Get:32 http://ftpmaster.internal/ubuntu plucky/main s390x libicu-dev s390x 76.1-1ubuntu2 [12.2 MB] 1237s Get:33 http://ftpmaster.internal/ubuntu plucky/main s390x libjpeg-turbo8-dev s390x 2.1.5-3ubuntu2 [281 kB] 1238s Get:34 http://ftpmaster.internal/ubuntu plucky/main s390x libjpeg8-dev s390x 8c-2ubuntu11 [1484 B] 1238s Get:35 http://ftpmaster.internal/ubuntu plucky/main s390x libjpeg-dev s390x 8c-2ubuntu11 [1484 B] 1238s Get:36 http://ftpmaster.internal/ubuntu plucky/main s390x liblapack-dev s390x 3.12.1-2 [5967 kB] 1244s Get:37 http://ftpmaster.internal/ubuntu plucky/main s390x libncurses-dev s390x 6.5+20250216-2 [407 kB] 1245s Get:38 http://ftpmaster.internal/ubuntu plucky/main s390x libpcre2-16-0 s390x 10.45-1 [259 kB] 1245s Get:39 http://ftpmaster.internal/ubuntu plucky/main s390x libpcre2-32-0 s390x 10.45-1 [245 kB] 1245s Get:40 http://ftpmaster.internal/ubuntu plucky/main s390x libpcre2-posix3 s390x 10.45-1 [7080 B] 1245s Get:41 http://ftpmaster.internal/ubuntu plucky/main s390x libpcre2-dev s390x 10.45-1 [899 kB] 1246s Get:42 http://ftpmaster.internal/ubuntu plucky/main s390x libpkgconf3 s390x 1.8.1-4 [31.2 kB] 1246s Get:43 http://ftpmaster.internal/ubuntu plucky/main s390x zlib1g-dev s390x 1:1.3.dfsg+really1.3.1-1ubuntu1 [898 kB] 1247s Get:44 http://ftpmaster.internal/ubuntu plucky/main s390x libpng-dev s390x 1.6.47-1 [278 kB] 1247s Get:45 http://ftpmaster.internal/ubuntu plucky/main s390x libreadline-dev s390x 8.2-6 [187 kB] 1248s Get:46 http://ftpmaster.internal/ubuntu plucky/main s390x liblzma-dev s390x 5.6.4-1 [183 kB] 1248s Get:47 http://ftpmaster.internal/ubuntu plucky/main s390x pkgconf-bin s390x 1.8.1-4 [21.5 kB] 1248s Get:48 http://ftpmaster.internal/ubuntu plucky/main s390x pkgconf s390x 1.8.1-4 [16.7 kB] 1248s Get:49 http://ftpmaster.internal/ubuntu plucky/main s390x libtirpc-dev s390x 1.3.4+ds-1.3 [196 kB] 1248s Get:50 http://ftpmaster.internal/ubuntu plucky/universe s390x r-base-dev all 4.4.3-1 [4176 B] 1248s Get:51 http://ftpmaster.internal/ubuntu plucky/universe s390x pkg-r-autopkgtest all 20231212ubuntu1 [6448 B] 1248s Fetched 82.3 MB in 1min 36s (860 kB/s) 1248s Selecting previously unselected package libisl23:s390x. 1248s (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 ... 58644 files and directories currently installed.) 1248s Preparing to unpack .../00-libisl23_0.27-1_s390x.deb ... 1248s Unpacking libisl23:s390x (0.27-1) ... 1248s Selecting previously unselected package libmpc3:s390x. 1248s Preparing to unpack .../01-libmpc3_1.3.1-1build2_s390x.deb ... 1248s Unpacking libmpc3:s390x (1.3.1-1build2) ... 1248s Selecting previously unselected package cpp-14-s390x-linux-gnu. 1248s Preparing to unpack .../02-cpp-14-s390x-linux-gnu_14.2.0-17ubuntu3_s390x.deb ... 1248s Unpacking cpp-14-s390x-linux-gnu (14.2.0-17ubuntu3) ... 1249s Selecting previously unselected package cpp-14. 1249s Preparing to unpack .../03-cpp-14_14.2.0-17ubuntu3_s390x.deb ... 1249s Unpacking cpp-14 (14.2.0-17ubuntu3) ... 1249s Selecting previously unselected package cpp-s390x-linux-gnu. 1249s Preparing to unpack .../04-cpp-s390x-linux-gnu_4%3a14.2.0-1ubuntu1_s390x.deb ... 1249s Unpacking cpp-s390x-linux-gnu (4:14.2.0-1ubuntu1) ... 1249s Selecting previously unselected package cpp. 1249s Preparing to unpack .../05-cpp_4%3a14.2.0-1ubuntu1_s390x.deb ... 1249s Unpacking cpp (4:14.2.0-1ubuntu1) ... 1249s Selecting previously unselected package libcc1-0:s390x. 1249s Preparing to unpack .../06-libcc1-0_15-20250222-0ubuntu1_s390x.deb ... 1249s Unpacking libcc1-0:s390x (15-20250222-0ubuntu1) ... 1249s Selecting previously unselected package libitm1:s390x. 1249s Preparing to unpack .../07-libitm1_15-20250222-0ubuntu1_s390x.deb ... 1249s Unpacking libitm1:s390x (15-20250222-0ubuntu1) ... 1249s Selecting previously unselected package libasan8:s390x. 1249s Preparing to unpack .../08-libasan8_15-20250222-0ubuntu1_s390x.deb ... 1249s Unpacking libasan8:s390x (15-20250222-0ubuntu1) ... 1249s Selecting previously unselected package libubsan1:s390x. 1249s Preparing to unpack .../09-libubsan1_15-20250222-0ubuntu1_s390x.deb ... 1249s Unpacking libubsan1:s390x (15-20250222-0ubuntu1) ... 1249s Selecting previously unselected package libgcc-14-dev:s390x. 1249s Preparing to unpack .../10-libgcc-14-dev_14.2.0-17ubuntu3_s390x.deb ... 1249s Unpacking libgcc-14-dev:s390x (14.2.0-17ubuntu3) ... 1249s Selecting previously unselected package gcc-14-s390x-linux-gnu. 1249s Preparing to unpack .../11-gcc-14-s390x-linux-gnu_14.2.0-17ubuntu3_s390x.deb ... 1249s Unpacking gcc-14-s390x-linux-gnu (14.2.0-17ubuntu3) ... 1249s Selecting previously unselected package gcc-14. 1249s Preparing to unpack .../12-gcc-14_14.2.0-17ubuntu3_s390x.deb ... 1249s Unpacking gcc-14 (14.2.0-17ubuntu3) ... 1249s Selecting previously unselected package gcc-s390x-linux-gnu. 1249s Preparing to unpack .../13-gcc-s390x-linux-gnu_4%3a14.2.0-1ubuntu1_s390x.deb ... 1249s Unpacking gcc-s390x-linux-gnu (4:14.2.0-1ubuntu1) ... 1249s Selecting previously unselected package gcc. 1249s Preparing to unpack .../14-gcc_4%3a14.2.0-1ubuntu1_s390x.deb ... 1249s Unpacking gcc (4:14.2.0-1ubuntu1) ... 1249s Selecting previously unselected package libstdc++-14-dev:s390x. 1249s Preparing to unpack .../15-libstdc++-14-dev_14.2.0-17ubuntu3_s390x.deb ... 1249s Unpacking libstdc++-14-dev:s390x (14.2.0-17ubuntu3) ... 1249s Selecting previously unselected package g++-14-s390x-linux-gnu. 1249s Preparing to unpack .../16-g++-14-s390x-linux-gnu_14.2.0-17ubuntu3_s390x.deb ... 1249s Unpacking g++-14-s390x-linux-gnu (14.2.0-17ubuntu3) ... 1249s Selecting previously unselected package g++-14. 1249s Preparing to unpack .../17-g++-14_14.2.0-17ubuntu3_s390x.deb ... 1249s Unpacking g++-14 (14.2.0-17ubuntu3) ... 1249s Selecting previously unselected package g++-s390x-linux-gnu. 1249s Preparing to unpack .../18-g++-s390x-linux-gnu_4%3a14.2.0-1ubuntu1_s390x.deb ... 1249s Unpacking g++-s390x-linux-gnu (4:14.2.0-1ubuntu1) ... 1249s Selecting previously unselected package g++. 1249s Preparing to unpack .../19-g++_4%3a14.2.0-1ubuntu1_s390x.deb ... 1249s Unpacking g++ (4:14.2.0-1ubuntu1) ... 1249s Selecting previously unselected package build-essential. 1249s Preparing to unpack .../20-build-essential_12.10ubuntu1_s390x.deb ... 1249s Unpacking build-essential (12.10ubuntu1) ... 1249s Selecting previously unselected package dctrl-tools. 1249s Preparing to unpack .../21-dctrl-tools_2.24-3build3_s390x.deb ... 1249s Unpacking dctrl-tools (2.24-3build3) ... 1249s Selecting previously unselected package libgfortran-14-dev:s390x. 1249s Preparing to unpack .../22-libgfortran-14-dev_14.2.0-17ubuntu3_s390x.deb ... 1249s Unpacking libgfortran-14-dev:s390x (14.2.0-17ubuntu3) ... 1249s Selecting previously unselected package gfortran-14-s390x-linux-gnu. 1249s Preparing to unpack .../23-gfortran-14-s390x-linux-gnu_14.2.0-17ubuntu3_s390x.deb ... 1249s Unpacking gfortran-14-s390x-linux-gnu (14.2.0-17ubuntu3) ... 1249s Selecting previously unselected package gfortran-14. 1249s Preparing to unpack .../24-gfortran-14_14.2.0-17ubuntu3_s390x.deb ... 1249s Unpacking gfortran-14 (14.2.0-17ubuntu3) ... 1249s Selecting previously unselected package gfortran-s390x-linux-gnu. 1249s Preparing to unpack .../25-gfortran-s390x-linux-gnu_4%3a14.2.0-1ubuntu1_s390x.deb ... 1249s Unpacking gfortran-s390x-linux-gnu (4:14.2.0-1ubuntu1) ... 1249s Selecting previously unselected package gfortran. 1249s Preparing to unpack .../26-gfortran_4%3a14.2.0-1ubuntu1_s390x.deb ... 1249s Unpacking gfortran (4:14.2.0-1ubuntu1) ... 1249s Selecting previously unselected package icu-devtools. 1249s Preparing to unpack .../27-icu-devtools_76.1-1ubuntu2_s390x.deb ... 1249s Unpacking icu-devtools (76.1-1ubuntu2) ... 1249s Selecting previously unselected package libblas-dev:s390x. 1249s Preparing to unpack .../28-libblas-dev_3.12.1-2_s390x.deb ... 1249s Unpacking libblas-dev:s390x (3.12.1-2) ... 1249s Selecting previously unselected package libbz2-dev:s390x. 1249s Preparing to unpack .../29-libbz2-dev_1.0.8-6_s390x.deb ... 1249s Unpacking libbz2-dev:s390x (1.0.8-6) ... 1249s Selecting previously unselected package libdeflate-dev:s390x. 1249s Preparing to unpack .../30-libdeflate-dev_1.23-1_s390x.deb ... 1249s Unpacking libdeflate-dev:s390x (1.23-1) ... 1249s Selecting previously unselected package libicu-dev:s390x. 1249s Preparing to unpack .../31-libicu-dev_76.1-1ubuntu2_s390x.deb ... 1249s Unpacking libicu-dev:s390x (76.1-1ubuntu2) ... 1250s Selecting previously unselected package libjpeg-turbo8-dev:s390x. 1250s Preparing to unpack .../32-libjpeg-turbo8-dev_2.1.5-3ubuntu2_s390x.deb ... 1250s Unpacking libjpeg-turbo8-dev:s390x (2.1.5-3ubuntu2) ... 1250s Selecting previously unselected package libjpeg8-dev:s390x. 1250s Preparing to unpack .../33-libjpeg8-dev_8c-2ubuntu11_s390x.deb ... 1250s Unpacking libjpeg8-dev:s390x (8c-2ubuntu11) ... 1250s Selecting previously unselected package libjpeg-dev:s390x. 1250s Preparing to unpack .../34-libjpeg-dev_8c-2ubuntu11_s390x.deb ... 1250s Unpacking libjpeg-dev:s390x (8c-2ubuntu11) ... 1250s Selecting previously unselected package liblapack-dev:s390x. 1250s Preparing to unpack .../35-liblapack-dev_3.12.1-2_s390x.deb ... 1250s Unpacking liblapack-dev:s390x (3.12.1-2) ... 1250s Selecting previously unselected package libncurses-dev:s390x. 1250s Preparing to unpack .../36-libncurses-dev_6.5+20250216-2_s390x.deb ... 1250s Unpacking libncurses-dev:s390x (6.5+20250216-2) ... 1250s Selecting previously unselected package libpcre2-16-0:s390x. 1250s Preparing to unpack .../37-libpcre2-16-0_10.45-1_s390x.deb ... 1250s Unpacking libpcre2-16-0:s390x (10.45-1) ... 1250s Selecting previously unselected package libpcre2-32-0:s390x. 1250s Preparing to unpack .../38-libpcre2-32-0_10.45-1_s390x.deb ... 1250s Unpacking libpcre2-32-0:s390x (10.45-1) ... 1250s Selecting previously unselected package libpcre2-posix3:s390x. 1250s Preparing to unpack .../39-libpcre2-posix3_10.45-1_s390x.deb ... 1250s Unpacking libpcre2-posix3:s390x (10.45-1) ... 1250s Selecting previously unselected package libpcre2-dev:s390x. 1250s Preparing to unpack .../40-libpcre2-dev_10.45-1_s390x.deb ... 1250s Unpacking libpcre2-dev:s390x (10.45-1) ... 1250s Selecting previously unselected package libpkgconf3:s390x. 1250s Preparing to unpack .../41-libpkgconf3_1.8.1-4_s390x.deb ... 1250s Unpacking libpkgconf3:s390x (1.8.1-4) ... 1250s Selecting previously unselected package zlib1g-dev:s390x. 1250s Preparing to unpack .../42-zlib1g-dev_1%3a1.3.dfsg+really1.3.1-1ubuntu1_s390x.deb ... 1250s Unpacking zlib1g-dev:s390x (1:1.3.dfsg+really1.3.1-1ubuntu1) ... 1250s Selecting previously unselected package libpng-dev:s390x. 1250s Preparing to unpack .../43-libpng-dev_1.6.47-1_s390x.deb ... 1250s Unpacking libpng-dev:s390x (1.6.47-1) ... 1250s Selecting previously unselected package libreadline-dev:s390x. 1250s Preparing to unpack .../44-libreadline-dev_8.2-6_s390x.deb ... 1250s Unpacking libreadline-dev:s390x (8.2-6) ... 1250s Selecting previously unselected package liblzma-dev:s390x. 1250s Preparing to unpack .../45-liblzma-dev_5.6.4-1_s390x.deb ... 1250s Unpacking liblzma-dev:s390x (5.6.4-1) ... 1250s Selecting previously unselected package pkgconf-bin. 1250s Preparing to unpack .../46-pkgconf-bin_1.8.1-4_s390x.deb ... 1250s Unpacking pkgconf-bin (1.8.1-4) ... 1250s Selecting previously unselected package pkgconf:s390x. 1250s Preparing to unpack .../47-pkgconf_1.8.1-4_s390x.deb ... 1250s Unpacking pkgconf:s390x (1.8.1-4) ... 1250s Selecting previously unselected package libtirpc-dev:s390x. 1250s Preparing to unpack .../48-libtirpc-dev_1.3.4+ds-1.3_s390x.deb ... 1250s Unpacking libtirpc-dev:s390x (1.3.4+ds-1.3) ... 1250s Selecting previously unselected package r-base-dev. 1250s Preparing to unpack .../49-r-base-dev_4.4.3-1_all.deb ... 1250s Unpacking r-base-dev (4.4.3-1) ... 1250s Selecting previously unselected package pkg-r-autopkgtest. 1250s Preparing to unpack .../50-pkg-r-autopkgtest_20231212ubuntu1_all.deb ... 1250s Unpacking pkg-r-autopkgtest (20231212ubuntu1) ... 1250s Setting up libjpeg-turbo8-dev:s390x (2.1.5-3ubuntu2) ... 1250s Setting up libncurses-dev:s390x (6.5+20250216-2) ... 1250s Setting up libreadline-dev:s390x (8.2-6) ... 1250s Setting up libpcre2-16-0:s390x (10.45-1) ... 1250s Setting up libpcre2-32-0:s390x (10.45-1) ... 1250s Setting up libtirpc-dev:s390x (1.3.4+ds-1.3) ... 1250s Setting up libpkgconf3:s390x (1.8.1-4) ... 1250s Setting up libmpc3:s390x (1.3.1-1build2) ... 1250s Setting up icu-devtools (76.1-1ubuntu2) ... 1250s Setting up pkgconf-bin (1.8.1-4) ... 1250s Setting up liblzma-dev:s390x (5.6.4-1) ... 1250s Setting up libubsan1:s390x (15-20250222-0ubuntu1) ... 1250s Setting up zlib1g-dev:s390x (1:1.3.dfsg+really1.3.1-1ubuntu1) ... 1250s Setting up libpcre2-posix3:s390x (10.45-1) ... 1250s Setting up libasan8:s390x (15-20250222-0ubuntu1) ... 1250s Setting up libjpeg8-dev:s390x (8c-2ubuntu11) ... 1250s Setting up libisl23:s390x (0.27-1) ... 1250s Setting up libdeflate-dev:s390x (1.23-1) ... 1250s Setting up libicu-dev:s390x (76.1-1ubuntu2) ... 1250s Setting up libcc1-0:s390x (15-20250222-0ubuntu1) ... 1250s Setting up libblas-dev:s390x (3.12.1-2) ... 1250s update-alternatives: using /usr/lib/s390x-linux-gnu/blas/libblas.so to provide /usr/lib/s390x-linux-gnu/libblas.so (libblas.so-s390x-linux-gnu) in auto mode 1250s Setting up dctrl-tools (2.24-3build3) ... 1250s Setting up libitm1:s390x (15-20250222-0ubuntu1) ... 1250s Setting up libbz2-dev:s390x (1.0.8-6) ... 1250s Setting up libpcre2-dev:s390x (10.45-1) ... 1250s Setting up libpng-dev:s390x (1.6.47-1) ... 1250s Setting up libjpeg-dev:s390x (8c-2ubuntu11) ... 1250s Setting up pkgconf:s390x (1.8.1-4) ... 1250s Setting up liblapack-dev:s390x (3.12.1-2) ... 1250s update-alternatives: using /usr/lib/s390x-linux-gnu/lapack/liblapack.so to provide /usr/lib/s390x-linux-gnu/liblapack.so (liblapack.so-s390x-linux-gnu) in auto mode 1250s Setting up cpp-14-s390x-linux-gnu (14.2.0-17ubuntu3) ... 1250s Setting up cpp-14 (14.2.0-17ubuntu3) ... 1250s Setting up libgcc-14-dev:s390x (14.2.0-17ubuntu3) ... 1250s Setting up libstdc++-14-dev:s390x (14.2.0-17ubuntu3) ... 1250s Setting up libgfortran-14-dev:s390x (14.2.0-17ubuntu3) ... 1250s Setting up cpp-s390x-linux-gnu (4:14.2.0-1ubuntu1) ... 1250s Setting up gcc-14-s390x-linux-gnu (14.2.0-17ubuntu3) ... 1250s Setting up gcc-s390x-linux-gnu (4:14.2.0-1ubuntu1) ... 1250s Setting up g++-14-s390x-linux-gnu (14.2.0-17ubuntu3) ... 1250s Setting up cpp (4:14.2.0-1ubuntu1) ... 1250s Setting up gfortran-14-s390x-linux-gnu (14.2.0-17ubuntu3) ... 1250s Setting up g++-s390x-linux-gnu (4:14.2.0-1ubuntu1) ... 1250s Setting up gcc-14 (14.2.0-17ubuntu3) ... 1250s Setting up g++-14 (14.2.0-17ubuntu3) ... 1250s Setting up gfortran-14 (14.2.0-17ubuntu3) ... 1250s Setting up gfortran-s390x-linux-gnu (4:14.2.0-1ubuntu1) ... 1250s Setting up gcc (4:14.2.0-1ubuntu1) ... 1250s Setting up g++ (4:14.2.0-1ubuntu1) ... 1250s update-alternatives: using /usr/bin/g++ to provide /usr/bin/c++ (c++) in auto mode 1250s Setting up build-essential (12.10ubuntu1) ... 1250s Setting up gfortran (4:14.2.0-1ubuntu1) ... 1250s update-alternatives: using /usr/bin/gfortran to provide /usr/bin/f95 (f95) in auto mode 1250s 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 1250s update-alternatives: using /usr/bin/gfortran to provide /usr/bin/f77 (f77) in auto mode 1250s 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 1250s Setting up r-base-dev (4.4.3-1) ... 1250s Setting up pkg-r-autopkgtest (20231212ubuntu1) ... 1250s Processing triggers for libc-bin (2.41-1ubuntu2) ... 1250s Processing triggers for man-db (2.13.0-1) ... 1251s Processing triggers for install-info (7.1.1-1) ... 1252s autopkgtest [18:31:29]: test pkg-r-autopkgtest: /usr/share/dh-r/pkg-r-autopkgtest 1252s autopkgtest [18:31:29]: test pkg-r-autopkgtest: [----------------------- 1252s Test: Try to load the R library mcmc 1253s 1253s R version 4.4.3 (2025-02-28) -- "Trophy Case" 1253s Copyright (C) 2025 The R Foundation for Statistical Computing 1253s Platform: s390x-ibm-linux-gnu 1253s 1253s R is free software and comes with ABSOLUTELY NO WARRANTY. 1253s You are welcome to redistribute it under certain conditions. 1253s Type 'license()' or 'licence()' for distribution details. 1253s 1253s R is a collaborative project with many contributors. 1253s Type 'contributors()' for more information and 1253s 'citation()' on how to cite R or R packages in publications. 1253s 1253s Type 'demo()' for some demos, 'help()' for on-line help, or 1253s 'help.start()' for an HTML browser interface to help. 1253s Type 'q()' to quit R. 1253s 1253s > library('mcmc') 1253s > 1253s > 1253s Other tests are currently unsupported! 1253s They will be progressively added. 1253s autopkgtest [18:31:29]: test pkg-r-autopkgtest: -----------------------] 1253s autopkgtest [18:31:30]: test pkg-r-autopkgtest: - - - - - - - - - - results - - - - - - - - - - 1253s pkg-r-autopkgtest PASS 1253s autopkgtest [18:31:30]: @@@@@@@@@@@@@@@@@@@@ summary 1253s generic PASS 1253s pkg-r-autopkgtest PASS 1259s nova [W] Using flock in prodstack6-s390x 1259s Creating nova instance adt-plucky-s390x-r-cran-mcmc-20250315-181037-juju-7f2275-prod-proposed-migration-environment-15-ad63e06a-a072-4350-8fce-11e55a7758eb from image adt/ubuntu-plucky-s390x-server-20250315.img (UUID 3d3557fa-fd0f-4bba-9b89-8d5964e09f61)... 1259s nova [W] nova quota exceeded (attempt #0) 1259s nova [W] Timed out waiting for 5d073b64-6551-4be0-9504-7a1298fb1094 to get deleted.