[Wolfram Mathematica] Символьные вычисления с условиями

[Mysterious Light]

В последнее время мне всё чаще приходится рассматривать похожие выражения для разных наборов параметров.
Например, пусть даны три списка L1, L2 и L3 длины n, нужно сравнить максимальное (среди списков) из наименших чисел и минимальное из средних чисел каждого списка.
Вполне естестественное желание написать With[{es = Transpose[Sort /@ {L1, L2, L3}]}, Max[es[[1]]] < Min[es[[2]]]] терпит крах потому, что Sort не умеет расписывать условия для выражения-ответа, когда элементы списков L1, L2, L3 не являются NumericQ, а заданы символьно.

(Оффтоп)

Обнаружил интересную багу особенность работы Sort:
Sort[{0, Sqrt[2], -Sqrt[2]}] == {0, -Sqrt[2], Sqrt[2]}

Для интуитивно ожидаемой работы нужно писать
Sort[{0, Sqrt[2], -Sqrt[2]}, Less]
или
SortBy[{0, Sqrt[2], -Sqrt[2]}, N]

Я тут написал на коленке свой велосипед

(Оффтоп)

NSort[list_List] := With[{n = Length[list]},
   Table[
    Piecewise[
     Table[
      {p[[k]], LessEqual @@ p}
      , {p, Permutations[list]}], Null
     ], {k, n}]
   ];

NMin[list_List] := With[{n = Length[list]},
   Piecewise[
    Table[{p[[1]], LessEqual @@ p}
     , {p, Permutations[list]}], Null
    ]];

NMax[list_List] := With[{n = Length[list]},
   Piecewise[
    Table[{p[[1]], GreaterEqual @@ p}
     , {p, Permutations[list]}], Null
    ]];

Работает, но с неприемлемой факториальной сложностью.

Собственно, вопрос:
было у кого-то желание пощупать такого типа задачи, в которых были бы символьные манипуляции с условиями? Как это лучше всего делается? Какие есть техники в WM? Короче, прошу поделиться опытом.

[agua]

Mysterious Light в сообщении #1027457 писал(а):

Обнаружил интересную особенность работы Sort:

Sort[{0, Sqrt[2], -Sqrt[2]}] == {0, -Sqrt[2], Sqrt[2]}

Для интуитивно ожидаемой работы нужно писать

Sort[{0, Sqrt[2], -Sqrt[2]}, Less]

Да, об этом прямо сказано в справке в разделе Possible Issues:

Цитата:

Numeric expressions are sorted by structure as well as numerical value:

Sort[{Infinity, Sqrt[2], 1, 2, -Infinity, 1/Sqrt[2]}]
{1, 2, 1/Sqrt[2], Sqrt[2], -Infinity, Infinity}

Sort by numerical value only:

Sort[{Infinity, Sqrt[2], 1, 2, -Infinity, 1/Sqrt[2]}, Less]
{-Infinity, 1/Sqrt[2], 1, Sqrt[2], 2, Infinity}

Сам вопрос и его реализация мне не совсем понятны, но ввиду обнаруженной "баги", кто мешает написать приведённое выражение, например, вот так:

With[{es = Transpose[Sort[#, Less] & /@ {L1, L2, L3}]}, Max[es[[1]]] < Min[es[[2]]]]

Если я, конечно, правильно понял суть фразы "символьные манипуляции с условиями" (скорее, это "манипуляции с символьными выражениями").

[Mysterious Light]

Вопрос был о выражениях, значение которых зависит от условия: If, Piecewise, Which (если без побочных эффектов), Min/Max, Sort.
Например, хотелось бы, что WM самостоятельно делалал такое преобразование NSort[{a, b}] -> If[a < b, {a, b}, {b, a}] (пишу NSort, чтобы подчеркнуть отличие от Sort: при любом означивании всех символов их числовыми значениями выражения должны совпасть). Или, например, NMin[a, b, c] -> Piecewise[{{a, a <= b && a <= c}, {b, b <= a && b <= c}}, c].
Обратите внимание, что все символы a, b, c вполне могут не обладать числовым значением.

Скажем, так задача поставлена: вот есть матрица $n\times n$, каждую строку нужно отсортировать (матрицу можно не менять) и затем сравнить наибольший элемент из первого столбца и наименший элемент из второго столбца, причём все или некоторые элементы могут представляться выражениями с символами, которые не имеют числовые значения, хотя в $Assumptions предполагаются Reals или Complexes.

Основная проблема видится в том, что нельзя просто так взять несколько Piecewise и начать их сравнивать, сделав глобальный Piecewise, а затем раскрыть всё при помощи PiecewiseExpand, потому что число вариантов значений/условий такого монстра будет произведением числа вариантов значений/условий составляющих его условных выражений. И если число вариантов упорядочения каждой строки матрицы $n!$, то число вариантов любого выражения с двумя строками $n!^2$ — слишком много.

На данный момент эта проблема не актуальна, свою задачу решил численным методом: для большого числа точек из пространства параметров отсортировал численно и сравнил численно, построив некоторую достаточно красивую и понятную диаграмму. Тем не менее, такое решение не общно и хотелось бы уметь получать автоматически выражения в символьном виде. В будущем может снова стать актуальной.

[agua]

Mysterious Light в сообщении #1027457 писал(а):

Например, пусть даны три списка L1, L2 и L3 длины n, нужно сравнить максимальное (среди списков) из наименьших чисел и минимальное из средних чисел каждого списка.

Здесь имелось в виду следующее?

(Max @@ Min /@ # - Min @@ Mean /@ # ) & @ {L1, L2, L3}

Цитата:

все символы a, b, c вполне могут не обладать числовым значением...
при любом означивании всех символов их числовыми значениями выражения должны совпасть...
все или некоторые элементы могут представляться выражениями с символами, которые не имеют числовые значения...

Но как тогда проводится сравнение элементов? Почему просто не вычислить значение выражения, когда все значения переменных-символов уже известны? Для этого есть какие-то причины? Может быть вместо Piecewise имеет смысл написать свою функцию сравнения (по типу Less в примере выше при сравнении числовых выражений) – тогда и необходимость в Piecewise отпадёт сама собой. Опять же, если я правильно понимаю задачу. Впрочем, если задача уже не актуальна, это не так важно.

upd

Цитата:

Например, хотелось бы, что WM самостоятельно делалал такое преобразование NSort[{a, b}] -> If[a < b, {a, b}, {b, a}]

Тогда, учитывая собственные наработки, может лучше сразу так:

NSort[list_List] :=
  Piecewise[
   Table[
    {p, LessEqual @@ p},
    {p, Permutations[list]}
    ], Null]

[agua]

В результате получаем то же самое, но гораздо (в n раз) быстрее:

NSort[{a1, a2, a3}] // InputForm

Piecewise[{
  {{a1, a2, a3}, a1 <= a2 <= a3},
  {{a1, a3, a2}, a1 <= a3 <= a2},
  {{a2, a1, a3}, a2 <= a1 <= a3},
  {{a2, a3, a1}, a2 <= a3 <= a1},
  {{a3, a1, a2}, a3 <= a1 <= a2},
  {{a3, a2, a1}, a3 <= a2 <= a1}
  }, Null]

Аналогично для функции Min:

NMin[list_List] :=
  With[{n = Length[list]},
   Piecewise[
    Table[
     {list[[k]], And @@ (LessEqual[list[[k]], #] & /@ Drop[list, {k}])},
     {k, n}
     ], Null]]

NMin[{a1, a2, a3, a4, a5}] // InputForm

Piecewise[{
  {a1, a1 <= a2 && a1 <= a3 && a1 <= a4 && a1 <= a5}, 
  {a2, a2 <= a1 && a2 <= a3 && a2 <= a4 && a2 <= a5}, 
  {a3, a3 <= a1 && a3 <= a2 && a3 <= a4 && a3 <= a5}, 
  {a4, a4 <= a1 && a4 <= a2 && a4 <= a3 && a4 <= a5}, 
  {a5, a5 <= a1 && a5 <= a2 && a5 <= a3 && a5 <= a4}
  }, Null]

Быстрее уже вряд ли получится. Хотя глубокого смысла я в этом всё равно не вижу (если только как раз не ставится задача получить такие вот piecewise-выражения в явном виде). Если же речь идёт о том, что на момент вычислений значения всех переменных ещё не известны, то можно ведь просто в нужных местах расставить SetDelayed, With, Block или Module.

[Mysterious Light]

(Оффтоп)

Символьные вычисления — это вычисления, в которых присутствуют символы, которые на момент самого вычисления не имеют значения или это значение не рассматривается. В большинстве языков программирования символьные вычисления не предполагаются, потому что при вычислении выражения вместо всех переменных подставляются их значения; строго говоря, каждый символ в каждый момент обладает своим значением. В некоторых языках допускается порядок вычисления, при котором значение подставляется не при первом упоминании символа, а позже, и до той поры с символом работают как с символом. В математике (я про формальную науку) преимущественно работают с символами так. В частности, можно при помощи законов алгебры доказать $a+(b-a) = b$, не предполагая, что $a$ и $b$ обладают конкретными значениями.
WM тем мне интересен, что он может работать с символами. В частности, если ввести a+(b-a), то WM выдаст b, хотя ни a, ни b числового значения не имеют.

Символьные вычисления имеют преимущество над численными: в тех случаях, когда сложное выражение можно свести к более простому, результат можно рассматривать в виде некой явной формулы. Любые численные рассчёты дадут лишь общее представление о виде результата.
Вот мне, например, нужно было в пространстве параметров построить фигуру, которая соответствует условию, которое написал в первом; Вы почти правильно его записали, хотя правильнее было бы

(Max @@ Min /@ # < Min @@ (Sort[#, Less][[2]]& /@ #) ) & @ {L1, L2, L3}

Я её построил численно: взял несколько точек (~10 000) и посчитал для каждой, выполняется ли условие, нужные закрасил. Далее посмотрел на фигуру и сказал себе: вот в этом промежутке условие не зависит от этого параметра, в этом — от другого, а здесь граница идёт как бы по параболе (на самом деле это оказался арктангенс перевёрнутый) и т.д. У меня есть рисунок, а внятной формулы, её описывающей, нет.
Используя символьные вычисления я хотел бы написать условие (которое выше записано) и WM бы упростила это выражение по-максимуму, чтобы на выходе была сравнительно небольшая формула, которая аналитически (т.е. в буквах) описывает фигуру, которая уже построена численно.

Я надеюсь, что значимость метода понятна.
Конретная задача приведена в первом посте и в более общем виде в третьем.
Проблема не в том, что эту задачу нельзя решить в принципе, а в том, что сложность имеющегося у меня (велосипедного) решения совершенно неприемлема.

[agua]

Спасибо за пояснения – теперь суть исходной задачи мне понятна. Фактически, речь идёт о группе из трёх точек в трёхмерном пространстве, координаты каждой точки сортируются по возрастанию и для отсортированных координат сравнивается максимум абсцисс с минимумом ординат.

Т.е. предполагалось получить что-то похожее на следующий код:

NSort[list] := Table[{p, LessEqual @@ p}, {p, Permutations[list]}];
L = NSort /@ {{a1, a2, a3}, {a4, a5, a6}, {a7, a8, a9}};
T = Flatten[Table[{x1, x2, x3}, {x1, L[[1]]}, {x2, L[[2]]}, {x3, L[[3]]}], 2];
M = {Max @ #[[1]] < Min @ #[[2]] & @ Transpose @ #[[1]], And @@ #[[2]]} & /@ Transpose /@ T;
Piecewise @ M

но с дальнейшим разворачиванием также функций Max и Min.

(Оффтоп)

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