What is in your Mathematica tool bag? [closed]

Answer 1

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

Answer 2

This one was written by Alberto Di Lullo, (who doesn't appear to be on Stack Overflow).

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. E.g. CopyToClipboard["123456789.12345"]

Cell[OutputFormData@expr] neatly removes the quotes.

Answer 3

General PDF/EMF export problems and solutions

1) It is completely unexpected and undocumented, but Mathematica exports and saves graphics in PDF and EPS formats using a set of style definitions that differs from the one used for displaying Notebooks on screen. 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 Magnifying 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).

Answer 4

Remember that The Mathematica Book is also available online at http://reference.wolfram.com/legacy/v5_2/ - though it's superseded by the current documentation at http://reference.wolfram.com

Answer 5

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).   *)

Answer 6

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]]