This question asks about making gravatars in Mathematica, but the accepted answer is just a wrapper around the gravatar.com service.
Is there an open source Mathematica engine that performs the actual hash to graphics?
$\begingroup$ $\endgroup$
Add a comment |
1 Answer
$\begingroup$ $\endgroup$
1 While I don't know the exact details on how Gravatar generates identicons, the following might give you a something suitable.
Generally speaking, identicons are generated by hashing the user data and then creating a graphic based on the hash. A common technique is to cycle through and turn pixels on or off based on whether the value of a digit in the hash is even or odd. Here the color is also based on the values in the hash, and also I imposed a certain kind of symmetry based on the hash as well. (I am quite sure this code can be made more aesthetically pleasing):
identiconPixels[id_String] := Module[{hash, color, orient, cells, tm, q}, hash = IntegerDigits[Hash[id, "MD5"], 8, 36]; color = RGBColor[hash[[1 ;; 3]]/7]; orient = If[OddQ[hash[[4]]], {Left, Bottom}, {Bottom, Left}]; cells = MapIndexed[If[OddQ[#1], color, White] &, Partition[hash, 6], {2}]; q = Image[cells]; Magnify[ ImageAssemble[{{q, ImageReflect[q, orient[[1]]]}, {ImageReflect[q, orient[[2]]], ImageReflect[ImageReflect[q, Top], Left]}}], 4] ] The Magnification here is to make the identicon larger to see the details.
identiconPixels["[email protected]"] 
identiconPixels["[email protected]"] 
The same idea can generate avatars that are bit more visually interesting if instead of using pixels we use cells in a mesh:
identiconCells[id_String, size_] := Module[{hash, color, orient, cells, tm, q}, hash = IntegerDigits[Hash[id, "MD5"], 8, 36]; color = RGBColor[hash[[1 ;; 3]]/7]; orient = If[OddQ[hash[[4]]], {ReflectionMatrix[{1, 0}], ReflectionMatrix[{0, 1}]}, {RotationTransform[Pi/2], RotationTransform[3 Pi/2]}]; cells = MapIndexed[If[OddQ[#1], {2, #2[[1]]}, Nothing] &, hash]; tm = TriangulateMesh[ BoundaryMeshRegion[{{0, 0}, {1, 0}, {1, 1}, {0, 1}}, Line[{1, 2, 3, 4, 1}]], MaxCellMeasure -> 1/26, MeshQualityGoal -> 1]; q = MeshPrimitives[tm, cells]; Graphics[{color, EdgeForm[color], q, Translate[GeometricTransformation[q, orient[[1]]], {2, 0}], Translate[ GeometricTransformation[q, RotationTransform[Pi]], {2, 0}], Translate[GeometricTransformation[q, orient[[2]]], {0, 0}]}, ImageSize -> size] ] There is a bit of a 'magic' number with MaxCellMeasure which yields a square broken in 36 cells.
identiconCells["[email protected]",128] 
identiconCells["[email protected]", 64] 
- $\begingroup$ Chuy, this is great thanks. Before accepting, two requests: 1, is there a way to avoid rasterizing in
identiconCells- on my system the diagonals look ragged. 2 Can you explicitly parametrize identicon size? $\endgroup$alancalvitti– alancalvitti2016-05-02 20:42:24 +00:00Commented May 2, 2016 at 20:42