EuklidZahl[p_] := Product[Prime[i], {i, 1, PrimePi[p]}] + 1
    
GoldbZerlegung[n_] := Delete[
  Union[{Null}, 
    Table[If[PrimeQ[n - Prime[i]], {Prime[i], n - Prime[i]}], {i, 1, 
        PrimePi[n/2]}]], 1]

Quersumme[n_] := Plus @@ IntegerDigits[n]
    
alternQSumme[n_] := Sum[(-1)^(i - 1)*Reverse[IntegerDigits[n]][[i]], {i, 1, 
    Length[IntegerDigits[n]]}]

ChinesReste[a_, m_] := Last[{M = Times @@ m; T = M/m;
    d = Table[
        x /. Delete[Flatten[Solve[{T[[i]]x == 1, Modulus == m[[i]]}, x]], 
            1], {i, 1, Length[m]}]; Mod[Plus @@ (a*T*d), M]}]

geradeTeiler[n_] := Delete[
  Union[Table[
      If[EvenQ[Divisors[n][[i]]], Divisors[n][[i]]], {i, 1, 
        Length[Divisors[n]]}]], -1]

ungeradeTeiler[n_] := Complement[Divisors[n], geradeTeiler[n]]

teilerfrZahlen[n_] := If[Abs[n] == 1, {1}, 
  Delete[Union[Table[If[GCD[n, i] == 1, i], {i, 1, Abs[n]}]], -1]]

nichtTeilerfrZ[n_] := Drop[Union[Table[If[GCD[i, n] > 1, i], {i, 1, n}]], -1]

SummeUeberTeiler[f_, n_] := First[{Teiler = Divisors[n];
    Sum[f[Teiler[[i]]], {i, 1, Length[Teiler]}]}]

MangLambda[n_] := If[Length[FactorInteger[n]] == 1, 
  Log[First[First[FactorInteger[n]]]], 0]

LiouvLambda[n_] := (-1)^If[n == 1, 0, Last[Plus @@ FactorInteger[n]]]
    
AnzPrimt[n_] := Length[FactorInteger[n]]

symmetrGrfkt[x1_, x2_, x3_, x4_, x5_, x6_, x7_] := {1, 
  x1 + x2 + x3 + x4 + x5 + x6 + x7, 
  x1 x2 + x1 x3 + x2 x3 + x1 x4 + x2 x4 + x3 x4 + x1 x5 + x2 x5 + x3 x5 + 
    x4 x5 + x1 x6 + x2 x6 + x3 x6 + x4 x6 + x5 x6 + x1 x7 + x2 x7 + x3 x7 + 
    x4 x7 + x5 x7 + x6 x7, 
  x1 x2 x3 + x1 x2 x4 + x1 x3 x4 + x2 x3 x4 + x1 x2 x5 + x1 x3 x5 + x2 x3 x5 +
     x1 x4 x5 + x2 x4 x5 + x3 x4 x5 + x1 x2 x6 + x1 x3 x6 + x2 x3 x6 + 
    x1 x4 x6 + x2 x4 x6 + x3 x4 x6 + x1 x5 x6 + x2 x5 x6 + x3 x5 x6 + 
    x4 x5 x6 + x1 x2 x7 + x1 x3 x7 + x2 x3 x7 + x1 x4 x7 + x2 x4 x7 + 
    x3 x4 x7 + x1 x5 x7 + x2 x5 x7 + x3 x5 x7 + x4 x5 x7 + x1 x6 x7 + 
    x2 x6 x7 + x3 x6 x7 + x4 x6 x7 + x5 x6 x7, 
  x1 x2 x3 x4 + x1 x2 x3 x5 + x1 x2 x4 x5 + x1 x3 x4 x5 + x2 x3 x4 x5 + 
    x1 x2 x3 x6 + x1 x2 x4 x6 + x1 x3 x4 x6 + x2 x3 x4 x6 + x1 x2 x5 x6 + 
    x1 x3 x5 x6 + x2 x3 x5 x6 + x1 x4 x5 x6 + x2 x4 x5 x6 + x3 x4 x5 x6 + 
    x1 x2 x3 x7 + x1 x2 x4 x7 + x1 x3 x4 x7 + x2 x3 x4 x7 + x1 x2 x5 x7 + 
    x1 x3 x5 x7 + x2 x3 x5 x7 + x1 x4 x5 x7 + x2 x4 x5 x7 + x3 x4 x5 x7 + 
    x1 x2 x6 x7 + x1 x3 x6 x7 + x2 x3 x6 x7 + x1 x4 x6 x7 + x2 x4 x6 x7 + 
    x3 x4 x6 x7 + x1 x5 x6 x7 + x2 x5 x6 x7 + x3 x5 x6 x7 + x4 x5 x6 x7, 
  x1 x2 x3 x4 x5 + x1 x2 x3 x4 x6 + x1 x2 x3 x5 x6 + x1 x2 x4 x5 x6 + 
    x1 x3 x4 x5 x6 + x2 x3 x4 x5 x6 + x1 x2 x3 x4 x7 + x1 x2 x3 x5 x7 + 
    x1 x2 x4 x5 x7 + x1 x3 x4 x5 x7 + x2 x3 x4 x5 x7 + x1 x2 x3 x6 x7 + 
    x1 x2 x4 x6 x7 + x1 x3 x4 x6 x7 + x2 x3 x4 x6 x7 + x1 x2 x5 x6 x7 + 
    x1 x3 x5 x6 x7 + x2 x3 x5 x6 x7 + x1 x4 x5 x6 x7 + x2 x4 x5 x6 x7 + 
    x3 x4 x5 x6 x7, 
  x1 x2 x3 x4 x5 x6 + x1 x2 x3 x4 x5 x7 + x1 x2 x3 x4 x6 x7 + 
    x1 x2 x3 x5 x6 x7 + x1 x2 x4 x5 x6 x7 + x1 x3 x4 x5 x6 x7 + 
    x2 x3 x4 x5 x6 x7, x1 x2 x3 x4 x5 x6 x7}

