4
$\begingroup$

I'm trying to explore what would happen if you change the collatz conjecture to flip the equations for odds and evens. So if you have an even number you multiply by 3, add 1, and divide by 2. If you have an odd number, divide it by 2. I understand that this will leave you with some decimal answers so I'm deciding to round up. I'm trying to write this program in Mathematica however am running into trouble. Here is my code:

flipCollatz[n_] := If[EvenQ[n], ((3 n + 1)/2), (n/2)]
flipOrbit[n_] := Module[{flipVals = {n}, n0 = n},
  While[n0 > 1,
   n0 = flipCollatz[n0];
   If[IntegerQ[n0], n0 = n0, n0 = (n0 + 0.5)];
   flipVals = Append[flipVals, n0];
   ];
  flipVals
  ]
flipOrbit[10]

It's giving me the wrong output. I should be getting 10,16,25,13,7,4,7,4,...

Any ideas?

Thanks much!

$\endgroup$
  • 1
    $\begingroup$ With n=10 it follows that 10*3+1 /2 = 15.5. My If statement should then add .5 making it 16. So that's {10, 16}. Now take 16 * 3 + 1 / 2 = 24.5. Add .5 again to get 25. So {10,16,25}. 25/2 = 12.5 + .5 = 13. You see? $\endgroup$ – Dops Feb 19 '16 at 20:59
  • 1
    $\begingroup$ Be aware IntegerQ gives false on a floating value: On second pass you have 8. which is not an integer so becomes 8.5 $\endgroup$ – george2079 Feb 19 '16 at 21:03
  • $\begingroup$ Simply using 1/2 instead of .5 makes this work. Beware however it never converges so your While loop never exits. $\endgroup$ – george2079 Feb 19 '16 at 21:10
  • $\begingroup$ ..and the 1/2 turns out to be always needed so just do If[EvenQ[n], ((3 n + 1)/2), (n/2)] + 1/2 .. $\endgroup$ – george2079 Feb 19 '16 at 21:36
3
$\begingroup$

wrap the RHS of your flipCollatz with the Ceiling function

flipCollatz[n_] := Ceiling[If[EvenQ[n], ((3 n + 1)/2), (n/2)]]

Ceiling rounds up to the nearest integer


NestList[flipCollatz, 10, 7]

{10, 16, 25, 13, 7, 4, 7, 4}

$\endgroup$
2
$\begingroup$

Just for fun:

f[n_] := With[{l = Boole[EvenQ@n]}, 
  l Ceiling[(3 n + 1)/2] + (1 - l) Ceiling[n/2]]
rc[n_] := NestWhileList[f, n, UnsameQ, All]
grf[n_] := Module[{set = rc /@ Range[n]},
  Union[DirectedEdge @@@ Join @@ (Partition[#, 2, 1] & /@ set)]]

Visualizing:

Manipulate[
 Graph[grf[p], VertexLabels -> label, VertexSize -> vertex, 
  VertexStyle -> vc, GraphLayout -> embedding, ImageSize -> 600],
 {p, {20, 30, 100, 1000}}, {vertex, 0.1, 
  2}, {vc, {Blue, 
   LightBlue}}, {embedding, {"SpringElectricalEmbedding", 
   "CircularEmbedding"}}, {label, {None, Placed["Name", Center]}}]

enter image description here

$\endgroup$
1
$\begingroup$

This answer is to show you how to write your code in a functional style more suitable to Mathematica.

flipCollatz[k_Integer?OddQ] := Quotient[k, 2] + 1 
flipCollatz[k_Integer?EvenQ] := Quotient[3 k, 2] + 1

flipOrbit[n_Integer?(# > 1 &), max : _Integer?(# > 1 &) : 12] := 
   NestWhileList[flipCollatz, n, {#1, #2} != {4, 7} &, 2, max]
Column @ Table[flipOrbit[n], {n, 2, 15}]

table

The second argument of flipOrbit limits the loop to max steps. It has a default value of 12, which I used in generating the table of results.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.