memo = {here,is,the,file,for,the,display,that,was,prepared,for,the,London, meeting,but,at,the,meeting,I,learned,how,to,refine,and,improve, the,programming,for,these,basic,procedures,which,are,mostly,for, finding,numerical,solutions,to,the,game,equations,in,21,variables, and,for,recursive,improvements,on,the,accuracy,of,such,approximate, numerical,solutions,and,also,it,can,be,remarked,that,I,discovered, at,the,time,of,the,meeting,that,the,programming,of,FRTAprog,and, SFRAprog,as,presented,here,was,valid,for,the,4.2,version,but,not, for,the,5th,version,of,MATHEMATICA,so,that,was,fixed,later,after, the,meeting} rr[j_, k_, l_, p_, q_] := rr21[j, k, l, p, q] rr21[f_, sy_, a_, m_Integer, n_Integer] := Module[{na, w, zy}, If[n < 1, Return[no$$iterations$$error]]; na = 0; zy = rat[sy, m]; Label[o1]; If[na == n, Goto[o2]]; zy = r21f[f, zy, a, m]; na = na + 1; Goto[o1]; Label[o2]; Return[zy]; ] rat[y_, k_Integer] := Rationalize[y, 1/10^(k + 2)] r21f[f_, sy_, a_, n_Integer] := r21fa[f, rat[sy, n], a, n] r21fa[f_, sy_, a_, n_Integer] := (AccuracyGoal -> n; PrecisionGoal -> n; WorkingPrecision -> n + 7; Module[{u, zy, nu, du, fe, w22, v21}, w22 = N[sby[{{D[f, y1], D[f, y2], D[f, y3], D[f, y4], D[f, y5], D[f, y6], D[f, y7], D[f, y8], D[f, y9], D[f, y10], D[f, y11], D[f, y12], D[f, y13], D[f, y14], D[f, y15], D[f, y16], D[f, y17], D[f, y18], D[f, y19], D[f, y20], D[f, y21]}, f}, sy], n]; w22 = Rationalize[w22, 1/10^(n + 2)]; {v21, fe} = w22; nu = -(a*fe); du = sqsum[v21]; u = nu/du; zy = N[sy + u*v21, n]; Return[zy]; ]) rf1b[f_, sy_, a_, n_Integer] := (AccuracyGoal -> n; PrecisionGoal -> n; WorkingPrecision -> n + 7; Module[{u, zy, du, b, fe, fe2, st21, st22}, b = a; st22 = N[sby[{{D[f, y1], D[f, y2], D[f, y3], D[f, y4], D[f, y5], D[f, y6], D[f, y7], D[f, y8], D[f, y9], D[f, y10], D[f, y11], D[f, y12], D[f, y13], D[f, y14], D[f, y15], D[f, y16], D[f, y17], D[f, y18], D[f, y19], D[f, y20], D[f, y21]}, f}, sy], n]; st22 = Rationalize[st22, 1/10^(n + 2)]; {st21, fe} = st22; du = sqsum[st21]; u = -(fe/du); Goto[o2]; Label[o1]; b = (2*b)/3; Label[o2]; zy = N[sy + b*u*st21, n]; fe2 = N[sby[f, zy], n]; If[fe2 < fe, Goto[o3]]; If[b < 6^(-n), Return[gonetoosmall]]; Goto[o1]; Label[o3]; Return[zy]; ]) s21b[w_] := Module[{j1, j2, j3, a, j4, j5, j6, j7, j8, j9, j10, j11, j12, j13, j14, j15, j16, j17, j18, j19, j20, j21}, {j1, j2, j3, j4, j5, j6, j7, j8, j9, j10, j11, j12, j13, j14, j15, j16, j17, j18, j19, j20, j21} = w; a = {y1 -> j1, y2 -> j2, y3 -> j3, y4 -> j4, y5 -> j5, y6 -> j6, y7 -> j7, y8 -> j8, y9 -> j9, y10 -> j10, y11 -> j11, y12 -> j12, y13 -> j13, y14 -> j14, y15 -> j15, y16 -> j16, y17 -> j17, y18 -> j18, y19 -> j19, y20 -> j20, y21 -> j21}; Return[a]; ] FRTA[ll_, sy_, n_Integer] := Module[{ry, o, y1a, y2a, y3a, y4a, y5a, y6a, y7a, y8a, y9a, y10a, y11a, y12a, y13a, y14a, y15a, y16a, y17a, y18a, y19a, y20a, y21a}, ry = Rationalize[sy, 1/10^(n + 2)]; {y1a, y2a, y3a, y4a, y5a, y6a, y7a, y8a, y9a, y10a, y11a, y12a, y13a, y14a, y15a, y16a, y17a, y18a, y19a, y20a, y21a} = ry; o = FindRoot[ll == zz21, {y1, y1a}, {y2, y2a}, {y3, y3a}, {y4, y4a}, {y5, y5a}, {y6, y6a}, {y7, y7a}, {y8, y8a}, {y9, y9a}, {y10, y10a}, {y11, y11a}, {y12, y12a}, {y13, y13a}, {y14, y14a}, {y15, y15a}, {y16, y16a}, {y17, y17a}, {y18, y18a}, {y19, y19a}, {y20, y20a}, {y21, y21a}, {AccuracyGoal -> n, WorkingPrecision -> n + 7}]; o = N[o, n]; Return[o]; ] SFRA[ll_, sy_, n_Integer, kk_Integer] := Module[{ry, o, k, y1a, y2a, y3a, y4a, y5a, y6a, y7a, y8a, y9a, y10a, y11a, y12a, y13a, y14a, y15a, c16, c17, c18, c19, c20, c21 }, k = kk/(1 + kk); ry = Rationalize[sy, 1/10^(n + 2)]; {y1a, y2a, y3a, y4a, y5a, y6a, y7a, y8a, y9a, y10a, y11a, y12a, y13a, y14a, y15a, c16, c17, c18, c19, c20, c21 } = ry; o = FindRoot[ll == zz21, {y1, k*y1a, y1a/k}, {y2, k*y2a, y2a/k}, {y3, k*y3a, y3a/k}, {y4, k*y4a, y4a/k}, {y5, k*y5a, y5a/k}, {y6, k*y6a, y6a/k}, {y7, k*y7a, y7a/k}, {y8, k*y8a, y8a/k}, {y9, k*y9a, y9a/k}, {y10, k*y10a, y10a/k}, {y11, k*y11a, y11a/k}, {y12, k*y12a, y12a/k}, {y13, k*y13a, y13a/k}, {y14, k*y14a, y14a/k}, {y15, k*y15a, y15a/k}, {y16, k*c16, c16/k}, {y17, k*c17, c17/k}, {y18, k*c18, c18/k}, {y19, k*c19, c19/k}, {y20, k*c20, c20/k}, {y21, k*c21, c21/k}, {AccuracyGoal -> n, WorkingPrecision -> n + 7}]; o = N[o, n]; Return[o]; Null; ] sqsum[kk_] := Module[{f1, r, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15, f16, f17, f18, f19, f20, f21}, {f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15, f16, f17, f18, f19, f20, f21} = kk; r = f1*f1 + f2^2 + f3*f3 + f4^2 + f5*f5 + f6^2 + f7^2 + f8*f8 + f9*f9 + f10*f10 + f11^2 + f12^2 + f13^2 + f14^2 + f15^2 + f16^2 + f17^2 + f18^2 + f19^2 + f20^2 + f21^2 ; Return[r]; ] prep[] := Module[{z}, Clear[done]; Clear[ff]; Clear[f]; ff = ff0 /. ps; f = sqsum[ff]; Return[done]; ] yy21 = {y1, y2, y3, y4, y5, y6, y7, y8, y9, y10, y11, y12, y13, y14, y15, y16, y17, y18, y19, y20, y21} zz21 = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0} rrs[z1_,z2_,z3_] := rrb[f,z1,9/5,z2,z3] rrs2[z1_, z2_, z3_] := rrb[f, z1, 2/3, z2, z3] rrc[z1_, z2_, z3_, z4_] := rrb[f, z1, z2, z3, z4] rra[v1_, v2_, v3_, v4_] := rrb[v1,v2,9/5,v3,v4] rrb[f_, sy_, a_, m_Integer, n_Integer] := Module[{na, w, zy}, If[n < 1, Return[no$$iterations$$error]]; na = 0; zy = rat[sy, m]; Label[o1]; If[na == n, Goto[o2]]; zy = rfb[f, zy, a, m]; na = na + 1; Goto[o1]; Label[o2]; Return[zy]; ] rfb[f_, sy_, a_, n_Integer] := rf1b[f, rat[sy, n], a, n] sby[phi_, sya_] := Module[{yaa, r}, yaa = sb[sya]; r = phi /. yaa; Return[r]; ] sb[wq_] := s21b[wq] FRTC[u1_,u2_] := FRTB[ff,u1,u2] FRTB[w1_, w2_, w3_] := Module[{zy, o}, o = FRTA[w1, w2, w3]; zy = yy21 /. o; Return[zy]; ] FRT[w1_, w2_, w3_] := Module[{za, zb, zc}, za = FRTA[w1, w2, w3]; zb = FRTB[w1, w2, w3]; zc = {zb, za}; Return[zc]; ] FRT1C[v1_,v2_] := FR1[v1,v2] FR1[u1_, u2_] := FRT1B[ff, u1, u2] FRT1B[w1_, w2_, w3_] := Module[{zy, o}, o = FRT1A[w1, w2, w3]; zy = yy21 /. o; Return[zy]; ] FRT1A[ll_, sy_, n_Integer] := Module[{ry, o, y1a, y2a, y3a, y4a, y5a, y6a, y7a, y8a, y9a, y10a, y11a, y12a, y13a, y14a, y15a, y16a, y17a, y18a, y19a, y20a, y21a}, ry = Rationalize[sy, 1/10^(n + 2)]; {y1a, y2a, y3a, y4a, y5a, y6a, y7a, y8a, y9a, y10a, y11a, y12a, y13a, y14a, y15a, y16a, y17a, y18a, y19a, y20a, y21a} = ry; o = FindRoot[ll == zz21, {y1, y1a}, {y2, y2a}, {y3, y3a}, {y4, y4a}, {y5, y5a}, {y6, y6a}, {y7, y7a}, {y8, y8a}, {y9, y9a}, {y10, y10a}, {y11, y11a}, {y12, y12a}, {y13, y13a}, {y14, y14a}, {y15, y15a}, {y16, y16a}, {y17, y17a}, {y18, y18a}, {y19, y19a}, {y20, y20a}, {y21, y21a}, {AccuracyGoal -> n, MaxIterations -> 1, WorkingPrecision -> n + 7}]; o = N[o, n]; Return[o]; ] SFRC[u1_,u2_,u3_] := SFRB[ff,u1,u2,u3] SFRB[w1_, w2_, w3_, v_] := Module[{zy, o}, o = SFRA[w1, w2, w3, v]; zy = yy21 /. o; Return[zy]; ] SFR[w1_, w2_, w3_, v_] := Module[{za, zb, zc}, za = SFRA[w1, w2, w3, v]; zb = SFRB[w1, w2, w3, v]; zc = {zb, za}; Return[zc]; ] fsb[z_] := sby[f, z] ffsb[v_] := sby[ff, v] s3sum[kk_] := Module[{r, f1, f2, f3}, {f1, f2, f3} = kk; r = f1 + f2 + f3; Return[r]; ] shapval = {(2 + b3 - bz)/6, (2 + b3 - bz)/6, (1 - b3 + bz)/3} shap[] := ( shapval /. ps ) nuke[] := Module[{r, ra, s, t}, Clear[bz, b3]; {s, ra} = {bz, b3} /. ps; If[s == 0, Goto[o2]]; r = nuke$function$needs$bz$defined$and$vanishing; Goto[o3]; Label[o2]; r = nukevs[ra]; Label[o3]; Return[r]; ] nukevs[b3w_] := Module[{z, w}, z = Max[0, (-1 + 3*b3w)/12]; w = {z + 1/3, z + 1/3, 1/3 - 2*z}; Return[w]; ] pay[zy_] := sby[ppvyy /. ps, zy] paytot[wy_] := s3sum[pay[wy]] npay[u_] := pay[u]/paytot[u] llv[w_] := llvals[w] llvals[u_] := sby[lltoyy, u] lltoyy = {b1 -> bz, b2 -> bz, a1f2 -> y1, a1f3 -> y2, a2f1 -> y1, a2f3 -> y2, a3f1 -> y3, a3f2 -> y3, a12 -> y4, a13 -> y5, a21 -> y4, a23 -> y5, a31 -> y6, a32 -> y6, af21 -> y7, af23 -> y8, af32 -> y9, af13 -> y8, af31 -> y9, af12 -> y7, u2b1r23 -> y10, u3b2r31 -> y11, u1b3r12 -> y12, u1b2r13 -> y10, u3b1r32 -> y11, u2b3r21 -> y12, u3b12r3 -> y13, u1b23r1 -> y14, u2b31r2 -> y15, u3b21r3 -> y13, u2b13r2 -> y14, u1b32r1 -> y15, u2b12r3 -> y16, u3b23r1 -> y17, u1b31r2 -> y18, u1b21r3 -> y16, u3b13r2 -> y17, u2b32r1 -> y18, u3b1r23 -> y19, u1b2r31 -> y20, u2b3r12 -> y21, u3b2r13 -> y19, u2b1r32 -> y20, u1b3r21 -> y21} ppvyy = ppvyya ff0 = ff0a AA = blah BB = blah Clear[AA,BB] g[v$w_] := fsb[fa[v$w]] fa[u$g_] := faa[u$g, AA, BB] faa[u$z_, A$j_, B$j_] := u$z*B$j + (1 - u$z)*A$j OUT = OUT rrce[v1_, v2_, v3_, v4_] := Module[{r, s, t1, t2}, t1=Date[]; r = rrc[v1, v2, v3, v4]; Clear[OUT]; OUT = r; t2 = Date[]; s = {v2, v3, v4}; Save["out.rrce", ps, memo, OUT, s, t1, t2]; Return[r]; ] end = lastline