(* :Title: List Tricks *)

(* :Context: ListTricks` *)

(* :Author: Eric Rowland *)
(*          http://math.rutgers.edu/~erowland *)

(* :Date: {2009, 5, 16} *)

(* :Package Version: 2.20 *)

(* :Mathematica Version: 7.0 *)

(* :Discussion:
	This package is a collection of structure manipulation tools.
*)


BeginPackage["ListTricks`"]

{
	AgreementLength,
	ArrayMap,
	Best,
	CanonicalRotation,
	Case,
	Classify,
	ColumnWrap,
	Complements,
	DropAfter,
	DropBefore,
	FixedPointPeriod,
	FixedPointSet,
	GroupActionMod,
	MapAcross,
	MapList,
	Multisets,
	NextTuple,
	Occurrence,
	PartitionAfter,
	PartitionAt,
	PartitionBefore,
	Period,
	PeriodLength,
	Portion,
	RaggedPartition,
	RotateClockwise,
	RotateCounterClockwise,
	RotateLeftTo,
	RotateRightTo,
	Shear,
	Sift, Distinct,
	SuccessiveMaxima,
	SuccessiveMinima,
	Swap,
	TakeAfter,
	TakeBefore,
	Tile,
	Trim,
	Unpad,
	UnpadLeft,
	UnpadRight,
	Unriffle,
	WrappedArrayPlot
}


Unprotect["ListTricks`*"]

Begin["`Private`"]

var[variables___String] :=
	StringJoin[Riffle[("\*StyleBox[\"" <> # <> "\", \"TI\"]" &) /@ {variables}, ", "]]

sub[variable_String, indices : {___}] :=
StringJoin[Riffle[
	Replace[indices, {
		"..." -> "\*StyleBox[\"\[Ellipsis]\", \"TI\"]",
		s_String :> "\!\(\*SubscriptBox[StyleBox[\"" <> variable <> "\", \"TI\"], StyleBox[\"" <> s <> "\", \"TI\"]]\)",
		s_ :> "\!\(\*SubscriptBox[StyleBox[\"" <> variable <> "\", \"TI\"], StyleBox[\"" <> ToString[s] <> "\", \"TR\"]]\)"
	},
	{1}
], ", "]]
sub["...", _] := var["..."]
sub[variable_String, index_] := sub[variable, {index}]
sub[variables_List, index : Except[_List]] := sub @@ ({#, index} &) /@ variables
sub[variables : {_String, _} ...] := StringJoin[Riffle[sub @@@ {variables}, ", "]]


Accumulate::usage =
"Accumulate[" <> var["list"] <> "] gives a list of the successive accumulated totals of elements in " <> var["list"] <> ".
Accumulate[{" <> sub["e", {1, 2, 3, "..."}] <> "}, " <> var["f"] <> "] forms {" <> var["f"] <> "[" <> sub["e", 1] <> "], " <> var["f"] <> "[" <> sub["e", {1, 2}] <> "], " <> var["f"] <> "[" <> sub["e", {1, 2, 3}] <> "], \[Ellipsis]}."

AgreementLength::usage =
"AgreementLength[" <> sub["list", {1, 2, "..."}] <> "] gives the number of beginning entries for which several lists agree."

ArrayMap::usage =
"ArrayMap[" <> var["f", "array"] <> ", {" <> var["level"] <> "}] applies " <> var["f"] <> " to the subarrays of " <> var["array"] <> " specified by " <> var["level"] <> ".
ArrayMap[" <> var["f", "array"] <> ", {" <> var["level"] <> "}, " <> var["d"] <> "] applies " <> var["f"] <> " along direction " <> var["d"] <> "."

Best::usage =
"Best[" <> var["list", "f"] <> "] gives the elements of " <> var["list"] <> " that score highest under the fitness function " <> var["f"] <> ".
Best[" <> var["list"] <> "] gives the largest elements of " <> var["list"] <> "."

CanonicalRotation::usage =
"CanonicalRotation[" <> var["list"] <> "] gives the rotation of " <> var["list"] <> " that appears first in canonical order.
CanonicalRotation[" <> var["list", "p"] <> "] uses the ordering function " <> var["p"] <> "."

Case::usage =
"Case[{" <> sub["e", {1, 2, "..."}] <> "}, " <> var["pattern"] <> "] gives the first " <> sub["e", "i"] <> " that matches " <> var["pattern"] <> ", returning Null if no element is found.
Case[{" <> sub["e", {1, "..."}] <> "}, " <> var["pattern"] <> " \[Rule] " <> var["rhs"] <> "] gives the value of rhs corresponding to the first " <> sub["e", "i"] <> " that matches " <> var["pattern"] <> ".
Case[" <> var["list", "pattern", "alt"] <> "] returns " <> var["alt"] <> " rather than Null if no element is found.
Case[" <> var["list", "pattern", "alt", "n"] <> "] finds the " <> var["n"] <> "th matching element, where negative " <> var["n"] <> " counts from the end of the list."

Classify::usage =
"Classify[" <> var["list"] <> "] partitions the elements of " <> var["list"] <> " into labeled equivalence classes {{{" <> sub["e", {11, 12, "..."}] <> "}, " <> sub["p", 1] <> "}, {{" <> sub["e", {21, 22, "..."}] <> "}, " <> sub["p", 2] <> "}, \[Ellipsis]}.
Classify[" <> var["list", "f"] <> "] classifies elements by their values under " <> var["f"] <> ".
Classify[" <> var["list", "f", "g"] <> "] applies " <> var["g"] <> " to each element after it is classified.
Classify[" <> var["list", "f", "g", "h"] <> "] applies " <> var["h"] <> " to class."

ColumnWrap::usage =
"ColumnWrap[" <> var["list", "n"] <> "] wraps a list into at most " <> var["n"] <> " columns.
ColumnWrap[" <> var["array", "n"] <> "] wraps a two\[Hyphen]dimensional array into at most " <> var["n"] <> " super\[Hyphen]columns.
ColumnWrap[" <> var["array", "n", "spacing"] <> "] leaves a space of size " <> var["spacing"] <> " between successive super\[Hyphen]columns."

Complements::usage =
"Complements[" <> sub["list", {1, 2}] <> "] gives the list {Complement[" <> sub["list", {1, 2}] <> "], Complement[" <> sub["list", {2, 1}] <> "]}.
Complements[" <> sub["list", {1, 2, 3, "..."}] <> "] gives {Complement[" <> sub["list", {1, 2, 3, "..."}] <> "], Complement[" <> sub["list", {2, 1, 3, "..."}] <> "], Complement[" <> sub["list", {3, 1, 2, "..."}] <> "], \[Ellipsis]}."

DropAfter::usage =
"DropAfter[" <> var["list", "pattern"] <> "] drops the elements of " <> var["list"] <> " appearing after the first element matching " <> var["pattern"] <> ".
DropAfter[" <> var["list", "pattern", "n"] <> "] drops the elements of " <> var["list"] <> " appearing after the " <> var["n"] <> "th element matching " <> var["pattern"] <> ". Negative " <> var["n"] <> " counts from the end of the list."

DropBefore::usage =
"DropBefore[" <> var["list", "pattern"] <> "] drops the elements of " <> var["list"] <> " appearing before the first element matching " <> var["pattern"] <> ".
DropBefore[" <> var["list", "pattern", "n"] <> "] drops the elements of " <> var["list"] <> " appearing before the " <> var["n"] <> "th element matching " <> var["pattern"] <> ". Negative " <> var["n"] <> " counts from the end of the list."

First::usage =
"First[" <> var["expr"] <> "] gives the first element in " <> var["expr"] <> ".
First[" <> var["expr", "default"] <> "] gives the first element in " <> var["expr"] <> ", or " <> var["default"] <> " if " <> var["expr"] <> " has length 0."

FixedPointPeriod::usage =
"FixedPointPeriod[" <> var["f", "expr"] <> "] gives the eventual period obtained by applying " <> var["f"] <> " repeatedly to " <> var["expr"] <> ".
FixedPointPeriod[" <> var["f", "expr", "n"] <> "] stops after at most " <> var["n"] <> " steps."

FixedPointSet::usage =
"FixedPointSet[" <> var["f", "list"] <> "] iteratively applies a list\[Hyphen]valued function " <> var["f"] <> " to each element of a list, adding the new elements obtained, until the result no longer changes.
FixedPointSet[" <> var["f", "list", "g"] <> "] treats elements as distinct based on their images under the \"indicator\" function " <> var["g"] <> "."

GroupActionMod::usage =
"GroupActionMod[" <> var["list", "f"] <> "] \"mods out\" a set of elements by a function " <> var["f"] <> " with finite orbit.
GroupActionMod[" <> var["list"] <> ", {" <> sub["f", {1, 2, "..."}] <> "}] mods out by the subgroup generated by " <> sub["f", {1, 2, "..."}] <> "."

Last::usage =
"Last[" <> var["expr"] <> "] gives the last element in " <> var["expr"] <> ".
Last[" <> var["expr", "default"] <> "] gives the last element in " <> var["expr"] <> ", or " <> var["default"] <> " if " <> var["expr"] <> " has length 0."

MapAcross::usage =
"MapAcross[{" <> sub["f", {1, 2, "..."}] <> "}, {" <> sub["x", {1, 2, "..."}] <> "}] gives {" <> sub["f", 1] <> "[" <> sub["x", 1] <> "], " <> sub["f", 2] <> "[" <> sub["x", 2] <> "], \[Ellipsis]}."

MapList::usage =
"MapList[" <> var["f", "list"] <> "] applies " <> var["f"] <> " to each element of " <> var["list"] <> " independently, returning a list of lists which differ from " <> var["list"] <> " in only one position each."

Multisets::usage =
"Multisets[" <> var["list", "n"] <> "] gives all multisets of " <> var["list"] <> " containing at most " <> var["n"] <> " elements.
Multisets[" <> var["list"] <> ", {" <> var["n"] <> "}] gives all multisets containing exactly " <> var["n"] <> " elements.
Multisets[" <> var["list"] <> ", {" <> sub["n", {"min", "max"}] <> "}] gives all multisets containing between " <> sub["n", "min"] <> " and " <> sub["n", "max"] <> " elements."

NextTuple::usage =
"NextTuple[" <> var["tuple", "list"] <> "] gives the tuple following " <> var["tuple"] <> " in the \"integer counting\" order implied by " <> var["list"] <> "."

Occurrence::usage =
"Occurrence[" <> var["list", "pattern"] <> "] gives the position of the first element in " <> var["list"] <> " that matches " <> var["pattern"] <> ", returning Null if no element is found.
Occurrence[" <> var["list"] <> ", " <> var["pattern"] <> " \[Rule] " <> var["f"] <> "] applies " <> var["f"] <> " to the position of the matching element.
Occurrence[" <> var["list", "pattern", "alt"] <> "] return " <> var["alt"] <> " rather than Null if no element is found.
Occurrence[" <> var["list", "pattern", "alt", "n"] <> "] find the " <> var["n"] <> "th matching element, where negative " <> var["n"] <> " counts from the end of the list."

PartitionAfter::usage =
"PartitionAfter[" <> var["list", "pattern"] <> "] partitions " <> var["list"] <> " by placing a break after each element matching " <> var["pattern"] <> ".
PartitionAfter[" <> var["list", "pattern", "n"] <> "] places a break after each of the first " <> var["n"] <> " such elements."

PartitionBefore::usage =
"PartitionBefore[" <> var["list", "pattern"] <> "] partitions " <> var["list"] <> " by placing a break before each element matching " <> var["pattern"] <> ".
PartitionBefore[" <> var["list", "pattern", "n"] <> "] places a break before the first " <> var["n"] <> " such elements."

PartitionAt::usage =
"PartitionAt[" <> var["list"] <> ", {" <> sub["n", {1, 2, "..."}] <> "}] partitions " <> var["list"] <> " by placing breaks after positions " <> sub["n", {1, 2, "..."}] <> ".
PartitionAt[" <> var["list", "n"] <> "] places a break after position " <> var["n"] <> "."

Period::usage =
"Period[" <> var["list"] <> "] gives the repetition period of " <> var["list"] <> "."

PeriodLength::usage =
"PeriodLength[" <> var["list"] <> "] gives the period length of " <> var["list"] <> "."

Portion::usage =
"Portion[" <> var["list"] <> "] gives the first half of " <> var["list"] <> ".
Portion[" <> var["list"] <> ", 1/" <> var["n"] <> "] gives the first (1/" <> var["n"] <> ")th of " <> var["list"] <> ".
Portion[" <> var["list", "frac", "i"] <> "] gives the " <> var["i"] <> "th " <> var["frac"] <> "th part of " <> var["list"] <> "."

RaggedPartition::usage =
"RaggedPartition[" <> var["list", "n"] <> "] partitions " <> var["list"] <> " into non\[Hyphen]overlapping sublists of length " <> var["n"] <> ", where any remaining elements are placed in a list of length <" <> var["n"] <> "."

Riffle::usage =
"\!\(\*RowBox[{\"Riffle\", \"[\", RowBox[{RowBox[{\"{\", RowBox[{SubscriptBox[StyleBox[\"e\", \"TI\"], StyleBox[\"1\", \"TR\"]], \",\", SubscriptBox[StyleBox[\"e\", \"TI\"], StyleBox[\"2\", \"TR\"]], \",\", StyleBox[\"\[Ellipsis]\", \"TR\"]}], \"}\"}], \",\", StyleBox[\"x\", \"TI\"]}], \"]\"}]\) gives \!\(\*RowBox[{\"{\", RowBox[{SubscriptBox[StyleBox[\"e\", \"TI\"], StyleBox[\"1\", \"TR\"]], \",\", StyleBox[\"x\", \"TI\"], \",\", SubscriptBox[StyleBox[\"e\", \"TI\"], StyleBox[\"2\", \"TR\"]], \",\", StyleBox[\"x\", \"TI\"], \",\", StyleBox[\"\[Ellipsis]\", \"TR\"]}], \"}\"}]\).
\!\(\*RowBox[{\"Riffle\", \"[\", RowBox[{RowBox[{\"{\", RowBox[{SubscriptBox[StyleBox[\"e\", \"TI\"], StyleBox[\"1\", \"TR\"]], \",\", SubscriptBox[StyleBox[\"e\", \"TI\"], StyleBox[\"2\", \"TR\"]], \",\", StyleBox[\"\[Ellipsis]\", \"TR\"]}], \"}\"}], \",\", RowBox[{\"{\", RowBox[{SubscriptBox[StyleBox[\"x\", \"TI\"], StyleBox[\"1\", \"TR\"]], \",\", SubscriptBox[StyleBox[\"x\", \"TI\"], StyleBox[\"2\", \"TR\"]], \",\", StyleBox[\"\[Ellipsis]\", \"TR\"]}], \"}\"}]}], \"]\"}]\) gives \!\(\*RowBox[{\"{\", RowBox[{SubscriptBox[StyleBox[\"e\", \"TI\"], StyleBox[\"1\", \"TR\"]], \",\", SubscriptBox[StyleBox[\"x\", \"TI\"], StyleBox[\"1\", \"TR\"]], \",\", SubscriptBox[StyleBox[\"e\", \"TI\"], StyleBox[\"2\", \"TR\"]], \",\", SubscriptBox[StyleBox[\"x\", \"TI\"], StyleBox[\"2\", \"TR\"]], \",\", StyleBox[\"\[Ellipsis]\", \"TR\"]}], \"}\"}]\).
\!\(\*RowBox[{\"Riffle\", \"[\", RowBox[{StyleBox[\"list\", \"TI\"], \",\", StyleBox[\"x\", \"TI\"], \",\", StyleBox[\"n\", \"TI\"]}], \"]\"}]\) yields a list in which every \!\(" <> var["n"] <> "\)\!\(\*SuperscriptBox[\"\[Null]\", \"th\"]\) element is \!\(\*StyleBox[\"x\", \"TI\"]\).
\!\(\*RowBox[{\"Riffle\", \"[\", RowBox[{StyleBox[\"list\", \"TI\"], \",\", StyleBox[\"x\", \"TI\"], \",\", RowBox[{\"{\", RowBox[{SubscriptBox[StyleBox[\"i\", \"TI\"], StyleBox[\"min\", \"TI\"]], \",\", SubscriptBox[StyleBox[\"i\", \"TI\"], StyleBox[\"max\", \"TI\"]], \",\", StyleBox[\"n\", \"TI\"]}], \"}\"}]}], \"]\"}]\) yields a list in which \!\(\*StyleBox[\"x\", \"TI\"]\) appears if possible at positions \!\(\*SubscriptBox[StyleBox[\"i\", \"TI\"], StyleBox[\"min\", \"TI\"]]\), \!\(\*RowBox[{Cell[BoxData[SubscriptBox[StyleBox[\"i\", \"TI\"], StyleBox[\"min\", \"TI\"]]], \"InlineFormula\"], \"+\", StyleBox[\"n\", \"TI\"]}]\), \!\(\*RowBox[{SubscriptBox[StyleBox[\"i\", \"TI\"], StyleBox[\"min\", \"TI\"]], \"+\", RowBox[{\"2\", StyleBox[\"n\", \"TI\"]}]}]\), \[Ellipsis] , \!\(\*SubscriptBox[StyleBox[\"i\", \"TI\"], StyleBox[\"max\", \"TI\"]]\).
Riffle[{{" <> sub["a", {1, 2, "..."}] <> "}, {" <> sub["b", {1, 2, "..."}] <> "}, \[Ellipsis], {" <> sub["z", {1, 2, "..."}] <> "}}] gives {" <> sub[{"a", 1}, {"b", 1}, {"", "..."}, {"z", 1}, {"a", 2}, {"b", 2}, {"", "..."}, {"z", 2}, {"", "..."}] <> "}."

RotateClockwise::usage =
"RotateClockwise[" <> var["array", "n"] <> "] rotates " <> var["array"] <> " clockwise " <> var["n"] <> " times.
RotateClockwise[" <> var["array"] <> "] rotates clockwise once."

RotateCounterClockwise::usage =
"RotateCounterClockwise[" <> var["array", "n"] <> "] rotates " <> var["array"] <> " counter\[Hyphen]clockwise " <> var["n"] <> " times.
RotateCounterClockwise[" <> var["array"] <> "] rotates counter\[Hyphen]clockwise once."

RotateLeftTo::usage =
"RotateLeftTo[" <> var["list", "pattern"] <> "] rotates " <> var["list"] <> " left until an element matching " <> var["pattern"] <> " is in the first position. If no such element exists, " <> var["list"] <> " is returned.
RotateLeftTo[" <> var["list"] <> "] rotates " <> var["list"] <> " left until a nonzero element is in the first position."

RotateRightTo::usage =
"RotateRightTo[" <> var["list", "pattern"] <> "] rotates " <> var["list"] <> " right until an element matching " <> var["pattern"] <> " is in the last position. If no such element exists, " <> var["list"] <> " is returned.
RotateRightTo[" <> var["list"] <> "] rotates " <> var["list"] <> " right until a nonzero element is in the last position."

Shear::usage =
"Shear[" <> var["array", "n"] <> "] rotates each row of " <> var["array"] <> " by " <> var["n"] <> " with respect to the previous row.
Shear[" <> var["array", "x", "r"] <> "] shears " <> var["array"] <> " at the angle ArcTan[" <> var["x"] <> "] and additionally rotates each row by " <> var["r"] <> ".
Shear[" <> var["array"] <> ", {" <> sub["x", {1, 2, "..."}] <> "}] rotates each subarray on level 1 of " <> var["array"] <> " by the vector {" <> sub["x", {1, 2, "..."}] <> "} with respect to the previous subarray.
The option Axis \[Rule] " <> var["align"] <> " specifies a subarray that is to remain unrotated; possible values are Top, Center, Bottom, or the position of the subarray."

Sift::usage =
"Sift[" <> var["randomobject", "test"] <> "] repeatedly generates a random object until one is found that satisfies the condition " <> var["test"] <> ".
Sift[" <> var["randomobject", "test", "n"] <> "] generates a list of " <> var["n"] <> " objects satisfying " <> var["test"] <> "."
Distinct::usage =
"Distinct is an option for Sift that determines whether to check for duplicates."

SuccessiveMaxima::usage =
"SuccessiveMaxima[" <> var["list"] <> "] gives the list {{" <> sub[{"x", 1}, {"e", 1}] <> "}, {" <> sub[{"x", 2}, {"e", 2}] <> "}, \[Ellipsis]}, where " <> sub["e", {1, 2, "..."}] <> " are the successive maxima of " <> var["list"] <> " and " <> sub["x", {1, 2, "..."}] <> " are the positions at which they occur.
SuccessiveMaxima[" <> var["list", "f"] <> "] finds the successive maxima under the fitness function " <> var["f"] <> ".
SuccessiveMaxima[" <> var["list", "f", "p"] <> "] finds the successive maxima under the fitness function " <> var["f"] <> " relative to the ordering function " <> var["p"] <> "."

SuccessiveMinima::usage =
"SuccessiveMinima[" <> var["list"] <> "] gives the list {{" <> sub[{"x", 1}, {"e", 1}] <> "}, {" <> sub[{"x", 2}, {"e", 2}] <> "}, \[Ellipsis]}, where " <> sub["e", {1, 2, "..."}] <> " are the successive minima of " <> var["list"] <> " and " <> sub["x", {1, 2, "..."}] <> " are the positions at which they occur.
SuccessiveMinima[" <> var["list", "f"] <> "] finds the successive minima under the fitness function " <> var["f"] <> ".
SuccessiveMinima[" <> var["list", "f", "p"] <> "] finds the successive minima under the fitness function " <> var["f"] <> " relative to the ordering function " <> var["p"] <> "."

Swap::usage =
"Swap[" <> var["list"] <> ", {" <> var["m", "n"] <> "}] exchanges the elements at positions " <> var["m"] <> " and " <> var["n"] <> " of " <> var["list"] <> ".
Swap[" <> var["list"] <> ", {" <> sub["n", {1, 2, "...", "k"}] <> "}] simultaneously moves the element in position " <> sub["n", 1] <> " to " <> sub["n", 2] <> ", the element in position " <> sub["n", 2] <> " to " <> sub["n", 3] <> ", \[Ellipsis], and the element in position " <> sub["n", "k"] <> " to " <> sub["n", 1] <> ".
Swap[" <> var["list"] <> ", " <> sub["cycle", {1, 2, "..."}] <> "] applies the permutations " <> sub["cycle", "i"] <> " in succession."

TakeAfter::usage =
"TakeAfter[" <> var["list", "pattern"] <> "] gives the elements of " <> var["list"] <> " appearing after the first element matching " <> var["pattern"] <> ".
TakeAfter[" <> var["list", "pattern", "n"] <> "] gives the elements of " <> var["list"] <> " appearing after the " <> var["n"] <> "th element matching " <> var["pattern"] <> ". Negative " <> var["n"] <> " counts from the end of the list."

TakeBefore::usage =
"TakeBefore[" <> var["list", "pattern"] <> "] gives the elements of " <> var["list"] <> " appearing before the first element matching " <> var["pattern"] <> ".
TakeBefore[" <> var["list", "pattern", "n"] <> "] gives the elements of " <> var["list"] <> " appearing before the " <> var["n"] <> "th element matching " <> var["pattern"] <> ". Negative " <> var["n"] <> " counts from the end of the list."

Tile::usage =
"Tile[" <> var["list", "len"] <> "] tiles " <> var["list"] <> " to form a periodic list of length " <> var["len"] <> ".
Tile[" <> var["array", "dims"] <> "] tiles " <> var["array"] <> " to form an array with dimensions " <> var["dims"] <> "."

Trim::usage =
"Trim[" <> var["array"] <> "] trims the rows of " <> var["array"] <> " so that they have the same length.
Trim[" <> var["array"] <> ", {" <> var["level"] <> "}] trims the expressions on level " <> var["level"] <> "."

Unpad::usage =
"Unpad[" <> var["list"] <> "] removes all zeros from the beginning and end of " <> var["list"] <> ".
Unpad[" <> var["list", "pattern"] <> "] removes all elements matching " <> var["pattern"] <> " from the beginning and end of " <> var["list"] <> ".
Unpad[" <> var["array", "pattern"] <> "] gives the smallest full array obtainable by removing elements matching " <> var["pattern"] <> " from the beginning and end of each level of " <> var["array"] <> ".
Unpad[" <> var["array", "pattern", "n"] <> "] unpads at level " <> var["n"] <> "."

UnpadLeft::usage =
"UnpadLeft[" <> var["list"] <> "] removes all zeros from the beginning of " <> var["list"] <> ".
UnpadLeft[" <> var["list", "pattern"] <> "] removes all elements matching " <> var["pattern"] <> " from the beginning of " <> var["list"] <> ".
UnpadLeft[" <> var["array", "pattern"] <> "] gives the smallest full array obtainable by removing elements matching " <> var["pattern"] <> " from the beginning of each level of " <> var["array"] <> ".
UnpadLeft[" <> var["array", "pattern", "n"] <> "] unpads at level " <> var["n"] <> "."

UnpadRight::usage =
"UnpadRight[" <> var["list"] <> "] removes all zeros from the end of " <> var["list"] <> ".
UnpadRight[" <> var["list", "pattern"] <> "] removes all elements matching " <> var["pattern"] <> " from the end of " <> var["list"] <> ".
UnpadRight[" <> var["array", "pattern"] <> "] gives the smallest full array obtainable by removing elements matching " <> var["pattern"] <> " from the end of each level of " <> var["array"] <> ".
UnpadRight[" <> var["array", "pattern", "n"] <> "] unpads at level " <> var["n"] <> "."

Unriffle::usage =
"Unriffle[" <> var["list", "n"] <> "] gives a list of " <> var["n"] <> " lists whose Riffle gives " <> var["list"] <> ".
Unriffle[" <> var["list"] <> "] unriffles " <> var["list"] <> " into two components."

WrappedArrayPlot::usage =
"WrappedArrayPlot[" <> var["array", "n"] <> "] generates a plot of the values in an array after wrapping into at most " <> var["n"] <> " super\[Hyphen]columns.
WrappedArrayPlot[" <> var["array", "n", "spacing"] <> "] leaves " <> var["spacing"] <> " white cells between successive super\[Hyphen]columns."


SetAttributes[NonZero, Listable]
NonZero[x_?NumberQ] := !PossibleZeroQ[x]

RealNumberQ[x_] := NumericQ[x] && Element[x, Reals]

StrictCeiling[x_] := If[IntegerQ[x], x + 1, Ceiling[x]]
StrictFloor[x_] := If[IntegerQ[x], x - 1, Floor[x]]


Unprotect[Accumulate]
Accumulate[list : _[], _] := list
Accumulate[list : _[__], Plus] := Accumulate[list]
Accumulate[list : _[__], List] :=
	Head[list] @@ FoldList[{Sequence @@ #1, #2} &, {First[list]}, Rest[list]]
Accumulate[list : _[__], f_ /; MemberQ[Attributes[f], Flat]] :=
	Head[list] @@ FoldList[f, f[First[list]], Rest[list]]
Accumulate[list : _[__], f_] := f @@@ Accumulate[list, List]
SyntaxInformation[Accumulate] = {"ArgumentsPattern" -> {_, _., OptionsPattern[]}}
Protect[Accumulate]

AgreementLength[lists__?(Depth[#] >= 2 &)] :=
LengthWhile[
	Transpose[PadRight[
		List @@@ {lists},
		{Length[{lists}], Max[Length /@ {lists}]},
		Unique[]
	]],
	SameQ @@ # &
]
SyntaxInformation[AgreementLength] = {"ArgumentsPattern" -> {__}}

ArrayMap[f_, array_List, {level_Integer?Positive}, direction : (_Integer?Positive) : 1] /;
	direction <= level <= ArrayDepth[array] :=
Module[{perm, result},
	perm = RotateRight[Range[level, 1, -1], direction - 1];
	result = Map[f, Transpose[array, perm], {level - 1}];
	Transpose[result, perm] /;
		level <= ArrayDepth[result] || Message[ArrayMap::tperm, result, perm]
]
SyntaxInformation[ArrayMap] = {"ArgumentsPattern" -> {_, _, {_}, _.}}
ArrayMap::tperm = "The array `1` cannot be transposed by `2`."

Best[list : _[___]] := Cases[list, Max[list]]
Best[list : _[___], f_] :=
With[{data = {#, f[#]} & /@ list},
	Cases[data, {a_, Max[Last /@ data]} :> a]
]
SyntaxInformation[Best] = {"ArgumentsPattern" -> {_, _.}}

CanonicalRotation[list : _[___]] :=
First[Sort[
	RotateLeft[list, #[[1]] - 1] & /@
		Position[list, First[Sort[list]], {1}, Heads -> False]
]]
CanonicalRotation[list : _[___], p_] :=
	First[Sort[NestList[RotateLeft, list, Max[0, Length[list] - 1]], p]]
SyntaxInformation[CanonicalRotation] = {"ArgumentsPattern" -> {_, _.}}

SetAttributes[Case, HoldRest]
Case[list : _[___], pattern_, alt_ : Null, n : (_Integer?Positive) : 1] :=
If[Length[#] >= n,
	Last[#],
	alt
] & @ Cases[list, pattern, {1}, n]
Case[list : _[___], pattern_, alt_, n_Integer?Negative] :=
If[Length[#] >= -n,
	Last[#],
	alt
] & @ Cases[Reverse[list], pattern, {1}, -n]
SyntaxInformation[Case] = {"ArgumentsPattern" -> {_, _, _., _.}}

Classify[l : head_[___], f_ : Identity, g_ : Identity, h_ : Identity] :=
Module[{list = {f[#], #} & /@ List @@ l, vals = {}, classes = {}},
	Function[{image, element},
		Occurrence[
			vals,
			image -> (AppendTo[classes[[#]], g[element]] &),
			AppendTo[vals, image]; AppendTo[classes, {g[element]}]
		]
	] @@@ list;
	Transpose[{h /@ head @@@ classes, vals}]
]
SyntaxInformation[Classify] = {"ArgumentsPattern" -> {_, _., _., _.}}

ColumnWrap[
	array : {__List},
	n : (_Integer?Positive) : 2,
	spacing : (_?NonNegative) : 3,
	opts : OptionsPattern[]
] :=
With[{width = Max[Length /@ array]},
	Grid[
		Flatten[#, 1] & /@ Unriffle[
			PadRight[array, {Length[array], width}, Null],
			Ceiling[Length[array] / n]
		],
		opts,
		ItemSize -> Full,
		Spacings -> {
			{Automatic, Append[ConstantArray[Automatic, Max[0, width - 1]], spacing], Automatic},
			Automatic
		}
	]
]
ColumnWrap[
	list : {__},
	n : (_Integer?Positive) : 2,
	spacing : (_?NonNegative) : 3,
	opts : OptionsPattern[]
] := ColumnWrap[List /@ list, n, spacing, opts]
Options[ColumnWrap] = Options[Grid] /. {(ItemSize -> _) -> (ItemSize -> Full), (Spacings -> _) -> Sequence[]}
SyntaxInformation[ColumnWrap] = {"ArgumentsPattern" -> {_, _., _., OptionsPattern[]}}

Complements[lists : (h_[___] ...)] :=
Table[
	Complement[{lists}[[i]], Sequence @@ Drop[{lists}, {i}]],
	{i, Length[{lists}]}
]
SyntaxInformation[Complements] = {"ArgumentsPattern" -> {___}}

Unprotect[First, Last]
SetAttributes[First, HoldRest]
First[_[e_, ___], _] := e
First[_[], default_] := default
First[atom_, _] /; Message[First::normal, 1, atom] := Null
SyntaxInformation[First] = {"ArgumentsPattern" -> {_, _.}}
SetAttributes[Last, HoldRest]
Last[_[___, e_], _] := e
Last[_[], default_] := default
Last[atom_, _] /; Message[Last::normal, 1, atom] := Null
SyntaxInformation[Last] = {"ArgumentsPattern" -> {_, _.}}
Protect[First, Last]

FixedPointPeriod[f_, expr_, n_ : Infinity] :=
Module[{list = {expr}, val = expr, i = 0},
	While[!MemberQ[list, val = f[val], {1}] && i <= n,
		AppendTo[list, val];
		i++
	];
	If[i <= n, Take[list, {Occurrence[list, val], -1}], {}]
]
SyntaxInformation[FixedPointPeriod] = {"ArgumentsPattern" -> {_, _, _.}}

FixedPointSet[f_, l_List] :=
Module[{list = {}, newelements = l, mappednewelements, failed},
	failed = Catch[
		While[newelements != {},
			list = Join[list, newelements];
			mappednewelements = f /@ newelements;
			If[!MatchQ[mappednewelements, {___List}], Throw[True]];
			newelements = Select[DeleteDuplicates[Join @@ mappednewelements], !MemberQ[list, #] &]
		];
		False
	];
	list /; !failed
]
FixedPointSet[f_, l_List, g_] :=
Module[{list = {}, indicators = {}, newelements = l, mappednewelements, failed},
	failed = Catch[
		While[newelements != {},
			list = Join[list, newelements];
			indicators = Union[indicators, g /@ newelements];
			mappednewelements = f /@ newelements;
			If[!MatchQ[mappednewelements, {___List}], Throw[True]];
			newelements = Select[DeleteDuplicates[Join @@ mappednewelements, SameQ @@ g /@ {##} &], !MemberQ[indicators, g[#]] &]
		];
		False
	];
	list /; !failed
]
SyntaxInformation[FixedPointSet] = {"ArgumentsPattern" -> {_, _, _.}}

GroupActionMod[list_, function : Except[_List]] := GroupActionMod[list, {function}]
GroupActionMod[list_, functions_List] := DeleteDuplicates[
	First[Sort[FixedPointSet[
		Through[Prepend[functions, Identity][#]] &,
		{#}
	]]] & /@ list
]
SyntaxInformation[GroupActionMod] = {"ArgumentsPattern" -> {_, _}}

MapAcross[functions_List, arguments_List] /; Length[functions] == Length[arguments] :=
	MapThread[#1[#2] &, {functions, arguments}]
SyntaxInformation[MapAcross] = {"ArgumentsPattern" -> {_, _}}

MapList[f_, list : _[___]] := Table[MapAt[f, list, i], {i, Length[list]}]
SyntaxInformation[MapList] = {"ArgumentsPattern" -> {_, _}}

Multisets[h_[], 0 | {0} | {0, 0}] := {h[]}
Multisets[set : _[__], n_Integer?NonNegative] := Multisets[set, {0, n}]
Multisets[set : _[__], {n_Integer?NonNegative}] := Multisets[set, {n, n}]
Multisets[set : h_[__], {n1_Integer, n2_Integer} /; 0 <= n1 <= n2] :=
Module[{list = Prepend[Table[0, {Length[set] - 1}], n1]},
	(h @@ Join @@ Table @@@ Transpose[{List @@ set, List /@ #}] &) /@ Reap[
		Sow[list];
		Do[
			If[Most[list] == Table[0, {Length[list] - 1}],
				{list[[-1]], list[[1]]} = {0, list[[-1]] + 1},
				((list[[#]]--; list[[# + 1]]++;
					If[# + 2 <= Length[list], {list[[-1]], list[[# + 1]]} = {0, list[[-1]] + 1}])
				&) @ Occurrence[list, Except[0], Null, Evaluate[If[list[[-1]] == 0, -1, -2]]]
			]; Sow[list],
			{Subtract @@ Binomial[{n2, n1 - 1} + Length[list], Length[list]] - 1}
		]
	][[2, 1]]
]
SyntaxInformation[Multisets] = {"ArgumentsPattern" -> {_, _}}

NextTuple[tuple : _[___], set : _[___] /; UnsameQ @@ set] /;
	Complement[tuple, set] == Head[tuple][] :=
Module[{t = tuple, i},
	For[i = Length[t], i > 0, i--, 
		Occurrence[
			Most[set],
			t[[i]] -> ((t[[i]] = set[[# + 1]]; Break[]) &),
			t[[i]] = set[[1]]
		]
	];
	t
]
SyntaxInformation[NextTuple] = {"ArgumentsPattern" -> {_, _}}

SetAttributes[Occurrence, HoldRest]
Occurrence[list : _[___], Rule[p_, f_], alt_ : Null, n : (_Integer?Positive) : 1] :=
If[Length[#] >= n,
	f[#[[-1,1]]],
	alt
] & @ Position[list, p, {1}, n, Heads -> False]
Occurrence[list : _[___], Rule[p_, f_], alt_, n_Integer?Negative] :=
If[Length[#] >= -n,
	f[Length[list] + 1 - #[[-1,1]]],
	alt
] & @ Position[Reverse[list], p, {1}, -n, Heads -> False]
Occurrence[list : _[___], p_, alt_ : Null, n : (_Integer?NonZero) : 1] :=
	Occurrence[list, Rule[p, Identity], alt, n]
SyntaxInformation[Occurrence] = {"ArgumentsPattern" -> {_, _, _., _.}}

PartitionAfter[list : _[___], p_, n : (_Integer?NonNegative | Infinity) : Infinity] :=
PartitionAt[
	list,
	DeleteCases[Flatten[Position[list, p, {1}, n, Heads -> False]], Length[list]]
]
PartitionBefore[list : _[___], p_, n : (_Integer?NonNegative | Infinity) : Infinity] :=
PartitionAt[
	list,
	DeleteCases[Flatten[Position[list, p, {1}, n, Heads -> False]] - 1, 0]
]
SyntaxInformation[PartitionAfter] = {"ArgumentsPattern" -> {_, _, _.}}
SyntaxInformation[PartitionBefore] = {"ArgumentsPattern" -> {_, _, _.}}

PartitionAt[list : _[___], {}] := Head[list] @ list
PartitionAt[list : _[___], positions : {__Integer}] /; Max[Abs[positions]] <= Length[list] :=
Take[list, # + {1, 0}] & /@
	Partition[
		Sort[Join[
			{0, Length[list]},
			positions /. n_Integer?Negative :> Length[list] + n
		]],
		2,
		1
	]
PartitionAt[list_, n_Integer] := PartitionAt[list, {n}]
SyntaxInformation[PartitionAt] = {"ArgumentsPattern" -> {_, _}}

Period[list : _[___]] := Take[list, PeriodLength[list]]
SyntaxInformation[Period] = {"ArgumentsPattern" -> {_}}

PeriodLength[_[]] = 0
PeriodLength[list : _[___]] :=
Module[{length = Length[list], possibles = Rest[First /@ Position[list, First[list], {1}]] - 1, pl, i = 0},
	While[i <= Min[length, 10] && Length[possibles] > 1000,
		possibles = Select[possibles, # + i > length || SameQ @@ Take[list, {# + 1 + i, -1, #}] &];
		i++
	];
	pl = First[Select[possibles, list === Tile[Take[list, #], length] &, 1], length];
	If[length < 2 pl, Message[PeriodLength::twoperiods, list]];
	pl
]
SyntaxInformation[PeriodLength] = {"ArgumentsPattern" -> {_}}
PeriodLength::twoperiods = "The list `1` does not contain two full periods."

Portion[list : _[___], frac_ : 1/2, i_ : 1] /; 1 <= i <= 1/frac :=
Take[
	list, 
	{
		Ceiling[(i - 1) frac Length[list]] + 1,
		StrictFloor[i frac Length[list]] + 1
	}
]
SyntaxInformation[Portion] = {"ArgumentsPattern" -> {_, _., _.}}

RaggedPartition[list : _[___], n_Integer?Positive] := Partition[list, n, n, 1, {}]
SyntaxInformation[RaggedPartition] = {"ArgumentsPattern" -> {_, _}}

Unprotect[Riffle]
Riffle[{listsequence__List}] :=
Module[{p},
	TakeBefore[
		Flatten[Transpose[
			PadRight[
				{listsequence},
				{Length[{listsequence}], Min[Length /@ {listsequence}] + 1},
				p
			]
		], 1],
	p]
]
SyntaxInformation[Riffle] = {"ArgumentsPattern" -> {_, _., _.}}
Protect[Riffle]

RotateClockwise[array_ /; ArrayDepth[array] >= 2, n_Integer : 1] :=
	Nest[Transpose[Reverse[#]] &, array, Mod[n, 4]]
RotateCounterClockwise[array_ /; ArrayDepth[array] >= 2, n_Integer : 1] :=
	Nest[Reverse[Transpose[#]] &, array, Mod[n, 4]]
SyntaxInformation[RotateClockwise] = {"ArgumentsPattern" -> {_, _.}}
SyntaxInformation[RotateCounterClockwise] = {"ArgumentsPattern" -> {_, _.}}

RotateLeftTo[list_] := RotateLeftTo[list, Except[0]]
RotateLeftTo[list : _[___], p_] :=
	RotateLeft[list, Occurrence[list, p, 1] - 1]
RotateRightTo[list_] := RotateRightTo[list, Except[0]]
RotateRightTo[list : _[___], p_] :=
	RotateLeft[list, Occurrence[list, p, 1, -1]]
SyntaxInformation[RotateLeftTo] = {"ArgumentsPattern" -> {_, _.}}
SyntaxInformation[RotateRightTo] = {"ArgumentsPattern" -> {_, _.}}

Shear[
	array_,
	v : {___?RealNumberQ},
	r : (_?RealNumberQ | {___?RealNumberQ}) : 0,
	OptionsPattern[]
] /; ArrayDepth[array] >= Max[2, Length[v] + 1] && (NumberQ[r] || Length[v] == Length[r]) :=
With[
	{d = Replace[OptionValue[Axis], {
		Top -> 1,
		Center -> Floor[(Length[array] + 1) / 2],
		Bottom -> Length[array],
		a_Integer?(1 <= # <= Length[array] &) :> a,
		a_Integer?(1 <= -# <= Length[array] &) :> Length[array] + a + 1,
		a_ :> (Message[Shear::axis, a]; 1)
	}]},
	MapIndexed[RotateRight[#1, Floor[(First[#2] - d) v] + r] &, array]
]
Shear[
	array_ /; ArrayDepth[array] >= 2,
	x : (_?RealNumberQ) : 1,
	r : (_?RealNumberQ) : 0,
	opts : OptionsPattern[]
] := Shear[array, {x}, r, opts]
Options[Shear] = {Axis -> Top}
SyntaxInformation[Shear] = {"ArgumentsPattern" -> {_, _., _., OptionsPattern[]}}
Shear::axis = "Invalid row specification `1` received. Using top subarray as axis."

SetAttributes[Sift, HoldFirst]
Sift[object_, test_, OptionsPattern[]] :=
Module[{temp},
	While[!test[temp = object]];
	temp
]
Sift[object_, test_, n : (_Integer?NonNegative) : 1, OptionsPattern[]] :=
Module[{results = {}, temp},
	While[Length[results] < n,
		temp = object;
		If[test[temp] && (!OptionValue[Distinct] || UnsameQ @@ Append[results, temp]),
			AppendTo[results, temp]
		]
	];
	results
]
Options[Sift] = {Distinct -> False}
SyntaxInformation[Sift] = {"ArgumentsPattern" -> {_, _, _., OptionsPattern[]}}

SuccessiveMaxima[list : _[___?NumericQ]] :=
Module[{best = First[list]},
	Transpose[{#, list[[#]]}] & @
		Prepend[First /@
			Position[list, y_ /; If[y > best, best = y; True, False], {1}, Heads -> False],
			1
		]
]
SuccessiveMaxima[list : _[___], f_, p_ : Greater] :=
Module[{best = f[First[list]]},
	Transpose[{#, list[[#]]}] & @
		Prepend[First /@
			Position[list, y_ /; If[p[f[y], best], best = f[y]; True, False], {1}, Heads -> False],
			1
		]
]
SyntaxInformation[SuccessiveMaxima] = {"ArgumentsPattern" -> {_, _., _.}}

SuccessiveMinima[list : _[___?NumericQ]] :=
Module[{best = First[list]},
	Transpose[{#, list[[#]]}] & @
		Prepend[First /@
			Position[list, y_ /; If[y < best, best = y; True, False], {1}, Heads -> False],
			1
		]
]
SuccessiveMinima[list : _[___], f_, p_ : Less] :=
Module[{best = f[First[list]]},
	Transpose[{#, list[[#]]}] & @
		Prepend[First /@
			Position[list, y_ /; If[p[f[y], best], best = f[y]; True, False], {1}, Heads -> False],
			1
		]
]
SyntaxInformation[SuccessiveMinima] = {"ArgumentsPattern" -> {_, _., _.}}

Swap[expr_] := expr
Swap[expr_, cycles__List] /; MatchQ[Flatten[{cycles}], {___Integer}] :=
Module[{copy = expr, cycle = First[{cycles}], valid = True},
	Quiet[
		Check[
			(copy[[Sequence @@ #1]] = expr[[Sequence @@ #2]]) & @@@
				Transpose[{RotateLeft[cycle], cycle}],
			valid = False,
			{Part::partw, Set::partw}
		],
		{Part::partw, Set::partw}
	];
	(Swap[copy, ##2] &)[cycles] /; (valid || Message[Swap::partw, expr])
]
SyntaxInformation[Swap] = {"ArgumentsPattern" -> {__}}
Swap::partw = "Specified part of `1` does not exist."

TakeAfter[list : _[___], pattern_, n : (_Integer?NonZero) : 1] :=
	Drop[list, Occurrence[list, pattern, All, n]]
TakeBefore[list : _[___], pattern_, n : (_Integer?NonZero) : 1] :=
	Take[list, Occurrence[list, pattern -> (# - 1 &), All, n]]
DropAfter[list : _[___], pattern_, n : (_Integer?NonZero) : 1] :=
	Take[list, Occurrence[list, pattern, All, n]]
DropBefore[list : _[___], pattern_, n : (_Integer?NonZero) : 1] :=
	Drop[list, Occurrence[list, pattern -> (# - 1 &), All, n]]
SyntaxInformation[TakeAfter] = {"ArgumentsPattern" -> {_, _, _.}}
SyntaxInformation[TakeBefore] = {"ArgumentsPattern" -> {_, _, _.}}
SyntaxInformation[DropAfter] = {"ArgumentsPattern" -> {_, _, _.}}
SyntaxInformation[DropBefore] = {"ArgumentsPattern" -> {_, _, _.}}

Tile[list : {__}, length_Integer?NonNegative] :=
Join @@ Append[
	ConstantArray[list, Floor[length/Length[list]]],
	Take[list, Mod[length, Length[list]]]
]
Tile[array_List, dim_List] /; ArrayDepth[array] >= Length[dim] :=
Take[
	ArrayFlatten[
		Table @@ Prepend[
			List /@ Ceiling[dim/Dimensions[array, Length[dim]]],
			array
		],
		Length[dim]
	],
	Sequence @@ dim
]
SyntaxInformation[Tile] = {"ArgumentsPattern" -> {_, _}}

Trim[array_, level : {_Integer?NonNegative} : {1}] /;
	Min[Depth /@ Level[array, level]] >= 2 :=
With[{length = Min[Length /@ Level[array, level]]},
	Map[Take[#, length] &, array, level]
]
SyntaxInformation[Trim] = {"ArgumentsPattern" -> {_, _.}}

(* The symbol Except doesn't accept named pattern variables, so use !MatchQ[ ] instead. *)
UnpadLeft[array_, p_ : 0] := UnpadLeft[array, p, ArrayDepth[array]]
UnpadLeft[list_, p_, 1] /; ArrayDepth[list] >= 1 :=
	Drop[list, Occurrence[list, _?(!MatchQ[#, p] &), All + 1] - 1]
UnpadLeft[array_, p_ : 0, n_Integer?Positive] /; ArrayDepth[array] >= n :=
Module[{pattern}, 
	pattern = Nest[{# ...} &, p, n - 1];
	Fold[
(*		Transpose[Drop[#1, Occurrence[#1, _?(!MatchQ[#, pattern] &), All + 1] - 1], #2] &,*)
		Occurrence[
			#1,
			_?(!MatchQ[#, pattern] &) -> Function[el, Transpose[Drop[#1, el - 1], #2]],
			{}
		] &,
		array,
		Append[
			Table[Normal[SparseArray[{i -> n, n -> i, a_ :> a}]], {i, n - 1, 1, -1}],
			RotateLeft[Range[n]]
		]
	]
]
UnpadRight[array_, p_ : 0] := UnpadRight[array, p, ArrayDepth[array]]
UnpadRight[list_, p_, 1] /; ArrayDepth[list] >= 1 :=
	Take[list, Occurrence[list, _?(!MatchQ[#, p] &), 0, -1]]
UnpadRight[array_, p_ : 0, n_Integer?Positive] /; ArrayDepth[array] >= n :=
Module[{pattern}, 
	pattern = Nest[{# ...} &, p, n - 1];
	Fold[
(*		Transpose[Take[#1, Occurrence[#1, Except[pattern], 0, -1]], #2] &,*)
		Occurrence[
			#1,
			_?(!MatchQ[#, pattern] &) -> Function[el, Transpose[Take[#1, el], #2]],
			{},
			-1
		] &,
		array,
		Append[
			Table[Normal[SparseArray[{i -> n, n -> i, a_ :> a}]], {i, n - 1, 1, -1}],
			RotateLeft[Range[n]]
		]
	]
]
Unpad[array_, p_ : 0] := Unpad[array, p, ArrayDepth[array]]
Unpad[array_, p_, n_Integer?Positive] /; ArrayDepth[array] >= n := UnpadRight[UnpadLeft[array, p, n], p, n]
SyntaxInformation[UnpadLeft] = {"ArgumentsPattern" -> {_, _., _.}}
SyntaxInformation[UnpadRight] = {"ArgumentsPattern" -> {_, _., _.}}
SyntaxInformation[Unpad] = {"ArgumentsPattern" -> {_, _., _.}}

Unriffle[{}, m : (_Integer?Positive) : 2] := ConstantArray[{}, m]
Unriffle[list_List, m : (_Integer?Positive) : 2] :=
Module[{p},
	Transpose[Partition[list, m, m, {1, 1}, p]] /. p -> Sequence[]
]
SyntaxInformation[Unriffle] = {"ArgumentsPattern" -> {_, _.}}

WrappedArrayPlot[
	array : {__List},
	n : (_Integer?Positive) : 2,
	spacing : (_?NonNegative) : 10,
	opts : OptionsPattern[]
] :=
Module[{partition},
	partition = (PadRight[#, {Length[#], Max[Length /@ #]}] &) /@ Partition[
		array,
		Ceiling[Length[array]/n],
		Ceiling[Length[array]/n],
		1,
		{{}}
	];
	ArrayPlot[
		ArrayFlatten[{Riffle[
			partition,
			{ConstantArray[0, {Length[First[partition]], spacing}]}
		]}],
		opts
	]
]
Options[WrappedArrayPlot] = Options[ArrayPlot]
SyntaxInformation[WrappedArrayPlot] = {"ArgumentsPattern" -> {_, _., _., OptionsPattern[]}}


End[]

Protect["ListTricks`*"]

EndPackage[]