487 Sums of power sums.pl 3.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167
  1. #!/usr/bin/perl
  2. # Daniel "Trizen" Șuteu
  3. # Date: 28 June 2019
  4. # https://github.com/trizen
  5. # https://projecteuler.net/problem=487
  6. # Runtime: 44.486s
  7. use 5.020;
  8. use strict;
  9. use warnings;
  10. use experimental qw(signatures);
  11. use Math::GMPz;
  12. use Math::GMPq;
  13. use ntheory qw(forprimes addmod submod divmod mulmod powmod);
  14. sub tangent_numbers ($n) {
  15. my @T = (Math::GMPz::Rmpz_init_set_ui(1));
  16. foreach my $k (1 .. $n) {
  17. Math::GMPz::Rmpz_mul_ui($T[$k] = Math::GMPz::Rmpz_init(), $T[$k - 1], $k);
  18. }
  19. foreach my $k (1 .. $n) {
  20. foreach my $j ($k .. $n) {
  21. Math::GMPz::Rmpz_mul_ui($T[$j], $T[$j], $j - $k + 2);
  22. Math::GMPz::Rmpz_addmul_ui($T[$j], $T[$j - 1], $j - $k);
  23. }
  24. }
  25. return @T;
  26. }
  27. sub bernoulli_numbers ($n) {
  28. $n = ($n >> 1) + 1;
  29. my @B;
  30. my @T = tangent_numbers($n);
  31. my $t = Math::GMPz::Rmpz_init();
  32. foreach my $k (0 .. 2 * @T) {
  33. $k % 2 == 0 or $k == 1 or next;
  34. my $q = Math::GMPq::Rmpq_init();
  35. if ($k == 0) {
  36. Math::GMPq::Rmpq_set_ui($q, 1, 1);
  37. $B[$k] = $q;
  38. next;
  39. }
  40. if ($k == 1) {
  41. Math::GMPq::Rmpq_set_si($q, -1, 2);
  42. $B[$k] = $q;
  43. next;
  44. }
  45. # T_k
  46. Math::GMPz::Rmpz_mul_ui($t, $T[($k >> 1) - 1], $k);
  47. Math::GMPz::Rmpz_neg($t, $t) if ((($k >> 1) - 1) & 1);
  48. Math::GMPq::Rmpq_set_z($q, $t);
  49. # (2^k - 1) * 2^k
  50. Math::GMPz::Rmpz_set_ui($t, 0);
  51. Math::GMPz::Rmpz_setbit($t, $k);
  52. Math::GMPz::Rmpz_sub_ui($t, $t, 1);
  53. Math::GMPz::Rmpz_mul_2exp($t, $t, $k);
  54. # B_k = q
  55. Math::GMPq::Rmpq_div_z($q, $q, $t);
  56. $B[($k >> 1) + 1] = $q;
  57. }
  58. return @B;
  59. }
  60. say ":: Computing Bernoulli numbers...";
  61. my $power = 1e4;
  62. my @bernoulli = map {
  63. my $num = Math::GMPz->new(0);
  64. my $den = Math::GMPz->new(0);
  65. Math::GMPq::Rmpq_get_num($num, $_);
  66. Math::GMPq::Rmpq_get_den($den, $_);
  67. [$num, $den];
  68. } bernoulli_numbers($power + 1);
  69. say ":: Applying Faulhaber's formula...";
  70. my $B0 = [map { Math::GMPz->new($_) } (1, 1)];
  71. my $B1 = [map { Math::GMPz->new($_) } (1, 2)];
  72. {
  73. my @cache;
  74. my $t = Math::GMPz::Rmpz_init_nobless();
  75. sub binomialmod ($n, $k, $m) {
  76. my $bin = (
  77. $cache[$n][$k] //= do {
  78. my $z = Math::GMPz::Rmpz_init_nobless();
  79. Math::GMPz::Rmpz_bin_uiui($z, $n, $k);
  80. $z;
  81. }
  82. );
  83. Math::GMPz::Rmpz_mod_ui($t, $bin, $m);
  84. }
  85. }
  86. # Faulhaber's formula (modulo some m)
  87. # See: https://en.wikipedia.org/wiki/Faulhaber%27s_formula
  88. sub faulhabermod ($n, $p, $m) {
  89. my $sum = 0;
  90. for my $k (0 .. $p) {
  91. $k % 2 == 0 or $k == 1 or next;
  92. my $B =
  93. ($k == 0) ? $B0
  94. : ($k == 1) ? $B1
  95. : $bernoulli[($k >> 1) + 1];
  96. $sum += mulmod(divmod(mulmod(binomialmod($p + 1, $k, $m), $B->[0] % $m, $m), $B->[1] % $m, $m),
  97. powmod($n, $p - $k + 1, $m), $m);
  98. $sum %= $m;
  99. }
  100. divmod($sum, $p + 1, $m);
  101. }
  102. # Efficient formula for computing:
  103. # S_p(n) = Sum_{k=1..n} Sum_{j=1..k} j^p
  104. # for some positive integer p.
  105. # The formula is:
  106. # S_p(n) = (n+1) * F_p(n) - F_(p+1)(n)
  107. # where F_n(x) are the Faulhaber polynomials.
  108. sub S ($n, $p, $mod) {
  109. submod(mulmod($n + 1, faulhabermod($n, $p, $mod), $mod), faulhabermod($n, $p + 1, $mod), $mod);
  110. }
  111. # Sanity check
  112. if (S(100, 4, 1e9 + 1) != (35375333830 % (1e9 + 1))) {
  113. die "Error for S_4(100)";
  114. }
  115. my $sum = 0;
  116. forprimes { # there are only 100 primes in this range
  117. $sum += S(1e12, $power, $_);
  118. } 2e9, 2e9 + 2000;
  119. say ":: Total: $sum";