\newcounter{Rchunkno}\newcounter{IsInCodeChunk}\setcounter{IsInCodeChunk}{1}\newcommand{\codechunkcommands}{\relax}\newcommand{\textchunkcommands}{\relax}\newcommand{\Routputcommands}{\relax}\newcommand{\makemarginno}{\par\vspace{-0.5\parskip}\codechunkcommands\stepcounter{Rchunkno}\setcounter{IsInCodeChunk}{1}\noindent\hspace*{-3em}\makebox[0mm]{\arabic{Rchunkno}}\hspace*{3em}}% New Report: Fri Sep 26 17:30:28 2014 % New Report: Fri Sep 26 16:59:20 2014 % New Report: Thu Sep 25 16:58:08 2014 % New Report: Mon Nov 4 13:41:06 2013 % New Report: Mon Nov 4 13:28:20 2013 % 131104: # require(tcltk) # now in the depends section of the package % slider() is copied from R/work/relax/install.dir/relax/R/slider.R % New Report: Fri Jun 12 11:48:32 2009 % New Report: Wed Mar 25 10:10:57 2009 %%%??? slider redo button release / at once,, vertcal sliders,, other button arrangements?? % New Report: Mon Jun 9 18:03:49 2008 % New Report: Tue Jun 3 09:20:42 2008 % New Report: Mon May 26 11:10:38 2008 % --- begin of preamble \documentclass{article} %\VignetteIndexEntry{Working with Slider Functions} % --- packages \usepackage{a4,graphicx,mathpazo,courier,alltt,amssymb} \usepackage{graphicx} % --- fonts % \usepackage[scaled=.95]{helvet} \usepackage[T1]{fontenc} % --- commands to control the layout of text and code chunks \parskip1ex \topmargin0cm \textheight22cm \parindent0mm \renewcommand{\textchunkcommands}{\normalsize} \renewcommand{\codechunkcommands}{\small} % --- titlepage \title{Some Slider Functions} \author{Hans Peter Wolf\\ {\small pw090615-1650, /home/wiwi/pwolf/R/aplpack/sliderfns, File:} \jobname.rev } % --- end of preamble \begin{document}\maketitle % --- begin of document \tableofcontents \newcommand{\showwidget}[1]{\par \includegraphics[width=4cm]{#1}} \newpage \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \section{Slider functions for exploratory data analysis} In this paper we discuss a set of slider functions for constructing dynamical statistical plots. Some of the characteristics of these plots are controlled by sliders and you can modify the plots by the sliders. The sliders will be generated within Tcl/Tk widgets. Moving a slider results in changing the associated parameter and the graphics output is updated. For example, {\tt slider.density()} plots a density trace and opens a Tcl/Tk widget with one slider that is linked to the {\tt width} parameter of {\tt density()}. After shifting the slider and releasing the mouse button the density trace is plotted again taking into account the new window width. The next section contains a list of functions presented in this paper. Then you get some examples so you can see the function in action. Some special tricks are used to customize the behaviour of the slider functions. These programming pearls are discussed in section three. In the remaining sections you find the definitions of the slider function. We hope that the functions are useful for you in the way they are defined. However, you are invited to take a closer look at the code. Sometimes it will be very easy to enhance the proposals and you quickly get new slider functions. \newpage \section{Slider functions -- overview and examples} \subsection{The functions of the paper} \newcommand{\kannweg}[1]{\relax} \kannweg{ The following list shows the slider functions of this paper. \begin{itemize} % 1 dim \item histogram %ok \item density %ok %% box-cox %% \item show 1.dim: hist, boxplot, ecdf, density ... layout %% \item stem ... n.classes \item --- density presenter % zra \item tszoom %ok \item smooth Tukey \item change of structure in different regions % k dim xy \item xyplot mit brushing ok %%% xyplot brushing: 2 Var waehlen sowie die Intervalle aller Var per slider %regression \item smooth by Lowess %%% \item --- xyplot mit lm - local estimations \item bootstrap regression ok %%% \item --- outlier %%% \item R^2 estimation \end{itemize} } The following list shows the functions available in this package: \makemarginno $\langle${\it linux command to find the slider functions}\ $1\rangle\equiv$ \label{CodeChunkLabelAAAB} \rule{0mm}{0mm}\newline\verb? fns<-readLines("sliderfns.rev") ?% \rule{0mm}{0mm}\newline\verb? fns<-fns[grep("^slider.*function",fns)] ?% \rule{0mm}{0mm}\newline\verb? sort(unique(sub("<-.*$","",fns))) ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \par\Routputcommands\begin{verbatim} Wed Mar 25 10:12:18 2009 [1] "slider" "slider.bootstrap.lm.plot" [3] "slider.brush.pairs" "slider.brush.plot.xy" [5] "slider.density" "slider.hist" [7] "slider.lowess.plot" "slider.present.density" [9] "slider.show.density" "slider.show.norm" [11] "slider.show.normal.density" "slider.smooth.plot.ts" [13] "slider.split.plot.ts" "slider.trimmed.mean" [15] "slider.trimmed.mean.plus" "slider.trimmed.mean.simple" [17] "slider.xyz" "slider.zoom.plot.ts" \end{verbatim}\textchunkcommands \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \newpage \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi The next subsections contain a sequence of screen shots showing the some of the slider functions in action. \subsection{{\tt slider.hist}} \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi {\tt slider.hist} computes histograms. The number of classes is controlled by a slider. As a special feature {\tt slider.hist} has a {\tt panel} argument. This argument allows you to deliver a panel function which draws some additional plotting elements. In the following example {\tt panel} is used to add a normal density curve as well as a \emph{rug}. \makemarginno $\langle${\it show {\tt slider.hist}}\ $2\rangle\equiv$ \label{CodeChunkLabelAAAC} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.hist}} 31$\rangle$% \rule{0mm}{0mm}\newline\verb? slider.hist(rivers,xlab="x",col="green",probability=TRUE, ?% \rule{0mm}{0mm}\newline\verb? panel=function(x){ ?% \rule{0mm}{0mm}\newline\verb? xx<-seq(min(x),max(x),length=100) ?% \rule{0mm}{0mm}\newline\verb? yy<-dnorm(xx,mean(x),sd(x)) ?% \rule{0mm}{0mm}\newline\verb? lines(xx,yy); rug(x); print(summary(yy)) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ) ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi After moving the slider to position 17 the control widget looks like this: \begin{center} \includegraphics[width=4cm]{sliderhistwidget} \end{center} \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi After releasing the mouse button the graphics device shows the following plot: \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \begin{center}\includegraphics[height=6cm]{p2008-Aug27-144152}\end{center} %

\ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi You see that the fit of the normal distribution is not very good. Perhaps an exponential distribution is a quite better model. Can you build a new call of {\tt slider.hist} with a suitable exponential density curve? Hint: You have to exchange the line of code that computes the normal density values:\\ remove {\tt yy<-dnorm(xx,mean(x),sd(x))} \\ write {\tt yy<-dexp(xx,1/mean(x))}. \newpage \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsection{{\tt slider.density}} {\tt slider.density} computes density traces. The parameter {\tt width} and the type of the kernel function are controlled by sliders. Like {\tt slider.hist} the function {\tt slider.density} has a panel argument to add further graphical elements. In the example {\tt slider.density} a normal density curve and a rug are added by the {\tt panel} function. \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \makemarginno $\langle${\it show {\tt slider.density}}\ $3\rangle\equiv$ \label{CodeChunkLabelAAAD} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.density}} 34$\rangle$% \rule{0mm}{0mm}\newline\verb? slider.density(log(rivers),xlab="rivers",col="red", ?% \rule{0mm}{0mm}\newline\verb? panel=function(x){ ?% \rule{0mm}{0mm}\newline\verb? xx<-seq(min(x),max(x),length=100) ?% \rule{0mm}{0mm}\newline\verb? yy<-dnorm(xx,mean(x),sd(x)) ?% \rule{0mm}{0mm}\newline\verb? lines(xx,yy); rug(x); print(summary(yy)) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ) ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi If you want to select a width of 3 percent of the range of the data and a rectangular kernel the slider control widget must have the following apearance. With these settings the graph will be very shaky. \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \begin{center} \includegraphics[height=7cm]{p2008-Aug27-145612} \showwidget{sliderdensitywidget} \end{center} %

\ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi The parameter settings {\tt "width=20"}, {\tt "kernel=epanechnikov"} result in a much smoother plot. \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \begin{center}\includegraphics[height=7cm]{p2008-Aug27-150508} \showwidget{sliderdensitywidget2} \end{center} %

\ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsection{{\tt slider.brush.pairs}} {\tt pairs()} constructs a draftsman's display -- a set of two dimensional scatterplots. This function is really useful for data sets with 3 to 10 variables because dependencies between a pair of variables can be seen at once. However, sometimes it is very interesting to explore two dimensional dependencies of a subset of the data points that are defined by a third variable. This idea leads to the function {\tt slider.brush.pairs} which computes a pairs plot and allows you to define an interval for the values of one variable. After changing the settings all data points of the visible interval are recolored using the color "red". \makemarginno $\langle${\it show {\tt slider.brush.pairs}}\ $4\rangle\equiv$ \label{CodeChunkLabelAAAE} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.brush.pairs}} 38$\rangle$% \rule{0mm}{0mm}\newline\verb? slider.brush.pairs(iris[,-4]) ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \begin{center}\includegraphics[height=7cm]{p171340-Jun-9} ~~~~~\showwidget{sliderpairswidget} \end{center} %

\ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsection{{\tt slider.brush.plot.xy}} The function {\tt slider.brush.plot.xy} is a small version of {\tt slider.brush.pairs()}. It is suitable for three dimensional data sets. {\tt slider.brush.plot.xy()} computes a two dimensional scatterplot and chooses the color of the points conditional to a third variable. Therefore, you can start the exploration with {\tt slider.brush.pairs()} and if you want to concentrate on one of the scatterplots --- e.~g.~for the purpose of presentation --- you can call {\tt slider.brush.plot.xy()}. \makemarginno $\langle${\it show of {\tt slider.brush.plot.xy}}\ $5\rangle\equiv$ \label{CodeChunkLabelAAAF} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.brush.plot.xy}} 40$\rangle$% \rule{0mm}{0mm}\newline\verb? slider.brush.plot.xy(iris[,1:3]) ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \begin{center}\includegraphics[height=7cm]{p172434-Jun-9} \showwidget{sliderbrushplotwidget} \end{center} %

\ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsection{{\tt slider.split.plot.ts}} Time series often have different structures in the distinct intervals. Then it may be interesting to inspect various subsets of the data. For comparing different intervals (in time) you can split the whole time series into pieces and fit linear regression models to the various regions. The function {\tt slider.split.plot.ts} has been designed for doing this job. By sliders you are able to define a point on the time axis as well as the length of a time interval (strip). Then a time series plot of your data is computed and it is partitioned into stripes in a way that one limit between two strip is identical with the selected point. Furthermore, regression lines of fitted linear models are drawn within each of the intervals. Alternatively {\tt slider.split.plot.ts} allows you to draw the main characteristics of the subsets of points. A mouse click on the button {\tt fivenum\ summary} of the control widget will add graphical five number summaries of the data values of each region. \makemarginno $\langle${\it show {\tt slider.split.plot.ts}}\ $6\rangle\equiv$ \label{CodeChunkLabelAAAG} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.split.plot.ts}} 43$\rangle$% \rule{0mm}{0mm}\newline\verb? slider.split.plot.ts(as.vector(sunspots)[1:100]) ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \begin{center}\includegraphics[height=7cm]{p173657-Jun-9} \showwidget{slidersplitwidget} \end{center} %

\ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsection{{\tt slider.zoom.plot.ts}} Some time series are often very long. For inspection such a series you want to be able to view the data of selected intervals. {\tt slider.zoom.plot.ts} enables you to choose two windows of the whole range of the data and the function computes two time series plots of the two sections. With this function it is easy to compare the structures of two different regions of a time series. \makemarginno $\langle${\it show {\tt slider.zoom.plot.ts}}\ $7\rangle\equiv$ \label{CodeChunkLabelAAAH} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.zoom.plot.ts}} 46$\rangle$% \rule{0mm}{0mm}\newline\verb? slider.zoom.plot.ts(as.vector(sunspots),2) ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \begin{center}\includegraphics[height=7cm]{p175158-Jun-9} \showwidget{sliderzoomwidget} \end{center} %

\ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsection{{\tt slider.smooth.plot.ts}} The function {\tt slider.smooth.plot.ts} allows you to smooth a time series by running medians or some other operations which has been proposed by Tukey. The implementation is based on {\tt smooth()} and the operation is applied by clicking one of the buttons of the control widget. \makemarginno $\langle${\it show {\tt slider.smooth.plot.ts}}\ $8\rangle\equiv$ \label{CodeChunkLabelAAAI} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.smooth.plot.ts}} 50$\rangle$% \rule{0mm}{0mm}\newline\verb? slider.smooth.plot.ts(rnorm(100)) ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \begin{center}\includegraphics[height=7cm]{p180443-Jun-9} \bigskip \bigskip \showwidget{slidersmoothwidget}\end{center} %

\ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsection{{\tt slider.lowess.plot}} {\tt lowess()} is an R function for analyzing the trend of points in a scatterplot. The smoothness of the computed line depends on a span parameter. Because of the algorithm is time consuming {\tt lowess} has a parameter to fix the number of iterations to be done. The function {\tt slider.lowess.plot()} computes a scatterplot of a data set and lets you select these two parameters by an control widget. \makemarginno $\langle${\it show {\tt slider.lowess.plot}}\ $9\rangle\equiv$ \label{CodeChunkLabelAAAJ} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.lowess.plot}} 53$\rangle$% \rule{0mm}{0mm}\newline\verb? slider.lowess.plot(cars) ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \begin{center}\includegraphics[height=7cm]{p180705-Jun-9} \showwidget{sliderlowesswidget} \end{center} %

\ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsection{{\tt slider.bootstrap.lm.plot}} Sometimes you have fitted a model curve on the base of a data set and you wonder how sensitive the result is against changes of the data. The function {\tt slider.bootstrap.lm.plot()} draws a scatterplot containing the curve of a fitted model as well as some curves that have been computed on samples of the original data points. The user is allowed to select the degree of the polynom to be fitted, the number of bootstrap samples and the random seed. \makemarginno $\langle${\it show {\tt slider.bootstrap.lm.plot}}\ $10\rangle\equiv$ \label{CodeChunkLabelAABA} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.bootstrap.lm.plot}} 56$\rangle$% \rule{0mm}{0mm}\newline\verb? daten<-iris[,2:3] ?% \rule{0mm}{0mm}\newline\verb? slider.bootstrap.lm.plot(daten) ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \begin{center}\includegraphics[height=7cm]{p181236-Jun-9} \showwidget{sliderbootwidget} \end{center} %

\ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \newpage \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \section{General issues of the implementation} \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsection{The structure of slider functions} The last section discusses some slider functions and the reader has got examples of their application. Now we will explore the structure of the slider functions. All of them call the function {\tt slider} to create and to control Tcl/TK widgets. The widgets consist of sliders and buttons that are linked to R functions describing the actions to be performed. To demonstrate the usage of {\tt slider} within the slider functions we discuss some examples now. As a very simple one let us build a slider function that prints the trimmed mean of a data set depending on the trim fraction which is controlled by a slider. \subsubsection{A very simple example} In this paragraph we define the function {\tt slider.trimmed.mean.simple}. It shows the usage of the function {\tt slider()} for doing the jobs \begin{itemize} \item create a control widget with one slider \item define the effect or the action to be done in case of a slider movement \item link the slider with the action. \end{itemize} Before going into details activate the following code chunk, please. It will define the function {\tt "slider.trimmed.mean.simple"} and it will call the new function with the data set {\tt "rivers[1:50]"}: \makemarginno $\langle${\it define {\tt slider.trimmed.mean}}\ $11\rangle\equiv$ \label{CodeChunkLabelAABB} \rule{0mm}{0mm}\newline\verb? slider.trimmed.mean.simple<-function(x) ?% \rule{0mm}{0mm}\newline\verb? { ?% \rule{0mm}{0mm}\newline\verb? # general initialisations ?% \rule{0mm}{0mm}\newline\verb? if(missing(x)) return("Error: no data found!") ?% \rule{0mm}{0mm}\newline\verb? # function to update result ?% \rule{0mm}{0mm}\newline\verb? compute.trimmed.mean<-function(...){ ?% \rule{0mm}{0mm}\newline\verb? # get slider ?% \rule{0mm}{0mm}\newline\verb? alpha <- slider(no=1) ?% \rule{0mm}{0mm}\newline\verb? # print result ?% \rule{0mm}{0mm}\newline\verb? cat(paste("trim fraction",alpha,":",mean(x,trim=alpha),"\n")) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? # definition of slider widget ?% \rule{0mm}{0mm}\newline\verb? slider(compute.trimmed.mean,"trim fraction",0,0.5,0.01,0) ?% \rule{0mm}{0mm}\newline\verb? # initial computation ?% \rule{0mm}{0mm}\newline\verb? compute.trimmed.mean() ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? slider.trimmed.mean.simple(rivers[1:50]) ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi Move the slider named {\tt "trim\ fraction"} and observe what happens! Now let's take a look at the definition of {\tt slider.trimmed.mean.simple}. The function consists of four instructions: \begin{itemize} \item The first statement is an input check -- business as usual. \item The second one defines the effect of a movement of the slider in form of an \emph{action function} although the slider hasn't been defined yet. \item Then the function {\tt slider} is called to build the control widget and the action function is passed by the first parameter. \item At last the action function is called and a trimmed mean will be printed. \end{itemize} You see {\tt slider.trimmed.mean.simple()} mainly consists of the definition of the action function {\tt compute.trimmed.mean()} and a call of {\tt slider()}. {\tt compute.trimmed.mean()} fulfills two tasks: fetching the actual value of the slider variable (trim fraction {\tt alpha}) and printing the trimmed mean. {\tt slider(no=1)} reads the value of slider number {\tt "no=1"} and then the value is assigned to the local variable {\tt alpha}. The computation of the trimmed mean by {\tt mean()} and its printing follows. \subsubsection{The main arguments of {\tt slider}} A slider of a slider control widget is declared by six parameters. The meaning of them is found in following list. \begin{enumerate} \item {\tt sl.functions}: an effect function which is called after moving the slider \item {\tt sl.names}: a text for labeling the slider \item {\tt sl.mins}: the minimum of the range of the slider \item {\tt sl.maxs}: the maximum of the range of the slider \item {\tt sl.deltas}: the increment of the scale of the slider \item {\tt sl.defaults}: the default value of the slider \end{enumerate} These parameters are arguments of the function {\tt slider}. The following example has the same structure as {\tt slider.trimmed.mean.simple()}. However, the action function computes a plot and in the call of {\tt slider()} the names of the formal parameters are used. \makemarginno $\langle${\it define {\tt slider.trimmed.mean}}\ $11\rangle+\equiv$ \label{CodeChunkLabelAABC} \rule{0mm}{0mm}\newline\verb? slider.trimmed.mean<-function(x) ?% \rule{0mm}{0mm}\newline\verb? { ?% \rule{0mm}{0mm}\newline\verb? # general initialisations ?% \rule{0mm}{0mm}\newline\verb? if(missing(x)) return("Error: no data found!") ?% \rule{0mm}{0mm}\newline\verb? # function to update plot ?% \rule{0mm}{0mm}\newline\verb? refresh<-function(...){ ?% \rule{0mm}{0mm}\newline\verb? # get slider ?% \rule{0mm}{0mm}\newline\verb? alpha <- slider(no=1) ?% \rule{0mm}{0mm}\newline\verb? # compute mean ?% \rule{0mm}{0mm}\newline\verb? tm <- mean(x,trim=alpha); m <- mean(x) ?% \rule{0mm}{0mm}\newline\verb? # construct plot ?% \rule{0mm}{0mm}\newline\verb? plot(as.data.frame(x)) ?% \rule{0mm}{0mm}\newline\verb? abline(v=tm,col="red") ?% \rule{0mm}{0mm}\newline\verb? text(tm,1.1,adj=1,"trimmed mean",col="red") ?% \rule{0mm}{0mm}\newline\verb? abline(v=m,col="black") ?% \rule{0mm}{0mm}\newline\verb? text( m,0.9,adj=0,"mean") ?% \rule{0mm}{0mm}\newline\verb? title(paste("trimmed mean:", format(tm,signif=4), ?% \rule{0mm}{0mm}\newline\verb? "\ntrim fraction:",round(alpha*100),"%")) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? # definition of slider widget ?% \rule{0mm}{0mm}\newline\verb? slider(sl.functions=refresh, ?% \rule{0mm}{0mm}\newline\verb? sl.names= "trim fraction", ?% \rule{0mm}{0mm}\newline\verb? sl.mins= 0, ?% \rule{0mm}{0mm}\newline\verb? sl.maxs= 0.5, ?% \rule{0mm}{0mm}\newline\verb? sl.deltas= 0.01, ?% \rule{0mm}{0mm}\newline\verb? sl.defaults= 0 ?% \rule{0mm}{0mm}\newline\verb? ) ?% \rule{0mm}{0mm}\newline\verb? # initial plot ?% \rule{0mm}{0mm}\newline\verb? refresh() ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? slider.trimmed.mean(rivers[1:50]) ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \begin{center}\includegraphics[height=6cm]{p152540-Sep-2}\end{center} %

\ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi It may be astonishing that the argument names are in plural form. This indicates that more than one slider can be defined in the same way. The following section will show you an example with two sliders. \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsubsection{Buttons and slider variables} The next version of the running example --- {\tt slider.trimmed.mean.plus()} --- demonstrates how two sliders are implemented. To keeps things simple a second slider is defined. It allows the user to change the color of the plot. In addition three \emph{buttons} are generated to switch between three graphical representations of the data: dotplot, histogram or boxplot. The code is a little bit longer. However, we are shure that it isn't very difficult to understand it. \makemarginno $\langle${\it define {\tt slider.trimmed.mean}}\ $11\rangle+\equiv$ \label{CodeChunkLabelAABD} \rule{0mm}{0mm}\newline\verb? slider.trimmed.mean.plus<-function(x) ?% \rule{0mm}{0mm}\newline\verb? { ?% \rule{0mm}{0mm}\newline\verb? # general initialisations ?% \rule{0mm}{0mm}\newline\verb? if(missing(x)) return("Error: no data found!") ?% \rule{0mm}{0mm}\newline\verb? slider(obj.name="ptype",obj.value="hist") ?% \rule{0mm}{0mm}\newline\verb? # function to update plot ?% \rule{0mm}{0mm}\newline\verb? refresh<-function(...){ ?% \rule{0mm}{0mm}\newline\verb? # get settings ?% \rule{0mm}{0mm}\newline\verb? alpha <- slider(no=1) ?% \rule{0mm}{0mm}\newline\verb? mycol <- slider(no=2) ?% \rule{0mm}{0mm}\newline\verb? ptype <- slider(obj.name="ptype") ?% \rule{0mm}{0mm}\newline\verb? # computation ?% \rule{0mm}{0mm}\newline\verb? tm <- mean(x,trim=alpha); m <- mean(x) ?% \rule{0mm}{0mm}\newline\verb? # construct high level plot ?% \rule{0mm}{0mm}\newline\verb? if(ptype=="dotplot") plot(as.data.frame(x),col=mycol) ?% \rule{0mm}{0mm}\newline\verb? if(ptype=="hist") hist(x,col=mycol) ?% \rule{0mm}{0mm}\newline\verb? if(ptype=="boxplot") boxplot(x,col=mycol,horizontal=TRUE) ?% \rule{0mm}{0mm}\newline\verb? # perform some lower level jobs ?% \rule{0mm}{0mm}\newline\verb? abline(v=tm,col="red") ?% \rule{0mm}{0mm}\newline\verb? text(tm,1.1,adj=1,"trimmed mean",col="red") ?% \rule{0mm}{0mm}\newline\verb? abline(v=m,col="black") ?% \rule{0mm}{0mm}\newline\verb? text( m,0.9,adj=0,"mean") ?% \rule{0mm}{0mm}\newline\verb? title(paste("trimmed mean:", format(tm,signif=4), ?% \rule{0mm}{0mm}\newline\verb? "\ntrim fraction:",round(alpha*100),"%")) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? # three functions to react on buttons ?% \rule{0mm}{0mm}\newline\verb? b1<-function(...){slider(obj.name="ptype",obj.value="dotplot");refresh()} ?% \rule{0mm}{0mm}\newline\verb? b2<-function(...){slider(obj.name="ptype",obj.value="hist"); refresh()} ?% \rule{0mm}{0mm}\newline\verb? b3<-function(...){slider(obj.name="ptype",obj.value="boxplot");refresh()} ?% \rule{0mm}{0mm}\newline\verb? # definition of slider widget ?% \rule{0mm}{0mm}\newline\verb? slider(sl.functions= refresh, ?% \rule{0mm}{0mm}\newline\verb? sl.names= c("trim fraction","color"), ?% \rule{0mm}{0mm}\newline\verb? sl.mins= c(0,1), ?% \rule{0mm}{0mm}\newline\verb? sl.maxs= c(0.5,13), ?% \rule{0mm}{0mm}\newline\verb? sl.deltas= c(0.01,1), ?% \rule{0mm}{0mm}\newline\verb? sl.defaults= c(0,1), ?% \rule{0mm}{0mm}\newline\verb? but.functions=c(b1,b2,b3), ?% \rule{0mm}{0mm}\newline\verb? but.names= c("dotplot","histogram","boxplot") ?% \rule{0mm}{0mm}\newline\verb? ) ?% \rule{0mm}{0mm}\newline\verb? # initial plot ?% \rule{0mm}{0mm}\newline\verb? refresh() ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? slider.trimmed.mean.plus(rivers[1:50]) ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \begin{center}\includegraphics[height=6cm]{p152654-Sep-2} \showwidget{slidertrimhistwidget} \end{center} % check %

\ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi In this example vectors of length two are assigned to the arguments {\tt sl.names}, {\tt sl.mins}, {\tt sl.maxs}, {\tt sl.deltas}, and {\tt sl.defaults}. The first elements of the vectors describe the settings of the first slider whereas the second ones fix the parameters of the other slider. The buttons are implemented by a vector of threee names ({\tt but.names}) and by a vector of three effect functions ({\tt but.functions}). To handle the state of the selected plot type a slider variable ({\tt ptype}) is created. During updating the plot the actual value of {\tt ptype} is found by the statement {\tt slider(obj.name="ptype")}. After changing {\tt ptype} it is stored by statements like {\tt slider(obj.name="ptype",\ obj.value="dotplot")}. In this example the effect functions of the buttons only consist of a statement to store the plot type and to update the plot by calling the effect function {\tt refresh()}. In summary there is a simple structure for implementing sliders and buttons. Slider variables can be used to communicate states, values and other information. \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsection{General Rules} In the last section the reader learned the syntax of the function {\tt slider} and he will be able to write slider function of his own. To achieve a similar structure of the slider functions introduced in this paper we propose some general rules now. \subsubsection{Names of the slider functions} The names of the slider functions of this paper always start with the character string {\tt "slider"} and end with a string indicating the job to be done, e.g. a statistical procedure or function like {\tt hist}, {\tt pairs} or {\tt smooth}. \subsubsection{Formal arguments for data sets} One dimensional data sets are passed to a {\tt slider*} function by the argument {\tt x}. If the data set is of two dimensions there are two types of calls: Either argument {\tt x} is a matrix or a data frame with two columns or the argruments {\tt x} and {\tt y} are used for the first and the second variable. If {\tt x} is a vector and {\tt y} not available then {\tt x} is used as the second dimension and {\tt seq(x)} as the first one. Three dimensional data sets are managed in an analogous way: A $(n\times3)$-matrix has to be assigned to {\tt x} or the arguments {\tt x}, {\tt y} and {\tt z} must be used. These rules enable us to write some general statements for checking and for preparation of some local variables containing the data. \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi Checking the one dimensional case is simple. Besides {\tt x.name} stores how the {\tt x} argument has been assigned by the user. \makemarginno $\langle${\it check if {\tt x} is a vector}\ $14\rangle\equiv$ {\quad$\subset$ 31, 34, 38, 66 } \label{CodeChunkLabelAABE} \rule{0mm}{0mm}\newline\verb? x.name<-deparse(substitute(x)) ?% \rule{0mm}{0mm}\newline\verb? if(missing(x)||length(x)<2) return("Error: x must be a vector") ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi To check a two dimensional data input the two cases described above has to be handled. After checking the data are assigned to two local variables {\tt x} and {\tt y}. \makemarginno $\langle${\it check if {\tt x} is a matrix or {\tt x} and {\tt y} are vectors}\ $15\rangle\equiv$ {\quad$\subset$ 53, 56 } \label{CodeChunkLabelAABF} \rule{0mm}{0mm}\newline\verb? x.name<-deparse(substitute(x)) ?% \rule{0mm}{0mm}\newline\verb? y.name<-deparse(substitute(y)) ?% \rule{0mm}{0mm}\newline\verb? if(length(x)<2) return("Error: x is of length 0 or 1") ?% \rule{0mm}{0mm}\newline\verb? if(!is.null(y)){ ?% \rule{0mm}{0mm}\newline\verb? if(length(y)<2) return("Error: y must be a vector") ?% \rule{0mm}{0mm}\newline\verb? if(length(x)!=length(y)) ?% \rule{0mm}{0mm}\newline\verb? return("Error: x and y must have the same length") ?% \rule{0mm}{0mm}\newline\verb? x<-cbind(x,y) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? if(!is.matrix(x) && !is.data.frame(x)){ ?% \rule{0mm}{0mm}\newline\verb? x<-cbind(seq(x),x) ?% \rule{0mm}{0mm}\newline\verb? y.name<-x.name; x.name<-"index" ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? if(is.null(y.name)){x.name<-colnames(x)[1]; y.name<-colnames(x)[2]} ?% \rule{0mm}{0mm}\newline\verb? y<-x[,2]; x<-x[,1] ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi In the case of three dimensions the arguments {\tt y} and {\tt z} are dealt like {\tt y} in the two dimensional case. \makemarginno $\langle${\it check if {\tt x,\ y,z} are vectors or {\tt x} is matrix with >2 columns}\ $16\rangle\equiv$ {\quad$\subset$ 40 } \label{CodeChunkLabelAABG} \rule{0mm}{0mm}\newline\verb? x.name<-deparse(substitute(x)) ?% \rule{0mm}{0mm}\newline\verb? y.name<-deparse(substitute(y)) ?% \rule{0mm}{0mm}\newline\verb? z.name<-deparse(substitute(z)) ?% \rule{0mm}{0mm}\newline\verb? if(length(x)<2) return("Error: x is of length 0 or 1") ?% \rule{0mm}{0mm}\newline\verb? if(!is.null(y)){ ?% \rule{0mm}{0mm}\newline\verb? if(length(y)<2) return("Error: y must be a vector") ?% \rule{0mm}{0mm}\newline\verb? if(length(x)!=length(y)) ?% \rule{0mm}{0mm}\newline\verb? return("Error: x and y must have the same length") ?% \rule{0mm}{0mm}\newline\verb? x<-cbind(x,y) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? if(!is.null(z)){ ?% \rule{0mm}{0mm}\newline\verb? if(length(z)<2) return("Error: z must be a vector") ?% \rule{0mm}{0mm}\newline\verb? if(length(x)!=length(z)) ?% \rule{0mm}{0mm}\newline\verb? return("Error: x and z must have the same length") ?% \rule{0mm}{0mm}\newline\verb? x<-cbind(x,z) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? if(!is.matrix(x)&& !is.data.frame(x) && ncol(x)<3) ?% \rule{0mm}{0mm}\newline\verb? return("Error: not enough variables") ?% \rule{0mm}{0mm}\newline\verb? if("NULL"==y.name){x.name<-colnames(x)[1]; y.name<-colnames(x)[2]} ?% \rule{0mm}{0mm}\newline\verb? if("NULL"==z.name){x.name<-colnames(x)[1]; z.name<-colnames(x)[3]} ?% \rule{0mm}{0mm}\newline\verb? z<-x[,3]; y<-x[,2]; x<-x[,1] ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi Time series are different from a one dimensional data set because data points are connected with times. Therefore, we need a code chunk for checking time series. \makemarginno $\langle${\it check if {\tt x} is a time series}\ $17\rangle\equiv$ {\quad$\subset$ 43, 46, 50 } \label{CodeChunkLabelAABH} \rule{0mm}{0mm}\newline\verb? x.name<-deparse(substitute(x)) ?% \rule{0mm}{0mm}\newline\verb? if(missing(x)||length(x)<2) return("Error: x must be a vector") ?% \rule{0mm}{0mm}\newline\verb? y<-x; if(is.ts(x)) { x<-time(x) } else { x<-seq(x) } ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsubsection{Passing additional arguments} Remark: This section should be skipped during the first reading of the text! You know that high level plotting function have the formal parameter {\tt "..."}. This argument allows the user to pass additional settings to the graphics device. At once the question arises: Can we manage to pass such arguments to plotting functions that are called by a slider function? For example: a histogram is computed in the {\tt refresh} function and the user wants to produce \emph{green} bars. There are different answers to tackle this problem. At first you can consider which of the graphics parameters are relevant to be set by the user. Then we can introduce these parameter in the header of a slider function. But the list of parameters will be very long because the user may be want to modify attributes of scale, point size, type, color, etc. A second way is to define a {\tt "..."} argument for passing additional parameters. \par\Routputcommands\begin{verbatim} slider.xyz<-function(x,...) \end{verbatim}\textchunkcommands \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi But there will be some difficulties to be managed if you use the {\tt "..."} construction. How do we handle the {\tt "..."} argument, how do we set default values for some parameter and how can we remove parameters that must not be changed at all? In the initialization part of the {\tt slider.*} functions it is possible to modify the list of the additional arguments. To demonstrate this step we show how you can remove a {\tt breaks} argument and then append a {\tt "main"} argument. If {\tt main} is not available it is set to {\tt x.name} . (Cleary there is no graphics parameter with name {\tt breaks} but users used to set breaks in their calls of {\tt hist} may try to deliver a {\tt breaks} argument.) \makemarginno $\langle${\it modification of the {\tt "..."} argument, not for evaluation}\ $18\rangle\equiv$ \label{CodeChunkLabelAABI} \rule{0mm}{0mm}\newline\verb? args<-list(...) ?% \rule{0mm}{0mm}\newline\verb? args<-args[names(args)!="breaks"] # remove "breaks" ?% \rule{0mm}{0mm}\newline\verb? if(!any("main"==names(args))) # set default "main" ?% \rule{0mm}{0mm}\newline\verb? args<-c(args,list(main=x.name)) ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi Now the argument list {\tt args} has to be passed to the function {\tt hist} within the action or refresh function. Writing {\tt hist(x,args)} doesn't work because the second argument of {\tt hist} is the {\tt break} argument and not a slot for further arguments. The second idea will be to use the {\tt "..."} of {\tt hist}: {\tt hist(x,...=args)}. But the {\tt "..."} argument of {\tt hist} is passed to the functions {\tt title} and {\tt axis} and so we don't get green bars at all. Our answer to this problem is to describe the call by its elements: the function {\tt hist} should be called with the argument list consisting of the additional arguments stored in {\tt args} and other arguments specifying the data set and the breaks, for example. Then the function {\tt do.call} is called with theses elements. Keep in mind that {\tt do.call} needs the arguments as an {\tt alist}. To summarize the following construction will work and is used in the function {\tt slider.hist}: \makemarginno $\langle${\it some details of a slider function, not for evaluation}\ $19\rangle\equiv$ \label{CodeChunkLabelAABJ} \rule{0mm}{0mm}\newline\verb? slider.xyz<-function(x,...) ?% \rule{0mm}{0mm}\newline\verb? { ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it initialisation statements} NA$\rangle$% \rule{0mm}{0mm}\newline\verb? args<-list(...) ?% \rule{0mm}{0mm}\newline\verb? args<-args[names(args)!="breaks"] # remove "breaks" ?% \rule{0mm}{0mm}\newline\verb? if(!any("main"==names(args))) # set default "main" ?% \rule{0mm}{0mm}\newline\verb? args<-c(args,list(main=x.name)) ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it more initialisation statements} NA$\rangle$% \rule{0mm}{0mm}\newline\verb? refresh<-function(...){ ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it some computations for the refresh task} NA$\rangle$% \rule{0mm}{0mm}\newline\verb? do.call("hist",c(alist(x=x,breaks=breaks),args)) ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it further refreshing statements} NA$\rangle$% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it tail of function slider.xyz} NA$\rangle$% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi Before we close this section we will present a further proposal to deal with the arguments. In the game there are four sets of information: \begin{itemize} \item the set of default settings coded in the slider function \item the set of additional parameters defined by the user \item the set of forbidden arguments that must not be used \item the set of important settings that must not be changed by the user \end{itemize} We can save these sets on suitable list objects: \makemarginno $\langle${\it *}\ $20\rangle\equiv$ \label{CodeChunkLabelAACA} \rule{0mm}{0mm}\newline\verb? # defaults (these are allowed to be changed by users) ?% \rule{0mm}{0mm}\newline\verb? defaults<-list(main=x.name) ?% \rule{0mm}{0mm}\newline\verb? # graphics parameter of the user ?% \rule{0mm}{0mm}\newline\verb? args<-list(...) ?% \rule{0mm}{0mm}\newline\verb? # forbidden (these must not be passed to a slider function) ?% \rule{0mm}{0mm}\newline\verb? set.of.forbidden.args<-list(probability=TRUE) ?% \rule{0mm}{0mm}\newline\verb? # important (these are passed and must not to be changed by users) ?% \rule{0mm}{0mm}\newline\verb? important<-alist(bty="n",sub="graphics computed by slider") ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi Now the sets have to be combined. At first we remove the forbidden elements from the argument list of the user. Then we concatenate the important ones, the user arguments and the default settings. Finally, we remove elements whose names occur on the list earlier. \makemarginno $\langle${\it *}\ $20\rangle+\equiv$ \label{CodeChunkLabelAACB} \rule{0mm}{0mm}\newline\verb? # remove not allowed ?% \rule{0mm}{0mm}\newline\verb? args<-args[!names(args) %in% set.of.forbidden.args] ?% \rule{0mm}{0mm}\newline\verb? # set of all parameters ?% \rule{0mm}{0mm}\newline\verb? defaults<-c(important,args,defaults) ?% \rule{0mm}{0mm}\newline\verb? # removing of double ones ?% \rule{0mm}{0mm}\newline\verb? args<-defaults[unique(names(defaults))] ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi The refresh function has a very simple structure now. \makemarginno $\langle${\it *}\ $20\rangle+\equiv$ \label{CodeChunkLabelAACC} \rule{0mm}{0mm}\newline\verb? refresh<-function(...){ ?% \rule{0mm}{0mm}\newline\verb? xrange<-range(x); num<-slider(no=1) ?% \rule{0mm}{0mm}\newline\verb? breaks<-seq(xrange[1],xrange[2],length=num+1) ?% \rule{0mm}{0mm}\newline\verb? do.call("hist",c(alist(x=x,breaks=breaks),args )) ?% \rule{0mm}{0mm}\newline\verb? panel(x) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi In the following we have not implemented these ideas completely. Sometimes we pass {\tt ...} arguments without further checks. \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsection{Density Presenter} In this paragraph we discuss some tools for plotting densities of distributions. The parameters of the distribution are controlled by sliders. These functions allow the user to study how the shapes of the densities depend on the parameter settings. It is a very easy exercise to find an implementation for a special distribution, e.g., the normal distribution. \makemarginno $\langle${\it define {\tt slider.show.normal.density}}\ $23\rangle\equiv$ {\quad$\subset$ 24, 30 } \label{CodeChunkLabelAACD} \rule{0mm}{0mm}\newline\verb? slider.show.normal.density<-function(name,...) ?% \rule{0mm}{0mm}\newline\verb? { ?% \rule{0mm}{0mm}\newline\verb? x<-seq(-10,10,length=200) ?% \rule{0mm}{0mm}\newline\verb? args<-list(...) ?% \rule{0mm}{0mm}\newline\verb? refresh<-function(...){ ?% \rule{0mm}{0mm}\newline\verb? par1<-slider(no=1); par2<-slider(no=2) ?% \rule{0mm}{0mm}\newline\verb? f.x<-dnorm(x,par1,par2) ?% \rule{0mm}{0mm}\newline\verb? main=paste("normal distribution\n", ?% \rule{0mm}{0mm}\newline\verb? "E(X) =",format(par1,digits=3), ?% \rule{0mm}{0mm}\newline\verb? ", sd(X) =",format(par2,digits=3)) ?% \rule{0mm}{0mm}\newline\verb? # plot(x,f.x,type="l",main=main) ?% \rule{0mm}{0mm}\newline\verb? do.call("plot",c(alist(x=x,y=f.x,type="l",main=main),args)) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? slider(refresh, ?% \rule{0mm}{0mm}\newline\verb? c("expectation","standard deviation"), ?% \rule{0mm}{0mm}\newline\verb? c(-20,.001),c(20,20),c(.1,.1),c(0.1,1) ?% \rule{0mm}{0mm}\newline\verb? ) ?% \rule{0mm}{0mm}\newline\verb? refresh() ?% \rule{0mm}{0mm}\newline\verb? cat("use slider to select parameters!\n") ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi Here comes a check. \makemarginno $\langle${\it *}\ $20\rangle+\equiv$ \label{CodeChunkLabelAACE} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.show.normal.density}} 23$\rangle$% \rule{0mm}{0mm}\newline\verb? slider.show.normal.density(col="red",bty="n") ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi A more interesting idea is to write a function that operates as a general presenter. The function {\tt slider.show.density()} shows the shapes of the densities of various distributions. After the user has collected some experiences she or he will like to write a improved version. Before you start programming your own presenter analyze the following function: \makemarginno $\langle${\it define {\tt slider.show.density}}\ $25\rangle\equiv$ {\quad$\subset$ 30 } \label{CodeChunkLabelAACF} \rule{0mm}{0mm}\newline\verb? slider.show.density<-function( ?% \rule{0mm}{0mm}\newline\verb? distribution="norm", ?% \rule{0mm}{0mm}\newline\verb? mins=c(-100,-100,-50,.001), ?% \rule{0mm}{0mm}\newline\verb? maxs=c(100,100,50,100), ?% \rule{0mm}{0mm}\newline\verb? deltas=c(1,1,.1,.1), ?% \rule{0mm}{0mm}\newline\verb? defaults=c(-5,5,0,1),type="l",...) ?% \rule{0mm}{0mm}\newline\verb? { ?% \rule{0mm}{0mm}\newline\verb? args<-list(...) ?% \rule{0mm}{0mm}\newline\verb? refresh<-function(...){ ?% \rule{0mm}{0mm}\newline\verb? lim1<-slider(no=1); lim2<-slider(no=2) ?% \rule{0mm}{0mm}\newline\verb? par1<-slider(no=3); par2<-slider(no=4) ?% \rule{0mm}{0mm}\newline\verb? x<-seq(min(lim1,lim2),max(lim1,lim2),length=200) ?% \rule{0mm}{0mm}\newline\verb? ddist<-paste("d",distribution,sep="") ?% \rule{0mm}{0mm}\newline\verb? f.x<-do.call(ddist,alist(x=x,par1,par2)) ?% \rule{0mm}{0mm}\newline\verb? main=paste("distribution:",distribution,"\n", ?% \rule{0mm}{0mm}\newline\verb? "parameter 1: ",format(par1,digits=3), ?% \rule{0mm}{0mm}\newline\verb? ", parameter 2: =",format(par2,digits=3)) ?% \rule{0mm}{0mm}\newline\verb? # plot(x,f.x,type=type,main=main) ?% \rule{0mm}{0mm}\newline\verb? do.call("plot",c(alist(x=x,y=f.x,type=type,main=main),args)) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? slider(refresh, ?% \rule{0mm}{0mm}\newline\verb? c("x limit (min)","x limit (max)", ?% \rule{0mm}{0mm}\newline\verb? "parameter 1","parameter 2")[1:length(mins)], ?% \rule{0mm}{0mm}\newline\verb? mins,maxs,deltas,defaults) ?% \rule{0mm}{0mm}\newline\verb? refresh() ?% \rule{0mm}{0mm}\newline\verb? cat("use sliders to select parameters!\n") ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi Here are a few examples to show that the idea works: \begin{itemize} \item gamma distribution \makemarginno $\langle${\it show the density of the gamma distribution}\ $26\rangle\equiv$ {\quad$\subset$ 30 } \label{CodeChunkLabelAACG} \rule{0mm}{0mm}\newline\verb? slider.show.density("gamma",mins=c(0,0,.01,.01), ?% \rule{0mm}{0mm}\newline\verb? maxs=c(100,100,50,50), ?% \rule{0mm}{0mm}\newline\verb? deltas=c(.1,.1,.01,.01), ?% \rule{0mm}{0mm}\newline\verb? defaults=c(0,10,4,1), bty="n") ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \item beta distribution \makemarginno $\langle${\it show the density of the beta distribution}\ $27\rangle\equiv$ {\quad$\subset$ 30 } \label{CodeChunkLabelAACH} \rule{0mm}{0mm}\newline\verb? slider.show.density("beta",mins=c(0,0,0,0), ?% \rule{0mm}{0mm}\newline\verb? maxs=c(1,1,10,10), ?% \rule{0mm}{0mm}\newline\verb? deltas=c(.1,.1,.01,.01), ?% \rule{0mm}{0mm}\newline\verb? defaults=c(0,1,1,1),col="blue") ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \item binomial distribution \makemarginno $\langle${\it show the density of the binomial distribution}\ $28\rangle\equiv$ {\quad$\subset$ 30 } \label{CodeChunkLabelAACI} \rule{0mm}{0mm}\newline\verb? slider.show.density("binom",mins=c(0,0,1,0), ?% \rule{0mm}{0mm}\newline\verb? maxs=c(100,100,100,1), ?% \rule{0mm}{0mm}\newline\verb? deltas=c(1,1,1,.01), ?% \rule{0mm}{0mm}\newline\verb? defaults=c(0,20,5,0.5),type="h") ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \item Poisson distribution \makemarginno $\langle${\it show the density of the Poisson distribution}\ $29\rangle\equiv$ {\quad$\subset$ 30 } \label{CodeChunkLabelAACJ} \rule{0mm}{0mm}\newline\verb? slider.show.density("pois",mins=c(0,0,.01), ?% \rule{0mm}{0mm}\newline\verb? maxs=c(100,100,50), ?% \rule{0mm}{0mm}\newline\verb? deltas=c(1,1,.1), ?% \rule{0mm}{0mm}\newline\verb? defaults=c(0,20,5),type="h") ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \end{itemize} The different presenter functions could be collected in central function. \makemarginno $\langle${\it *}\ $20\rangle+\equiv$ \label{CodeChunkLabelAADA} \rule{0mm}{0mm}\newline\verb? slider.present.density<-function() ?% \rule{0mm}{0mm}\newline\verb? { ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.show.density}} 25$\rangle$% \rule{0mm}{0mm}\newline\verb| |\verb?f0<- ?$\langle${\it define {\tt slider.show.normal.density}} 23$\rangle$\verb? ?% \rule{0mm}{0mm}\newline\verb| |\verb?f1<- function(...){ ?$\langle${\it show the density of the gamma distribution} 26$\rangle$\verb? }?% \rule{0mm}{0mm}\newline\verb| |\verb?f2<- function(...){ ?$\langle${\it show the density of the beta distribution} 27$\rangle$\verb? }?% \rule{0mm}{0mm}\newline\verb| |\verb?f3<- function(...){ ?$\langle${\it show the density of the binomial distribution} 28$\rangle$\verb? }?% \rule{0mm}{0mm}\newline\verb| |\verb?f4<- function(...){ ?$\langle${\it show the density of the Poisson distribution} 29$\rangle$\verb? }?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? slider(but.functions=c(f0,f1,f2,f3,f4), ?% \rule{0mm}{0mm}\newline\verb? but.names=c("show NORMAL","show GAMMA","show BETA", ?% \rule{0mm}{0mm}\newline\verb? "show BINOMIAL","show POISSON")) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? slider.present.density() ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi Now the reader is prepared to take a further look at the implementations of the slider functions of this paper. \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \section{Histograms and Density Traces} \subsection{Class number of histograms -- {\tt slider.hist}} In this section we propose a function which allows you to study the effect of the number of classes on the shape of a histogram. For this purpose a widget with a slider controlling the number of classes is opened and a histogram is computed. %nstructed in the graphics device. By moving the slider the user changes the number of classes and the histogram is redrawn. The implementation uses two special features: 1.) Sometimes we want to add further graphical elements like a density curve to the histogram. For this job {\tt slider.hist} has a slot to deliver a \emph{panel} function. This panel function will be called after updating the histogram. 2.) Additional graphics parameter can be transfered by the {\tt "..."} argument of {\tt slider.hist} to the call of {\tt hist} which constructs the histogram. \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi Remarks: The default number of breaks is computed by {\tt hist}. If a {\tt breaks} argument is found in the call of {\tt slider.hist} it will be removed. \makemarginno $\langle${\it define {\tt slider.hist}}\ $31\rangle\equiv$ {\quad$\subset$ 2, 32, 33, 60 } \label{CodeChunkLabelAADB} \rule{0mm}{0mm}\newline\verb? slider.hist<-function(x,panel=rug,...) ?% \rule{0mm}{0mm}\newline\verb? { ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it check if {\tt x} is a vector} 14$\rangle$% \rule{0mm}{0mm}\newline\verb? args<-list(...) ?% \rule{0mm}{0mm}\newline\verb? args<-args[names(args)!="breaks"] ?% \rule{0mm}{0mm}\newline\verb? ClassNumber<-length(hist(x,plot=FALSE)$breaks) ?% \rule{0mm}{0mm}\newline\verb? if(!any("main"==names(args)))args<-c(args,list(main=x.name)) ?% \rule{0mm}{0mm}\newline\verb? refresh<-function(...){ ?% \rule{0mm}{0mm}\newline\verb? xrange<-range(x); num<-slider(no=1) ?% \rule{0mm}{0mm}\newline\verb? breaks<-seq(xrange[1],xrange[2],length=num+1) ?% \rule{0mm}{0mm}\newline\verb? do.call("hist",c(alist(x=x,breaks=breaks),args)) ?% \rule{0mm}{0mm}\newline\verb? panel(x) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? slider(refresh,"ClassNumber",1,100,1,ClassNumber); refresh() ?% \rule{0mm}{0mm}\newline\verb? "use slider to select number of classes" ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsubsection{Test} %In this section we will test the function just defined. Here is a check to test whether we can change the color. \makemarginno $\langle${\it check}\ $32\rangle\equiv$ \label{CodeChunkLabelAADC} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.hist}} 31$\rangle$% \rule{0mm}{0mm}\newline\verb? slider.hist(log(islands),col="green") ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi To test the panel feature we add a normal density curve to the histogram. \makemarginno $\langle${\it check}\ $32\rangle+\equiv$ \label{CodeChunkLabelAADD} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.hist}} 31$\rangle$% \rule{0mm}{0mm}\newline\verb? slider.hist(rivers,xlab="RIVERS",col="red",probability=TRUE, ?% \rule{0mm}{0mm}\newline\verb? pa=function(x){ ?% \rule{0mm}{0mm}\newline\verb? xx<-seq(min(x),max(x),length=100) ?% \rule{0mm}{0mm}\newline\verb? yy<-dnorm(xx,mean(x),sd(x)) ?% \rule{0mm}{0mm}\newline\verb? lines(xx,yy); rug(x); print(summary(yy)) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ) ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsection{Width and kernel of a density trace -- {\tt slider.density}} The main parameters of density traces are width and kernel type. In the function {\tt slider.density()} both of them are selected by sliders. The alternative idea to implement the selection of the kernel function by buttons would have required seven buttons. Therefore, a slider solution seems to be a little bit smarter. To be able to add further graphical elements a panel function has been included. Technical Remarks: 1.) The kernel type is stored in the slider variable {\tt kno}. 2.) In {\tt slider.density()} we have two different effect functions where the second one {\tt set.kernel()} calls the first slider function ({\tt refresh()}). \makemarginno $\langle${\it define {\tt slider.density}}\ $34\rangle\equiv$ {\quad$\subset$ 3, 35, 36, 60 } \label{CodeChunkLabelAADE} \rule{0mm}{0mm}\newline\verb? slider.density<-function(x,panel=rug,...) ?% \rule{0mm}{0mm}\newline\verb? { ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it check if {\tt x} is a vector} 14$\rangle$% \rule{0mm}{0mm}\newline\verb? args<-list(...) ?% \rule{0mm}{0mm}\newline\verb? if(!any("main"==names(args))) args<-c(args,list(main=x.name)) ?% \rule{0mm}{0mm}\newline\verb? kernel<-c("gaussian", "epanechnikov","rectangular", ?% \rule{0mm}{0mm}\newline\verb? "triangular","biweight", "cosine", "optcosine") ?% \rule{0mm}{0mm}\newline\verb? slider(obj.name="kno",obj.value=1) ?% \rule{0mm}{0mm}\newline\verb? refresh<-function(...){ ?% \rule{0mm}{0mm}\newline\verb? width<-slider(no=1)*diff(range(x))/100 ?% \rule{0mm}{0mm}\newline\verb? kno<-slider(obj.name="kno"); kernel<-kernel[kno] ?% \rule{0mm}{0mm}\newline\verb? xy<-density(x,width=width,kernel=kernel) ?% \rule{0mm}{0mm}\newline\verb? do.call("plot",c(alist(x=xy),args)) ?% \rule{0mm}{0mm}\newline\verb? title(paste("\n\nwidth =",signif(width,4),", kernel =",kernel)) ?% \rule{0mm}{0mm}\newline\verb? panel(x) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? set.kernel<-function(...){ ?% \rule{0mm}{0mm}\newline\verb? kernel<-slider(no=2) ?% \rule{0mm}{0mm}\newline\verb? slider(obj.name="kno",obj.value=kernel) ?% \rule{0mm}{0mm}\newline\verb? refresh() ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? bw.default<-diff(range(x))/density(x)$bw ?% \rule{0mm}{0mm}\newline\verb? nt <- slider(c(refresh,set.kernel), ?% \rule{0mm}{0mm}\newline\verb? c("width (% of range)","kernel"), ?% \rule{0mm}{0mm}\newline\verb? c(.1,1),c(100,7),c(.1,1),c(bw.default,1) ?% \rule{0mm}{0mm}\newline\verb? ) ?% \rule{0mm}{0mm}\newline\verb? # tkwm.minsize(nt, "300", "110") # set width, height to prevent to small sizes ?% \rule{0mm}{0mm}\newline\verb? refresh() ?% \rule{0mm}{0mm}\newline\verb? cat("use slider to select width of window and to select kernel:\n") ?% \rule{0mm}{0mm}\newline\verb? print(cbind("no"=1:7,"kernel"=kernel)) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsubsection{Test} At first we test {\tt slider.density} without a panel function. \makemarginno $\langle${\it check of {\tt slider.density}}\ $35\rangle\equiv$ \label{CodeChunkLabelAADF} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.density}} 34$\rangle$% \rule{0mm}{0mm}\newline\verb? slider.density(rivers,xlab="RIVERS",col="red") ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi Now we test a call of {\tt slider.density} with a panel function to plot a fitted normal density curve. \makemarginno $\langle${\it check of {\tt slider.density}}\ $35\rangle+\equiv$ \label{CodeChunkLabelAADG} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.density}} 34$\rangle$% \rule{0mm}{0mm}\newline\verb? slider.density(log(rivers),xlab="rivers",col="red", ?% \rule{0mm}{0mm}\newline\verb? panel=function(x){ ?% \rule{0mm}{0mm}\newline\verb? xx<-seq(min(x),max(x),length=100) ?% \rule{0mm}{0mm}\newline\verb? yy<-dnorm(xx,mean(x),sd(x)) ?% \rule{0mm}{0mm}\newline\verb? lines(xx,yy); rug(x); print(summary(yy)) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ) ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsubsection{Help Page} %% {\tt prompt(slider.hist)} \makemarginno $\langle${\it define help of {\tt slider.hist}}\ $37\rangle\equiv$ \label{CodeChunkLabelAADH} \rule{0mm}{0mm}\newline\verb? \name{slider.hist} ?% \rule{0mm}{0mm}\newline\verb? \title{interactive histogram and density traces} ?% \rule{0mm}{0mm}\newline\verb? \alias{slider.hist} ?% \rule{0mm}{0mm}\newline\verb? \alias{slider.density} ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? \description{ ?% \rule{0mm}{0mm}\newline\verb? The functions \code{slider.hist} and \code{slider.density} ?% \rule{0mm}{0mm}\newline\verb? compute histograms and density traces ?% \rule{0mm}{0mm}\newline\verb? whereas some parameter are controlled by sliders. ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? \code{slider.hist} computes a histogram; the number of classes is ?% \rule{0mm}{0mm}\newline\verb? defined by a slider. ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? \code{slider.density} computes a density trace; width and ?% \rule{0mm}{0mm}\newline\verb? type of the kernel are defined by sliders. ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \usage{ ?% \rule{0mm}{0mm}\newline\verb? slider.hist(x, panel, ...) ?% \rule{0mm}{0mm}\newline\verb? slider.density(x, panel, ...) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \arguments{ ?% \rule{0mm}{0mm}\newline\verb? \item{x}{ data set to be used for plotting } ?% \rule{0mm}{0mm}\newline\verb? \item{panel}{ function constructing additional graphical elements to the plot} ?% \rule{0mm}{0mm}\newline\verb? \item{\dots}{ additional (graphics) parameters which are passed to ?% \rule{0mm}{0mm}\newline\verb? the invoked high level plotting function } ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \details{ ?% \rule{0mm}{0mm}\newline\verb? \code{slider.hist} draws a histogram of the data set \code{x} by ?% \rule{0mm}{0mm}\newline\verb? calling \code{hist} and opens a Tcl/Tk widget with one slider. ?% \rule{0mm}{0mm}\newline\verb? The slider defines the number of classes of the histogram. Changing the ?% \rule{0mm}{0mm}\newline\verb? slider results in redrawing of the plot. For further ?% \rule{0mm}{0mm}\newline\verb? details see the help page of \code{hist}. \code{rug} is used as the ?% \rule{0mm}{0mm}\newline\verb? default panel function. ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? \code{slider.density} draws a density trace of the data set \code{x} ?% \rule{0mm}{0mm}\newline\verb? by \code{plot(density(...))} and opens a Tcl/Tk-widget with two ?% \rule{0mm}{0mm}\newline\verb? sliders. The first slider defines the width of the density trace ?% \rule{0mm}{0mm}\newline\verb? and the second one the kernel function: ?% \rule{0mm}{0mm}\newline\verb? \code{"1-gaussian", "2-epanechnikov", "3-rectangular", ?% \rule{0mm}{0mm}\newline\verb? "4-triangular","5-biweight", "6-cosine", "7-optcosine"} ?% \rule{0mm}{0mm}\newline\verb? Changing one of the sliders results in a redrawing of the plot. ?% \rule{0mm}{0mm}\newline\verb? For further details see the help page of \code{density}. ?% \rule{0mm}{0mm}\newline\verb? \code{rug} is used as the default panel function. ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \value{ ?% \rule{0mm}{0mm}\newline\verb? a message about the usage ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \references{ ~~ } ?% \rule{0mm}{0mm}\newline\verb? \author{ Hans Peter Wolf } ?% \rule{0mm}{0mm}\newline\verb? \seealso{ \code{\link{hist}}, \code{slider}} ?% \rule{0mm}{0mm}\newline\verb? \examples{ ?% \rule{0mm}{0mm}\newline\verb? \dontrun{ ?% \rule{0mm}{0mm}\newline\verb? ## This example cannot be run by examples() but should be work in an interactive R session ?% \rule{0mm}{0mm}\newline\verb? slider.hist(log(islands)) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \dontrun{ ?% \rule{0mm}{0mm}\newline\verb? ## This example cannot be run by examples() but should be work in an interactive R session ?% \rule{0mm}{0mm}\newline\verb? slider.density(rivers,xlab="rivers",col="red") ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \dontrun{ ?% \rule{0mm}{0mm}\newline\verb? ## This example cannot be run by examples() but should be work in an interactive R session ?% \rule{0mm}{0mm}\newline\verb? slider.density(log(rivers),xlab="rivers",col="red", ?% \rule{0mm}{0mm}\newline\verb? panel=function(x){ ?% \rule{0mm}{0mm}\newline\verb? xx<-seq(min(x),max(x),length=100) ?% \rule{0mm}{0mm}\newline\verb? yy<-dnorm(xx,mean(x),sd(x)) ?% \rule{0mm}{0mm}\newline\verb? lines(xx,yy) ?% \rule{0mm}{0mm}\newline\verb? rug(x) ?% \rule{0mm}{0mm}\newline\verb? print(summary(yy)) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \keyword{ univar } ?% \rule{0mm}{0mm}\newline\verb? \keyword{ iplot } ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \section{Brushing Functions} % see also tkBrush in: The TeachingDemos (Greg Snow) \subsection{A draftsman's display with Brushing -- {\tt slider.brush.pairs}} A draftsman's display is a nice graphics to show two dimensional dependencies of the variables of a multivariate data set. Brushing allows you to mark a subset of the data points. The subset of the points is defined by the condition that the coordinate of a selected variable has to lie within a fixed interval. By the function {\tt slider.brush.pairs()} the user can select a variable (dimension) as well as an interval for recoloring the points satisfying a condition with color {\tt "red"}. The function {\tt pairs()} is not used in the refresh function avoiding computational overhead. So the complexity of code is mostly caused by constructing the plot. \makemarginno $\langle${\it define {\tt slider.brush.pairs}}\ $38\rangle\equiv$ {\quad$\subset$ 4, 39, 60 } \label{CodeChunkLabelAADI} \rule{0mm}{0mm}\newline\verb? slider.brush.pairs<-function(x,...) ?% \rule{0mm}{0mm}\newline\verb? { ?% \rule{0mm}{0mm}\newline\verb? args<-list(...) ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it check if {\tt x} is a vector} 14$\rangle$% \rule{0mm}{0mm}\newline\verb? # preparation of data ?% \rule{0mm}{0mm}\newline\verb? m<-dim(x)[2]; for(j in 1:m) x[,j]<-as.numeric(x[,j]) ?% \rule{0mm}{0mm}\newline\verb? mins<-apply(x,2,min); maxs<-apply(x,2,max) ?% \rule{0mm}{0mm}\newline\verb? delta<-(maxs-mins)/100 ?% \rule{0mm}{0mm}\newline\verb? # initial plot ?% \rule{0mm}{0mm}\newline\verb? varnames<-paste("var ",1:m,": ",colnames(x),sep="") ?% \rule{0mm}{0mm}\newline\verb? dev.new(); par(mfrow=c(m,m),oma=c(0,0,0,0),mai=c(0,0,0,0),...) ?% \rule{0mm}{0mm}\newline\verb? usr.array<-array(0,c(m,m,4)); axes<-FALSE ?% \rule{0mm}{0mm}\newline\verb? for(i in 1:m){ ?% \rule{0mm}{0mm}\newline\verb? for(j in 1:m){ ?% \rule{0mm}{0mm}\newline\verb? # plot(x[,j],x[,i],axes=axes,type="p") ?% \rule{0mm}{0mm}\newline\verb? do.call("plot",c(alist(x=x[,j],y=x[,i],type="p",axes=axes,xlab="",ylab=""),args)) ?% \rule{0mm}{0mm}\newline\verb? usr.array[i,j,] <- usr<-par()$usr ?% \rule{0mm}{0mm}\newline\verb? if(i==j) text(usr[1],usr[4],varnames[i],adj=c(0,1),cex=5) ?% \rule{0mm}{0mm}\newline\verb? rect(usr[1],usr[3],usr[2],usr[4]) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? # update function ?% \rule{0mm}{0mm}\newline\verb? refresh<-function(...){ ?% \rule{0mm}{0mm}\newline\verb? vmin<-slider(no=1)/100; vmax<-vmin+slider(no=2)/100 ?% \rule{0mm}{0mm}\newline\verb? vno <-slider(no=3) ?% \rule{0mm}{0mm}\newline\verb? vmin<-mins[vno]*(1-vmin)+maxs[vno]*(vmin) ?% \rule{0mm}{0mm}\newline\verb? vmax<-mins[vno]*(1-vmax)+maxs[vno]*(vmax) ?% \rule{0mm}{0mm}\newline\verb? ind <-vmin<=x[,vno] & x[,vno]<=vmax ?% \rule{0mm}{0mm}\newline\verb? for(i in 1:m){ ?% \rule{0mm}{0mm}\newline\verb? for(j in 1:m){ ?% \rule{0mm}{0mm}\newline\verb? par(mfg=c(i,j),usr=usr.array[i,j,]) ?% \rule{0mm}{0mm}\newline\verb? points(x[ ,j],x[ ,i],col=0,cex=2,pch=19) ?% \rule{0mm}{0mm}\newline\verb? points(x[ ind,j],x[ ind,i],col="red",pch=1) ?% \rule{0mm}{0mm}\newline\verb? points(x[!ind,j],x[!ind,i],col="blue",pch=19) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? # slider definition ?% \rule{0mm}{0mm}\newline\verb? nt <- slider(refresh, ?% \rule{0mm}{0mm}\newline\verb? c("lower limit (% of range)","width (% of range)", ?% \rule{0mm}{0mm}\newline\verb? paste("variable no: 1 ..",m)), ?% \rule{0mm}{0mm}\newline\verb? c(0,0,1), c(100,100, m), c(1,1,1), c(0,30,1) ?% \rule{0mm}{0mm}\newline\verb? ) ?% \rule{0mm}{0mm}\newline\verb? # tkwm.minsize(nt, "450", "150") # set width, height to prevent to small sizes ?% \rule{0mm}{0mm}\newline\verb? refresh() ?% \rule{0mm}{0mm}\newline\verb? cat("use sliders to select variable and interval width\n") ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsubsection{Test} We will use the famous {\tt iris} data to test the brushing function. \makemarginno $\langle${\it test of slider.brush.pairs}\ $39\rangle\equiv$ \label{CodeChunkLabelAADJ} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.brush.pairs}} 38$\rangle$% \rule{0mm}{0mm}\newline\verb? usr.array<-slider.brush.pairs(iris,cex=.2) ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsection{Scatter plot brushing -- {\tt slider.brush.plot.xy}} The function {\tt slider.brush.plot.xy()} computes an xy-plot and recolors a data point {\tt "red"} if the value of its third variable is in the fixed interval. \makemarginno $\langle${\it define {\tt slider.brush.plot.xy}}\ $40\rangle\equiv$ {\quad$\subset$ 5, 41, 60 } \label{CodeChunkLabelAAEA} \rule{0mm}{0mm}\newline\verb? slider.brush.plot.xy<-function(x,y=NULL,z=NULL,...) ?% \rule{0mm}{0mm}\newline\verb? { ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it check if {\tt x,\ y,z} are vectors or {\tt x} is matrix with >2 columns} 16$\rangle$% \rule{0mm}{0mm}\newline\verb? args<-list(...) ?% \rule{0mm}{0mm}\newline\verb? if(!any("main"==names(args))) ?% \rule{0mm}{0mm}\newline\verb? args<-c(args,list(main=paste(x.name,"<-->",y.name))) ?% \rule{0mm}{0mm}\newline\verb? if(!any("xlab"==names(args)))args<-c(args,list(xlab=x.name)) ?% \rule{0mm}{0mm}\newline\verb? if(!any("ylab"==names(args)))args<-c(args,list(ylab=y.name)) ?% \rule{0mm}{0mm}\newline\verb? do.call("plot.default",c(alist(x=x,y=y,pch=19),args)) ?% \rule{0mm}{0mm}\newline\verb? refresh<-function(...){ ?% \rule{0mm}{0mm}\newline\verb? zrange<-range(z); z1<-slider(no=1); z2<-slider(no=2) ?% \rule{0mm}{0mm}\newline\verb? zmin<-z1; zmax<-z1+z2; ind<-zmin<=z&z<=zmax; pos<-par()$usr ?% \rule{0mm}{0mm}\newline\verb? rect(pos[2],pos[4],pos[1]*.5+pos[2]*.5,pos[3]*.1+pos[4]*.9, ?% \rule{0mm}{0mm}\newline\verb? col="white",border=NA) ?% \rule{0mm}{0mm}\newline\verb? txt<-paste(z.name,"(red) in [",format(zmin,digits=4),",", ?% \rule{0mm}{0mm}\newline\verb? format(zmax,digits=4),"]",sep="") ?% \rule{0mm}{0mm}\newline\verb? text(pos[2],pos[4],txt,adj=c(1,1),col="red",cex=0.7) ?% \rule{0mm}{0mm}\newline\verb? col<-c("black","red")[1+ind] ?% \rule{0mm}{0mm}\newline\verb? points(x,y,col=col,pch=19, ?% \rule{0mm}{0mm}\newline\verb? cex=if("cex" %in% names(args)) args$cex else 1) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? z.min<-min(z); z.max<-max(z); delta<-(z.max-z.min)/100 ?% \rule{0mm}{0mm}\newline\verb? reset<-function(...){ ?% \rule{0mm}{0mm}\newline\verb? do.call("plot",c(alist(x=x,y=y,col="red",pch=19),args)); pos<-par()$usr #090216 ?% \rule{0mm}{0mm}\newline\verb? rect(pos[2],pos[4],pos[1]*.4+pos[2]*.6,pos[3]*.1+pos[4]*.9, ?% \rule{0mm}{0mm}\newline\verb? col="white",border=NA) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? slider(refresh, ?% \rule{0mm}{0mm}\newline\verb? c("minimum of z","interval width of z"), ?% \rule{0mm}{0mm}\newline\verb? c(z.min,0),c(z.max+delta,(z.max-z.min)+delta), ?% \rule{0mm}{0mm}\newline\verb? c(delta,delta),c(z.min-delta,(z.max-z.min)/2), ?% \rule{0mm}{0mm}\newline\verb? reset.function=reset ?% \rule{0mm}{0mm}\newline\verb? ) ?% \rule{0mm}{0mm}\newline\verb? refresh() ?% \rule{0mm}{0mm}\newline\verb? cat("use sliders to select interval for inking points\n") ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsubsection{Test} \makemarginno $\langle${\it test of {\tt slider.brush.plot.xy}}\ $41\rangle\equiv$ \label{CodeChunkLabelAAEB} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.brush.plot.xy}} 40$\rangle$% \rule{0mm}{0mm}\newline\verb? # data<-matrix(rnorm(900), 300,3) ?% \rule{0mm}{0mm}\newline\verb? # slider.brush.plot.xy(data[,1],data[,2],sqrt(data[,1]^2+data[,2]^2), ?% \rule{0mm}{0mm}\newline\verb? # main="hallo") ?% \rule{0mm}{0mm}\newline\verb? # slider.brush.plot.xy(iris[,1],iris[,2],iris[,3]) ?% \rule{0mm}{0mm}\newline\verb? slider.brush.plot.xy(iris[,1:3],cex=1.5) ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsubsection{Help Page} \makemarginno $\langle${\it define help of {\tt slider.brush.pairs} and of {\tt slider.brush.plot.xy}}\ $42\rangle\equiv$ \label{CodeChunkLabelAAEC} \rule{0mm}{0mm}\newline\verb? \name{slider.brush} ?% \rule{0mm}{0mm}\newline\verb? \title{interactive brushing functions} ?% \rule{0mm}{0mm}\newline\verb? \alias{slider.brush.pairs} ?% \rule{0mm}{0mm}\newline\verb? \alias{slider.brush.plot.xy} ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? \description{ ?% \rule{0mm}{0mm}\newline\verb? These functions compute a pairs plot or a simple xy-plot and ?% \rule{0mm}{0mm}\newline\verb? open a slider control widget for brushing. ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? \code{slider.brush.pairs} computes a pairs plot; the user defines an ?% \rule{0mm}{0mm}\newline\verb? interval for one of the variables and in effect all data points ?% \rule{0mm}{0mm}\newline\verb? in this interval will be recolored. ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? \code{slider.brush.plot.xy} computes an xy-plot; the user defines a ?% \rule{0mm}{0mm}\newline\verb? interval for a third variable \code{z} and all points ?% \rule{0mm}{0mm}\newline\verb? \code{(x,y)} will be recolored red if the \code{z} value is in the interval. ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \usage{ ?% \rule{0mm}{0mm}\newline\verb? slider.brush.pairs(x, ...) ?% \rule{0mm}{0mm}\newline\verb? slider.brush.plot.xy(x, y, z, ...) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \arguments{ ?% \rule{0mm}{0mm}\newline\verb? \item{\dots}{ new settings for global graphics parameters } ?% \rule{0mm}{0mm}\newline\verb? \item{x}{ matrix or data frame or vector } ?% \rule{0mm}{0mm}\newline\verb? \item{y}{ vector of y values if \code{x} is not a matrix } ?% \rule{0mm}{0mm}\newline\verb? \item{z}{ vector of z values if \code{x} is not a matrix } ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \details{ ?% \rule{0mm}{0mm}\newline\verb? \code{slider.brush.pairs} draws a pairs plot of the data set \code{x}. ?% \rule{0mm}{0mm}\newline\verb? The first slider defines the lower limit of the interval and the ?% \rule{0mm}{0mm}\newline\verb? second its width. By the third slider a variable is selected. ?% \rule{0mm}{0mm}\newline\verb? All data points for which the selected variable is in the interval ?% \rule{0mm}{0mm}\newline\verb? are recolored red. ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? \code{slider.brush.plot.xy} draws an xy-plot of the data set \code{x}. ?% \rule{0mm}{0mm}\newline\verb? The first slider defines the lower limit of the interval of z values ?% \rule{0mm}{0mm}\newline\verb? and the second one its width. All data points for which the variable z ?% \rule{0mm}{0mm}\newline\verb? is in the interval are recolored red. ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \value{ ?% \rule{0mm}{0mm}\newline\verb? a message about the usage ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \references{ W. S. Cleveland, R. A. Becker, and G. Weil. The Use of ?% \rule{0mm}{0mm}\newline\verb? Brushing and Rotation for Data Analysis. InW. S. Cleveland ?% \rule{0mm}{0mm}\newline\verb? and M. E. McGill, editors, Dynamic Graphics for ?% \rule{0mm}{0mm}\newline\verb? Statistics. Wadsworth and Brooks/Cole, Pacific Grove, ?% \rule{0mm}{0mm}\newline\verb? CA, 1988. } ?% \rule{0mm}{0mm}\newline\verb? \author{ Hans Peter Wolf } ?% \rule{0mm}{0mm}\newline\verb? \seealso{ \code{\link{pairs}}, \code{\link{plot}} } ?% \rule{0mm}{0mm}\newline\verb? \examples{ ?% \rule{0mm}{0mm}\newline\verb? \dontrun{ ?% \rule{0mm}{0mm}\newline\verb? ## This example cannot be run by examples() but should be work in an interactive R session ?% \rule{0mm}{0mm}\newline\verb? slider.brush.pairs(iris) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \dontrun{ ?% \rule{0mm}{0mm}\newline\verb? ## This example cannot be run by examples() but should be work in an interactive R session ?% \rule{0mm}{0mm}\newline\verb? slider.brush.plot.xy(iris[,1:3]) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \keyword{ iplot } ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \section{Time Series Plots} \subsection{Splitted time series -- {\tt slider.split.plot.ts}} Often there is a periodical structure in time series of a fixed period. Then you will like to have a tool to separate and compare the sections defined by the season. The function {\tt slider.split.plot.ts} lets you select the length of a saison and one of the limits between two saisons. Then in the time series plot {\tt fivenum} summary statistics or a regression lines are added to each of the sections. \makemarginno $\langle${\it define {\tt slider.split.plot.ts}}\ $43\rangle\equiv$ {\quad$\subset$ 6, 44, 60 } \label{CodeChunkLabelAAED} \rule{0mm}{0mm}\newline\verb? slider.split.plot.ts<-function(x,type="l",...) ?% \rule{0mm}{0mm}\newline\verb? { ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it check if {\tt x} is a time series} 17$\rangle$% \rule{0mm}{0mm}\newline\verb? args<-list(...) ?% \rule{0mm}{0mm}\newline\verb? n<-length(x); xmin<-min(x); xmax<-max(x) ?% \rule{0mm}{0mm}\newline\verb? xdelta<-xmax-xmin ?% \rule{0mm}{0mm}\newline\verb? slider(obj.name="summary.type",obj.value="linear") ?% \rule{0mm}{0mm}\newline\verb? refresh<-function(...){ ?% \rule{0mm}{0mm}\newline\verb? # initialization ?% \rule{0mm}{0mm}\newline\verb? summary.type<-slider(obj.name="summary.type") ?% \rule{0mm}{0mm}\newline\verb? width<-slider(no=1) ?% \rule{0mm}{0mm}\newline\verb? limit<-slider(no=2) ?% \rule{0mm}{0mm}\newline\verb? n.sec<-1 ?% \rule{0mm}{0mm}\newline\verb? limit<-limit-width*ceiling((limit-xmin)/width) ?% \rule{0mm}{0mm}\newline\verb? # plot: # plot(x,y,type=type,bty="n",xlab="",ylab="") ?% \rule{0mm}{0mm}\newline\verb? do.call("plot",c(alist(x,y,type=type),args)) ?% \rule{0mm}{0mm}\newline\verb? limit<-limit-width-width/n.sec; j<-0 ?% \rule{0mm}{0mm}\newline\verb? # abline(v=limits,lwd=0.5,lty=3) ?% \rule{0mm}{0mm}\newline\verb? while(limit1){ ?% \rule{0mm}{0mm}\newline\verb? tstart2 <- slider(no=3); tend2 <- width+tstart2 ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? # plot ?% \rule{0mm}{0mm}\newline\verb? par(mfrow=c(2+(n.windows>1),1),mai=c(.5,0.5,.1,0)) ?% \rule{0mm}{0mm}\newline\verb? # plot(x,y,type="l",bty="n",xlab="",ylab="") ?% \rule{0mm}{0mm}\newline\verb? do.call("plot",c(alist(x,y,type="l",bty="n"),args)) ?% \rule{0mm}{0mm}\newline\verb? abline(v=c(x[tstart1],x[tend1]),col="red") ?% \rule{0mm}{0mm}\newline\verb? lines(x[tstart1:tend1],y[tstart1:tend1],col="red",lty=2) ?% \rule{0mm}{0mm}\newline\verb? if(n.windows>1){ ?% \rule{0mm}{0mm}\newline\verb? abline(v=c(x[tstart2],x[tend2]),col="blue") ?% \rule{0mm}{0mm}\newline\verb? lines(x[tstart2:tend2],y[tstart2:tend2],col="blue",lty=3) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? usr<-par()$usr ?% \rule{0mm}{0mm}\newline\verb? ind<-tstart1:tend1 ?% \rule{0mm}{0mm}\newline\verb? plot(x[ind],y[ind],type="b",col="red",bty="n", # ylim=usr[3:4], ?% \rule{0mm}{0mm}\newline\verb? xlim=c(x[tstart1],x[tstart1]+width*diff(x[1:2]))) ?% \rule{0mm}{0mm}\newline\verb? if(n.windows>1){ ?% \rule{0mm}{0mm}\newline\verb? ind<-tstart2:tend2 ?% \rule{0mm}{0mm}\newline\verb? plot(x[ind],y[ind],type="b",col="blue",bty="n", # ylim=usr[3:4], ?% \rule{0mm}{0mm}\newline\verb? xlim=c(x[tstart2],x[tstart2]+width*diff(x[1:2]))) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? par(mfrow=c(1,1)) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? if(n.windows<2){ ?% \rule{0mm}{0mm}\newline\verb? slider(refresh,c("width of window","start of window"), ?% \rule{0mm}{0mm}\newline\verb? c(1,1),c(tmax,tmax),c(1,1),c(ceiling(tmax/4),1)) ?% \rule{0mm}{0mm}\newline\verb? }else{ ?% \rule{0mm}{0mm}\newline\verb? slider(refresh, ?% \rule{0mm}{0mm}\newline\verb? c("width of window","start window 1","start window 2"), ?% \rule{0mm}{0mm}\newline\verb? c(1,1,1),c(tmax,tmax,tmax),c(1,1,1),c(ceiling(tmax/4),1,ceiling(tmax/2))) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? refresh() ?% \rule{0mm}{0mm}\newline\verb? cat("select window and look at time series!\n") ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsubsection{Test} The first test will be done with {\tt co2}. \makemarginno $\langle${\it test of {\tt slider.zoom.plot.ts}}\ $47\rangle\equiv$ \label{CodeChunkLabelAAEH} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.zoom.plot.ts}} 46$\rangle$% \rule{0mm}{0mm}\newline\verb? slider.zoom.plot.ts(co2,2,main="co2") ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi For comparing two sections of a series take a look at {\tt sunspots}. \makemarginno $\langle${\it test of {\tt slider.zoom.plot.ts}}\ $47\rangle+\equiv$ \label{CodeChunkLabelAAEI} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.zoom.plot.ts}} 46$\rangle$% \rule{0mm}{0mm}\newline\verb? slider.zoom.plot.ts(sunspots,2) ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsubsection{Help Page} \makemarginno $\langle${\it define help of {\tt slider.zoom.plot.ts}}\ $49\rangle\equiv$ \label{CodeChunkLabelAAEJ} \rule{0mm}{0mm}\newline\verb? \name{slider.zoom.plot.ts} ?% \rule{0mm}{0mm}\newline\verb? \title{interactive zooming of time series} ?% \rule{0mm}{0mm}\newline\verb? \alias{slider.zoom.plot.ts} ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? \description{ ?% \rule{0mm}{0mm}\newline\verb? This function shows one or two sections of a time series. The window(s) is ?% \rule{0mm}{0mm}\newline\verb? (are) controlled by sliders. ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \usage{ ?% \rule{0mm}{0mm}\newline\verb? slider.zoom.plot.ts(x, n.windows, ...) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \arguments{ ?% \rule{0mm}{0mm}\newline\verb? \item{x}{ time series } ?% \rule{0mm}{0mm}\newline\verb? \item{n.windows}{ \code{if(n.windows>1} two sections are defined } ?% \rule{0mm}{0mm}\newline\verb? \item{\dots}{ additional graphical parameters } ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \details{ ?% \rule{0mm}{0mm}\newline\verb? \code{slider.zoom.plot.ts} plots the original time series and it lets you ?% \rule{0mm}{0mm}\newline\verb? select one or two sections of the series by fixing the width(s) and the ?% \rule{0mm}{0mm}\newline\verb? starting point(s) of the region(s). Then the section(s) of the series is (are) ?% \rule{0mm}{0mm}\newline\verb? plotted separately one below the other. ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? The first slider defines the width of the section(s). ?% \rule{0mm}{0mm}\newline\verb? The second (third) one sets the start of the first (second) section. ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \value{ ?% \rule{0mm}{0mm}\newline\verb? a message about the usage ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \author{ Hans Peter Wolf } ?% \rule{0mm}{0mm}\newline\verb? \seealso{ \code{\link{plot}} } ?% \rule{0mm}{0mm}\newline\verb? \examples{ ?% \rule{0mm}{0mm}\newline\verb? \dontrun{ ?% \rule{0mm}{0mm}\newline\verb? ## This example cannot be run by examples() but should be work in an interactive R session ?% \rule{0mm}{0mm}\newline\verb? slider.zoom.plot.ts(co2,2) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \keyword{ iplot } ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsection{Smoothing Time Series -- {\tt slider.smooth.plot.ts}} Tukey has proposed a set of smoothing operations for time series. Some of them are implemented by the function {\tt smooth()}. {\tt slider.smooth.plot.ts} supports the user to find the suitable combination of smoothing operations. Interactively he is able to smooth a time series step by step. The filter that should be used in the next step is selected by Tcl/Tk control panel. \makemarginno $\langle${\it define {\tt slider.smooth.plot.ts}}\ $50\rangle\equiv$ {\quad$\subset$ 8, 51, 60 } \label{CodeChunkLabelAAFA} \rule{0mm}{0mm}\newline\verb? slider.smooth.plot.ts<-function(x,...) ?% \rule{0mm}{0mm}\newline\verb? { ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it check if {\tt x} is a time series} 17$\rangle$% \rule{0mm}{0mm}\newline\verb? t.x<-x; x<-y ?% \rule{0mm}{0mm}\newline\verb? args<-list(...) ?% \rule{0mm}{0mm}\newline\verb? kind<-c("3RS3R", "3RSS", "3RSR", "3R", "3", "S") ?% \rule{0mm}{0mm}\newline\verb? slider(obj.name="nts",obj.value=x) ?% \rule{0mm}{0mm}\newline\verb? slider(obj.name="kind",obj.value="3") ?% \rule{0mm}{0mm}\newline\verb? slider(obj.name="history.kind",obj.value="") ?% \rule{0mm}{0mm}\newline\verb? refresh<-function(...){ ?% \rule{0mm}{0mm}\newline\verb? # initialization ?% \rule{0mm}{0mm}\newline\verb? choice<-slider(obj.name="kind"); print(choice) ?% \rule{0mm}{0mm}\newline\verb? history.kind<-slider(obj.name="history.kind") ?% \rule{0mm}{0mm}\newline\verb? history.kind<-c(history.kind,choice) ?% \rule{0mm}{0mm}\newline\verb? slider(obj.name="history.kind",obj.value=history.kind) ?% \rule{0mm}{0mm}\newline\verb? xx<-slider(obj.name="nts") ?% \rule{0mm}{0mm}\newline\verb? xx<-smooth(xx,kind=choice) ?% \rule{0mm}{0mm}\newline\verb? # plot(t.x,x,type="l",lty=3,bty="n",xlab="",ylab="") ?% \rule{0mm}{0mm}\newline\verb? do.call("plot",c(alist(t.x,x,type="l",lty=3,bty="n"),args)) ?% \rule{0mm}{0mm}\newline\verb? title(paste(history.kind,collapse="->")) ?% \rule{0mm}{0mm}\newline\verb? points(t.x,xx,type="l",col="red") # lty=1+which(choice==kind)) ?% \rule{0mm}{0mm}\newline\verb? slider(obj.name="nts",obj.value=xx) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? reset<-function(...){ ?% \rule{0mm}{0mm}\newline\verb? slider(obj.name="nts",obj.value=x) ?% \rule{0mm}{0mm}\newline\verb? slider(obj.name="kind",obj.value="3") ?% \rule{0mm}{0mm}\newline\verb? slider(obj.name="history.kind",obj.value="") ?% \rule{0mm}{0mm}\newline\verb? refresh() ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? f1<-function(...){slider(obj.name="kind",obj.value="3RS3R");refresh()} ?% \rule{0mm}{0mm}\newline\verb? f2<-function(...){slider(obj.name="kind",obj.value="3RSS"); refresh()} ?% \rule{0mm}{0mm}\newline\verb? f3<-function(...){slider(obj.name="kind",obj.value="3RSR"); refresh()} ?% \rule{0mm}{0mm}\newline\verb? f4<-function(...){slider(obj.name="kind",obj.value="3R"); refresh()} ?% \rule{0mm}{0mm}\newline\verb? f5<-function(...){slider(obj.name="kind",obj.value="3"); refresh()} ?% \rule{0mm}{0mm}\newline\verb? f6<-function(...){slider(obj.name="kind",obj.value="S"); refresh()} ?% \rule{0mm}{0mm}\newline\verb? refresh() ?% \rule{0mm}{0mm}\newline\verb? slider(but.functions=c(f1,f2,f3,f4,f5,f6), ?% \rule{0mm}{0mm}\newline\verb? but.names=kind,reset.function=reset) ?% \rule{0mm}{0mm}\newline\verb? cat("select type of smoothing a la Tukey and look the result!\n") ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsubsection{Test} For testing we use some random numbers. \makemarginno $\langle${\it test of {\tt slider.smooth.plot.ts}}\ $51\rangle\equiv$ \label{CodeChunkLabelAAFB} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.smooth.plot.ts}} 50$\rangle$% \rule{0mm}{0mm}\newline\verb? slider.smooth.plot.ts(rnorm(100),main="\nrandom",col="blue") ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsubsection{Help Page} \makemarginno $\langle${\it define help of {\tt slider.smooth.plot.ts}}\ $52\rangle\equiv$ \label{CodeChunkLabelAAFC} \rule{0mm}{0mm}\newline\verb? \name{slider.smooth.plot.ts} ?% \rule{0mm}{0mm}\newline\verb? \title{interactive Tukey smoothing} ?% \rule{0mm}{0mm}\newline\verb? \alias{slider.smooth.plot.ts} ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? \description{ ?% \rule{0mm}{0mm}\newline\verb? \code{slider.smooth.plot.ts} computes smooth curves ?% \rule{0mm}{0mm}\newline\verb? of a time series plot by Tukey's smoothers. ?% \rule{0mm}{0mm}\newline\verb? The kind of smoothing is controlled by a Tcl/Tk widget. ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \usage{ ?% \rule{0mm}{0mm}\newline\verb? slider.smooth.plot.ts(x, ...) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \arguments{ ?% \rule{0mm}{0mm}\newline\verb? \item{x}{ time series } ?% \rule{0mm}{0mm}\newline\verb? \item{\dots}{ additional graphical parameters } ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \details{ ?% \rule{0mm}{0mm}\newline\verb? \code{slider.smooth.plot.ts} draws the time series \code{x}. ?% \rule{0mm}{0mm}\newline\verb? The user selects a filter of the set ?% \rule{0mm}{0mm}\newline\verb? \code{c("3RS3R", "3RSS", "3RSR", "3R", "3", "S")} ?% \rule{0mm}{0mm}\newline\verb? step by step and the resulting curve is added to the plot. ?% \rule{0mm}{0mm}\newline\verb? The selection is performed by pressing a button of the control ?% \rule{0mm}{0mm}\newline\verb? widget of \code{slider.smooth.plot.ts}. ?% \rule{0mm}{0mm}\newline\verb? The button \code{reset} restarts the smoothing process. ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \value{ ?% \rule{0mm}{0mm}\newline\verb? a message about the usage ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \references{ Tukey, J. W. (1977). Exploratory Data Analysis, Reading ?% \rule{0mm}{0mm}\newline\verb? Massachusetts: Addison-Wesley. ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \author{ Hans Peter Wolf } ?% \rule{0mm}{0mm}\newline\verb? \seealso{ \code{\link{plot}}, \code{\link{smooth}} } ?% \rule{0mm}{0mm}\newline\verb? \examples{ ?% \rule{0mm}{0mm}\newline\verb? \dontrun{ ?% \rule{0mm}{0mm}\newline\verb? ## This example cannot be run by examples() but should be work in an interactive R session ?% \rule{0mm}{0mm}\newline\verb? slider.smooth.plot.ts(rnorm(100)) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \keyword{ iplot } ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \section{Regression} \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsection{Smoothing by lowess -- {\tt slider.lowess.plot}} The result of the lowess smoother heavily depends on the setting of the parameter {\tt f}. This parameter controls the smoother span and has to be fixed by the user. The function {\tt slider.lowess.plot} allows the user to select the span and to observe the corresponding line. Furthermore, the number of iterations are set interactively. \makemarginno $\langle${\it define {\tt slider.lowess.plot}}\ $53\rangle\equiv$ {\quad$\subset$ 9, 54, 60 } \label{CodeChunkLabelAAFD} \rule{0mm}{0mm}\newline\verb? slider.lowess.plot<-function(x,y=NULL,...) ?% \rule{0mm}{0mm}\newline\verb? { ?% \rule{0mm}{0mm}\newline\verb? # slider function to draw lowess smoother, pwolf 080525 ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it check if {\tt x} is a matrix or {\tt x} and {\tt y} are vectors} 15$\rangle$% \rule{0mm}{0mm}\newline\verb? args<-list(...) ?% \rule{0mm}{0mm}\newline\verb? refresh<-function(...){ ?% \rule{0mm}{0mm}\newline\verb? f<-slider(no=1) ?% \rule{0mm}{0mm}\newline\verb? iter<-slider(no=2) ?% \rule{0mm}{0mm}\newline\verb? xy<-lowess(x,y,f=f,iter=iter) ?% \rule{0mm}{0mm}\newline\verb? # plot(x,y,bty="n") ?% \rule{0mm}{0mm}\newline\verb? do.call("plot",c(alist(x,y,bty="n"),args)) ?% \rule{0mm}{0mm}\newline\verb? lines(xy) ?% \rule{0mm}{0mm}\newline\verb? title(paste("\n\nlowess: f =",signif(f,4),", iterations =",iter)) ?% \rule{0mm}{0mm}\newline\verb? lines(xy) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? slider(refresh, ?% \rule{0mm}{0mm}\newline\verb? c("smoother span","iterations"), ?% \rule{0mm}{0mm}\newline\verb? c(.01,1),c(1,7),c(.01,1),c(2/3,3) ?% \rule{0mm}{0mm}\newline\verb? ) ?% \rule{0mm}{0mm}\newline\verb? refresh() ?% \rule{0mm}{0mm}\newline\verb? cat("use slider to select smoother span!\n") ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsubsection{Test} \makemarginno $\langle${\it check of {\tt slider.lowess.plot}}\ $54\rangle\equiv$ \label{CodeChunkLabelAAFE} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.lowess.plot}} 53$\rangle$% \rule{0mm}{0mm}\newline\verb? slider.lowess.plot(cars,col="red") ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsubsection{Help Page} \makemarginno $\langle${\it define help of {\tt slider.lowess.plot}}\ $55\rangle\equiv$ \label{CodeChunkLabelAAFF} \rule{0mm}{0mm}\newline\verb? \name{slider.lowess.plot} ?% \rule{0mm}{0mm}\newline\verb? \title{interactive lowess smoothing} ?% \rule{0mm}{0mm}\newline\verb? \alias{slider.lowess.plot} ?% \rule{0mm}{0mm}\newline\verb? \description{ ?% \rule{0mm}{0mm}\newline\verb? \code{slider.lowess.plot} computes an xy-plot of the data and ?% \rule{0mm}{0mm}\newline\verb? adds LOWESS lines. The smoother ?% \rule{0mm}{0mm}\newline\verb? span and the number of iterations are selected by sliders. ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \usage{ ?% \rule{0mm}{0mm}\newline\verb? slider.lowess.plot(x, y, ...) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \arguments{ ?% \rule{0mm}{0mm}\newline\verb? \item{x}{ data set to be used for plotting or vector of x values } ?% \rule{0mm}{0mm}\newline\verb? \item{y}{ vector of y values in case \code{x} is not a matrix } ?% \rule{0mm}{0mm}\newline\verb? \item{\dots}{ additional (graphics) parameter settings } ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \details{ ?% \rule{0mm}{0mm}\newline\verb? \code{slider.lowess.plot} computes a scatterplot of the data. ?% \rule{0mm}{0mm}\newline\verb? Then a LOWESS smoother line is added to the plot. ?% \rule{0mm}{0mm}\newline\verb? For more details about the lowess parameters \code{f} and \code{iter} ?% \rule{0mm}{0mm}\newline\verb? take a look at the help page of \code{lowess}. ?% \rule{0mm}{0mm}\newline\verb? The parameters are set by moving sliders of the ?% \rule{0mm}{0mm}\newline\verb? control widget. The first slider defines the smoother span \code{f} ?% \rule{0mm}{0mm}\newline\verb? and the second one the number of iterations. ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \value{ ?% \rule{0mm}{0mm}\newline\verb? a message about the usage ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \references{ for references see help file of \code{lowess} } ?% \rule{0mm}{0mm}\newline\verb? \author{ Hans Peter Wolf } ?% \rule{0mm}{0mm}\newline\verb? \seealso{ \code{\link{lowess}}, \code{slider} } ?% \rule{0mm}{0mm}\newline\verb? \examples{ ?% \rule{0mm}{0mm}\newline\verb? \dontrun{ ?% \rule{0mm}{0mm}\newline\verb? ## This example cannot be run by examples() but should be work in an interactive R session ?% \rule{0mm}{0mm}\newline\verb? slider.lowess.plot(cars) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \keyword{ iplot } ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsection{Sensitivity of Regression Line -- {\tt slider.bootstrap.lm.plot}} To understand the senitivity of a regression curve the function {\tt slider.bootstrap.lm.plot} shows the user a lot of bootstrap regression lines computed on samples of the data points. The number of repetitions, the random seed and the polynomial degree is controlled by sliders. \makemarginno $\langle${\it define {\tt slider.bootstrap.lm.plot}}\ $56\rangle\equiv$ {\quad$\subset$ 10, 57, 60 } \label{CodeChunkLabelAAFG} \rule{0mm}{0mm}\newline\verb? slider.bootstrap.lm.plot<-function(x,y=NULL,...) ?% \rule{0mm}{0mm}\newline\verb? { ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it check if {\tt x} is a matrix or {\tt x} and {\tt y} are vectors} 15$\rangle$% \rule{0mm}{0mm}\newline\verb? args<-list(...) ?% \rule{0mm}{0mm}\newline\verb? n<-length(x) ?% \rule{0mm}{0mm}\newline\verb? ind<-order(x); x.orig<-x<-x[ind]; y.orig<-y<-y[ind] ?% \rule{0mm}{0mm}\newline\verb? xx<-seq(min(x),max(x),length=100) ?% \rule{0mm}{0mm}\newline\verb? # plot(x,y,...) ?% \rule{0mm}{0mm}\newline\verb? do.call("plot",c(alist(x,y,bty="n"),args)) ?% \rule{0mm}{0mm}\newline\verb? abline(lm(y~x),lwd=5) ?% \rule{0mm}{0mm}\newline\verb? refresh<-function(...){ ?% \rule{0mm}{0mm}\newline\verb? # plot(x,y,...); ?% \rule{0mm}{0mm}\newline\verb? do.call("plot",c(alist(x,y,bty="n"),args)) ?% \rule{0mm}{0mm}\newline\verb? abline(coefyx<-lm(y~x)$coef, lwd=3) ?% \rule{0mm}{0mm}\newline\verb? polytype<-slider(no=1) ?% \rule{0mm}{0mm}\newline\verb? form<-paste(paste(sep="","I(x^",1:polytype,")"),collapse="+") ?% \rule{0mm}{0mm}\newline\verb? form<-as.formula(paste("y ~",form)); coef<-lm(form)$coef ?% \rule{0mm}{0mm}\newline\verb? yy<-outer(xx,0:polytype,"^")%*%coef; lines(xx,yy,lwd=2) ?% \rule{0mm}{0mm}\newline\verb? B<-slider(no=2); zz<-slider(no=3); set.seed(zz) ?% \rule{0mm}{0mm}\newline\verb? result<-matrix(0,1+polytype,B) ?% \rule{0mm}{0mm}\newline\verb? for(i in 1:B){ ?% \rule{0mm}{0mm}\newline\verb? index<-sample(1:n,n,replace=TRUE) ?% \rule{0mm}{0mm}\newline\verb? x<-x.orig[index]; y<-y.orig[index] ?% \rule{0mm}{0mm}\newline\verb? coef<-lm(form)$coef ?% \rule{0mm}{0mm}\newline\verb? yy<-outer(xx,0:polytype,"^")%*%coef ?% \rule{0mm}{0mm}\newline\verb? lines(xx,yy,lwd=2,col=i,lty=2) ?% \rule{0mm}{0mm}\newline\verb? result[,i]<-coef ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? abline(coefyx, lwd=5) ?% \rule{0mm}{0mm}\newline\verb? result<-t(result); ?% \rule{0mm}{0mm}\newline\verb? colnames(result)<-c("intercept",paste(sep="","beta: x^",1:polytype)) ?% \rule{0mm}{0mm}\newline\verb? print(summary(result)) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? slider(refresh,c("polynomial degree","number repetitions","random seed"), ?% \rule{0mm}{0mm}\newline\verb? c(1,1,1),c(5,50,100),c(1,1,1),c(1,10,1)) ?% \rule{0mm}{0mm}\newline\verb? refresh() ?% \rule{0mm}{0mm}\newline\verb? "ok" ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsubsection{Test} \makemarginno $\langle${\it test of {\tt slider..bootstrap.lm.plot}}\ $57\rangle\equiv$ \label{CodeChunkLabelAAFH} \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.bootstrap.lm.plot}} 56$\rangle$% \rule{0mm}{0mm}\newline\verb? daten<-iris[,2:3] ?% \rule{0mm}{0mm}\newline\verb? slider.bootstrap.lm.plot(daten) ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsubsection{Help Page} \makemarginno $\langle${\it define help of {\tt slider.bootstrap.lm.plot}}\ $58\rangle\equiv$ \label{CodeChunkLabelAAFI} \rule{0mm}{0mm}\newline\verb? \name{slider.bootstrap.lm.plot} ?% \rule{0mm}{0mm}\newline\verb? \title{interactive bootstapping for lm} ?% \rule{0mm}{0mm}\newline\verb? \alias{slider.bootstrap.lm.plot} ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? \description{ ?% \rule{0mm}{0mm}\newline\verb? \code{slider.bootstrap.lm.plot} computes a scatterplot and ?% \rule{0mm}{0mm}\newline\verb? adds regression curves of samples of the data points. ?% \rule{0mm}{0mm}\newline\verb? The number of samples and the degree of the model are ?% \rule{0mm}{0mm}\newline\verb? controlled by sliders. ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \usage{ ?% \rule{0mm}{0mm}\newline\verb? slider.bootstrap.lm.plot(x, y, ...) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \arguments{ ?% \rule{0mm}{0mm}\newline\verb? \item{x}{ two column matrix or vector of x values if y is used } ?% \rule{0mm}{0mm}\newline\verb? \item{y}{ y values if x is not a matrix } ?% \rule{0mm}{0mm}\newline\verb? \item{\dots}{ additional graphics parameters } ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \details{ ?% \rule{0mm}{0mm}\newline\verb? \code{slider.bootstrap.lm.plot} draws a scatterplot of the data points ?% \rule{0mm}{0mm}\newline\verb? and fits a linear model to the data set. Regression curves ?% \rule{0mm}{0mm}\newline\verb? of samples of the data are then added to the plot. Within a Tcl/Tk ?% \rule{0mm}{0mm}\newline\verb? control widget the degree of the model, the repetitions and the start ?% \rule{0mm}{0mm}\newline\verb? of the random seed are set. After modification of a parameter ?% \rule{0mm}{0mm}\newline\verb? the plot is updated. ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \value{ ?% \rule{0mm}{0mm}\newline\verb? a message about the usage ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \references{ ~~ } ?% \rule{0mm}{0mm}\newline\verb? \author{ Hans Peter Wolf } ?% \rule{0mm}{0mm}\newline\verb? \seealso{ \code{\link{plot}} } ?% \rule{0mm}{0mm}\newline\verb? \examples{ ?% \rule{0mm}{0mm}\newline\verb? \dontrun{ ?% \rule{0mm}{0mm}\newline\verb? ## This example cannot be run by examples() but should be work in an interactive R session ?% \rule{0mm}{0mm}\newline\verb? daten<-iris[,2:3] ?% \rule{0mm}{0mm}\newline\verb? slider.bootstrap.lm.plot(daten) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? \keyword{ iplot } ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \section{Appendix} \subsection{Definition of {\tt slider}} We will finish the paper by listing the definition of the function {\tt slider()}. The definition is copied from package relax. \renewcommand{\codechunkcommands}{\footnotesize} \makemarginno $\langle${\it define {\tt slider}}\ $59\rangle\equiv$ \label{CodeChunkLabelAAFJ} \rule{0mm}{0mm}\newline\verb? slider<-function (sl.functions, sl.names, sl.mins, sl.maxs, sl.deltas, ?% \rule{0mm}{0mm}\newline\verb? sl.defaults, but.functions, but.names, no, set.no.value, ?% \rule{0mm}{0mm}\newline\verb? obj.name, obj.value, reset.function, title) ?% \rule{0mm}{0mm}\newline\verb? { ?% \rule{0mm}{0mm}\newline\verb? if (!exists("slider.env")) ?% \rule{0mm}{0mm}\newline\verb? slider.env <<- new.env(parent = .GlobalEnv) ?% \rule{0mm}{0mm}\newline\verb? if (!missing(no)) ?% \rule{0mm}{0mm}\newline\verb? return(as.numeric(tclvalue(get(paste("slider", no, sep = ""), ?% \rule{0mm}{0mm}\newline\verb? env = slider.env)))) ?% \rule{0mm}{0mm}\newline\verb? if (!missing(set.no.value)) { ?% \rule{0mm}{0mm}\newline\verb? try(eval(parse(text = paste("tclvalue(slider", set.no.value[1], ?% \rule{0mm}{0mm}\newline\verb? ")<-", set.no.value[2], sep = "")), env = slider.env)) ?% \rule{0mm}{0mm}\newline\verb? return(set.no.value[2]) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? if (!missing(obj.name)) { ?% \rule{0mm}{0mm}\newline\verb? if (!missing(obj.value)) ?% \rule{0mm}{0mm}\newline\verb? assign(obj.name, obj.value, env = slider.env) ?% \rule{0mm}{0mm}\newline\verb? else obj.value <- get(obj.name, env = slider.env) ?% \rule{0mm}{0mm}\newline\verb? return(obj.value) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? if (missing(title)) ?% \rule{0mm}{0mm}\newline\verb? title <- "slider control widget" ?% \rule{0mm}{0mm}\newline\verb? if (missing(sl.names)) { ?% \rule{0mm}{0mm}\newline\verb? sl.defaults <- sl.names <- NULL ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? if (missing(sl.functions)) ?% \rule{0mm}{0mm}\newline\verb? sl.functions <- function(...) { ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? # require(tcltk) # now in the depends section of the package ?% \rule{0mm}{0mm}\newline\verb? nt <- tktoplevel() ?% \rule{0mm}{0mm}\newline\verb? tkwm.title(nt, title) ?% \rule{0mm}{0mm}\newline\verb? tkwm.geometry(nt, "+0+15") ?% \rule{0mm}{0mm}\newline\verb? assign("tktop.slider", nt, env = slider.env) ?% \rule{0mm}{0mm}\newline\verb? "relax" ?% \rule{0mm}{0mm}\newline\verb? for (i in seq(sl.names)) { ?% \rule{0mm}{0mm}\newline\verb? "relax" ?% \rule{0mm}{0mm}\newline\verb? eval(parse(text = paste("assign('slider", i, "',tclVar(sl.defaults[i]),env=slider.env)", ?% \rule{0mm}{0mm}\newline\verb? sep = ""))) ?% \rule{0mm}{0mm}\newline\verb? tkpack(fr <- tkframe(nt)) ?% \rule{0mm}{0mm}\newline\verb? lab <- tklabel(fr, text = sl.names[i], width = "25") ?% \rule{0mm}{0mm}\newline\verb? sc <- tkscale(fr, from = sl.mins[i], to = sl.maxs[i], ?% \rule{0mm}{0mm}\newline\verb? showvalue = TRUE, resolution = sl.deltas[i], orient = "horiz") ?% \rule{0mm}{0mm}\newline\verb? tkpack(lab, sc, side = "right") ?% \rule{0mm}{0mm}\newline\verb? assign("sc", sc, env = slider.env) ?% \rule{0mm}{0mm}\newline\verb? eval(parse(text = paste("tkconfigure(sc,variable=slider", ?% \rule{0mm}{0mm}\newline\verb? i, ")", sep = "")), env = slider.env) ?% \rule{0mm}{0mm}\newline\verb? sl.fun <- if (length(sl.functions) > 1) ?% \rule{0mm}{0mm}\newline\verb? sl.functions[[i]] ?% \rule{0mm}{0mm}\newline\verb? else sl.functions ?% \rule{0mm}{0mm}\newline\verb? if (!is.function(sl.fun)) ?% \rule{0mm}{0mm}\newline\verb? sl.fun <- eval(parse(text = paste("function(...){", ?% \rule{0mm}{0mm}\newline\verb? sl.fun, "}"))) ?% \rule{0mm}{0mm}\newline\verb? tkbind(sc, "", sl.fun) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? assign("slider.values.old", sl.defaults, env = slider.env) ?% \rule{0mm}{0mm}\newline\verb? tkpack(f.but <- tkframe(nt), fill = "x") ?% \rule{0mm}{0mm}\newline\verb? tkpack(tkbutton(f.but, text = "Exit", command = function() tkdestroy(nt)), ?% \rule{0mm}{0mm}\newline\verb? side = "right") ?% \rule{0mm}{0mm}\newline\verb? if (!missing(reset.function)) { ?% \rule{0mm}{0mm}\newline\verb? if (!is.function(reset.function)) ?% \rule{0mm}{0mm}\newline\verb? reset.function <- eval(parse(text = paste("function(...){", ?% \rule{0mm}{0mm}\newline\verb? reset.function, "}"))) ?% \rule{0mm}{0mm}\newline\verb? tkpack(tkbutton(f.but, text = "Reset", command = function() { ?% \rule{0mm}{0mm}\newline\verb? for (i in seq(sl.names)) eval(parse(text = paste("tclvalue(slider", ?% \rule{0mm}{0mm}\newline\verb? i, ")<-", sl.defaults[i], sep = "")), env = slider.env) ?% \rule{0mm}{0mm}\newline\verb? reset.function() ?% \rule{0mm}{0mm}\newline\verb? }), side = "right") ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? if (missing(but.names)) ?% \rule{0mm}{0mm}\newline\verb? but.names <- NULL ?% \rule{0mm}{0mm}\newline\verb? for (i in seq(but.names)) { ?% \rule{0mm}{0mm}\newline\verb? but.fun <- if (length(but.functions) > 1) ?% \rule{0mm}{0mm}\newline\verb? but.functions[[i]] ?% \rule{0mm}{0mm}\newline\verb? else but.functions ?% \rule{0mm}{0mm}\newline\verb? if (!is.function(but.fun)) ?% \rule{0mm}{0mm}\newline\verb? but.fun <- eval(parse(text = c("function(...){", ?% \rule{0mm}{0mm}\newline\verb? but.fun, "}"))) ?% \rule{0mm}{0mm}\newline\verb? tkpack(tkbutton(f.but, text = but.names[i], command = but.fun), ?% \rule{0mm}{0mm}\newline\verb? side = "left") ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? invisible(nt) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \end{document} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsection{Generation of {\tt .R} and {\tt .Rd} files} The building process of packages needs to store Code in {\tt .R} files and help pages in {\tt Rd} files. The code chunk of this section writes these files. Compare file {\tt doaplpack}. \makemarginno $\langle${\it old generation of .R and .Rd files}\ $60\rangle\equiv$ \label{CodeChunkLabelAAGA} \rule{0mm}{0mm}\newline\verb? tangleR("sliderfns.rev","slider.hist.Rd", ?% \rule{0mm}{0mm}\newline\verb? "define help of [[slider.hist]]",FALSE,FALSE,FALSE) ?% \rule{0mm}{0mm}\newline\verb? tangleR("sliderfns.rev","slider.brush.Rd", ?% \rule{0mm}{0mm}\newline\verb? "define help of [[slider.brush.pairs]] and of [[slider.brush.plot.xy]]", ?% \rule{0mm}{0mm}\newline\verb? FALSE,FALSE,FALSE) ?% \rule{0mm}{0mm}\newline\verb? tangleR("sliderfns.rev","slider.split.plot.ts.Rd", ?% \rule{0mm}{0mm}\newline\verb? "define help of [[slider.split.plot.ts]]", ?% \rule{0mm}{0mm}\newline\verb? FALSE,FALSE,FALSE) ?% \rule{0mm}{0mm}\newline\verb? tangleR("sliderfns.rev","slider.zoom.plot.ts.Rd", ?% \rule{0mm}{0mm}\newline\verb? "define help of [[slider.zoom.plot.ts]]", ?% \rule{0mm}{0mm}\newline\verb? FALSE,FALSE,FALSE) ?% \rule{0mm}{0mm}\newline\verb? tangleR("sliderfns.rev","slider.smooth.plot.ts.Rd", ?% \rule{0mm}{0mm}\newline\verb? "define help of [[slider.smooth.plot.ts]]", ?% \rule{0mm}{0mm}\newline\verb? FALSE,FALSE,FALSE) ?% \rule{0mm}{0mm}\newline\verb? tangleR("sliderfns.rev","slider.lowess.plot.Rd", ?% \rule{0mm}{0mm}\newline\verb? "define help of [[slider.lowess.plot]]", ?% \rule{0mm}{0mm}\newline\verb? FALSE,FALSE,FALSE) ?% \rule{0mm}{0mm}\newline\verb? tangleR("sliderfns.rev","slider.bootstrap.lm.plot.Rd", ?% \rule{0mm}{0mm}\newline\verb? "define help of [[slider.bootstrap.lm.plot]]", ?% \rule{0mm}{0mm}\newline\verb? FALSE,FALSE,FALSE) ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.hist}} 31$\rangle$% \rule{0mm}{0mm}\newline\verb? dump("slider.hist",file="slider.hist.R") ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.density}} 34$\rangle$% \rule{0mm}{0mm}\newline\verb? dump("slider.density",file="slider.density.R") ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.brush.pairs}} 38$\rangle$% \rule{0mm}{0mm}\newline\verb? dump("slider.brush.pairs",file="slider.brush.pairs.R") ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.brush.plot.xy}} 40$\rangle$% \rule{0mm}{0mm}\newline\verb? dump("slider.brush.plot.xy",file="slider.brush.plot.xy.R") ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.split.plot.ts}} 43$\rangle$% \rule{0mm}{0mm}\newline\verb? dump("slider.split.plot.ts",file="slider.split.plot.ts.R") ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.zoom.plot.ts}} 46$\rangle$% \rule{0mm}{0mm}\newline\verb? dump("slider.zoom.plot.ts",file="slider.zoom.plot.ts.R") ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.smooth.plot.ts}} 50$\rangle$% \rule{0mm}{0mm}\newline\verb? dump("slider.smooth.plot.ts",file="slider.smooth.plot.ts.R") ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.lowess.plot}} 53$\rangle$% \rule{0mm}{0mm}\newline\verb? dump("slider.lowess.plot",file="slider.lowess.plot.R") ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it define {\tt slider.bootstrap.lm.plot}} 56$\rangle$% \rule{0mm}{0mm}\newline\verb? dump("slider.bootstrap.lm.plot",file="slider.bootstrap.lm.plot.R") ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsection{Create namespace file} \makemarginno $\langle${\it old generation of namespace file}\ $61\rangle\equiv$ \label{CodeChunkLabelAAGB} \rule{0mm}{0mm}\newline\verb? cat('exportPattern("^slider.[a-z]+")', ?% \rule{0mm}{0mm}\newline\verb? 'export(bagplot,boxplot2D,compute.bagplot,faces,plot.bagplot, ?% \rule{0mm}{0mm}\newline\verb? plot.faces,spin3R,stem.leaf)', ?% \rule{0mm}{0mm}\newline\verb? file="/home/wiwi/pwolf/R/aplpack/aplpack/NAMESPACE",sep="\n") ?% \rule{0mm}{0mm}\newline\verb? "ok" ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsection{Umwandlung von PS-Bildern in JPEGs} Der R-Erstellungsprozess des PDF-Files verwendet pdflatex, sodass JPEP-Dateien statt PS-Dateien eingebunden werden. Deshalb ist es ratsam, jpg-Datei gleicher Qualitt zu generieren. Mit diesem Chunk lassen sich die Bilder von ps nach jpg konvertieren. Im Erstellungsskript werden brigens die jpg-Dateien an die geeignete Stelle kopiert: {\tt cp\ sliderfns/*.jpg\ aplpack/inst/doc/} \makemarginno $\langle${\it *}\ $20\rangle+\equiv$ \label{CodeChunkLabelAAGC} \rule{0mm}{0mm}\newline\verb? a<-list.files(pattern="^p.*$") ?% \rule{0mm}{0mm}\newline\verb? for(fi in a){ ?% \rule{0mm}{0mm}\newline\verb? nfi<-sub("$",".jpg",fi) ?% \rule{0mm}{0mm}\newline\verb? eval(parse(text=paste("system('convert ",fi," ",nfi,"')"))) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \subsection{{\tt aplpack} script} \makemarginno $\langle${\it {\tt aplpack} script}\ $63\rangle\equiv$ \label{CodeChunkLabelAAGD} \rule{0mm}{0mm}\newline\verb? # doaplpack: Installation script for aplpack ?% \rule{0mm}{0mm}\newline\verb? # pw 09/2008 ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ### CLEAN ?% \rule{0mm}{0mm}\newline\verb? [ ! -d aplpack/R ] && mv aplpack/r aplpack/R ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ### BAGPLOT ?% \rule{0mm}{0mm}\newline\verb? echo "library(relax);tangleR(\"bagplot.rev\",expand.roots=\"\",expand.root.start=TRUE)" | R --vanilla ?% \rule{0mm}{0mm}\newline\verb? mv bagplot.R aplpack/R/bagplot.R ?% \rule{0mm}{0mm}\newline\verb? ##notangle -R"define [[bagplot]]" bagplot.rev > aplpack/R/bagplot.R ?% \rule{0mm}{0mm}\newline\verb? echo "library(relax);tangleR(\"bagplot.rev\",\"bagplot.Rd\", \ ?% \rule{0mm}{0mm}\newline\verb? expand.roots=\"define help of [[bagplot]]\",expand.root.start=FALSE)" | R --vanilla ?% \rule{0mm}{0mm}\newline\verb? grep "^[^#]" bagplot.Rd.R > aplpack/man/bagplot.Rd ?% \rule{0mm}{0mm}\newline\verb? rm bagplot.Rd.R ?% \rule{0mm}{0mm}\newline\verb? ## notangle -R"define help of [[bagplot]]" bagplot.rev > aplpack/man/bagplot.Rd ?% \rule{0mm}{0mm}\newline\verb? cp -p bagplot.rev aplpack/inst/src/ ?% \rule{0mm}{0mm}\newline\verb? cp -p work/bagplot.pdf aplpack/inst/pdf/ ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ### FACES ?% \rule{0mm}{0mm}\newline\verb? notangle -R"define [[faces]]" faces.rev > aplpack/R/faces.R ?% \rule{0mm}{0mm}\newline\verb? notangle -R"define [[plot.faces]]" faces.rev > aplpack/R/plot.faces.R ?% \rule{0mm}{0mm}\newline\verb? notangle -R"define [[faces]] help" faces.rev > aplpack/man/faces.Rd ?% \rule{0mm}{0mm}\newline\verb? cp -p faces.rev aplpack/inst/src/ ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ### MS stem-and-leaf ?% \rule{0mm}{0mm}\newline\verb? notangle -R"definiere ms" ms.rev > aplpack/R/stem.leaf.R ?% \rule{0mm}{0mm}\newline\verb? notangle -R"definiere Hilfe zu [[stem.leaf]]" ms.rev > aplpack/man/stem.leaf.Rd ?% \rule{0mm}{0mm}\newline\verb? cp -p ms.rev aplpack/inst/src/ ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ### SPIN3R ?% \rule{0mm}{0mm}\newline\verb? notangle -R"definiere [[spin3R]]" spin3R.rev > aplpack/R/spin3R.R ?% \rule{0mm}{0mm}\newline\verb? notangle -R"definiere Hilfe von [[spin3R]]" spin3R.rev > aplpack/man/spin3R.Rd ?% \rule{0mm}{0mm}\newline\verb? cp -p spin3R.rev aplpack/inst/src/ ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ### BOXPLOT2D ?% \rule{0mm}{0mm}\newline\verb? notangle -R"start" sc.rev > aplpack/R/boxplot2D.R ?% \rule{0mm}{0mm}\newline\verb? notangle -R"definiere Hilfe von [[boxplot2D]]" sc.rev > aplpack/man/boxplot2D.Rd ?% \rule{0mm}{0mm}\newline\verb? cp -p sc.rev aplpack/inst/src/ ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ### SLIDERFNS ?% \rule{0mm}{0mm}\newline\verb? #cp sliderfns/*.Rd aplpack/man/ ?% \rule{0mm}{0mm}\newline\verb? notangle -R"define help of [[slider.hist]]" \ ?% \rule{0mm}{0mm}\newline\verb? sliderfns/sliderfns.rev > aplpack/man/slider.hist.Rd ?% \rule{0mm}{0mm}\newline\verb? notangle -R"define help of [[slider.brush.pairs]] and of [[slider.brush.plot.xy]]" \ ?% \rule{0mm}{0mm}\newline\verb? sliderfns/sliderfns.rev > aplpack/man/slider.brush.Rd ?% \rule{0mm}{0mm}\newline\verb? notangle -R"define help of [[slider.split.plot.ts]]" \ ?% \rule{0mm}{0mm}\newline\verb? sliderfns/sliderfns.rev > aplpack/man/slider.split.plot.ts.Rd ?% \rule{0mm}{0mm}\newline\verb? notangle -R"define help of [[slider.zoom.plot.ts]]" \ ?% \rule{0mm}{0mm}\newline\verb? sliderfns/sliderfns.rev > aplpack/man/slider.zoom.plot.ts.Rd ?% \rule{0mm}{0mm}\newline\verb? notangle -R"define help of [[slider.smooth.plot.ts]]" \ ?% \rule{0mm}{0mm}\newline\verb? sliderfns/sliderfns.rev > aplpack/man/slider.smooth.plot.ts.Rd ?% \rule{0mm}{0mm}\newline\verb? notangle -R"define help of [[slider.lowess.plot]]" \ ?% \rule{0mm}{0mm}\newline\verb? sliderfns/sliderfns.rev > aplpack/man/slider.lowess.plot.Rd ?% \rule{0mm}{0mm}\newline\verb? notangle -R"define help of [[slider.bootstrap.lm.plot]]" \ ?% \rule{0mm}{0mm}\newline\verb? sliderfns/sliderfns.rev > aplpack/man/slider.bootstrap.lm.plot.Rd ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? #cat sliderfns/*.R > aplpack/R/sl.R ?% \rule{0mm}{0mm}\newline\verb? notangle -R"define [[slider.hist]]" \ ?% \rule{0mm}{0mm}\newline\verb? sliderfns/sliderfns.rev > aplpack/R/slider.hist.R ?% \rule{0mm}{0mm}\newline\verb? notangle -R"define [[slider.density]]" \ ?% \rule{0mm}{0mm}\newline\verb? sliderfns/sliderfns.rev > aplpack/R/slider.density.R ?% \rule{0mm}{0mm}\newline\verb? notangle -R"define [[slider.brush.pairs]]" \ ?% \rule{0mm}{0mm}\newline\verb? sliderfns/sliderfns.rev > aplpack/R/slider.brush.pairs.R ?% \rule{0mm}{0mm}\newline\verb? notangle -R"define [[slider.brush.plot.xy]]" \ ?% \rule{0mm}{0mm}\newline\verb? sliderfns/sliderfns.rev > aplpack/R/slider.brush.plot.xy.R ?% \rule{0mm}{0mm}\newline\verb? notangle -R"define [[slider.split.plot.ts]]" \ ?% \rule{0mm}{0mm}\newline\verb? sliderfns/sliderfns.rev > aplpack/R/slider.split.plot.ts.R ?% \rule{0mm}{0mm}\newline\verb? notangle -R"define [[slider.zoom.plot.ts]]" \ ?% \rule{0mm}{0mm}\newline\verb? sliderfns/sliderfns.rev > aplpack/R/slider.zoom.plot.ts.R ?% \rule{0mm}{0mm}\newline\verb? notangle -R"define [[slider.smooth.plot.ts]]" \ ?% \rule{0mm}{0mm}\newline\verb? sliderfns/sliderfns.rev > aplpack/R/slider.smooth.plot.ts.R ?% \rule{0mm}{0mm}\newline\verb? notangle -R"define [[slider.lowess.plot]]" \ ?% \rule{0mm}{0mm}\newline\verb? sliderfns/sliderfns.rev > aplpack/R/slider.lowess.plot.R ?% \rule{0mm}{0mm}\newline\verb? notangle -R"define [[slider.bootstrap.lm.plot]]" \ ?% \rule{0mm}{0mm}\newline\verb? sliderfns/sliderfns.rev > aplpack/R/slider.bootstrap.lm.plot.R ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? cp -p sliderfns/sliderfns.rev aplpack/inst/src/ ?% \rule{0mm}{0mm}\newline\verb? cp sliderfns/*.jpg aplpack/inst/doc/ ?% \rule{0mm}{0mm}\newline\verb? cat sliderfns/sliderfns.tex | sed "s/\\//" > aplpack/inst/doc/sliderfns.Snw ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ### SLIDER ?% \rule{0mm}{0mm}\newline\verb? cp /home/wiwi/pwolf/R/work/relax/install.dir/relax/man/slider.Rd aplpack/man/ ?% \rule{0mm}{0mm}\newline\verb? cp /home/wiwi/pwolf/R/work/relax/install.dir/relax/R/slider.R aplpack/R/ ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ### NAMESPACE ?% \rule{0mm}{0mm}\newline\verb? echo "exportPattern(\"^slider.[a-z]+\")" > tmp.tmp ?% \rule{0mm}{0mm}\newline\verb? echo "export(bagplot,boxplot2D,compute.bagplot,faces,plot.bagplot," >> tmp.tmp ?% \rule{0mm}{0mm}\newline\verb? echo " plot.faces,spin3R,stem.leaf)" >> tmp.tmp ?% \rule{0mm}{0mm}\newline\verb? mv tmp.tmp aplpack/NAMESPACE ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ### DESCRIPTION ?% \rule{0mm}{0mm}\newline\verb? cp DESCRIPTION aplpack/DESCRIPTION ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ### CHECK + BUILD ?% \rule{0mm}{0mm}\newline\verb? R CMD check aplpack; R CMD build aplpack ?% \rule{0mm}{0mm}\newline\verb? #rm lib/aplpack/R/aplpack.rdb ?% \rule{0mm}{0mm}\newline\verb? R CMD INSTALL --library=lib aplpack_1.2.2.tar.gz ?% \rule{0mm}{0mm}\newline\verb? cd lib; zip -r aplpack_1.2.2.zip aplpack/* ?% \rule{0mm}{0mm}\newline\verb? mv aplpack_1.2.2.zip .. ?% \rule{0mm}{0mm}\newline\verb? cd .. ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? exit 0 ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ### MANUALS generation of pdf manuals: ?% \rule{0mm}{0mm}\newline\verb? ## cp *rev pdfmake/ ?% \rule{0mm}{0mm}\newline\verb? cd pdfmake ; ?% \rule{0mm}{0mm}\newline\verb? revweb sc; latex sc; latex sc; dvipdf sc; ?% \rule{0mm}{0mm}\newline\verb? revweb faces; latex faces; latex faces; dvipdf faces; ?% \rule{0mm}{0mm}\newline\verb? revweb spin3R; latex spin3R; latex spin3R; dvipdf spin3R; ?% \rule{0mm}{0mm}\newline\verb? revweb ms; latex ms; latex ms; dvipdf ms ?% \rule{0mm}{0mm}\newline\verb? cd ../work ?% \rule{0mm}{0mm}\newline\verb? echo "library(relax);weaveR(\"bagplot.rev\")" | R --vanilla ?% \rule{0mm}{0mm}\newline\verb? latex bagplot; latex bagplot; dvipdf bagplot; ?% \rule{0mm}{0mm}\newline\verb? cp bagplot.pdf ../pdfmake/ ?% \rule{0mm}{0mm}\newline\verb? cd ../pdfmake/ ?% \rule{0mm}{0mm}\newline\verb? cp *pdf ../aplpack/inst/pdf ?% \rule{0mm}{0mm}\newline\verb? cd .. ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ## sliderfns manual ?% \rule{0mm}{0mm}\newline\verb? cd sliderfns ?% \rule{0mm}{0mm}\newline\verb? echo "library(relax); weaveR('sliderfns.rev')" |R --vanilla -q ?% \rule{0mm}{0mm}\newline\verb? latex sliderfns; latex sliderfns; dvipdf sliderfns ?% \rule{0mm}{0mm}\newline\verb? cp *.pdf ../pdfmake/ ?% \rule{0mm}{0mm}\newline\verb? cp sliderfns.pdf ../aplpack/inst/pdf/ ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \end{document} \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi ===================================================================== \makemarginno $\langle${\it *}\ $20\rangle+\equiv$ \label{CodeChunkLabelAAGE} \rule{0mm}{0mm}\newline\verb? system("notangle -Rdefine-tangleR ../../work/relax/webR/webR.rev > t.R") ?% \rule{0mm}{0mm}\newline\verb? source("t.R") ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? tangleR("sliderfns.rev","f.Rd","define help of [[slider.hist]]", FALSE, ?% \rule{0mm}{0mm}\newline\verb? insert.comment=FALSE,add.extension=FALSE) ?% \rule{0mm}{0mm}\newline\verb? #tangleR("sliderfns.rev","f.R","define [[slider.split.plot.ts]]", FALSE, ?% \rule{0mm}{0mm}\newline\verb? # insert.comment=FALSE) ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \makemarginno $\langle${\it old define {\tt slider.show.density}}\ $65\rangle\equiv$ \label{CodeChunkLabelAAGF} \rule{0mm}{0mm}\newline\verb? slider.show.norm<-function(name,...) ?% \rule{0mm}{0mm}\newline\verb? { ?% \rule{0mm}{0mm}\newline\verb? refresh<-function(...){ ?% \rule{0mm}{0mm}\newline\verb? lim1<-slider(no=1); lim2<-slider(no=2) ?% \rule{0mm}{0mm}\newline\verb? par1<-slider(no=3); par2<-slider(no=4) ?% \rule{0mm}{0mm}\newline\verb? x<-seq(min(lim1,lim2),max(lim1,lim2),length=200) ?% \rule{0mm}{0mm}\newline\verb? f.x<-dnorm(x,par1,par2) ?% \rule{0mm}{0mm}\newline\verb? main=paste("normal distribution\n", ?% \rule{0mm}{0mm}\newline\verb? "E(X) = ",format(par1,digits=3), ?% \rule{0mm}{0mm}\newline\verb? ", sd(X) =",format(par2,digits=3)) ?% \rule{0mm}{0mm}\newline\verb? plot(x,f.x,type="l",bty="n",main=main) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? slider(refresh, ?% \rule{0mm}{0mm}\newline\verb? c("x limit (min)","x limit (max)", ?% \rule{0mm}{0mm}\newline\verb? "expectation","standard deviation"), ?% \rule{0mm}{0mm}\newline\verb? c(-100,-100,-50,.001),c(100,100,50,100),c(1,1,.1,.1),c(-5,5,0,1) ?% \rule{0mm}{0mm}\newline\verb? ) ?% \rule{0mm}{0mm}\newline\verb? refresh() ?% \rule{0mm}{0mm}\newline\verb? cat("use slider to select parameter!\n") ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? slider.show.norm() ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi To simplify things we compute a function that sets default values of a {\tt alist}. ??? \makemarginno $\langle${\it *}\ $20\rangle+\equiv$ \label{CodeChunkLabelAAGG} \rule{0mm}{0mm}\newline\verb? replace.defaults<-function(new.args,...){ ?% \rule{0mm}{0mm}\newline\verb? defaults<-list(...) ?% \rule{0mm}{0mm}\newline\verb? for(i in seq(new.args)) ?% \rule{0mm}{0mm}\newline\verb? h<-match(names(new.args)[i],names(defaults.args)) ?% \rule{0mm}{0mm}\newline\verb? if(!is.na(h)){ ?% \rule{0mm}{0mm}\newline\verb? cat("found"); defaults[i]<-new.args[h];print(new.args[h])} else ?% \rule{0mm}{0mm}\newline\verb? defaults<-c(defaults,new.args[h]) ?% \rule{0mm}{0mm}\newline\verb? print(defaults) ?% \rule{0mm}{0mm}\newline\verb? return(defaults) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? slider.hist<-function(x,panel=rug,...) ?% \rule{0mm}{0mm}\newline\verb? { ?% \rule{0mm}{0mm}\newline\verb| |\verb??$\langle${\it check if {\tt x} is a vector} 14$\rangle$% \rule{0mm}{0mm}\newline\verb? args<-list(...) ?% \rule{0mm}{0mm}\newline\verb? args<-args[names(args)!="breaks"] ?% \rule{0mm}{0mm}\newline\verb? ClassNumber<-length(hist(x,plot=FALSE)$breaks) ?% \rule{0mm}{0mm}\newline\verb? # if(!any("main"==names(args)))args<-c(args,list(main=x.name)) ?% \rule{0mm}{0mm}\newline\verb? refresh<-function(...){ ?% \rule{0mm}{0mm}\newline\verb? xrange<-range(x); num<-slider(no=1) ?% \rule{0mm}{0mm}\newline\verb? breaks<-seq(xrange[1],xrange[2],length=num+1) ?% \rule{0mm}{0mm}\newline\verb? do.call("hist",c(alist(x=x,breaks=breaks), ?% \rule{0mm}{0mm}\newline\verb? replace.defaults(args,main="hallo",col="green") ?% \rule{0mm}{0mm}\newline\verb? )) ?% \rule{0mm}{0mm}\newline\verb? # do.call("hist",c(alist(x=x,breaks=breaks),args, ?% \rule{0mm}{0mm}\newline\verb? # list(main="asdhalldddd"))) ?% \rule{0mm}{0mm}\newline\verb? panel(x) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ## slider(refresh,"ClassNumber",1,100,1,ClassNumber); refresh() ?% \rule{0mm}{0mm}\newline\verb? refresh() ?% \rule{0mm}{0mm}\newline\verb? "use slider to select number of classes" ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? slider.hist(co2,main="red") ?% \rule{0mm}{0mm}\newline\verb? identical(alist(x=10,b=20),list(x=10,b=20)) ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ?% \ifodd\value{IsInCodeChunk}\setcounter{IsInCodeChunk}{0}\vspace{-\parskip}\par\hspace*{-\parindent}\textchunkcommands\fi \makemarginno $\langle${\it *}\ $20\rangle+\equiv$ \label{CodeChunkLabelAAGH} \rule{0mm}{0mm}\newline\verb? slider1<- ?% \rule{0mm}{0mm}\newline\verb? function (sl.functions, sl.names, sl.mins, sl.maxs, sl.deltas, ?% \rule{0mm}{0mm}\newline\verb? sl.defaults, but.functions, but.names, no, set.no.value, ?% \rule{0mm}{0mm}\newline\verb? obj.name, obj.value, reset.function, title) ?% \rule{0mm}{0mm}\newline\verb? { ?% \rule{0mm}{0mm}\newline\verb? if (!exists("slider.env")) ?% \rule{0mm}{0mm}\newline\verb? slider.env <<- new.env(parent = .GlobalEnv) ?% \rule{0mm}{0mm}\newline\verb? if (!missing(no)) ?% \rule{0mm}{0mm}\newline\verb? return(as.numeric(tclvalue(get(paste("slider", no, sep = ""), ?% \rule{0mm}{0mm}\newline\verb? env = slider.env)))) ?% \rule{0mm}{0mm}\newline\verb? if (!missing(set.no.value)) { ?% \rule{0mm}{0mm}\newline\verb? try(eval(parse(text = paste("tclvalue(slider", set.no.value[1], ?% \rule{0mm}{0mm}\newline\verb? ")<-", set.no.value[2], sep = "")), env = slider.env)) ?% \rule{0mm}{0mm}\newline\verb? return(set.no.value[2]) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? if (!missing(obj.name)) { ?% \rule{0mm}{0mm}\newline\verb? if (!missing(obj.value)) ?% \rule{0mm}{0mm}\newline\verb? assign(obj.name, obj.value, env = slider.env) ?% \rule{0mm}{0mm}\newline\verb? else obj.value <- get(obj.name, env = slider.env) ?% \rule{0mm}{0mm}\newline\verb? return(obj.value) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? if (missing(title)) ?% \rule{0mm}{0mm}\newline\verb? title <- "slider control widget" ?% \rule{0mm}{0mm}\newline\verb? if (missing(sl.names)) ?% \rule{0mm}{0mm}\newline\verb? sl.names <- NULL ?% \rule{0mm}{0mm}\newline\verb? if (missing(sl.functions)) ?% \rule{0mm}{0mm}\newline\verb? sl.functions <- function(...) { ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? require(tcltk) ?% \rule{0mm}{0mm}\newline\verb? nt <- tktoplevel() ?% \rule{0mm}{0mm}\newline\verb? tkwm.title(nt, title) ?% \rule{0mm}{0mm}\newline\verb? tkwm.geometry(nt, "+0+15") ?% \rule{0mm}{0mm}\newline\verb? assign("tktop.slider", nt, env = slider.env) ?% \rule{0mm}{0mm}\newline\verb? for (i in seq(sl.names)) { ?% \rule{0mm}{0mm}\newline\verb? ## dat <- c(no = i, value = sl.defaults[i], time = round(proc.time()[3] * 5)) ?% \rule{0mm}{0mm}\newline\verb? ## assign(paste("sl.dat.", i, sep = ""), dat, env = slider.env) ?% \rule{0mm}{0mm}\newline\verb? eval(parse(text = paste("assign('slider", i, "',tclVar(sl.defaults[i]),env=slider.env)", ?% \rule{0mm}{0mm}\newline\verb? sep = ""))) ?% \rule{0mm}{0mm}\newline\verb? tkpack(fr <- tkframe(nt)) ?% \rule{0mm}{0mm}\newline\verb? lab <- tklabel(fr, text = sl.names[i], width = "25") ?% \rule{0mm}{0mm}\newline\verb? sc <- tkscale(fr, from = sl.mins[i], to = sl.maxs[i], ?% \rule{0mm}{0mm}\newline\verb? showvalue = TRUE, resolution = sl.deltas[i], orient = "horiz") ?% \rule{0mm}{0mm}\newline\verb? tkpack(lab, sc, side = "right") ?% \rule{0mm}{0mm}\newline\verb? assign("sc", sc, env = slider.env) ?% \rule{0mm}{0mm}\newline\verb? eval(parse(text = paste("tkconfigure(sc,variable=slider", ?% \rule{0mm}{0mm}\newline\verb? i, ")", sep = "")), env = slider.env) ?% \rule{0mm}{0mm}\newline\verb? sl.fun <- if (length(sl.functions) > 1) ?% \rule{0mm}{0mm}\newline\verb? sl.functions[[i]] ?% \rule{0mm}{0mm}\newline\verb? else sl.functions ?% \rule{0mm}{0mm}\newline\verb? if (!is.function(sl.fun)) ?% \rule{0mm}{0mm}\newline\verb? sl.fun <- eval(parse(text = paste("function(...){", ?% \rule{0mm}{0mm}\newline\verb? sl.fun, "}"))) ?% \rule{0mm}{0mm}\newline\verb? # tkconfigure(sc, command = sl.fun) ?% \rule{0mm}{0mm}\newline\verb? tkbind(sc,"",sl.fun) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? assign("slider.values.old", sl.defaults, env = slider.env) ?% \rule{0mm}{0mm}\newline\verb? tkpack(f.but <- tkframe(nt), fill = "x") ?% \rule{0mm}{0mm}\newline\verb? tkpack(tkbutton(f.but, text = "Exit", command = function() tkdestroy(nt)), ?% \rule{0mm}{0mm}\newline\verb? side = "right") ?% \rule{0mm}{0mm}\newline\verb? if (!missing(reset.function)) { ?% \rule{0mm}{0mm}\newline\verb? if (!is.function(reset.function)) ?% \rule{0mm}{0mm}\newline\verb? reset.function <- eval(parse(text = paste("function(...){", ?% \rule{0mm}{0mm}\newline\verb? reset.function, "}"))) ?% \rule{0mm}{0mm}\newline\verb? tkpack(tkbutton(f.but, text = "Reset", command = function() { ?% \rule{0mm}{0mm}\newline\verb? for (i in seq(sl.names)) eval(parse(text = paste("tclvalue(slider", ?% \rule{0mm}{0mm}\newline\verb? i, ")<-", sl.defaults[i], sep = "")), env = slider.env) ?% \rule{0mm}{0mm}\newline\verb? reset.function() ?% \rule{0mm}{0mm}\newline\verb? }), side = "right") ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? if (missing(but.names)) ?% \rule{0mm}{0mm}\newline\verb? but.names <- NULL ?% \rule{0mm}{0mm}\newline\verb? for (i in seq(but.names)) { ?% \rule{0mm}{0mm}\newline\verb? but.fun <- if (length(but.functions) > 1) ?% \rule{0mm}{0mm}\newline\verb? but.functions[[i]] ?% \rule{0mm}{0mm}\newline\verb? else but.functions ?% \rule{0mm}{0mm}\newline\verb? if (!is.function(but.fun)) ?% \rule{0mm}{0mm}\newline\verb? but.fun <- eval(parse(text = c("function(...){", ?% \rule{0mm}{0mm}\newline\verb? but.fun, "}"))) ?% \rule{0mm}{0mm}\newline\verb? tkpack(tkbutton(f.but, text = but.names[i], command = but.fun), ?% \rule{0mm}{0mm}\newline\verb? side = "left") ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? invisible(nt) ?% \rule{0mm}{0mm}\newline\verb? } ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ?% \rule{0mm}{0mm}\newline\verb? ?%