Arithmetic of Large Integers

50!

((50!)/(2^100))

GCD[50!,(2^100)]

FactorInteger[50!]

(2^256)+1

FactorInteger[(2^256)+1]

p=Random[Integer,{1,(10^1000)}]

FactorInteger[p]

PrimeQ[p]

Euclidean Algorithm

Clear[gcd]
gcd[a_,b_]:=gcd[\[LeftBracketingBar]a\[RightBracketingBar],\[LeftBracketingBar]b\[RightBracketingBar]]/;a<0 ||b<0
gcd[a_,b_]:=gcd[b,a]/;a<b
gcd[a_,0]:=a
gcd[a_,b_]:=gcd[b,Mod[a,b]]

gcd[50!,(2^100)]

GCD[50!,(2^100)]

q=Random[Integer,{1,(10^1000)}]

Timing[gcd[p,q]]

Timing[GCD[p,q]]

Extended Euclidean Algorithm

Clear[extendedgcd]
extendedgcd[xx_,y_]:=Module[{x,k,rule,r,q,X},
x[0]=xx;x[1]=y;k=0;rule={};gcdmatrix={};
While[Not[x[k+1]==0],
k=k+1;
r[k]=Mod[x[k-1],x[k]];
q[k]=Quotient[x[k-1],x[k]];
x[k+1]=r[k];
AppendTo[rule,X[k+1]->Collect[X[k-1]-q[k]*X[k]/.rule,{X[0],X[1]}]];
AppendTo[gcdmatrix,{k,"|",x[k-1],"=",q[k],"*",x[k],"+",r[k]}];
];
{x[k],Coefficient[X[k-2]-q[k-1]*X[k-1]/.rule,{X[0],X[1]}]}
]/;IntegerQ[xx]&&IntegerQ[y]

extendedgcd[p,q]

{g,{s,t}}=extendedgcd[50!,(2^100)]

s*50!+t*(2^100)

extendedgcd[Fibonacci[20],Fibonacci[19]]

gcdmatrix

Fermat Test

(2^p)

p

Mod[(2^p),p]

PowerMod[2,p,p]

Timing[result1=PowerMod[2,p-1,p]]

PrimeQ[p]

Fast Powers

Recursive Approach

Clear[powermod]
powermod[a_,0,p_]:=1
powermod[a_,n_,p_]:=Mod[((powermod[a,(n/2),p])^2),p]/;EvenQ[n]
powermod[a_,n_,p_]:=Mod[a*powermod[a,n-1,p],p]/;OddQ[n]
$RecursionLimit=∞;

Timing[result2=powermod[2,p-1,p]]

result1-result2

Iterative Approach

digits=IntegerDigits[p-1,2]

Length[digits]

iterativepowermod[a_,n_,p_]:=Module[{digits,result,power,k},
digits=IntegerDigits[n,2];
result=1;power=a;
Do[If[digits[[Length[digits]-k+1]]==1,result=Mod[result*power,p]];power=Mod[(power^2),p],{k,Length[digits]}];
result
]

Timing[result3=iterativepowermod[2,p-1,p]]

result3-result1

Carmichael Numbers

Clear[NextCarmichael]
NextCarmichael[n_]:=Module[{ready=False,p=n,a},
While[Not[ready],
If[Not[PrimeQ[p]],
list=Table[PowerMod[a,p,p]-a,{a,p-1}];
list=Union[list];
If[list=={0},ready=True,p=p+1],p=p+1]];
p]

(c=NextCarmichael[4])//Timing

FactorInteger[c]

(c=NextCarmichael[c+1])//Timing

FactorInteger[c]

(c=NextCarmichael[c+1])//Timing

FactorInteger[c]

(c=NextCarmichael[c+1])//Timing

FactorInteger[c]

(c=NextCarmichael[c+1])//Timing

FactorInteger[c]

Structure of Carmichael Numbers

Clear[FastNextCarmichael]
FastNextCarmichael[n_]:=Module[{ready=False,p=n},
While[Not[ready],
If[PrimeQ[p],p=p+1,
factors=Transpose[FactorInteger[p]];
If[Not[Union[factors[[2]]]=={1}]||
Not[IntegerQ[(p-1)/Apply[LCM,factors[[1]]-1]]],p=p+1,ready=True]]
];
p
]

(c=FastNextCarmichael[4])//Timing

(c=FastNextCarmichael[c+1])//Timing

(c=FastNextCarmichael[c+1])//Timing

(c=FastNextCarmichael[c+1])//Timing

Diffie-Hellman Key Exchange

Plot[(2^x),{x,0,10}]

ListPlot[Table[{x,(2^x)},{x,0,10}],PlotStyle->PointSize[0.01]]

NextPrime[1000]

ListPlot[Table[{x,PowerMod[2,x,1009]},{x,0,1009}],PlotStyle->PointSize[0.01]]

NextPrime[10000]

ListPlot[Table[{x,PowerMod[2,x,10007]},{x,0,10007}],PlotStyle->PointSize[0.01]]

Modular Inverse

φ=NextPrime[(10^10)]

e=NextPrime[(10^5)]

We search for the Inverse of e modulo φ

d=PowerMod[e,-1,φ]

Test:

Mod[e*d,φ]

The Extended Euclidiean Algorithm yields

{g,{s,t}}=extendedgcd[e,φ]

d==Mod[s,φ]

The RSA Crypto System

Loading auxiliary functions...

Combine[liste_]:=First[liste] /; Length[liste]==1

