June 21, 2017

Application Summary

This application predicts height of child through his gender and the height of the parents. This data set lists the individual observations for 934 children in 205 families on which Galton (1886) based his cross-tabulation.

In addition to the question of the relation between heights of parents and their offspring, for which this data is mainly famous, Galton had another purpose which the data in this form allows to address: Does marriage selection indicate a relationship between the heights of husbands and wives, a topic he called assortative mating? Keen p. 297-298 provides a brief discussion of this topic

R Code

library(shiny)
library(HistData)
data(GaltonFamilies)
library(dplyr)
library(ggplot2)

# converting in centimeters
gf <- GaltonFamilies
gf <- gf %>% mutate(father=father*2.54,
                    mother=mother*2.54,
                    childHeight=childHeight*2.54)

# linear model
regmod <- lm(childHeight ~ father + mother + gender, data=gf)

ui.r

library(shiny)

shinyUI(fluidPage(
  titlePanel("Prediction of height of the child through his parents"),
  sidebarLayout(
    sidebarPanel(
      helpText("This application predicts height of child through his gender and the height of the parents."),
      helpText("Please make a choise of parameters:"),
      sliderInput(inputId = "inFh",
                  label = "Father's height in centimeters:",
                  value = 150,
                  min = 150,
                  max = 200,
                  step = 1),
      sliderInput(inputId = "inMh",
                  label = "Mother's height in centimeters:",
                  value = 150,
                  min = 150,
                  max = 200,
                  step = 1),
      radioButtons(inputId = "inGen",
                   label = "Child's gender: ",
                   choices = c("Female"="female", "Male"="male"),
                   inline = TRUE)
    ),
    
    mainPanel(
      htmlOutput("parentsText"),
      htmlOutput("prediction"),
      plotOutput("barsPlot", width = "50%")
    )
  )
))

server.r

library(shiny)
library(HistData)
data(GaltonFamilies)
library(dplyr)
library(ggplot2)

# converting in centimeters
gf <- GaltonFamilies
gf <- gf %>% mutate(father=father*2.54,
                    mother=mother*2.54,
                    childHeight=childHeight*2.54)

# linear model
regmod <- lm(childHeight ~ father + mother + gender, data=gf)

shinyServer(function(input, output) {
  output$parentsText <- renderText({
    paste("When the father's height is",
          strong(round(input$inFh, 1)),
          "cm, and mother's is",
          strong(round(input$inMh, 1)),
          "cm, then:")
  })
  output$prediction <- renderText({
    df <- data.frame(father=input$inFh,
                     mother=input$inMh,
                     gender=factor(input$inGen, levels=levels(gf$gender)))
    ch <- predict(regmod, newdata=df)
    sord <- ifelse(
      input$inGen=="female",
      "Daugther",
      "Son"
    )
    paste0(em(strong(sord)),
           "'s predicted height would be approximately ",
           em(strong(round(ch))),
           " cm"
    )
  })
  output$barsPlot <- renderPlot({
    sord <- ifelse(
      input$inGen=="female",
      "Daugther",
      "Son"
    )
    df <- data.frame(father=input$inFh,
                     mother=input$inMh,
                     gender=factor(input$inGen, levels=levels(gf$gender)))
    ch <- predict(regmod, newdata=df)
    yvals <- c("Father", sord, "Mother")
    df <- data.frame(
      x = factor(yvals, levels = yvals, ordered = TRUE),
      y = c(input$inFh, ch, input$inMh),
      colors = c("pink", "orange", "blue")
    )
    ggplot(df, aes(x=x, y=y, color=colors, fill=colors)) +
      geom_bar(stat="identity", width=0.5) +
      xlab("") +
      ylab("Height (cm)") +
      theme_minimal() +
      theme(legend.position="none")
  })
})