0
$\begingroup$

I am trying to run this Multifractal package given in the classical book of Baumann — Mathematica for Theoretical Physics II. The problem is that the code does not work, that is I have no plots. In my idea, this package could help al lot in fractal modeling. Unfortunately, it does not work. The problem is that I didn't find any mistake. I reported the code below. Could you help me?

BeginPackage["MultiFractal`"];
Clear[Dq, Tau, Alpha, MultiFractal];
MultiFractal::usage = "MultiFractal[p_List,r_List] calculates the 
      multifractal spectrum D_q for a model based on the probabilities
      p and the scaling factors r. This function plots five functions
      Tau(q), D_q(q), Alpha(q), f(q) and f(Alpha).";
Begin["Private`"];
(*---calculate the multifractal dimensions---*)
Dq[p_List, r_List] := 
Block[{l1, l2, listrg = {}},(*---length of the lists---*)
l1 = Length[p]; l2 = Length[r];
If[l1 == l2,(*---variation of q and determination of D_q---*)
Do[gl1 = Sum[p[[j]]^q r[[j]]^((q - 1) Dfractal), {j, 1, l1}] - 1;
 result = FindRoot[gl1 == 0, {Dfractal, -3, 3}];
 result = -Dfractal /. result;
 (*---collect the result in a list----*)
 AppendTo[listrg, {q, result}], {q, -10, 10, .101}], Print[" "];
 Print["  Lengths of lists are different!"];
 listrg = {}];
listrg];

(*----calculate Tau---*)
Tau[result_list] := 
Block[{l1, listtau = {}},(*----lengths of the lists---*)
l1 = Length[result];
(*---calcultate Tau---*)
Do[AppendTo[
 listtau, {result[[k, 1]], 
  result[[k, 2]] (1 - result[[k, 1]])}], {k, 1, l1}];
listtau];

(*---Legendre transform---*)
Alpha[result_List] := 
Block[{l1, dq, listalpha = {}, listf = {}, listleg = {}, mlist = {},
 pl1, pl2},(*---lengths of the lists---*)l1 = Length[result];
(*---determine the differential dq---*)
dq = (result[[2, 1]] - result[[1, 1]]) 2;
(*---calculate Alpha by numerical differentiation---*)
Do[AppendTo[
 listalpha, {result[[k, 
   1]], (result[[k + 1, 2]] - result[[k - 1, 2]])/dq}], {k, 2, 
 l1 - 1}];
l1 = Length[listalpha];
(*---calculate f and collect the result in a list---*)
Do[AppendTo[
 listf, {result[[k, 
   1]], -(result[[k, 1]] listalpha[[k, 2]] - result[[k, 2]])}];
listalpha[[k, 2]] = -listalpha[[k, 2]], {k, 1, 12}];
(*---list of the Legendre transforms---*)
Do[AppendTo[listleg, {listalpha[[k, 2]], listf[[k, 2]]}];
 AppendTo[mlist, listf[[k, 2]]], {k, 1, l2}];
(*---plot f and alpha versus q---*)
pl1 = ListLinePlot[listalpha, Joined -> {True, False}, 
 AxesLabel -> {"q", "\[Alpha]"}, Prolog -> Thickness[0.001]];
pl2 = ListLinePlot[listf, Joined -> {True, False}, 
 AxesLabel -> {"q", "f"}, Prolog -> Thickness[0.001]];
Show[{pl1, pl2}, AxesLabel -> {"q", "\[Alpha],f"}];
(*---plot the Legendre transform f versus alpha---*)
ListLinePlot[listleg, AxesLabel -> {"\[Alpha]", "f"}];
(*---print the maximum of f=D_ 0---*)maxi = Max[mlist];
Print[" "];
Print["   D_0 = ", maxi]];

(*---calcultate the multifractal properties---*)
MultiFractal[p_List, r_List] := 
Block[{listDq, listTau},(*---determine D_q---*)listDq = Dq[p, r];
ListLinePlot[listDq, Joined -> {True, False}, 
  AxesLabel -> {"q", "Dq"}, Prolog -> Thickness[0.001]]
 (*---calculate Tau---*) listTau = Tau[listDq];
ListLinePlot[listTau, Joined -> {True, False}, 
 AxesLabel -> {"q", "\[Tau]"}, Prolog -> Thickness[0.001]]
(*---determine the Hoelder exponent---*) Alpha[listTau]];

End[];

EndPackage[];
$\endgroup$
  • $\begingroup$ The "Package" has 4 functions. I suggest that you evaluate each of them independently to identify where things stop working. $\endgroup$ – Jagra Dec 18 '18 at 0:45
  • $\begingroup$ Please ignore previous comment. The "Package" has 4 functions, with MultiFractal calling the other 3. I suggest that you evaluate each of the 3 called functions independently to identify where things stop working. It would also help everyone here to help you, if you provide sufficient test data for for the lists, p and r that one needs to supply to the function MultiFractal so anyone can evaluate what you evaluate. Also, can you supply examples of the output you expect to get? $\endgroup$ – Jagra Dec 18 '18 at 0:52
  • $\begingroup$ While I haven't looked closely at all of the Package, the function Alpha has semicolons ";" after the lines: Show[{pl1, pl2}, AxesLabel -> {"q", "\[Alpha],f"}]; and ListLinePlot[listleg, AxesLabel -> {"\[Alpha]", "f"}]; I think these would stop Alpha from displaying plots. $\endgroup$ – Jagra Dec 18 '18 at 1:10
  • $\begingroup$ Also see: Earlier question $\endgroup$ – Jagra Dec 18 '18 at 1:16
  • $\begingroup$ Dear all, thanks for your several replies. I am able to plot the Dq setting two vectors p and r. In particular I gave p=[1/5,3/5,1/5] and r=[1/2,1/2,1/2]. In my opinion the problem is on the input of Tau and Alpha. I do not understand what vector is. The problem is that "Tau{1/2,1/2,1/2} is not a list". Any idea? $\endgroup$ – Spook82 Dec 18 '18 at 22:33

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.