Using R for Face Detection through AWS Rekognition

Today I experimented a little with the Rekognition service that AWS offers. I started out by experimenting with doing a Python version of this project, following this K-pop Idol Identifier with Rekognition post. It was pretty easy to setup; however, I tend to use R more than Python for data analysis and manipulation.

I found the excellent paws package, which is available through CRAN. The documentation for the paws package is very good, organized in an attractive github site here.

To start, I just duplicated the Python project in R, which was fairly straightforward. Then, I expanded on it a bit to annotate a photo with information about the emotional expressions being displayed by any subjects. The annotated image above shows what the script outputs if it is given a photo of my kids. And, here’s the commented code that walks through what I did.

########################
# Setup the environment with libraries and the key service
########################

# Use the paws library for easy access to aws
# Note: You will need to authenticate. For this project, I have my credentials in an
# AWS configuration; so, paws looks there for them.
# paws provides good information on how to do this:
# https://github.com/paws-r/paws/blob/master/docs/credentials.md
library(paws)

# Use the magick library for image functions.
library(magick)

# This application is going to use the rekognition service from AWS. The paws documentation is here:
# # https://paws-r.github.io/docs/rekognition/
svc <- rekognition()

########################
# First, create a new collection that you will use to store the set of identified faces. This will be
# the library of faces that you use for determining someone's identity
########################

# I am going to create a collection for a set of family photos
svc$create_collection(CollectionId = "family-r")

# I stored a set of faces of my kids in a single directory on my Desktop. Inside
# this directory are multiple photos of each person, with the filename set as personname_##.png. This
# means that there are several photos per kid, which should help with classification.

# Get the list of files
path = "~/Desktop/family"
file.names = dir(path, full.names=F)

# Loop through the files in the specified folder, add and index them in the collection
for(f in file.names) {
    imgFile = paste(path,f,sep="/")
    # This gets the name of the kid, which is embedded in the filename and separated from the number with an underscore
    imgName = unlist(strsplit(f,split="_"))[[1]]
    # Add the photos and the name to the collection that I created
    svc$index_faces(CollectionId="family-r", Image=list(Bytes=imgFile), ExternalImageId=imgName, DetectionAttributes=list())
}

########################
# Second, take a single photo that has multiple kids in it. Label each kid with his name and the
# emotions that are expressed in the photo.
########################

# Get information about a group photo
grp.photo = "~/Desktop/all_three_small.png"

# Read the photo using magick
img = image_read(grp.photo)

# Get basic informatino about the photo that will be useful for annotating
inf = image_info(img)

# Detect the faces in the image and pull all attributes associated with faces
o = svc$detect_faces(Image=list(Bytes=grp.photo), Attributes="ALL")

# Just get the face details
all_faces = o$FaceDetails
length(all_faces)

# Loop through the faces, one by one. For each face, draw a rectangle around it, add the kid's name, and emotions

# Duplicate the original image to have something to annotate and output
new.img = img

