Замена подсписка первым элементом в подсписке

Question

Я довольно новичок в Mathematica и озадачен этой проблемой. У меня есть список, который выглядит так:

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

Я хочу заменить каждый подсписок своим первым элементом. Итак, приведенный выше список следует преобразовать в:

{1,0,1}

Я неоднократно просматривал документацию и часами гуглил. Я уверен, что это довольно просто, но я не могу понять это. Я начал с этого списка:

{1, 1, 1, 0, 1}

Мне нужно знать, сколько существует прогонов 1, что, очевидно, равно 2. Итак, я использовал Split для разделения списка на группы последовательных 1 и 0. Используя длину в этом списке, я могу получить общее количество прогонов, равное 3. Теперь мне просто нужно вычислить количество прогонов, равное 1. Если я могу преобразовать список, как указано выше, я могу просто суммировать элементы в списке, чтобы получить ответ.

Надеюсь, это имеет смысл. Спасибо за любую помощь!

Answer 1

Предлагаемые решения довольно быстрые, однако, если вам нужна предельная эффективность (огромные списки), вот еще один, который был бы на порядок быстрее (сформулированный как чистая функция):

Total[Clip[Differences@#,{0, 1}]] + First[#] &

Дляпример:

In[86]:= 
largeTestList = RandomInteger[{0,1},{10^6}];
Count[Split[largeTestList],{1..}]//Timing
Count[Split[largeTestList][[All,1]],1]//Timing
Total[Clip[Differences@#,{0, 1}]] + First[#] &@largeTestList//Timing

Out[87]= {0.328,249887}
Out[88]= {0.203,249887}
Out[89]= {0.015,249887}

РЕДАКТИРОВАТЬ

Я не хотел начинать "большую перестрелку", но пока мы здесь, позвольте мне вытащить самый большой пистолет -компиляция в C:

runsOf1C = 
 Compile[{{lst, _Integer, 1}},
   Module[{r = Table[0, {Length[lst] - 1}], i = 1, ctr = First[lst]},
    For[i = 2, i <= Length[lst], i++,
      If[lst[[i]] == 1 && lst[[i - 1]] == 0, ctr++]];
      ctr],
  CompilationTarget -> "C", RuntimeOptions -> "Speed"]

Теперь,

In[157]:= 
hugeTestList=RandomInteger[{0,1},{10^7}];
Total[Clip[ListCorrelate[{-1,1},#],{0,1}]]+First[#]&@hugeTestList//AbsoluteTiming
runsOf1C[hugeTestList]//AbsoluteTiming

Out[158]= {0.1872000,2499650}
Out[159]= {0.0780000,2499650}

Конечно, это не элегантное решение, но оно простое.

РЕДАКТИРОВАТЬ 2

Улучшение оптимизации @Sjoerd, этот будет примерно на 1,5 быстрее, чем runsOf1C все же:

runsOf1CAlt = 
Compile[{{lst, _Integer, 1}},
  Module[{r = Table[0, {Length[lst] - 1}], i = 1, ctr = First[lst]},
    For[i = 2, i <= Length[lst], i++,
     If[lst[[i]] == 1,
      If[lst[[i - 1]] == 0, ctr++];
      i++
     ]];
    ctr],
  CompilationTarget -> "C", RuntimeOptions -> "Speed"]

Answer 2

У вас есть два вопроса: один из заголовка и вопрос, скрывающийся за ним.На первый ответ:

First/@ list

На второй, подсчитывающий количество прогонов 1, отвечали много раз, но это решение

Total[Clip[ListCorrelate[{-1, 1}, #], {0, 1}]] + First[#] &

составляет около 50%.быстрее, чем решение Леонида.Заметьте, что я увеличил длину списка тестов для лучшего выбора времени:

largeTestList = RandomInteger[{0, 1}, {10000000}];
Count[Split[largeTestList], {1 ..}] // AbsoluteTiming
Count[Split[largeTestList][[All, 1]], 1] // AbsoluteTiming
Total[Clip[Differences@#, {0, 1}]] + First[#] &@ largeTestList // AbsoluteTiming
(Tr@Unitize@Differences@# + Tr@#[[{1, -1}]])/2 &@ largeTestList // AbsoluteTiming
Total[Clip[ListCorrelate[{-1, 1}, #], {0, 1}]] + First[#] &@
  largeTestList // AbsoluteTiming


Out[680]= {3.4361965, 2498095}

Out[681]= {2.4531403, 2498095}

Out[682]= {0.2710155, 2498095}

Out[683]= {0.2530145, 2498095}

Out[684]= {0.1710097, 2498095}

---

После атаки компиляции Леонида я собирался бросить полотенце, но я заметил возможную оптимизацию, поэтому битва продолжается... [Мистер Волшебник, мы с Леонидом должны быть брошены в тюрьму за нарушение спокойствия на ЮЗ]

runsOf1Cbis = 
 Compile[{{lst, _Integer, 1}}, 
  Module[{r = Table[0, {Length[lst] - 1}], i = 1, ctr = First[lst]}, 
   For[i = 2, i <= Length[lst], i++, 
    If[lst[[i]] == 1 && lst[[i - 1]] == 0, ctr++; i++]];
   ctr], CompilationTarget -> "C", RuntimeOptions -> "Speed"]

largeTestList = RandomInteger[{0, 1}, {10000000}]; 
Total[Clip[ListCorrelate[{-1, 1}, #], {0, 1}]] + First[#] &@
    largeTestList // AbsoluteTiming
runsOf1C[largeTestList] // AbsoluteTiming
runsOf1Cbis[largeTestList] // AbsoluteTiming


Out[869]= {0.1770101, 2500910}

Out[870]= {0.0960055, 2500910}

Out[871]= {0.0810046, 2500910}

Результаты меняются, но я получаю улучшение от 10 до 30%.

Оптимизация может быть трудно определить, но это дополнительный i++, если тест {0,1} пройден успешно.Вы не можете иметь два из них в последовательных местоположениях.

---

И, здесь, оптимизация оптимизации Леонида моей оптимизации его оптимизации (я надеюсь, что это не будет тянуть, или яЯ собираюсь перенести переполнение стека):

runsOf1CDitto = 
 Compile[{{lst, _Integer, 1}}, 
  Module[{i = 1, ctr = First[lst]}, 
   For[i = 2, i <= Length[lst], i++, 
    If[lst[[i]] == 1, If[lst[[i - 1]] == 0, ctr++];
     i++]];
   ctr], CompilationTarget -> "C", RuntimeOptions -> "Speed"]

largeTestList = RandomInteger[{0, 1}, {10000000}]; 
Total[Clip[ListCorrelate[{-1, 1}, #], {0, 1}]] + First[#] &@
  largeTestList // AbsoluteTiming
runsOf1C[largeTestList] // AbsoluteTiming
runsOf1Cbis[largeTestList] // AbsoluteTiming
runsOf1CAlt[largeTestList] // AbsoluteTiming
runsOf1CDitto[largeTestList] // AbsoluteTiming


Out[907]= {0.1760101, 2501382}

Out[908]= {0.0990056, 2501382}

Out[909]= {0.0780045, 2501382}

Out[910]= {0.0670038, 2501382}

Out[911]= {0.0600034, 2501382}

К счастью для меня, у Леонида была лишняя инициализация в коде, которую можно было удалить.

Answer 3

Вот вариант метода Differences Леонида, который несколько быстрее:

(Tr@Unitize@Differences@# + Tr@#[[{1,-1}]])/2 &

По сравнению (с использованием Tr для обоих):

list = RandomInteger[1, 1*^7];

Tr[Clip[Differences@#, {0,1}]] + First[#] & @ list //timeAvg

(Tr@Unitize@Differences@# + Tr@#[[{1,-1}]])/2 & @ list //timeAvg

0.1186

0.0904

---

Так как это стало соревнованием за эффективность кода, вот мое следующее усилие:

(Tr@BitXor[Most@#, Rest@#] + Tr@#[[{1, -1}]])/2 &

Кроме того, я получаю очень разные результаты, используя Mathematica 7, поэтому я включаю их сюда для справки:

largeTestList = RandomInteger[{0, 1}, {10000000}];
Count[Split[largeTestList], {1 ..}] // AbsoluteTiming
Count[Split[largeTestList][[All, 1]], 1] // AbsoluteTiming
Total[Clip[Differences@#, {0, 1}]] + First[#] &@largeTestList // AbsoluteTiming
(Tr@Unitize@Differences@# + Tr@#[[{1, -1}]])/2 &@largeTestList // AbsoluteTiming
Total[Clip[ListCorrelate[{-1, 1}, #], {0, 1}]] + First[#] &@largeTestList // AbsoluteTiming
(Tr@BitXor[Most@#, Rest@#] + Tr@#[[{1, -1}]])/2 &@largeTestList // AbsoluteTiming

{1.3400766, 2499840}

{0.9670553, 2499840}

{0.1460084, 2499840}

{0.1070061, 2499840}

{0.3710213, 2499840}

{0.0480028, 2499840}

Answer 4

Другой подход, использующий Count для поиска списков, содержащих некоторое количество повторений 1:

In[20]:= Count[Split[{1, 1, 1, 0, 1}], {1 ..}]

Out[20]= 2

Answer 5

Я бы сделал это:

Count[Split[{1, 1, 1, 0, 1}][[All, 1]], 1]

или

Total[First /@ Split[{1, 1, 1, 0, 1}]]