program hachimoji_encode_demo implicit none integer, parameter :: i64 = selected_int_kind(15) character(len=6), parameter :: LETTER_NAMES(8) = & [character(len=6) :: "Phi", "Lambda", "Rho", "Kappa", & "Omega", "Sigma", "Pi", "Zeta"] call run_tests() contains ! sigma3(n) = Sum_{d|n} d^3 (0 for n=0) integer(i64) function sigma3(n) result(s) integer(i64), intent(in) :: n integer(i64) :: d, c s = 0_i64 if (n == 0_i64) return d = 1_i64 do while (d * d <= n) if (mod(n, d) == 0_i64) then s = s + d * d * d c = n / d if (c /= d) s = s + c * c * c end if d = d + 1_i64 end do end function sigma3 ! Map sigma3 value to Hachimoji letter index 0-7 integer function hachimoji_letter(s) result(idx) integer(i64), intent(in) :: s idx = int(mod(s, 8_i64)) end function hachimoji_letter ! Cartan energy between two Hachimoji letter indices integer function cartan_weight(a, b) result(w) integer, intent(in) :: a, b if (a == b) then w = 273 else if (a / 2 == b / 2) then w = 256 else w = 0 end if end function cartan_weight ! AngrySphinx gate: check if integer list passes energy budget. ! passed = 1 if collisions <= 1, else 0. subroutine angrysphinx_gate(elements, n, passed, collisions, energy) integer, intent(in) :: elements(:) integer, intent(in) :: n integer, intent(out) :: passed integer, intent(out) :: collisions integer, intent(out) :: energy integer, allocatable :: sums(:) integer :: npairs, i, j, idx, raw npairs = n * (n + 1) / 2 allocate(sums(npairs)) idx = 1 do i = 1, n do j = i, n sums(idx) = elements(i) + elements(j) idx = idx + 1 end do end do collisions = 0 do i = 1, npairs do j = i + 1, npairs if (sums(i) == sums(j)) collisions = collisions + 1 end do end do deallocate(sums) raw = 273 + 17 * collisions if (raw < 256 * collisions) then energy = 0 else energy = raw - 256 * collisions end if if (collisions <= 1) then passed = 1 else passed = 0 end if end subroutine angrysphinx_gate ! Full encoding: compute sigma3, letter index, print row subroutine hachimoji_encode(n) integer(i64), intent(in) :: n integer(i64) :: s integer :: idx s = sigma3(n) idx = hachimoji_letter(s) write(*, '(2X, I4, 2X, I10, 2X, I2, 3X, A)') & int(n), int(s), idx, trim(LETTER_NAMES(idx + 1)) end subroutine hachimoji_encode subroutine run_tests() integer(i64) :: n integer :: i, j, c, e, p integer :: elems(10) ! ---------- sigma3 assertions ---------- call assert_eq_i64(sigma3(0_i64), 0_i64, "sigma3(0)") call assert_eq_i64(sigma3(1_i64), 1_i64, "sigma3(1)") call assert_eq_i64(sigma3(2_i64), 9_i64, "sigma3(2)") call assert_eq_i64(sigma3(3_i64), 28_i64, "sigma3(3)") call assert_eq_i64(sigma3(4_i64), 73_i64, "sigma3(4)") call assert_eq_i64(sigma3(5_i64), 126_i64, "sigma3(5)") call assert_eq_i64(sigma3(6_i64), 252_i64, "sigma3(6)") call assert_eq_i64(sigma3(7_i64), 344_i64, "sigma3(7)") call assert_eq_i64(sigma3(8_i64), 585_i64, "sigma3(8)") call assert_eq_i64(sigma3(9_i64), 757_i64, "sigma3(9)") call assert_eq_i64(sigma3(10_i64), 1134_i64,"sigma3(10)") ! ---------- hachimoji_letter assertions ---------- call assert_eq_int(hachimoji_letter(1_i64), int(mod(1_i64, 8_i64)), "hachimoji_letter(1)") call assert_eq_int(hachimoji_letter(9_i64), int(mod(9_i64, 8_i64)), "hachimoji_letter(9)") call assert_eq_int(hachimoji_letter(28_i64), int(mod(28_i64, 8_i64)), "hachimoji_letter(28)") call assert_eq_int(hachimoji_letter(73_i64), int(mod(73_i64, 8_i64)), "hachimoji_letter(73)") call assert_eq_int(hachimoji_letter(126_i64), int(mod(126_i64, 8_i64)), "hachimoji_letter(126)") call assert_eq_int(hachimoji_letter(252_i64), int(mod(252_i64, 8_i64)), "hachimoji_letter(252)") call assert_eq_int(hachimoji_letter(344_i64), int(mod(344_i64, 8_i64)), "hachimoji_letter(344)") call assert_eq_int(hachimoji_letter(585_i64), int(mod(585_i64, 8_i64)), "hachimoji_letter(585)") call assert_eq_int(hachimoji_letter(757_i64), int(mod(757_i64, 8_i64)), "hachimoji_letter(757)") call assert_eq_int(hachimoji_letter(1134_i64), int(mod(1134_i64, 8_i64)), "hachimoji_letter(1134)") ! ---------- cartan_weight assertions ---------- call assert_eq_int(cartan_weight(0, 0), 273, "cartan(0,0)") call assert_eq_int(cartan_weight(0, 1), 256, "cartan(0,1)") call assert_eq_int(cartan_weight(0, 2), 0, "cartan(0,2)") call assert_eq_int(cartan_weight(2, 3), 256, "cartan(2,3)") call assert_eq_int(cartan_weight(3, 5), 0, "cartan(3,5)") call assert_eq_int(cartan_weight(7, 7), 273, "cartan(7,7)") ! ---------- AngrySphinx gate assertions ---------- elems(1:2) = [1, 2] call angrysphinx_gate(elems, 2, p, c, e) call assert_eq_int(p, 1, "gate [1,2] passed") call assert_eq_int(c, 0, "gate [1,2] collisions") call assert_eq_int(e, 273, "gate [1,2] energy") elems(1:3) = [1, 2, 3] call angrysphinx_gate(elems, 3, p, c, e) call assert_eq_int(p, 1, "gate [1,2,3] passed") call assert_eq_int(c, 1, "gate [1,2,3] collisions") call assert_eq_int(e, 34, "gate [1,2,3] energy") elems(1:4) = [1, 2, 3, 4] call angrysphinx_gate(elems, 4, p, c, e) call assert_eq_int(p, 0, "gate [1,2,3,4] passed") call assert_eq_int(c, 3, "gate [1,2,3,4] collisions") call assert_eq_int(e, 0, "gate [1,2,3,4] energy") ! ========== Formatted output ========== write(*, *) write(*, '(A)') "Hachimoji Encoder Test Vector" write(*, '(A)') "=================================" write(*, '(A)') " n sigma3 Index Letter" write(*, '(A)') " --- ------- ----- ------" do n = 1_i64, 10_i64 call hachimoji_encode(n) end do write(*, *) write(*, '(A)') "AngrySphinx Gate Tests" write(*, '(A)') "=============================" write(*, '(A)') " Elements Passed Collisions Energy" write(*, '(A)') " ----------------- ------ ---------- ------" elems(1:2) = [1, 2] call angrysphinx_gate(elems, 2, p, c, e) write(*, '(2X, "[", I0, ",", I0, "]", T22, A, T30, I0, T42, I0)') & elems(1), elems(2), merge("true ", "false", p == 1), c, e elems(1:3) = [1, 2, 3] call angrysphinx_gate(elems, 3, p, c, e) write(*, '(2X, "[", I0, ",", I0, ",", I0, "]", T22, A, T30, I0, T42, I0)') & elems(1), elems(2), elems(3), merge("true ", "false", p == 1), c, e elems(1:4) = [1, 2, 3, 4] call angrysphinx_gate(elems, 4, p, c, e) write(*, '(2X, "[", I0, ",", I0, ",", I0, ",", I0, "]", T22, A, T30, I0, T42, I0)') & elems(1), elems(2), elems(3), elems(4), merge("true ", "false", p == 1), c, e ! ---------- cartan matrix display ---------- write(*, *) write(*, '(A)') "Cartan Weight Matrix (8 x 8)" write(*, '(A)') "=============================" write(*, '(9X, 8(2X, A6))') (trim(LETTER_NAMES(i)), i = 1, 8) do i = 1, 8 write(*, '(2X, A6, 8(2X, I6))') trim(LETTER_NAMES(i)), & (cartan_weight(i - 1, j), j = 0, 7) end do write(*, *) write(*, '(A)') "All assertions passed." end subroutine run_tests subroutine assert_eq_i64(actual, expected, label) integer(i64), intent(in) :: actual, expected character(len=*), intent(in) :: label if (actual /= expected) then write(*, '(A, A, A, I0, A, I0)') "FAIL: ", trim(label), & " expected ", expected, " got ", actual stop 1 end if end subroutine assert_eq_i64 subroutine assert_eq_int(actual, expected, label) integer, intent(in) :: actual, expected character(len=*), intent(in) :: label if (actual /= expected) then write(*, '(A, A, A, I0, A, I0)') "FAIL: ", trim(label), & " expected ", expected, " got ", actual stop 1 end if end subroutine assert_eq_int end program hachimoji_encode_demo