(* :Title: String Tricks *)

(* :Context: StringTricks` *)

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

(* :Date: {2009, 9, 29} *)

(* :Package Version: 1.20 *)

(* :Mathematica Version: 6.0 *)

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


BeginPackage["StringTricks`"]

{
	InExpression,
	MatchPairs,
	StringPartition,
	StringPower,
	StringPowerQ,
	StringReplaceRepeated,
	StringRiffle,
	StringRotateLeft,
	StringRotateRight,
	StringTally,
	StringTuples
}


Unprotect["StringTricks`*"]

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}, ", "]]


InExpression::usage =
"InExpression[" <> var["n"] <> "] gives the expression submitted as the " <> var["n"] <> "th input line, wrapped in HoldComplete."

MatchPairs::usage =
"MatchPairs[" <> var["string"] <> ", {" <> var["openpattern", "closepattern"] <> "}] gives the positions of each matching pair of matchfix operators in " <> var["string"] <> ".
MatchPairs[" <> var["string", "delimeter"] <> "] uses " <> var["delimeter"] <> " for the opening and closing patterns."

StringPartition::usage =
"StringPartition[" <> var["string", "n"] <> "] partitions " <> var["string"] <> " into non\[Hyphen]overlapping substrings of length " <> var["n"] <> ".
StringPartition[" <> var["string", "n", "d"] <> "] generates substrings with offset " <> var["d"] <> "."

StringPower::usage =
"StringPower[" <> var["string", "n"] <> "] generates a string of " <> var["n"] <> " copies of " <> var["string"] <> ".
StringPower[" <> var["string"] <> ", " <> var["n"] <> "/" <> var["m"] <> "] generates a fractional power, if the length of " <> var["string"] <> " is divisible by " <> var["m"] <> "."

StringPowerQ::usage =
"StringPowerQ[" <> var["string"] <> "] yields True if " <> var["string"] <> " is a power of a smaller string, and yields False otherwise."

StringReplaceRepeated::usage =
"StringReplaceRepeated[" <> var["string", "rules"] <> "] repeatedly performs replacements on " <> var["string"] <> " until the result no longer changes.
StringReplaceRepeated[" <> var["string", "rules", "n"] <> "] stops after at most " <> var["n"] <> " steps.
StringReplaceRepeated[" <> var["string", "rules", "n", "l"] <> "] truncates at length " <> var["l"] <> " at each step."

StringRiffle::usage =
"StringRiffle[" <> var["string", "x"] <> "] inserts the string " <> var["x"] <> " between every character in " <> var["string"] <> ".
StringRiffle[" <> var["string", "x", "n"] <> "] inserts " <> var["x"] <> " every " <> var["n"] <> " characters.
StringRiffle[" <> var["string", "x"] <> ", {" <> sub["i", {"min", "max"}] <> ", " <> var["n"] <> "}] inserts " <> var["x"] <> " if possible at positions " <> sub["i", "min"] <> ", " <> sub["i", "min"] <> " + " <> var["n"] <> ", " <> sub["i", "min"] <> " + 2 " <> var["n"] <> ", \[Ellipsis], " <> sub["i", "max"] <> "."

StringRotateLeft::usage =
"StringRotateLeft[" <> var["string", "n"] <> "] cycles the characters in a string " <> var["n"] <> " positions to the left.
StringRotateLeft[" <> var["string"] <> "] cycles one position to the left."

StringRotateRight::usage =
"StringRotateRight[" <> var["string", "n"] <> "] cycles the characters in a string " <> var["n"] <> " positions to the right.
StringRotateRight[" <> var["string"] <> "] cycles one position to the right."

StringTally::usage =
"StringTally[" <> var["string"] <> "] tallies the characters in " <> var["string"] <> ", listing all distinct characters together with their multiplicities.
StringTally[" <> var["string", "n"] <> "] tallies the subwords in " <> var["string"] <> " of length " <> var["n"] <> "."

StringTuples::usage =
"StringTuples[{" <> sub["s", {1, 2, "...", "k"}] <> "}, " <> var["n"] <> "] generates a list of all possible words of length " <> var["n"] <> " on a given alphabet."


InExpression[] := InExpression[$Line - 1]
InExpression[n_Integer /; n != 0 && n <= $Line] :=
	MakeExpression @@ ToExpression[InString[n], InputForm, Hold]
SyntaxInformation[InExpression] = {"ArgumentsPattern" -> {_.}}