Combine[liste_]:=1000*Combine[Reverse[Rest[Reverse[liste]]]]+Last[liste]

Convert[string_]:=  Combine[ToCharacterCode[string]]

makelist[zahl_]:={zahl} /; zahl<1000

makelist[zahl_]:=Append[makelist[(zahl-Mod[zahl,1000])/1000],Mod[zahl,1000]
		]

ConvertBack[zahl_]:=FromCharacterCode[makelist[zahl]]

(*
NextPrime[n_]:=n+1/;PrimeQ[n+1]
NextPrime[n_]:=NextPrime[n+1]
*)

EncodeRSA[nachricht_]:=PowerMod[Convert[nachricht],e,m]

DecodeRSA[zahl_]:=ConvertBack[PowerMod[zahl,d,m]]

InitializeRSA:=Module[{},
p=NextPrime[Random[Integer,{(10^199),(10^200)}]];
q=NextPrime[Random[Integer,{(10^199),(10^200)}]];
m=p*q;
φ=(p-1)*(q-1);
e=φ;
While[Not[GCD[φ,e]===1],
e=NextPrime[Random[Integer,{(10^39),(10^40)}]]];
d=PowerMod[e,-1,φ];
]

Clear[ErzeugeISBNPrüfziffer,CheckISBNPrüfziffer];

ErzeugeISBNPrüfziffer[n_]:=Module[{liste},liste=IntegerDigits[n,10];While[Length[liste]<9,PrependTo[liste,0]];
		Mod[Sum[k*liste[[k]],{k,9}],11]]

CheckISBNPrüfziffer[n_]:=Module[{zahl,rest},
		zahl=Mod[n,10];rest=(n-zahl)/10;If[SameQ[ErzeugeISBNPrüfziffer[rest],zahl],"Die ISBN ist o.k.","Die ISBN ist nicht o.k."]]/;NumberQ[n]
	
CheckISBNPrüfziffer[n_*X]:=Module[{zahl,rest},
		zahl=10;rest=n;If[SameQ[ErzeugeISBNPrüfziffer[rest],zahl],"Die ISBN ist o.k.","Die ISBN ist nicht o.k."]]

Clear[Digitalisiere,Verbalisiere,ReedSolomon,InverseReedSolomon]

Digitalisiere[wort_]:=ToCharacterCode[wort]-64

Verbalisiere[liste_]:=FromCharacterCode[liste+64]

Clear[ReedSolomon];
ReedSolomon[wort_,p_]:=Module[{liste,n,a0,a1,a2,a3,k,sol},
liste=Digitalisiere[wort];
n=Length[liste];sol=Solve[{a0+a1+a2+a3+Apply[Plus,liste]==0,
a1+2a2+3a3+Sum[(k+3)*liste[[k]],{k,n}]==0,
a1+4a2+9a3+Sum[(k+3)^2*liste[[k]],{k,n}]==0,
a1+8a2+27a3+Sum[(k+3)^3*liste[[k]],{k,n}]==0,
Modulus==p},{a0,a1,a2,a3}];
liste=Flatten[{{a0,a1,a2,a3},liste}]/.sol[[1]];
Verbalisiere[liste]
	]

Clear[InverseReedSolomon]
InverseReedSolomon[wort_,p_]:=Module[{liste,n,e,s,x,k,i,j,ii,jj,aalpha,bbeta,alpha,beta},
liste=Digitalisiere[wort];
n=Length[liste];
s=Mod[Apply[Plus,liste],p];
t=Mod[Sum[(k-1)*liste[[k]],{k,1,n}],p];
u=Mod[Sum[(k-1)^2*liste[[k]],{k,1,n}],p];
v=Mod[Sum[(k-1)^3*liste[[k]],{k,1,n}],p];
If[Union[{s,t,u,v}]== {0},
Return[StringTake[wort,{5,-1}]],
sol=Solve[{s== alpha+beta,t==i alpha+j beta,u== i^2 alpha+j^2 beta,v== i^3 alpha+j^3 beta,Modulus==p},{alpha,beta,i,j}];
ii=i/.sol[[-1]];
jj=j/.sol[[-1]];
aalpha=alpha/.sol[[-1]];
bbeta=beta/.sol[[-1]];
If[IntegerQ[ii],liste[[ii+1]]=Mod[liste[[ii+1]]-aalpha,p]];
If[IntegerQ[jj],liste[[jj+1]]=Mod[liste[[jj+1]]-bbeta,p]];
liste=Nest[Rest,liste,4];
Verbalisiere[liste]
]
]

Generation of keys...

InitializeRSA

public key

{e,m}

private key

d

encoding with RSA

message="This is my message"

result=EncodeRSA[message]

DecodeRSA[result]

DecodeRSA[result+1]

another message

result=EncodeRSA["What about this message?"]

DecodeRSA[result]

Finally a really message:

<<"C:\\Dokumente und Einstellungen\\koepf\\Eigene Dateien\\Koepf\\Vorträge\\Kamerun2010\\message"

result=EncodeRSA[message]

DecodeRSA[result]

A two-correcting Reed-Solomon Code

These functions generate the necessary redundancy and are able to correct up to two errors.

code=ReedSolomon["MATHEMATICS",31]

InverseReedSolomon[code,31]

code1=StringReplace[code,"H"->"J"]

InverseReedSolomon[code1,31]

code2=StringReplace[code1,"D"->"Z"]

InverseReedSolomon[code2,31]

code3=StringReplace[code2,"E"->"F"]

InverseReedSolomon[code3,31]