(***********************************************************************
Mathematica-Compatible Notebook
This notebook can be used on any computer system with Mathematica 3.0,
MathReader 3.0, or any compatible application. The data for the notebook
starts with the line of stars above.
To get the notebook into a Mathematica-compatible application, do one of
the following:
* Save the data starting with the line of stars above into a file
with a name ending in .nb, then open the file inside the application;
* Copy the data starting with the line of stars above to the
clipboard, then use the Paste menu command inside the application.
Data for notebooks contains only printable 7-bit ASCII and can be
sent directly in email or through ftp in text mode. Newlines can be
CR, LF or CRLF (Unix, Macintosh or MS-DOS style).
NOTE: If you modify the data for this notebook not in a Mathematica-
compatible application, you must delete the line below containing the
word CacheID, otherwise Mathematica-compatible applications may try to
use invalid cache data.
For more information on notebooks and Mathematica-compatible
applications, contact Wolfram Research:
web: http://www.wolfram.com
email: info@wolfram.com
phone: +1-217-398-0700 (U.S.)
Notebook reader applications are available free of charge from
Wolfram Research.
***********************************************************************)
(*CacheID: 232*)
(*NotebookFileLineBreakTest
NotebookFileLineBreakTest*)
(*NotebookOptionsPosition[ 8672, 321]*)
(*NotebookOutlinePosition[ 9390, 346]*)
(* CellTagsIndexPosition[ 9346, 342]*)
(*WindowFrame->Normal*)
Notebook[{
Cell[CellGroupData[{
Cell["\<\
Simple Non-Differentiable Functions
and
Weierstrass' NOWHERE Differentiable Function\
\>", "Subtitle",
Evaluatable->False,
AspectRatioFixed->True],
Cell["\<\
by
K. D. Stroyan
University of Iowa\
\>", "Subsubtitle",
Evaluatable->False,
AspectRatioFixed->True],
Cell["\<\
copyright 1997 by Academic Press, Inc. - All rights reserved.\
\>", "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{
Cell[TextData[{
"Special ",
StyleBox["Mathematica",
FontSlant->"Italic"],
" Function: The GapZoom Package"
}], "Subsubsection",
Evaluatable->False,
InitializationCell->True,
AspectRatioFixed->True],
Cell["Needs[\"Graphics`Colors`\"];", "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[" Notebook Overview", "Section",
Evaluatable->False,
AspectRatioFixed->True],
Cell["\<\
This notebook introduces some functions that are NOT smooth at every point. \
These functions are studied in Exercises 3.2.3 and 3.2.4 and Problems 3.1 and \
3.2.\
\>", "Text",
Evaluatable->False,
AspectRatioFixed->True]
}, Closed]],
Cell[CellGroupData[{
Cell["Sample Computations", "Section",
Evaluatable->False,
AspectRatioFixed->True],
Cell["\<\
There are certain reasons why these functions are non-differentiable. Take a \
close look at each and see if you can figure out why this is so.\
\>", "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell["A Jump Function j[x]:", "Subsection",
Evaluatable->False],
Cell["\<\
The next function has a \"jump disconuity\" at the point x = 1. Enter the \
next computation to see what happens near x = 1:\
\>", "Text",
Evaluatable->False],
Cell[BoxData[{
\(\(Clear[j, x]; \)\),
\(\(j[x_] := \@\(x\^2 + 2\ x + 1\)\/\(x + 1\); \)\),
\(j[x]\),
\(\(Plot[j[x], {x, \(-2\), 1}, PlotStyle -> {Thickness[0.01], Blue}];
\)\)}], "Input"]
}, Closed]],
Cell[CellGroupData[{
Cell["A Kink Function k[x]:", "Subsection",
Evaluatable->False],
Cell[" This function is:", "Text",
Evaluatable->False],
Cell[BoxData[{
\(\(Clear[k, x]; \)\),
\(\(k[x_] := \@\(x\^2 + 2\ x + 1\); \)\),
\(k[x]\),
\(\(Plot[k[x], {x, \(-2\), 1}, PlotStyle -> {Thickness[0.01], Red}];
\)\)}], "Input"]
}, Closed]],
Cell[CellGroupData[{
Cell["Weierstrass' Wild Wiggles w[x]: A Kink at Every Point", "Subsection",
Evaluatable->False],
Cell["\<\
This is Weierstrass' function at a unit scale. Plot it and notice how \
jagged it looks.\
\>", "Text",
Evaluatable->False],
Cell[BoxData[{
\(\(SetOptions[Plot, AspectRatio \[Rule] Automatic]; \)\),
\(\(Clear[w, x, n]; \)\),
\(w[x_] := \[Sum]\+\(m = 1\)\%n Cos[3\^m\ x]\/2\^m\),
\(\(n = 10; \)\),
\(\(Print["\", w[x]]; \)\),
\(\(Plot[w[x], {x, \(-1\), 1}, AxesLabel \[Rule] {"\", "\"},
PlotStyle -> {Brown}]; \)\)}], "Input"],
Cell[CellGroupData[{
Cell["A Closer Look", "Subsubsection",
Evaluatable->False],
Cell["The question is: ", "Text",
Evaluatable->False],
Cell["\<\
Do the jagged parts of the graph go away when we magnify?
The next computation allows YOU to pick an x value and a scale. The graph \
of w[x] will then be drawn magnifying at the point (x,w[x]) to the scale \
you select. the sample and then experiment with different points and \
scales.\
\>", "Text",
Evaluatable->False],
Cell[BoxData[{
\(\(SetOptions[Plot, AspectRatio \[Rule] Automatic,
AxesOrigin \[Rule] {0, 0}, AxesLabel \[Rule] {"\", "\"},
Ticks \[Rule] None]; \)\),
\(\(Clear[w, x, y, n]; \)\),
\(\(w[x_] := \[Sum]\+\(m = 1\)\%n Cos[3\^m\ x]\/2\^m; \)\),
\(\(x = 0.3; \)\),
\(\(scale = 1\/10. ; \)\),
\(\(n = 1 + Floor[N[Log[100\/scale]\/Log[2]]]; \)\),
\(\(y = N[w[x]]; \)\),
\(Plot[w[x + dx] - y, {dx, \(-scale\), scale},
PlotRange \[Rule] {y - scale, y + scale}, PlotStyle -> {Brown}]; \n
Print[n, "\< terms of w[x] at scale = \>", scale]; \n
Print["\", x "\<,\>"\ , y, "\<)\>"]; \)}], "Input"]
}, Closed]]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell["Exercises", "Section"],
Cell[CellGroupData[{
Cell["Exercise 3.2.3 & 4", "Subsection"],
Cell["See the Zoom program.", "Text"]
}, Closed]],
Cell[CellGroupData[{
Cell["Problem 3.1", "Subsection"],
Cell[CellGroupData[{
Cell["Exercise: Observations about the graph y = j[x]", "Subsubsection",
Evaluatable->False],
Cell["\<\
Notice that j[x] = -1 for values of x < 1, no matter how close to x = 1 \
they are, but that j[x] = +1 for values of x > 1, no matter how close to x = \
1 they are. This means that we can take x1 < 1, but very very close to x = \
1 and x2 > 1, also very close.\
\>", "Text",
Evaluatable->False],
Cell["Then we have", "Text",
Evaluatable->False],
Cell[TextData[
"\tx1 \[TildeTilde] x2 but j[x1] is not close to j[x2]"], "Text",
Evaluatable->False],
Cell["QUESTIONS:", "Text",
Evaluatable->False],
Cell["\<\
1) Why does the computer give error messages when it is plotting this graph? \
\
\>", "Text",
Evaluatable->False],
Cell[TextData[{
"2) Can you simplify the expression Sqrt[ ",
Cell[BoxData[
\(x\^2 + 2\ x + 1\)]],
" ] /(x+1) by factoring ",
Cell[BoxData[
\(x\^2 + 2\ x + 1\)]],
"?"
}], "Text",
Evaluatable->False],
Cell["3) Why do we say j[x] is not continuous? ", "Text",
Evaluatable->False]
}, Closed]],
Cell[CellGroupData[{
Cell["Exercise: Observations about the graph y = k[x]", "Subsubsection",
Evaluatable->False],
Cell["\<\
Notice that k[x] is a line of slope -1 for values of x < 1, no matter \
how close to x = 1 they are, but that j[x] is line of slope +1 for values \
of x > 1, no matter how close to x = 1 they are. Since line segments remain \
linear on magnification, this means that we can magnify near x = -1 as much \
as we please and the graph will not change (only the scales change.) No \
matter how much we magnify, the graph near x = -1 never gets close to a \
single straight line, it is NOT locally linear near x =-1.\
\>", "Text",
Evaluatable->False],
Cell["QUESTIONS:", "Text",
Evaluatable->False],
Cell[TextData[{
"1) Can you simplify the expression Sqrt[",
Cell[BoxData[
\(x\^2 + 2\ x + 1\)]],
" ] by factoring ",
Cell[BoxData[
\(x\^2 + 2\ x + 1\)]],
"?"
}], "Text",
Evaluatable->False],
Cell["\<\
2) Why do we call k[x] continuous, but NOT smooth (or locally linear) at \
x = -1?\
\>", "Text",
Evaluatable->False]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell["Problem 3.2", "Subsection",
Evaluatable->False,
AspectRatioFixed->True],
Cell["\<\
Plot magnifications of the graph of Weierstrass' function w[x] at x = 0.3, \
for scales of 1/2, 1/5, 1/10.\
\>", "Text",
Evaluatable->False],
Cell["Plot magnified graphs at several x-locations. ", "Text",
Evaluatable->False]
}, Closed]]
}, Closed]]
}, Open ]]
},
FrontEndVersion->"Microsoft Windows 3.0",
ScreenRectangle->{{0, 1024}, {0, 718}},
AutoGeneratedPackage->None,
WindowSize->{486, 613},
WindowMargins->{{11, Automatic}, {-2, Automatic}},
StyleDefinitions -> "CalcTLCStyle.nb"
]
(***********************************************************************
Cached data follows. If you edit this Notebook file directly, not using
Mathematica, you must remove the line containing CacheID at the top of
the file. The cache data will then be recreated when you save this file
from within Mathematica.
***********************************************************************)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[CellGroupData[{
Cell[1731, 51, 160, 6, 138, "Subtitle",
Evaluatable->False],
Cell[1894, 59, 115, 6, 62, "Subsubtitle",
Evaluatable->False],
Cell[2012, 67, 133, 4, 27, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[2170, 75, 213, 8, 33, "Subsubsection",
Evaluatable->False,
InitializationCell->True],
Cell[2386, 85, 73, 1, 39, "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell[2496, 91, 85, 2, 40, "Section",
Evaluatable->False],
Cell[2584, 95, 235, 6, 46, "Text",
Evaluatable->False]
}, Closed]],
Cell[CellGroupData[{
Cell[2856, 106, 86, 2, 40, "Section",
Evaluatable->False],
Cell[2945, 110, 191, 4, 46, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[3161, 118, 66, 1, 47, "Subsection",
Evaluatable->False],
Cell[3230, 121, 173, 4, 46, "Text",
Evaluatable->False],
Cell[3406, 127, 211, 5, 121, "Input"]
}, Closed]],
Cell[CellGroupData[{
Cell[3654, 137, 66, 1, 47, "Subsection",
Evaluatable->False],
Cell[3723, 140, 56, 1, 27, "Text",
Evaluatable->False],
Cell[3782, 143, 199, 5, 102, "Input"]
}, Closed]],
Cell[CellGroupData[{
Cell[4018, 153, 98, 1, 47, "Subsection",
Evaluatable->False],
Cell[4119, 156, 136, 4, 27, "Text",
Evaluatable->False],
Cell[4258, 162, 367, 7, 162, "Input"],
Cell[CellGroupData[{
Cell[4650, 173, 60, 1, 33, "Subsubsection",
Evaluatable->False],
Cell[4713, 176, 55, 1, 27, "Text",
Evaluatable->False],
Cell[4771, 179, 349, 7, 84, "Text",
Evaluatable->False],
Cell[5123, 188, 677, 13, 322, "Input"]
}, Closed]]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[5861, 208, 28, 0, 40, "Section"],
Cell[CellGroupData[{
Cell[5914, 212, 40, 0, 47, "Subsection"],
Cell[5957, 214, 37, 0, 27, "Text"]
}, Closed]],
Cell[CellGroupData[{
Cell[6031, 219, 33, 0, 31, "Subsection"],
Cell[CellGroupData[{
Cell[6089, 223, 94, 1, 33, "Subsubsection",
Evaluatable->False],
Cell[6186, 226, 313, 6, 65, "Text",
Evaluatable->False],
Cell[6502, 234, 50, 1, 27, "Text",
Evaluatable->False],
Cell[6555, 237, 104, 2, 27, "Text",
Evaluatable->False],
Cell[6662, 241, 48, 1, 27, "Text",
Evaluatable->False],
Cell[6713, 244, 126, 4, 27, "Text",
Evaluatable->False],
Cell[6842, 250, 224, 9, 27, "Text",
Evaluatable->False],
Cell[7069, 261, 82, 1, 27, "Text",
Evaluatable->False]
}, Closed]],
Cell[CellGroupData[{
Cell[7188, 267, 94, 1, 33, "Subsubsection",
Evaluatable->False],
Cell[7285, 270, 568, 9, 103, "Text",
Evaluatable->False],
Cell[7856, 281, 48, 1, 27, "Text",
Evaluatable->False],
Cell[7907, 284, 215, 9, 27, "Text",
Evaluatable->False],
Cell[8125, 295, 132, 4, 27, "Text",
Evaluatable->False]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[8306, 305, 81, 2, 31, "Subsection",
Evaluatable->False],
Cell[8390, 309, 155, 4, 27, "Text",
Evaluatable->False],
Cell[8548, 315, 84, 1, 27, "Text",
Evaluatable->False]
}, Closed]]
}, Closed]]
}, Open ]]
}
]
*)
(***********************************************************************
End of Mathematica Notebook file.
***********************************************************************)