Hysteresis ======================================================== An R package for fitting rate-dependent hysteretic loops ------------------------------------- Hysteresis loops occur when an output variable can have multiple possible values at one input value depending on the history of the system and the direction of change in the input. This package contains functions to simulate, fit, and obtain parameter values along with their standard errors (Yang and Parkhurst) from hysteresis loops of the form $$x_{t}=b_{x}cos(2t\pi/T+\phi)+c_{x}+e_{x,t}$$ $$y_{t}=b_{y}*cos(2t\pi/T+\phi)^{n}+R*sin(2t\pi/T+\phi)^{m}+c_{y}+e_{y,t}$$ where e is a random error term. These generalized transcendental equations (Lapshin) form a hysteresis loop for a given frequency or period and set of time points t=1,2...n. The plot below uses the function **mloop** which simulates hysteresis loops to show the effects of choosing various odd values for n and m. ```{r mandn,warning=FALSE,message=FALSE,fig.width=15,results='hide'} library(knitr) library(hysteresis) par(mfrow=c(3,3),mai=c(0,0.2,0.2,0),ann=FALSE,xaxt="n",yaxt="n",oma=c(0,0,3,0)) for (i in c(1,3,15)){ for (j in c(1,3,15)){ obj<-mloop(m=i,n=j,n.points=100,period=99) plot(floop(obj$x,obj$y,m=i,n=j,period=99),xlim=c(-0.8,0.8),ylim=c(-0.8,0.8)) if (i==1) title(paste("n=",j,sep="")) if (j==1) title(ylab=paste("m=",i,sep=""),line=0,cex.sub=2) } } title("Hysteresis Loops for Odd Values of m and n",outer=TRUE) ``` It is also possible to use even values for n. ```{r moremandn,warning=FALSE, fig.width=15} par(mfrow=c(3,3),mai=c(0,0.2,0.2,0),ann=FALSE,xaxt="n",yaxt="n",oma=c(0,0,3,0)) for (i in c(1,3,15)){ for (j in c(2,4,16)){ obj<-mloop(m=i,n=j,n.points=100,period=99) plot(floop(obj$x,obj$y,m=i,n=j,period=99),xlim=c(-0.8,0.8),ylim=c(-0.8,0.8)) if (i==1) title(paste("n=",j,sep="")) if (j==2) title(ylab=paste("m=",i,sep=""),line=0,cex.sub=2) } } title("Hysteresis Loops for Odd Values of m and Even Values of n",outer=TRUE) ``` A special case is when n=1 and m=1, this makes the hysteresis loop an ellipse. The centroid of the hysteresis loop is given by cx and cy as shown in the plot below of ellipses. ```{r} obj<-mloop(cx=0,cy=0,n.points=100,period=99) obj2<-mloop(cx=1.5,cy=0,n.points=100,period=99) obj3<-mloop(cx=0,cy=1.5,n.points=100,period=99) plot(obj$x,obj$y,type="l",xlim=c(-2,3),ylim=c(-2,3),xlab="x",ylab="y",col="#6600CC",main="Centroid Given by cx and cy") points(0,0,pch=19,col="#6600CC") text(x=0,y=0.15,"(cx=0,cy=0)",col="#6600CC") lines(obj2$x,obj2$y,col="#00FF66") points(1.5,0,pch=19,col="#00FF66") text(x=1.5,y=0.15,"(cx=1.5,cy=0)",col="#00FF66") lines(obj3$x,obj3$y,col="#FF6600") points(0,1.5,pch=19,col="#FF6600") text(x=0,y=1.65,"(cx=0,cy=1.5)",col="#FF6600") ``` The saturation points describe where the direction of the input changes sign. The distances from the central point to the saturation points are given by b.x and b.y (saturation points at ($c_{x} \pm b_{x},c_{y} \pm b_{y}$)) ```{r bx,fig.show='asis',fig.width=5} for (i in c(1,2,4)){ obj<-mloop(b.x=i,n.points=100,period=99) plot(obj$x,obj$y,xlim=c(-5,10),ylim=c(-1.4,1.4),type="l",main=paste("b.x=",i,sep=""),xlab="x",ylab="y") points(i,0.8,pch=19) legend(i,1,legend=c("Saturation Point","x=cx+b.x","y=cy+b.y"),bty="n") } ``` ```{r by,fig.show='asis',fig.width=5} for (i in c(0.8,2,4)){ obj<-mloop(b.y=i,n.points=100,period=99) plot(obj$x,obj$y,xlim=c(-1,2),ylim=c(-5,5),type="l",main=paste("b.y=",i,sep=""),xlab="x",ylab="y") points(0.6,i,pch=19) legend(0.6,i,legend=c("Saturation Point","x=cx+b.x","y=cy+b.y"),bty="n") } ``` Retention, or the output split point R, is the vertical distance from center to upper loop trajectory. ```{r retention,fig.show='asis',fig.width=5} for (i in c(1,2,4)){ obj<-mloop(retention=i,n.points=100,period=99) plot(obj$x,obj$y,xlim=c(-1,1),ylim=c(-5,5),type="l",main=paste("retention=",i,sep=""),xlab="x",ylab="y") segments(0,0,0,i) text(0.3,0.5,"Retention") } ``` Finally the phase.angle, $\phi$, changes the location of points along the loop, but does not change the form of the loop itself. When phase.angle is zero, the loop starting point is also the saturation point. ```{r} obj<-mloop(retention=0.5,n.points=100,period=99) plot(obj$x,obj$y,type="l",xlab="x",ylab="y",main="Starting Points for Different Values of phase.angle",xlim=c(-0.6,0.8)) for (i in c(0,90,180,260)){ obj2<-mloop(phase.angle=i,retention=0.5,n.points=1,period=99) points(obj2$x,obj2$y,pch=19,col="gold",cex=2) points(obj2$x,obj2$y,col="gold",cex=4) text(obj2$x+.08,obj2$y,round(i,2)) } ``` Fitting Ellipses ---------------------- ### The Process **Hysteresis** contains one method for fitting hysteresis loops given any n and m in the function **floop**. In the special case of an ellipse where n=1 and m=1, four methods are available in the function **fel**. The two-step simple harmonic regression (harmonic2) method, the default, generally produces estimates that are less biased and have lower variances than those produced by the other methods. Since the focus is on rate-dependent hysteresis, knowledge of time for the observations is required (or if unknown, times may be assumed to be equally spaced). On the other hand, if the objective is solely to fit an ellipse, observation times are not needed for the other three methods. ```{r} set.seed(24) ellipse1 <- mel(method=2,retention=0.4,b.x=0.6,b.y=0.8,cx=0,cy=0,sd.x=0.1,sd.y=0.1,phase.angle=0,period=24,n.points=24) #The function **mel** can be used as an alternative to **mloop** for simulating ellipses, and it is useful because it offers four different ellipse parameterizations. model <- fel(ellipse1$x,ellipse1$y,method="harmonic2",period=24,times="equal") #period=24 and times="equal" are used to say that 24 equally spaced points make up an ellipse. model ``` In addition to the fundamental values of the model, **fel** also calculates a wide variety of derived parameters. Definitions for these parameters can be found using **help(loop.parameters)**. ```{r} model$Estimates ``` A wide variety of functions have S3 methods for objects of class **ellipsefit** produced by **fel**. The most important of these is **summary.ellipsefit** which can be used to bootstrap and summarize models produced by **fel**. ```{r} summary(model,N=10000,studentize=TRUE) ``` Another important S3 method is for the function **plot**. ```{r} plot(model,main="2-step Simple Harmonic Regression Ellipse Example") ``` In addition, S3 methods exist for **fitted**, **print**, and **residuals**. ### Comparison of Ellipse Estimation Methods The two most useful ellipse estimation methods implemented by **fel** are the 'harmonic2' and 'direct' methods. The 'direct' method (Flusser and Halir) fits an ellipse without requiring time information and is more stable than the other two methods in **fel**, 'lm' and 'nls', which are based on linear least squares and ellipse-specific nonlinear regression respectively. The 'direct' method does not yet have delta method standard errors available. ```{r} modeldirect <- fel(ellipse1$x,ellipse1$y,method="direct",period=24,times="equal") summodel<-summary(modeldirect,N=10000,studentize=TRUE) summodel plot(modeldirect,main="Direct Ellipse Example") ``` The 'direct' method uses different fundamental parameters than the 'harmonic2' method. However summary results for b.x, b.y, and retention are still available from the matrix of values produced by summary.ellipsefit. ```{r} summodel$values ``` The four plots below illustrate a comparison of the four methods for fitting an ellipse to simulated data. The data points are based on the simulated red ellipse; the fitted ellipse is in black. ```{r tests,fig.width=10,fig.height=10,warning=FALSE,message=FALSE} set.seed(13) par(mfrow=c(2,2)) halfellipse <- mel(method=2,cx=20,cy=25,retention=1.2,b.x=14,b.y=0.8,sd.x=1,sd.y=0.2,period=24,n.points=16,phase.angle=pi/2) halftrueellipse <- mel(method=2,cx=20,cy=25,retention=1.2,b.x=14,b.y=0.8,phase.angle=0,period=99,n.points=100) harmodel<-fel(halfellipse$x,halfellipse$y,method="harmonic2",period=24,times="equal") dirmodel<-fel(halfellipse$x,halfellipse$y,method="direct",period=24,times="equal") lmmodel<-fel(halfellipse$x,halfellipse$y,method="lm",period=24,times="equal") nlsmodel<-fel(halfellipse$x,halfellipse$y,method="nls",period=24,times="equal",control=c(n.iter=500)) plot(harmodel,main="Harmonic2 Model",xlim=c(5,34),ylim=c(23.4,26.9)) lines(halftrueellipse$x,halftrueellipse$y,col="red") plot(dirmodel,main="Direct Model",xlim=c(5,34),ylim=c(23.4,26.9)) lines(halftrueellipse$x,halftrueellipse$y,col="red") plot(lmmodel,main="Linear Model",xlim=c(5,34),ylim=c(23.4,26.9)) lines(halftrueellipse$x,halftrueellipse$y,col="red") plot(nlsmodel,main="Non-Linear Model",xlim=c(5,34),ylim=c(23.4,26.9)) lines(halftrueellipse$x,halftrueellipse$y,col="red") ``` Geometric Method ------------------ The geometric ellipse method used here is based on the work of Gander, Golub and Strebel, and the code used is an R translation of the Matlab code they provided. This method directly minimizes the Euclidean distances from the ellipse through Gauss-Newton minimization. Standard errors are obtainable through either the Delta Method and bootstrapping, however the use of bootstrapping through summary.ellipsefit is discouraged on these ellipses as the geometric method is extremely computationally expensive. The "geometric" method works best when sd.x=sd.y, and it is important to check for false convergence. One way to check for false convergence is to examine the plot after fitting the data. ```{r geometric,warning=FALSE} set.seed(101) ellip <- mel(rote.deg=45,semi.major=5,semi.minor=3,n.points=13,sd.x=0.4,sd.y=0.4) true.ellip <- mel(rote.deg=45,semi.major=5,semi.minor=3,n.points=100,period=100) ellip.geometric <- fel(ellip$x,ellip$y,method="geometric") ellip.geometric$values plot(ellip.geometric,main="Geometric Model") lines(true.ellip$x,true.ellip$y,col="red") ``` Bootstrapping Fitted Ellipses ---------------------------------- The function **summary.ellipsefit** bootstraps the x and y residuals of a fitted ellipse separately to produce standard errors and less biased estimates of ellipse parameters. These residuals are easy to obtain using the 'harmonic2' model which gives fitted points when fitting the ellipse, but somewhat more difficult to obtain from the other methods which do not use time as a variable in fitting the model and therefore cannot place observations on the ellipse. The function **fel**, therefore, gives two methods for producing x and y residuals using these methods. If times="unknown", fitted values are taken to be the points on the ellipse closest to their realized values. If times="equal" or a numeric vector and the period of the ellipse is known, then the distances between points on the ellipse are taken as given and only the starting point of the ellipse is chosen to minimize the sum of squared distances between fitted and realized values. If times are available, it is always better to give them, as the residuals given by times='unknown' will lead to standard errors for ellipse parameters that are biased downwards. If times really are unknown, a good alternative is to use the delta standard errors from the function **delta.error** which is currently available for every method except the direct. In addition, residuals can be studentized within the **summary.ellipsefit** function by keeping studentize=TRUE, which is the default. Simulations suggest that studentization improves 95% bootstrap coverage intervals for all four methods. The value N gives the number of bootstrap replicates, its default is 1000 which may be low in some situations (Efron 1979). In each replication, residuals are resampled with replacement and added to the original fitted values produced by **fel**. The simulated ellipse is then refit using the original method and parameter estimates are obtained. The standard deviations of these estimates are then used to give parameter standard errors, and less biased parameter estimates are obtained by subtracting the estimated bias produced by the method, mean(bootstrap estimates) - (original estimate), from the original estimate. Note, if reproducible results are desired use set.seed() command. ### Comparison of Bootstrapped Ellipses The fitted black ellipses from above are then bootstrapped to reduce bias. ```{r boottest,fig.width=10,fig.height=10} par(mfrow=c(2,2)) harsummodel<-summary(harmodel,N=1000,studentize=TRUE) dirsummodel<-summary(dirmodel,N=1000,studentize=TRUE) lmsummodel<-summary(lmmodel,N=1000,studentize=TRUE) nlssummodel<-summary(nlsmodel,N=1000,studentize=TRUE) plot(harsummodel,main="Bootstrapped Harmonic2 Model",xlim=c(5,34),ylim=c(23.4,26.9)) lines(halftrueellipse$x,halftrueellipse$y,col="red") plot(dirsummodel,main="Bootstrapped Direct Model",xlim=c(5,34),ylim=c(23.4,26.9)) lines(halftrueellipse$x,halftrueellipse$y,col="red") plot(lmsummodel,main="Bootstrapped Lm Model",xlim=c(5,34),ylim=c(23.4,26.9)) lines(halftrueellipse$x,halftrueellipse$y,col="red") plot(nlssummodel,main="Bootstrapped Nls Model",xlim=c(5,34),ylim=c(23.4,26.9)) lines(halftrueellipse$x,halftrueellipse$y,col="red") ``` Fitting Multiple Ellipses Simultaneously ------------------------------------------ The argument subjects in the function **fel** can be used to fit multiple ellipses, which share the same period, at one time. In this case **fel** produces an object of class **ellipsefitlist** instead of **ellipsefit**, and methods for objects of class **ellipsefitlist** exist for the functions **summary**, **plot**, and **print**. Ellipses are separated by levels given by the argument subjects, which can be either a vector or a list of vectors treated as factors. Below is an example of fitting multiple ellipses using the subjects option. ```{r multiple,warning=FALSE} data(EllipseData) models <- fel(EllipseData$X,EllipseData$Y,method="harmonic2",subjects=EllipseData$subjects,subset=EllipseData$repeated==1) models summodels<-summary(models) summodels plot(summodels,main="Fitting Multiple Ellipses Simultaneously") ``` To output summary results to excel readable file at current directory ---------------------------------------------------------------------- ```{r mid,eval=FALSE} ## write.table(models$Estimates,"file_name.txt") and ## write.table(summodels$Boot.Estimates,"file_name.txt") ``` Fitting Hysteresis Loops -------------------------- The function **floop** can be used to fit hysteresis loops with specific values of n and m as arguments to **floop**. Below is an example of a hysteresis loop with n=5, m=3. ```{r} loop <- mloop(n=5, m=3,sd.x=0.02,sd.y=0.02) fitloop <- floop(loop$x,loop$y,n=5, m=3,period=24,times="equal") fitloop$Estimates plot(fitloop,main="Fitted Hysteresis Loop") summary(fitloop) ``` Acknowledgments ----------------- NIFA MRF 25-008/W-2173 Impacts of Stress Factors on Performance, Health, and Well Being of Farm Animals