Introduction to Programming 
with 
Mathematica

By
Richard J. Gaylord 
(gaylord@ux1.cso.uiuc.edu)

Samuel N. Kamin 
(kamin@cs.uiuc.edu)

Paul R. Wellin 
(wellin@sonoma.edu)

Copyright ã 1993 by TELOS/Springer-Verlag

Chapter 6 ± Conditional Function Definitions

(Mathematica code)

Functions defined in this Notebook

removeWhiteSpace...115-118
removeTwoSpaces...118
applyChar...119-121
incrementNumbers...121
divide100By...121
removeRepetitions...122
pointLoc...122

Initialization (evaluate to turn off spell messages)

Off[General::spell]

Off[General::spell1]

Section 6.1  Introduction

removeWhiteSpace

Version 1

Clear[removeWhiteSpace,a,b,c]

removeWhiteSpace[{" ", r___}] := {r}
removeWhiteSpace[{"\n", r___}] := {r}
removeWhiteSpace[L_] := L

(* Test *)
removeWhiteSpace[{" ", "a", "b", "c"}]

Version 2

Clear[removeWhiteSpace,a,b,c]

(* Version 2 *)
removeWhiteSpace[{x_, r___} /; x == " "] := {r}
removeWhiteSpace[{x_, r___} /; x == "\n"] := {r}
removeWhiteSpace[L_] := L

(* Test *)
removeWhiteSpace[{" ", "a", "b", "c"}]

Version 3

Clear[removeWhiteSpace,a,b,c]

(* Version 3 *)
removeWhiteSpace[{x_, r___} /; x == " " || x == "\n"] := {r}
removeWhiteSpace[L_] := L
removeWhiteSpace[{" " | "\n", r___}] := {r}
removeWhiteSpace[L_] := L

(* Test *)
removeWhiteSpace[{" ", "a", "b", "c"}]

Version 4

Clear[removeWhiteSpace,a,b,c]

(* Version 4 *)
removeWhiteSpace[{x_, r___} /; MemberQ[{" ", "\n"}, x]] := {r}
removeWhiteSpace[L_] := L

(* Test *)
removeWhiteSpace[{" ", "a", "b", "c"}]

Version 5

Clear[removeWhiteSpace,a,b,c]

stringMemberQ[str_, ch_] := StringPosition[str, ch] != {}
whiteSpaceQ[ch_] := stringMemberQ[" \n", ch]

removeWhiteSpace[{x_?whiteSpaceQ, r___}] := {r}
removeWhiteSpace[L_] := L

(* Test *)
removeWhiteSpace[{" ", "a", "b", "c"}]

Version 6

Clear[removeWhiteSpace,a,b,c]

removeWhiteSpace[{x_, r___} /; whiteSpaceQ[x]] := {r}
removeWhiteSpace[L_] := L

(* Test *)
removeWhiteSpace[{" ", "a", "b", "c"}]

Version 7

Clear[removeWhiteSpace,a,b,c]

removeWhiteSpace[{x_, r___}] := {r} /; whiteSpaceQ[x]
removeWhiteSpace[L_] := L

(* Test *)
removeWhiteSpace[{" ", "a", "b", "c"}]

Section 6.2  Conditional functions

Clear[removeWhiteSpace]

removeWhiteSpace[lis_] :=
    If[stringMemberQ[" \n", First[lis]], Rest[lis], lis]

removeTwoSpaces[{x_, y_, r___}] :=
         {r} /; whiteSpaceQ[x] && whiteSpaceQ[y]
removeTwoSpaces[{x_, r___}] := {r} /; whiteSpaceQ[x]
removeTwoSpaces[lis_] := lis

removeTwoSpaces[lis_] := 
   If[whiteSpaceQ[First[lis]],
       If[whiteSpaceQ[First[Rest[lis]]],
           Rest[Rest[lis]],
           Rest[lis]],
       lis]

applyChar[lis_] := 
	Module[{op = First[lis], nums = Rest[lis]},   
		If[op == "+", Apply[Plus, nums],   
			If[op == "-", Apply[Minus, nums],
				If[op == "*", Apply[Times, nums],   
					If[op == "/", Apply[Divide, nums],   
						Print["Bad argument to applyChar"]]]]]]

