3D   Box-Counting Fractal Dimension Algorithm

C. Ugwumadu et. al. “Atomistic-To-Continuum Modeling of Carbon Foam: A New Approach to Finite Element Simulation”

An example of our procedure to obtain the 3D box-counting dimension, implemented in Wolfram Mathematica is provided herein. We acknowledge that parts of this algorithm are adopted from Antonio Rueda’s work and others.

Import the stl file and convert to a Graphics3D file. We are using the model denoted as “M3”, which can be found here

SetDirectory[NotebookDirectory[]];
model = Import["M3.stl"]

graphics3DModel = Graphics3D[model, Boxed->False]

Convert Graphic3D to Image3D.

graph3DToimg3D[graphics3dmodel_Graphics3D,qu_]:=Module[{pr,br,slices},pr=PlotRange/. AbsoluteOptions[graphics3dmodel,PlotRange];br=Map[Norm@Differences[#]&,pr];
slices=ParallelMap[Image[Show[graphics3dmodel,ViewPoint->Top,Lighting->{{"Ambient",White}},Background->None,PlotRange->{pr[[1]],pr[[2]],#}]]&,
Partition[FindDivisions[pr[[3]],qu*2],2,1]];Image3D[slices,BoxRatios->br,ColorFunction->Hue]]

image3DModel = graph3DToimg3D[graphics3DModel,50]

boxedModel = EdgeDetect[image3DModel]

Functions for 3D Box-Counting Computation

extractDataFromBoxes[boxedModel_,currentBoxSize_]:=
Map[ImageData,Flatten[ImagePartition[boxedModel,currentBoxSize]]];

boxCounting[boxedmodel_Image3D,initialBoxSize_Integer, maxBoxSize_Integer, boxSizeIncrementStep_Integer]:=
ParallelTable[{1/currentBoxSize,Total[Map[Sign,(Map[Total[#,3]&,
extractDataFromBoxes[boxedModel,currentBoxSize]])]]},{currentBoxSize,initialBoxSize,maxBoxSize,boxSizeIncrementStep}];

iterate the maxBoxSize until convergence in the slope is attained,. Here we set the maxBoxSize to 241.

maxBoxSize = 241;

Perform box counting and fitting of the log-log plot to obtain the 3D box-counting dimension.

logResults = boxCounting[boxedModel,1,maxBoxSize,1]

line=Fit[Log[logResults],{1,x},x]

Here, the  slope  is  the  3 D  box - counting  dimension  (2.53). We provide the associated plot below:

Plot[line,{x,-2,0},Epilog->Point[Log[logResults]], PlotStyle->Black, Frame->True,Axes->True,PlotLabel->Log[1/m], AxesLabel->{Log[N],x},PlotRange->All]