#OK to post homework
#Blair Seidler, 3/13/22, Assignment 15
with(combinat):

Help:=proc(): print(`DecDigits(a,K), WrongDigits(a,b,K)`): end:

#1. DecDigits(a,K): inputs a number a and outputs the LIST of its first K digits. For example,
# DecDigits(Pi,6); should be [3,1,4,1,5,9]
DecDigits:=proc(a,K) local i,L,rem:
if evalf(a)<=0 then
  print("Positive numbers only!!!"):
  RETURN(FAIL):
fi:
rem:=a/10^(ceil(log10(a))-1):
L:=[]:
for i from 1 to K do
  L:=[op(L),trunc(rem)]:
  rem:=10*(rem-trunc(rem)):
od:
L:
end:

#2. WrongDigits(a,b,K): inputs two numbers a and b and a positive integer K and outputs the list
# of places where their decimal digits differ.
WrongDigits:=proc(a,b,K) local ad,bd,i,L:
ad:=DecDigits(a,K):
bd:=DecDigits(b,K):
L:=[]:
for i from 1 to K do
  if not ad[i]=bd[i] then
    L:=[op(L),i]:
  fi:
od:
L:
end:

(*
Try:
Digits:=1000: WrongDigits(Pi,NorthM(500000)):

[7, 18, 19, 30, 41, 42, 43, 52, 53, 54, 62, 64, 66, 67, 73, 74, 76, 77, 78, 82, 83, 85, 86, 87, 88, 89, 90, 91, 93, 94, 95, 96, 97, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 146, 147, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 160, 161, 163, 164, 165, 166, 168, 169, 170, 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, 182, 183, 184, 185, 186, 187, 188, 189, 190, 193, 194, 195, 196, 197, 198, 199, 200, 201, 203, 204, 205, 206, 207, 208, 209, 210, 211, 212, 213, 214, 215, 216, 217, 219, 220, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 247, 248, 249, 250, 251, 252, 253, 254, 255, 256, 257, 258, 259, 260, 261, 262, 263, 264, 266, 268, 269, 270, 271, 272, 273, 274, 275, 277, 278, 280, 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, 292, 293, 294, 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, 313, 314, 315, 316, 317, 318, 319, 321, 323, 324, 325, 326, 327, 328, 329, 331, 333, 334, 335, 336, 337, 339, 340, 341, 342, 343, 344, 345, 346, 347, 348, 349, 350, 351, 352, 353, 354, 355, 356, 357, 358, 360, 361, 363, 364, 365, 367, 369, 370, 371, 372, 373, 374, 375, 376, 377, 378, 379, 380, 381, 382, 383, 384, 385, 386, 387, 388, 389, 390, 391, 392, 393, 394, 395, 396, 397, 399, 400, 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, 411, 412, 413, 414, 415, 416, 417, 418, 419, 420, 421, 422, 423, 425, 426, 427, 428, 430, 431, 432, 433, 434, 435, 436, 437, 438, 440, 441, 442, 443, 444, 445, 446, 447, 448, 449, 450, 451, 452, 453, 454, 455, 456, 457, 458, 459, 460, 462, 463, 464, 465, 466, 467, 468, 469, 470, 472, 473, 474, 475, 476, 477, 479, 480, 481, 482, 483, 484, 485, 486, 487, 488, 489, 490, 491, 493, 494, 495, 496, 497, 498, 499, 500, 501, 502, 503, 504, 505, 506, 507, 508, 509, 510, 511, 512, 513, 514, 515, 517, 518, 519, 520, 521, 522, 523, 524, 525, 526, 527, 528, 529, 530, 532, 533, 534, 536, 537, 538, 539, 540, 541, 542, 543, 544, 545, 546, 547, 550, 551, 552, 553, 554, 556, 557, 558, 559, 561, 562, 563, 564, 565, 566, 567, 568, 569, 570, 571, 572, 573, 574, 575, 576, 577, 578, 579, 580, 581, 582, 583, 584, 585, 586, 587, 588, 589, 590, 591, 592, 593, 594, 595, 596, 597, 598, 599, 600, 601, 603, 605, 606, 607, 608, 609, 610, 611, 612, 613, 616, 617, 618, 619, 621, 622, 623, 624, 625, 626, 627, 629, 630, 631, 632, 633, 634, 635, 636, 637, 638, 639, 640, 641, 642, 643, 644, 645, 646, 647, 648, 649, 650, 651, 652, 653, 654, 655, 656, 657, 659, 660, 662, 663, 664, 665, 666, 667, 668, 670, 671, 672, 673, 674, 675, 676, 677, 678, 679, 680, 682, 683, 685, 687, 689, 690, 691, 692, 693, 694, 696, 697, 699, 700, 701, 702, 703, 704, 705, 706, 707, 708, 709, 710, 711, 712, 713, 714, 715, 716, 717, 718, 719, 720, 721, 723, 724, 725, 726, 727, 728, 729, 730, 731, 732, 733, 734, 735, 736, 737, 738, 739, 740, 741, 742, 743, 744, 745, 746, 747, 748, 749, 750, 751, 753, 754, 755, 757, 758, 759, 760, 761, 762, 763, 764, 765, 766, 767, 768, 769, 770, 771, 773, 774, 775, 777, 778, 779, 780, 781, 782, 783, 784, 785, 787, 788, 789, 790, 791, 792, 793, 795, 796, 797, 798, 799, 800, 801, 802, 803, 804, 805, 806, 807, 808, 810, 811, 812, 813, 814, 815, 816, 817, 818, 819, 820, 821, 822, 824, 825, 826, 827, 828, 829, 830, 831, 832, 833, 834, 835, 836, 837, 838, 839, 840, 841, 842, 843, 845, 846, 847, 848, 849, 850, 853, 854, 855, 856, 857, 859, 860, 861, 862, 863, 864, 865, 866, 867, 868, 869, 870, 871, 872, 873, 874, 875, 876, 877, 878, 879, 881, 882, 883, 884, 885, 886, 887, 888, 889, 891, 892, 893, 895, 896, 897, 898, 901, 902, 903, 904, 905, 906, 907, 908, 909, 910, 911, 912, 914, 915, 917, 919, 920, 921, 923, 924, 925, 926, 927, 928, 929, 930, 931, 932, 933, 934, 935, 936, 937, 938, 939, 941, 942, 943, 944, 945, 946, 947, 948, 950, 951, 952, 953, 954, 955, 956, 957, 958, 959, 960, 961, 962, 963, 964, 965, 966, 967, 968, 969, 970, 972, 973, 974, 975, 976, 977, 978, 979, 980, 981, 982, 983, 984, 985, 987, 988, 990, 991, 992, 993, 994, 995, 996, 997, 999, 1000]

Digits:=1000: WrongDigits(Pi,NorthM(5000000)):

[8, 22, 35, 48, 49, 50, 61, 62, 63, 73, 75, 77, 78, 85, 86, 87, 89, 90, 91, 98, 100, 101, 102, 103, 105, 106, 110, 111, 112, 113, 114, 116, 117, 118, 119, 122, 123, 124, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 150, 151, 152, 153, 154, 155, 156, 158, 159, 160, 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, 171, 172, 173, 174, 175, 177, 178, 179, 180, 181, 182, 184, 185, 186, 187, 188, 190, 192, 193, 194, 195, 196, 197, 198, 200, 201, 202, 203, 204, 206, 207, 208, 209, 210, 211, 212, 213, 215, 218, 219, 220, 221, 222, 223, 224, 225, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 244, 245, 247, 248, 249, 250, 251, 252, 253, 254, 255, 256, 257, 258, 259, 260, 261, 263, 264, 265, 266, 267, 268, 270, 272, 273, 274, 275, 276, 277, 278, 279, 280, 282, 283, 285, 286, 287, 288, 289, 290, 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, 310, 311, 312, 313, 314, 315, 316, 318, 319, 320, 321, 323, 324, 325, 326, 327, 328, 329, 330, 333, 334, 335, 336, 337, 338, 339, 340, 341, 342, 343, 344, 347, 348, 349, 350, 352, 353, 354, 355, 357, 358, 359, 360, 361, 362, 363, 364, 365, 366, 367, 368, 369, 370, 372, 373, 374, 375, 376, 377, 378, 379, 380, 381, 382, 383, 384, 385, 386, 387, 388, 389, 390, 391, 392, 393, 394, 395, 396, 398, 399, 400, 401, 402, 403, 405, 406, 408, 409, 410, 411, 412, 413, 414, 415, 416, 417, 418, 419, 420, 421, 422, 423, 424, 425, 426, 428, 430, 431, 432, 433, 434, 435, 436, 437, 438, 439, 440, 441, 442, 443, 444, 445, 446, 447, 448, 449, 450, 451, 452, 453, 454, 455, 456, 457, 458, 459, 460, 461, 462, 463, 464, 465, 466, 467, 468, 469, 470, 471, 472, 473, 475, 476, 477, 478, 479, 480, 481, 483, 484, 485, 486, 487, 488, 489, 490, 491, 492, 493, 494, 495, 496, 498, 499, 500, 501, 502, 503, 504, 505, 506, 511, 512, 513, 514, 517, 518, 519, 520, 521, 522, 523, 524, 525, 527, 528, 530, 531, 532, 533, 534, 535, 536, 537, 538, 539, 540, 541, 542, 543, 544, 545, 546, 548, 549, 550, 552, 553, 554, 555, 558, 559, 560, 561, 562, 563, 564, 565, 567, 568, 569, 570, 571, 572, 573, 574, 576, 577, 578, 579, 580, 581, 582, 583, 585, 586, 587, 588, 589, 591, 592, 593, 594, 595, 596, 597, 599, 600, 601, 602, 603, 604, 605, 606, 607, 608, 609, 610, 611, 612, 613, 614, 616, 617, 618, 619, 620, 621, 622, 623, 625, 626, 627, 628, 629, 630, 631, 632, 633, 634, 635, 636, 637, 638, 639, 640, 641, 642, 643, 644, 645, 647, 648, 649, 650, 651, 652, 653, 654, 655, 656, 658, 659, 660, 661, 663, 664, 665, 666, 667, 668, 669, 670, 671, 672, 673, 674, 675, 676, 677, 678, 679, 680, 681, 682, 683, 684, 685, 686, 687, 688, 689, 690, 691, 692, 693, 694, 695, 696, 697, 698, 699, 700, 701, 702, 703, 704, 705, 706, 707, 708, 709, 710, 711, 712, 713, 714, 715, 716, 717, 718, 719, 720, 721, 722, 723, 724, 725, 726, 727, 729, 730, 731, 732, 733, 734, 735, 736, 737, 738, 739, 740, 741, 742, 743, 744, 745, 747, 748, 749, 750, 751, 752, 754, 755, 756, 757, 758, 759, 760, 761, 762, 763, 764, 765, 766, 767, 768, 769, 770, 771, 772, 773, 774, 775, 776, 777, 778, 779, 780, 781, 782, 783, 784, 785, 786, 787, 789, 790, 791, 793, 794, 795, 796, 797, 799, 800, 801, 802, 803, 804, 805, 808, 809, 810, 811, 812, 813, 814, 815, 817, 818, 821, 822, 823, 824, 825, 826, 828, 829, 830, 831, 833, 835, 837, 838, 839, 840, 841, 842, 843, 844, 845, 846, 847, 848, 849, 850, 851, 852, 853, 854, 855, 856, 857, 859, 860, 861, 862, 864, 865, 866, 867, 868, 869, 870, 871, 872, 873, 874, 876, 877, 878, 879, 880, 881, 882, 883, 884, 886, 889, 890, 891, 893, 894, 896, 897, 898, 899, 900, 901, 902, 903, 904, 905, 906, 909, 911, 912, 913, 914, 915, 916, 917, 918, 919, 921, 922, 923, 924, 925, 926, 927, 928, 929, 930, 931, 932, 933, 934, 935, 936, 937, 938, 939, 940, 941, 942, 943, 945, 946, 948, 949, 950, 951, 952, 953, 955, 956, 957, 958, 959, 960, 961, 962, 963, 965, 966, 967, 968, 969, 970, 971, 972, 974, 975, 976, 977, 978, 979, 980, 982, 983, 984, 985, 986, 987, 990, 991, 992, 994, 995, 996, 997, 998]

Is that sequence in the OEIS.

I couldn't find either sequence in the OEIS, even after shifting them down 1 to represent
digits after the decimal point.
*)

