Colorize $3D$ "random walk" of $\pi$ digits

Question

The following graphic is a 3D "random walk" of $\pi$ digits by converting them in base $6$ representing $6$ directions :

Manipulate[d = N[Pi, n];
walk = First@RealDigits[d, 6]; 
coord = FoldList[Plus, {0, 0, 0}, {{0, 1, 0}, {1, 0, 0}, {0, -1, 0}, {-1, 0,0}, {0, 0, 1}, 
{0, 0, -1}}[[# + 1]] & /@ walk]; 

Graphics3D[{Line[coord], PointSize[Large], Green, Point[First@coord], Red, 
Point[Last@coord]}, ImageSize -> 400], {n, 1, 100000, 1}]

There is a $257019$ lines (First@RealDigits[N[Pi, 200000], 6] // Length)

and I want to colorize each direction by six color

colors = {Red, Blue, Green, Cyan, Yellow, Purple}

J. M.'s missing motivation · Accepted Answer · 2017-03-18T16:41:22.027

6

I'll leave it to other people to make a longer path out of this:

walkRules = AssociationThread[Range[0, 5], {{0, 1, 0}, {1, 0, 0}, {0, -1, 0},
                                            {-1, 0, 0}, {0, 0, 1}, {0, 0, -1}}];
colorRules = AssociationThread[Range[0, 5], {Red, Blue, Green, Cyan, Yellow, Purple}];

digits = First[RealDigits[π, 6, 10^3]];
coord = FoldList[Plus, {0, 0, 0}, Lookup[walkRules, digits]];
Graphics3D[{PointSize[Large], {Green, Point[First[coord]]}, {Red, Point[Last[coord]]}, 
            Riffle[Lookup[colorRules, digits], Line /@ Partition[coord, 2, 1]]},
           Boxed -> False]

$colored \pi walk$

edited Mar 18 '17 at 16:41

answered Oct 16 '16 at 12:46

J. M.'s missing motivation

124,525
11
401
574

digits are not defined and walkRules not used. I guess you have a line missing. – Johu Oct 16 '16 at 12:56
Whoops. Check now, please. – J. M.'s missing motivation Oct 16 '16 at 13:01
I am sorry for the down-vote but this is not right. All the segments are gradients: https://i.stack.imgur.com/40RTs.png – Mr.Wizard Feb 19 '17 at 09:48
@Mr. Wizard, luckily, it's easy to fix. – J. M.'s missing motivation Mar 18 '17 at 16:41
Happy to reverse my vote :-) – Mr.Wizard Mar 18 '17 at 17:13

Johu · Answer 2 · 2016-10-16T12:53:48.810

3

segments = {coord[[;; -2]], coord[[2 ;;]]}\[Transpose];
selectColor[a_List, b_List] :=
 Which[
  a[[1]] > b[[1]], Red,
  a[[1]] < b[[1]], Blue,
  a[[2]] > b[[2]], Green,
  a[[2]] < b[[2]], Cyan,
  a[[3]] < b[[3]], Yellow,
  a[[3]] > b[[3]], Purple
  ]
Graphics3D[{selectColor @@ #, Line@#} & /@ segments]

edited Oct 16 '16 at 12:53

answered Oct 16 '16 at 12:43

Johu

4,918
16
43

Colorize $3D$ "random walk" of $\pi$ digits

2 Answers2

Linked