Mathematica
Clear[A, B, n, k, T, nn]
nn = 100;
Monitor[A =
Table[Table[N[Re[k^ZetaZero[n]], 12], {k, 1, nn}], {n, 1, nn}];, n]
ArrayPlot[A, ImageSize -> Full]
Logarithmic square root waves
Posted in Uncategorized
1 Comment
von Mangoldt function and Riemann zeta zeros
Mathematica
Clear[A, B, n, k, T, nn]
nn = 24;
A = Table[Table[N[Re[k^ZetaZero[n]], 12], {k, 1, nn}], {n, 1, nn}];
MatrixForm[A]
T[n_, k_] :=
T[n, k] =
If[n < 1 || k n, T[k, n],
If[n > k, T[k, Mod[n, k, 1]], -Sum[T[n, i], {i, n - 1}]]]]];
B = Table[Table[T[n, k]/n, {k, 1, nn}], {n, 1, nn}];
MatrixForm[B]
Total[A]
Total[N[B, 10]]
Posted in Uncategorized
Comments Off on von Mangoldt function and Riemann zeta zeros
Mertens function
Mathematica
nn = 1000
Monitor[aa =
Table[Sum[MoebiusMu[k]*Floor[n/k]^(0), {k, 1, n}], {n, 1, nn}];, n]
Monitor[bb =
Table[Sum[MoebiusMu[k]*Floor[n/k]^(1/2), {k, 1, n}], {n, 1, nn}];,
n + 1000]
Monitor[cc = Table[(6/Pi^2)*n^(1/2), {n, 1, nn}];, n + 2000]
ListLinePlot[{aa, bb, -cc, bb + 2*cc - 2*cc[[1]], cc},
ImageSize -> Full]
Print["These are equal:"]
Clear[t];
nn = 12;
rowsumexponent = 1/2;
t[n_, k_] :=
t[n, k] =
If[n = k, t[Floor[n/k], 1]]]]];
MatrixForm[Table[Table[t[n, k], {k, 1, 12}], {n, 1, 12}]];
gg = Table[t[n, 1], {n, 1, 12}];
dd = Table[
Sum[MoebiusMu[k]*Floor[n/k]^(rowsumexponent), {k, 1, n}], {n, 1,
nn}];
MatrixForm[Transpose[{gg, dd, dd - gg}]]
Print["But unfortunately these are not equal:"]
Clear[t];
nn = 12;
rowsumexponent = 1/2;
t[n_, k_] :=
t[n, k] =
If[n = k, t[Floor[n/k], 1]]]]];
MatrixForm[Table[Table[t[n, k], {k, 1, 12}], {n, 1, 12}]];
gg = Table[t[n, 1], {n, 1, 12}];
dd = (6/Pi^2)*
Table[Sum[MoebiusMu[k]*Floor[n/k]^(rowsumexponent), {k, 1, n}], {n,
1, nn}];
MatrixForm[Transpose[{gg, dd, dd - gg}]]
Posted in Uncategorized
Comments Off on Mertens function
Zeta zero spectrum with spikes of similar heights
Mathematica
Clear[f]
scale = 1000000;
f = Range[scale];
f[[1]] = N@MangoldtLambda[1];
Monitor[Do[
f[[i]] = N@MangoldtLambda[i] + f[[i - 1]], {i, 2, scale}], i]
xres = .004;
xlist = Exp[Range[0, Log[scale - 1], xres]];
tmax = 60;
tres = .015;
s = 1/2;
Monitor[errList1 =
Table[(Total[(xlist^(-1/2 + I t)*(f[[Floor[xlist]]] -
xlist))])*(-1/2 + I t), {t, 0, tmax, tres}];, t]
Print["Variant of the Fourier transform of the von Mangoldt function"]
g1 = ListLinePlot[Re[errList1]/Length[xlist], DataRange -> {0, tmax},
PlotRange -> {-.3, 1.3}, Axes -> True, Filling -> Axis];
g2 = Graphics[Line[{{0, 1}, {tmax, 1}}]];
Show[g1, g2, ImageSize -> Large]
Posted in Uncategorized
Comments Off on Zeta zero spectrum with spikes of similar heights
Primes as zeros of polynomials
If the code below doesn’t work this code at Pastebin should work:
Mathematica:
Clear[nn, t, n, k, M, x];
nn = 100;
t[n_, 1] = 1;
t[1, k_] = 1;
t[n_, k_] :=
t[n, k] =
If[n 1, k > 1], x - Sum[t[k - i, n], {i, 1, n - 1}], 0],
If[And[n > 1, k > 1], x - Sum[t[n - i, k], {i, 1, k - 1}], 0]];
M = Table[Table[t[n, k], {k, 1, nn}], {n, 1, nn}];
MatrixForm[M];
Plot[{Log[Det[M]], -Log[-Det[M]]}, {x, 0, nn}, Filling -> Axis,
ImageSize -> Large]
Det[M]
{2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, \
67, 71, 73, 79, 83, 89, 97}
-1863421930771874888093773332480000 \
(128531325300505565894745960580688308974372099421200497637265827559438\
70293633488281250 x^39 –
2330685263101519033233198809849133175771996846016601671526733419271\
70681098298410546875 x^40 +
2056313035804526365475585334709278064828195426812628689049033481854\
586112381843468046875 x^41 –
1176282071573845344602877452001020300880714950288283589185372631383\
3066624521515113890625 x^42 +
4905000734024499696664833528882178331290639767887896665901405607830\
6745240014110059559375 x^43 –
1589371761302150018933790038374660192514118745354272295493103910328\
41906747589444827207500 x^44 +
4165931283662198580801769016212968686473503870625636598822998595394\
34610765052095643685500 x^45 –
9078896923826708550125778634112303749252146500492477711668801612316\
16602142661809542205900 x^46 +
1678144342383082231818092247764138029904145792906833059787377321899\
086975719185511661862600 x^47 –
2670617372253432019724728565759894321133041526935410272332691296354\
449403157830634344730062 x^48 +
3701955046681015256677898368288149581096465045410847548523517763851\
726509324822108523663790 x^49 –
4511198816093594162055201299220594719654079786973187794666832078885\
109535482082426178150298 x^50 +
4868779477170994901165053136487157697400486051278377582782822813608\
424755966095438173927150 x^51 –
4682147134555877773794814354656826970457784804297844863473455413286\
480141678587741633991508 x^52 +
4032062543587948270009807154260865001346806849222738076321674269446\
462419132213132504442260 x^53 –
3122121415128518167146096368172154616034972474420245684465319013394\
806595018152467392257532 x^54 +
2181151852107457973027094328625543369526768776822034362213803544175\
363666859894519638586450 x^55 –
1378636369688362970070147918857505659137119641806760147950411847272\
554459640154629370726685 x^56 +
7901961050440498036384995452268708649601155231691431594450024905586\
00442613068864741536925 x^57 –
4114757332397062339192869466619963169701784549229177005577809815180\
91595733950709464628215 x^58 +
1949454319454895575111076053201305912599159270737618825843195250086\
87087499161325325265025 x^59 –
8412543005411648588185951509306119734464102812016596077997625577506\
5055109296982980823520 x^60 +
3309312236694501086534612449733965242441775821938481399484637258278\
0392153364745056450000 x^61 –
1187329919991294613185354795215040242732861087306876136438924977014\
8584649384566743603080 x^62 +
3886336471236370774115479273169128132055685468643257456137922054706\
168020191349338908400 x^63 –
1160510089917061690749077988219257563973691532927796038812069604394\
578612724163323429860 x^64 +
3160813303753949689427103825792147523671089722844939210960527054970\
69032192780902795300 x^65 –
7848633640984627740444703272367678034446639073942297701096067765852\
0730122719320032140 x^66 +
1775595224742109556609200652821082543923554450769034452535704970034\
2428149535049341700 x^67 –
3656506828102765372736536458851858840712756560181056228401302014777\
802239990541120456 x^68 +
6846837825833178152193893293378314658469990722275192526030986802647\
63666015194546120 x^69 –
1164278647870503078643126094960010094429820380383962567520105825819\
29640334987715224 x^70 +
1795249560789507057771769584731583122144757623291186665535386776362\
6404781415889350 x^71 –
2505936498239667134585125019390672089656977317772283927009636329603\
501009026551589 x^72 +
3160755336306214533526815060559253183465956379512946375782658690394\
25552572604805 x^73 –
3595104553985762377552526415844870095406826478003283786766985827448\
6328430583231 x^74 +
3679485718228405638601224913239487397476409550113386307245500220776\
400624938625 x^75 –
3380721203885104569833143312548607029656558693233736707742576714192\
83793018540 x^76 +
2781715707222874228150276906057731192923790736345435808794572843345\
5143232700 x^77 –
2044471074534013324486140679745468361110609444529044840034752845115\
370342460 x^78 +
1338605505235063898332979704402862180161164510536187422119879832568\
15440600 x^79 –
7786190020601854220912010187624769126805281463858566223233215329151\
597230 x^80 +
4011945036396925253597569095495407292223928417484087622447942654249\
48750 x^81 –
1825806220101512224177692450377783684561414124243294847038620834022\
6170 x^82 +
7316118884283563311076345356139383865567639410335628027659219484903\
50 x^83 –
2572852857313525659475063938913017111091064128667264211005473510794\
0 x^84 + 7912875802489843170611070602464904473578606992019678618764217\
77700 x^85 –
21201615299221853511337960328136709456973154234391017214971495660 \
x^86 + 492769589122601905729494504089945116900958343031880054962466950\
x^87 – 9885583598609559524771431565638672182317197847495799641052707 \
x^88 + 170177552251535200900516303252122207976759798530432292607715 \
x^89 – 2496188124199763708650512408749700269031221473162512891753 \
x^90 + 30927328130861848559154204639122357962577222538024135375 x^91 \
– 320120742971841859237129827569212530968005055259797928 x^92 +
2728884973041339081915263455382563439947495036861560 x^93 –
18795246928633888788577116615408259300443354857712 x^94 +
101840302721019792953400417571639466806960906800 x^95 –
417371413712099062811233049949627582960297600 x^96 +
1214713683680341509046777775829337072800000 x^97 –
2234891933753665252501477478978277120000 x^98 +
1952335327213263997342642816512000000 x^99)
Posted in Uncategorized
Comments Off on Primes as zeros of polynomials
Zeta zeros at Pastebin
1.
In[543]:= Clear[n, s, a];
2.
s = 1/2;
3.
NSum[1/(n + 0)^s – 1/(n + 1)^s – 2/(n + 2)^s – 1/(n + 3)^s +
4.
1/(n + 4)^s + 2/(n + 5)^s, {n, 1, Infinity}, WorkingPrecision -> 400]
5.
N[2.549127729379167407581967029267929878/(Im[ZetaZero[18]]/2), 20]^-1
6.
N[Im[ZetaZero[1]], 20]
7.
N[2.549127729379167407581967029267929878/(Im[ZetaZero[33]]/2), 20]^-1
8.
N[Im[ZetaZero[2]], 20]
9.
N[2.549127729379167407581967029267929878/(Im[ZetaZero[42]]/2), 20]^-1
10.
N[Im[ZetaZero[3]], 20]
11.
12.
During evaluation of In[543]:= NIntegrate::ncvb: NIntegrate failed to converge to prescribed accuracy after 9 recursive bisections in n near {n} = {<>}. NIntegrate obtained -<> and <> for the integral and error estimates. >>
13.
14.
Out[545]= \
15.
-2.5491277293791674075819670292679298788388868361501383611646759945550\
16.
2114281280979141892279032135882066112601786029735792734346777007416385\
17.
1031714272022490694260100601769646158455686154700856477098022672879033\
18.
4388858289379494842246720038280526184788343913638074859695887808089231\
19.
7899988144451825952399138069988923352228536471316749487823829937101794\
20.
3934028300079177278303471836107425673221464057551975
21.
22.
Out[546]= 14.135650568603255663
23.
Out[547]= 14.134725141734693790
24.
Out[548]= 21.020643640006420723
25.
Out[549]= 21.022039638771554993
26.
Out[550]= 25.011827067342131577
27.
Out[551]= 25.010857580145688763
Posted in Uncategorized
Comments Off on Zeta zeros at Pastebin
Piece wise linear regression from two dimensional data – multiple break points
This Matlab program is commented in Swedish. I give no guarantee that it is working
since it is a long time ago since I wrote it.
Matlab:
% programmet indelar mätpunkter i n över k kombinationer av delmängder
% och returnerar den kombination av korrelationer för linjära
% regressionslinjer, som har den minsta standardavvikelsen.
% Dvs. Programmet försöker hitta en kombination av linjer
% som alla passar lika bra på var sitt avsnitt av mätdata.
lines = 4; % antal linjer
gemensamma_punkter = 0; % 1 = gemensamma punkter beaktas, 0 gemensamma punkter beaktas inte
contactangle = [0.44, 71.1747411262677;
0.46, 70.6802138431153;
0.5, 68.7976902726958;
0.56, 65.9770432272691;
0.64, 63.6548931533462;
0.72, 61.3545600435929;
0.8, 59.0775645191162;
1, 58.6705339485564;
1.5, 56.0490010641405;
2, 54.2248928559115;
3, 53.855355702081;
4, 52.4002296826947;
5, 51.6887751091207;
7, 50.2296697722891;
10, 50.2296697722891;
15, 49.8878105268492;
20, 49.8878105268492;
30, 48.4185494511706;
40, 46.9321517393474;
60, 43.9088037168348;
90, 42.0750220508436;
];
%---------------------------------------------------------------------
x_data = contactangle(:,1);
x = contactangle(:,1);
y = contactangle(:,2);
% räkna medelvärde av punkter med identiska x-värden
Y = [];
X = [];
for row = 1:length(x)
index = find(x==x(row));
if index(1,1) == row
Y(row) = mean(y(index));
X(row) = x(row);
else
Y(row)=NaN;
X(row)=NaN;
end
index = [];
end
contactangle = contactangle(find(not(isnan(Y))),:);
% räkna medelvärde av punkter med identiska x-värden, slut
x = contactangle(:,1);
y = contactangle(:,2);
x = x'; % transponering
y = y'; % transponering
%x = [1, 1.5, 2, 3, 4, 5];% 6 stycken mätpunkter x = tiden
%y = [71.79475502, 69.83880402, 69.83880402, 69.83880402, 68.37224497, 68.37224497];% y = kontakt vinkel
k =[];
k = lines - 1; % k = 3-1 motsvarar 3 linjer
n = length(x)-1; % antal mätdata - 1
cmb =[];
kombination = [];
kombination = nchoosek(1:n,k); %listning av kombinationer
cmb = nchoosek(n,k); %antal kombinationer
index = [1:n];
subsets =[];
partitions = [];
partitions(1:cmb,1:n)=0;
counter =0;
for row = 1:cmb
for column = 1:k
counter =counter +1;
for i=1:n
if kombination(row,column)==index(i)
partitions(row,i)=counter;%kombination(row,column); %partitions(row,i)=kombination(row,column);
end
end
end
counter = 0;
end
partitions; % korrekt
presubsets = [];
onescolumn = [];
onescolumn(1:cmb,1)=1;
presubsets = [onescolumn partitions]; %antalet positioner för partitions strecken är ett mindre än antalet mätdata. Därför lägger man till en column med 1 i början.
for row = 1:cmb
for column = 1:length(x)
if and(column==1,presubsets(row,column)>0)
presubsets(row,column)=1;
end
if and(column>1,presubsets(row,column)>0)
presubsets(row,column)=presubsets(row,column)+1;
else
if column>1
presubsets(row,column)=presubsets(row,column-1);
end
end
end
end
subsets = presubsets; %
% summan av delmängderna är talserie A124932 i
% Online Encyclopedia of integer sequences
% http://www.research.att.com/~njas/sequences/A124932
% sum(sum(subsets));
index = [];
cmb;
chosen_subset_combinations=[];
appearances = [];
counter = 0;
% det här hade kanske gått att göra enklare från början
for row = 1:cmb
for line=1:lines
index = find(subsets(row,:)==line);
appearances = [appearances length(index)];
index = [];
end
if min(appearances)>1
counter = counter +1;
chosen_subset_combinations(counter,:)=subsets(row,:); % väljer de kombinationer som vars subset innehåller 2 eller flera punkter
end
appearances = [];
end
chosen_subset_combinations; % valda kombinationer av subsets
subsets = [];
subsets = chosen_subset_combinations;
[m,n]=size(subsets);
index=[];
X = [];
Y = [];
R2 = [];
R = [];
r = [];
%R2(m,n) = 0;
for row = 1:m
for column = 1:lines
index = find(subsets(row,:)==column);
if gemensamma_punkter == 1
% beaktande av gemensamma punkter för subsets, början
first_point = min(index);
last_point = max(index);
if and(first_point==1, last_point1, last_point1, last_point==length(x))
index = [(first_point-1) index];
end
end
end
% beaktande av gemensamma punkter för subsets, slut
end
X = x(index);
Y = y(index);
% p = polyfit(X,Y,1);
% Y_estimate = p(1)*X + p(2);
if std(Y)==0 % om mätdata innehåller konstanta platåer(=linjer) skall r = 1
r=1;
else
R = corrcoef(X,Y);
r = R(1,2);
detect = [];
detect = isnan(r); % Det här vilkoret är kanske litet riskabelt och kanske även onödigt.
if detect == 1
r = 1; % corrcoeff NaN värdena och varningsmeddelandena torde härstamma från de
% konstanta segmentena i mätdata. Detta borde utredas.
% Åtgärdat ovan med vilkoret std(Y)==0
end
end
R2(row,column) = r^2;
end
end
R2;
% summera R2 värdena och se vilken kombination som har det högsta sammanlagda R2 värdet
% alternativt se vilken kombination som har lägsta standard avvikelsen.
% Jag vet inte vilket som är bäst.
s=[]; % målfunktionen s
for row=1:m
% s(row) = var(R2(row,1:lines)); % variansen av linjernas korrelation
s(row) = std(R2(row,1:lines)); % standardavvikelsen av linjernas korrelation
% s(row) = sum(R2(row,1:lines)); % summan av linjernas korrelation
end
s';
[C,I] = min(s); % minimering
%[C,I] = max(s); % maximering
combination_with_lowest_standard_deviation_of_R2_values = chosen_subset_combinations(I,:);
combination_with_lowest_standard_deviation_of_R2_values = combination_with_lowest_standard_deviation_of_R2_values'
R2_values_for_chosen_combination = R2(I,:)
% average_of_R2_values_for_chosen_combination=mean(R2(I,:));
Posted in Uncategorized
Comments Off on Piece wise linear regression from two dimensional data – multiple break points
Series expansion of Riemann zeta function
Mathematica 8:
Series[(1/(a1))^(b)*(Cos[c*Log[1/(a1)]] + I*Sin[c*Log[1/(a1)]]), {c,
0, 6}] +
Series[(1/(a2))^(b)*(Cos[c*Log[1/(a2)]] + I*Sin[c*Log[1/(a2)]]), {c,
0, 6}] +
Series[(1/(a3))^(b)*(Cos[c*Log[1/(a3)]] + I*Sin[c*Log[1/(a3)]]), {c,
0, 6}] +
Series[(1/(a4))^(b)*(Cos[c*Log[1/(a4)]] + I*Sin[c*Log[1/(a4)]]), {c,
0, 6}] +
Series[(1/(a5))^(b)*(Cos[c*Log[1/(a5)]] + I*Sin[c*Log[1/(a5)]]), {c,
0, 6}] +
Series[(1/(a6))^(b)*(Cos[c*Log[1/(a6)]] + I*Sin[c*Log[1/(a6)]]), {c,
0, 6}] +
Series[(1/(a7))^(b)*(Cos[c*Log[1/(a7)]] + I*Sin[c*Log[1/(a7)]]), {c,
0, 6}]
The output is interesting.
Posted in Uncategorized
Comments Off on Series expansion of Riemann zeta function
A Dirichlet series coefficient approach to the Riemann hypothesis
Mathematica 8
Clear[t, A];
nn = 12;
t[n_, 1] = 1;
t[1, k_] = 1;
t[n_, k_] :=
t[n, k] =
If[n 1, k > 1], Sum[-t[k - i, n], {i, 1, n - 1}], 0],
If[And[n > 1, k > 1], Sum[-t[n - i, k], {i, 1, k - 1}], 0]];
A = Table[Table[t[n, k], {k, 1, nn}], {n, 1, nn}];
A[[1, All]] = 0;
Print["A accumulated"]
MatrixForm[A];
MatrixForm[Accumulate[A]]
Print["B"]
B = Table[Table[If[Mod[n, k] == 0, 1 - k, 1], {n, 1, nn}], {k, 1, nn}];
MatrixForm[B];
DD = Table[
MatrixExp[
1/2*Table[
Table[If[Mod[n, k] == 0, B[[i]][[n/k]], 0], {k, 1, nn}], {n, 1,
nn}]][[All, 1]], {i, 1, nn}];
MatrixForm[DD]
Posted in Uncategorized
Comments Off on A Dirichlet series coefficient approach to the Riemann hypothesis
Fourier transform symmetric around the x-axis
Mathematica 8:
Clear[n, d];
Clear[f]
scale = 1000000;
f = ConstantArray[0, scale];
f[[1]] = Sum[d*MoebiusMu@d, {d, Divisors[1]}];
Monitor[Do[
f[[i]] = Sum[d*MoebiusMu@d, {d, Divisors[i]}] + f[[i - 1]], {i, 2,
scale}], i]
xres = .002;
xlist = Exp[Range[0, Log[scale], xres]];
tmax = 60;
tres = .015;
Monitor[errList =
Table[(xlist^(-1/2 + I t).(f[[Floor[xlist]]] - 0*xlist)), {t,
Range[0, tmax, tres]}];, t]
g = ListLinePlot[Im[errList]/Length[xlist], DataRange -> {0, tmax},
PlotRange -> {-5000, 5000}, Frame -> True, Axes -> False];
Show[g]
Posted in Uncategorized
Comments Off on Fourier transform symmetric around the x-axis
The Mobius function Blog 