#4. Archimedes(k,N): inputs a small positive integer k, and a positive integer N and outputs what
# Phillips calls pn and Pn, i.e. the perimeter of an inscribed and circumscribed polygon with k*2^N
# sides. Note that Archimedes(k,1) is [sin(Pi/k),tan(Pi/k)].
Archimedes:=proc(k,N) local n:
n:=k*2^N:
[n*sin(Pi/n),n*tan(Pi/n)]:
end:

(* Output
Confirm Archimides' calculation by typing Archimedes(3,5)

Digits := 10; evalf(Archimedes(3, 5));
                   [3.141031951, 3.142714599]

*)

#5. BestMachin(a): finds the (hopefully) unique k such that FindMachin(a,k) is as small as possible
BestMachin:=proc(a) local k,m,min:
min:=abs(FindMachin(a,1)):
for k from 2 to 1000 do
  m:=abs(FindMachin(a,k)):
  if m<min then
    min:=m:
  else
    return(k-1):
  fi:
od:
return(FAIL):
end:
(* Output

Is [seq(BestMachin(a),a=2..10)] in the OEIS? If not, should it be?

The terms from 2..10 appear in three different sequences, but...

[seq(BestMachin(1/a), a = 2 .. 30)];
[2, 2, 3, 4, 5, 6, 6, 7, 8, 9, 9, 10, 11, 12, 13, 13, 14, 15, 16, 17, 17, 18, 19, 20, 20, 21, 22, 23, 24]

The terms from 2..30 do not appear in any OEIS sequence. Should it be? I'm not sure. I would be more
interested in the same sequence when b is +/- the reciprocal of an integer.

*)

