1
$\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$
5
  • 1
    $\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, 2018 at 0:45
  • 1
    $\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, 2018 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, 2018 at 1:10
  • $\begingroup$ Also see: Earlier question $\endgroup$
    – Jagra
    Dec 18, 2018 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, 2018 at 22:33

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Browse other questions tagged or ask your own question.