# Playing with Gilpin's Proposal for Advection-based Cryptographic Hashing

Posted 3 years ago
6371 Views
|
3 Replies
|
25 Total Likes
| ## Introduction

Last week, William Gilpin published a fascinating paper suggesting a physics-based hashing mechanism in the Proceedings of the National Society: Cryptographic hashing using chaotic hydrodynamics: https://doi.org/10.1073/pnas.1721852115

The paper discusses a hashing algorithm based on fluid mechanics: Particles are distributed in a 2D disk. The inside of the disk is filled with an idealized fluid and the fluid is now stirred with a single stirrer. The stirring process is modelled with two possible stirrer positions. A message (say made from 0s and 1s) can now be encoded through which of the two stirrer positions is active. If the bit from the message is 1, use stirrer position 1, if the bit of the message is 0, use stirrer position 2. After some bites are processed, and the fluid is stirred, this process mixes the particles. Dropping some of the information content of the actual particle positions, e.g. by taking only the x-positions of the particle positions allows to build a hash by using the particle indices after sorting the particles along the x-axis.

The Methods section of the paper mentions that all calculations were carried out using Mathematica 11.0. Unfortunately no notebook supplement was given. So, playing around with ideas of the paper, I re-implemented some of the computations of the paper.

The paper is behind a paywall, but fortunately the author's website has a downloadable copy of the paper here.

The potential importance of physics-based models for hashing, and so for cryptocurrencies was pointed out at various sites (e.g. Stanford News, btcmanager).

It is fun to play around with the model.

## The chaotic advection model model

This classic model goes back to Hassan Aref (whom I was fortunate to know personally) from his 1984 paper Stirring by chaotic advection.

The Hamiltonian for the movement of a particle with coordinates {?,?} in a circle of radius a under the influence of agitating vortex at {x,y} (possibly time-dependent) of strength ? and its mirror vortex.

    H[{?_, ?_}, {x_, y_}] =
?/(2 ?) Log[ComplexExpand[ Abs[((? + I ?) - (x + I y))/((? + I ?) - a^2/( x - I y))]] ] The resulting equations of motion:

