Як перевірити, чи список містить послідовні цілі числа в Mathematica?

Я хочу перевірити, чи містить список послідовних цілих чисел.

 consQ[a_] := Module[
  {ret = True}, 
  Do[If[i > 1 && a[[i]] != a[[i - 1]] + 1, ret = False; Break[]], {i, 
  1, Length[a]}]; ret]

Хоча функція consQ виконує роботу, я задаюсь питанням, чи є кращий (коротший, швидший) спосіб це зробити, бажано, використовуючи стиль функціонального програмування.

EDIT: The function above maps lists with consecutive integers in decreasing sequence to False. I would like to change this to True.

11

7 Відповіді

Рішення Шаблі - це, мабуть, те, що я зробив би, але тут є альтернатива:

consQ[a : {___Integer}] := Most[a] + 1 === Rest[a]
consQ[_] := False

Зауважте, що ці підходи відрізняються тим, як вони обробляють порожній список.

11
додано
Швидкий, функціональний та компактний. :-) Але загадковий (для мене), де Union @ Differences близький до самодокументації. - Важко вирішити, який з них найкращий! - Обидва мої "рішення" залишають далеко позаду продуктивності.
додано Автор nilo de roock, джерело
Будь ласка, подивіться на EDIT: і далі в питанні. Як би ви модифікували свій код?
додано Автор nilo de roock, джерело
а також список розміру 1. Я люблю твій краще.
додано Автор Szabolcs, джерело
@nilo ви можете слідкувати за белісаріусом і використовувати Sign : Most [a] + Sign [a [[2]] - [[1]]] === Відпочинок [a ]
додано Автор Mr.Wizard, джерело
@Містер. Ви маєте на увазі Sign [- # [[1]] + # [[2]]]] & @ [a [[1]], [[- 1]]) ?
додано Автор Dr. belisarius, джерело
@belisarius Sign [{- 1,1} .a [[{1, -1}]]]
додано Автор Brett Champion, джерело
Але легко розбити. Встановіть a = {1,2,3,4,5} і перейдіть звідти.
додано Автор Brett Champion, джерело

Ви могли б використовувати

consQ[a_List ? (VectorQ[#, IntegerQ]&)] := [email protected][a] === {1}
consQ[_] = False

Ви можете вилучити тест для цілих чисел, якщо ви знаєте, що кожен список, до якого ви переходите, буде мати цілі числа.

EDIT: A little extra: if you use a very old version that doesn't have Differences, or wonder how to implement it,

differences[a_List] := Rest[a] - Most[a]

EDIT 2: The requested change:

consQ[a : {Integer___}] := MatchQ[[email protected][a], {1} | {-1} | {}]
consQ[_] = False

Це працює як з послідовністю збільшення, так і з пониженням, і дає також True для списку розміру 1 або 0.

More generally, you can test if the list of numbers are equally spaced with something like equallySpacedQ[a_List] := [email protected]@Differences[a] == 1

9
додано
Або без обмежень цілісності: consQ [a_]: = Union @ Differences [a] === {1}. Прохолодно Важко вибрати між вашим рішенням і тим, що є чемпіоном. - (я не знав, що у Mathematica була функція відмінностей.)
додано Автор nilo de roock, джерело
Будь ласка, подивіться на EDIT: і далі в питанні. Як би ви модифікували свій код?
додано Автор nilo de roock, джерело
Дякую за редагування. @Szabolcs - Мені подобається ваша відповідь на читаність, компактність та функціональний стиль, хоча технічно вона може бути не найшвидшою. - Різноманітність рішень показує потужність Mathematica.
додано Автор nilo de roock, джерело
@niloderoock Переглянути мою редакцію.
додано Автор Szabolcs, джерело
Оскільки ви перевіряєте, що набір різниць точно (1) , достатньо перевірити, чи містить цей список ціле число, а не перевіряти їх усі.
додано Автор Brett Champion, джерело

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

a = Range[10^7];
f[a_] := Range[Sequence @@ ##, Sign[-#[[1]] + #[[2]]]] &@{a[[1]], a[[-1]]} == a;
Timing[f[a]]
b = [email protected];
Timing[f[b]]

Редагувати

Короткий тест для рішень швидкого доступу до цих пір:

a = Range[2 10^7];
[email protected]@a
[email protected]@a
[email protected]@a
(*
{6.5,True}
{0.703,True}
{0.203,True}
*)
8
додано
додано Автор Mr.Wizard, джерело
+1 в будь-якому випадку, але ти веде мене з розуму. :-p
додано Автор Mr.Wizard, джерело
@Містер. Дивись свої манери! Назад ногами, прокладати гігантські яйця та їсти листя евкаліпта дозволяється тільки в www.stackoverflow.co.au
додано Автор Dr. belisarius, джерело
@Містер. Звичайно, ця частина була присвячена вам: D
додано Автор Dr. belisarius, джерело

Мені подобаються рішення двох інших, але я б переймався дуже довгими списками. Розглянемо дані

d:dat[n_Integer?Positive]:= d = {1}~Join~Range[1, n]

який має невід'ємну точку з самого початку. Налаштування consQ1 для Brett's та consQ2 для Szabolcs, я отримую

AbsoluteTiming[ #[dat[ 10000 ] ]& /@ {consQ1, consQ2}
{ {0.000110, False}, {0.001091, False} }

Або, приблизно в десять разів різниця між двома, що залишається відносно сумісним з численними випробуваннями. Цього разу можна скоротити приблизно наполовину через коротке замикання процесу, використовуючи NestWhile :

Clear[consQ3]
consQ3[a : {__Integer}] := 
 Module[{l = Length[a], i = 1},
   NestWhile[# + 1 &, i, 
      (#2 <= l) && a[[#1]] + 1 == a[[#2]] &, 
   2] > l
 ]

яка перевіряє кожну пару і продовжує, лише якщо вони повертаються істинно. Тайминги

AbsoluteTiming[consQ3[dat[ 10000 ]]]
{0.000059, False}

з

{0.000076, False}

для consQ . Отже, відповідь Бретта досить близька, але іноді це займе удвічі більше часу.

Edit: I moved the graphs of the timing data to a Community Wiki answer.

8
додано
Я не фахівець з синхронізації, але чи не є функція Timing, яку потрібно вибрати при порівнянні швидкості алгоритму sec? - Я питаю, тому що я отримую різні результати при використанні Timing, а не AbsoluteTiming. - Мені цікаво, яке рішення використовує найшвидший алгоритм.
додано Автор nilo de roock, джерело
@rcollyer я отримую цей i.stack.imgur.com/OVwnq.png
додано Автор Dr. belisarius, джерело
@ Rcollyer Ви не бажаєте включити моє?
додано Автор Dr. belisarius, джерело
@niloderoock, я додав дані про час, використовуючи Timing для моєї відповіді.
додано Автор rcollyer, джерело
@ belisarius, так і я, див. мій відповідь вікі .
додано Автор rcollyer, джерело
@belisarius, абсолютно Дай мені пару годин.
додано Автор rcollyer, джерело

Тепер я переконаний, що Белізарій намагається отримати козу, написавши навмисно заплутаний код. :-p

I would write: f = Range[##, Sign[#2 - #]]& @@ #[[{1, -1}]] == # &

Крім того, я вважаю, що WReach, мабуть, мав намір написати щось на кшталт:

consQFold[a_] := 
 Catch[
  Fold[If[#2 === # + 1, #2, [email protected]] &, a[[1]] - 1, a]; 
  True
 ]
5
додано
-14 для зворотного проектування мого захищеного авторським правом і заплутаного коду
додано Автор Dr. belisarius, джерело
Там є вино для вашої проблеми із козлом .
додано Автор rcollyer, джерело

Fold can be used in a fairly concise expression that runs very quickly:

consQFold[a_] := (Fold[If[#2 == #1 + 1, #2, Return[False]] &, a[[1]]-1, a]; True)

Зіставлення візерунків може використовуватися для забезпечення чіткого вираження наміру за рахунок значно повільної продуктивності:

consQMatch[{___, i_, j_, ___}] /; j - i != 1 := False
consQMatch[_] = True;

Редагувати

consQFold, as written, works in Mathematica v8.0.4 but not in earlier versions of v8 or v7. To correct this problem, there are a couple of alternatives. The first is to explicitly name the Return point:

consQFold[a_] :=
  (Fold[If[#2==#1+1, #2, Return[False,CompoundExpression]] &, a[[1]]-1, a]; True)

Друга, як запропонував @ Mr.Wizard, замінити Return за допомогою Throw / Catch :

consQFold[a_] :=
  Catch[Fold[If[#2 == #1 + 1, #2, Throw[False]]&, a[[1]]-1, a]; True]
5
додано
Скільки конструкцій Return працює з 8.0.4? О, і, звичайно, +1.
додано Автор Mr.Wizard, джерело
Це робить? Ти впевнений?
додано Автор Mr.Wizard, джерело
це те, про що я думав, коли я читаю це питання, але чи не майте на увазі використовувати Throw , а не Return ?
додано Автор Mr.Wizard, джерело
@ Mr.Wizard Throw також буде працювати, але для цього потрібен відповідний Catch . Таким чином, Return є більш стислим, оскільки він виходить з найближчої контегральної суми (в даному випадку - визначення consQFold ).
додано Автор WReach, джерело
@ Mr.Wizard Ага! Я зараз бачу проблему. Return виявляється розбитим у версії 7 та версії 8.0.1. Він знову виправлений у версії 8.0.4 (або порушено, залежно від вашої точки зору :).
додано Автор WReach, джерело
@ Mr.Wizard Схоже, що багато слів, що оточують Return - і декілька фактів. Офіційна документація нечисленна. Наприклад, форма для двох аргументів - майже недокументована . Я неодноразово здивувався документованою поведінкою: Якщо [другий аргумент] опущений, зачіпається функція або цикл визначається за допомогою вбудованої евристики . Я вважаю, що я повинен був знати краще, ніж покладатися на це, і я мав (неправильне) щастя випробувати мій код у блискучі нові 8.0.4.
додано Автор WReach, джерело

Оскільки час, здається, досить важливий. Я перевів порівняння між різними методами до цього, Community Wiki, answer.

Використовувані дані - це просто списки послідовних цілих чисел, з однією непересічною точкою, і вони генеруються через

d : dat[n_Integer?Positive] := (d = {1}~Join~Range[1, n])
d : dat[n_Integer?Positive, p_Integer?Positive] /; p <= n := 
     Range[1, p]~Join~{p}~Join~Range[p + 1, n]

де перша форма dat [n] еквівалентна dat [n, 1] . Код часу дуже простий:

Clear[consQTiming]
Options[consQTiming] = {
   NonConsecutivePoints -> {10, 25, 50, 100, 250,500, 1000}};
consQTiming[fcns__, OptionPattern[]]:=
With[{rnd = RandomInteger[{1, #}, 100]}, 
  With[{fcn = #}, 
     Timing[ fcn[dat[10000, #]] & /@ rnd ][[1]]/100
  ] & /@ {fcns}
] & /@ OptionValue[NonConsecutivePoints]

Він генерує 100 випадкових цілих чисел від 1 до кожного з (10, 25, 50, 100, 250, 500, 1000) і dat , потім використовує кожне з цих випадкових чисел як Непослідовна точка в списку - 10 000 елементів довго. Кожна реалізація consQ застосовується до кожного списку, що виробляється за допомогою dat , а результати усереднюються. Функція побудови є простою

Clear[PlotConsQTimings]
Options[PlotConsQTimings] = {
     NonConsecutivePoints -> {10, 25, 50, 100, 250, 500, 1000}};
PlotConsQTimings[timings : { _?VectorQ ..}, OptionPattern[]] :=
  ListLogLogPlot[
    Thread[{OptionValue[NonConsecutivePoints], #}] & /@ Transpose[timings],
    Frame -> True, Joined -> True, PlotMarkers -> Automatic
  ]

timing data for various functions

Я приурочив до виконання наступні функції < code> consQSzabolcs1 , consQSzabolcs2 , consQBrett , consQRCollyer , consQBelisarius , consQWRFold , consQWRFold2 , consQWRFold3 , consQWRMatch і Версія MrWizard consQBelisarius .

У порядку зростання лівого більшості часу: consQBelisarius , consQWizard , consQRCollyer , consQBrett , consQSzabolcs1 < consQWRFold3 і consQWRFold .

Edit: Reran all of the functions with timeAvg (the second one) instead of Timing in consQTiming. I did still average over 100 runs, though. For the most part, there was any change, except for the lowest two where there is some variation from run to run. So, take those two lines with a grain of salt as they're timings are practically identical.

enter image description here

5
додано
Дякую. Схоже, це прості варіанти, а не швидше, ніж інші, що я очікував.
додано Автор Mr.Wizard, джерело
@rcollyer Ви б перевірити belisarius та мої функції знову, використовуючи timeAvg або подібні? Мені цікаво дізнатись, чи в вашій системі моторошний вага є справжньою чи артефактом.
додано Автор Mr.Wizard, джерело
Вибач я не зрозумів. Дуже дякую!
додано Автор Dr. belisarius, джерело
так, але яка функція це? У відповідь пані є дві функції
додано Автор Dr. belisarius, джерело
Який з них є consQWizard ?
додано Автор Dr. belisarius, джерело
Дякую @ rcollyer :)
додано Автор Dr. belisarius, джерело
@ belisarius, виштовхнув його, щоб дозволити випадкові непослідовні вказівки до 5000 і 10000, а також оновлену картинку.
додано Автор rcollyer, джерело
@belisarius, праворуч над вашим, що падає нижче вашої від 50 до 1000.
додано Автор rcollyer, джерело
@ Белісаріус, я думав, що я це зрозуміла в тексті, мабуть, ні. Це його версія вашої функції, f . Я не потурбувався з іншим, оскільки WReach застосував це виправлення до consQWRFold3 . Отже, я був досить здивований, що існує різниця у термінах.
додано Автор rcollyer, джерело
@ Mr.Wizard, перевстановіть всі функції за допомогою timeAvg , і для вас і для Белісаріуса є варіанти від бігу до запуску.
додано Автор rcollyer, джерело