(*
  y = {x1, x2, x3, x4, x5, x6, x7};
b = Flatten[Outer[List, y, y, y, y, y, y, y], Length[y] - 1];
c = Union[Table[Union[b[[i]]], {i, 1, Length[b]}]];
ZwL[j_] := 
    Delete[Union[Table[If[Length[c[[i]]] == j, c[[i]]], {i, 1, Length[c]}]], 
      1];
Mult[k_] := Table[Times @@ k[[i]], {i, 1, Length[k]}];
d = Join[{{1}}, Table[Mult[ZwL[i]], {i, 1, Length[y]}]];
e = Table[Plus @@ d[[i]], {i, 1, Length[d]}]
  *)

KnapsUewF[a_, V_] := Last[{L = {}; 
    If[V >= a[[Length[a]]], L = Join[{1}, L], L = Join[{0}, L]];
    Do[If[V - Plus @@ (Take[a, -i].L) >= a[[Length[a] - i]], L = Join[{1}, L],
         L = Join[{0}, L]], {i, 1, Length[a] - 1}];
    If[V == Plus @@ (a.L), S = L, S = {}]; S}]

Ordnung[a_, n_] := First[
  Sort[Table[
      If[IntegerQ[EulerPhi[n]/i], If[Mod[a^i, n] == 1, i]], {i, 1, 
        EulerPhi[n]}]]]

kleinstePWurzel[n_] := First[{L = Null; 
    Do[z = 0; 
      For[k = 1, k < EulerPhi[n], k++, 
        If[PowerMod[j, k, n] != 1, z = z + 1]];
      If[z == EulerPhi[n] - 1 && GCD[j, n] == 1, L = j; Break[]], {j, 1, 
        n - 1}]; L}]

primWurzeln[n_] := Last[{y = Flatten[{klPW = kleinstePWurzel[n];
          
          Drop[Union[
              Table[If[GCD[k, EulerPhi[n]] == 1, Mod[klPW^k, n]], {k, 1, 
                  EulerPhi[n]}]], -1]}]; 
    If[IntegerQ[First[y]], x = y, x = {}]; x}]

primWQ[w_, n_] := TrueQ[MemberQ[primWurzeln[n], Mod[w, n]]]

UniversalExp[n_] := 
  LCM @@ (Flatten[{ZwLi = FactorInteger[n]; einHalb[x_] := x - 1;
          korrLi = MapAt[einHalb, ZwLi, {1, 2}]; 
          phiF[{x_, y_}] := EulerPhi[x^y];
          
          If[ZwLi[[1, 1]] == 2 && ZwLi[[1, 2]] > 2, Map[phiF, korrLi], 
            Map[phiF, ZwLi]]}])
    
