Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Sign up
Here's how it works:
  1. Anybody can ask a question
  2. Anybody can answer
  3. The best answers are voted up and rise to the top

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.

share|improve this question
    
For your amusement: (18761) – Mr.Wizard Feb 3 at 23:16
3  
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"} – Daniel Lichtblau Feb 3 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

enter image description here


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} *)
share|improve this answer
    
But this answer is specific to this particular String output, no? – Berg Feb 4 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. – march Feb 4 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 Feb 4 at 17:41
1  
@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? – march Feb 4 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 Feb 5 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

enter image description here

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

output

share|improve this answer

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"}
share|improve this answer
1  
+1 for the "contrived and questionable" method – Sascha Feb 4 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"}

share|improve this answer

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.

share|improve this answer
    
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 – Sascha Feb 4 at 19:25

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"}
share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.