(*^ ::[ Information = "This is a Mathematica Notebook file. It contains ASCII text, and can be transferred by email, ftp, or other text-file transfer utility. It should be read or edited using a copy of Mathematica or MathReader. If you received this as email, use your mail application or copy/paste to save everything from the line containing (*^ down to the line containing ^*) into a plain text file. On some systems you may have to give the file a name ending with ".ma" to allow Mathematica to recognize it as a Notebook. The line below identifies what version of Mathematica created this file, but it can be opened using any other version as well."; FrontEndVersion = "NeXT Mathematica Notebook Front End Version 2.2"; NeXTStandardFontEncoding; keywords = "removeWhiteSpace, removeTwoSpaces, applyChar, incrementNumbers, divide100By, removeRepetitions, pointLoc"; fontset = title, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, L1, e8, 24, "Times"; ; fontset = subtitle, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, L1, e6, 18, "Times"; ; fontset = subsubtitle, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, italic, L1, e6, 14, "Times"; ; fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, L1, a20, 18, "Times"; ; fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, L1, a15, 14, "Times"; ; fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, L1, a12, 12, "Times"; ; fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 10, "Times"; ; fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, L1, 12, "Courier"; ; fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5, 12, "Courier"; ; fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L1, 12, "Courier"; ; fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L1, 12, "Courier"; ; fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L1, 12, "Courier"; ; fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287, L1, 12, "Courier"; ; fontset = name, inactive, noPageBreakInGroup, nohscroll, preserveAspect, M7, italic, B65535, L1, 10, "Times"; ; fontset = header, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic, L1, 12, "Times"; ; fontset = leftheader, 12; fontset = footer, inactive, nohscroll, noKeepOnOnePage, preserveAspect, center, M7, italic, L1, 12, "Times"; ; fontset = leftfooter, 12; fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12, "Courier"; ; fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; paletteColors = 128; automaticGrouping; currentKernel; ] :[font = title; inactive; preserveAspect; startGroup] Introduction to Programming with Mathematica ;[s] 2:0,0;35,1;46,-1; 2:1,21,16,Times,1,24,0,0,0;1,22,17,Times,3,24,0,0,0; :[font = subsubtitle; inactive; preserveAspect] By Richard J. Gaylord (gaylord@ux1.cso.uiuc.edu) Samuel N. Kamin (kamin@cs.uiuc.edu) Paul R. Wellin (wellin@sonoma.edu) :[font = subsubtitle; inactive; preserveAspect; plain; fontName = "Times"] Copyright ã 1993 by TELOS/Springer-Verlag ;[s] 3:0,0;10,1;11,2;41,-1; 3:1,13,10,Times,0,14,0,0,0;1,0,0,Symbol,0,14,0,0,0;1,13,10,Times,0,14,0,0,0; :[font = subtitle; inactive; preserveAspect; startGroup] Chapter 6 ± Conditional Function Definitions :[font = subsubtitle; inactive; preserveAspect] (Mathematica code) :[font = section; inactive; Cclosed; preserveAspect; startGroup] Functions defined in this Notebook :[font = text; inactive; preserveAspect; endGroup] removeWhiteSpace...115-118 removeTwoSpaces...118 applyChar...119-121 incrementNumbers...121 divide100By...121 removeRepetitions...122 pointLoc...122 :[font = section; inactive; Cclosed; preserveAspect; startGroup] Initialization (evaluate to turn off spell messages) :[font = input; initialization; preserveAspect] *) Off[General::spell] (* :[font = input; initialization; preserveAspect; endGroup] *) Off[General::spell1] (* :[font = section; inactive; Cclosed; preserveAspect; startGroup; keywords = "removeWhiteSpace"] Section 6.1 Introduction :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] removeWhiteSpace :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] Version 1 :[font = input; preserveAspect] Clear[removeWhiteSpace,a,b,c] :[font = input; preserveAspect] removeWhiteSpace[{" ", r___}] := {r} removeWhiteSpace[{"\n", r___}] := {r} removeWhiteSpace[L_] := L :[font = input; preserveAspect; endGroup] (* Test *) removeWhiteSpace[{" ", "a", "b", "c"}] :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] Version 2 :[font = input; preserveAspect] Clear[removeWhiteSpace,a,b,c] :[font = input; preserveAspect] (* Version 2 *) removeWhiteSpace[{x_, r___} /; x == " "] := {r} removeWhiteSpace[{x_, r___} /; x == "\n"] := {r} removeWhiteSpace[L_] := L :[font = input; preserveAspect; endGroup] (* Test *) removeWhiteSpace[{" ", "a", "b", "c"}] :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] Version 3 :[font = input; preserveAspect] Clear[removeWhiteSpace,a,b,c] :[font = input; preserveAspect] (* Version 3 *) removeWhiteSpace[{x_, r___} /; x == " " || x == "\n"] := {r} removeWhiteSpace[L_] := L removeWhiteSpace[{" " | "\n", r___}] := {r} removeWhiteSpace[L_] := L :[font = input; preserveAspect; endGroup] (* Test *) removeWhiteSpace[{" ", "a", "b", "c"}] :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] Version 4 :[font = input; preserveAspect] Clear[removeWhiteSpace,a,b,c] :[font = input; preserveAspect] (* Version 4 *) removeWhiteSpace[{x_, r___} /; MemberQ[{" ", "\n"}, x]] := {r} removeWhiteSpace[L_] := L :[font = input; preserveAspect; endGroup] (* Test *) removeWhiteSpace[{" ", "a", "b", "c"}] :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] Version 5 :[font = input; preserveAspect] Clear[removeWhiteSpace,a,b,c] :[font = input; preserveAspect] stringMemberQ[str_, ch_] := StringPosition[str, ch] != {} whiteSpaceQ[ch_] := stringMemberQ[" \n", ch] :[font = input; preserveAspect] removeWhiteSpace[{x_?whiteSpaceQ, r___}] := {r} removeWhiteSpace[L_] := L :[font = input; preserveAspect; endGroup] (* Test *) removeWhiteSpace[{" ", "a", "b", "c"}] :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] Version 6 :[font = input; preserveAspect] Clear[removeWhiteSpace,a,b,c] :[font = input; preserveAspect] removeWhiteSpace[{x_, r___} /; whiteSpaceQ[x]] := {r} removeWhiteSpace[L_] := L :[font = input; preserveAspect; endGroup] (* Test *) removeWhiteSpace[{" ", "a", "b", "c"}] :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] Version 7 :[font = input; preserveAspect] Clear[removeWhiteSpace,a,b,c] :[font = input; preserveAspect] removeWhiteSpace[{x_, r___}] := {r} /; whiteSpaceQ[x] removeWhiteSpace[L_] := L :[font = input; preserveAspect; endGroup; endGroup; endGroup] (* Test *) removeWhiteSpace[{" ", "a", "b", "c"}] :[font = section; inactive; Cclosed; preserveAspect; startGroup; keywords = "removeWhiteSpace, removeTwoSpaces, applyChar, incrementNumbers, divide100By, removeRepetitions"] Section 6.2 Conditional functions :[font = input; preserveAspect] Clear[removeWhiteSpace] :[font = input; preserveAspect] removeWhiteSpace[lis_] := If[stringMemberQ[" \n", First[lis]], Rest[lis], lis] :[font = input; preserveAspect] removeTwoSpaces[{x_, y_, r___}] := {r} /; whiteSpaceQ[x] && whiteSpaceQ[y] removeTwoSpaces[{x_, r___}] := {r} /; whiteSpaceQ[x] removeTwoSpaces[lis_] := lis :[font = input; preserveAspect] removeTwoSpaces[lis_] := If[whiteSpaceQ[First[lis]], If[whiteSpaceQ[First[Rest[lis]]], Rest[Rest[lis]], Rest[lis]], lis] :[font = input; preserveAspect] 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"]]]]]] :[font = input; preserveAspect] applyChar[{"+", 1, 2, 3, 4}] :[font = input; preserveAspect] 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"]]] :[font = input; preserveAspect] applyChar[{"+", 1, 2, 3, 4}] :[font = input; preserveAspect] 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"]]] :[font = input; preserveAspect] applyChar[{"+", 1, 2, 3, 4}] :[font = input; preserveAspect] incrementNumbers[L_] := Map[If[NumberQ[#], #+1, #]&, L] :[font = input; preserveAspect] incrementNumbers[{a, 4, bob, Pi, 6.3, 3/2}] :[font = input; preserveAspect] divide100By[L_] := Map[If[#==0, #, 100/#]&, L] :[font = input; preserveAspect] (* Test data for divide100By *) x = Table[Random[Integer, {1,100}],{5}] :[font = input; preserveAspect] divide100By[x] :[font = input; preserveAspect] divide100By[{2,5,0,10}] :[font = input; preserveAspect] removeRepetitions[L_] := Fold[If[#2==Last[#1], #1, Append[#1, #2]]&, {First[L]}, Rest[L]] :[font = input; preserveAspect] (* Test data for removeRepetitions *) y = {1, 1, 0, 1, -1, -1, -1, 1, 0, 1} :[font = input; preserveAspect; endGroup] removeRepetitions[y] :[font = section; inactive; Cclosed; preserveAspect; startGroup; keywords = "pointLoc"] Section 6.4 Example ± Classifying points :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] pointLoc :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] Conditional definition ( /; ) :[font = input; preserveAspect] Clear[pointLoc,a,b,c,d,e,f,g,h,i] :[font = input; preserveAspect] 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 *) :[font = input; preserveAspect; endGroup] (* 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] :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] If :[font = input; preserveAspect] Clear[pointLoc] :[font = input; preserveAspect] 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]]]]]] :[font = input; preserveAspect; endGroup] Map[pointLoc, testpoints] :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] Which :[font = input; preserveAspect] Clear[pointLoc] :[font = input; preserveAspect] 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] :[font = input; preserveAspect; endGroup] Map[pointLoc, testpoints] :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] Nesting conditional expressions :[font = input; preserveAspect] Clear[pointLoc] :[font = input; preserveAspect] 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]] :[font = input; Cclosed; preserveAspect; startGroup] Map[pointLoc, testpoints] :[font = output; output; inactive; preserveAspect; endGroup; endGroup] {1, 2, 3, 4, -2, -1, -2, -1, 0} ;[o] {1, 2, 3, 4, -2, -1, -2, -1, 0} :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] Conditional definitions within clauses :[font = input; preserveAspect] Clear[pointLoc] :[font = input; preserveAspect] 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 *) :[font = input; preserveAspect; endGroup; endGroup; endGroup; endGroup; endGroup] Map[pointLoc, testpoints] ^*)