Opposite Collatz Conjecture

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

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

Any ideas?

Thanks much!

• 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? – Dops Feb 19 '16 at 20:59
• Be aware IntegerQ gives false on a floating value: On second pass you have 8. which is not an integer so becomes 8.5 – george2079 Feb 19 '16 at 21:03
• Simply using 1/2 instead of .5 makes this work. Beware however it never converges so your While loop never exits. – george2079 Feb 19 '16 at 21:10
• ..and the 1/2 turns out to be always needed so just do If[EvenQ[n], ((3 n + 1)/2), (n/2)] + 1/2 .. – george2079 Feb 19 '16 at 21:36

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}

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]}}] 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}] 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.