for(face in all_faces) {

    # Prepare a label that collapses across the emotions data provided by rekognition. Give the type of
    # emotion and the confidence that AWS has in its expression.
    emo.label = ""
    for(emo in face$Emotions) {
        emo.label = paste(emo.label,emo$Type, " = ", round(emo$Confidence, 2), "\n", sep="")
    }

    # Identify the coordinates of the face. Note that AWS returns percentage values of the total image size. This is
    # why the image info object above is needed
    box = face$BoundingBox
    image_width=inf$width
    image_height=inf$height
    x1 = box$Left*image_width
    y1 = box$Top*image_height
    x2 = x1 + box$Width*image_width
    y2 = y1 + box$Height*image_height  

    # Create a subset image in memory that is just cropped around the focal face
    img.crop = image_crop(img, paste(box$Width*image_width,"x",box$Height*image_height,"+",x1,"+",y1, sep=""))
    img.crop = image_write(img.crop, path = NULL, format = "png")

    # Search in a specified collection to see if we can label the identity of the face is in this crop
    o = svc$search_faces_by_image(CollectionId="family-r",Image=list(Bytes=img.crop), FaceMatchThreshold=70)

    # Create a graphics device version of the larger photo that we can annotate
    new.img = image_draw(new.img)

    # If the face matches something in the collection, then add the name to the image
    if(length(o$FaceMatches) > 0) {
        faceName = o$FaceMatches[[1]]$Face$ExternalImageId
        faceConfidence = round(o$FaceMatches[[1]]$Face$Confidence,3)
        print(paste("Detected: ",faceName, sep=""))
        # Annotate with the name of the person
        text(x=x1+(box$Width*image_width)/2, y=y1,faceName, adj=0.5, cex=3, col="green")
    }

    # Draw a rectangle around the face
    rect(x1,y1,x2,y2, border="red", lty="dashed", lwd=5)   

    # Annotate the photo with the emotions information
    text(x=x1+(box$Width*image_width)/2, y=y1+50,emo.label, pos=1, cex=1.5, col="red")     

    dev.off()
}

# Write the image out to file
image_write(new.img, path="~/Desktop/annotated_image.png", format="png")

Start-Up Teams: A Multidimensional Conceptualization, Integrative Review of Past Research, and Future Research Agenda

Knight, A. P., Greer, L. L., & de Jong, B. (2020). Start-up teams: A multidimensional conceptualization, integrative review of past research, and future research agenda. Academy of Management Annals, 14, 231-266.

Abstract. Academic interest in start-up teams has grown dramatically over the past 40 years, with researchers from a wide variety of disciplines actively studying the topic. Although this widespread interest is encouraging, a review of the literature reveals a lack of consensus in how researchers conceptualize and operationally define start-up teams. A lack of consensus on the core phenomenon—a foundational part of a strong paradigm—has stifled the systematic advancement of knowledge about start-up teams, which has downstream implications for the viability of this field of research. To advance the development of a stronger paradigm, we present a multidimensional conceptualization of start-up teams that is derived from points of consensus in existing definitions. Our multidimensional conceptualization accounts for the fact that, although all are under the umbrella of the concept of “start-up team,” start-up teams vary in a set of key ingredients—ownership of equity, autonomy of strategic decision-making, and entitativity. This conceptualization serves as a framework for reviewing and beginning to integrate past research on start-up teams. It also serves as a framework for guiding and informing an integrated program of future research on start-up teams. By introducing a multidimensional conceptualization of start-up teams, we highlight the value of considering the defining ingredients of start-up teams for furthering a stronger paradigm.

On the relation between felt trust and actual trust: Examining pathways to and implications of leader trust meta-accuracy

Campagna, R. L., Dirks, K. T., Knight, A. P., Crossley, C., & Robinson, S. L. (In Press). On the relation between felt trust and actual trust: Examining pathways to and implications of leader trust meta-accuracy. Journal of Applied Psychology.

Abstract. Research has long emphasized that being trusted is a central concern for leaders (Dirks & Ferrin, 2002), but an interesting and important question left unexplored is whether leaders feel trusted by each employee, and whether their felt trust is accurate. Across two field studies, we examined the factors that shape the accuracy of leaders’ felt trust—or, their trust meta-accuracy—and the implications of trust meta- accuracy for the degree of relationship conflict between leaders and their employees. By integrating research on trust and interpersonal perception, we developed and tested hypotheses based on two theoretical mechanisms—an external signaling mechanism and an internal presumed reciprocity mechanism—that theory suggests shape leaders’ trust meta-accuracy. In contrast to the existing literature on felt trust, our results reveal that leader trust meta-accuracy is shaped by an internal mechanism and the presumed reciprocity of trust relationships. We further find that whether trust meta-accuracy is associated with positive relational outcomes for leaders depends upon the level of an employee’s actual trust in the leader. Our research contributes to burgeoning interest in felt trust by elucidating the mechanisms underlying trust meta-accuracy and suggesting practical directions for leaders who seek to accurately understand how much their employees trust them.

