# Extending a list

I have a range of n integers (always starting at 1) which are 1 apart, f.e. Range, Range or Range.

I want to extend the range by [1, 2, 3 ... n] elements by duplicating n existing elements at random positions. With n = 2 for example Range could become

{1, 2, 3, 3, 5, 6, 7, 7, 9, 10, 11, 12}

There are 3 requirements:

(1) The first and the last element should not be duplicated.

(2) After a duplication there should be a jump of 2 (like from 3 to 5 in the above example list).

(3) There should be at least 1 non-repeated element between 2 duplications (5 and 6 in the list).

I finally found an ugly solution with Fors and Whiles but somehow got lost trying to find a functional one.

• I'm not clear on what you are asking. You state "I want to extend the range by [1, 2, 3 ... n] elements", but [1, 2, 3 ... n] has no meaning to me as a Mathematica expression nor as a mathematical one. You mention duplicating elements, but your example doesn't show duplication as I understand it; it shows ... k, k + 1, ... being replaced by ... k, k, ... and then n + 1 tacked onto the end of a list that previously had n elements. So I'm confused about what your goal really is. Perhaps you should add your ugly but working code. The code at least would give a precise specification. Nov 28 '15 at 18:18

f[m_, n_] := Module[{rg, ok, rs},
rg = Range[m + n];
ok = rg[[2 ;; -2]];
While[True,
rs = Sort@RandomSample[ok, n];
If[FreeQ[Differences@rs, 1 | 2], Break[]]];
Fold[ReplacePart[#1, #2 + 1 -> #2] &, rg, rs]]

f[10, 2]


{1, 2, 2, 4, 5, 6, 7, 8, 9, 10, 10, 12}

• Beautiful combination of Fold and ReplacePart. Sometimes I get two duplicate pairs next to each other like 4,4,5,5. Not a big deal, but I asked for a separation (point 3 of the question).
– eldo
Nov 28 '15 at 22:37
• @eldo - Ok, fixed that with FreeQ[ ... , 1 | 2] Nov 28 '15 at 23:00
• The While loop and RandomSample may be problematic for large inputs because it would be unlikely that Differences@rs do not have any $1$s or $2$s. For example, f[81,40] would take a long time to calculate. Nov 29 '15 at 6:11

This would work:

ExtendedList[range_, duplicates_] :=
MapAt[# - 1 &, Range[range],
List /@ Accumulate[Most[RandomChoice[
Flatten[Permutations /@
IntegerPartitions[range - 2 duplicates, {duplicates + 1}],
1]
]] + 2]
]


The above code is not efficient for large lists. The code below would be more efficient:

ExtendedList[range_, duplicates_] :=
MapAt[# - 1 &, Range[range],
List /@ Accumulate[Most[RandomSample[RandomChoice[
IntegerPartitions[range - 2 duplicates, {duplicates + 1}]
]]] + 2]
]


Edit: The above codes generate a list of length range: the length does not change. You would need to type ExtendedList[12,2] instead of [10,2] in order to get the result in the question.

Edit 2: Fixed the code.

ExtendedList[range_, duplicates_] :=
MapAt[# - 1 &, Range[range + duplicates],
List /@ Accumulate[Most[RandomSample[RandomChoice[
IntegerPartitions[range - duplicates, {duplicates + 1}]
]]] + 2]
]

ExtendedList[10,2]
(*{1, 2, 3, 3, 5, 6, 7, 8, 8, 10, 11, 12}*)

• Now it works, thanks a lot, +1
– eldo
Nov 28 '15 at 21:54
• These codes have one flaw: they subtract 1 from certain elements instead of duplicating elements. So, you would need to input the final length of the list (initial length + number of duplicates) and the number of duplicates in order to get the desired result. Nov 28 '15 at 22:02
• Yes, I noticed, but that's not a big problem
– eldo
Nov 28 '15 at 22:05
• Fixed the code! Nov 29 '15 at 5:30