# Combinations of multiple matching patterns

I wonder if there is any nice way to combine DownValues (or any other suitable rule-/pattern-/function -based Mathematica construct) when multiple patterns match an expression. Let me explain what I mean with a somewhat silly example:

f[x_?(Mod[#,2]==0 &&Mod[#,3]==0&)]:= "FizzBuzz"
f[x_?(Mod[#,2]==0& )]:= "Fizz"
f[x_?(Mod[#,3]==0&)]:= "Buzz"
f[x_]:=x

Range@15 //Map@f
(* {1,Fizz,Buzz,Fizz,5,FizzBuzz,7,Fizz,Buzz,Fizz,11,FizzBuzz,13,Fizz,Buzz} *)


It would be really nice if one could do away with the first DownValue of f which checks if an expression is divisible by both 2 and 3 (since this is just a combination of the PatternTests used by the two DownValues defined beneath it). In this simple case one additional DownValue might not be an issue but if one adds more and more "rules" the number of additional combinations to check increases rapidly with the number of "rules". For instance:

g[x_?(Mod[#,2]==0 &&Mod[#,3]==0 && #<10&)]:= "FizzBuzzZapp"
g[x_?(Mod[#,2]==0 &&Mod[#,3]==0&)]:= "FizzBuzz"
g[x_?(Mod[#,2]==0&& #<10& )]:= "FizzZapp"
g[x_?(Mod[#,2]==0& )]:= "Fizz"
g[x_?(Mod[#,3]==0&& #<10& )]:= "BuzzZapp"
g[x_?(Mod[#,3]==0&)]:= "Buzz"
g[x_?(#<10&)]:= "Zapp"
g[x_]:=x

Range@15 //Map@g
(* {Zapp,FizzZapp,BuzzZapp,FizzZapp,Zapp,FizzBuzzZapp,Zapp,FizzZapp,
BuzzZapp,Fizz,11,FizzBuzz,13,Fizz,Buzz} *)


Is there an elegant idiom for this?

Edit:

I actually came up with this whole question when looking at this website about fizzbuzz in too much detail and thinking that the presented FP solution was not really comprehensible anymore. As this fizzbuzz task is all about rule-replacement one might assume that a pattern-matching/rule-replacement/functional approach should give the most natural, elegant and easy to understand representation but this seems not necessarily to be true.

• For your amusement: (18761) Commented Feb 3, 2016 at 23:16
• A bit of cheating, but it avoids the disjunction explosion: In[71]:= Map[ StringJoin[ ReplaceList[#, {(x_ /; Mod[x, 2] == 0) :> "Fizz", x_ /; Mod[x, 3] == 0 :> "Buzz", x_ /; GCD[x, 6] == 1 :> ToString[x]}]] &, Range[15]] Out[71]= {"1", "Fizz", "Buzz", "Fizz", "5", "FizzBuzz", "7", "Fizz", \ "Buzz", "Fizz", "11", "FizzBuzz", "13", "Fizz", "Buzz"} Commented Feb 3, 2016 at 23:42

In keeping with the multiple DownValues part of the question, this is an option:

ClearAll@f
conditions[x_] := {Mod[x, 2] == 0, Mod[x, 3] == 0, x < 10}
f[x_ /; Or @@ conditions[x]] := StringJoin@Pick[{"Fizz", "Buzz", "Zapp"}, conditions[x]]
f[x_] := x


It tests for any of the conditions first, and then within the body of the function uses the individual conditions to Pick out the correct words.

Of course, with something as simple as this, we could just define

ClearAll@f
f[x_] := With[{cons = conditions[x]},
If[Or @@ cons, StringJoin@Pick[{"Fizz", "Buzz", "Zapp"}, cons], x]
]


to begin with, because this doesn't require multiple calls to the conditions. Or, packaging everything together (in which case you can switch out the conditions and the list of strings):

ClearAll@f
f[x_] := Module[{
cons = {Mod[x, 2] == 0, Mod[x, 3] == 0, x < 10},
strs = {"Fizz", "Buzz", "Zapp"}
},
If[Or @@ cons, StringJoin@Pick[strs, cons], x]
]


However, none of the conditions are used in the definition of f, which isn't really in keeping with the nature of the question, which I read as how to deal with multiple DownValues with overlapping conditions. It might be that that's just not the natural way to deal with these constructions, but I'm still interested in an answer to that specific question.

To further see the usefulness here, I'll implement the second function that Sascha did in their answer.

ClearAll@f
regions = 1/2*{{1, -Sqrt[3]/3}, {0, 2 Sqrt[3]/3}, {-1, -Sqrt[3]/3}} // Map@Disk;

f[x_] := Module[{cons = RegionMember[#, x] & /@ regions},
{If[Or @@ cons, RGBColor @@ Plus @@ Pick[IdentityMatrix[3], cons], Black], Point@x}
]


Then (since I have version 10.0, I don't have RandomPoint, so I use a direct method to generate a random point in the disk):

f /@ Table[6/Sqrt[2 π] Sqrt[RandomReal[{0, 1}]] {Cos@#, Sin@#} &@ RandomReal[{0, 2 π}], {5000}] // Graphics


In addition, if there is interest in calling subfunctions, here's another example. Let's say that we want to compose a set of function depending on which conditions are met (and the ordering in which the conditions are met matters!). I'll return to the original conditions:

ClearAll@f
f[x_] := Module[{
cons = {Mod[x, 2] == 0, Mod[x, 3] == 0, x < 10},
strs = {g, h, m}
},
If[Or @@ cons, Apply[Composition, Pick[strs, cons]]@x, x]
]
f /@ Range[11]
(* {m[1], g[m[2]], h[m[3]], g[m[4]], m[5], g[h[m[6]]], m[7], g[m[8]], h[m[9]], g[10], 11} *)

• But this answer is specific to this particular String output, no?
– Berg
Commented Feb 4, 2016 at 10:04
• @Berg. I'm not sure what you mean! You can put any list of strings in there with any list of conditions. Order matters of course. Commented Feb 4, 2016 at 15:15
• But it only works if you look for a String output that is a sequence of substrings. How would you adapt your solution if one were to call subfunctions f1[x], ..., f8[x] depending on the condition?
– Berg
Commented Feb 4, 2016 at 17:41
• @Berg. I'm sorry, but I'm still not sure what you're saying. If the output of the functions need to be different, then you don't use StringJoin. What matters is that you have the correct ordering (and choice) of out of the list of things that the conditions pick out. As far as calling subfunctions, I didn't understand that to be part of the question, but perhaps I'm missing something. Can you give me a specific example? Commented Feb 4, 2016 at 23:36
• Say, you want f[x] to return x^2 for condition 1, Sin[x] for condition 2, RandomReal[] for condition 3, etc. (But, basically the wording of the question seems off to me: its not about pattern matching but String generation.)
– Berg
Commented Feb 5, 2016 at 22:47

This does not answers my own question fully (I am still interested to see if someone might come up with an truly elegant solution based on DownValues) but I found a rule-based solution that is imho. elegant non the less.

fizzbuzz[rls_]:= With[{res=ReplaceList[#, rls]}, If[res=={}, #, StringJoin@res]]&

fizzbuzz[{_?(Mod[#,2]==0&) -> "Fizz",
_?(Mod[#,3]==0&) -> "Buzz",
_?(#<10&) -> "Zapp"}] /@ Range@15


Looks especially neat (or obfuscated, depending on your point of view) with the escfnesc glyph for Function

Update: Generalization of my solution and Example

Because some confusion arose in the comments on march's answer I though I should address those in my own answer and give another example to show that this approach can be easily extended to all kinds of rules. So here is a generalization of my function fizzbuzz. It takes three arguments:

• a list of (possibly overlapping) replacement rules
• a function to be applied to the expressions found via pattern matching (note that the function also has access to the actual variable not only the results from pattern matching, see example below)
• an alternative function to be applied if no pattern matched

func[rls_, f_, alt_]:= With[{res=ReplaceList[#, rls]}, If[res=={}, alt@#, f[res,#]]]&

**Example**
regions=1/2*{{1, -Sqrt[3]/3}, {0, 2 Sqrt[3]/3}, {-1, -Sqrt[3]/3}} //Map@Disk;

f = func[{x_ /;RegionMember[regions[[1]],x]:> {1,0,0},
x_ /;RegionMember[regions[[2]],x]:> {0,1,0},
x_ /;RegionMember[regions[[3]],x]:> {0,0,1}},
{RGBColor@(Plus@@#1), Point[#2]}&, Point[#]& ]

f/@ RandomPoint[Disk[{0,0}, 2], 5000] //Graphics


### An alternative approach

It seems at its heart that you want more than one rule to match a given expression and each match to return a value, which is then to be combined. I cannot think of any "clever" method to do this that is not contrived and questionable. Perhaps something more standard has at least some service for you.

Your rules, each one in a sublist:

rules =
{{_?(Mod[#, 2] == 0 &) :> "Fizz"},
{_?(Mod[#, 3] == 0 &) :> "Buzz"},
{_?(# < 10 &)         :> "Zapp"}};


Then any one of the next three lines will produce:

Range@15 /. rules // Thread
Array[Replace[rules], 15]
Replace[rules] /@ Range[15]

{{1, 1, "Zapp"}, {"Fizz", 2, "Zapp"}, {3, "Buzz", "Zapp"}, {"Fizz", 4, "Zapp"},
{5, 5, "Zapp"}, {"Fizz", "Buzz", "Zapp"}, {7, 7, "Zapp"}, {"Fizz", 8, "Zapp"},
{9, "Buzz", "Zapp"}, {"Fizz", 10, 10}, {11, 11, 11}, {"Fizz", "Buzz", 12},
{13, 13, 13}, {"Fizz", 14, 14}, {15, "Buzz", 15}}


You could then, if possible, process from there, e.g.

post[x_List] := "" <> Cases[x, _String] /. "" :> First[x];

Array[post @* Replace[rules], 15]

{"Zapp", "FizzZapp", "BuzzZapp", "FizzZapp", "Zapp", "FizzBuzzZapp",
"Zapp", "FizzZapp", "BuzzZapp", "Fizz", 11, "FizzBuzz", 13, "Fizz", "Buzz"}


### A second try at the specific request

As for that "contrived and questionable" method I might as well post it; it actually doesn't look quite so bad "on paper" as it did in my head.

stack[] = {};
push[x_] := (stack[] = {stack[], x};)
end[] := # &["" <> stack[], stack[] = {}]

g[x_] /; Mod[x, 2] == 0 && push["Fizz"] = Null;
g[x_] /; Mod[x, 3] == 0 && push["Buzz"] = Null;
g[x_] /; x < 10 && push["Zapp"] = Null;

g[else_] := If[stack[] =!= {}, end[], else]

Array[g, 15]

{"Zapp", "FizzZapp", "BuzzZapp", "FizzZapp", "Zapp", "FizzBuzzZapp", "Zapp",
"FizzZapp", "BuzzZapp", "Fizz", 11, "FizzBuzz", 13, "Fizz", "Buzz"}

• +1 for the "contrived and questionable" method Commented Feb 4, 2016 at 19:44
f[x_] := With[{res = f1[x] <> f2[x] <> f3[x]},
Switch[res, "", x, _, res]]
f1[x_?(Mod[#, 2] == 0 &)] := "Fizz"
f1[x_] := ""
f2[x_?(Mod[#, 3] == 0 &)] := "Buzz"
f2[x_] := ""
f3[x_?(# < 10 &)] := "Zapp"
f3[x_] := ""

f /@ Range@15


{"Zapp", "FizzZapp", "BuzzZapp", "FizzZapp", "Zapp", "FizzBuzzZapp", "Zapp", "FizzZapp", "BuzzZapp", "Fizz", 11, "FizzBuzz", 13, "Fizz", "Buzz"}

I have probably missed the point but wanted to play:

f[lst_, ru_, lab_] := Module[
{r, u, s},
r = Boole@Through[ru[#]] & /@ lst;
u = (lab # /. {0 -> Sequence[]} & /@ r) /. {{} -> 1};
s = StringJoin @@@ u;
Thread[{lst, s}] /. {{_, y_String} :> y, {x_, 1} :> x}
]


So,

f[Range[100], {Mod[#, 2] == 0 &, Mod[#, 3] == 0 &, # < 10 &}, {"Fizz",
"Buzz", "Zapp"}]


yields:

{"Zapp", "FizzZapp", "BuzzZapp", "FizzZapp", "Zapp", "FizzBuzzZapp", \
"Zapp", "FizzZapp", "BuzzZapp", "Fizz", 11, "FizzBuzz", 13, "Fizz", \
"Buzz", "Fizz", 17, "FizzBuzz", 19, "Fizz", "Buzz", "Fizz", 23, \
"FizzBuzz", 25, "Fizz", "Buzz", "Fizz", 29, "FizzBuzz", 31, "Fizz", \
"Buzz", "Fizz", 35, "FizzBuzz", 37, "Fizz", "Buzz", "Fizz", 41, \
"FizzBuzz", 43, "Fizz", "Buzz", "Fizz", 47, "FizzBuzz", 49, "Fizz", \
"Buzz", "Fizz", 53, "FizzBuzz", 55, "Fizz", "Buzz", "Fizz", 59, \
"FizzBuzz", 61, "Fizz", "Buzz", "Fizz", 65, "FizzBuzz", 67, "Fizz", \
"Buzz", "Fizz", 71, "FizzBuzz", 73, "Fizz", "Buzz", "Fizz", 77, \
"FizzBuzz", 79, "Fizz", "Buzz", "Fizz", 83, "FizzBuzz", 85, "Fizz", \
"Buzz", "Fizz", 89, "FizzBuzz", 91, "Fizz", "Buzz", "Fizz", 95, \
"FizzBuzz", 97, "Fizz", "Buzz", "Fizz"}


Perhabs

g[x_] := Switch[{Mod[x, 2] == 0, Mod[x, 3] == 0, x < 10},
{True, True, True}, "FizzBuzzZapp",
{True, True, False}, "FizzBuzz",
{True, False, True}, "FizzZapp",
{True, False, False}, "Fizz",
{False, True, True}, "BuzzZapp",
{False, True, False}, "Buzz",
{False, False, True}, "Zapp",
_, x]


Not sure about elegance but at least every test is performed only once per function call. And it seems that the function definition cannot be much simpler (in general), if you have a large number of cases to define.

• This still leads to a massive amount of possible disjunctions that have to be manually addressed (and in the correct order) for the switch statement to work. Imagine not three fizzbuzz rules but a hundred Commented Feb 4, 2016 at 19:25