-
Notifications
You must be signed in to change notification settings - Fork 2
/
transient_impression.R
120 lines (87 loc) · 4.45 KB
/
transient_impression.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
#' Calculate the Transient Impression after an Event
#'
#' @param d data that has been reshaped to be in long format, with columns:
#' element, term, component, event, event_id, dimension, and estimate
#' @param equation_key the actdata equation key for the equation to use to get
#' the transient impression
#' @param equation_gender male, female, or average, corresponding to the gender
#' of equation to use when calculating the transient impression
#' @param eq_df use this only if you have used your *own* equation and not one in
#' actdata
#' @return dataframe in long format, with one row for each element-dimension of
#' the event, columns for fundamental sentiment and transient impression.
#'
#' @export
#'
#' @examples
#' d <- tibble::tibble(actor_modifier = "tired", actor = "ceo", behavior = "advise", object = "benefactor")
#' d <- reshape_events_df(df = d, df_format = "wide", dictionary_key = "usfullsurveyor2015", dictionary_gender = "average")
#' transient_impression(d = d, equation_key = "us2010", equation_gender = "average")
#'
transient_impression <- function(d,
equation_key = NULL,
equation_gender = NULL,
eq_df = NULL, ...) {
#first, deal with modified identities
if("actor_modifier" %in% d$element){
new_id <- d %>% dplyr::filter(element == "actor" | element == "actor_modifier")
new_id_epa <- modify_identity(d = new_id,
equation_key = equation_key,
equation_gender = equation_gender,
eq_df = eq_df)
new_actor_info <- tibble::tibble(element = "actor",
term = paste(unique(d$term[d$element == "actor_modifier"]),
unique(d$term[d$element == "actor"])),
component = "identity",
event = unique(d$event))
new_actor_info <- cbind(new_actor_info, new_id_epa)
d <- d %>% dplyr::filter(!(element == "actor" | element == "actor_modifier"))
if("event_id" %in% names(d)){
new_actor_info$event_id <- unique(d$event_id)
}
d <- rbind(new_actor_info, d)
}
if("object_modifier" %in% d$element){
new_id <- d %>% dplyr::filter(element == "object" | element == "object_modifier")
new_id_epa <- modify_identity(d = new_id,
equation_key = equation_key,
equation_gender = equation_gender,
eq_df = eq_df)
new_object_info <- tibble::tibble(element = "object",
term = paste(unique(d$term[d$element == "object_modifier"]),
unique(d$term[d$element == "object"])),
component = "identity",
event = unique(d$event))
new_object_info <- cbind(new_object_info, new_id_epa)
d <- d %>% dplyr::filter(!(element == "object" | element == "object_modifier"))
if("event_id" %in% names(d)){
new_object_info$event_id <- unique(d$event_id)
}
d <- rbind(new_object_info, d)
}
#d <- d %>% dplyr::arrange(match(element, c("actor", "behavior", "object")))
d <- d[order(d$element), , drop = FALSE]
#get the equation
eq <- get_equation(name = equation_key,
g = equation_gender,
eq_df = eq_df,
type = "impressionabo")
#construct the selection matrix
selection_mat <- eq %>% dplyr::select(AE:OA)
#get ABO elements for coefficients
abo_selected <- as.data.frame(t(t(selection_mat)*d$estimate)) %>%
naniar::replace_with_na_all(condition = ~.x == 0) %>%
dplyr::rowwise() %>%
dplyr::mutate(product = prod(c(AE, AP, AA, BE, BP, BA, OE, OP, OA), na.rm = TRUE))
#multiply ABO elements by the equation coefficients
post_epa <- t(eq[,2:10]) %*% abo_selected$product
post_epa <- tibble::tibble(post_epa = post_epa)
#put before and after together
pre_post <- cbind(d, post_epa)
#get the pre and post event dimensions
pre_post <- pre_post %>%
dplyr::mutate(trans_imp = post_epa[,1]) %>%
dplyr::select(element, term, component, dimension, estimate, trans_imp)
pre_post <- pre_post %>% ungroup()
return(pre_post)
}