5
$\begingroup$

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

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[10] 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.

$\endgroup$
1
  • 5
    $\begingroup$ 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. $\endgroup$
    – m_goldberg
    Nov 28 '15 at 18:18
8
$\begingroup$
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}

$\endgroup$
3
  • $\begingroup$ 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). $\endgroup$
    – eldo
    Nov 28 '15 at 22:37
  • $\begingroup$ @eldo - Ok, fixed that with FreeQ[ ... , 1 | 2] $\endgroup$ Nov 28 '15 at 23:00
  • $\begingroup$ 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. $\endgroup$ Nov 29 '15 at 6:11
4
$\begingroup$

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}*)
$\endgroup$
4
  • $\begingroup$ Now it works, thanks a lot, +1 $\endgroup$
    – eldo
    Nov 28 '15 at 21:54
  • $\begingroup$ 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. $\endgroup$ Nov 28 '15 at 22:02
  • $\begingroup$ Yes, I noticed, but that's not a big problem $\endgroup$
    – eldo
    Nov 28 '15 at 22:05
  • $\begingroup$ Fixed the code! $\endgroup$ Nov 29 '15 at 5:30

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.