Certain search in list

For an arbitrary list we can find the first position of an element that exceed twice the first element using LengthWhile. The helper function twicePos finds this position. The function fk, uses this helper function for each element e in the input list to find the required position (if any) in the sublist to the right of e and add it to the position of e:

ClearAll[twicePos, fk]
twicePos[x_] := LengthWhile[x, 2 First[x] >= # &] /. Length[x] -> {}
fk = Table[i + twicePos[#[[i ;;]]], {i, Length@#}] &;


SeedRandom[1234]
n = 10;
list = RandomReal[{-100, 100}, n];

fk[list]

{{}, 6, 4, 6, 6, {}, 10, 10, 10, {}}

This is slightly faster than Anjan's fa:

SeedRandom[1234]
n = 1000;
list = RandomReal[{-100, 100}, n];

res1 = fk[list]; // AbsoluteTiming // First

0.14639

res2 = fa[list]; // AbsoluteTiming // First

0.177977

res1 == res2

True


This answer is faster than @Roman's by at least a magnitude.

fa[l_] := Module[{twiceSelect, pos, lDuplicate = l, outputList = {}},

     (*Creates an association with positions as values*)
     (*pos = First /@ PositionIndex[l];*) (* If there are same elements in the list this would fail*)
      pos = Thread[l->Range[Length[l]]]//Association; (*This is more robust*)

      (*A helper function to select the first element 
        which satisfies the condition that it should be 
        twice than the first element of the list.*)
     twiceSelect[x_] := SelectFirst[Rest[x], # > 2*First[x] &] /. _Missing -> {};

      (*Here for every loop, you apply twiceSelect[], 
        truncate the list, and so on, for Length[l] times*)
      Do[
          AppendTo[outputList, twiceSelect[lDuplicate]];
          lDuplicate = Rest[lDuplicate];,
          Length[l]
        ];

       (*After obtaining all the required elements, replace the
        elements with their corresponsing positions*)
       outputList /. pos
      ]

Test

SeedRandom[1234]
list = RandomReal[{-100, 100}, 10];
fa[list]

{{}, 6, 4, 6, 6, {}, 10, 10, 10, {}}

Timing Comparison

SeedRandom[1234]
list = RandomReal[{-100, 100}, 1000];

fr[LL_]:=Lookup[GroupBy[
   SequencePosition[LL, {e_, ___, f_} /; f >= 2 e, Overlaps -> All], 
  First -> Last, Min], Range[Length[LL]], {}
]; (*Roman's*)

m = fr[list];//AbsoluteTiming
n = fa[list];//AbsoluteTiming
m == n

{4.32954, Null}

{0.122447, Null}

True


Update

If you're going to try to work with lists of length $n$ greater than a few thousand, it doesn't make sense to use Outer to generate an $n \times n$ matrix.

In this case, you should work on one list at a time. For speed reasons, it will be convenient to have a compiled function (from an answer by MichaelE2) to figure out the position of the first non - zero element :

firstnzp = Compile[{{list,_Integer,1}},
    Do[If[list[[i]] != 0, Return[i]], {i,Length@list}],
    RuntimeOptions->"Speed"
];

Then, a function that works on one list at a time is:

twice[ll_] := firstnzp @ UnitStep[Rest[ll] - 2 First[ll]]

Applying this function to suitably restricted subsets of list gives:

fd[ll_] := Replace[
    Table[twice[ll[[i;;]]], {i, Length[ll]}] + Range @ Length @ ll,
    Length @ ll + 1 -> {},
    {1}
]

Comparison:

SeedRandom[1234]
list=RandomReal[{-100,100},10000];

r1 = fa[list]; //AbsoluteTiming
r2 = fd[list]; //AbsoluteTiming

r1 === r2

{64.9011, Null}

{2.05682, Null}

True

Original answer

Here's another approach using Outer to subtract 2 times the element from the rest of the list for each element in the list, and then converting to a SparseArray to take advantage of the nice "MatrixColumns" method. The UnitStep and UpperTriangularize pieces just zero out irrelevant elements:

fc[ll_] := Replace[
    UpperTriangularize[
        SparseArray @ UnitStep @ Outer[Plus,-2ll,ll],
        1
    ]["MatrixColumns"],
    {a_,___}->a,
    {1}
]

Timing comparison:

r1 = fa[list]; //AbsoluteTiming
r2 = fc[list]; //AbsoluteTiming

r1 === r2

{0.143921, Null}

{0.029986, Null}

True

Brief explanation

To see how it works, consider the following short example:

SeedRandom[1]
list = RandomInteger[{-3,10}, 10]

{10, -2, 1, -3, 4, -3, -3, 5, 3, -3}

Let's look at the 3rd element, which is 1. We need to subtract 2 from all of the elements to the right, but I will instead just subtract 2 from all of them (this is the Outer step):

list - 2

{8, -4, -1, -5, 2, -5, -5, 3, 1, -5}

Clearly, any element less than 0 doesn't satisfy the criteria, so use UnitStep to set them to 0, and the others to 1 (the UnitStep step):

UnitStep[list - 2]

{1, 0, 0, 0, 1, 0, 0, 1, 1, 0}

Now, we also need to ignore the first 3 elements, since they aren't to the right of the 3rd element. Let's set them to 0 as well (the UpperTriangularize step):

MapAt[0&, UnitStep[list - 2], 1]

{0, 0, 0, 0, 1, 0, 0, 1, 1, 0}

Finally, we want to find the first nonzero column, which is 5 in this case. This is the "MatrixColumns" step, which returns all nonzero columns for a given row.