I have a df that looks like this.
head(dfhigh)
rownames 2015Y 2016Y 2017Y 2018Y 2019Y 2020Y 2021Y
1 Australia 29583.7403 48397.383 45220.323 68461.941 39218.044 20140.351 29773.188
2 Austria* 1294.5092 -8400.973 14926.164 5511.625 2912.795 -14962.963 5855.014
3 Belgium* -24013.3111 68177.596 -3057.153 27119.084 -9208.553 13881.481 22955.298
4 Canada 43852.7732 36061.859 22764.156 37653.521 50141.784 23174.006 59693.992
5 Chile* 20507.8407 12249.294 6128.716 7735.778 12499.238 8385.907 15251.538
6 Czech Republic 465.2137 9814.496 9517.948 11010.423 10108.914 9410.576 5805.084
I want to calculate the changes between years, so instead of the values, the table has the percentage of change (obviously deleting 2015Y).
Try this using (current - previous)/ previous *100
lst <- list()
nm <- names(dfhigh)[-1]
for(i in 1:(length(nm) - 1)){
lst[[i]] <- (dfhigh[[nm[i+1]]] - dfhigh[[nm[i]]]) / dfhigh[[nm[i]]] * 100
}
ans <- do.call(cbind , lst)
colnames(ans) <- paste("ch_of" , nm[-1])
ans
you can change the formula to calculate percentage as you want
You could also use a tidyverse solution.
library(tidyverse)
df %>%
pivot_longer(!rownames) %>%
group_by(rownames) %>%
mutate(value = 100*value/lag(value)-100) %>%
ungroup() %>%
pivot_wider(names_from = name, values_from = value)
# # A tibble: 6 × 8
# rownames `2015Y` `2016Y` `2017Y` `2018Y` `2019Y` `2020Y` `2021Y`
# <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
# 1 Australia NA 63.6 -6.56 51.4 -42.7 -48.6 47.8
# 2 Austria* NA -749. -278. -63.1 -47.2 -614. -139.
# 3 Belgium* NA -384. -104. -987. -134. -251. 65.4
# 4 Canada NA -17.8 -36.9 65.4 33.2 -53.8 158.
# 5 Chile* NA -40.3 -50.0 26.2 61.6 -32.9 81.9
# 6 CzechRepublic NA 2010. -3.02 15.7 -8.19 -6.91 -38.3
Related
I want to take the average of each column (except the date) after every seven rows. I tried the approach below, but I was getting incorrect values. This method also seems really long. Is there a way to shorten it?
bankamerica = read.csv('https://raw.githubusercontent.com/bandcar/Examples/main/bankamerica.csv')
library(tidyverse)
GroupLabels <- 0:(nrow(bankamerica) - 1)%/% 7
bankamerica$Group <- GroupLabels
Avgs <- bankamerica %>%
group_by(bankamerica$Group) %>%
summarize(Avg = mean(bankamerica$tr))
EDITED: Just realized this code provides the incorrect values
I think you're on the right path.
bankamerica %>%
mutate(group = cumsum(row_number() %% 7 == 1)) %>%
group_by(group) %>%
summarise(caldate = first(caldate), across(-caldate, mean)) %>%
select(-group)
## A tibble: 144 × 3
# caldate tr var
# <chr> <dbl> <dbl>
# 1 1/2/01 28.9 -50.6
# 2 1/11/01 23.6 -45.4
# 3 1/23/01 20.9 -45
# 4 2/1/01 17.4 -48
# 5 2/12/01 14.4 -48
# 6 2/21/01 17 -48.9
# 7 3/2/01 19.1 -56
# 8 3/13/01 19.4 -56.9
# 9 3/22/01 23.3 -55.7
#10 4/2/01 7.71 -58.3
This averages every 7 rows not every 7 days, because there are missing days in the data.
I would like to group all members of the same genera together for some summary statistics, but would like to maintain their full names in the original dataframe. I know that I could change their names or create a new column in the original dataframe but I am lookng for a more elegant solution. I would like to implement this in R and the dplyr package.
Example data here https://knb.ecoinformatics.org/knb/d1/mn/v2/object/urn%3Auuid%3Aeb176981-1909-4d6d-ac07-3406e4efc43f
I would like to group all clams of the genus Macoma as one group, "Macoma sp." but ideally creating this grouping within the following, perhapse before the group_by(site_code, species_scientific)
summary <- data %>%
group_by(site_code, species_scientific) %>%
summarize(mean_size = mean(width_mm))
Note that there are multiple Macoma xxx species and multiple other species that I want to group as is.
We may replace the species_scientific by replaceing the elements that have the substring 'Macoma' (str_detect) with 'Macoma', use that as grouping column and get the mean
library(dplyr)
library(stringr)
data %>%
mutate(species_scientific = replace(species_scientific,
str_detect(species_scientific, "Macoma"), "Macoma")) %>%
group_by(site_code, species_scientific) %>%
summarise(mean_size = mean(width_mm, na.rm = TRUE), .groups = 'drop')
-output
# A tibble: 97 × 3
site_code species_scientific mean_size
<chr> <chr> <dbl>
1 H_01_a Clinocardium nuttallii 33.9
2 H_01_a Macoma 41.0
3 H_01_a Protothaca staminea 37.3
4 H_01_a Saxidomus gigantea 56.0
5 H_01_a Tresus nuttallii 100.
6 H_02_a Clinocardium nuttallii 35.1
7 H_02_a Macoma 41.3
8 H_02_a Protothaca staminea 38.0
9 H_02_a Saxidomus gigantea 54.7
10 H_02_a Tresus nuttallii 50.5
# … with 87 more rows
If the intention is to keep only the first word in 'species_scientific'
data %>%
group_by(genus = str_remove(species_scientific, "\\s+.*"), site_code) %>%
summarise(mean_size = mean(width_mm, na.rm = TRUE), .groups = 'drop')
-output
# A tibble: 97 × 3
genus site_code mean_size
<chr> <chr> <dbl>
1 Clinocardium H_01_a 33.9
2 Clinocardium H_02_a 35.1
3 Clinocardium H_03_a 37.5
4 Clinocardium H_04_a 48.2
5 Clinocardium H_05_a 37.6
6 Clinocardium H_06_a 38.7
7 Clinocardium H_07_a 40.2
8 Clinocardium L_01_a 44.4
9 Clinocardium L_02_a 54.8
10 Clinocardium L_03_a 61.1
# … with 87 more rows
I have a dataframe with 10 numeric columns and 3 character columns, as a sample I prepare this dataframe:
df <- data.frame(
name = c("ANCON","ANCON","ANCON", "LUNA", "MAGOLLO", "MANCHAY", "MANCHAY","PATILLA","PATILLA"),
destiny = c("sea","reuse","sea","sea", "reuse","sea","sea","sea","sea"),
year = c("2022","2015","2022","2022", "2015","2016","2016","2018","2018"),
QQ = c(10,11,3,4,13,11,12,23,7),
Temp = c(14,16,16,15,16,20,19,14,18))
I need to group it by column "name", get the mean summary for columns "QQ" and "Temp", and the mode for columns "destiny" and "year". I could get the mean summary but I couldn´t include the mode
df_mean <- df %>%
group_by(name) %>%
summarise_all(mean, na.rm = TRUE)
name destiny year QQ Temp
<chr> <dbl> <dbl> <dbl> <dbl>
1 ANCON NA NA 8 15.3
2 LUNA NA NA 4 15
3 MAGOLLO NA NA 13 16
4 MANCHAY NA NA 11.5 19.5
5 PATILLA NA NA 15 16
the desired output with the medians is something like this:
name destiny year QQ Temp
1 ANCON sea 2022 8.0 15.3
2 LUNA sea 2022 4.0 15.0
3 MAGOLLO reuse 2015 13.0 16.0
4 MANCHAY sea 2016 11.5 19.5
5 PATILLA sea 2018 15.0 16.0
How could I do it? Please help
Use across and cur_column. Median would only work with ordinal data, though, and for categorical data like the character columns you have, use mode:
mode <- function(x) {
x_unique <- unique(x)
x_unique[which.max(tabulate(match(x, x_unique)))]
}
Then
mode_columns <- c('destiny', 'year')
df %>%
group_by(name) %>%
summarise(
across(
everything(),
~ if (cur_column() %in% mode_columns) mode(.x) else mean(.x)
)
)
# A tibble: 5 × 5
name destiny year QQ Temp
<chr> <chr> <chr> <dbl> <dbl>
1 ANCON sea 2022 8 15.3
2 LUNA sea 2022 4 15
3 MAGOLLO reuse 2015 13 16
4 MANCHAY sea 2016 11.5 19.5
5 PATILLA sea 2018 15 16
UPD: Or you could summarise a bit differently
summarise(
across({{mode_cols}}, mode),
across(!{{mode_cols}}, mean)
)
I'm looking at covid-19 data to calculate estimates for the reproductive number R0.
library(ggplot2)
library(dplyr)
library(tidyr)
library(stringr)
library(TTR)
# Get COVID cases, available from:
url <- "https://static.usafacts.org/public/data/covid-19/covid_confirmed_usafacts.csv"
DoubleCOV <- read.csv(url, stringsAsFactors = FALSE)
names(DoubleCOV)[1] <- "countyFIPS"
DoubleCovid <- pivot_longer(DoubleCOV, cols=starts_with("X"),
values_to="cases",
names_to=c("X","date_infected"),
names_sep="X") %>%
mutate(infected = as.Date(date_infected, format="%m.%d.%y"),
countyFIPS = str_pad(as.character(countyFIPS), 5, pad="0"))
#data is by county, summarise for the state of interest
stateData <- DoubleCovid %>% filter(State == "AL") %>% filter(cases != 0) %>%
group_by(infected) %>% summarise(sum(cases)) %>%
mutate(DaysSince = infected - min(infected))
names(stateData)[2] <- "cumCases"
#3 day moving average to smooth a little
stateData <- stateData %>% mutate(MA = runMean(cumCases,3))
#calculate doubling rate (DR) and then R0 infectious period/doubling rate
for(j in 4:nrow(stateData)){
stateData$DR[j] <- log(2)/log(stateData$MA[j]/stateData$MA[j-1])
stateData$R0[j] <- 14/stateData$DR[j]
}
CDplot <- stateData %>%
ggplot(mapping = aes(x = as.numeric(DaysSince), y = R0)) +
geom_line(color = "firebrick")
print(CDplot)
So in the above the state of interest is Alabama, hence filter(State == "AL") and this works.
But if I change the state to "NY" I get
Error in `$<-.data.frame`(`*tmp*`, "DR", value = c(NA, NA, NA, 0.733907206043719 :
replacement has 4 rows, data has 39
head(stateData) yields
infected cumCases DaysSince MA
<date> <int> <drtn> <dbl>
1 2020-03-02 1 0 days NA
2 2020-03-03 2 1 days NA
3 2020-03-04 11 2 days 4.67
4 2020-03-05 23 3 days 12
5 2020-03-06 25 4 days 19.7
6 2020-03-07 77 5 days 41.7
The moving average values in rows 3 and 4 (12 and 4.67) would yield a doubling rate of 0.734 which aligns with the value in the error message value = c(NA, NA, NA, 0.733907206043719 but why does it throw an error after that?
Bonus question: I know loops are frowned upon in R...is there a way to get the moving average and R0 calculation without one?
You have to initialise the new variables before you can access them using the j index. Due to recycling, Alabama, which has 28 rows (divisible by 4), does not return an error, only the warnings about uninitialised columns. New York, however, has 39 rows, which is not divisible by 4 so recycling fails and R returns an error. You shouldn't ignore warnings, sometimes you can, but it's not a good idea.
Try this to see what R (you) is trying to do:
stateData[4]
You should get all rows of the 4th column, not the 4th row.
Solution: initialise your DR and R0 columns first.
stateData$DR <- NA
stateData$R0 <- NA
for(j in 4:nrow(stateData)){
stateData$DR[j] <- log(2)/log(stateData$MA[j]/stateData$MA[j-1])
stateData$R0[j] <- 14/stateData$DR[j]
}
For the bonus question, you can use lag in the same mutate with MA:
stateData <- stateData %>% mutate(MA = runMean(cumCases,3),
DR = log(2)/log(MA/lag(MA)),
R0 = 14 / DR)
stateData
# A tibble: 28 x 6
infected cumCases DaysSince MA DR R0
<date> <int> <drtn> <dbl> <dbl> <dbl>
1 2020-03-13 5 0 days NA NA NA
2 2020-03-14 11 1 days NA NA NA
3 2020-03-15 22 2 days 12.7 NA NA
4 2020-03-16 29 3 days 20.7 1.42 9.89
5 2020-03-17 39 4 days 30 1.86 7.53
6 2020-03-18 51 5 days 39.7 2.48 5.64
7 2020-03-19 78 6 days 56 2.01 6.96
8 2020-03-20 106 7 days 78.3 2.07 6.78
9 2020-03-21 131 8 days 105 2.37 5.92
10 2020-03-22 167 9 days 135. 2.79 5.03
# ... with 18 more rows
I'm using Alabama's data.
Sample data:
library(tidyverse)
set.seed(123)
dat <- tibble(
year = rep(1980:2015, each = 100),
day = rep(200:299, times = 36),
rain = sample(0:17, size = 100*36,replace = T),
PETc = sample(rnorm(100*36)),
ini.t = rep(10:45, each = 100 ))
I have a function that operates on a DataFrame
my.func <- function(df, initial, thres, upper.limit){
df$paw <- rep(NA, nrow(df))
df$aetc <- rep(NA, nrow(df))
df$sw <- rep(NA, nrow(df))
for(n in 1:nrow(df)){
df$paw[n] <- df$rain[n] + initial
df$aetc[n] <- ifelse(df$paw[n] >= thres, df$PETc[n], (df$paw[n]/thres) * df$PETc[n])
df$aetc[n] <- ifelse(df$aetc[n] > df$paw[n], df$paw[n], df$aetc[n])
df$sw[n] <- initial + df$rain[n] - df$aetc[n]
df$sw[n] <- ifelse(df$sw[n] > upper.limit,upper.limit,ifelse(df$sw[n] < 0, 0,df$sw[n]))
initial <- df$sw[n]
}
return(df)
}
thres <- 110
upper.limit <- 200
Applying the above function for a single year:
dat.1980 <- dat[dat$year == 1980,]
my.func(dat.1980, initial = dat.1980$ini.t[1], thres, upper.limit)
How do I apply this function to each year. I thought of using dplyr
dat %>% group_by(year)%>% run my function on each year.
Also since there are 35 years, there will be 35 dataframes returned. How do I return the bind these data frame row wise?
You were on the right track. do lets you perform functions by group.
dat %>%
group_by(year) %>%
do(my.func(., initial = head(.$ini.t, 1), thres, upper.limit))
# Groups: year [36]
# year day rain PETc ini.t paw aetc sw
# <int> <int> <int> <dbl> <int> <dbl> <dbl> <dbl>
# 1 1980 200 5 0.968 10 15.0 0.132 14.9
# 2 1980 201 14 0.413 10 28.9 0.108 28.8
# 3 1980 202 7 -0.912 10 35.8 -0.296 36.1
# 4 1980 203 15 -0.337 10 51.1 -0.156 51.2
# 5 1980 204 16 0.412 10 67.2 0.252 67.0
# 6 1980 205 0 -0.923 10 67.0 -0.562 67.5
# 7 1980 206 9 1.17 10 76.5 0.813 75.7
# 8 1980 207 16 0.0542 10 91.7 0.0452 91.7
# 9 1980 208 9 -0.293 10 101 -0.268 101
# 10 1980 209 8 0.0788 10 109 0.0781 109
# ... with 3,590 more rows
purrr::map functions are the du jour method but I think in this case it's a stylistic choice
We can split by 'year' and then use map to apply the my.func to each of the split datasets in the list
library(purrr)
dat %>%
split(.$year) %>%
map_df(~my.func(.x, initial = .x$ini.t[1], thres, upper.limit))