Nothing
#' @exportS3Method plot empCirc
#' @keywords calculus
#' @method plot empCirc
#' @title S3 plotting method for object of class \code{"empCirc"}
#' @description plotting method for object of class 'empCirc' which results from function \code{\link{Circ_emp}} and contains the empirical RIASEC angular locations extracted from the Mplus result file after running the Mplus syntax.
#' @details no details
#' @param x object of class 'empCirc'.
#' @param main titel for plot.
#' @param lcolor (character) vector for colors; default set to \code{lcolor=c("blue","blue","red","red")}.
#' @param ltype vector for line types; default set to \code{ltype=c(1,2)}
#' @param lwd numeric defining the line width; default set to \code{lwd=3}
#' @param defhexa list of definition to draw the hexagon
#' @param ... other parameters passed through
#' @return a plot visualizing the empirical RIASEC angular locations within the Hexagon.
#'
########################### hier die plot method #############################
plot.empCirc<-function(x,main=NULL, lcolor=c("blue","blue","red","red"), ltype=c(1,2), lwd=3, defhexa= list(hexa=TRUE, seg=TRUE,gr=5,r=4,nseg=7,x.cent=0,y.cent=0), ...)
{
############################## bedeutung der funktionsargumente ###########################
###########################################################################################
if(is.null(main)){main<-paste( "angular locations for ",deparse(substitute(x)),sep="")}
#if(main=="def"){main<-paste("plot for",x$empirisch$Mplus.datei,x$projektion$Mplus.datei,sep=" ")}
#if(main==""){main<-paste( "angular locations for ",deparse(substitute(x)),sep="")}
#plot( 1:10,1:10, type="n",asp=1)
#parameter:-------------------------
# x<- test # plotting objekt (ergebnis von Circ_emp)
# hochkant stehendes Hexagon fest eingestellt Realistic ist oben
#func. by: jhheine@googlemail.com
hexa <- defhexa$hexa
seg <- defhexa$seg
gr<-defhexa$gr # grösse der plotting area
r=defhexa$r #radius des hexagons
nseg=defhexa$nseg # segmente eigentlich hier konstant, da hexagon
x.cent <- defhexa$x.cent # zeichnen in der Mitte
y.cent <- defhexa$y.cent # zeichnen in der Mitte
# lcolor <- c("red","red","blue","blue","green","green") #farbe: hexag, beschriftunghexagon, empirisch,beschriftungempirisch, projektion, beschriftungprojektion
# ltype <- c(2,1,2) # linientyp: hexag, empirisch, projektion
# seg <- TRUE
# hexa <- TRUE
#-----------------------------------
H<-seq((0),((2*pi)), length.out=nseg) # 0 - 360 grad in 60
plot.new()
plot.window(xlim=c(-gr,gr), ylim=c(-gr,gr),asp=1,main=main)
#plot(x=c(-gr,gr), y=c(-gr,gr), type = "n", asp = 1, xlab = "", ylab = "",main=main)
Hxx <- x.cent + r*sin( H )
Hyy <- y.cent + r*cos( H )
# [1] hexagon aussenlinien plotten ------------
if(hexa==TRUE){
lines(Hxx,Hyy, col=lcolor[1],lty=ltype[1],lwd=lwd) # hexagon aussenlinien plotten
}
# [1] optional segmente ploten--------------
if (seg==TRUE){
for (i in 1:(nseg-1)){
lines(c(x.cent,Hxx[i]),c(y.cent,Hyy[i]), col=lcolor[1],lty=ltype[1],lwd=lwd) #
}}
# [2] perfekt beschriftungen hinzufügen --------------------
BP <- colnames(x$mat) # Beschriftung
BPxx <- x.cent + (r+.4)*sin( H[1:6] )
BPyy <- y.cent + (r+.4)*cos( H[1:6] )
text(BPxx,BPyy, labels= BP, col=lcolor[2]) # hexagon beschriftungen plotten col=c("green","blue","yellow","pink","red","black")
# [3] plotten der empirischen winkel ----------------------
#x$empirisch$mat[1,] #empirisch x$mat[2,] #perfect
rwink<-(x$mat[1, ]) #empirische winkel
Exx <- x.cent + r*sin((rwink))
Eyy <- y.cent + r*cos((rwink))
for (i in 1:6){
lines(c(x.cent,Exx[i]),c(y.cent,Eyy[i]),col=lcolor[3],lty=ltype[2],lwd=lwd) # empirische linien plotten col=c("green","blue","yellow","pink","red","black")[i] col=lcolor[3]
}
# [4] empirisch beschriftungen hinzufügen -----------------------
BE <- colnames(x$mat) #
BExx <- x.cent + (r-.7)*sin( (rwink+.1) ) # +.1-> stehen links daneben
BEyy <- y.cent + (r-.7)*cos( (rwink+.1) ) #
text(BExx,BEyy, labels= BE, col=lcolor[4]) # empirisch beschriftungen plotten col=c("green","blue","yellow","pink","red","black")
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.