How to double elements of a list given by their positions

Question

Given that I have a list $\{P_0,P_1,P_2,\cdots,P_7\}$, where, $P_i$ is a real number or a list like {x,y}/{x,y,z}. Now I would like to double some elements according to given index(i) and interval(p). For instance,

$i=1,p=2$, the elements that will be doubled is $\{i-p-1,i,i+p+1\}=\{-2,1,4\}$. Namely, $P_1,P_4$ (delete $-2$ since $P_{-2}$ is non-existent)

$i=3,p=2$, the elements that will be doubled is $\{i-p-1,i,i+p+1\}=\{0,3,6\}$. Namely, $P_0,P_3,P_6$

My trial

Firstly, I find the positions of the elements that need to be doubled, then applying ReplacePart[]

elemAdjust1[elems_, deg_, i_] :=
 Module[{idx, n = Length[elems] - 1, new},
  idx = Select[{i - deg - 1, i, i + deg + 1}, 0 <= # <= n &] + 1;
  new = {#, #} & /@ elems[[idx]];
  ReplacePart[elems, Thread[idx -> new] /. {x_, x_} :> Sequence[x, x]]
 ]

Another method came form J.M., i.e., with the help of Partition[]

elemAdjust2[elems_, deg_, i_] :=
 Module[{idx, n = Length[elems] - 1, left, mid, right},
  idx = Select[{i - deg - 1, i, i + deg + 1}, 0 <= # <= n &] + 1;
  left = Take[elems, {1, idx[[1]] - 1}];
  right = Take[elems, {idx[[-1]] + 1, n + 1}];
  mid = Take[elems, {idx[[1]], idx[[-1]]}];
  mid = Flatten[Partition[mid, deg + 2, deg + 1, {-1, 1}, {}], 1];
  Join[left, mid, right]
 ]

Test

pts = {P0, P1, P2, P3, P4, P5, P6, P7};
elemAdjust1[pts, 2, 1]
elemAdjust2[pts, 2, 1]
(*==> {P0, P1, P1, P2, P3, P4, P4, P5, P6, P7}*)
elemAdjust1[pts, 2, 2]
elemAdjust2[pts, 2, 2]
(*==> {P0, P1, P2, P2, P3, P4, P5, P5, P6, P7}*)
elemAdjust1[pts, 2, 3]
elemAdjust2[pts, 2, 3]
(*==> {P0, P0, P1, P2, P3, P3, P4, P5, P6, P6, P7}*)

---

elemAdjust[{{0, 0}, {1, 1}, {2, -1}, {3, 0}, {4, -2}, {5, 1}}, 2, 2]
(*==> {{0, 0}, {1, 1}, {2, -1}, {2, -1}, {3, 0}, {4, -2}, {5, 1}, {5, 1}}*)

Question

• Is there more better to deal with this problem?

doubleElements[lst, postions]

doubleElements[{a1,a2,a3,a4,a5,a6,a7,a8,a9}, {1,7,9}]

==>{a1,a1,a2,a3,a4,a5,a6,a7,a7,a8,a9,a9}

Answer 1

It seems that {i−p−1,i,i+p+1} isn't really important so let's start assuming it's already generated:

list = {a, b, c, d}
indices = {-2, 0, 7}

Part[
 list,
 Range@Length@list /. Map[# -> Sequence[#, #] &, indices + 1]
 ]

{a, a, b, c, d}

Probably not the best for bigger lists but shorter. Notice that Select part is dropped, as ReplaceAll takes care of that.

---

another inefficient alternative:

MapIndexed[
  ## & @@ If[MemberQ[indices + 1, First@#2], {#, #}, #] &,
  list
]

Answer 2

eA[elems_, deg_, i_] := 
 Module[{idx = Select[{i - deg - 1, i, i + deg + 1}, 0 <= # <= Length@elems -1 &] + 1},
   Fold[Insert[#, #[[#2 - 1]], #2] &, elems, idx + Range@Length@idx]
 ];

Answer 3

Prompted by rasher/ciao's comment referencing Looking for a way to insert multiple elements into multiple positions simultaneously in a list I propose:

doubleAt[list_, pos_] :=
  Length[list] /. n_ :>
    list[[ Sort @ Join[Select[pos, 1 <= # <= n &], Range @ n] ]]

doubleAt[{a1,a2,a3,a4,a5,a6,a7,a8,a9}, {-3, 7, 1, 9, 22}]

{a1, a1, a2, a3, a4, a5, a6, a7, a7, a8, a9, a9}

This is less intuitive but far somewhat faster than Kuba's code:

(* Kuba's method as a function; Dispatch added for performance *)

kubaFn[list_, indices_] := 
  list[[ 
    Range @ Length @ list /.
       Dispatch @ Map[# -> Sequence[#, #] &, indices + 1]
  ]]

list = "a" ~CharacterRange~ "z" ~RandomChoice~ 50000;
pos  = Range[-1000, 60000] ~RandomSample~ 4000;

kubaFn[list, pos - 1]       // Length // AbsoluteTiming
doubleAt[list, pos]         // Length // AbsoluteTiming

{0.0153409, 53294}
{0.00306862, 53294}

Note that agreement with Kuba's code requires an offset (+1, -1) for one of the functions:

kubaFn[list, pos - 1] === doubleAt[list, pos]    (* True *)