I conducted an analysis for some M&A-Deals. My current output looks like this:
Deal-Nr | Event-Date | Target-Nation | CAR | SIC
----------------------------------------------------
1 | 01-01-1999 | Italy | 5.1% | 201
2 | 02-01-1999 | Germany | 2.3% | 202
3 | 06-01-1999 | Spain | 1.5% | 201
4 | 10-09-1999 | Germany | 0.3% | 201
5 | 15-09-1999 | UK | 1.1% | 201
6 | 25-10-2000 | Spain | 0.8% | 201
However, for my final analysis I want to exclude all deals within the same SIC-Code, which do not have at least 180 trading days between them. So in this case, I would want to exclude my deal 3 from the analysis (as they have the same SIC-code and do not have 180 days between them). Then the code should continue and check the next deal within that SIC-Code industry and remove (<180 days) or keep it (>180 days). This should be done for all the different SIC codes in my analysis.
As I'm rather new in R, I'm reaching out for help. Thank you so much for your support.
Edit:
As indicated below I provide some further information. I'm interested in the deals that are in the same SIC-Code and >180 days apart. This would mean in the table to remove row (3) and row (5). If one deal is more than 180 days apart the subsequent dates should be checked.
First, your Event.Date column needs to be a real date, not a string. I'm inferring month-day-year. From there, we need to group by SIC and calculate the difference in dates.
base R
dat$Event.Date <- as.Date(dat$Event.Date, format = "%d-%m-%Y")
keep <- ave(as.numeric(dat$Event.Date), dat$SIC, FUN = function(z) c(TRUE, diff(z) >= 180)) > 0
dat[keep,]
# Deal.Nr Event.Date Target.Nation CAR SIC
# 1 1 1999-01-01 Italy 5.1% 201
# 2 2 1999-01-02 Germany 2.3% 202
# 4 4 1999-09-10 Germany 0.3% 201
# 6 6 2000-10-25 Spain 0.8% 201
dplyr
library(dplyr)
dat %>%
# mutate(Event.Date = as.Date(Event.Date, format = "%d-%m-%Y")) %>%
# group_by(SIC) %>%
# filter(c(TRUE, diff(Event.Date) >= 180)) %>%
# ungroup()
# . + # A tibble: 4 x 5
# Deal.Nr Event.Date Target.Nation CAR SIC
# <int> <date> <chr> <chr> <int>
# 1 1 1999-01-01 Italy 5.1% 201
# 2 2 1999-01-02 Germany 2.3% 202
# 3 4 1999-09-10 Germany 0.3% 201
# 4 6 2000-10-25 Spain 0.8% 201
data.table
library(data.table)
as.data.table(dat
# )[, Event.Date := as.Date(Event.Date, format = "%d-%m-%Y")
# ][, .SD[c(TRUE, diff(Event.Date) >= 180),], by = .(SIC)]
+ > SIC Deal.Nr Event.Date Target.Nation CAR
# 1: 201 1 1999-01-01 Italy 5.1%
# 2: 201 4 1999-09-10 Germany 0.3%
# 3: 201 6 2000-10-25 Spain 0.8%
# 4: 202 2 1999-01-02 Germany 2.3%
Data
dat <- structure(list(Deal.Nr = 1:6, Event.Date = c("01-01-1999", "02-01-1999", "06-01-1999", "10-09-1999", "15-09-1999", "25-10-2000"), Target.Nation = c("Italy", "Germany", "Spain", "Germany", "UK", "Spain"), CAR = c("5.1%", "2.3%", "1.5%", "0.3%", "1.1%", "0.8%"), SIC = c(201L, 202L, 201L, 201L, 201L, 201L)), row.names = c(NA, -6L), class = "data.frame")
Related
I currently have a data set that has all information within one single row (or column if I transpose).
The very first items in the data are actually column names:
Country | Population | Country Column One | Country Column 2 | USA | 400 million | USA Column 1 | USA Column 2 | Canada | 38 Million | Canada Column 1 | Canada Column 2 | etc..
I notice that I can just "wrap" and have everything start at a new row once it reaches a new country. How would I go about that? Is there a more efficient way?
d <- t(matrix(scan(text=string, sep='|', what = "", strip.white = TRUE), 4))
colnames(d) <- d[1,]
data.frame(d[-1,])
Country Population Country.Column.One Country.Column.2
1 USA 400 million USA Column 1 USA Column 2
2 Canada 38 Million Canada Column 1 Canada Column 2
string <- "Country | Population | Country Column One | Country Column 2 | USA | 400 million | USA Column 1 | USA Column 2 | Canada | 38 Million | Canada Column 1 | Canada Column 2 "
Here is a base R option using read.table + gsub
> read.table(text = gsub("(([^|]+\\|){3}[^|]+)\\|", "\\1\n", s),sep = "|",header = TRUE)
Country Population Country.Column.One Country.Column.2
1 USA 400 million USA Column 1 USA Column 2
2 Canada 38 Million Canada Column 1 Canada Column 2
given
s <- "Country | Population | Country Column One | Country Column 2 | USA | 400 million | USA Column 1 | USA Column 2 | Canada | 38 Million | Canada Column 1 | Canada Column 2 "
Here is a custom approach:
We create a tibble separate the rows and pull it as vector
with split we create a list
then we use bind_rows and do pivoting.
library(tidyverse)
my_vec <- as_tibble(string) %>%
separate_rows("value", sep = " \\| ") %>%
pull(value)
my_list <- split(my_vec, ceiling(seq_along(my_vec) / 4))
bind_rows(my_list) %>%
pivot_longer(-`1`) %>%
pivot_wider(names_from = `1`, values_from = value) %>%
select(-name)
Country Population `Country Column One` `Country Column 2`
<chr> <chr> <chr> <chr>
1 USA 400 million USA Column 1 "USA Column 2"
2 Canada 38 Million Canada Column 1 "Canada Column 2 "
I have two data sets I would like to join. The income_range data is the master dataset and I would like to join data_occ to the income_range data based on what band the income falls inside. Where there are more than two observations(incomes) that are within the range I would like to take the lower income.
I was attempting to use data.table but was having trouble. I was would also like to keep all columns from both data.frames if possible.
The output dataset should only have 7 observations.
library(data.table)
library(dplyr)
income_range <- data.frame(id = "France"
,inc_lower = c(10, 21, 31, 41,51,61,71)
,inc_high = c(20, 30, 40, 50,60,70,80)
,perct = c(1,2,3,4,5,6,7))
data_occ <- data.frame(id = rep(c("France","Belgium"), each=50)
,income = sample(10:80, 50)
,occ = rep(c("manager","clerk","manual","skilled","office"), each=20))
setDT(income_range)
setDT(data_occ)
First attempt.
df2 <- income_range [data_occ ,
on = .(id, inc_lower <= income, inc_high >= income),
.(id, income, inc_lower,inc_high,perct,occ)]
Thank you in advance.
Since you tagged dplyr, here's one possible solution using that library:
library('fuzzyjoin')
# join dataframes on id == id, inc_lower <= income, inc_high >= income
joined <- income_range %>%
fuzzy_left_join(data_occ,
by = c('id' = 'id', 'inc_lower' = 'income', 'inc_high' = 'income'),
match_fun = list(`==`, `<=`, `>=`)) %>%
rename(id = id.x) %>%
select(-id.y)
# sort by income, and keep only the first row of every unique perct
result <- joined %>%
arrange(income) %>%
group_by(perct) %>%
slice(1)
And the (intermediate) results:
> head(joined)
id inc_lower inc_high perct income occ
1 France 10 20 1 10 manager
2 France 10 20 1 19 manager
3 France 10 20 1 14 manager
4 France 10 20 1 11 manager
5 France 10 20 1 17 manager
6 France 10 20 1 12 manager
> result
# A tibble: 7 x 6
# Groups: perct [7]
id inc_lower inc_high perct income occ
<chr> <dbl> <dbl> <dbl> <int> <chr>
1 France 10 20 1 10 manager
2 France 21 30 2 21 manual
3 France 31 40 3 31 manual
4 France 41 50 4 43 manager
5 France 51 60 5 51 clerk
6 France 61 70 6 61 manager
7 France 71 80 7 71 manager
I've added the intermediate dataframe joined for easy of understanding. You can omit it and just chain the two command chains together with %>%.
Here is one data.table approach:
cols = c("inc_lower", "inc_high")
data_occ[, (cols) := income]
result = data_occ[order(income)
][income_range,
on = .(id, inc_lower>=inc_lower, inc_high<=inc_high),
mult="first"]
data_occ[, (cols) := NULL]
# id income occ inc_lower inc_high perct
# 1: France 10 clerk 10 20 1
# 2: France 21 manager 21 30 2
# 3: France 31 clerk 31 40 3
# 4: France 41 clerk 41 50 4
# 5: France 51 clerk 51 60 5
# 6: France 62 manager 61 70 6
# 7: France 71 manager 71 80 7
I'm working on a dataframe which has 4 features, County, State, # COVID cases, and date. I want to add a column which calculates the number of days since the lowest date value for that county. I found a way to do it, but it requires a for loop and takes way too long to execute considering there are over 60k rows. I'm confused if and how I can calculate this in a vectored way so it takes a reasonable about of time.
daysSinceFirstCase <- function (x) {
# create vector the length of the row count
vals <- 1:nrow(x)
# for each row
for(i in 1:nrow(x)) {
row <- x[i, ]
# get occurrences of that county and state
countyCases <- x[x$county == row$county & x$state == row$state,]
# get first date
firstDate <- countyCases[order(countyCases$date),]$date[1]
#calculate difference
diff <- as.integer(row$date - firstDate)
#store difference
vals[i] <- diff
print(i)
}
return(vals)
}
df['days_since_first_case'] <- daysSinceFirstCase(df)
Edit: Here's an example of my data and the column I am trying to create.
Date | County | State | Cases | Days since first case
2020-03-14 | Philadelphia | PA | 500 | 0
2020-03-15 | Philadelphia | PA | 892 | 1
2020-03-16 | Philadelphia | PA | 1502 | 2
2020-03-22 | Baltimore | MD | 12 | 0
2020-03-23 | Baltimore | MD | 152 | 1
2020-03-24 | Baltimore | MD | 348 | 2
We could subtract the current date with the minimum date for each County and State.
library(dplyr)
df %>%
mutate(Date = as.Date(Date)) %>%
group_by(County, State) %>%
mutate(Days_since_first_case = as.integer(Date - min(Date)))
# Date County State Cases Days_since_first_case
# <date> <chr> <chr> <int> <int>
#1 2020-03-14 Philadelphia PA 500 0
#2 2020-03-15 Philadelphia PA 892 1
#3 2020-03-16 Philadelphia PA 1502 2
#4 2020-03-22 Baltimore MD 12 0
#5 2020-03-23 Baltimore MD 152 1
#6 2020-03-24 Baltimore MD 348 2
If you have record for each day, you can also count the row number from the first dat.
df %>%
mutate(Date = as.Date(Date)) %>%
arrange(County, State, Date) %>%
group_by(County, State) %>%
mutate(Days_since_first_case = row_number() - 1)
To answer your question, your code isn't vectorizing.
# get first date
firstDate <- countyCases[order(countyCases$date),]$date[1]
I think you are looping 60k times of this line. A potential improvement can be made is looping this line once for each group of country+state, rather than every single row.
Or you have a try of belowing data.table solution
library(data.table)
library(lubridate)
dt <- fread('Date | County | State | Cases | Days since first case
2020-03-14 | Philadelphia | PA | 500 | 0
2020-03-15 | Philadelphia | PA | 892 | 1
2020-03-16 | Philadelphia | PA | 1502 | 2
2020-03-22 | Baltimore | MD | 12 | 0
2020-03-23 | Baltimore | MD | 152 | 1
2020-03-24 | Baltimore | MD | 348 | 2')
dt[,Date:=ymd(Date)]
dt[,first_case_date:=Date[which(Cases==min(Cases))],by=.(County)]
dt
#> Date County State Cases Days since first case first_case_date
#> 1: 2020-03-14 Philadelphia PA 500 0 2020-03-14
#> 2: 2020-03-15 Philadelphia PA 892 1 2020-03-14
#> 3: 2020-03-16 Philadelphia PA 1502 2 2020-03-14
#> 4: 2020-03-22 Baltimore MD 12 0 2020-03-22
#> 5: 2020-03-23 Baltimore MD 152 1 2020-03-22
#> 6: 2020-03-24 Baltimore MD 348 2 2020-03-22
dt[,Days_since_first_case:= Date-first_case_date]
dt
#> Date County State Cases Days since first case first_case_date
#> 1: 2020-03-14 Philadelphia PA 500 0 2020-03-14
#> 2: 2020-03-15 Philadelphia PA 892 1 2020-03-14
#> 3: 2020-03-16 Philadelphia PA 1502 2 2020-03-14
#> 4: 2020-03-22 Baltimore MD 12 0 2020-03-22
#> 5: 2020-03-23 Baltimore MD 152 1 2020-03-22
#> 6: 2020-03-24 Baltimore MD 348 2 2020-03-22
#> Days_since_first_case
#> 1: 0 days
#> 2: 1 days
#> 3: 2 days
#> 4: 0 days
#> 5: 1 days
#> 6: 2 days
Created on 2020-04-19 by the reprex package (v0.3.0)
I am not sure about the performance as the test below is still only 2 groups for the data. You can have a test on your real dataset.
library(data.table)
library(lubridate)
library(microbenchmark)
dt <- fread('Date | County | State | Cases | Days since first case
2020-03-14 | Philadelphia | PA | 500 | 0
2020-03-15 | Philadelphia | PA | 892 | 1
2020-03-16 | Philadelphia | PA | 1502 | 2
2020-03-22 | Baltimore | MD | 12 | 0
2020-03-23 | Baltimore | MD | 152 | 1
2020-03-24 | Baltimore | MD | 348 | 2')
dt <- rbindlist(replicate(10000,dt,simplify = FALSE)) #60k records
dt[,Date:=ymd(Date)]
#key line for result
microbenchmark(dt[,first_case_date:=head(Date[which(Cases==min(Cases))],1),by=.(County)])
#> Unit: milliseconds
#>
#> expr: dt[, `:=`(first_case_date, head(Date[which(Cases == min(Cases))],1)), by = .(County)]
#> min lq mean median uq max neval
#> 1.6829 1.7602 2.015732 1.8329 2.1797 4.3841 100
Consider ave to find minimum by group and take the difference
df['days_since_first_case'] <- with(df, as.integer(Date - ave(Date, County, State, FUN=min)))
Alternatively, run aggregate + merge, then take the difference:
df <- within(merge(df, aggregate(cbind(Min_Date=Date) ~ County + State, df, FUN=min),
by = c("County", "State")), {
days_since_first_case <- as.integer(Date - Min_Date)
rm(Min_Date)
})
This is a continued question from the post Remove the first row from each group if the second row meets a condition
Below is a sample dataset:
df <- data.frame(id=c("9","9","9","5","5","4","4","4","4","4","20","20"),
Date=c("11/29/2018","11/29/2018","11/29/2018","2/13/2019","2/13/2019",
"6/15/2018","6/20/2018","8/17/2018","8/20/2018","8/23/2018","12/25/2018","12/25/2018"),
Buyer= c("John","John","John","Maria","Maria","Sandy","Sandy","Sandy","Sandy","Sandy","Paul","Paul"),
Amount= c("959","1158","596","922","922","1849","4193","4256","65","100","313","99"), stringsAsFactors = F) %>%
group_by(Buyer,id) %>% mutate(diffs = c(NA, diff(as.Date(Date, format = "%m/%d/%Y"))))
which would look like:
| id | Date | Buyer | diff | Amount |
|----|:----------:|------:|------|--------|
| 9 | 11/29/2018 | John | NA | 959 |
| 9 | 11/29/2018 | John | 0 | 1158 |
| 9 | 11/29/2018 | John | 0 | 596 |
| 5 | 2/13/2019 | Maria | 76 | 922 |
| 5 | 2/13/2019 | Maria | 0 | 922 |
| 4 | 6/15/2018 | Sandy | -243 | 1849 |
| 4 | 6/20/2018 | Sandy | 5 | 4193 |
| 4 | 8/17/2018 | Sandy | 58 | 4256 |
| 4 | 8/20/2018 | Sandy | 3 | 65 |
| 4 | 8/23/2018 | Sandy | 3 | 100 |
| 20 | 12/25/2018 | Paul | 124 | 313 |
| 20 | 12/25/2018 | Paul | 0 | 99 |
I need to retain those records where based on each buyer and id, the sum of amount between consecutive rows >5000 if the difference between two consecutive rows <=5. So, for example, Buyer 'Sandy' with id '4' has two transactions of 1849 and 4193 on '6/15/2018' and '6/20/2018' within a gap of 5 days, and since the sum of these two amounts>5000, the output would have these records. Whereas, for the same Buyer 'Sandy' with id '4' has another transactions of 4256, 65 and 100 on '8/17/2018', '8/20/2018' and '8/23/2018' within a gap of 3 days each, but the output will not have these records as the sum of this amount <5000.
The final output would look like:
| id | Date | Buyer | diff | Amount |
|----|:---------:|------:|------|--------|
| 4 | 6/15/2018 | Sandy | -243 | 1849 |
| 4 | 6/20/2018 | Sandy | 5 | 4193 |
df <- data.frame(id=c("9","9","9","5","5","4","4","4","4","4","20","20"),
Date=c("11/29/2018","11/29/2018","11/29/2018","2/13/2019","2/13/2019",
"6/15/2018","6/20/2018","8/17/2018","8/20/2018","8/23/2018","12/25/2018","12/25/2018"),
Buyer= c("John","John","John","Maria","Maria","Sandy","Sandy","Sandy","Sandy","Sandy","Paul","Paul"),
Amount= c("959","1158","596","922","922","1849","4193","4256","65","100","313","99"), stringsAsFactors = F) %>%
group_by(Buyer,id) %>% mutate(diffs = c(NA, diff(as.Date(Date, format = "%m/%d/%Y"))))
Changing Date from character to Date and Amount from character to numeric:
df$Date<-as.Date(df$Date, '%m/%d/%y')
df$Amount<-as.numeric(df$Amount)
Now here I group the dataset by id, arrange it with Date, and create a rank within each id (so for example Sandy is going to have rank from 1 through 5 for 5 different days in which she has shopped), then I define a new variable called ConsecutiveSum which adds the Value of each row to it's previous row's Value (lag gives you the previous row). The ifelse statement forces consecutive sum to output a 0 if the previous row's Value doesn't exists. The next step is just enforcing your conditions:
df %>%
group_by(id) %>%
arrange(Date) %>%
mutate(rank=dense_rank(Date)) %>%
mutate(ConsecutiveSum = ifelse(is.na(lag(Amount)),0,Amount + lag(Amount , default = 0)))%>%
filter(diffs<=5 & ConsecutiveSum>=5000 | ConsecutiveSum==0 & lead(ConsecutiveSum)>=5000)
# id Date Buyer Amount diffs rank ConsecutiveSum
# <chr> <chr> <chr> <dbl> <dbl> <int> <dbl>
# 1 4 6/15/2018 Sandy 1849 NA 1 0
# 2 4 6/20/2018 Sandy 4193 5 2 6042
I would use a combination of techniques available in tidyverse:
First create a grouping variable (new_id) and use the original id and new_id in combination to add together based on a grouping. Then we can filter by the criteria of the sum of the Amount > 5000. We can take this and filter then join or semi_join to filter based on the criteria.
ids is a dataset that finds the total Amount based on id and new_id and filters for when Dollars > 5000. This gives you the id and new_id that meets your criteria
df <- data.frame(id=c("9","9","9","5","5","4","4","4","4","4","20","20"),
Date=c("11/29/2018","11/29/2018","11/29/2018","2/13/2019","2/13/2019",
"6/15/2018","6/20/2018","8/17/2018","8/20/2018","8/23/2018","12/25/2018","12/25/2018"),
Buyer= c("John","John","John","Maria","Maria","Sandy","Sandy","Sandy","Sandy","Sandy","Paul","Paul"),
Amount= c(959,1158,596,922,922,1849,4193,4256,65,100,313,99), stringsAsFactors = F) %>%
group_by(Buyer,id) %>% mutate(diffs = c(NA, diff(as.Date(Date, format = "%m/%d/%Y"))))
library(tidyverse)
df1 <- df %>% mutate(Date = as.Date(Date , format = "%m/%d/%Y"),
tf1 = (id != lag(id, default = 0)),
tf2 = (is.na(diffs) | diffs > 5))
df1$new_id <- cumsum(df1$tf1 + df1$tf2 > 0)
>df1
id Date Buyer Amount diffs days_post tf1 tf2 new_id
<chr> <date> <chr> <dbl> <dbl> <date> <lgl> <lgl> <int>
1 9 2018-11-29 John 959 NA 2018-12-04 TRUE TRUE 1
2 9 2018-11-29 John 1158 0 2018-12-04 FALSE FALSE 1
3 9 2018-11-29 John 596 0 2018-12-04 FALSE FALSE 1
4 5 2019-02-13 Maria 922 NA 2019-02-18 TRUE TRUE 2
5 5 2019-02-13 Maria 922 0 2019-02-18 FALSE FALSE 2
6 4 2018-06-15 Sandy 1849 NA 2018-06-20 TRUE TRUE 3
7 4 2018-06-20 Sandy 4193 5 2018-06-25 FALSE FALSE 3
8 4 2018-08-17 Sandy 4256 58 2018-08-22 FALSE TRUE 4
9 4 2018-08-20 Sandy 65 3 2018-08-25 FALSE FALSE 4
10 4 2018-08-23 Sandy 100 3 2018-08-28 FALSE FALSE 4
11 20 2018-12-25 Paul 313 NA 2018-12-30 TRUE TRUE 5
12 20 2018-12-25 Paul 99 0 2018-12-30 FALSE FALSE 5
ids <- df1 %>%
group_by(id, new_id) %>%
summarise(dollar = sum(Amount)) %>%
ungroup() %>% filter(dollar > 5000)
id new_id dollar
<chr> <int> <dbl>
1 4 3 6042
df1 %>% semi_join(ids)
What I have:
I have two dataframes to work with. Those are:
> print(myDF_2003)
A_score country B_score
1 200 Germany 11
2 150 Italy 9
3 0 Sweden 0
and:
> print(myDF_2005)
A_score country B_score
1 -300 France 16
2 100 Germany 12
3 200 Italy 15
4 40 Spain 17
They are produced by the following code, which I do not want to change:
#_________2003______________
myDF_2003=data.frame(c(200,150,0),c("Germany", "Italy", "Sweden"), c(11,9,0))
colnames(myDF_2003)=c("A_score","country", "B_score")
myDF_2003$country=as.character(myDF_2003$country)
myDF_2003$country=factor(myDF_2003$country, levels=unique(myDF_2003$country))
myDF_2003$A_score=as.numeric(as.character(myDF_2003$A_score))
myDF_2003$B_score=as.numeric(as.character(myDF_2003$B_score))
#_________2005______________
myDF_2005=data.frame(c(-300,100,200,40),c("France","Germany", "Italy", "Spain"), c(16,12,15,17))
colnames(myDF_2005)=c("A_score","country", "B_score")
myDF_2005$country=as.character(myDF_2005$country)
myDF_2005$country=factor(myDF_2005$country, levels=unique(myDF_2005$country))
myDF_2005$A_score=as.numeric(as.character(myDF_2005$A_score))
myDF_2005$B_score=as.numeric(as.character(myDF_2005$B_score))
What I want:
I want to paste another column to myDF_2005 which has the difference of the B_Scores of countries that exist in both previous dataframes. In other words: I want to produce this output:
> print(myDF_2005_2003_Diff)
A_score country B_score B_score_Diff
1 -300 France 16
2 100 Germany 12 1
3 200 Italy 15 6
4 40 Spain 17
Question:
What is the most elegant code to do this?
# join in a temporary dataframe
temp <- merge(myDF_2005, myDF_2003, by = "country", all.x = T)
# calculate the difference and assign a new column
myDF_2005$B_score_Diff <- temp$B_score.x - temp$B_score.y
A solution using dplyr. The idea is to merge the two data frame and then calculate the difference.
library(dplyr)
myDF_2005_2 <- myDF_2005 %>%
left_join(myDF_2003 %>% select(-A_score), by = "country") %>%
mutate(B_score_Diff = B_score.x - B_score.y) %>%
select(-B_score.y) %>%
rename(B_score = B_score.x)
myDF_2005_2
# A_score country B_score B_score_Diff
# 1 -300 France 16 NA
# 2 100 Germany 12 1
# 3 200 Italy 15 6
# 4 40 Spain 17 NA