applyChar[{"+", 1, 2, 3, 4}]

applyChar[lis_] := Module[{op = First[lis], nums = Rest[lis]},
    Which[op == "+", Apply[Plus, nums],
          op == "-", Apply[Minus, nums],
          op == "*", Apply[Times, nums],
          op == "/", Apply[Divide, nums],
          True, Print["Bad argument to applyChar"]]]

applyChar[{"+", 1, 2, 3, 4}]

applyChar[lis_] := 
    Module[{op = First[lis], nums = Rest[lis]},
       Switch[op, "+", Apply[Plus, nums],
                  "-", Apply[Minus, nums],
                  "*", Apply[Times, nums],
                  "/", Apply[Divide, nums],
                  _, Print["Bad argument to applyChar"]]]

applyChar[{"+", 1, 2, 3, 4}]

incrementNumbers[L_] := Map[If[NumberQ[#], #+1, #]&, L]

incrementNumbers[{a, 4, bob, Pi, 6.3, 3/2}]

divide100By[L_] := Map[If[#==0, #, 100/#]&, L]

(* Test data for divide100By *)
x = Table[Random[Integer, {1,100}],{5}]

divide100By[x]

divide100By[{2,5,0,10}]

removeRepetitions[L_] :=
   Fold[If[#2==Last[#1], #1, Append[#1, #2]]&, {First[L]}, Rest[L]]

(* Test data for removeRepetitions *)
y = {1, 1, 0, 1, -1, -1, -1, 1, 0, 1}

removeRepetitions[y]

Section 6.4  Example ± Classifying points

pointLoc

Conditional definition ( /; )

Clear[pointLoc,a,b,c,d,e,f,g,h,i]

pointLoc[{0, 0}] := 0
pointLoc[{x_, 0}]  := -1
pointLoc[{0, y_}]  := -2
pointLoc[{x_, y_}]   := 1 /; x>0 && y>0
pointLoc[{x_, y_}]   := 2 /; x<0 && y>0
pointLoc[{x_, y_}]   := 3 /; x<0 && y<0
pointLoc[{x_, y_}]   := 4 (* /; x>0 && y<0 *)

(* TEST *)
a = {1, 4};  b = {-1, 4};  c = {-1, -4};  d = {1, -4};
e = {0,2};   f = {-2,0};   g = {0,-2};    h = {2,0};
i = {0,0};
testpoints = {a,b,c,d,e,f,g,h,i};
Map[pointLoc, testpoints]

If

Clear[pointLoc]

pointLoc[{x_, y_}] :=
    If[x == 0 && y == 0, 0,
    If[y == 0, -1,
    If[x == 0, -2,
    If[x > 0 && y > 0, 1,
    If[x < 0 && y > 0, 2,
    If[x < 0 && y < 0, 3, (* x > 0 && y < 0 *) 4]]]]]]

Map[pointLoc, testpoints]

Which

Clear[pointLoc]

pointLoc[{x_, y_}] :=
   Which[
           x == 0 && y == 0, 0,
           y == 0, -1,
           x == 0, -2,
           x > 0 && y > 0, 1,
           x < 0 && y > 0, 2,
           x < 0 && y < 0, 3,
           True (* x > 0 && y < 0 *) , 4]

Map[pointLoc, testpoints]

Nesting conditional expressions

Clear[pointLoc]

pointLoc[{x_, y_}] :=
   Which[
            x == 0, If[y == 0, 0, -2],
            x > 0, Which[y > 0, 1,
                                  y < 0, 4,
                                  True (* y == 0 *), -1],
            True (* x<0 *),
                Which[y < 0, 3,
                            y > 0, 2,
                            True (* y == 0 *), -1]]

Map[pointLoc, testpoints]

Conditional definitions within clauses

Clear[pointLoc]

pointLoc[{0, 0}] := 0
pointLoc[{x_, 0}] := -1
pointLoc[{0, y_}] := -2
pointLoc[{x_, y_}] := If[x < 0, 2, 1] /; y > 0
pointLoc[{x_, y_}] := If[x < 0, 3, 4] (* /; y < 0 *)

Map[pointLoc, testpoints]