Advertisement
Guest User

Untitled

a guest
Feb 21st, 2019
79
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.84 KB | None | 0 0
  1. collatz[x_, y_] := If[x == 3*y || x == 2*y + 1 || y == 3*x || y == 2*x + 2, 2, 0]
  2.  
  3. GraphPlot3D[collatz[#1, #2] &, {40, 40}]
  4.  
  5. Collatz[1] := {1}
  6. Collatz[n_Integer] := Prepend[Collatz[3 n + 1], n] /; OddQ[n] && n > 0
  7. Collatz[n_Integer] := Prepend[Collatz[n/2], n] /; EvenQ[n] && n > 0
  8.  
  9. Graph[(DirectedEdge @@@ Partition[Collatz[#], 2, 1]) & /@ Range[500] // Flatten // Union,
  10. EdgeShapeFunction -> GraphElementData[{"Arrow", "ArrowSize" -> .005}],
  11. GraphLayout -> "LayeredDrawing"]
  12.  
  13. Graph[(DirectedEdge @@@ Partition[Collatz[#], 2, 1]) & /@ Range[100] //
  14. Flatten // Union, GraphLayout -> "RadialEmbedding",
  15. VertexLabels -> "Name"]
  16.  
  17. Collatz[1] := {1}
  18. Collatz[n_Integer] := Collatz[n] = Prepend[Collatz[3 n + 1], n] /; OddQ[n] && n > 0
  19. Collatz[n_Integer] := Collatz[n] = Prepend[Collatz[n/2], n] /; EvenQ[n] && n > 0
  20.  
  21. CollatzSequence[list_] := Module[{memory, tmp, chain, result = Internal`Bag[]},
  22.  
  23. memory[1] = False;
  24. memory[n_] := (memory[n] = False; True);
  25.  
  26. Do[
  27. chain = Internal`Bag[];
  28. tmp = l;
  29. While[memory[tmp],
  30. Internal`StuffBag[chain, tmp];
  31. tmp = If[EvenQ[tmp], tmp/2, 3 tmp + 1];
  32. ];
  33. Internal`StuffBag[chain, tmp];
  34. Internal`StuffBag[result, chain],
  35. {l, list}];
  36. Internal`BagPart[#, All] & /@ Internal`BagPart[result, All]
  37. ]
  38.  
  39. CollatzSequence[{10, 11, 12}]
  40. (* {{10, 5, 16, 8, 4, 2, 1}, {11, 34, 17, 52, 26, 13, 40, 20,
  41. 10}, {12, 6, 3, 10}} *)
  42.  
  43. Graph[
  44. Flatten[(Rule @@@ Partition[#, 2, 1]) & /@
  45. CollatzSequence[Range[50000]]],
  46. PerformanceGoal -> "Speed",
  47. GraphLayout -> {"PackingLayout" -> "ClosestPacking"},
  48. VertexStyle -> Opacity[0.2, RGBColor[44/51, 10/51, 47/255]],
  49. EdgeStyle -> RGBColor[38/255, 139/255, 14/17]]
  50.  
  51. SetAttributes[Collatz, {Listable}];
  52. Collatz[n_, e_, a_, f_] := Module[{nn = n, bag = Internal`Bag[]},
  53. While[nn =!= 1, Internal`StuffBag[bag, nn];
  54. nn = If[EvenQ[nn], nn/2, 3 nn + 1]
  55. ];
  56. Internal`StuffBag[bag, nn];
  57. With[{seq = Reverse[Internal`BagPart[bag, All]]},
  58. AnglePath[Transpose[{seq/(1 + seq^e), a*(f - 2 Mod[seq, 2])}]]]];
  59.  
  60. astroIntensity[l_, s_, r_, h_, g_] :=
  61. With[{psi = 2 Pi (s/3 + r l), a = h l^g (1 - l^g)/2},
  62. l^g + a*{{-0.14861, 1.78277}, {-0.29227, -0.90649}, {1.97294,
  63. 0.0}}.{Cos[psi], Sin[psi]}];
  64.  
  65. Manipulate[
  66. DynamicModule[{seq},
  67. seq = ControlActive[Collatz[Range[5000, 5020], e, a, f],
  68. Collatz[RandomInteger[1000000, {n}], e, a, f]];
  69. Graphics[{Opacity[o], Thickness[ControlActive[0.01, 0.003]],
  70. Line[seq,
  71. VertexColors -> (Table[
  72. astroIntensity[l, s, r, h, g], {l, 0, 1,
  73. 1/(Length[#] - 1)}] & /@ seq)]}, ImageSize -> 500]
  74. ]
  75. , "Colors", {{s, 2.49}, 0, 3}, {{r, 0.76}, 0, 5}, {{h, 1.815}, 0,
  76. 2}, {{g, 1.3}, 0.1, 2}, {{o, 0.5}, 0.1, 1},
  77. Delimiter,
  78. "Structure",
  79. {{e, 1.3}, 0.9, 1.8},
  80. {{a, 0.19}, 0.1, 0.3},
  81. {{f, 0.7}, 0.1, 1.5},
  82.  
  83. {n, 300, 5000, 1}
  84. ]
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement