What is Sexy?

There have been several report on how our society has been changing it's ideal of attractive / sexy over the years.  More than one lady I have know, have been concerned about that they were "Fat" or not sexy because they didn't look like the models.  Back in 2009 Wired Magazine did an article titled Infoporn: Today's Playmates Are More Like Anime Figures Than Real Humans  that looked at how Playboy Playmate's Body Mass Index (BMI) had changed over the years.  They showed a steady decrease in the Playmate's BMI.  The CDC defines a BMI between 18.5 and 24.9 is healthy.  25 and over is overweight and under 18.5 is underweight.

So I took the data and updated to April 2015 using the data from WeKinglyPigs. Here is what I found:

Bad News

• 48% of the playmates were underweight!

• There was a decreasing trend from 1953 - 1987 

  • The median playmate BMI was below (under weight) 29 of the 35 years (83%) from 1977 - 2012 

Good News

• The trend started to go upward around 1987 

• Some of the ladies that have been considered sex symbols were in the normal range

Here is the code to do the 2 graphs in R.  Files are attached  below.

#Code for ploting the points.

#set the dir to where you data is

setwd("c:/R")

#Load your data.  The data is in a spreadsheet named simple with NDs.csv and we are going to call it data in R

mydata <- read.table("playmatebmi.csv", header=TRUE, sep=",",)

attach(mydata)

reg1 <- lm(BMI~Year)

par(cex=1)

#Plots the data but makes nondetects a different color and type based on column D_BMI being a 0 for ND and 1 for detect.

plot(Year, BMI, col=ifelse(D_BMI, "black", "red"),ylab = "BMI", pch=ifelse(D_BMI, 19, 19), cex = 0.5)

# Apply loess smoothing using the default span value of 0.8.  You can change the curve by changing the span value.

y.loess <- loess(y ~ x, span=0.8, data.frame(x=Year, y=BMI))

# Compute loess smoothed values for all points along the curve

y.predict <- predict(y.loess, data.frame(x=Year))

# Plots the curve.

lines(Year,y.predict, lwd=3.5, lty=2)

# Plots line for underweight limit of 18.5

abline(a = NULL, b = NULL, h = 18.5, v = NULL, reg = NULL,

       coef = NULL, untf = FALSE)

 #Add Legend to graph.  You can change the size of the box by changing cex = 0.75  Large # makes it larger.

legend("topleft",

c("Smoothing Curve", "Underweight BMI<18.5 ", "Playmate’s BMI

(Red = Under weight)"),

col = c(1, "black","black"),

cex = 0.5,

text.col = "black",

lty = c(1 ,1, -1),

lwd= c(3.5,1,1),

pch = c(-1, -1, 19),

merge = TRUE, bg = 'gray90')

#Add title

title(main="Playboy Playmate BMI 1953 - 2013")

# Done

#Box Plot Code

#set the dir to where you data is

setwd("c:/R")

 #Load your data.  The data is in a spreadsheet named nd-spreadsheet and we are going to call it data in R

mydata <- read.table("Playmate-decade-data.csv", header=TRUE, sep=",",)

#makes the notched box plot.  "mydata" = the name of the data in R.

boxplot(mydata, notch=TRUE,

# Gives the title and axis names

main="Box Plots of Playmate BMI", xlab="Year", ylab="BMI",

#Sets the colors

col=(c("gold","darkgray", "darkorchid1", "cyan", "white", "red","limegreen", "magenta", "chartreuse1", "hotpink1")))

# Adds the line at 18.5

abline(a = NULL, b = NULL, h = 18.5, v = NULL, reg = NULL,

       coef = NULL, untf = FALSE)

 # Done