resources - yuya - ¿Qué hay en tu bolsa de herramientas Mathematica?
youtube que cargo en mi bolsa (26)
Comience sin un cuaderno en blanco abierto
Me molestó que Mathematica comenzara con un cuaderno en blanco abierto. Podría cerrar este cuaderno con un guión, pero aún así se abriría brevemente. Mi hack es crear un archivo Invisible.nb
contenga:
Notebook[{},Visible->False]
Y agregue esto a mi Kernel/init.m
:
If[Length[Notebooks["Invisible*"]] > 0,
NotebookClose[Notebooks["Invisible*"][[1]]]
]
SetOptions[$FrontEnd,
Options[$FrontEnd, NotebooksMenu] /.
HoldPattern["Invisible.nb" -> {__}] :> Sequence[]
]
Ahora comienzo Mathematica abriendo Invisible.nb
Puede haber una mejor manera, pero esto me ha servido bien.
FoldList
personalizada de Fold
y FoldList
Fold[f, x]
se hace equivalente a Fold[f, First@x, Rest@x]
Por cierto, creo que esto puede encontrar su camino en una versión futura de Mathematica.
¡Sorpresa! Esto se ha implementado, aunque actualmente no está documentado. Me informaron que fue implementado en 2011 por Oliver Ruebenkoenig, aparentemente no mucho después de haber publicado esto. Gracias Oliver Ruebenkoenig!
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''s recommendation to modify SyntaxInformation *)
SyntaxInformation[Fold] = {"ArgumentsPattern" -> {_, _, _.}};
SyntaxInformation[FoldList] = {"ArgumentsPattern" -> {_, _., {__}}};
Protect[Fold, FoldList]
Actualizado para permitir esto:
SetAttributes[f, HoldAll]
Fold[f, Hold[1 + 1, 2/2, 3^3]]
f[f[1 + 1, 2/2], 3^3]
"Partición dinámica"
Consulte la publicación de Mathematica.SE # 7512 para obtener una nueva versión de esta función.
Con frecuencia quiero dividir una lista según una secuencia de longitudes.
ejemplo de pseudo-código:
partition[{1,2,3,4,5,6}, {2,3,1}]
Salida: {{1,2}, {3,4,5}, {6}}
Se me ocurrió esto:
dynP[l_, p_] :=
MapThread[l[[# ;; #2]] &, {{0} ~Join~ Most@# + 1, #} &@Accumulate@p]
Que luego completé con esto, incluidas las pruebas de argumento:
dynamicPartition[l_List, p : {_Integer?NonNegative ..}] :=
dynP[l, p] /; Length@l >= Tr@p
dynamicPartition[l_List, p : {_Integer?NonNegative ..}, All] :=
dynP[l, p] ~Append~ Drop[l, Tr@p] /; Length@l >= Tr@p
dynamicPartition[l_List, p : {_Integer?NonNegative ..}, n__ | {n__}] :=
dynP[l, p] ~Join~ Partition[l ~Drop~ Tr@p, n] /; Length@l >= Tr@p
El tercer argumento controla lo que ocurre con los elementos más allá de la especificación de división.
Trucos de Mathematica de Szabolcs
El que uso con más frecuencia es la paleta de datos en forma de pegado
CreatePalette@
Column@{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[],
ToBoxes@Map[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[],
ToBoxes@Map[strip, ImportString[data, "CSV"], {2}]]]]],
Button["Table",
Module[{data}, data = NotebookGet[ClipboardNotebook[]][[1, 1, 1]];
If[Head[data] === String,
NotebookWrite[InputNotebook[],
ToBoxes@ImportString[data, "Table"]]]]]}
Modificar datos externos desde dentro de Compile
Recientemente, Daniel Lichtblau mostró este método que nunca había visto antes. En mi opinión, amplía significativamente la utilidad de 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.} *)
Todos sabemos que Mathematica es genial, pero a menudo también carece de funcionalidad crítica. ¿Qué tipo de paquetes / herramientas / recursos externos usas con Mathematica?
Editaré (e invitaré a cualquier otra persona a que lo haga también) esta publicación principal para incluir recursos que se centren en la aplicabilidad general en la investigación científica y que la mayor cantidad de gente pueda encontrar útil. Siéntase libre de contribuir con cualquier cosa, incluso pequeños fragmentos de código (como hice abajo para una rutina de tiempo).
Además, las características indocumentadas y útiles en Mathematica 7 y más allá de lo que se encontró, o desenterrado de algún papel / sitio son bienvenidas.
Incluya una breve descripción o comentario sobre por qué algo es bueno o qué utilidad proporciona. Si enlaza a libros en Amazon con enlaces de afiliado, menciónelo, por ejemplo, poniendo su nombre después del enlace.
Paquetes:
-
LevelScheme
es un paquete que expande en gran medida la capacidad de Mathematica para generar gráficos atractivos. Lo uso si no para nada más que para el mucho, mucho mejor control sobre las marcas de trama / eje. Su versión más nueva se llama SciDraw, y se lanzará en algún momento de este año. -
Presentation Package
David Park (US $ 50 - sin cargo por actualizaciones) - El paquete
grassmannOps
Jeremy Michelson proporciona recursos para realizar álgebra y cálculo con variables de Grassmann y operadores que tienen relaciones de conmutación no triviales. - El paquete y libro
GrassmannAlgebra
John Brown para trabajar con las álgebras de Grassmann y Clifford. - RISC (Research Institute for Symbolic Computation) tiene una variedad de paquetes para Mathematica (y otros idiomas) disponibles para descargar. En particular, existe Theorema para la demostración automatizada de teoremas y la multitud de paquetes para suma simbólica, ecuaciones de diferencia, etc. en la página de software del grupo Algorithmic Combinatorics .
Herramientas:
-
MASH
es la excelente secuencia de comandos Perl Daniel Reeves que esencialmente proporciona compatibilidad con scripts para Mathematica v7. (Ahora incorporado a partir de Mathematica 8 con la opción-script
). - Un
alternate Mathematica shell
con una entrada readline de GNU (usando python, * nix solamente) - El paquete ColourMaths le permite seleccionar visualmente partes de una expresión y manipularlas. http://www.dbaileyconsultancy.co.uk/colour_maths/colour_maths.html
Recursos:
El propio repositorio de Wolfram
MathSource
tiene muchos cuadernos estrechos útiles para diversas aplicaciones. También echa un vistazo a las otras secciones como-
Current Documentation
, -
Courseware
para conferencias, - y
Demos
para, bueno, demos.
-
Libros:
- Programación de Mathematica: una introducción avanzada de Leonid Shifrin (
web
,pdf
) es una lectura obligada si desea hacer algo más que bucles For en Mathematica. Tenemos el placer de hacer que el propioLeonid
conteste preguntas aquí. - Métodos cuánticos con Mathematica por James F. Feagin ( amazon )
- El libro de Mathematica de Stephen Wolfram ( amazon ) (
web
) - Schaum''s Outline ( amazon )
- Mathematica en acción por Stan Wagon ( amazon ) - 600 páginas de ejemplos claros y pasa a Mathematica versión 7. Las técnicas de visualización son especialmente buenas, puedes ver algunas de ellas en la
Demonstrations Page
del autor. - Fundamentos de la programación de Mathematica por Richard Gaylord (
pdf
) - Una buena introducción concisa a la mayoría de lo que usted necesita saber sobre la programación de Mathematica. - Mathematica Cookbook de Sal Mangano publicado por O''Reilly 2010 832 páginas. - Escrito en el conocido estilo O''Reilly Cookbook: Problema - Solución. Para productos intermedios.
- Ecuaciones diferenciales con Mathematica, 3rd Ed. Elsevier 2004 Amsterdam por Martha L. Abell, James P. Braselton - 893 páginas Para principiantes, aprenda a resolver DEs y Mathematica al mismo tiempo.
Características indocumentadas (o escasamente documentadas):
- Cómo personalizar los atajos de teclado de Mathematica. Ver
this question
- Cómo inspeccionar patrones y funciones utilizados por las propias funciones de Mathematica. Ver
this answer
- ¿Cómo lograr un tamaño consistente para GraphPlots en Mathematica? Ver
this question
- Cómo producir documentos y presentaciones con Mathematica. Ver
this question
Problemas y soluciones generales de exportación PDF / EMF
1) Es completamente inesperado e indocumentado, pero Mathematica exporta y guarda gráficos en formatos PDF y EPS usando un conjunto de definiciones de estilo que difiere del utilizado para mostrar Cuadernos en pantalla. By default Notebooks are displayed on screen in the "Working" style environment (which is default value for the ScreenStyleEvironment
global $FrontEnd
option) but are printed in the "Printout"
style environment (which is default value for the PrintingStyleEnvironment
global $FrontEnd
option). When one exports graphics in raster formats such as GIF and PNG or in EMF format Mathematica generates graphics that looks exactly like it looks inside Notebook. It seems that the "Working"
style environment is used for rendering in this case. But it is not the case when you export/save anything in PDF or EPS formats! In this case the "Printout"
style environment is used by default that differs very deeply from the "Working" style environment. First of all, the "Printout"
style environment sets Magnification
to 80% . Secondly, it uses its own values for the font sizes of different styles and this results in inconsistent font size changes in the genarated PDF file as compared with the original on-screen representation. The latter can be called FontSize fluctuations which are very annoying. But happily this can be avoided by setting the PrintingStyleEnvironment
global $FrontEnd
option to "Working" :
SetOptions[$FrontEnd, PrintingStyleEnvironment -> "Working"]
2) The common problem with exporting to EMF format is that most of programs (not only Mathematica ) generate a file that looks nice at the default size but becomes ugly when you zoom it in. It is because metafiles are sampled at screen resolution fidelity . The quality of the generated EMF file can be enhanced by Magnify
ing the original graphical object so that exactness of sampling of the original graphics becomes much more precise. Compare two files:
graphics1 =
First@ImportString[
ExportString[Style["a", FontFamily -> "Times"], "PDF"], "PDF"];
graphics2 = Magnify[graphics1, 10];
Export["C://test1.emf", graphics1]
Export["C://test2.emf", graphics2]
If you insert these files into Microsoft Word and zoom them in you will see that the first "a" has sawtooth on it while the second has not (tested with Mathematica 6).
Another way through ImageResolution
was suggested by Chris Degnen (this option has effect at least starting from Mathematica 8):
Export["C://test1.emf", graphics1]
Export["C://test2.emf", graphics1, ImageResolution -> 300]
3) In Mathematica we have three ways to convert graphics into metafile: via Export
to "EMF"
(strongly recommended way: produces metafile with highest possible quality), via Save selection As...
menu item ( produces much lesser precise figure , not recommended) and via Edit ► Copy As ► Metafile
menu item ( I strongly recommend against this route ).
Internal`InheritedBlock
Recientemente he aprendido la existencia de funciones tan útiles como Internal`InheritedBlock
, a partir de este mensaje de Daniel Lichtblau en el grupo de noticias oficial.
Según tengo entendido, Internal`InheritedBlock
permite pasar una copia de una función de salida dentro del alcance del 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]
¡Creo que esta función puede ser muy útil para todos los que necesiten modificar las funciones incorporadas temporalmente!
Comparación con Block
Vamos a definir alguna función:
a := Print[b]
Ahora deseamos pasar una copia de esta función al alcance del Block
. El ensayo ingenuo no da lo que queremos:
In[2]:= Block[{a = a}, OwnValues[a]]
During evaluation of In[9]:= b
Out[2]= {HoldPattern[a] :> Null}
Ahora trato de usar definición retrasada en el primer argumento de Block
(también es una característica no documentada):
In[3]:= Block[{a := a}, OwnValues[a]]
Block[{a := a}, a]
Out[3]= {HoldPattern[a] :> a}
During evaluation of In[3]:= b
Vemos que en este caso funciona pero no tenemos una copia del original a
dentro del alcance del Block
.
Ahora intentemos Internal`InheritedBlock
:
In[5]:= Internal`InheritedBlock[{a}, OwnValues[a]]
Out[5]= {HoldPattern[a] :> Print[b]}
Tenemos una copia de la definición original para el interior del alcance del Block
y podemos modificarlo de la manera que queremos sin afectar la definición global de a
!
Caching expressions
I find these functions very helpful to cache any expression. The interesting thing here for these two functions is that the held expression itself is used as a key of the hashtable/symbol Cache or CacheIndex, compared to the well-known memoization in mathematica where you can only cache result if the function is defined like f[x_] := f[x] = ... So you can cache any part of a code, this is useful if a function is to be called several times but just some parts of the code must not be recomputed.
To cache an expression independently of its arguments.
SetAttributes[Cache, HoldFirst];
c:Cache[expr_] := c = expr;
Ex: Cache[Pause[5]; 6]
Cache[Pause[5]; 6]
The second time the expression returns 6 without waiting.
To cache an expression using an alias expression that can depend on an argument of the cached expression.
SetAttributes[CacheIndex, HoldRest];
c:CacheIndex[index_,expr_] := c = expr;
Ex: CacheIndex[{"f",2},x=2;y=4;x+y]
If expr takes some time to compute, it is much faster to evaluate {"f",2} for example to retrieve the cached result.
For a variation of these functions in order to have a localized cache (ie. the cache memory is automatically released outside the Block construct) see this post Avoid repeated calls to Interpolation
Deleting cached values
To delete cached values when you don''t know the number of definitions of a function. I consider that definitions have a Blank somewhere in their arguments.
DeleteCachedValues[f_] :=
DownValues[f] = Select[DownValues[f], !FreeQ[Hold@#,Pattern]&];
To delete cached values when you know the number of definitions of a function (goes slightly faster).
DeleteCachedValues[f_,nrules_] :=
DownValues[f] = Extract[DownValues[f], List /@ Range[-nrules, -1]];
This uses the fact that definitions of a function are at the end of their DownValues list, cached values are before.
Using symbols to store data and object-like functions
Also here are interesting functions to use symbols like objects.
It is already well known that you can store data in symbols and quickly access them using DownValues
mysymbol["property"]=2;
You can access the list of keys (or properties) of a symbol using these functions based on what dreeves submitted in a post on this site:
SetAttributes[RemoveHead, {HoldAll}];
RemoveHead[h_[args___]] := {args};
NKeys[symbol_] := RemoveHead @@@ DownValues[symbol(*,Sort->False*)][[All,1]];
Keys[symbol_] := NKeys[symbol] /. {x_} :> x;
I use this function a lot to display all infos contained in the DownValues of a symbol:
PrintSymbol[symbol_] :=
Module[{symbolKeys},
symbolKeys = Keys[symbol];
TableForm@Transpose[{symbolKeys, symbol /@ symbolKeys}]
];
Finally here is a simple way to create a symbol that behaves like an object in object oriented programming (it just reproduces the most basic behaviour of OOP but I find the syntax elegant) :
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
];
Properties are stored as DownValues and methods as delayed Upvalues in the symbol created by Module that is returned. I found the syntax for function2 that is the usual OO-syntax for functions in Tree data structure in Mathematica .
For a list of existing types of values each symbol has, see http://reference.wolfram.com/mathematica/tutorial/PatternsAndTransformationRules.html and http://www.verbeia.com/mathematica/tips/HTMLLinks/Tricks_Misc_4.html .
For example try this
x = NewObject[y -> 3];
function[x, 4]
x.function2[5]
You can go further if you want to emulate object inheritance using a package called InheritRules available here http://library.wolfram.com/infocenter/MathSource/671/
You could also store the function definition not in newObject but in a type symbol, so if NewObject returned type[newObject] instead of newObject you could define function and function2 like this outside of NewObject (and not inside) and have the same usage as before.
function[type[object_], x_] ^:= object["y"] + x;
type /: type[object_].function2[x_] := 2 object["y"]+x;
Use UpValues[type] to see that function and function2 are defined in the type symbol.
Further ideas about this last syntax are introduced here https://mathematica.stackexchange.com/a/999/66 .
Improved version of SelectEquivalents
@rcollyer: Many thanks for bringing SelectEquivalents to the surface, it''s an amazing function. Here is an improved version of SelectEquivalents listed above with more possibilities and using options, this makes it easier to use.
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[
{
tagElement=OptionValue@TagElement,
transformElement=OptionValue@TransformElement,
transformResults=OptionValue@TransformResults,
mapLevel=OptionValue@MapLevel,
tagPattern=OptionValue@TagPattern,
finalFunction=OptionValue@FinalFunction
}
,
finalFunction[
Reap[
Map[
Sow[
transformElement@#
,
{tagElement@#}
]&
,
x
,
{mapLevel}
]
,
tagPattern
,
transformResults
][[2]]
]
];
Here are examples of how this version can be used:
Using Mathematica Gather/Collect properly
How would you do a PivotTable function in Mathematica?
Mathematica fast 2D binning algorithm
Internal`Bag
Daniel Lichtblau describes here an interesting internal data structure for growing lists.
Implementing a Quadtree in Mathematica
Debugging functions
These two posts point to useful functions for debugging:
Here''s another function based on Reap and Sow to extract expressions from different parts of a program and store them in a symbol.
SetAttributes[ReapTags,HoldFirst];
ReapTags[expr_]:=
Module[{elements},
Reap[expr,_,(elements[#1]=#2/.{x_}:>x)&];
elements
];
Aquí hay un ejemplo
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*)
Otros recursos
Here''s a list of interesting links for learning purpose:
A collection of Mathematica learning resources
Updated here: https://mathematica.stackexchange.com/a/259/66
Printing system symbol definitions without context prepended
The contextFreeDefinition[]
function below will attempt to print the definition of a symbol without the most common context prepended. The definition then can be copied to Workbench and formatted for readability (select it, right click, 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]},
Print@InputForm[FullDefinition[sym]]]])
contextFreeDefinition[sym_Symbol, context_String] :=
contextFreeDefinition[sym, {context}]
contextFreeDefinition[sym_Symbol] :=
contextFreeDefinition[sym, commonestContexts[sym]]
withRules[]
Caveat: This function does not localize variables the same way With
and Module
do, which means that nested localization constructs won''t work as expected. withRules[{a -> 1, b -> 2}, With[{a=3}, b_ :> b]]
will replace a
and b
in the nested With
and Rule
, while With
doesn''t do this.
This is a variant of With
that uses rules instead of =
and :=
:
ClearAll[withRules]
SetAttributes[withRules, HoldAll]
withRules[rules_, expr_] :=
Internal`InheritedBlock[
{Rule, RuleDelayed},
SetAttributes[{Rule, RuleDelayed}, HoldFirst];
Unevaluated[expr] /. rules
]
I found this useful while cleaning up code written during experimentation and localizing variables. Occasionally I end up with parameter lists in the form of {par1 -> 1.1, par2 -> 2.2}
. With withRules
parameter values are easy to inject into code previously written using global variables.
Usage is just like With
:
withRules[
{a -> 1, b -> 2},
a+b
]
Antialiasing 3D graphics
This is a very simple technique to antialias 3D graphics even if your graphics hardware doesn''t support it natively.
antialias[g_, n_: 3] :=
ImageResize[Rasterize[g, "Image", ImageResolution -> n 72], Scaled[1/n]]
Aquí hay un ejemplo:
Note that a large value for n
or a large image size tends to expose graphics driver bugs or introduce artefacts.
Notebook diff functionality
Notebook diff functionality is available in the <<AuthorTools`
package, and (at least in version 8) in the undocumented NotebookTools`
context. This is a little GUI to diff two notebooks that are currently open:
PaletteNotebook@DynamicModule[
{nb1, nb2},
Dynamic@Column[
{PopupMenu[Dynamic[nb1],
Thread[Notebooks[] -> NotebookTools`NotebookName /@ Notebooks[]]],
PopupMenu[Dynamic[nb2],
Thread[Notebooks[] -> NotebookTools`NotebookName /@ Notebooks[]]],
Button["Show differences",
CreateDocument@NotebookTools`NotebookDiff[nb1, nb2]]}]
]
PutAppend with PageWidth -> Infinity
In Mathematica using of the PutAppend
command is the most straightforward way to maintain a running log file with results of intermediate computations. But it uses by default PageWith->78
setting when exporting expressions to a file and so there is no guarantee that every intermediate output will take only one line in the log.
PutAppend
does not have any options itself but tracing its evaluations reveals that it is based on the OpenAppend
function which has the PageWith
option and allows changing its default value by the SetOptions
command:
In[2]:= Trace[x>>>"log.txt",TraceInternal->True]
Out[2]= {x>>>log.txt,{OpenAppend[log.txt,CharacterEncoding->PrintableASCII],OutputStream[log.txt,15]},Null}
So we can get PutAppend
to append only one line at a time by setting:
SetOptions[OpenAppend, PageWidth -> Infinity]
ACTUALIZAR
There is a bug introduced in version 10: SetOptions
no longer affects the behavior of OpenWrite
and OpenAppend
.
A workaround is to implement your own version of PutAppend
with explicit PageWidth -> Infinity
option:
Clear[myPutAppend]
myPutAppend[expr_, pathtofile_String] :=
(Write[#, expr]; Close[#];) &[OpenAppend[pathtofile, PageWidth -> Infinity]]
Note that we also may implement it via WriteString
as shown in this answer, but in this case it will be necessary to preliminarily convert the expression into the corresponding InputForm
via ToString[expr, InputForm]
.
Este no es un recurso completo, así que lo estoy lanzando aquí en la sección de respuestas, pero lo he encontrado muy útil para resolver problemas de velocidad (que, desafortunadamente, es una gran parte de lo que trata la programación de 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};
El uso es simplemente timeAvg@funcYouWantToTest
.
EDITAR: Mr. Wizard ha proporcionado una versión más simple que elimina Throw
and Catch
y es un poco más fácil de analizar:
SetAttributes[timeAvg, HoldFirst]
timeAvg[func_] := Do[If[# > 0.3, Return[#/5^i]] & @@
Timing @ Do[func, {5^i}]
,{i, 0, 15}]
EDITAR: Aquí hay una versión de acl (tomada de here ):
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]
Mathematica es una herramienta aguda, pero puede cortarte con su comportamiento algo sin tipo y avalanches de mensajes de diagnóstico crípticos. Una forma de lidiar con esto es definir funciones siguiendo este modismo:
ClearAll@zot
SetAttributes[zot, ...]
zot[a_] := ...
zot[b_ /; ...] := ...
zot[___] := (Message[zot::invalidArguments]; Abort[])
Esa es una gran cantidad de repetición, que con frecuencia me siento tentado a omitir. Especialmente cuando se crean prototipos, lo que sucede mucho en Mathematica. Por lo tanto, utilizo una macro llamada define
que me permite mantenerme disciplinado, con mucho menos repetitivo.
Un uso básico de define
es así:
define[
fact[0] = 1
; fact[n_ /; n > 0] := n * fact[n-1]
]
fact[5]
120
Al principio no parece mucho, pero hay algunos beneficios ocultos. El primer servicio que define
proporciona es que aplica ClearAll
automáticamente al símbolo que se está definiendo. Esto asegura que no haya definiciones sobrantes, una ocurrencia común durante el desarrollo inicial de una función.
El segundo servicio es que la función que se está definiendo se "cierra" automáticamente. Con esto quiero decir que la función emitirá un mensaje y abortará si se invoca con una lista de argumentos que no concuerde con una de las definiciones:
fact[-1]
define::badargs: There is no definition for ''fact'' applicable to fact[-1].
$Aborted
Este es el valor principal de define
, que capta una clase de error muy común.
Otra conveniencia es una forma concisa de especificar atributos en la función que se está definiendo. Hagamos la función Listable
:
define[
fact[0] = 1
; fact[n_ /; n > 0] := n * fact[n-1]
, Listable
]
fact[{3, 5, 8}]
{6, 120, 40320}
Además de todos los atributos normales, define
acepta un atributo adicional llamado Open
. Esto evita que define
agregue la definición del error catch-all a la función:
define[
successor[x_ /; x > 0] := x + 1
, Open
]
successor /@ {1, "hi"}
{2, successor["hi"]}
Se pueden definir múltiples atributos para una función:
define[
flatHold[x___] := Hold[x]
, {Flat, HoldAll}
]
flatHold[flatHold[1+1, flatHold[2+3]], 4+5]
Hold[1 + 1, 2 + 3, 4 + 5]
Sin más preámbulos, aquí está la definición de define
:
ClearAll@define
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:{}] :=
( ClearAll@name
; SetAttributes[name, DeleteCases[attributes, Open]]
; If[!MemberQ[attributes, Open]
, def:name[___] := (Message[define::badargs, name, Defer@def]; Abort[])
]
; body
;
)
def:define[___] := (Message[define::malformed, Defer@def]; Abort[])
define::badargs = "There is no definition for ''``'' applicable to ``.";
define::malformed = "Malformed definition: ``";
La implementación exhibida no admite ni valores altos ni currículos, ni patrones más generales que la definición de funciones simples. Sin embargo, sigue siendo útil.
Todd Gayley (Wolfram Research) simplemente me envía un truco agradable que permite "envolver" las funciones integradas con código arbitrario. Siento que tengo que compartir este útil instrumento. La siguiente es la respuesta de Todd sobre mi question
.
Un poco de historia interesante (?): Ese estilo de hack para "envolver" una función incorporada fue inventado alrededor de 1994 por Robby Villegas y yo, irónicamente para la función Message, en un paquete llamado ErrorHelp que escribí para el Mathematica Journal. en aquel momento. Ha sido utilizado muchas veces, por muchas personas, desde entonces. Es un truco de información privilegiada, pero creo que es justo decir que se ha convertido en la forma canónica de inyectar su propio código en la definición de una función incorporada. Hace el trabajo bien. Por supuesto, puede poner la variable $ inMsg en cualquier contexto privado que desee.
Unprotect[Message];
Message[args___] := Block[{$inMsg = True, result},
"some code here";
result = Message[args];
"some code here";
result] /; ! TrueQ[$inMsg]
Protect[Message];
Una de las cosas buenas de la interfaz de computadora portátil de Mathematica es que puede evaluar expresiones en cualquier idioma, no solo en Mathematica. Como ejemplo simple, considere crear un nuevo tipo de celda de entrada de Shell que pase la expresión contenida al shell del sistema operativo para su evaluación.
Primero, defina una función que delega la evaluación de un comando textual al shell externo:
shellEvaluate[cmd_, _] := Import["!"~~cmd, "Text"]
El segundo argumento es necesario e ignorado por razones que se pondrán de manifiesto más adelante. A continuación, queremos crear un nuevo estilo llamado Shell :
- Abra un nuevo cuaderno.
- Seleccione el elemento de menú Formato / Editar hoja de estilo ...
- En el cuadro de diálogo, junto a Ingresar un nombre de estilo: escriba
Shell
. - Seleccione el soporte de la celda al lado del nuevo estilo.
- Seleccione el elemento del menú Cell / Show Expression
- Sobrescriba la expresión de la celda con el texto del Paso 6 dado a continuación.
- Una vez más, seleccione el elemento del menú Cell / Show Expression
- Cierra el diálogo.
Use la siguiente expresión de celda como el Texto del Paso 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"]
La mayor parte de esta expresión se copió directamente del estilo de programa incorporado. Los cambios clave son estas líneas:
Evaluatable->True,
CellEvaluationFunction->shellEvaluate,
CellFrameLabels->{{None, "Shell"}, {None, None}},
Evaluatable
habilita la funcionalidad MAYÚS + INTRO para la celda. La evaluación llamará a CellEvaluationFunction
pasando el contenido de la celda y el tipo de contenido como argumentos ( shellEvaluate
ignora el último argumento). CellFrameLabels
es solo una exquisitez que permite al usuario identificar que esta celda es inusual.
Con todo esto en su lugar, ahora podemos ingresar y evaluar una expresión de shell:
- En el cuaderno creado en los pasos anteriores, crea una celda vacía y selecciona el corchete de la celda.
- Seleccione el elemento de menú Formato / Estilo / Shell .
- Escriba un comando de shell del sistema operativo válido en la celda (por ejemplo, ''ls'' en Unix o ''dir'' en Windows).
- Presione MAYÚS + ENTRAR.
Lo mejor es mantener este estilo definido en una hoja de estilo ubicada en el centro. Además, las funciones de evaluación como shellEvaluate
se definen mejor como stubs usando DeclarePackage en init.m
Los detalles de ambas actividades están más allá del alcance de esta respuesta.
Con esta funcionalidad, uno puede crear cuadernos que contengan expresiones de entrada en cualquier sintaxis de interés. La función de evaluación puede escribirse en Mathematica puro o delegar cualquiera o todas las partes de la evaluación en una agencia externa. Tenga en cuenta que hay otros CellEpilog
relacionados con la evaluación de células, como CellEpilog
, CellProlog
y CellDynamicExpression
.
Un patrón común consiste en escribir el texto de la expresión de entrada en un archivo temporal, compilar el archivo en algún idioma, ejecutar el programa y capturar la salida para la visualización final en la celda de salida. Hay muchos detalles para abordar cuando se implementa una solución completa de este tipo (como capturar los mensajes de error correctamente), pero se debe apreciar el hecho de que no solo es posible hacer cosas como esta, sino también prácticas.
En una nota personal, son características como esta que hacen que la interfaz del portátil sea el centro de mi universo de programación.
Actualizar
La siguiente función auxiliar es útil para crear tales celdas:
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]
)
Se usa así:
shellCell[] := evaluatableCell["shell", Import["!"~~#, "Text"] &]
Ahora, si se evalúa shellCell[]
, la celda de entrada se eliminará y se reemplazará con una nueva celda de entrada que evalúa su contenido como un comando de shell.
Ya he mencionado this antes, pero la herramienta que encuentro más útil es una aplicación de Reap
and Sow
que imita / extiende el comportamiento de GatherBy
:
SelectEquivalents[x_List,f_:Identity, g_:Identity, h_:(#2&)]:=
Reap[Sow[g[#],{f[#]}]&/@x, _, h][[2]];
Esto me permite agrupar listas por cualquier criterio y transformarlas en el proceso. La forma en que funciona es que una función de criterios ( f
) etiqueta cada elemento en la lista, cada elemento es transformado por una segunda función suministrada ( g
), y la salida específica es controlada por una tercera función ( h
). La función h
acepta dos argumentos: una etiqueta y una lista de los elementos recolectados que tienen esa etiqueta. Los artículos conservan su orden original, por lo que si configura h = #1&
luego obtiene una Union
no ordenada, como en los examples de Reap
. Pero, puede ser utilizado para procesamiento secundario.
Como ejemplo de su utilidad, he estado trabajando con Wannier90 que da salida al hamiltoniano dependiente del espacio en un archivo donde cada línea es un elemento diferente en la matriz, de la siguiente manera
rx ry rz i j Re[Hij] Im[Hij]
Para convertir esa lista en un conjunto de matrices, reuní todas las sublistas que contienen la misma coordenada, convertí la información del elemento en una regla (es decir, {i, j} -> Re [Hij] + I Im [Hij]), y luego convirtió las reglas recopiladas en un SparseArray
todo con el único trazador de líneas:
SelectEquivalents[hamlst,
#[[;; 3]] &,
#[[{4, 5}]] -> (Complex @@ #[[6 ;;]]) &,
{#1, SparseArray[#2]} &]
Honestamente, esta es mi navaja suiza, y hace que las cosas complejas sean muy simples. La mayoría de mis otras herramientas son un tanto específicas del dominio, así que probablemente no las publique. Sin embargo, la mayoría, si no todos, de ellos hacen referencia a SelectEquivalents
.
Editar : no imita completamente a GatherBy
que no puede agrupar varios niveles de la expresión tan simple como GatherBy
. Sin embargo, Map
funciona bien para la mayoría de lo que necesito.
Ejemplo : @Yaroslav Bulatov ha pedido un ejemplo autónomo. Aquí hay uno de mi investigación que se ha simplificado enormemente. Entonces, digamos que tenemos un conjunto de puntos en un avión
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}}
y nos gustaría reducir el número de puntos mediante un conjunto de operaciones de simetría. (Para los curiosos, estamos generando el pequeño grupo de cada punto.) Para este ejemplo, utilicemos un eje de rotación de cuatro veces alrededor del eje z
In[2] := rots = RotationTransform[#, {0, 0, 1}] & /@ (Pi/2 Range[0, 3]);
Usando SelectEquivalents
podemos agrupar los puntos que producen el mismo conjunto de imágenes bajo estas operaciones, es decir, son equivalentes, usando los siguientes
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}}}
que produce 3 sublistas que contienen los puntos equivalentes. (Tenga en cuenta que Union
es absolutamente vital aquí ya que asegura que cada punto produce la misma imagen. Originalmente, utilicé Sort
, pero si un punto se encuentra en un eje de simetría, es invariante bajo la rotación sobre ese eje dando una imagen extra Por lo tanto, Union
elimina estas imágenes adicionales. Además, GatherBy
produciría el mismo resultado.) En este caso, los puntos ya están en una forma que GatherBy
, pero solo necesito un punto representativo de cada agrupación e I '' d como un recuento de los puntos equivalentes. Como no necesito transformar cada punto, utilizo la función de Identity
en la segunda posición. Para la tercera función, debemos ser cuidadosos. El primer argumento que se le pasará serán las imágenes de los puntos debajo de las rotaciones, que para el punto {0,0,0}
es una lista de cuatro elementos idénticos, y usarlo arrojaría el conteo. Sin embargo, el segundo argumento es solo una lista de todos los elementos que tienen esa etiqueta, por lo que solo contendrá {0,0,0}
. En codigo,
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}}
Tenga en cuenta que este último paso puede lograrse tan fácilmente
In[5] := {#[[1]], Length[#]}& /@ Out[3]
Sin embargo, es fácil con este y el ejemplo menos completo anterior ver cómo las transformaciones muy complejas son posibles con un mínimo de código.
By popular demand, the code to generate the top-10 SO answerers plot (except annotations ) using the SO API .
getRepChanges[userID_Integer] :=
Module[{totalChanges},
totalChanges =
"total" /.
Import["http://api..com/1.1/users/" <>
ToString[userID] <> "/reputation?fromdate=0&pagesize=10&page=1",
"JSON"];
Join @@ Table[
"rep_changes" /.
Import["http://api..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..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", ""})]
Following function format[expr_]
can be used to indent/format unformatted mathematica
expressions that spans over a page
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 /@ Characters@str // StringJoin];
format[expr_] := indent[expr // InputForm // ToString, "[({", "])}", ";"];
(*
format[Hold@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 /@ Characters@str // StringJoin]]
*)
ref: https://codegolf.stackexchange.com/questions/3088/indent-a-string-using-given-parentheses
I find it really useful when developing packages to add this keyboard shortcut to my SystemFiles/FrontEnd/TextResources/Windows/KeyEventTranslations.tr
file.
(* Evaluate Initialization Cells: Real useful for reloading library changes. *)
Item[KeyEvent["i", Modifiers -> {Control, Command}],
FrontEndExecute[
FrontEndToken[
SelectedNotebook[],
"EvaluateInitialization"]]],
Next for every Packagename.m
I make a PackagenameTest.nb
notebook for testing and the first 2 cells of the test notebook are set as initialization cells. In the first cell I put
Needs["PackageManipulations`"]
to load the very useful PackageManipulations library which was written by Leonid. The second cell contains
PackageRemove["Packagename`Private`"]
PackageRemove["Packagename`"]
PackageReload["Packagename`"]
which all do the actual package reloading. Note the first two lines are there only to Remove
all symbols as I like to keep the contexts as clean as possible.
Then the workflow for writing and testing a package becomes something like this.
- Save changes to
Packagename.m
. - Go to
PackagenameTest.nb
and doCTRL + ALT + i
.
This causes the initialization cells to reload the package, which makes testing real simple.
I was just looking through one of my packages for inclusion in this, and found some messages that I defined that work wonders: Debug::<some name>
. By default, they are turned off, so don''t produce much overhead. But, I can litter my code with them, and turn them on if I need to figure out exactly how a bit of code is behaving.
I''m sure a lot of people have encountered the situation where they run some stuff, realizing it not only stuck the program, but they also haven''t saved for the last 10 minutes!
EDITAR
After suffering from this for some time, I one day found out that one can create auto-save from within the Mathematica code. I think that using such auto-save have helped me a lot in the past, and I always felt that the possibility itself was something that not a lot of people are aware that they can do.
The original code I used is at the bottom. Thanks to the comments I''ve found out that it is problematic, and that it is much better to do it in an alternative way, using ScheduledTask
(which will work only in Mathematica 8).
Code for this can be found in this answer from Sjoerd C. de Vries
(Since I''m not sure if it''s OK to copy it to here, I''m leaving it as a link only.)
The solution below is using Dynamic
. It will save the notebook every 60 seconds, but apparently only if its cell is visible . I''m leaving it here only for completion reasons. (and for users of Mathematica 6 and 7)
/EDIT
To solve it I use this code in the beginning of a notebook:
Dynamic[Refresh[NotebookSave[]; DateString[], UpdateInterval -> 60]]
This will save your work every 60 seconds.
I prefer it to NotebookAutoSave[]
because it saves before the input is processed, and because some files are more text than input.
I originally found it here: http://en.wikipedia.org/wiki/Talk:Mathematica#Criticisms
Note that once running this line, saving will happen even if you close and re-open your file (as long as dynamic updating is enabled).
Also, since there is no undo in Mathematica , be careful not to delete all your content, since saving will make it irreversible (as a precaution move, I remove this code from every finished notebook)
It is possible to run MathKernel in batch mode by using undocumented command-line options -batchinput
and -batchoutput
:
math -batchinput -batchoutput < input.m > outputfile.txt
(where input.m
is the batch input file ending with the newline character, outputfile.txt
is the file to which the output will be redirected).
In Mathematica v.>=6 the MathKernel has undocumented command-line option:
-noicon
which controls whether the MathKernel will have visible icon on the Taskbar (at least under Windows).
The FrontEnd (at least from v.5) has undocumented command-line option
-b
which disables the splash-screen and allows to run the Mathematica FrontEnd much faster
and option
-directlaunch
which disables the mechanism which launches the most recent Mathematica version installed instead of launching the version associated with .nb files in the system registry.
Another way to do this probably is :
Instead of launching the Mathematica.exe binary in the installation directory, launch the Mathematica.exe binary in SystemFiles/FrontEnd/Binaries/Windows. The former is a simple launcher program which tries its hardest to redirect requests for opening notebooks to running copies of the user interface. The latter is the user interface binary itself.
It is handy to combine the last command line option with setting global FrontEnd option VersionedPreferences->True
which disables sharing of preferences between different Mathematica versions installed :
SetOptions[$FrontEnd, VersionedPreferences -> True]
(The above should be evaluated in the most recent Mathematica version installed.)
In Mathematica 8 this is controlled in the Preferences dialog, in the System pane, under the setting "Create and maintain version specific front end preferences" .
It is possible to get incomplete list of command-line options of the FrontEnd by using undocumented key -h
(the code for Windows):
SetDirectory[$InstallationDirectory <>
"//SystemFiles//FrontEnd//Binaries//Windows//"];
Import["!Mathematica -h", "Text"]
da:
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
Other options include:
-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
Are there other potentially useful command-line options of the MathKernel and the FrontEnd? Please share if you know.
My favorite hacks are small code-generating macros that allow you to replace a bunch of standard boilerplate commands with one short one. Alternatively, you can create commands for opening/creating notebooks.
Here is what I''ve been using for a while in my day-to-day Mathematica workflow. I found myself performing the following a lot:
- Make a notebook have a private context, load package(s) I need, make it autosave.
- After working with this notebook for a while, I''d want to do some throw away scratch computations in a separate notebook, with its own private context, while having access to definitions I''ve been using in the "main" notebook. Because I set up the private context, this requires to manually adjust $ContextPath
Doing all this by hand over and over is a pain, so let''s automate! First, some utility code:
(* 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 = Flatten@List@list;
If[! MemberQ[ctList, Except[_String]],AppendTo[$ContextPath, #] & /@ ctList,
Message[ExposeContexts::badargs]];
$ContextPath = DeleteDuplicates[$ContextPath];
$ContextPath]
Autosave[x:(True|False)] := SetOptions[EvaluationNotebook[],NotebookAutoSave->x];
Now, let''s create a macro that''s going to put the following cells in the notebook:
SetOptions[EvaluationNotebook[], CellContext -> Notebook]
Needs["LVAutils`"]
Autosave[True]
And here''s the macro:
MyPrivatize[exposedCtxts : ({__String} | Null) : Null]:=
SelfDestruct@Module[{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];
]
]
Now when I type in MyPrivatize[]
is creates the private context and loads my standard package. Now let''s create a command that will open a new scratch notebook with its own private context (so that you can hack there with wild abandon without the risk of screwing up the definitions), but has access to your current contexts.
SpawnScratch[] := SelfDestruct@Module[{nb,boxExpr,strList},
strList = Riffle[("/"" <> # <> "/"") & /@ $ContextPath, ","];
boxExpr = RowBox[{"MyPrivatize", "[",
RowBox[{"{", RowBox[strList], "}"}], "]"}];
nb = CreateDocument[];
writeAndEval[nb,boxExpr];
]
The cool thing about this is that due to SelfDestruct
, when the command runs it leaves no trace in the current notebook -- which is good, because otherwise it would just create clutter.
For extra style points, you can create keyword triggers for these macros using InputAutoReplacements
, but I''ll leave this as an exercise for the reader.
My utility functions (I have these built in to MASH, which is mentioned in the question):
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[] *)
Most@NestWhileList[f[]&, f[], test]; (* returns while test is true. *)
readList[] := doList[read, #=!=EOF&]; (* Slurp list''o''lines from stdin. *)
cat = StringJoin@@(ToString/@{##})&; (* Like sprintf/strout in C/C++. *)
system = Run@cat@##&; (* 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[Evaluate@lst, 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). *)
One of the things that bothers me about the built-in scoping constructs is that they evaluate all of the local variable definitions at once, so you can''t write for example
With[{a = 5, b = 2 * a},
...
]
So a while ago I came up with a macro called WithNest that allows you to do this. I find it handy, since it lets you keep variable bindings local without having to do something like
Module[{a = 5,b},
b = 2 * a;
...
]
In the end, the best way I could find to do this was by using a special symbol to make it easier to recurse over the list of bindings, and I put the definition into its own package to keep this symbol hidden. Maybe someone has a simpler solution to this problem?
If you want to try it out, put the following into a file called 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''s 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[List@a,body]]];
SyntaxInformation[WithNest]={"ArgumentsPattern"->{{__},_}};
SetAttributes[WithNest,{HoldAll,Protected}];
End[];
EndPackage[];
One trick I''ve used, which allows you to emulate the way most built-in functions work with bad arguments (by sending a message and then returning the whole form unevaluated) exploits a quirk of the way Condition
works when used in a defintion. If foo
should only work with one argument:
foo[x_] := x + 1;
expr : foo[___] /; (Message[foo::argx, foo, Length@Unevaluated[expr], 1];
False) := Null; (* never reached *)
If you have more complex needs, it''s easy to factor out the argument validation and message generation as an independent function. You can do more elaborate things by using side effects in Condition
beyond just generating messages, but in my opinion most of them fall into the "sleazy hack" category and should be avoided if possible.
Also, in the "metaprogramming" category, if you have a Mathematica package ( .m
) file, you can use the "HeldExpressions"
element to get all the expressions in the file wrapped in HoldComplete
. This makes tracking things down much easier than using text-based searches. Unfortunately, there''s no easy way to do the same thing with a notebook, but you can get all the input expressions using something like the following:
inputExpressionsFromNotebookFile[nb_String] :=
Cases[Get[nb],
Cell[BoxData[boxes_], "Input", ___] :>
MakeExpression[StripBoxes[boxes], StandardForm],
Infinity]
Lastly, you can use the fact that Module
emulates lexical closures to create the equivalent of reference types. Here''s a simple stack (which uses a variation the Condition
trick for error handling as a bonus):
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 = Last@backing; instance);
HoldPattern[Push[instance : StackInstance[backing_], new_]] :=
(backing = {new, backing}; instance);
HoldPattern[Peek[instance : StackInstance[backing_]]] /;
! EmptyQ[instance] || (Message[StackInstance::empty]; False) :=
First@backing]
Now you can print the elements of a list in reverse order in a needlessly convoluted way!
With[{stack = MakeStack[], list},
Do[Push[stack, elt], {elt, list}];
While[!EmptyQ[stack],
Print[Peek@stack];
Pop@stack]]
Recursive pure functions ( #0
) seem to be one of the darker corners of the language. Here are a couple of non-trivial examples of their use , where this is really useful (not that they can not be done without it). The following is a pretty concise and reasonably fast function to find connected components in a graph, given a list of edges specified as pairs of vertices:
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[Flatten@lst][[All, 1]], f]];
What happens here is that we first map a dummy symbol on each of the vertex numbers, and then set up a way that, given a pair of vertices {f[5],f[10]}
, say, then f[5]
would evaluate to f[10]
. The recursive pure function is used as a path compressor (to set up memoization in such a way that instead of long chains like f[1]=f[3],f[3]=f[4],f[4]=f[2], ...
, memoized values get corrected whenever a new "root" of the component is discovered. This gives a significant speed-up. Because we use assignment, we need it to be HoldAll, which makes this construct even more obscure and more attractive ). This function is a result of on and off-line Mathgroup discussion involving Fred Simons, Szabolcs Horvat, DrMajorBob and yours truly. Ejemplo:
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>>}}
It is certainly much slower than a built-in, but for the size of code, quite fast still IMO.
Another example: here is a recursive realization of Select
, based on linked lists and recursive pure functions:
selLLNaive[x_List, test_] :=
Flatten[If[TrueQ[test[#1]],
{#1, If[#2 === {}, {}, #0 @@ #2]},
If[#2 === {}, {}, #0 @@ #2]] & @@ Fold[{#2, #1} &, {}, Reverse[x]]];
Por ejemplo,
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}}
It is however not properly tail recursive, and will blow the stack (crash the kernel) for larger lists. Here is the tail-recursive version:
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]], {}]];
Por ejemplo,
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}}
Remember that The Mathematica Book is also available online at web - though it''s superseded by the current documentation at http://reference.wolfram.com
This code makes a palette that uploads the selection to Stack Exchange as an image. On Windows, an extra button is provided that gives a more faithful rendering of the selection.
Copy the code into a notebook cell and evaluate. Then pop out the palette from the output, and install it using Palettes -> Install Palette...
If you have any trouble with it, post a comment here. Download the notebook version here .
Begin["SOUploader`"];
Global`palette = PaletteNotebook@DynamicModule[{},
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"],
Unevaluated@Sequence[]
]
}],
(* 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[
First@StringCases[
First@Select[res, StringMatchQ[#, k ~~ ___] &],
k ~~ v___ ~~ ";" :> v],
"''"]
];
data = ExportString[g, "PNG"];
JLink`JavaBlock[
url = "http://.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];
part@setContentType["image/png"];
entity =
JLink`JavaNew[
"org.apache.commons.httpclient.methods.multipart./
MultipartRequestEntity", {part}, method@getParams[]];
method@setRequestEntity[entity];
code = client@executeMethod[method];
response = method@getResponseBodyAsString[];
];
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[
NotebookGet@ClipboardNotebook[] /.
r_RasterBox :>
Block[{},
Throw[Image[First[r], "Byte", ColorSpace -> "RGB"], tag] /;
True];
$Failed,
tag
]
]
];
)
(* Init end *)
]
End[];
This is recipe from Stan Wagon''s book...use it when built-in Plot behaves erratically due to lack of precision
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]]]]];
I often use the following trick from Kristjan Kannike''s when I need "dictionary-like" behavior from Mathematica''s 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]
When evaluation results are confusing, sometimes it helps to dump evaluation steps into a text file
SetAttributes[recordSteps, HoldAll];
recordSteps[expr_] :=
Block[{$Output = List@OpenWrite["~/temp/msgStream.m"]},
TracePrint[Unevaluated[expr], _?(FreeQ[#, Off] &),
TraceInternal -> True];
Close /@ $Output;
Thread[Union@
Cases[ReadList["~/temp/msgStream.m", HoldComplete[Expression]],
symb_Symbol /;
AtomQ@Unevaluated@symb &&
Context@Unevaluated@symb === "System`" :>
HoldComplete@symb, {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]]
This one was written by Alberto Di Lullo, (who doesn''t appear to be on ).
CopyToClipboard
, for Mathematica 7 (in Mathematica 8 it''s built in)
CopyToClipboard[expr_] :=
Module[{nb},
nb = CreateDocument[Null, Visible -> False, WindowSelected -> True];
NotebookWrite[nb, Cell[OutputFormData@expr], All];
FrontEndExecute[FrontEndToken[nb, "Copy"]];
NotebookClose@nb];
Original post: http://forums.wolfram.com/mathgroup/archive/2010/Jun/msg00148.html
I have found this routine useful for copying large real numbers to the clipboard in ordinary decimal form. Eg CopyToClipboard["123456789.12345"]
Cell[OutputFormData@expr]
neatly removes the quotes.