odes = {?'[t] == -D[H[{?[t], ?[t]}, {x[t], y[t]}], ?[t]],
?'[ t] == +D[H[{?[t], ?[t]}, {x[t], y[t]}], ?[t]]} // Simplify Solve the equations of motion for randomly selected parameters and plot the particle trajectory. For a position-independent and time-independent vortex, the particle moves in a circle.

nds = NDSolveValue[{
Block[{a = 1, ? = 1, x = 0.5 &, y = 0 &}, odes],
? == 0.3, ? == -0.4}, {?[t], ?[t]}, {t, 0, 10}] ParametricPlot[Evaluate[nds], {t, 0, 10}] Here the vortex moves around in a periodic manner. The resulting particle trajectory has a high degree of symmetry.

nds2 = NDSolveValue[{
Block[{a = 1, ? = 1, x = 0.8 Cos[2 Pi #/200] &, y = 0.8 Sin[2 Pi #/200] &}, odes],
? == 0.3, ? == -0.4}, {?[t], ?[t]}, {t, 0, 400}] ParametricPlot[Evaluate[nds2], {t, 0, 400}, PlotPoints -> 400] Letting the vortex move along a random curve results in a chaotic movement of the particle. We color the particle's trajectory with time.

(* vortex movement curve *)
randomCurve = BSplineFunction[RandomPoint[Disk[], {100}]];

X[t_Real] := randomCurve[t/100][]
Y[t_Real] := randomCurve[t/100][]

nds2 = NDSolveValue[{
Block[{a = 1, ? = 10, x = X, y = Y}, odes],
? == 0.3, ? == -0.4}, {?[t], ?[t]}, {t, 0, 100}] ParametricPlot[Evaluate[nds2], {t, 0, 100}, PlotPoints -> 1000,
ColorFunction -> Function[{x, y, u}, ColorData["DarkRainbow"][u]]] Having two possible positions of the vortex and switching periodically between them results in a particle trajectory that is made of piecewise circle arcs.

nds2 = NDSolveValue[{
Block[{a = 1, ? = 10, x = Sign[Sin[Pi #]]/2 &, y = 0 &}, odes],
? == 2/3, ? == 0}, {?[t], ?[t]}, {t, 0, 100}];

ParametricPlot[Evaluate[nds2], {t, 0, 100}, PlotPoints -> 1000,
ColorFunction -> Function[{x, y, u}, ColorData["DarkRainbow"][u]]] Using initially 4320 points on a circle shows how the initial circle gets stretched and ripped apart and the points distribute chaotically over the disk.

nds2 = NDSolveValue[{
Block[{a = 1, ? = 10, x = Sign[Sin[Pi #]]/2 &, y = 0 &}, odes],
? == Table[2/3 Cos[?], {?, 0, 2 Pi, 2 Pi/(12 360)}],
? == Table[2/3 Sin[?], {?, 0, 2 Pi, 2 Pi/(12 360)}]},
{?[t], ?[t]}, {t, 0, 2}];

GraphicsGrid[
Partition[Graphics[{LightGray, Disk[], Black, PointSize[0.005],
Point[Transpose[nds2 /. t -> #]]}, ImageSize -> 120] & /@Range[0, 2, 2/19] , 5]] With time running upwards, here is a 3D image of this stirring process. The transition from using the right stirrer to using the left stirrer at time 1 is clearly visible.

trajectories3D =
Transpose[Table[ Append[#, N[?]] & /@ Transpose[nds2 /. t -> ?], {?, 0, 2, 2/100}]];

Graphics3D[{Thickness[0.001], Opacity[0.2],
BSplineCurve /@ RandomSample[trajectories3D, 1600]},
PlotRange -> All, Axes -> True, BoxRatios -> {1, 1, 2}] Here is the corresponding interactive demonstration.

Manipulate[
Graphics[{LightGray, Disk[], Black, PointSize[0.005], Point[Transpose[nds2 /. t -> ?]]}],
{?, 0, 2, Appearance -> "Labeled"}] The x-position of the particles will be used later. Here is a plot of the x-positions of 540 points initially on a circle over time.One observes many crossing of these x-trajectories.

nds2B = NDSolveValue[{
Block[{a = 1, ? = 4, x = Sign[Sin[Pi #]]/2 &, y = 0 &}, odes],
? == Table[2/3 Cos[?], {?, 0, 2 Pi, 2 Pi/540}],
? == Table[2/3 Sin[?], {?, 0, 2 Pi, 2 Pi/540}]},
{?[t], ?[t]}, {t, 0, 12}];

ListLinePlot[Transpose[Table[{t, #} & /@ nds2B[], {t, 0., 4, 4/200}] ],
PlotStyle -> Table[Directive[Opacity[0.4], Thickness[0.001], ColorData["DarkRainbow"][j/541]], {j, 541}],
Frame -> True, Axes -> False, FrameLabel -> {t, x}] Using a Dynamic[particleGraphics] we can easily model many more particles in real time without having to store large interpolating functions. We solve the the equations of motion over small time increments and the graphic updates dynamically.

rPoints = Select[Flatten[Table[N[{x, y}], {x, -1, 1, 2/101}, {y, -1, 1, 2/101}], 1], Norm[#] < 1 &];

Dynamic[Graphics[{LightGray, Disk[], Black, PointSize[0.001], Point[rPoints]}]] rhs?[X_, ?_List, ?_List] := With[{ ? = 5}, -(((1 - X^2) ? ? (1 + X^2 - 2 X ?))/(2 ? (X^2 + ?^2 - 2 X ? + ?^2) (1 - 2 X ? + X^2 (?^2 + ?^2))))]
rhs?[X_, ?_List, ?_List] := With[{ ? =  5}, -(((1 - X^2) ? (-? - X^2 ? +  X (1 - ?^2 + ?^2)))/(2 ? (X^2 + ?^2 - 2 X ? + ?^2) (1 - 2 X ? + X^2 (?^2 + ?^2))))]

With[{?t = 10^-2, T = 0.2},
Monitor[
Do[
nds = NDSolveValue[
Block[{ X = Evaluate[1/2 Sign[Sin[Pi (k + 1/2) ?t/T]]] &},
{?'[t] == rhs?[t, ?[t], ?[t]], ?'[t] == rhs?[t, ?[t], ?[t]],
?[k ?t] == Transpose[rPoints][],
?[k ?t] == Transpose[rPoints][]}],
{?[t], ?[t]}, {t, (k + 1) ?t, (k + 1) ?t}] /. t -> (k + 1) ?t;
rPoints = Transpose[nds],
{k, 0, 200}], k]]


Switching irregularly between the two stirrer positions gives qualitatively similar-looking trajectories. We use a sum of three trig functions see here for a detailed account on this type of function).

(* left or right stirrer is on *)
Plot[Sign[Sin[Pi t] + Sin[Pi Sqrt t] + Sin[Pi Sqrt t]], {t, 0, 100}, Exclusions -> None] nds3 = NDSolveValue[{
Block[{a = 1, ? = 10,
x = Sign[Sin[Pi #] + Sin[Pi Sqrt #] + Sin[Pi Sqrt #]]/2 &,
y = 0 &}, odes],    ? == 2/3, ? == 0}, {?[t], ?[t]}, {t, 0, 100}];

ParametricPlot[Evaluate[nds3], {t, 0, 100}, PlotPoints -> 1000,
ColorFunction -> Function[{x, y, u}, ColorData["DarkRainbow"][u]]] We can also change the stirring direction.

nds3B = NDSolveValue[{
Block[{a = 1, ? = 10 Sign[Sin[Pi t] + Sin[Pi Sqrt t] + Sin[Pi Sqrt t]],
x = Sign[Sin[Pi #] + Sin[Pi Sqrt #] + Sin[Pi Sqrt #]]/2 &,
y = 0 &}, odes],    ? == 2/3, ? == 0}, {?[t], ?[
t]}, {t, 0, 100}];

ParametricPlot[Evaluate[nds3B], {t, 0, 100}, PlotPoints -> 1000,
ColorFunction -> Function[{x, y, u}, ColorData["DarkRainbow"][u]]] Here are three stirrer positions at the vertices of an equilateral triangle.

st3[t_] = Piecewise[
With[{r = RandomInteger[{0, 2}]}, {1/2. {Cos[2 Pi r/3], Sin[2 Pi r/3]}, #[] <= t <= #[] }] & /@
Partition[FoldList[Plus, 0, RandomReal[{0, 1}, 300]], 2, 1]];

x3[t_Real] := st3[t][]
y3[t_Real] := st3[t][]

nds3 = NDSolveValue[{ Block[{a = 1, ? = 5, x = x3, y = y3}, odes], ? == 1/3, ? == 0}, {?[t], ?[t]}, {t, 0, 100}] ParametricPlot[Evaluate[nds3], {t, 0, 100}, PlotPoints -> 1000,
ColorFunction -> Function[{x, y, u}, ColorData["DarkRainbow"][u]]] ## Side note: the linked twist map

Mathematically, alternating left and right use of the stirrer, is isomorphic to a so-called linked twist map. The following implements a simple realization of a linked twist map from Cairns /Kolganova. https://doi.org/10.1088/0951-7715/9/4/011

Clear[g, h, f];
g[{x_, y_}] := {x, Mod[Piecewise[{{y + 4 x, Abs[x] <= 1/4}}, y], 1, -1/2]}
h[{x_, y_}] := {Mod[Piecewise[{{x + 4 y, Abs[y] <= 1/4}}, x], 1, -1/2], y}
f[{x_, y_}] := g[h[{x, y}]]

f[{x, y}] In explicit piecewise form, the map is more complicated. (To fit it, we use a reduce size.)

(f2 = PiecewiseExpand[# , -1/2 < x < 1/2 && -1/2 < y < 1/2] & /@ f[{x, y}]) Here are the first and second component visualized.

{ContourPlot[Evaluate[f2[]], {x, -1/2, 1/2} , {y, -1/2, 1/2},
Exclusions -> {}, PlotPoints -> 60],
ContourPlot[Evaluate[f2[]], {x, -1/2, 1/2} , {y, -1/2, 1/2},
Exclusions -> {}, PlotPoints -> 60]} Applying the linked twist map to a set of points inside a square hints at the ergodic nature of the map.

ptsRG = With[{pp = 80}, Table[{RGBColor[x + 1/2, y + 1/2, 0.5], Point[{x, y}]}, {y, -1/2, 1/2, 1/pp}, {x, -1/2, 1/2, 1/pp}]];

Graphics /@ NestList[Function[p, p /. Point[xy_] :> Point[f@xy]], ptsRG, 3] ## Closed form mapping

As mentioned, for a fixed stirrer position, a particle moves along a circle. This means that to move the particle to its final position, we don't have to solve nonlinear differential equations, but rather can calculate the final position through algebraic computations which are unfortunately not fully explicit. Doing the calculations (see Aref's paper for details) shows that we will have to solve of transcendental equation.

In the following we will use a unit disk of radius 1 and a unit strength vortex. The particle is initially at {r,?} (in polar coordinates) and the stirrer is at {±b,0}.

a = 1;
? = 1;


The circle the particle is moving on.

circle[{r_, ?_}, b_] :=
Module[{?, ?c, ?},
? = Sqrt[(b^2 + r^2 - 2 b r Cos[?])/(a^4/b^2 + r^2 - 2 a^2 r Cos[?]/b)];
?c = (b - ?^2 a^2/b)/(1 - ?^2);
? = Abs[?/(1 - ?^2) (a^2/b - b)];
Circle[{?c, 0}, ?]]


The period for one revolution on the circle.

period[{r_, ?_}, b_, T_] :=
Module[{?, ?, T?},
? = Sqrt[(b^2 + r^2 - 2 b r Cos[?])/(a^4/b^2 + r^2 - 2 a^2 r Cos[?]/b)];
? = Abs[?/(1 - ?^2) (a^2/b - b)];
T? = (2 Pi)^2 ?^2/? (1 + ?^2)/(1 - \?^2) ]


The final position after rotating for time T.

rotate[{r_, ?_}, b_, T_, opts___] :=
Module[{(*?,?c,?,?p,T?,eq,fr*)},
? = Sqrt[(b^2 + r^2 - 2 b r Cos[?])/(a^4/b^2 + r^2 - 2 a^2 r Cos[?]/b)];
?c = (b - ?^2 a^2/b)/(1 - ?^2);
? = Abs[?/(1 - ?^2) (a^2/b - b)];
?p = ArcTan[r Cos[?] - ?c, r Sin[?]];
T? = (2 Pi)^2 ?^2/? (1 + ?^2)/(1 - \?^2);
(* the implicit equation to be solved numerically for ?t *)

eq = ?t - 2 ?/(1 + ?^2) Sin[?t] == ?p - 2 ?/(1 + ?^2) Sin[?p] + 2 Pi T/T?;
fr = FindRoot[eq, {?t, ?p}, opts] // Quiet;  (* could use Solve[eq, ?t, Reals] *)
{Sqrt[?^2 + ?c^2 + 2 ? ?c Cos[?t]],
ArcTan[? Cos[?t] + ?c, ? Sin[?t]]} /. fr]


A high-precision version for later use.

 rotateHP[{r_, ?_}, b_, T_ ] :=
With[{prec = Precision[{r, ?}]},
rotate[{r, ?}, b, T, WorkingPrecision -> Min[prec, 200] - 1,  PrecisionGoal -> prec - 10]]

rotateHP[{2/5, 1}, 1/2, 10^-10]

{0.3999999999735895736749310453217879335729586969724148186668989989685300449569453838180010833652353802304511654926113687832716502416432363896855780225351918314742068365263060199921670958293439964299441,
1.000000000034865509829422032384759003150106866109371061507406908121303212377635808764825759934117372434662086592066738925787825280696681907390281734196810440241159138906978471624124765879791828431390}


Also for later use, rotate many points at once.

rotate[l : {_List ..}, b_, T_ ] := rotate[#, b, T] & /@ l

rotateHP[l : {_List ..}, b_, T_ ] := rotateHP[#, b, T] & /@ l


The locator is the initial particle position; the stirrer position is the purple point. We show the circle and the final particle position (gray point).

Manipulate[
Graphics[{LightGray, Disk[],
Purple, PointSize[0.02], Point[{b, 0}] ,
Gray, circle[ToPolarCoordinates[p], b] ,
PointSize[0.01],
Point[p], Blue ,
Point[ FromPolarCoordinates[ rotate @@ SetPrecision[ {ToPolarCoordinates[p], b, T}, 200] ]]}],
{{T, 0.2}, 0.001, 10},
{{b, 0.5}, -0.999, 0.999},
{{p, {0.3, 0.4}}, Locator}] Here is a plot of the period for one revolution as a function of the initial position of the particle. The period can get quite large when points are near the boundary of the disk

ParametricPlot3D[{r Cos[?], r Sin[?], period[{r, ?}, 1/2, 1]},
{r, 0, 1}, {?, -Pi, Pi}, BoxRatios -> {1, 1, 0.3},
PlotPoints -> 40, MeshFunctions -> {#3 &}] For the stirrer located at {0.5,0}, here are the possible circles that the particle will move on.

Graphics[Table[circle[{r, ?}, 1/2.] , {r, 1/10, 9/10, 1/10}, {?, -Pi, Pi, 2 Pi/20}]] We use the closed form of the stirring map to visualize the flow. Here are about 20k points in stripes in the unit disk.

stripePoints = Select[RandomPoint[Disk[], 40000], Function[xy, Mod[xy[], 0.2] < 0.1]];

Graphics[{PointSize[0.002], Point[stripePoints]}] We repeatedly stir with the left and then the right stirrer on for time 1.

swirled = rotate[ToPolarCoordinates[stripePoints], 0.5, 1];

Graphics[{PointSize[0.002], Point[FromPolarCoordinates[swirled]]}] swirled = rotate[swirled, -0.5, 1];

Graphics[{PointSize[0.002], Point[FromPolarCoordinates[swirled]]}] swirled = rotate[swirled, 0.5, 1];

Graphics[{PointSize[0.002], Point[FromPolarCoordinates[swirled]]}] swirled = rotate[swirled, -0.5, 1];

Graphics[{PointSize[0.002], Point[FromPolarCoordinates[swirled]]}] ## Now stir and make hashes

We now use two different initial positions of the points: a sunflower-like one and a random one.

randominitialPositions[n_, prec_] :=
SortBy[Table[ReIm[RandomReal[{0, 1}, WorkingPrecision -> prec] *
Exp[ I RandomReal[{-Pi, Pi}, WorkingPrecision -> prec]]], {n}], First]

SeedRandom;
initialPositionsR = randominitialPositions[100, 250];

Graphics[{LightGray, Disk[],
MapIndexed[Function[{p, pos},
{Red, PointSize[0.002], Point[p], Black, Text[pos[], p]}],
N[initialPositionsR]]}] sunflower[n_, R_, prec_] :=
Table[FromPolarCoordinates[ N[{Sqrt[j/n] R, Mod[2 Pi (1 - 1/GoldenRatio) j, 2 Pi, -Pi]}, prec]], {j, n}]

Graphics[{LightGray, Disk[], Black, Point[sunflower[1000, 0.9, 20]]}] The message to encode we will tell in the form of a sequence of 0s and 1s. A zero means use the left stirrer position and a 1 means use the right stirrer position. So, we define a stirring process with a given message ? and fixed b and T as follows:

stirringProcess[initialPositions_, bAbs_, T_, ?_List] :=
FromPolarCoordinates /@
FoldList[rotateHP[#1, #2 bAbs, T] &, ToPolarCoordinates /@ initialPositions, 2 ? - 1]


Here is a simple message:

message1 = RandomInteger[{0, 1}, 50]

{1, 1, 0, 0, 0, 0, 0, 1, 1, 1, 0, 1, 1, 0, 1, 1, 0, 0, 1, 1, 0, 1, 0, 0, 1,
1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1,1, 0, 1, 0}


Now we carry out the corresponding stirring process. (We arbitrarily use b=1/2 and T=1/10.)

sP1 = stirringProcess[initialPositionsR, 1/2, 1/10, message1];


To get a feeling for the stirring process, we connect successive positions of each particle with a randomly colored spline interpolation. (Note that the spline interpolation does not exactly represent the particle's trajectory.)

Graphics[{LightGray, Disk[], Thickness[0.001],
Map[Function[c, {RandomColor[], BSplineCurve[c, SplineDegree -> 5]}],
Transpose[N[Table[sP1[[j]], {j, 50}]]]]}] Now, can we trust these results? We can check by running the stirring process (numerically) backwards.

sP1Rev = stirringProcess[sP1[[-1]], 1/2, -1/10, Reverse[message1]];


The so-recovered initial positions agree to at least 80 digits with the original point positions.

sP1Rev[[-1]] - initialPositionsR // Abs // Max // Accuracy

86.9777


As mentioned earlier, we define the hashes as the positions of the particles when ordered according to their x-values. So, for a given particle configurations, this is the hash-making function.

makeHash[l_] := Sort[ MapIndexed[{#1, #2[]} &, l]][[All, 2]]


Because the hashes are permutations of the particle numberings, the number of hashes grows factorially with the particle number and 58 particles could model a 256 bit hash and 99 particles a 512 bit hash.

{2^256, {57!, 58!}} // N

{1.15792*10^77, {4.05269*10^76, 2.35056*10^78}}

{2^512, {98!, 99!}} // N

{1.34078*10^154, {9.42689*10^153, 9.33262*10^155}}

hashes1 = makeHash /@ sP1;


Here is a visualization how the hashes evolve with each stir. The coloring is from blue (1) to 100 (red) of the initial particle numbering.

ArrayPlot[hashes1, ColorFunction -> ColorData["DarkRainbow"], PlotRange -> {1, 100}] This is how the edit distance of the hashes increases with successive stirrings.

ListPlot[Table[{j, EditDistance[hashes1[], hashes1[[j]]]}, {j, 1, 50}],  Filling -> Axis] Gilpin defines the rearrangement index of a hash as the sum of the absolute difference between neighboring particle indices.

rearrangementIndex[indexList_] := Total[Abs[Differences[indexList]]]


Here is the growth rate of the rearrangement index for our just-calculated hashes.

ListPlot[Table[{j, rearrangementIndex[hashes1[[j]]]}, {j, 1, 50}], Filling -> Axis] Let's make a second message that has one bit flipped, say at position 10.

message2 = MapAt[1 - # &, message1, 10]

{1, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1, 0, 1, 1, 0, 0, 1, 1, 0, 1, 0,
0, 1,  1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 0}

message1 - message2

{0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}


The resulting particle movements look quite different.

sP2 = stirringProcess[initialPositionsR, 1/2, 1/10, message2];

Graphics[{LightGray, Disk[], Thickness[0.001],
Map[Function[c, {RandomColor[], BSplineCurve[c, SplineDegree -> 5]}],
Transpose[N[Table[sP2[[j]], {j, 50}]]]]}] The edit distances between the two hash sequences increase quickly after the different bit is encountered.

hashes2 = makeHash /@ sP2;

ListPlot[Table[{j, EditDistance[hashes1[[j]], hashes2[[j]]]}, {j, 0, 50}], Filling -> Axis] Gilpin carried out many numerical experiments investigating how the hashes behave as a function of the hash length (number of particles), stirring time T, and message length.

The next two examples change only the stirring time, and keep all other parameters: message, stirrer distance, initial particle distance.

sP1B = stirringProcess[initialPositionsR, 1/2, 1/9, message1];

hashes1B = makeHash /@ sP1B;

ListPlot[Table[{j, EditDistance[hashes1[[j]], hashes1B[[j]]]}, {j, 0, 50}], Filling -> Axis] With increasing stirring time, the edit distance between the hashes quickly increases.

sP1C = stirringProcess[initialPositionsR, 1/2, 1/2, message1];

hashes1C = makeHash /@ sP1C;

ListPlot[Table[{j, EditDistance[hashes1[[j]], hashes1C[[j]]]}, {j, 0, 50}], Filling -> Axis] Next, we use the phyllotaxis-like initial position from above with 200 particles. We also use a longer stirring time (T=1).

message3 = RandomInteger[{0, 1}, 50]

{0, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0, 0, 1, 1, 1, 0, 1, 1, 1, 1, 0, 0, 0, 1, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0,1, 0, 1, 0}

sP3 = stirringProcess[sunflower[200, 9/10, 250], 1/2, 1, message3];


A plot of the 200 particle trajectories suggests a good mixing.

Graphics[{LightGray, Disk[], Thickness[0.001],
Map[Function[c, {RandomColor[], BSplineCurve[c, SplineDegree -> 5]}],
Transpose[N[Table[sP3[[j]], {j, 50}]]]]}] Already after the first stir, the edit distance between the original hash and the one resulting after stirring is quite large.

hashes3 = makeHash /@ sP3;

ListPlot[Table[{j, EditDistance[hashes3[], hashes3[[j]]]}, {j, 0, 50}], Filling -> Axis] We will end here. The interested reader can continue to model, stir a million times, count trajectory exchanges, and statistically analyze other aspects of the proposed hashing scheme from Gilpin's paper.

PS: And one can compare with theoretical hashing probabilities for ideal hashes. Such as: draw [ScriptCapitalN]s hashes from M! possible hashes. How many different hashes Subscript[[ScriptCapitalN], U] does one draw in average?

uniqueHashes[M_, \[ScriptCapitalN]s_] :=
M! (1 - (1 - 1/M!)^\[ScriptCapitalN]s)

Plot3D[uniqueHashes[M, \[ScriptCapitalN]s], {M, 1, 60}, {\[ScriptCapitalN]s, 1, 1000}, MeshFunctions -> {#3 &},
PlotPoints -> 100, ScalingFunctions -> "Log", PlotRange -> All,
WorkingPrecision -> 50,
AxesLabel -> {Style["M", Italic], Style["\[ScriptCapitalN]s", Italic], Style["\!$$\*SubscriptBox[\(\[ScriptCapitalN]$$, $$U$$]\)", Italic]}] For Ns?M!, this becomes:

Series[Mfac (1 - (1 -  1/Mfac)^\[ScriptCapitalN]s), {Mfac, ?, 2}] /. Mfac -> M! // Simplify uniqueHashesApprox[ M_, \[ScriptCapitalN]s_] := \[ScriptCapitalN]s - (( \\[ScriptCapitalN]s (\[ScriptCapitalN]s - 1))/( 2 M!))
+ ((\[ScriptCapitalN]s (\[ScriptCapitalN]s - 1) (\[ScriptCapitalN]s - 2))/(6 (M!)^2))


Here is a quick numerical modeling with a sample size of 100 from 6!=720 possible hashes.

With[{M = 6, \[ScriptCapitalN]s = 100},
{Table[Length[
Tally[RandomChoice[Range[M!], \[ScriptCapitalN]s]]], {10000}] // Mean,
uniqueHashes[M, \[ScriptCapitalN]s],
uniqueHashesApprox[M, \[ScriptCapitalN]s]}] // N

{93.407, 93.4267, 93.4369}


I definitely suggest reading the whole paper, including the Supplementary Information.

The notebook with all the code and visualizations is attached. Answer
3 Replies
Sort By:
Posted 3 years ago - Congratulations! This post is now a Staff Pick as distinguished by a badge on your profile! Thank you, keep it coming! Answer
Posted 3 years ago
 Very nice article, as always. However, there are a number of typographical issues with missing parentheses and script letters not being formatted in the text (as well as in the code), which is quite distracting. The use of code with script letters, which I too use often, always looks crappy in HTML.On a more technical note, while Ive not yet read Gilpins paper, it immediately occurred to me that one could use the Lorenz model to achieve the same outcomeand a quick search shows a number of papers recently published on this idea (e.g. Google hashing using lorenz equations). And even simpler, one could use the logistic map, for which there are also many papers. So, I guess it would be helpful to readers to know why Gilpins proposal is advantageous. Answer
Posted 3 years ago
 @ PaulI didn't mean to write a review of the paper, but rather to implement in Wolfram Language the main ingredients of the steps used to run the large simulations from the paper.Yes, there are quite a few papers that deal with hash generation through chaotic maps of the one or another flavor (discrete and continuous, including CAs). My reading of the paper is that this is the most physical version so far. Maybe even with the prospect of building a physical device that spits out hashes for certain kind of input (protocols). And the reverse question: what is the most natural representation of a hash in a physical system? Chaotic systems surely can be used to generate hashes because they quickly change and they are hard to invert. But maybe there is even a quantum version for a fully linear evolution? Partial traces seem perfect to reduce information. If say the message is encoded in a quasi-periodic driving force (similar to the stirring protocol), could time crystals be used for hash generation? Or in the periodicity of some external field (Harper equation).Some of the advantages of the system is the early-time hyperuniform hash distribution.Wrt the script letters. Imo the use of the same variables as original literature makes comparing the two easier. That is why I used them. Answer