Spring 2020 Courses

People Metrics
Open to BSBA, MBA, and Specialized Masters students

Metrics are at the core of people analytics. The purpose of this course is to introduce you to the foundations of assessing behavior in organizations using novel measurement approaches and large datasets. Through classroom discussions and real-world applications, this course will enable you to add value to organizations through the development, use, and interpretation of innovative people metrics. Specifically, after taking this course, you will be able to:

  • Develop a clear and logical conceptual measurement model. A conceptual measurement model is the foundation of creating novel and useful new approaches for assessing intrapersonal characteristics (e.g., personality) and interpersonal behavior (e.g., knowledge sharing, teamwork).
  • Identify novel sources of data for innovative people metrics. Organizations are awash in the traces of individual behavior and social interactions. Decoding how data that already exist in an organization can be used to understand behavior is an essential skill for adding value in the field of people analytics.
  • Apply a rigorous process for validating new people metrics. Developing a measurement model and finding sources of data are necessary, but insufficient for adding value through people metrics. New measures must be validated.

Fall 2019 Courses

Leadership Development
2nd Year Full-Time MBA OB Core Course

This course builds upon the material from the 1st Year OB Core (OB 5620, Foundations for Leadership Effectiveness) and, importantly, from your time so far at Olin and during your summer work experiences. The focus of the course is on the attributes, behaviors, and tendencies of effective leadership. There are two primary objectives:

  • Gain new insights into your own beliefs and expectations regarding what constitutes effective leadership in organizations. You will accomplish this through a mixture of classroom discussion, case analysis, and self-assessment.
  • Learn about your own strengths and weaknesses in leading others. You will accomplish this in the classroom through controlled experiential exercises, which will be the basis for feedback from your peers. You will also reflect in depth on your strengths using feedback provided by people you have encountered in your life and career through a structured exercise.

Summer 2019 Courses

Foundations of Impactful Teamwork
Required Course for 1st Year MBA Students

Working effectively in and leading teams are essential competencies in modern organizations, both large and small. The purpose of this course is to lay a foundation of knowledge and skills that will enable you to differentiate yourself as an effective leader and member of impactful teams. The specific learning objectives for this course include:

  • Be able to skillfully launch and lead goal-directed project teams that meet or exceed stakeholders’ expectations for task performance, provide a positive working experience for team members, and enable team members to grow as a unit and as individuals.
  • Be able to diagnose common interpersonal challenges that arise in teams composed of diverse individuals who are working under pressure in unfamiliar environments; and, apply evidence-based practices for leading teams through these challenges.
  • Refine your awareness of your personal strengths and weaknesses as a leader and develop a plan for honing your leadership identity and interpersonal skills during your MBA program.
  • Augment your resourcefulness when navigating diverse local environments and unfamiliar cultures and societies.

On the emergence of collective psychological ownership in new creative teams

Gray, S. M., Knight, A. P., & Baer, M. (2020). On the emergence of collective psychological ownership in new creative teams. Organization Science, 31, 141-164.

Abstract. We develop and test a theoretical model that explains how collective psychological ownership—shared feelings of joint possession over something—emerges within new creative teams that were launched to advance one person’s (i.e., a creative lead’s) preconceived idea. Our model proposes that such teams face a unique challenge—an initial asymmetry in feelings of psychological ownership for the idea between the creative lead who conceived the idea and new team members who are beginning to work on the idea. We suggest that the creative lead can resolve this asymmetry and foster the emergence of collective psychological ownership by enacting two interpersonal behaviors—help seeking and territorial marking. These behaviors build collective ownership by facilitating the unifying, centripetal force of team identification and preventing the divisive, centrifugal force of team ownership conflict. Our model also proposes that collective ownership positively relates to the early success of new creative teams. The results of a quantitative study of 79 creative teams participating in an entrepreneurship competition provided general support for our predictions, but also suggested refinements as to how a creative lead’s behavior influences team dynamics. The findings of a subsequent qualitative investigation of 27 teams participating in a university startup launch course shed additional light on how collective ownership emerges in new creative teams launched to advance one person’s idea.

Using R to Analyze Twitter

The code below will give you a start on processing text data from Twitter. There are some basic examples of how to pull down tweets for selected users and compare/contrast the sentiment of their posts.

#####################
# This script illustrates how to pull data from
# twitter and use default settings for English
# language sentiment analysis
#####################
library(twitteR)
library(rtweet)
library(syuzhet)
library(ngram)
library(reshape2)
require(dplyr)
library(timeDate)
library(ggplot2)

#####################
# This is just a crude string cleaning function for the purposes
# of illustration.
#####################

clean.string <- function(string){
    # Lowercase
    temp <- tolower(string)
    # Remove everything that is not a number or letter (may want to keep more
    # stuff in your actual analyses).
    temp <- stringr::str_replace_all(temp,"[^a-zA-Z\\s]", " ")
    # Shrink down to just one white space
    temp <- stringr::str_replace_all(temp,"[\\s]+", " ")
    return(temp)
}

#####################
# this function returns a crude sentiment analysis of the tweets from a set of
# users' timelines. You must provide a vector of users.
#####################

twit.sentiment <- function(users, n.tweets=200, include.retweet=FALSE) {
    sent.vars = c("anger", "anticipation", "disgust", "fear", "joy", "sadness", "surprise", "trust", "negative", "positive")   
    d.vars = c("user_id", "screen_name", "created_at", "retweet_count", "favorite_count", "followers_count", "friends_count", "text")
    d = data.frame(get_timelines(users, n=n.tweets, parse=TRUE))

    # do a very light text cleaning
    d$text_clean = unlist(lapply(d$text, clean.string))

    # count the clean words
    d$n_words = unlist(lapply(d$text_clean, wordcount))

    # Do the sentiment analysis using nrc. In a real production sentiment analysis, you would want
    # to consider several different dictionaries. Check out the following page for a walkthrough of
    # some of the different lexicons you might consider:
    # https://cran.r-project.org/web/packages/syuzhet/vignettes/syuzhet-vignette.html
    d[,sent.vars] = bind_rows(lapply(d$text_clean, get_nrc_sentiment))
    head(d)

    # Get a percentage of pos/neg by number of words in the email
    d$neg_pct = d$negative/d$n_words
    d$pos_pct = d$positive/d$n_words

    if(include.retweet) {
        d.sub = d[,c(d.vars, sent.vars)]       
    } else {
        d.sub = d[!(d$is_retweet),c(d.vars, sent.vars)]    
    }
    return(d.sub)
}

#####################
# Explore the dictionaries, showing how different
# words are coded
#####################

nrc = get_sentiment_dictionary(dictionary = "nrc", language = "english")
syuzhet = get_sentiment_dictionary(dictionary = "syuzhet", language = "english")

nrc[nrc$word == "horrible", ]
syuzhet[syuzhet$word == "horrible", ]

nrc[nrc$word == "disastrous", ]
syuzhet[syuzhet$word == "disastrous", ]

#####################
# Exploring sentiment analysis
#####################

v1 = "Man, I am having the best day today. The sun is out and it is a beautiful day."
v2 = "So grateful to be part of this supportive community. This is an amazing place to work."
v3 = "What a horrible day. Not only is it storming, but I fell in the mud and broke my phone."
v4 = "Awful bosses and terrible co-workers. This is a ridiculously bad place to work."

