Count number of rows meeting criteria in another table - R PRogramming

Question

I have two tables, one with property listings and another one with contacts made for a property (i.e. is someone is interested in the property they will "contact" the owner).

Sample "listings" table below:

listings <- data.frame(id = c("6174", "2175", "9176", "4176", "9177"), city = c("A", "B", "B", "B" ,"A"), listing_date = c("01/03/2015", "14/03/2015", "30/03/2015", "07/04/2015", "18/04/2015"))
listings$listing_date <- as.Date(listings$listing_date, "%d/%m/%Y")

listings
#    id city listing_date
#1 6174    A   01/03/2015
#2 2175    B   14/03/2015
#3 9176    B   30/03/2015
#4 4176    B   07/04/2015
#5 9177    A   18/04/2015

Sample "contacts" table below:

contacts <- data.frame (id = c ("6174", "6174", "6174", "6174", "2175", "2175", "2175", "9176", "9176", "4176", "4176", "9177"), contact_date = c("13/03/2015","14/04/2015", "27/03/2015", "13/04/2015", "15/03/2015", "16/03/2015", "17/03/2015", "30/03/2015", "01/06/2015", "08/05/2015", "09/05/2015", "23/04/2015" ))

contacts$contact_date <- as.Date(contacts$contact_date, "%d/%m/%Y")
contacts
#     id contact_date
#1  6174   2015-03-13
#2  6174   2015-04-14
#3  6174   2015-03-27
#4  6174   2015-04-13
#5  2175   2015-03-15
#6  2175   2015-03-16
#7  2175   2015-03-17
#8  9176   2015-03-30
#9  9176   2015-06-01
#10 4176   2015-05-08
#11 4176   2015-05-09
#12 9177   2015-04-23

Problem 1. I need to count the number of contacts made for a property within 'x' days of listing. The output should be a new column added to "listings" with # contacts:

Sample ('x' = 30 days)

listings
#    id city listing_date ngs
#1 6174    A   2015-03-01   2
#2 2175    B   2015-03-14   3
#3 9176    B   2015-03-30   1
#4 4176    B   2015-04-07   0
#5 9177    A   2015-04-18   1

I have done this with the for loop; it is horrible slow for live data:

n <- nrow(listings)
mat <- vector ("integer", n)
for (i in 1:n) {  
  mat[i] <- nrow (contacts[contacts$id==listings[i,"id"] & as.numeric (contacts$contact_date - listings[i,"listing_date"]) <=30,])
}
listings$ngs <- mat

2. I need to prepare a histogram of # contacts vs days with 'x' as variable - through manipulate function. I can't figure out a way to do all this inside the manipulate function.

Answer 1

Here's a possible solution using data.table rolling joins

library(data.table)

# key `listings` by proper columns in order perform the binary join
setkey(setDT(listings), id, listing_date)

# Perform a binary rolling join while extracting matched icides and counting them
indx <- data.table(listings[contacts, roll = 30, which = TRUE])[, .N, by = V1]

# Joining back to `listings` by proper rows while assigning the counts by reference
listings[indx$V1, ngs := indx$N]
#      id city listing_date ngs
# 1: 2175    B   2015-03-14   3
# 2: 4176    B   2015-04-07  NA
# 3: 6174    A   2015-03-01   2
# 4: 9176    B   2015-03-30   1
# 5: 9177    A   2015-04-18   1

Answer 2

You could use the dplyr package. First merge the data:

all.data <- merge(contacts,listings,by = "id")

Set a target number of days:

number.of.days <- 30

Then gather the data by ID (group_by), exclude the results that are not within the time frame (filter) and count the number of occurrences/rows (summarise).

result <- all.data %>% group_by(id) %>% filter(contact_date > listing_date + number.of.days) %>% summarise(count.of.contacts = length(id))

I think there are a number of ways this could be potentially solved but I have found dplyr to be very helpful in a lot circumstances.

EDIT:

Sorry should have thought about that a little more. Does this work,

result <- all.data %>% group_by(id,city,listing_date) %>% summarise(ngs = length(id[which(contact_date < listing_date + number.of.days)]))

I don't think zero results can be passed sensibly through the filter stage (understandably, the goal is usually the opposite). I'm not too sure what sort of impact the 'which' component will have on processing time, likely to be slower than using the 'filter' function but might not matter.

Answer 3

Using dplyr for your first problem:

left_join(contacts, listings, by = c("id" = "id")) %>%
filter(abs(listing_date - contact_date) < 30) %>%
group_by(id) %>% summarise(cnt = n()) %>%
right_join(listings)

And the output is:

    id      cnt city    listing_date
1   6174    2   A        2015-03-01
2   2175    3   B        2015-03-14
3   9176    1   B        2015-03-30
4   4176    NA  B        2015-04-07
5   9177    1   A        2015-04-18

I'm not sure I understand your second question to answer it.

Answer 4

Or:

indx <- match(contacts$id, listings$id)
days_since <- contacts$contact_date - listings$listing_date[indx]
n <- with(contacts[days_since <= 30, ], tapply(id, id, length))
n[is.na(n)] <- 0
listings$n <- n[match(listings$id, names(n))]

It's similar to Thomas' answer but utilizes tapply and match instead of aggregate and merge.

Answer 5

I'm not sure if your actual id values are factor, but I'll start by making those numeric. Using them as factors will cause you problems:

listings$id <- as.numeric(as.character(listings$id))
contacts$id <- as.numeric(as.character(contacts$id))

Then, the strategy is to calculate the "days since listing" value for each contact and add this to your contacts data.frame. Then, aggregate this new data.frame (in your example, sum of contacts within 30 days), and then merge the resulting count back into your original data.

contacts$ngs <- contacts$contact_date - listings$listing_date[match(contacts$id, listings$id)]
a <- aggregate(ngs ~ id, data = contacts, FUN = function(x) sum(x <= 30))
merge(listings, a)
#     id city listing_date ngs
# 1 2175    B   2015-03-14   3
# 2 4176    B   2015-04-07   0
# 3 6174    A   2015-03-01   2
# 4 9176    B   2015-03-30   1
# 5 9177    A   2015-04-18   1