R/sticky.R

#' Draw a stick figure
#'
#' This code draws a stick figure in an exsiting plot device
#'
#' @param x interger(1) corrdinate
#' @import plotrix shiny

#' @export
draw.stick <- function(x,y,scale=1,arms="down",
                       gender="male",lwd=3, clcol="white",
                       face="happy", linecol=gray(.3),
                       hat=NA) {
    # clcol: color of clothes - any color
    # scale: fize of figure
    # x,y left bottom alignment of figure
    # linecol: color of lines - any color
    # lwd: line weight

    # Arms: "down", "nuetral", "up", "hip", "wave"
    # Gender: "male", "female"
    # Face: "happy", "sad", "annoyed", "surprised"
    # Hat: plot hat T,F


    # Set the figure scale, default it 1
    s <- scale/100

    # If is undefined then give the man a hat
    if (is.na(hat)) hat<-(gender=="male")

    require("plotrix")

    # Draw Head
    draw.ellipse(x+50*s,y+75*s,10*s,15*s,lwd=lwd, border=linecol)

    if (face=="happy") {
        # Draw eyes
        draw.ellipse(x+46*s,y+77*s,2.5*s,2*s,lwd=lwd, border=linecol)
        draw.ellipse(x+54*s,y+77*s,2.5*s,2*s,lwd=lwd, border=linecol)

        # Draw mouth
        draw.ellipse(x+50*s,y+72*s,6*s,8*s, segment = c(-160,-20),
                     lwd=lwd, border=linecol)
    }
    if (face=="sad")   {
        # Draw eyes
        draw.ellipse(x+46*s,y+75*s,2*s,2*s,lwd=lwd, border=linecol)
        draw.ellipse(x+54*s,y+75*s,2*s,2*s,lwd=lwd, border=linecol)

        # Draw mouth
        draw.ellipse(x+50*s,y+60*s,6*s,8*s, segment = c(140,40),
                     lwd=lwd, border=linecol)
    }

    if (face=="surprised")   {
        # Draw eyes
        draw.ellipse(x+46*s,y+78*s,3*s,2*s,lwd=lwd, border=linecol)
        draw.ellipse(x+54*s,y+78*s,3*s,2*s,lwd=lwd, border=linecol)

        # Draw irises
        #  draw.ellipse(x+46*s,y+78*s,1*s,1*s,lwd=lwd, border=linecol)
        #  draw.ellipse(x+54*s,y+78*s,1*s,1*s,lwd=lwd, border=linecol)

        # Draw mouth
        draw.ellipse(x+50*s,y+65*s,3*s,4*s,
                     lwd=lwd, border=linecol)
    }


    if (face=="annoyed")  {
        # Draw mouth
        lines(c(x+46*s,x+55*s), c(y+66*s,y+68*s),lwd=lwd, col=linecol)

        # Draw eyes
        draw.ellipse(x+46*s,y+76*s,2*s,2*s,lwd=lwd, border=linecol)
        draw.ellipse(x+54*s,y+76*s,2*s,1*s,lwd=lwd, border=linecol)
    }




    # Draw torso
    lines(c(x+50*s,x+50*s), c(y+35*s,y+60*s),lwd=lwd, col=linecol)

    # Draw arms
    if (arms=="down") {
        lines(c(x+50*s,x+36*s), c(y+55*s,y+30*s),lwd=lwd, col=linecol) # Left
        lines(c(x+50*s,x+64*s), c(y+55*s,y+30*s),lwd=lwd, col=linecol) # Right
    }
    if (arms=="nuetral") {
        lines(c(x+50*s,x+30*s), c(y+50*s,y+55*s),lwd=lwd, col=linecol) # Left
        lines(c(x+50*s,x+70*s), c(y+50*s,y+55*s),lwd=lwd, col=linecol) # Right
    }
    if (arms=="up") {
        lines(c(x+50*s,x+32*s), c(y+50*s,y+65*s),lwd=lwd, col=linecol) # Left
        lines(c(x+50*s,x+68*s), c(y+50*s,y+65*s),lwd=lwd, col=linecol) # Right
    }
    if (arms=="hip") {
        lines(c(x+50*s,x+37*s,x+48*s), c(y+56*s,y+47*s,y+40*s),lwd=lwd, col=linecol) # Left
        lines(c(x+50*s,x+63*s,x+51*s), c(y+56*s,y+49*s,y+62*s),lwd=lwd, col=linecol) # Right
    }
    if (arms=="wave") {
        lines(c(x+50*s,x+38*s,x+33*s), c(y+56*s,y+60*s,y+78*s),lwd=lwd, col=linecol) # Left
        lines(c(x+50*s,x+63*s,x+52*s), c(y+56*s,y+47*s,y+40*s),lwd=lwd, col=linecol) # Right
    }

    # Draw male legs
    if (gender=="male") {
        lines(c(x+50*s,x+40*s), c(y+35*s,y+5*s),lwd=lwd, col=linecol)
        lines(c(x+50*s,x+60*s), c(y+35*s,y+5*s),lwd=lwd, col=linecol)

    }

    # Draw female legs and dress
    if (gender!="male") {
        # Draw legs
        lines(c(x+45*s,x+45*s), c(y+17*s,y+5*s),lwd=lwd, col=linecol)
        lines(c(x+55*s,x+55*s), c(y+17*s,y+5*s),lwd=lwd, col=linecol)

        # Draw dress
        polygon(c(x+s*50,x+s*35,x+s*65),
                c(y+s*40,y+s*17,y+s*17),
                col=clcol, border=linecol,lwd=lwd)
    }

    # Draw hat
    if (hat==T) polygon(
        c(x+35*s,x+65*s,x+65*s,x+59*s,x+58*s,x+42*s,x+41*s,x+35*s),
        c(y+84*s,y+84*s,y+86*s,y+86*s,y+91*s,y+91*s,y+86*s,y+86*s),
        col=clcol, border=linecol,lwd=lwd)

}


#' @export
stickyplot <- function(face, gender, arms) {
    plot(c(.25,.75), c(0,1), type="n")
    draw.stick(0,0,
               face=tolower(face),
               gender=tolower(gender),
               arms=tolower(arms),
               hat=F)

}

#' @importFrom shiny runApp
#' @export
sticky <- function() {
    path <- system.file(package = "Knees", "sticky")
    runApp(path)
}
ziqiangc/Knees documentation built on May 4, 2019, 11:23 p.m.