A collection of small utility functions for Mathematica programming. Also for compatibility issues. #mma

mmautil.m

(*
 * MemberAllQ[list, form] returns True if all elements of `list' matches `form',
 * False otherwise.
 *)
MemberAllQ[list_, form_] := Fold[(#1 && MatchQ[#2, form])&, True, list];

(*
 * FreeAllQ[expr, forms] returns True if the given expression does not match to
 * any of the given forms.
 *)
FreeAllQ[expr_, forms_List] := Fold[(#1 && FreeQ[expr, #2])&, True, forms];

FreeAllQ[expr_, forms_List, levelspec_] :=
  Fold[(#1 && FreeQ[expr, #2, levelspec])&, True, forms];

FreeAllQ[expr_, form_] := FreeQ[expr, forms];

FreeAllQ[expr_, form_, levelspec_] := FreeQ[expr, form, levelspec];

(*
 * Gives True for a valid variable.
 *)
VariableQ[_Plus|_Times|_Power] = False;

VariableQ[Indeterminate|_DirectedInfinity|_ComplexInfinity] = False;

VariableQ[_?NumberQ] = False;

VariableQ[_] = True;

(*
 * Gives True for a replacement rule or a list of replacement rules.
 *)
RuleQ[(Rule|RuleDelayed)[_, _]] = True;

RuleQ[rules_List] :=
  Fold[(#1 && MatchQ[#2, (Rule|RuleDelayed)[_, _]])&, True, rules];

RuleQ[rules_Dispatch] := RuleQ[rules[[1]]] /; Length[rules] >= 1;

RuleQ[_] = False;

(*
 * SeriesQ[expr, vars..] returns True if `expr' is a series expansion with
 * respect to `vars', False otherwise.
 *
 * Depends on: MemberAllQ.
 *)
SeriesQ[s_SeriesData, x_] := Length[s] >= 1 && s[[1]] === x;

SeriesQ[s_SeriesData, x_, y__] := Length[s] >= 3 && s[[1]] === x &&
  ListQ[s[[3]]] && MemberAllQ[s[[3]], _?(SeriesQ[#, y]&)];

SeriesQ[_, __] = False;

(*
 * Gives True for a zero matrix.
 *)
ZeroMatrixQ[m_] := MatrixQ[m] && !MemberQ[Flatten[m], _?(# =!= 0&)];

(*
 * Converts the given expression into a list with respect to the specified
 * operator. E.g.,
 *   MakeList[0, Plus]      => {},
 *   MakeList[a, Plus]      => {a},
 *   MakeList[a + b, Plus]  => {a, b},
 *   MakeList[0, Times]     => {0},
 *   MakeList[1, Times]     => {},
 *   MakeList[a, Times]     => {a},
 *   MakeList[a + b, Times] => {a, b}.
 *)
MakeList[expr_, op:Plus|Times|And|Or] :=
  DeleteCases[List @@ op[expr, dummy[1], dummy[2]], dummy[_]];

MakeList[0, Times] = {0};

MakeList[False, And] = {False};

MakeList[True, Or] = {True};

(*
 * Separates elements in the list that matches to the pattern and returns
 * the result as { matched-elements, non-matched-elements }. E.g.,
 *   SeparateList[{1, 2, -3}, _?Positive] => {{1, 2}, {-3}}.
 *)
SeparateList[list_, pattern_] := {
  Head[list] @@ (Reap[Scan[(
    If[MatchQ[#, pattern],
      Sow[#];
    ];
  )&, list]][[2]] ~ Flatten ~ 1),
  Head[list] @@ (Reap[Scan[(
    If[!MatchQ[#, pattern],
      Sow[#];
    ];
  )&, list]][[2]] ~ Flatten ~ 1)
};

(*
 * Extracts option infomration from options like
 *   opt = name -> {"mainoption",
 *                  "suboption1" -> value1,
 *                  "suboption2" -> value2}.
 * Then,
 *   MainOption[opt]  =>  "mainoption",
 *   SubOptions[opt]  =>  {"suboption1" -> value1,
 *                         "suboption2" -> value2}.
 *)
MainOption[opt_] := opt[[1]] /; ListQ[opt] && Length[opt] >= 1;

MainOption[opt_] := opt;

SubOptions[opt_] := Rest[opt] /; ListQ[opt] && Length[opt] >= 1;

SubOptions[opt_] := {};

(******************************************************************************)

(* Compatibilities *)

(* Confirmed with v5.1 *)
If[$VersionNumber < 7,
  FindFile[name_String] := System`Private`FindFile[name];
];

(* Confirmed with v5.1 *)
If[$VersionNumber < 8,
  $InputFileName := System`Private`$InputFileName;
];

(* http://mathematica.stackexchange.com/questions/2419/delete-duplicate-elements-from-a-list *)
(* Confirmed with v5.1 and v6.0; TJ is faster than DD in v6.0. *)
If[$VersionNumber < 7,
  If[$VersionNumber >= 6,
    DeleteDuplicates[x_List] :=
      Tally[Join@x][[All, 1]],
    DeleteDuplicates[x_List] :=
      Part[x, Sort@Part[Range[Length@x][[#]],
         Most@FoldList[Plus, 1, Length /@ Split@x[[#]]]]]& @ Ordering@x
  ];
];

If[$VersionNumber < 9,
  DuplicateFreeQ[list_] := UnsameQ @@ list /; !AtomQ[list];
];

If[$VersionNumber < 10,
  SquareMatrixQ[m_?MatrixQ] := Length[m] === Length[First[m]];
  SquareMatrixQ[_] := False;
];

(* vim: set ft=mma et ts=8 sts=2 sw=2: *)