#7. Jesus(n): finds the sum of the first n terms of Jesus Guillera's beautiful series for 128/pi^2
# given in his homepage (in a Ramanujan-style notation, that must be deciphered).
Jesus:=proc(n) local sum,i:
sum:=0:
for i from 0 to n do
  sum:=sum+(-1)^i*binomial(2*i,i)^5*(820*i^2+180*i+13)/2^(20*i):
od:
sqrt(128/sum):
end:

(* Output

What is the error in Jesus(20)?

Digits := 100;
evalf(Pi - Jesus(20));
                                                   -64
          7.37790225535073558652236021506878058 x 10   

*)

#8. What's nice about Machin's formula is that FindMachin(1/5,4) has numerator 1 (or rather -1).
# Do there exist integers a and k >= 2 such that FindMachin(a,k) has this property that its numerator
# is -1 or 1?
FindMachinRec:=proc(lo,hi,K) local a,b,i,j:
for i from lo to hi do
  a:=1/i:
  for j from 1 to K do
    b:=FindMachin(a,j):
    if abs(numer(b))=1 then
      print([a$j,b]):
    fi:
  od:
od:
end:

(* Output

The only ones I found with k up to 200 and denominators (a) up to 250 were the ones we knew about:
                             [1  1]
                             [-, -]
                             [2  3]

                           [1  1  -1]
                           [-, -, --]
                           [2  2  7 ]

                             [1  1]
                             [-, -]
                             [3  2]

                           [1  1  1]
                           [-, -, -]
                           [3  3  7]

                       [1  1  1  1  -1 ]
                       [-, -, -, -, ---]
                       [5  5  5  5  239]

*)