v5 = "I am not having the best day today. The sun is not out and it is not a beautiful day."
v6 = "Some days are better than others. This is the latter."
v7 = "So, got my final back. Um, yeah. The professor sure knows how to give the gift of a great day."
v8 = "Great idea Olin...Make all the students swipe their cards just to get onto the 4th floor. Beautiful building that we can't access."

get_nrc_sentiment(clean.string(v1))
get_nrc_sentiment(clean.string(v2))
get_nrc_sentiment(clean.string(v3))
get_nrc_sentiment(clean.string(v4))
get_nrc_sentiment(clean.string(v5))
get_nrc_sentiment(clean.string(v6))
get_nrc_sentiment(clean.string(v7))
get_nrc_sentiment(clean.string(v8))

#####################
# The first thing you need to do is create an app for your twitter account
# you can find instructions here:
# https://developer.twitter.com/en/docs/basics/apps/overview.html

# Once you've created an app, then add the following information to this script
#####################
# twitter_consumer_key = "YOUR INFO HERE"
# twitter_consumer_secret = "YOUR INFO HERE"
# twitter_access_token = "YOUR INFO HERE"
# twitter_access_secret = "YOUR INFO HERE"

setup_twitter_oauth(twitter_consumer_key, twitter_consumer_secret, twitter_access_token, twitter_access_secret)

#####################
# Sample sentiment analysis on accounts where
# we have strong priors about their sentiment
#####################

sad_happy = c("sosadtoday", "angrymemorys", "gohappiest", "kindnessgirl")
d.sh = twit.sentiment(users=sad_happy, n.tweets=200, include.retweet=F)
boxplot(positive~screen_name, data=d.sh, cex.axis=.7, las=2, main="positive")
boxplot(negative~screen_name, data=d.sh, cex.axis=.7, las=2, main="negative")

#####################
# Illustrating the potential for looking at specific users and
# comparing / contrasting individual employees' sentiment
#####################

OlinPeeps = c("DeanTaylorWashU", "sjmalter", "LamarPierce1", "OrgStratProf")
BSchoolDeans = c("DeanTaylorWashU", "scottderue")
BSchools = c("OlinBusiness", "Wharton")

d.olin = twit.sentiment(users=OlinPeeps, n.tweets=300, include.retweet=F)
d.deans = twit.sentiment(users=BSchoolDeans, n.tweets=300, include.retweet=F)
d.schools = twit.sentiment(users=BSchools, n.tweets=300, include.retweet=F)

boxplot(positive~screen_name, data=d.olin, cex.axis=.7, las=2, main="positive")
boxplot(negative~screen_name, data=d.olin, cex.axis=.7, las=2, main="negative")

boxplot(positive~screen_name, data=d.deans, cex.axis=.7, las=2, main="positive")
boxplot(negative~screen_name, data=d.deans, cex.axis=.7, las=2, main="negative")

boxplot(positive~screen_name, data=d.schools, cex.axis=.7, las=2, main="positive")
boxplot(negative~screen_name, data=d.schools, cex.axis=.7, las=2, main="negative")

#####################
# Illustrating the potential for looking at trends over time
#####################
olin.all = c("DeanTaylorWashU", "sjmalter", "LamarPierce1", "OrgStratProf", "sethcarnahan", "peterboumgarden",
    "jrobmartin", "milbourn_todd", "danbentle", "wustlbusiness", "drpatsportsbiz", "analisaortiz", "krwools")

d.lrg = twit.sentiment(users=olin.all, n.tweets=300, include.retweet=F)

d.lrg$date = as.Date(d.lrg$created_at)
d.lrg$year = as.numeric(strftime(d.lrg$date, format="%Y"))
d.lrg$month = as.numeric(strftime(d.lrg$date, format="%m"))
d.lrg$woy = as.numeric(strftime(d.lrg$date, format="%V"))

o = aggregate(d.lrg[,c("positive", "negative")], by=list(d.lrg$year, d.lrg$month), mean)
names(o)[1:2] = c("year", "month")