(* currently allows a matched pair to have nonempty overlap *)
MatchPairs[string_String, delimeter : Except[_List]] := MatchPairs[string, {delimeter, delimeter}]
MatchPairs[string_String, {openpattern_, closepattern_}] :=
Module[{openpositions, closepositions, positions = {}, stack = {}},
	openpositions = StringPosition[string, openpattern];
	closepositions = StringPosition[string, closepattern];
	Function[p,
		If[stack == {},
			If[MemberQ[openpositions, p],
				AppendTo[stack, p],
				AppendTo[positions, {Null, p}]
			],
			If[MemberQ[closepositions, p],
				AppendTo[positions, {Last[stack], p}];
				stack = Most[stack],
				
				AppendTo[stack, p]
			]
		]
	] /@ Union[openpositions, closepositions];
	Join[
		positions,
		{#, Null} & /@ stack
	]
]
SyntaxInformation[MatchPairs] = {"ArgumentsPattern" -> {_, _}}

StringPartition[string_String, n_Integer?Positive] := StringPartition[string, n, n]
StringPartition[string_String, n_Integer?Positive, d_Integer?Positive] /; n > StringLength[string] := {}
StringPartition[string_String, n_Integer?Positive, d_Integer?Positive] :=
Table[
	StringTake[string, {i, i + n - 1}],
	{i, 1, Floor[StringLength[string] - (n - d), d] - (d - 1), d}
]
SyntaxInformation[StringPartition] = {"ArgumentsPattern" -> {_, _, _.}}

StringPower[s_String, n_Integer?NonNegative] :=
	StringJoin[ConstantArray[s, n]]
StringPower[s_String, r_Rational?NonNegative] /; Divisible[StringLength[s], Denominator[r]] :=
	StringJoin[ConstantArray[s, Floor[r]], StringTake[s, StringLength[s] FractionalPart[r]]]
SyntaxInformation[StringPower] = {"ArgumentsPattern" -> {_, _}}

StringPowerQ[""] = True
StringPowerQ[string_String] :=
With[{length = StringLength[string]},
	LengthWhile[
		Most[Divisors[length]],
		string != StringPower[StringTake[string, #], length/#] &
	] != DivisorSigma[0, length] - 1
]
SyntaxInformation[StringPowerQ] = {"ArgumentsPattern" -> {_}}

StringReplaceRepeated[
	s_String,
	rules : _Rule | _RuleDelayed | {(_Rule | _RuleDelayed) ...},
	n : (_Integer?NonNegative | Infinity) : Infinity,
	maxlength : (_Integer?NonNegative | Infinity) : Infinity
] := FixedPoint[(StringTake[#, Min[StringLength[#], maxlength]] &)[StringReplace[#, rules]] &, s, n]
SyntaxInformation[StringReplaceRepeated] = {"ArgumentsPattern" -> {_, _, _., _.}}

StringRiffle[string_String, s_String, n_Integer : 2] /; n >= 2 :=
	StringInsert[string, s, Range[n, StringLength[string], n - 1]]
StringRiffle[string_String, s_String, {imin_Integer, imax_Integer, n_Integer}] :=
	StringInsert[
		string,
		s,
		Range @@ Append[If[# > 0, #, Mod[#, StringLength[string]] + 2] & /@ {imin, imax}, n - 1]
	]
SyntaxInformation[StringRiffle] = {"ArgumentsPattern" -> {_, _, _.}}

StringRotateLeft[string_String, n_Integer : 1] :=
	StringTake[string, {Mod[n + 1, StringLength[string], 1], -1}] <> StringTake[string, Mod[n, StringLength[string]]]
SyntaxInformation[StringRotateLeft] = {"ArgumentsPattern" -> {_, _.}}

StringRotateRight[string_String, n_Integer : 1] :=
	StringTake[string, {Mod[-n + 1, StringLength[string], 1], -1}] <> StringTake[string, Mod[-n, StringLength[string]]]
SyntaxInformation[StringRotateRight] = {"ArgumentsPattern" -> {_, _.}}

StringTally[string_String] :=
	Tally[Characters[string]]
StringTally[string_String, n_Integer?Positive] :=
	Tally[StringPartition[string, n, 1]]
SyntaxInformation[StringTally] = {"ArgumentsPattern" -> {_, _.}}

StringTuples[list : {___String}, n_Integer?NonNegative] := StringJoin /@ Tuples[list, n]
SyntaxInformation[StringTuples] = {"ArgumentsPattern" -> {_, _}}


End[]

Protect["StringTricks`*"]

EndPackage[]