#9. Is there a k and integers 6 <= a[1] <= a[2] <=...<= a[k], b such that
# ATAN([1/a[1], ...,1/a[k],1/b])=1 OR ATAN([1/a[1], ...,1/a[k],-1/b])=1
FindMachinSet:=proc(minp,maxp) local b,bb,i,j,p:
for i from minp to maxp do
  for p in partition(i) do
    bb:=solve(ATAN([seq(1/(p[j]+5),j=1..nops(p)),b])=1,b):
    if abs(numer(bb))=1 then
      print([seq(1/(p[j]+5),j=1..nops(p)),bb]):
    fi:
  od:
od:
end:

(* Output

It turns out there are actually a bunch of them! I generated the sets {a[1],...,a[k]} by using
partitions of increasing integers. The number of elements in the partition becomes k, and the
denominator is 5+x for each x in the partition. Here are the ones for partitions of up to 30:

                    [1  1  1  1  1  1   1 ]
                    [-, -, -, -, -, -, ---]
                    [7  7  8  8  8  8  239]

                    [1  1  1  1  1  1   1  ]
                    [-, -, -, -, -, -, ----]
                    [7  7  7  8  8  9  2943]

                         [1  1  1   1]
                         [-, -, --, -]
                         [7  8  18  2]

                        [1  1  1  1   1]
                        [-, -, -, --, -]
                        [7  7  8  18  3]

                  [1  1  1  1  1   1    -1  ]
                  [-, -, -, -, --, --, -----]
                  [6  6  6  7  13  14  41187]

                    [1  1  1  1  1  1   -1 ]
                    [-, -, -, -, -, --, ---]
                    [6  6  7  7  8  18  117]

                    [1  1  1  1  1  1   1 ]
                    [-, -, -, -, -, --, --]
                    [6  7  7  7  8  18  68]

                      [1  1  1  1  1   1]
                      [-, -, -, -, --, -]
                      [7  7  8  8  18  5]

                    [1  1  1  1  1  1   1 ]
                    [-, -, -, -, -, --, --]
                    [6  7  7  8  8  18  31]

                    [1  1  1  1  1  1   1 ]
                    [-, -, -, -, -, --, --]
                    [7  7  7  8  8  18  18]

                      [1  1  1  1   1   1]
                      [-, -, -, --, --, -]
                      [7  7  8  13  18  4]

                         [1  1  1   1]
                         [-, -, --, -]
                         [6  8  31  2]

*)