plot(o[o$year == 2018, "month"], o[o$year == 2018, "positive"], type="l", ylim=c(0,3), col="dark green", lwd=3, ylab="sentiment", xlab="month")
lines(o[o$year == 2017, "month"], o[o$year == 2017, "positive"], type="l", col="dark green", lwd=3, lty=2)

lines(o[o$year == 2018, "month"], o[o$year == 2018, "negative"], type="l", col="dark red", lwd=3)
lines(o[o$year == 2017, "month"], o[o$year == 2017, "negative"], type="l", col="dark red", lwd=3, lty=2)

boxplot(positive~screen_name, data=d.lrg, cex.axis=.7, las=2, main="positive")
boxplot(negative~screen_name, data=d.lrg, cex.axis=.7, las=2, main="negative")

d.lrg$name = as.factor(d.lrg$screen_name)

p <- ggplot(d.lrg, aes(x=name, y=positive)) + geom_violin()
p <- ggplot(d.lrg, aes(x=name, y=negative)) + geom_violin()

d.lrg[d.lrg$negative > 7, ]

Integrating R and PollEverywhere

I wrote a short function to extract poll results from PollEverywhere. I frequently use PollEverywhere in classes and executive education programs, but have always found pulling the results clunky.

PollEverywhere does have an api, but it doesn’t seem like something that (at least publicly available) is a big focus of attention. Nonetheless, it is possible to use basic http authentication to get poll results. Here’s the function that will do that.

## -- ## -- ## -- ## -- ## -- ## -- ## -- ## -- ## -- ## -- ##
## This function extracts responses to poll everywhere polls
## This is currently setup just to do a simple multiple choice
## poll. This could be extended to other types of polls and response sets
## More information here: https://api.polleverywhere.com/
## -- ## -- ## -- ## -- ## -- ## -- ## -- ## -- ## -- ## -- ##

pe.responses = function(ids, un, pw) {
    require(httr)
    require(jsonlite)
    ## The id of the poll is at the end of the URL if you open one of the poll
    # in your browser
    ## I could not find a way with the api to list all of the polls for
    ## a given account. This would be ideal, but it's not there as far as I can see

    url.root = "https://www.polleverywhere.com/multiple_choice_polls"

    for(id in ids) {
        # This will just pull the attributes for this particular poll
        url = paste(url.root,id,sep="/")
        # I am only interested in the option set right here, but you could
        # get more information about the poll from this
        ops = fromJSON(content(GET(url, authenticate(un,pw)), "text"))$options
        names(ops)[1] = "response_id"

        # This will pull the responses to this particular poll
        url = paste(url.root,id,"results",sep="/")
        responses = fromJSON(content(GET(url, authenticate(un,pw)), "text"))
        responses$poll_id = id

        # Add the keyword response in addition to the value
        mrg = merge(responses, ops[, c("response_id", "value", "keyword")], by="value", all.x=T)

        if(id == ids[1]) {
            res.out = mrg
        } else {
            res.out = rbind(res.out, mrg)
        }
    }
    res.out$response_num = as.numeric(res.out$keyword)

    # Format the date/time
    res.out$response_date = unlist(lapply(strsplit(res.out$created_at, "T"), function(x) x[1]))
    res.out$response_time = unlist(lapply(strsplit(res.out$created_at, "T"), function(x) x[2]))
    res.out$response_time = substr(res.out$response_time,1, 8)
    res.out$response_date_time = paste(res.out$response_date, res.out$response_time, sep=" ")
    res.out$response_date_time = as.POSIXlt(res.out$response_date_time)
    return(res.out)
}

## Enter your polleverywhere credentials here
# un = "{Your Username Here}"
# pw = "{Your Password Here}"

## Here's a set of poll ids that I was interested in getting the results for
# ids = vector of pollids that you want to extract the results for

o = pe.responses(ids, un, pw)