Index[a_, r_, p_] := First[
  Union[Table[If[PowerMod[r, j, p] == a, j], {j, 1, p - 1}]]]

quadrReste[n_] := Drop[
  Union[Table[If[JacobiSymbol[i, n] == 1, i], {i, 1, n - 1}]], -1]

quadrNichtreste[n_] := Drop[
  Union[Table[If[JacobiSymbol[i, n] == -1, i], {i, 1, n - 1}]], -1]

vQuaR[n_] := Drop[
  Union[Flatten[
      Join[{Null}, 
        Table[If[GCD[n, i] == 1, If[IntegerQ[(x^2 - i)/n], i]], {x, 1, 
            n - 1}, {i, 1, n - 1}]]]], -1]

SummeVonQu[n_, k_] := Flatten[{m = Ceiling[Sqrt[n]];
    S = {x1, x2, x3, x4, x5}; M = {m1, m2, m3, m4, m5};
    Do[M[[i]] = 0, {i, 1, 5}]; Do[M[[i]] = m, {i, 1, k}];
    T = Take[S, k]; 
    x = Table[
        If[Plus @@ (T^2) == n, T], {x1, 0, M[[1]]}, {x2, 0, M[[2]]}, {x3, 0, 
          M[[3]]}, {x4, 0, M[[4]]}, {x5, 0, M[[5]]}];
    y = Delete[Union[Flatten[x, 4]], 1];
    z = Union[Table[Sort[y[[i]]], {i, 1, Length[y]}]]}, 1]

QuDiff[n_] := Delete[
  Union[Table[
      If[PotenzQ[i^2 - n, 2], {i, Sqrt[i^2 - n]}], {i, Floor[Sqrt[n] + 1], 
        n}]], 1]

FiboZahl[n_] := Last[{a = 1; b = 1; 
    Do[{c = a + b, b1 = b, a1 = a, a = b, b = c}, {n - 1}]; a}]

LucasZahl[n_] := Last[{a = 1; b = 3; 
    Do[{c = a + b, b1 = b, a1 = a, a = b, b = c}, {n - 1}]; a}]

KBinRZ[L_] := Last[{REDdesKB[a_, b_] := a + 1/b; 
    r = REDdesKB[L[[-2]], Last[L]];
    z = -3; Do[{r = REDdesKB[L[[z]], r], z = z - 1}, {Length[L] - 2}]; r}]

RZinKB[q_] := Last[{s = q; L = {}; 
    While[! IntegerQ[s], {L = Join[L, {Floor[s]}];
        s = 1/(s - Floor[s])}]; s = s - 1; L = Join[L, {s, 1}]}]

KBeinerIZ[x_, n_] := Floor[
  NestList[Function[{u}, 1/(u - Floor[u])], x, n - 1]]

KONVeinerRZ[q_] := Flatten[{x = RZinKB[q]; L = {x[[1]]};
    L = Join[L, {x[[2]]x[[1]] + 1}]; 
    Do[L = Join[L, {x[[i]]L[[i - 1]] + L[[i - 2]]}], {i, 3, Length[x]}]; 
    M = {1, x[[2]]}; 
    Do[M = Join[M, {x[[i]]M[[i - 1]] + M[[i - 2]]}], {i, 3, Length[x]}]; 
    L/M}]

Konvergenten[r_, n_] := Flatten[{x = KBeinerIZ[r, n]; L = {x[[1]]};
    L = Join[L, {x[[2]]x[[1]] + 1}]; 
    Do[L = Join[L, {x[[i]]L[[i - 1]] + L[[i - 2]]}], {i, 3, Length[x]}]; 
    M = {1, x[[2]]}; 
    Do[M = Join[M, {x[[i]]M[[i - 1]] + M[[i - 2]]}], {i, 3, Length[x]}]; 
    L/M}]

StellenAnz[n_] := Last[MantissaExponent[N[n]]]

PotenzQ[n_, k_] := TrueQ[IntegerQ[n^(1/k)]]

Primteiler[n_] := 
  Flatten[{t = FactorInteger[n]; Table[t[[i, 1]], {i, 1, Length[t]}]}]