#### From C15.txt ####

#Maple code for Lecture 15
Help15:=proc(): print(` A(n), PiAp(n), NorthM(N), ArcTanT(x,k), ATAN(L) , FindMcahin(a,k), Ac(n), PiApc(n) `):end:


#A(n) The integral of (x*(1-x))^n/(1+x^2) from x=0 to x=1
A:=proc(n) local x:    int(x^n*(1 - x)^n/(x^2 + 1), x = 0 .. 1): end :

#PiAp(n): The approximation of Pi by a rational number obtained by pretending that A(4*n) above is 0.
PiAp:=proc(n)    local a:    a := A(4*n):    -coeff(a, Pi, 0)/coeff(a, Pi, 1):end:


#ArcTanT(x,k): The truncation of the Taylor series of arctan(x) after k terms, followed by the rigorous error bound
#x^(2*k+1)/(2*k+1)
ArcTanT:=proc(x,k) local i:
[4*add((-1)^i*x^(2*i+1)/(2*i+1),i=0..k), 4*x^(2*k+3)/(2*k+3)]:
end:

#ATAN(L): Inputs a list of numbers (or symbols) L finds the quantity A such that
#arctan(A)= arctan(L[1])+...+arctan(L[k])
#
#arctan(a)+arctan(b)=arctan((a+b)/(1-a*b)):
ATAN:=proc(L) local a,b:
if nops(L)=1 then
 RETURN(L[1]):
fi:
a:=ATAN([op(1..nops(L)-1,L)]):
b:=L[nops(L)]:
normal((a+b)/(1-a*b)):
end:


#FindMachin(a,k): finds the unique b such that ATAN([a$k,b])=1
FindMachin:=proc(a,k) local b:
solve(ATAN([a$k,b])=1,b):
end:


#NorthM(N): The truncated Gregory-Leibnitz formula at N, giving most correct digits of Pi when N=10^k/2, e.g. NorthM(500000); It was discovered emprically, in 1988, by
#at the time undergraudate R.D. North
NorthM:=proc(N) local k:
evalf(4*add((-1)^(k-1)/(2*k-1),k=1..N)):
end:



##ADDED AFTER CLASS
#Ac(n): Same as A(n) but using the third-order recurrence gotten from the amazing Almkvist-Zeilberger algorithm
#1/2*(45*n^2-88*n+32)/(2*n-1)/(5*n-7)/N-(25*n^2-50*n+18)/(2*n-1)/(5*n-7)/N^2+(n-2)*(5*n-2)/(2*n-1)/(5*n-7)/N^3
Ac:=proc(n) local L,n1,newguy:option remember:
if n=0 then
Pi/4:
elif n=1 then
-1+1/2*ln(2)+1/4*Pi:
elif n=2 then
 -2/3+ln(2):
else
L:=[Pi/4,-1+1/2*ln(2)+1/4*Pi, -2/3+ln(2)]:

for n1 from 3 to n do

newguy:=1/2*(45*n1^2-88*n1+32)/(2*n1-1)/(5*n1-7)*L[3]-(25*n1^2-50*n1+18)/(2*n1-1)/(5*n1-7)*L[2]+(n1-2)*(5*n1-2)/(2*n1-1)/(5*n1-7)*L[1]:
L:=[L[2],L[3],newguy]:
od:
RETURN(L[3]):
fi:

end:





#PiApc(n): The approximation of Pi by a rational number obtained by pretending that Ac(4*n) above is 0.
PiApc:=proc(n)    local a:    a := Ac(4*n):    -coeff(a, Pi, 0)/coeff(a, Pi, 1):end: