reseek[d0_, k_] := Module[{j, d, p, n}, j = 0; {p, n} = d0; Label[o1]; 
      d = seek[p, n]; {p, n} = d; j = j + 1; n = 1 + (11*n)/10; 
      n = IntegerPart[n]; d = {p, n}; If[j < k, Goto[o1]]; d = {p, n}; 
      Return[d]; ]
 
seek[pb_, n0_] := Module[{m, m2, pq, s}, m = n0; s = m*m; Label[o1]; 
      m2 = Sqrt[s]; If[m2 < m + 1, Goto[o2]]; m = m + 1; Label[o2]; 
      pq = pert[pb, 1/m]; If[bet[pq, pb], Goto[o3]]; s = s + 1; Goto[o1]; 
      Label[o3]; pq=rat[pq,15]; pq=N[pq,15]; Return[{pq, m}]; ]
 
pert[pa_, s_] := Module[{p1, p2, p3, p4, x, y, z}, {p1, p2, p3, p4} = pa; 
      Label[o0]; x = R[]; y = DA[]; x = x - 1/2; z = s*x; Label[o1]; 
      If[y > 3, Goto[o4]]; If[y > 1, Goto[o2]]; p1 = p1 + z; p2 = p2 - z; 
      Goto[o7]; Label[o2]; If[y > 2, Goto[o3]]; p1 = p1 + z; p3 = p3 - z; 
      Goto[o7]; Label[o3]; p2 = p2 + z; p3 = p3 - z; Goto[o7]; Label[o4]; 
      If[y > 4, Goto[o5]]; p1 = p1 + z; p4 = p4 - z; Goto[o7]; Label[o5]; 
      If[y > 5, Goto[o6]]; p2 = p2 + z; p4 = p4 - z; Goto[o7]; Label[o6]; 
      p3 = p3 + z; p4 = p4 - z; Label[o7]; If[Max[p1, p2, p3, p4] > 1, 
       Goto[o0]]; If[Min[p1, p2, p3, p4] < 0, Goto[o0]]; 
      x = {(1 + 3*p1 - p2 - p3 - p4)/4, (1 - p1 + 3*p2 - p3 - p4)/4, 
        (1 - p1 - p2 + 3*p3 - p4)/4, (1 - p1 - p2 - p3 + 3*p4)/4}; 
      Return[x]; ]
  
R[] := Module[{s1, s2, s3}, s1 = Ra[]; s2 = Ra[]; s3 = Ra[]; 
      s1 = 100000*s1 + s2; s3 = 100000*s1 + s3; s2 = s3/10^15; 
      s1 = N[s2, 17]; Return[s1]; ]
 
Ra[] := Random[Integer, 100000]
 
DA[] := Module[{x, y, z}, x = R[]; y = 6*x; z = 1 + Rationalize[y, 1]; 
      Return[z]; ]
 
bet[pa_, pb_] := fp[xsf[pb] - xsf[pa]]
 
fp[s_] := firpos[s]

firpos[kka_] := Module[{k1, k2, k3, k4, k5, k6}, 
     {k1, k2, k3, k4, k5, k6, k7, k8, k9, k10, k11, k12, k13, k14} = kka; 
      If[k1 < 0, Goto[o1]]; If[k1 > 0, Goto[o2]]; If[k2 < 0, Goto[o1]]; 
      If[k2 > 0, Goto[o2]]; If[k3 < 0, Goto[o1]]; If[k3 > 0, Goto[o2]]; 
      If[k4 < 0, Goto[o1]]; If[k4 > 0, Goto[o2]]; If[k5 < 0, Goto[o1]]; 
      If[k5 > 0, Goto[o2]]; If[k6 < 0, Goto[o1]]; If[k6 > 0, Goto[o2]]; 
      If[k7 < 0, Goto[o1]]; If[k7 > 0, Goto[o2]]; If[k8 < 0, Goto[o1]]; 
      If[k8 > 0, Goto[o2]]; If[k9 < 0, Goto[o1]]; If[k9 > 0, Goto[o2]]; 
      If[k10 < 0, Goto[o1]]; If[k10 > 0, Goto[o2]]; If[k11 < 0, Goto[o1]]; 
      If[k11 > 0, Goto[o2]]; If[k12 < 0, Goto[o1]]; If[k12 > 0, Goto[o2]]; 
      If[k13 < 0, Goto[o1]]; If[k13 > 0, Goto[o2]]; If[k14 < 0, Goto[o1]]; 
      If[k14 > 0, Goto[o2]]; Label[o1]; Return[False]; 
      Label[o2]; Return[True]; ]
  
xsf[px_] := xb[px, vv1]
 
xb[pb_, vvb_] := Sort[xa[pb, vvb], Greater]

xa[u_, v_] := xa4[u, v]
 
xa4[pa_, vva_] := Module[{r, w1, w2, w3, w4, w12, w13, w23, w14, w24, w34, 
      w123, w124, w134, w234, q1, q2, q3, q4}, {q1, q2, q3, q4} = pa; 
      {w1, w2, w3, w4, w12, w13, w23, w14, w24, w34, w123, w124, w134, 
        w234} = vva; r = {w1 - q1, w2 - q2, w3 - q3, w4 - q4, w12 - q1 - q2, 
        w13 - q1 - q3, w23 - q2 - q3, w14 - q1 - q4, w24 - q2 - q4, 
        w34 - q3 - q4, w123 - q1 - q2 - q3, w124 - q1 - q2 - q4, 
        w134 - q1 - q3 - q4, w234 - q2 - q3 - q4}; Return[r]; ]
   
s4sum[kk_] := Module[{r, f1, f2, f3, f4}, {f1, f2, f3, f4} = kk; 
      r = f1 + f2 + f3 + f4; Return[r]; ]
  
p = {p1, p2, p3, p4}
  
vv = {v1, v2, v3, v4, v12, v13, v23, v14, v24, v34, v123, v124, v134, v234}

rat[x_, k_Integer] := Rationalize[x, 1/10^(k + 2)]