Что находится в сумке для инструментов Mathematica?

Мы все знаем, что Mathematica велик, но также часто не хватает критической функциональности. Какие внешние пакеты/инструменты/ресурсы вы используете с Mathematica?

Я отредактирую (и приглашу кого-нибудь еще сделать это тоже) эту основную должность, чтобы включить ресурсы, которые ориентированы на общую применимость в научных исследованиях и которые, как можно больше людей, будут полезны. Не стесняйтесь вносить что-либо, даже небольшие фрагменты кода (как я сделал ниже для временной процедуры).

Кроме того, недокументированные и полезные функции в Mathematica 7 и выше, чем вы нашли себя, или вырыты из какой-либо бумаги/сайта, приветствуются.

Пожалуйста, добавьте краткое описание или комментарий о том, почему что-то замечательно или какая полезность он предоставляет. Если вы ссылаетесь на книги на Amazon с партнерскими ссылками, укажите это, например, разместив свое имя после ссылки.


Пакеты:

  • LevelScheme - это пакет, который значительно расширяет возможности Mathematica для создания привлекательных участков. Я использую его, если не для чего-то еще, для значительно улучшенного контроля над рамками/осями. Его новейшая версия называется SciDraw, и она будет выпущена в этом году.
  • David Park Presentation Package (50 долларов США - бесплатно для обновлений)
  • Джереми Майкельсон grassmannOps пакет предоставляет ресурсы для выполнения алгебры и исчисления с помощью переменных Грассмана и операторов, которые имеют нетривиальные отношения коммутации.
  • Джон Браун GrassmannAlgebra пакет и книга для работы с алгебрами Грассмана и Клиффорда.
  • RISC (Research Institute for Symbolic Computation) имеет множество пакетов для Mathematica (и других языков), доступных для загрузки. В частности, существует Theorema для автоматического подтверждения теоремы, а множество пакетов для символического суммирования, разностных уравнений и т.д. В Страница программного обеспечения группы алгоритмических комбинатоников.

Инструменты:

  • MASH является Daniel Reeves отлично Perl script, в основном обеспечивающий поддержку скриптов для Mathematica v7. (Теперь встроен в Mathematica 8 с опцией -script.)
  • alternate Mathematica shell с входом для чтения GNU (с использованием только python, * nix)
  • Пакет ColourMaths позволяет визуально выбирать части выражения и манипулировать ими. http://www.dbaileyconsultancy.co.uk/colour_maths/colour_maths.html

Ресурсы

  • Собственный репозиторий Wolfram MathSource имеет много полезного, если узкие ноутбуки для различных приложений. Также проверьте другие разделы, например

  • Mathematica Wikibook.

Книги:

  • Математическое программирование: расширенное введение Леонида Шифрина (web, pdf) является обязательным для чтения, если вы хотите сделать что-либо большее, чем для циклов в Mathematica. Мы с удовольствием имеем Leonid ответы на вопросы здесь.
  • Квантовые методы с математикой Джеймса Ф. Фейгина (amazon)
  • Математическая книга Стивена Вольфрама (amazon) (web)
  • Шаум Эскиз (amazon)
  • Математика в действии Стэна Вагона (amazon) - 600 страниц опрятных примеров и подходит к версии Mathematica 7. Технологии визуализации особенно хороши, вы можете увидеть некоторые из них на авторе Demonstrations Page.
  • Основы математического программирования Ричарда Гейлорда (pdf) - хорошее краткое введение в большинство того, что вам нужно знать о программировании Mathematica.
  • Поваренная книга Mathematica от Sal Mangano, опубликованная O'Reilly 2010 832 страницы. - Написано в известном стиле поваренной книги О'Рейли: Проблема - Решение. Для промежуточных продуктов.
  • Дифференциальные уравнения с математикой, 3-е изд. Elsevier 2004 Amsterdam Марта Л. Абелл, Джеймс П. Бразельтон - 893 страницы Для начинающих изучайте решения DE и Mathematica в то же время.

Недокументированные (или едва документированные) функции:

  1. Как настроить сочетания клавиш Mathematica. См. this question.
  2. Как проверить шаблоны и функции, используемые собственными функциями Mathematica. См. this answer
  3. Как добиться согласованного размера GraphPlots в Mathematica? См. this question.
  4. Как создавать документы и презентации с помощью Mathematica. См. this question.

Ответы

Ответ 1

Раньше я упоминал , но инструмент, который я считаю наиболее полезным, представляет собой приложение Reap и Sow, которое имитирует/расширяет поведение GatherBy:

SelectEquivalents[x_List,f_:Identity, g_:Identity, h_:(#2&)]:=
   Reap[Sow[g[#],{f[#]}]&/@x, _, h][[2]];

Это позволяет мне группировать списки по любым критериям и преобразовывать их в процесс. Способ, которым он работает, заключается в том, что функция критериев (f) помещает каждый элемент в список, каждый элемент затем преобразуется второй поставленной функцией (g), а конкретный вывод управляется третьей функцией (h). Функция h принимает два аргумента: тег и список собранных элементов, имеющих этот тег. Элементы сохраняют свой первоначальный порядок, поэтому, если вы установите h = #1&, вы получите несортированный Union, как в примеры для Reap. Но его можно использовать для вторичной обработки.

В качестве примера его полезности я работал с Wannier90, который выводит пространственно зависимый гамильтониан в файл, где каждая строка другой элемент в матрице, как следует

rx ry rz i j Re[Hij] Im[Hij]

Чтобы превратить этот список в набор матриц, я собрал все подсписки, которые содержат одну и ту же координату, превратил информацию о элементе в правило (т.е. {i, j} → Re [Hij] + я Im [Hij]), а затем превратили собранные правила в SparseArray все с одним слоем:

SelectEquivalents[hamlst, 
      #[[;; 3]] &, 
      #[[{4, 5}]] -> (Complex @@ #[[6 ;;]]) &, 
      {#1, SparseArray[#2]} &]

Честно говоря, это мой швейцарский армейский нож, и это делает сложные вещи очень простыми. Большинство моих других инструментов несколько специфичны для домена, поэтому я, вероятно, не опубликую их. Однако большинство из них, если не все, ссылаются на SelectEquivalents.

Изменить: он не полностью имитирует GatherBy тем, что не может группировать несколько уровней выражение просто как GatherBy. Тем не менее, Map отлично работает для большей части того, что мне нужно.

Пример: @Ярослав Булатов попросил сделать самостоятельный пример. Здесь один из моих исследований, который был значительно упрощен. Итак, допустим, мы имеем множество точек в плоскости

In[1] := pts = {{-1, -1, 0}, {-1, 0, 0}, {-1, 1, 0}, {0, -1, 0}, {0, 0, 0}, 
 {0, 1, 0}, {1, -1, 0}, {1, 0, 0}, {1, 1, 0}}

и мы хотим уменьшить количество точек множеством операций симметрии. (Для любопытных мы генерируем небольшую группу каждой точки.) В этом примере позвольте использовать четырехмерную ось вращения вокруг z Оу

In[2] := rots = RotationTransform[#, {0, 0, 1}] & /@ (Pi/2 Range[0, 3]);

Используя SelectEquivalents, мы можем группировать точки, которые производят один и тот же набор изображений в этих операциях, т.е. эквивалентны, используя следующие

In[3] := SelectEquivalents[ pts, Union[Through[rots[#] ] ]& ] (*<-- Note Union*)
Out[3]:= {{{-1, -1, 0}, {-1, 1, 0}, {1, -1, 0}, {1, 1, 0}},
          {{-1, 0, 0}, {0, -1, 0}, {0, 1, 0}, {1, 0, 0}},
          {{0,0,0}}}

который создает 3 подсписки, содержащие эквивалентные точки. (Примечание: Union здесь абсолютно необходимо, так как это гарантирует, что каждое изображение создается одним и тем же изображением. Первоначально я использовал Sort, но если точка лежит на оси симметрии, она инвариантна относительно вращения вокруг этой оси давая дополнительный образ самого себя. Таким образом, Union устраняет эти дополнительные изображения. Кроме того, GatherBy приведет к такому же результату.) В этом случае точки уже находятся в форме, которую я буду использовать, но мне нужно только представительный пункт от каждой группировки, и я бы хотел подсчитать эквивалентные точки. Поскольку мне не нужно преобразовывать каждую точку, я использую функцию Identity во второй позиции. Для третьей функции нам нужно быть осторожным. Первым переданным им аргументом будут изображения точек под поворотами, которые для точки {0,0,0} представляют собой список из четырех идентичных элементов, и использование этого будет сбросить счет. Однако второй аргумент - это всего лишь список всех элементов, которые имеют этот тег, поэтому он будет содержать только {0,0,0}. В коде

In[4] := SelectEquivalents[pts,  
             Union[Through[rots[#]]]&, #&, {#2[[1]], Length[#2]}& ]
Out[4]:= {{{-1, -1, 0}, 4}, {{-1, 0, 0}, 4}, {{0, 0, 0}, 1}}

Обратите внимание, что этот последний шаг можно легко выполнить с помощью

In[5] := {#[[1]], Length[#]}& /@ Out[3]

Но, с этим и менее полным примером, легко понять, насколько возможны очень сложные преобразования с минимальным кодом.

Ответ 2

Одна из приятных особенностей интерфейса ноутбука Mathematica заключается в том, что он может оценивать выражения на любом языке, а не только Mathematica. В качестве простого примера рассмотрим создание нового типа входных ячеек оболочки, который передает содержащее выражение в оболочку операционной системы для оценки.

Сначала определите функцию, которая делегирует оценку текстовой команды внешней оболочке:

shellEvaluate[cmd_, _] := Import["!"~~cmd, "Text"]

Второй аргумент необходим и игнорируется по причинам, которые станут очевидными позже. Затем мы хотим создать новый стиль под названием Shell:

  • Откройте новый ноутбук.
  • Выберите пункт меню "Формат" / "Редактировать таблицу стилей"...
  • В диалоговом окне рядом с Введите имя стиля: type Shell.
  • Выберите ячейку рядом с новым стилем.
  • Выберите пункт меню Ячейка/Показать выражение
  • Запишите выражение ячейки с текстом Шаг 6, приведенным ниже.
  • Еще раз выберите пункт меню Ячейка/Показать выражение
  • Закройте диалоговое окно.

Используйте следующее выражение ячейки как Шаг 6 Текст:

Cell[StyleData["Shell"],
 CellFrame->{{0, 0}, {0.5, 0.5}},
 CellMargins->{{66, 4}, {0, 8}},
 Evaluatable->True,
 StripStyleOnPaste->True,
 CellEvaluationFunction->shellEvaluate,
 CellFrameLabels->{{None, "Shell"}, {None, None}},
 Hyphenation->False,
 AutoQuoteCharacters->{},
 PasteAutoQuoteCharacters->{},
 LanguageCategory->"Formula",
 ScriptLevel->1,
 MenuSortingValue->1800,
 FontFamily->"Courier"]

Большая часть этого выражения была скопирована непосредственно из встроенного стиля программы. Ключевыми изменениями являются следующие строки:

 Evaluatable->True,
 CellEvaluationFunction->shellEvaluate,
 CellFrameLabels->{{None, "Shell"}, {None, None}},

Evaluatable позволяет использовать функцию SHIFT + ENTER для ячейки. Оценка вызовет CellEvaluationFunction, передавая содержимое ячейки и тип содержимого в качестве аргументов (shellEvaluate игнорирует последний аргумент). CellFrameLabels - это просто тонкость, которая позволяет пользователю определить, что эта ячейка необычна.

Со всем этим на месте мы можем теперь ввести и оценить выражение оболочки:

  • В записной книжке, созданной в приведенных выше шагах, создайте пустую ячейку и выберите ячейку.
  • Выберите пункт меню "Формат/Стиль/Оболочка".
  • Введите действительную команду оболочки операционной системы в ячейку (например, "ls" в Unix или "dir" в Windows).
  • Нажмите SHIFT + ВВОД.

Лучше всего сохранить этот определенный стиль в таблицах стилей, расположенных в центре. Кроме того, функции оценки, такие как shellEvaluate, лучше всего определять как заглушки, используя DeclarePackage в init.m. Подробности обоих этих действий выходят за рамки этого ответа.

С помощью этой функции можно создавать ноутбуки, содержащие входные выражения в любом интересующем синтаксисе. Функция оценки может быть записана в чистом Mathematica или делегировать любую или всю часть оценки внешнему агентству. Имейте в виду, что есть другие крючки, которые относятся к оценке ячейки, например, CellEpilog, CellProlog и CellDynamicExpression.

Общий шаблон предполагает запись текста входного выражения во временный файл, компиляцию файла на каком-то языке, запуск программы и запись вывода для окончательного отображения в выходной ячейке. Есть много подробностей, которые нужно решать при реализации полного решения такого рода (например, правильно фиксировать сообщения об ошибках), но нужно понимать, что это возможно не только для этого, но и для практического использования.

В личной заметке такие функции, как это, делают интерфейс ноутбука центром моего юниверса программирования.

Обновление

Следующая вспомогательная функция полезна для создания таких ячеек:

evaluatableCell[label_String, evaluationFunction_] :=
  ( CellPrint[
      TextCell[
        ""
      , "Program"
      , Evaluatable -> True
      , CellEvaluationFunction -> (evaluationFunction[#]&)
      , CellFrameLabels -> {{None, label}, {None, None}}
      , CellGroupingRules -> "InputGrouping"
      ]
    ]
  ; SelectionMove[EvaluationNotebook[], All, EvaluationCell]
  ; NotebookDelete[]
  ; SelectionMove[EvaluationNotebook[], Next, CellContents]
  )

Используется таким образом:

shellCell[] := evaluatableCell["shell", Import["!"~~#, "Text"] &]

Теперь, если оценивается shellCell[], входная ячейка будет удалена и заменена новой ячейкой ввода, которая оценивает ее содержимое как команду оболочки.

Ответ 3

Тодд Гейли (Wolfram Research) просто присылает мне хороший хак, который позволяет "обернуть" встроенные функции с помощью произвольного кода. Я чувствую, что должен поделиться этим полезным инструментом. Следующим является ответ Тодда на мой question.

Немного интересной (?) истории: этот стиль взлома для "обертывания" встроенная функция была изобретена около 1994 года Робби Виллегасом и мной, по иронии судьбы для функции Message, в пакете под названием ErrorHelp что я написал для журнала Mathematica тогда. Он был использован много раз, многими людьми, с тех пор. Это немного инсайдер трюк, но я считаю справедливым сказать, что он стал каноническим способ введения собственного кода в определение встроенного функция. Он прекрасно выполняет свою работу. Вы можете, конечно, поставить $inMsg в любой частный контекст, который вы пожелаете.

Unprotect[Message];

Message[args___] := Block[{$inMsg = True, result},
   "some code here";
   result = Message[args];
   "some code here";
   result] /; ! TrueQ[$inMsg]

Protect[Message];

Ответ 4

Это не полный ресурс, поэтому я бросаю его сюда в разделе ответов, но я нашел его очень полезным при определении скорости (что, к сожалению, является большой частью того, что программирует Mathematica).

timeAvg[func_] := Module[
{x = 0, y = 0, timeLimit = 0.1, p, q, iterTimes = Power[10, Range[0, 10]]},
Catch[
 If[(x = First[Timing[(y++; Do[func, {#}]);]]) > timeLimit,
    Throw[{x, y}]
    ] & /@ iterTimes
 ] /. {p_, q_} :> p/iterTimes[[q]]
];
Attributes[timeAvg] = {HoldAll};

Теперь использование просто [email protected].

EDIT: Mr. Wizard предоставил более простую версию, которая устраняет Throw и Catch и немного легче разобрать:

SetAttributes[timeAvg, HoldFirst]
timeAvg[func_] := Do[If[# > 0.3, Return[#/5^i]] & @@ 
                     Timing @ Do[func, {5^i}]
                     ,{i, 0, 15}]

EDIT: здесь версия acl (взята из здесь):

timeIt::usage = "timeIt[expr] gives the time taken to execute expr, \
  repeating as many times as necessary to achieve a total time of 1s";

SetAttributes[timeIt, HoldAll]
timeIt[expr_] := Module[{t = Timing[expr;][[1]], tries = 1},
  While[t < 1., tries *= 2; t = Timing[Do[expr, {tries}];][[1]];]; 
  t/tries]

Ответ 5

Internal`InheritedBlock

Недавно я узнал о существовании такой полезной функции, как Internal`InheritedBlock, от этого сообщения Даниэля Лихтблау в официальной телеконференции.

Как я понимаю, Internal`InheritedBlock позволяет передать копию исходящей функции внутри области Block:

In[1]:= Internal`InheritedBlock[{Message},
Print[Attributes[Message]];
Unprotect[Message];
Message[x___]:=Print[{{x},Stack[]}];
Sin[1,1]
]
Sin[1,1]
During evaluation of In[1]:= {HoldFirst,Protected}
During evaluation of In[1]:= {{Sin::argx,Sin,2},{Internal`InheritedBlock,CompoundExpression,Sin,Print,List}}
Out[1]= Sin[1,1]
During evaluation of In[1]:= Sin::argx: Sin called with 2 arguments; 1 argument is expected. >>
Out[2]= Sin[1,1]

Я думаю, что эта функция может быть очень полезной для всех, кто временно модифицирует встроенные функции!

Сравнение с блоком

Определим некоторую функцию:

a := Print[b]

Теперь мы хотим передать копию этой функции в область Block. Наивное испытание не дает того, что мы хотим:

In[2]:= Block[{a = a}, OwnValues[a]]

During evaluation of In[9]:= b

Out[2]= {HoldPattern[a] :> Null}

Теперь попробуйте использовать отложенное определение в первом аргументе Block (это тоже недокументированная функция):

In[3]:= Block[{a := a}, OwnValues[a]]
Block[{a := a}, a]

Out[3]= {HoldPattern[a] :> a}

During evaluation of In[3]:= b

Мы видим, что в этом случае a работает, но мы не получили копию исходного a внутри области Block.

Теперь попробуем Internal`InheritedBlock:

In[5]:= Internal`InheritedBlock[{a}, OwnValues[a]]

Out[5]= {HoldPattern[a] :> Print[b]}

У нас есть копия исходного определения для a внутри области Block, и мы можем изменить ее так, как мы хотим, не затрагивая глобальное определение для a!

Ответ 6

Mathematica - это острый инструмент, но он может вырезать вам несколько нетипизированное поведение и лавины cryptic диагностические сообщения. Один из способов борьбы с этим - определить функции, следующие за этой идиомой:

[email protected]
SetAttributes[zot, ...]
zot[a_] := ...
zot[b_ /; ...] := ...
zot[___] := (Message[zot::invalidArguments]; Abort[])

Это много шаблонов, которые я часто испытываю искушение пропустить. Особенно, когда прототипирование, что случается очень много в Mathematica. Итак, я использую макрос под названием define, который позволяет мне оставаться дисциплинированным, с гораздо меньшим количеством шаблонов.

Основное использование define выглядит следующим образом:

define[
  fact[0] = 1
; fact[n_ /; n > 0] := n * fact[n-1]
]

fact[5]

120

Сначала это не выглядит много, но есть некоторые скрытые преимущества. Первая услуга, предоставляемая define, заключается в том, что она автоматически применяет ClearAll к определяемому символу. Это гарантирует отсутствие остаточных определений - обычное явление при начальной разработке функции.

Вторая услуга заключается в том, что определяемая функция автоматически закрывается. Под этим я подразумеваю, что функция выдает сообщение и прерывается, если он вызывается с помощью списка аргументов, который не соответствует одному из определений:

fact[-1]

define::badargs: There is no definition for 'fact' applicable to fact[-1].
$Aborted

Это основное значение define, которое выдает очень распространенный класс ошибок.

Другим удобством является сжатый способ указания атрибутов для определяемой функции. Пусть функция Listable:

define[
  fact[0] = 1
; fact[n_ /; n > 0] := n * fact[n-1]
, Listable
]

fact[{3, 5, 8}]

{6, 120, 40320}

В дополнение ко всем нормальным атрибутам define принимает дополнительный атрибут Open. Это предотвращает define от добавления определения ошибки catch-all к функции:

define[
  successor[x_ /; x > 0] := x + 1
, Open
]

successor /@ {1, "hi"}

{2, successor["hi"]}

Для функции могут быть определены несколько атрибутов:

define[
  flatHold[x___] := Hold[x]
, {Flat, HoldAll}
]

flatHold[flatHold[1+1, flatHold[2+3]], 4+5]

Hold[1 + 1, 2 + 3, 4 + 5]

Без дальнейших церемоний, вот определение define:

[email protected]
SetAttributes[define, HoldAll]
define[body_, attribute_Symbol] := define[body, {attribute}]
define[body:(_Set|_SetDelayed), attributes_List:{}] := define[CompoundExpression[body], attributes]
define[body:CompoundExpression[((Set|SetDelayed)[name_Symbol[___], _])..], attributes_List:{}] :=
  ( [email protected]
  ; SetAttributes[name, DeleteCases[attributes, Open]]
  ; If[!MemberQ[attributes, Open]
    , def:name[___] := (Message[define::badargs, name, [email protected]]; Abort[])
    ]
  ; body
  ;
  )
def:define[___] := (Message[define::malformed, [email protected]]; Abort[])

define::badargs = "There is no definition for '``' applicable to ``.";
define::malformed = "Malformed definition: ``";

Представленная реализация не поддерживает ни верхние значения, ни currying, ни шаблоны более общие, чем простое определение функции. Однако он остается полезным.

Ответ 7

Начать без открытой открытой записной книжки

Меня беспокоило, что Mathematica начинается с пустой записной книжки. Я мог бы закрыть этот ноутбук с помощью script, но он все равно вспыхнул бы кратковременно. Мой взлом - создать файл Invisible.nb, содержащий:

Notebook[{},Visible->False]

И добавьте это в мой Kernel\init.m:

If[Length[Notebooks["Invisible*"]] > 0, 
  NotebookClose[Notebooks["Invisible*"][[1]]]
]

SetOptions[$FrontEnd,
  Options[$FrontEnd, NotebooksMenu] /. 
    HoldPattern["Invisible.nb" -> {__}] :> Sequence[]
]

Теперь я запускаю Mathematica, открывая Invisible.nb

Может быть, лучший способ, но это хорошо послужило мне.


Индивидуальные Fold и FoldList

Fold[f, x] эквивалентен Fold[f, [email protected], [email protected]]

Кстати, я считаю, что это может найти путь к будущей версии Mathematica.

Сюрприз! Это было реализовано, хотя оно в настоящее время недокументировано. Мне сообщили, что он был реализован в 2011 году Оливером Рюбенененигом, видимо, вскоре после того, как я опубликовал это. Спасибо, Оливер Рюбененениг!

Unprotect[Fold, FoldList]

Fold[f_, h_[a_, b__]] := Fold[f, Unevaluated @ a, h @ b]
FoldList[f_, h_[a_, b__]] := FoldList[f, Unevaluated @ a, h @ b]

(* Faysal recommendation to modify SyntaxInformation *)
SyntaxInformation[Fold]     = {"ArgumentsPattern" -> {_, _, _.}};
SyntaxInformation[FoldList] = {"ArgumentsPattern" -> {_, _., {__}}};

Protect[Fold, FoldList]

Обновлено, чтобы разрешить следующее:

SetAttributes[f, HoldAll]
Fold[f, Hold[1 + 1, 2/2, 3^3]]
f[f[1 + 1, 2/2], 3^3]

"Динамическое разделение"

См. Сообщение # 7512 в формате Mathematica.SE для новой версии этой функции.

Часто я хочу разбить список в соответствии с последовательностью длин.

Пример псевдокода:

partition[{1,2,3,4,5,6}, {2,3,1}]

Выход: {{1,2}, {3,4,5}, {6}}

Я придумал это:

dynP[l_, p_] := 
 MapThread[l[[# ;; #2]] &, {{0} ~Join~ [email protected]# + 1, #} &@[email protected]]

Который я завершил с этим, включая тестирование аргументов:

dynamicPartition[l_List, p : {_Integer?NonNegative ..}] :=
  dynP[l, p] /; [email protected] >= [email protected]

dynamicPartition[l_List, p : {_Integer?NonNegative ..}, All] :=
  dynP[l, p] ~Append~ Drop[l, [email protected]] /; [email protected] >= [email protected]

dynamicPartition[l_List, p : {_Integer?NonNegative ..}, n__ | {n__}] :=
  dynP[l, p] ~Join~ Partition[l ~Drop~ [email protected], n] /; [email protected] >= [email protected]

Третий аргумент управляет тем, что происходит с элементами за пределами спецификации split.


трюки Szabolcs Mathematica

Чаще всего я использую палитру таблиц пасты

[email protected]
 [email protected]{Button["TSV", 
    Module[{data, strip}, 
     data = NotebookGet[ClipboardNotebook[]][[1, 1, 1]];
     strip[s_String] := 
      StringReplace[s, RegularExpression["^\\s*(.*?)\\s*$"] -> "$1"];
     strip[e_] := e;
     If[Head[data] === String, 
      NotebookWrite[InputNotebook[], 
       [email protected][strip, ImportString[data, "TSV"], {2}]]]]], 
   Button["CSV", 
    Module[{data, strip}, 
     data = NotebookGet[ClipboardNotebook[]][[1, 1, 1]];
     strip[s_String] := 
      StringReplace[s, RegularExpression["^\\s*(.*?)\\s*$"] -> "$1"];
     strip[e_] := e;
     If[Head[data] === String, 
      NotebookWrite[InputNotebook[], 
       [email protected][strip, ImportString[data, "CSV"], {2}]]]]], 
   Button["Table", 
    Module[{data}, data = NotebookGet[ClipboardNotebook[]][[1, 1, 1]];
     If[Head[data] === String, 
      NotebookWrite[InputNotebook[], 
       [email protected][data, "Table"]]]]]}

Изменить внешние данные из Compile

Недавно Даниэль Лихтблау показал этот метод, которого я никогда раньше не видел. По-моему, это значительно расширяет полезность Compile

ll = {2., 3., 4.};
c = Compile[{{x}, {y}}, ll[[1]] = x; y];

c[4.5, 5.6]

ll

(* Out[1] = 5.6  *)

(* Out[2] = {4.5, 3., 4.}  *)

Ответ 8

Общие проблемы и решения экспорта PDF/EMF

1) Это совершенно неожиданно и недокументировано, но Mathematica экспортирует и сохраняет графику в форматах PDF и EPS с использованием набора определений стиля, который отличается от того, который используется для отображения ноутбуков на экране. По умолчанию Ноутбуки отображаются на экране в среде "Рабочий" стиль (который является значением по умолчанию для параметра ScreenStyleEvironment global $FrontEnd), но печатаются в среде стиля "Printout" (который является значением по умолчанию для PrintingStyleEnvironment глобальная опция $FrontEnd). Когда вы экспортируете графику в растровые форматы, такие как GIF и PNG или в формате EMF, Mathematica генерирует графику, которая выглядит так, как будто она выглядит внутри ноутбука. Кажется, что среда стиля "Working" используется для рендеринга в этом случае. Но это не тот случай, когда вы экспортируете/сохраняете что-либо в форматах PDF или EPS! В этом случае по умолчанию используется "Printout" стиль стиля, который очень сильно отличается от среды "Рабочий" стиль. Прежде всего среда стиля "Printout" устанавливает Magnification в 80%. Во-вторых, он использует свои собственные значения для размеров шрифтов разных стилей, и это приводит к несогласованным изменениям размера шрифта в расширенном PDF файле по сравнению с оригинальным представлением на экране. Последнее можно назвать колебания FontSize, которые очень раздражают. Но, к счастью, этого можно избежать , установив для параметра PrintingStyleEnvironment global $FrontEnd значение "Working" :

SetOptions[$FrontEnd, PrintingStyleEnvironment -> "Working"]

2) Общая проблема с экспортом в формат EMF заключается в том, что большинство программ (а не только Mathematica) генерируют файл, который отлично выглядит по умолчанию, но становится уродливым, когда вы его увеличиваете. Это потому, что метафайлы отбираются при верности разрешения экрана. Качество созданного файла EMF можно улучшить с помощью Magnify исходного графического объекта, чтобы точность выборки исходной графики стала намного более точной. Сравните два файла:

graphics1 = 
  [email protected][
    ExportString[Style["a", FontFamily -> "Times"], "PDF"], "PDF"];
graphics2 = Magnify[graphics1, 10];
Export["C:\\test1.emf", graphics1]
Export["C:\\test2.emf", graphics2]

Если вы вставляете эти файлы в Microsoft Word и увеличиваете их число, вы увидите, что первый "a" имеет на нем пилот, а второй - нет (протестирован с Mathematica 6).

Другой путь через ImageResolution был предложен Chris Degnen (этот вариант действует, по крайней мере, начиная с Mathematica 8):

Export["C:\\test1.emf", graphics1]
Export["C:\\test2.emf", graphics1, ImageResolution -> 300]

3) В Mathematica у нас есть три способа преобразования графики в метафайл: через Export в "EMF" (настоятельно рекомендуется: создает метафайл с максимально возможным качеством), через пункт Save selection As... (дает гораздо меньшую точную цифру, не рекомендуется) и через пункт меню Edit ► Copy As ► Metafile (Я настоятельно рекомендую этот маршрут).

Ответ 9

По популярному требованию, код для генерации заголовка SO-заголовков топ-10 (кроме аннотаций) с помощью SO API.

enter image description here

getRepChanges[userID_Integer] :=
 Module[{totalChanges},
  totalChanges = 
   "total" /. 
    Import["http://api.stackoverflow.com/1.1/users/" <> 
      ToString[userID] <> "/reputation?fromdate=0&pagesize=10&page=1",
      "JSON"];
  Join @@ Table[
    "rep_changes" /. 
     Import["http://api.stackoverflow.com/1.1/users/" <> 
       ToString[userID] <> 
       "/reputation?fromdate=0&pagesize=10&page=" <> ToString[page], 
      "JSON"],
    {page, 1, Ceiling[totalChanges/10]}
    ]
  ]

topAnswerers = ({"display_name", 
      "user_id"} /. #) & /@ ("user" /. ("top_users" /. 
      Import["http://api.stackoverflow.com/1.1/tags/mathematica/top-\
answerers/all-time", "JSON"]))

repChangesTopUsers =
  Monitor[Table[
    repChange = 
     ReleaseHold[(Hold[{DateList[
              "on_date" + AbsoluteTime["January 1, 1970"]], 
             "positive_rep" - "negative_rep"}] /. #) & /@ 
        getRepChanges[userID]] // Sort;
    accRepChange = {repChange[[All, 1]], 
       Accumulate[repChange[[All, 2]]]}\[Transpose],
    {userID, topAnswerers[[All, 2]]}
    ], userID];

pl = DateListLogPlot[
  Tooltip @@@ 
   Take[({repChangesTopUsers, topAnswerers[[All, 1]]}\[Transpose]), 
    10], Joined -> True, Mesh -> None, ImageSize -> 1000, 
  PlotRange -> {All, {10, All}}, 
  BaseStyle -> {FontFamily -> "Arial-Bold", FontSize -> 16}, 
  DateTicksFormat -> {"MonthNameShort", " ", "Year"}, 
  GridLines -> {True, None}, 
  FrameLabel -> (Style[#, FontSize -> 18] & /@ {"Date", "Reputation", 
      "Top-10 answerers", ""})]

Ответ 10

Кэширование выражений

Я считаю, что эти функции очень полезны для кеширования любого выражения. Интересная вещь для этих двух функций заключается в том, что само проведенное выражение используется как ключ хэш-таблицы/символа Cache или CacheIndex по сравнению с хорошо известной memoization в математике, где вы можете только кэшировать результат, если функция определена как f [x_]: = f [x] =... Таким образом, вы можете кэшировать любую часть кода, это полезно, если функция должна вызываться несколько раз, но некоторые части кода не должны пересматриваться.

Чтобы кэшировать выражение независимо от его аргументов.

SetAttributes[Cache, HoldFirst];
c:Cache[expr_] := c = expr;

Ex: Cache[Pause[5]; 6]
Cache[Pause[5]; 6]

Во второй раз выражение возвращает 6 без ожидания.

Чтобы кэшировать выражение, используя выражение псевдонима, которое может зависеть от аргумента кэшированного выражения.

SetAttributes[CacheIndex, HoldRest];
c:CacheIndex[index_,expr_] := c = expr;

Ex: CacheIndex[{"f",2},x=2;y=4;x+y]

Если expr требует некоторого времени для вычисления, гораздо быстрее оценить { "f", 2}, например, для получения кэшированного результата.

Для вариации этих функций для локального кэша (т.е. кэш-память автоматически выходит за пределы конструкции блока) см. этот пост Избегайте повторных вызовов Интерполяции

Удаление кешированных значений

Чтобы удалить кешированные значения, когда вы не знаете количество определений функции. Я считаю, что определения имеют Blank где-то в своих аргументах.

DeleteCachedValues[f_] := 
       DownValues[f] = Select[DownValues[f], !FreeQ[[email protected]#,Pattern]&];

Чтобы удалить кешированные значения, когда вы знаете количество определений функции (идет немного быстрее).

DeleteCachedValues[f_,nrules_] := 
       DownValues[f] = Extract[DownValues[f], List /@ Range[-nrules, -1]];

Это использует тот факт, что определения функции находятся в конце списка DownValues, кешированные значения предшествуют.

Использование символов для хранения данных и объектно-подобных функций

Также есть интересные функции для использования символов, таких как объекты.

Уже известно, что вы можете хранить данные в символах и быстро обращаться к ним с помощью DownValues ​​

mysymbol["property"]=2;

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

SetAttributes[RemoveHead, {HoldAll}];
RemoveHead[h_[args___]] := {args};
NKeys[symbol_] := RemoveHead @@@ DownValues[symbol(*,Sort->False*)][[All,1]];
Keys[symbol_] := NKeys[symbol] /. {x_} :> x;

Я использую эту функцию много, чтобы отобразить всю информацию, содержащуюся в DownValues ​​символа:

PrintSymbol[symbol_] :=
  Module[{symbolKeys},
    symbolKeys = Keys[symbol];
    [email protected][{symbolKeys, symbol /@ symbolKeys}]
  ];

Наконец, вот простой способ создать символ, который ведет себя как объект в объектно-ориентированном программировании (он просто воспроизводит самое основное поведение ООП, но я считаю синтаксис элегантным):

Options[NewObject]={y->2};
NewObject[OptionsPattern[]]:=
  Module[{newObject},
    newObject["y"]=OptionValue[y];

    function[newObject,x_] ^:= newObject["y"]+x;
    newObject /: newObject.function2[x_] := 2 newObject["y"]+x;

    newObject
  ];

Свойства сохраняются как DownValues ​​и методы в качестве задержанных Upvalues ​​в символе, созданном возвращаемым модулем. Я нашел синтаксис для функции2, который является обычным OO-синтаксисом для функций в структуре данных дерева в Mathematica.

Для списка существующих типов значений, которые имеет каждый символ, см. http://reference.wolfram.com/mathematica/tutorial/PatternsAndTransformationRules.html и http://www.verbeia.com/mathematica/tips/HTMLLinks/Tricks_Misc_4.html.

Например, попробуйте это

x = NewObject[y -> 3];
function[x, 4]
x.function2[5]

Вы можете пойти дальше, если хотите эмулировать наследование объектов, используя пакет InheritRules, доступный здесь http://library.wolfram.com/infocenter/MathSource/671/

Вы также можете сохранить определение функции не в newObject, а в символе типа, поэтому, если NewObject возвратил тип [newObject] вместо newObject, вы могли бы определить функцию и функцию2, как это вне NewObject (а не внутри) и имеют такое же использование, как и раньше.

function[type[object_], x_] ^:= object["y"] + x;
type /: type[object_].function2[x_] := 2 object["y"]+x;

Используйте UpValues ​​[type], чтобы увидеть, что функция и функция2 определены в символе типа.

Дальнейшие идеи об этом последнем синтаксисе представлены здесь https://mathematica.stackexchange.com/a/999/66.

Улучшенная версия SelectEquivalents

@rcollyer: Большое спасибо за то, что вы выбрали SelectEquivalents на поверхности, это потрясающая функция. Вот улучшенная версия SelectEquivalents, перечисленная выше, с большим количеством возможностей и использованием опций, что упрощает ее использование.

Options[SelectEquivalents] = 
   {
      TagElement->Identity,
      TransformElement->Identity,
      TransformResults->(#2&) (*#1=tag,#2 list of elements corresponding to tag*),
      MapLevel->1,
      TagPattern->_,
      FinalFunction->Identity
   };

SelectEquivalents[x_List,OptionsPattern[]] := 
   With[
      {
         [email protected],
         [email protected],
         [email protected],
         [email protected],
         [email protected],
         [email protected]
      }
      ,
      finalFunction[
         Reap[
            Map[
               Sow[
                  [email protected]#
                  ,
                  {[email protected]#}
               ]&
               , 
               x
               , 
               {mapLevel}
            ] 
            , 
            tagPattern
            , 
            transformResults
         ][[2]]
      ]
   ];

Вот примеры того, как можно использовать эту версию:

Использование Mathematica Соберите/Соберите правильно

Как вы выполняете функцию сводной таблицы в Mathematica?

Быстрый алгоритм 2D-алгоритма Mathematica

Internal`Bag

Даниэль Лихтблау описывает здесь интересную внутреннюю структуру данных для растущих списков.

Внедрение Quadtree в Mathematica

Функции отладки

Эти два сообщения указывают на полезные функции для отладки:

Как отлаживать при написании небольших или больших кодов с помощью Mathematica? верстак? отладчик mma? или что-то еще? (ShowIt)

https://stackoverflow.com/questions/5459735/the-clearest-way-to-represent-mathematicas-evaluation-sequence/5527117#5527117 (TraceView)

Здесь другая функция, основанная на Reap и Sow, извлекает выражения из разных частей программы и сохраняет их в символе.

SetAttributes[ReapTags,HoldFirst];
ReapTags[expr_]:=
   Module[{elements},
      Reap[expr,_,(elements[#1]=#2/.{x_}:>x)&];
      elements
   ];

Здесь пример

ftest[]:=((*some code*)Sow[1,"x"];(*some code*)Sow[2,"x"];(*some code*)Sow[3,"y"]);
s=ReapTags[ftest[]];
Keys[s]
s["x"]
PrintSymbol[s] (*Keys and PrintSymbol are defined above*)

Другие ресурсы

Вот список интересных ссылок для обучения:

Коллекция учебных ресурсов Mathematica

Обновлено здесь: https://mathematica.stackexchange.com/a/259/66

Ответ 11

Мои служебные функции (у меня есть встроенные в MASH, что упоминается в вопросе):

pr = WriteString["stdout", ##]&;            (* More                           *)
prn = pr[##, "\n"]&;                        (*  convenient                    *)
perr = WriteString["stderr", ##]&;          (*   print                        *)
perrn = perr[##, "\n"]&;                    (*    statements.                 *)
re = RegularExpression;                     (* I wish mathematica             *)
eval = ToExpression[cat[##]]&;              (*  weren't so damn               *)
EOF = EndOfFile;                            (*   verbose!                     *)
read[] := InputString[""];                  (* Grab a line from stdin.        *)
doList[f_, test_] :=                        (* Accumulate list of what f[]    *)
  [email protected][f[]&, f[], test];      (*  returns while test is true.   *)
readList[] := doList[read, #=!=EOF&];       (* Slurp list'o'lines from stdin. *)
cat = [email protected]@(ToString/@{##})&;        (* Like sprintf/strout in C/C++.  *)
system = [email protected]@##&;                       (* System call.                   *)
backtick = Import[cat["!", ##], "Text"]&;   (* System call; returns stdout.   *)
slurp = Import[#, "Text"]&;                 (* Fetch contents of file as str. *)
                                            (* ABOVE: mma-scripting related.  *)
keys[f_, i_:1] :=                           (* BELOW: general utilities.      *)
  DownValues[f, Sort->False][[All,1,1,i]];  (* Keys of a hash/dictionary.     *)
SetAttributes[each, HoldAll];               (* each[pattern, list, body]      *)
each[pat_, lst_, bod_] := ReleaseHold[      (*  converts pattern to body for  *)
  Hold[Cases[[email protected], pat:>bod];]];    (*   each element of list.        *)
some[f_, l_List] := True ===                (* Whether f applied to some      *)
  Scan[If[f[#], Return[True]]&, l];         (*  element of list is True.      *)
every[f_, l_List] := Null ===               (* Similarly, And @@ f/@l         *)
  Scan[If[!f[#], Return[False]]&, l];       (*  (but with lazy evaluation).   *)

Ответ 12

Один трюк, который я использовал, который позволяет вам эмулировать то, как большинство встроенных функций работают с плохими аргументами (отправив сообщение, а затем возвращая всю необработанную форму) использует причуду пути Condition работает, когда используется в определении. Если foo должен работать только с одним аргументом:

foo[x_] := x + 1;
expr : foo[___] /; (Message[foo::argx, foo, [email protected][expr], 1]; 
                    False) := Null; (* never reached *)

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

Кроме того, в категории "метапрограммирование", если у вас есть пакет Mathematica (.m), вы можете использовать элемент "HeldExpressions", чтобы получить все выражения в файле, заключенном в HoldComplete. Это значительно упрощает отслеживание, чем при использовании текстовых запросов. К сожалению, нет простого способа сделать то же самое с записной книжкой, но вы можете получить все входные выражения, используя что-то вроде следующего:

inputExpressionsFromNotebookFile[nb_String] :=
 Cases[Get[nb],
  Cell[BoxData[boxes_], "Input", ___] :>
   MakeExpression[StripBoxes[boxes], StandardForm],
  Infinity]

Наконец, вы можете использовать тот факт, что Module эмулирует лексические замыкания, чтобы создать эквивалент ссылочных типов. Вот простой стек (который использует вариацию трюка Condition для обработки ошибок в качестве бонуса):

ClearAll[MakeStack, StackInstance, EmptyQ, Pop, Push, Peek]
 With[{emptyStack = Unique["empty"]},
  Attributes[StackInstance] = HoldFirst;
  MakeStack[] :=
   Module[{backing = emptyStack},
    StackInstance[backing]];

  StackInstance::empty = "stack is empty";

  EmptyQ[StackInstance[backing_]] := (backing === emptyStack);

  HoldPattern[
    Pop[instance : StackInstance[backing_]]] /;
    ! EmptyQ[instance] || (Message[StackInstance::empty]; False) :=
   (backing = [email protected]; instance);

  HoldPattern[Push[instance : StackInstance[backing_], new_]] :=
   (backing = {new, backing}; instance);

  HoldPattern[Peek[instance : StackInstance[backing_]]] /;
    ! EmptyQ[instance] || (Message[StackInstance::empty]; False) :=
   [email protected]]

Теперь вы можете распечатывать элементы списка в обратном порядке беспорядочно запутанным способом!

With[{stack = MakeStack[], list},
 Do[Push[stack, elt], {elt, list}];

 While[!EmptyQ[stack],
  Print[[email protected]];
  [email protected]]]

Ответ 13

Определение символьных систем печати без контекстного добавления

Функция contextFreeDefinition[] ниже попытается напечатать определение символа без использования наиболее распространенного контекста. Затем определение может быть скопировано в Workbench и отформатировано для чтения (выберите его, щелкните правой кнопкой мыши, Source → Format)

Clear[commonestContexts, contextFreeDefinition]

commonestContexts[sym_Symbol, n_: 1] := Quiet[
  Commonest[
   Cases[Level[DownValues[sym], {-1}, HoldComplete], 
    s_Symbol /; FreeQ[$ContextPath, Context[s]] :> Context[s]], n],
  Commonest::dstlms]

contextFreeDefinition::contexts = "Not showing the following contexts: `1`";

contextFreeDefinition[sym_Symbol, contexts_List] := 
 (If[contexts =!= {}, Message[contextFreeDefinition::contexts, contexts]];
  Internal`InheritedBlock[{sym}, ClearAttributes[sym, ReadProtected];
   Block[{$ContextPath = Join[$ContextPath, contexts]}, 
    [email protected][FullDefinition[sym]]]])

contextFreeDefinition[sym_Symbol, context_String] := 
 contextFreeDefinition[sym, {context}]

contextFreeDefinition[sym_Symbol] := 
 contextFreeDefinition[sym, commonestContexts[sym]]

справила []

Предостережение: Эта функция не локализует переменные одинаково With и Module do, что означает, что вложенные конструкторы локализации не будут работать должным образом. withRules[{a -> 1, b -> 2}, With[{a=3}, b_ :> b]] заменит a и b на вложенные With и Rule, а With не сделает этого.

Это вариант With, который использует правила вместо = и :=:

ClearAll[withRules]
SetAttributes[withRules, HoldAll]
withRules[rules_, expr_] :=
  Internal`InheritedBlock[
    {Rule, RuleDelayed},
    SetAttributes[{Rule, RuleDelayed}, HoldFirst];
    Unevaluated[expr] /. rules
  ]

Я нашел это полезным при очистке кода, написанного во время экспериментов и локализации переменных. Иногда я заканчиваю списками параметров в форме {par1 -> 1.1, par2 -> 2.2}. С параметрами withRules параметры легко вводятся в код, ранее написанный с использованием глобальных переменных.

Использование похоже на With:

withRules[
  {a -> 1, b -> 2},
  a+b
]

Сглаживание 3D-графики

Это очень простой способ сглаживания 3D-графики, даже если ваше графическое оборудование не поддерживает его.

antialias[g_, n_: 3] := 
  ImageResize[Rasterize[g, "Image", ImageResolution -> n 72], Scaled[1/n]]

Вот пример:

Mathematica graphicsMathematica graphics

Обратите внимание, что большое значение для n или большого размера изображения имеет тенденцию выставлять ошибки графического драйвера или вводить артефакты.


Функциональность разблокировки ноутбука

Функциональность разблокировки ноутбука доступна в пакете <<AuthorTools` и (по крайней мере, в версии 8) в недокументированном контексте NotebookTools`. Это небольшой графический интерфейс для разблокировки двух ноутбуков, которые в настоящее время открыты:

[email protected][
  {nb1, nb2}, 
  [email protected][
    {PopupMenu[Dynamic[nb1], 
      Thread[Notebooks[] -> NotebookTools`NotebookName /@ Notebooks[]]], 
     PopupMenu[Dynamic[nb2], 
      Thread[Notebooks[] -> NotebookTools`NotebookName /@ Notebooks[]]], 
     Button["Show differences", 
      [email protected]`NotebookDiff[nb1, nb2]]}]
  ]

Mathematica graphics

Ответ 14

Рекурсивные чистые функции (#0) кажутся одним из более темных углов языка. Вот пара нетривиальных примеров их использования, где это действительно полезно (не то, что они не могут быть выполнены без него). Ниже приведена довольно краткая и достаточно быстрая функция для поиска связанных компонентов в графе, учитывая список ребер, заданных в виде пар вершин:

ClearAll[setNew, componentsBFLS];
setNew[x_, x_] := Null;
setNew[lhs_, rhs_]:=lhs:=Function[Null, (#1 := #0[##]); #2, HoldFirst][lhs, rhs];

componentsBFLS[lst_List] := Module[{f}, setNew @@@ Map[f, lst, {2}];
   GatherBy[Tally[[email protected]][[All, 1]], f]];

Что здесь происходит, так это то, что мы сначала сопоставляем фиктивный символ на каждом из вершинных чисел, а затем настраиваем способ, который, учитывая пару вершин {f[5],f[10]}, скажем, тогда f[5] будет оценивать до f[10], Рекурсивная чистая функция используется как компрессор пути (для настройки memoization таким образом, что вместо длинных цепочек, таких как f[1]=f[3],f[3]=f[4],f[4]=f[2], ..., запоминаемые значения корректируются всякий раз, когда обнаруживается новый "корень" компонента, что дает значительную скорость Поскольку мы используем назначение, нам нужно, чтобы это было HoldAll, что делает эту конструкцию еще более неясной и привлекательной). Эта функция является результатом обсуждений в Mathgroup в режиме офф-лайн, включая Fred Simons, Szabolcs Horvat, DrMajorBob и ваш по-настоящему. Пример:

In[13]:= largeTest=RandomInteger[{1,80000},{40000,2}];

In[14]:= componentsBFLS[largeTest]//Short//Timing
Out[14]= {0.828,{{33686,62711,64315,11760,35384,45604,10212,52552,63986,  
     <<8>>,40962,7294,63002,38018,46533,26503,43515,73143,5932},<<10522>>}}

Это, безусловно, намного медленнее, чем встроенный, но для размера кода довольно быстро остается IMO.

Другой пример: здесь рекурсивная реализация Select, основанная на связанных списках и рекурсивных чистых функциях:

selLLNaive[x_List, test_] :=
  Flatten[If[TrueQ[test[#1]],
     {#1, If[#2 === {}, {}, #0 @@ #2]},
     If[#2 === {}, {}, #0 @@ #2]] & @@ Fold[{#2, #1} &, {}, Reverse[x]]];

Например,

In[5]:= Block[
         {$RecursionLimit= Infinity},
         selLLNaive[Range[3000],EvenQ]]//Short//Timing

Out[5]= {0.047,{2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,
 <<1470>>,2972,2974,2976,2978,2980,2982,2984,2986,2988,2990,
  2992,2994,2996,2998,3000}}

Однако он не является корректно хвостом рекурсивным и будет выбивать стек (разбивать ядро) для больших списков. Вот рекурсивная версия:

selLLTailRec[x_List, test_] :=
Flatten[
 If[Last[#1] === {},
  If[TrueQ[test[First[#1]]],
   {#2, First[#1]}, #2],
  (* else *)
  #0[Last[#1],
   If[TrueQ[test[First[#1]]], {#2, First[#1]}, #2]
   ]] &[Fold[{#2, #1} &, {}, Reverse[x]], {}]];

Например,

In[6]:= Block[{$IterationLimit= Infinity},
       selLLTailRec[Range[500000],EvenQ]]//Short//Timing
Out[6]= {2.39,{2,4,6,8,10,12,14,16,18,20,22,
       <<249978>>,499980,499982,499984,499986,499988,499990,499992,
        499994,499996,499998,500000}} 

Ответ 15

Это рецепт книги Stan Wagon... используйте его, когда встроенный график ведет себя беспорядочно из-за отсутствия точности

Options[PrecisePlot] = {PrecisionGoal -> 6};
PrecisePlot[f_, {x_, a_, b_}, opts___] := Module[{g, pg},
   pg = PrecisionGoal /. {opts} /. Options[PrecisePlot];
   SetAttributes[g, NumericFunction];
   g[z_?InexactNumberQ] := Evaluate[f /. x -> z];
   Plot[N[g[SetPrecision[y, \[Infinity]]], pg], {y, a, b},
    Evaluate[Sequence @@ FilterRules[{opts}, Options[Plot]]]]];

Я часто использую следующий трюк от Kristjan Kannike, когда мне нужно "похожее на словари" поведение по сравнению с Mathematica downvalues ​​

index[downvalue_, 
   dict_] := (downvalue[[1]] /. HoldPattern[dict[x_]] -> x) // 
   ReleaseHold;
value[downvalue_] := downvalue[[-1]];
indices[dict_] := 
  Map[#[[1]] /. {HoldPattern[dict[x_]] -> x} &, DownValues[dict]] // 
   ReleaseHold;
values[dict_] := Map[#[[-1]] &, DownValues[dict]];
items[dict_] := Map[{index[#, dict], value[#]} &, DownValues[dict]];
indexQ[dict_, index_] := 
  If[MatchQ[dict[index], HoldPattern[dict[index]]], False, True];

(* Usage example: *)
(* Count number of times each subexpression occurs in an expression *)
expr = Cos[x + Cos[Cos[x] + Sin[x]]] + Cos[Cos[x] + Sin[x]]
Map[(counts[#] = If[indexQ[counts, #], counts[#] + 1, 1]; #) &, expr, Infinity];
items[counts]

Когда результаты оценки запутывают, иногда это помогает сбрасывать шаги оценки в текстовый файл

SetAttributes[recordSteps, HoldAll];
recordSteps[expr_] :=
 Block[{$Output = [email protected]["~/temp/msgStream.m"]}, 
  TracePrint[Unevaluated[expr], _?(FreeQ[#, Off] &), 
   TraceInternal -> True];
  Close /@ $Output;
  Thread[[email protected]
    Cases[ReadList["~/temp/msgStream.m", HoldComplete[Expression]], 
     symb_Symbol /; 
       [email protected]@symb && 
        [email protected]@symb === "System`" :> 
      [email protected], {0, Infinity}, Heads -> True], HoldComplete]
  ]

(* Usage example: *)
(* puts steps of evaluation of 1+2+Sin[5]) into ~/temp/msgStream.m *)
recordSteps[1+2+Sin[5]]

Ответ 16

Можно запустить MathKernel в пакетном режиме с помощью недокументированных параметров командной строки -batchinput и -batchoutput:

math -batchinput -batchoutput < input.m > outputfile.txt

(где input.m - файл ввода партии, заканчивающийся символом новой строки, outputfile.txt - это файл, для которого будет перенаправлен вывод).

В Mathematica v. >= 6 MathKernel имеет недокументированную опцию командной строки:

-noicon

который контролирует, будет ли MathKernel иметь видимый значок на панели задач (по крайней мере, под Windows).

FrontEnd (по крайней мере, из версии 5) имеет недокументированную опцию командной строки

-b

который отключает заставку и позволяет быстрее запускать Mathematica FrontEnd

и опция

-directlaunch

который отключает механизм, который запускает последнюю версию Mathematica, установленную вместо запуска версии, связанной с .nb файлами в системном реестре.

Другой способ сделать это, вероятно, ::

Вместо запуска Mathematica.exe двоичный в каталог установки, запустите Mathematica.exe двоичный в SystemFiles\FrontEnd\Binaries\Windows. Первая - простая пусковая установка программа, которая перенаправлять запросы на открытие ноутбуков для запуска копий пользовательский интерфейс. Последний сам пользовательский интерфейс.

Удобно комбинировать последний параметр командной строки с установкой глобальной опции FrontEnd VersionedPreferences->True которая отключает совместное использование предпочтений между установленными версиями Mathematica:

SetOptions[$FrontEnd, VersionedPreferences -> True]

(Вышеуказанное должно быть оценено в самой последней версии Mathematica.)

В Mathematica 8 это управляется в диалоговом окне "Настройки" на панели "Система" в настройке "Создать и поддерживать параметры переднего конца версии" .

Можно получить неполный список параметров командной строки FrontEnd с помощью недокументированного ключа -h (код для Windows):

SetDirectory[$InstallationDirectory <> 
   "\\SystemFiles\\FrontEnd\\Binaries\\Windows\\"];
Import["!Mathematica -h", "Text"]

дает:

Usage:  Mathematica [options] [files]
Valid options:
    -h (--help):  prints help message
    -cleanStart (--cleanStart):  removes existing preferences upon startup
    -clean (--clean):  removes existing preferences upon startup
    -nogui (--nogui):  starts in a mode which is initially hidden
    -server (--server):  starts in a mode which disables user interaction
    -activate (--activate):  makes application frontmost upon startup
    -topDirectory (--topDirectory):  specifies the directory to search for resources and initialization files
    -preferencesDirectory (--preferencesDirectory):  specifies the directory to search for user AddOns and preference files
    -password (--password):  specifies the password contents
    -pwfile (--pwfile):  specifies the path for the password file
    -pwpath (--pwpath):  specifies the directory to search for the password file
    -b (--b):  launches without the splash screen
    -min (--min):  launches as minimized

Другие варианты:

-directLaunch:  force this FE to start
-32:  force the 32-bit FE to start
-matchingkernel:  sets the frontend to use the kernel of matching bitness
-Embedding:  specifies that this instance is being used to host content out of process

Существуют ли другие потенциально полезные параметры командной строки для MathKernel и FrontEnd? Поделитесь, если вы знаете.

Связанный с этим вопрос.

Ответ 17

Мои любимые хаки - это небольшие макросы, генерирующие код, которые позволяют вам заменить набор стандартных команд шаблонов одним коротким. Кроме того, вы можете создавать команды для открытия/создания ноутбуков.

Вот что я использовал некоторое время в моем повседневном рабочем процессе Mathematica. Я обнаружил, что много выполняю следующее:

  • Сделайте ноутбук в личном контексте, загрузите пакеты, которые мне нужны, сделайте это автоматически.
  • После работы с этим ноутбуком какое-то время я хочу сделать некоторые вычисления с нуля в отдельном ноутбуке с собственным личным контекстом, имея доступ к определениям, которые я использовал в "основном" ноутбуке, Поскольку я настраивал частный контекст, для этого требуется вручную настроить $ContextPath

Выполнение всего этого вручную снова и снова является болью, поэтому давайте автоматизировать! Во-первых, некоторый код утилиты:

(* Credit goes to Sasha for SelfDestruct[] *)
SetAttributes[SelfDestruct, HoldAllComplete];
SelfDestruct[e_] := (If[$FrontEnd =!= $Failed,
   SelectionMove[EvaluationNotebook[], All, EvaluationCell]; 
   NotebookDelete[]]; e)

writeAndEval[nb_,boxExpr_]:=(
    NotebookWrite[nb,  CellGroupData[{Cell[BoxData[boxExpr],"Input"]}]];
    SelectionMove[nb, Previous, Cell]; 
    SelectionMove[nb, Next, Cell];
    SelectionEvaluate[nb];
)

ExposeContexts::badargs = 
  "Exposed contexts should be given as a list of strings.";
ExposeContexts[list___] := 
 Module[{ctList}, ctList = [email protected]@list; 
  If[! MemberQ[ctList, Except[_String]],AppendTo[$ContextPath, #] & /@ ctList, 
   Message[ExposeContexts::badargs]];
  $ContextPath = DeleteDuplicates[$ContextPath];
  $ContextPath]

    Autosave[x:(True|False)] := SetOptions[EvaluationNotebook[],NotebookAutoSave->x];

Теперь создайте макрос, который будет помещать следующие ячейки в блокнот:

SetOptions[EvaluationNotebook[], CellContext -> Notebook]
Needs["LVAutils`"]
Autosave[True]

И вот макрос:

MyPrivatize[exposedCtxts : ({__String} | Null) : Null]:=
  [email protected][{contBox,lvaBox,expCtxtBox,assembledStatements,strList},
    contBox = MakeBoxes[SetOptions[EvaluationNotebook[], CellContext -> Notebook]];
    lvaBox = MakeBoxes[Needs["LVAutils`"]];

    assembledStatements = {lvaBox,MakeBoxes[Autosave[True]],"(*********)"};
    assembledStatements = Riffle[assembledStatements,"\[IndentingNewLine]"]//RowBox;
    writeAndEval[InputNotebook[],contBox];
    writeAndEval[InputNotebook[],assembledStatements];
    If[exposedCtxts =!= Null,
       strList = Riffle[("\"" <> # <> "\"") & /@ exposedCtxts, ","];
       expCtxtBox = RowBox[{"ExposeContexts", "[", RowBox[{"{", RowBox[strList], "}"}], "]"}];
       writeAndEval[InputNotebook[],expCtxtBox];
      ]
 ]

Теперь, когда я набираю MyPrivatize[], создается частный контекст и загружает стандартный пакет. Теперь давайте создадим команду, которая откроет новый ноутбук с записью с собственным личным контекстом (чтобы вы могли взломать там с диким отказом без риска испортить определения), но имеет доступ к вашим текущим контекстам.

SpawnScratch[] := [email protected][{nb,boxExpr,strList},
    strList = Riffle[("\"" <> # <> "\"") & /@ $ContextPath, ","];
    boxExpr = RowBox[{"MyPrivatize", "[",
        RowBox[{"{", RowBox[strList], "}"}], "]"}];
    nb = CreateDocument[];
    writeAndEval[nb,boxExpr];
]

Приятная вещь в том, что из-за SelfDestruct, когда команда запускается, она не оставляет следа в текущем ноутбуке - это хорошо, потому что в противном случае это просто создало бы беспорядок.

Для дополнительных точек стиля вы можете создавать триггеры ключевых слов для этих макросов с помощью InputAutoReplacements, но я оставлю это как упражнение для читателя.

Ответ 18

PutAppend с помощью PageWidth → Infinity

В Mathematica использование команды PutAppend является самым простым способом для поддержания работающего файла журнала с результатами промежуточных вычислений. Но он использует параметр PageWith->78 по умолчанию при экспорте выражений в файл, и поэтому нет гарантии, что каждый промежуточный вывод займет только одну строку в журнале.

PutAppend не имеет никаких параметров, но отслеживание его оценок показывает, что оно основано на функции OpenAppend, которая имеет параметр PageWith и позволяет изменить значение по умолчанию командой SetOptions:

In[2]:= Trace[x>>>"log.txt",TraceInternal->True]
Out[2]= {x>>>log.txt,{OpenAppend[log.txt,CharacterEncoding->PrintableASCII],OutputStream[log.txt,15]},Null}

Таким образом, мы можем получить PutAppend для добавления только одной строки за раз, установив:

SetOptions[OpenAppend, PageWidth -> Infinity]

UPDATE

Существует ошибка , представленная в версии 10: SetOptions больше не влияет на поведение OpenWrite и OpenAppend.

Обходной путь заключается в реализации собственной версии PutAppend с явной опцией PageWidth -> Infinity:

Clear[myPutAppend]
myPutAppend[expr_, pathtofile_String] :=
 (Write[#, expr]; Close[#];) &[OpenAppend[pathtofile, PageWidth -> Infinity]]

Обратите внимание, что мы также можем реализовать его с помощью WriteString, как показано в этом, но в этом случае необходимо предварительно преобразовать выражение в соответствующий InputForm через ToString[expr, InputForm].

Ответ 19

Я просто просматривал один из своих пакетов для включения в него и нашел некоторые сообщения, которые я определил, что творит чудеса: Debug::<some name>. По умолчанию они отключены, поэтому не производят слишком много лишних расходов. Но, я могу поместить мой код с ними и включить их, если мне нужно выяснить, как именно работает код.

Ответ 20

Одна из вещей, которая беспокоит меня о встроенных объектных конструкциях, заключается в том, что они сразу оценивают все локальные переменные, поэтому вы не можете писать, например,

With[{a = 5, b = 2 * a},
    ...
]

Итак, недавно я придумал макрос под названием WithNest, который позволяет вам это делать. Я считаю это удобным, так как он позволяет сохранять переменные привязки локально, не делая что-то вроде

Module[{a = 5,b},
    b = 2 * a;
    ...
]

В конце концов, лучший способ, который я мог найти для этого, - использовать специальный символ, чтобы упростить рекурсию над списком привязок, и я поместил определение в свой собственный пакет, чтобы этот символ был скрыт. Может быть, у кого-то есть более простое решение этой проблемы?

Если вы хотите попробовать, поместите следующее в файл с именем Scoping.m:

BeginPackage["Scoping`"];

WithNest::usage=
"WithNest[{var1=val1,var2=val2,...},body] works just like With, except that
values are evaluated in order and later values have access to earlier ones.
For example, val2 can use var1 in its definition.";

Begin["`Private`"];

(* Set up a custom symbol that works just like Hold. *)
SetAttributes[WithNestHold,HoldAll];

(* The user-facing call.  Give a list of bindings and a body that not
our custom symbol, and we start a recursive call by using the custom
symbol. *)
WithNest[bindings_List,body:Except[_WithNestHold]]:=
WithNest[bindings,WithNestHold[body]];

(* Base case of recursive definition *)
WithNest[{},WithNestHold[body_]]:=body;

WithNest[{bindings___,a_},WithNestHold[body_]]:=
WithNest[
{bindings},
WithNestHold[With[[email protected],body]]];

SyntaxInformation[WithNest]={"ArgumentsPattern"->{{__},_}};
SetAttributes[WithNest,{HoldAll,Protected}];

End[];

EndPackage[];

Ответ 21

Этот код создает палитру, которая загружает выделение в Stack Exchange в качестве изображения. В Windows предусмотрена дополнительная кнопка, которая дает более точное отображение выбора.

Скопируйте код в ячейку ноутбука и оцените его. Затем вытащите палитру с выхода и установите ее, используя Palettes -> Install Palette...

Если у вас есть какие-либо проблемы с этим, отправьте комментарий здесь. Загрузите версию ноутбука здесь.


Begin["SOUploader`"];

Global`palette = [email protected][{},

   Column[{
     Button["Upload to SE",
      With[{img = rasterizeSelection1[]},
       If[img === $Failed, Beep[], uploadWithPreview[img]]],
      Appearance -> "Palette"],

     If[$OperatingSystem === "Windows",

      Button["Upload to SE (pp)",
       With[{img = rasterizeSelection2[]},
        If[img === $Failed, Beep[], uploadWithPreview[img]]],
       Appearance -> "Palette"],

      [email protected][]
      ]
     }],

   (* Init start *)
   Initialization :>
    (

     stackImage::httperr = "Server returned respose code: `1`";
     stackImage::err = "Server returner error: `1`";

     stackImage[g_] :=
      Module[
       {getVal, url, client, method, data, partSource, part, entity,
        code, response, error, result},

       getVal[res_, key_String] :=
        With[{k = "var " <> key <> " = "},
         StringTrim[

          [email protected][
            [email protected][res, StringMatchQ[#, k ~~ ___] &],
            k ~~ v___ ~~ ";" :> v],
          "'"]
         ];

       data = ExportString[g, "PNG"];

       JLink`JavaBlock[
        url = "http://stackoverflow.com/upload/image";
        client =
         JLink`JavaNew["org.apache.commons.httpclient.HttpClient"];
        method =
         JLink`JavaNew[
          "org.apache.commons.httpclient.methods.PostMethod", url];
        partSource =
         JLink`JavaNew[
          "org.apache.commons.httpclient.methods.multipart.\
ByteArrayPartSource", "mmagraphics.png",
          JLink`MakeJavaObject[data]@toCharArray[]];
        part =
         JLink`JavaNew[
          "org.apache.commons.httpclient.methods.multipart.FilePart",
          "name", partSource];
        [email protected]["image/png"];
        entity =
         JLink`JavaNew[
          "org.apache.commons.httpclient.methods.multipart.\
MultipartRequestEntity", {part}, [email protected][]];
        [email protected][entity];
        code = [email protected][method];
        response = [email protected][];
        ];

       If[code =!= 200, Message[stackImage::httperr, code];
        Return[$Failed]];
       response = StringTrim /@ StringSplit[response, "\n"];

       error = getVal[response, "error"];
       result = getVal[response, "result"];
       If[StringMatchQ[result, "http*"],
        result,
        Message[stackImage::err, error]; $Failed]
       ];

     stackMarkdown[g_] :=
      "![Mathematica graphics](" <> stackImage[g] <> ")";

     stackCopyMarkdown[g_] := Module[{nb, markdown},
       markdown = Check[stackMarkdown[g], $Failed];
       If[markdown =!= $Failed,
        nb = NotebookCreate[Visible -> False];
        NotebookWrite[nb, Cell[markdown, "Text"]];
        SelectionMove[nb, All, Notebook];
        FrontEndTokenExecute[nb, "Copy"];
        NotebookClose[nb];
        ]
       ];

     (* Returns available vertical screen space,
     taking into account screen elements like the taskbar and menu *)


     screenHeight[] := -Subtract @@
        Part[ScreenRectangle /. Options[$FrontEnd, ScreenRectangle],
         2];

     uploadWithPreview[img_Image] :=
      CreateDialog[
       Column[{
         Style["Upload image to the Stack Exchange network?", Bold],
         Pane[

          Image[img, Magnification -> 1], {Automatic,
           Min[screenHeight[] - 140, 1 + ImageDimensions[img][[2]]]},
          Scrollbars -> Automatic, AppearanceElements -> {},
          ImageMargins -> 0
          ],
         Item[
          ChoiceButtons[{"Upload and copy MarkDown"}, \
{stackCopyMarkdown[img]; DialogReturn[]}], Alignment -> Right]
         }],
       WindowTitle -> "Upload image to Stack Exchange?"
       ];

     (* Multiplatform, fixed-width version.
        The default max width is 650 to fit Stack Exchange *)
     rasterizeSelection1[maxWidth_: 650] :=
      Module[{target, selection, image},
       selection = NotebookRead[SelectedNotebook[]];
       If[MemberQ[Hold[{}, $Failed, NotebookRead[$Failed]], selection],

        $Failed, (* There was nothing selected *)

        target =
         CreateDocument[{}, WindowSelected -> False, Visible -> False,
           WindowSize -> maxWidth];
        NotebookWrite[target, selection];
        image = Rasterize[target, "Image"];
        NotebookClose[target];
        image
        ]
       ];

     (* Windows-only pixel perfect version *)
     rasterizeSelection2[] :=
      If[
       MemberQ[Hold[{}, $Failed, NotebookRead[$Failed]],
        NotebookRead[SelectedNotebook[]]],

       $Failed, (* There was nothing selected *)

       Module[{tag},
        FrontEndExecute[
         FrontEndToken[FrontEnd`SelectedNotebook[], "CopySpecial",
          "MGF"]];
        Catch[
         [email protected][] /.
          r_RasterBox :>
           Block[{},
            Throw[Image[First[r], "Byte", ColorSpace -> "RGB"], tag] /;
              True];
         $Failed,
         tag
         ]
        ]
       ];
     )
   (* Init end *)
   ]

End[];

Ответ 22

Я уверен, что многие люди столкнулись с ситуацией, когда они запускают некоторые вещи, понимая, что это не только застряло в программе, но они также не сохраняются в течение последних 10 минут!

ИЗМЕНИТЬ

После некоторого времени, я обнаружил, что можно создать автоматическое сохранение из кода Mathematica. Я думаю, что использование такого автосохранения очень помогло мне в прошлом, и я всегда чувствовал, что сама возможность - это то, что мало кто знает, что они могут сделать.

Исходный код, который я использовал, находится внизу. Благодаря комментариям я обнаружил, что это проблематично, и что гораздо лучше сделать это альтернативным способом, используя ScheduledTask (который будет работать только в Mathematica 8).

Код для этого можно найти в этом ответе от Sjoerd C. de Vries (Так как я не уверен, нормально ли копировать его здесь, я оставляю его только как ссылку.)


В приведенном ниже решении используется Dynamic. Он будет экономить ноутбук каждые 60 секунд, но, по-видимому, , только если его ячейка видна. Я оставляю его здесь только по причинам завершения. (и для пользователей Mathematica 6 и 7)

/EDIT

Чтобы решить эту проблему, я использую этот код в начале ноутбука:

Dynamic[Refresh[NotebookSave[]; DateString[], UpdateInterval -> 60]]

Это спасет вашу работу каждые 60 секунд.
Я предпочитаю его NotebookAutoSave[], потому что он сохраняет до обработки ввода и потому, что некоторые файлы больше текста, чем ввода.

Я изначально нашел его здесь: http://en.wikipedia.org/wiki/Talk:Mathematica#Criticisms

Обратите внимание, что при выполнении этой строки сохранение произойдет, даже если вы закроете и снова откроете файл (пока включено динамическое обновление).

Кроме того, поскольку в Mathematica нет отмены, будьте осторожны, чтобы не удалить весь ваш контент, поскольку сохранение сделает его необратимым (в качестве меры предосторожности я удаляю этот код из каждого готового ноутбука)

Ответ 23

Этот был написан Альберто Ди Лулло (который, похоже, не находится в переполнении стека).

CopyToClipboard, для Mathematica 7 (в Mathematica 8 встроен)

CopyToClipboard[expr_] := 
  Module[{nb}, 
   nb = CreateDocument[Null, Visible -> False, WindowSelected -> True];
   NotebookWrite[nb, Cell[[email protected]], All];
   FrontEndExecute[FrontEndToken[nb, "Copy"]];
   [email protected]];

Оригинальное сообщение: http://forums.wolfram.com/mathgroup/archive/2010/Jun/msg00148.html

Я нашел эту рутину полезной для копирования больших реальных чисел в буфер обмена в обычной десятичной форме. Например. CopyToClipboard["123456789.12345"]

Cell[[email protected]] аккуратно удаляет кавычки.

Ответ 25

Мне очень полезно при разработке пакетов добавить эту комбинацию клавиш в мой SystemFiles/FrontEnd/TextResources/Windows/KeyEventTranslations.tr файл.

(* Evaluate Initialization Cells: Real useful for reloading library changes. *)

Item[KeyEvent["i", Modifiers -> {Control, Command}],
    FrontEndExecute[
        FrontEndToken[
            SelectedNotebook[],
            "EvaluateInitialization"]]],

Далее для каждого Packagename.m я делаю блок PackagenameTest.nb для тестирования, а первые 2 ячейки тестового ноутбука устанавливаются как ячейки инициализации. В первой ячейке я положил

Needs["PackageManipulations`"]

загрузить очень полезную библиотеку PackageManipulations, написанную Леонидом. Вторая ячейка содержит

PackageRemove["Packagename`Private`"]
PackageRemove["Packagename`"]
PackageReload["Packagename`"]

которые выполняют фактическую перезагрузку. Обратите внимание, что в первых двух строках есть только Remove все символы, как мне нравится, чтобы контексты были максимально чистыми.

Тогда рабочий процесс для записи и тестирования пакета становится примерно таким.

  • Сохранить изменения в Packagename.m.
  • Перейдите к PackagenameTest.nb и выполните CTRL + ALT + i.

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

Ответ 26

Следующая функция format[expr_] может использоваться для форматирования отформатированных выражений mathematica для отступа/форматирования

indent[str_String, ob_String, cb_String, delim_String] := 
  Module[{ind, indent, f, tab}, ind = 0; tab = "    ";
   indent[i_, tab_, nl_] := nl <> Nest[tab <> ToString[#] &, "", i];
   f[c_] := (indent[ind, "", " "] <> c <> indent[++ind, tab, "\n"]) /;StringMatchQ[ob, ___ ~~ c ~~ ___];
   f[c_] := (indent[--ind, "", " "] <> c <> indent[ind, tab, "\n"]) /;StringMatchQ[cb, ___ ~~ c ~~ ___];
   f[c_] := (c <> indent[ind, tab, "\n"]) /;StringMatchQ[delim, ___ ~~ c ~~ ___];
   f[c_] := c;
   f /@ [email protected] // StringJoin];
format[expr_] := indent[expr // InputForm // ToString, "[({", "])}", ";"];

(*    
format[[email protected][{ind, indent, f, tab}, ind = 0; tab = "    ";
 indent[i_, tab_, nl_] := nl <> Nest[tab <> ToString[#] &, "", i];
 f[c_] := (indent[ind, "", " "] <> c <> indent[++ind, tab, "\n"]) /;StringMatchQ[ob, ___ ~~ c ~~ ___];
 f[c_] := (indent[--ind, "", " "] <> c <> indent[ind, tab, "\n"]) /;StringMatchQ[cb, ___ ~~ c ~~ ___];
 f[c_] := (c <> indent[ind, tab, "\n"]) /;StringMatchQ[delim, ___ ~~ c ~~ ___];
 f[c_] := c;
 f /@ [email protected] // StringJoin]]
*)

ref: https://codegolf.stackexchange.com/info/3088/indent-a-string-using-given-parentheses