-
Notifications
You must be signed in to change notification settings - Fork 0
/
get_session_cases.R
261 lines (209 loc) · 10.7 KB
/
get_session_cases.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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
#' Cases in specified session
#'
#' A function for retrieving all cases treated in a specified parliamentary session.
#'
#' @usage get_session_cases(sessionid = NA, good_manners = 0, cores = 1)
#'
#' @param sessionid Character string indicating the id of the parliamentary session to retrieve.
#' @param good_manners Integer. Seconds delay between calls when making multiple calls to the same function
#' @param cores Integer. Number of cores (1 by default) to use in structuring the data.
#' More than 1 will not work on windows
#'
#' @return A data.frame with the following variables:
#'
#' 1. **$root** (main data on the MP)
#'
#' | | |
#' |:-----------------------|:-----------------------------------|
#' | **response_date** | Date of data retrieval |
#' | **version** | Data version from the API |
#' | **treated_session_id** | Session the case was treated in |
#' | **document_group** | Document group the case belongs to |
#' | **reference** | Document reference |
#' | **id** | Case id |
#' | **com_req_id** | Committee recommendation id |
#' | **com_req_code** | Committee recommendation code |
#' | **title_short** | Short title of case |
#' | **case_filed_id** | Id of filed case |
#' | **last_update_date** | Date of last update on case |
#' | **status** | Status of the case |
#' | **title** | Full title of the case |
#' | **type** | Type of case |
#' | **session_id** | Session id of the case |
#' | **committee_id** | Responsible committee id |
#'
#' 2. **$topics** (named list by case id)
#'
#' | | |
#' |:------------------|:-------------------------------------------------------|
#' | **is_main_topic** | Logical indication whether the topic is the main topic |
#' | **main_topic_id** | Id of the main topic for the case |
#' | **id** | Topic id |
#' | **name** | Topic name |
#'
#' 3. **$proposers** (named list by case id)
#'
#' | | |
#' |:--------------|:-------------------------------------------------|
#' | **rep_id** | Proposing MP id |
#' | **county_id** | County id of proposing MP |
#' | **party_id** | Party id of proposing MP |
#' | **rep_sub** | Logical indicator for whether MP is a substitute |
#'
#' 4. **$spokespersons** (data frame by case id)
#'
#' | | |
#' |:--------------|:-------------------------------------------------|
#' | **case_id** | Case id |
#' | **rep_id** | Spokesperson(s) MP id for the case |
#' | **county_id** | County id of spokesperson MP |
#' | **party_id** | Party id of spokesperson MP |
#' | **rep_sub** | Logical indicator for whether MP is a substitute |
#'
#' @md
#'
#' @seealso [get_case] [get_vote]
#'
#'
#' @examples
#'
#' \dontrun{
#' s0506 <- get_session_cases("2005-2006")
#' head(s0506)
#' }
#'
#' @import rvest parallel httr2
#' @export
#'
get_session_cases <- function(sessionid = NA, good_manners = 0, cores = 1){
url <- paste0("https://data.stortinget.no/eksport/saker?sesjonid=", sessionid)
base <- request(url)
resp <- base |>
req_error(is_error = function(resp) FALSE) |>
req_perform()
if(resp$status_code != 200) {
stop(
paste0(
"Response of ",
url,
" is '",
resp |> resp_status_desc(),
"' (",
resp$status_code,
")."
),
call. = FALSE)
}
if(resp_content_type(resp) != "text/xml") {
stop(
paste0(
"Response of ",
url,
" returned as '",
resp_content_type(resp),
"'.",
" Should be 'text/xml'."),
call. = FALSE)
}
tmp <- resp |>
resp_body_html(check_type = FALSE, encoding = "utf-8")
tmp2 <- list(root = data.frame(response_date = tmp |> html_elements("saker_oversikt > saker_liste > sak > respons_dato_tid") |> html_text(),
version = tmp |> html_elements("saker_oversikt > saker_liste > sak > versjon") |> html_text(),
treated_session_id = tmp |> html_elements("saker_oversikt > saker_liste > sak > behandlet_sesjon_id") |> html_text(),
document_group = tmp |> html_elements("saker_oversikt > saker_liste > sak > dokumentgruppe") |> html_text(),
reference = tmp |> html_elements("saker_oversikt > saker_liste > sak > henvisning") |> html_text(),
id = tmp |> html_elements("saker_oversikt > saker_liste > sak > id") |> html_text(),
com_req_id = tmp |> html_elements("saker_oversikt > saker_liste > sak > innstilling_id") |> html_text(),
com_req_code = tmp |> html_elements("saker_oversikt > saker_liste > sak > innstilling_kode") |> html_text(),
title_short = tmp |> html_elements("saker_oversikt > saker_liste > sak > korttittel") |> html_text(),
case_filed_id = tmp |> html_elements("saker_oversikt > saker_liste > sak > sak_fremmet_id") |> html_text(),
last_update_date = tmp |> html_elements("saker_oversikt > saker_liste > sak > sist_oppdatert_dato") |> html_text(),
status = tmp |> html_elements("saker_oversikt > saker_liste > sak > status") |> html_text(),
title = tmp |> html_elements("saker_oversikt > saker_liste > sak > tittel") |> html_text(),
type = tmp |> html_elements("saker_oversikt > saker_liste > sak > type") |> html_text(),
session_id = tmp |> html_elements("saker_oversikt > sesjon_id") |> html_text()))
# Case topics
tmp2$topics <- mclapply((tmp |> html_elements("saker_oversikt > saker_liste > sak > emne_liste")), function(x){
data.frame(is_main_topic = x |> html_elements("emne > er_hovedemne") |> html_text(),
main_topic_id = x |> html_elements("emne > hovedemne_id") |> html_text(),
id = x |> html_elements("emne > id") |> html_text(),
name = x |> html_elements("emne > navn") |> html_text())
}, mc.cores = cores)
names(tmp2$topics) <- tmp2$root$id
# Case proposer
tmp2$proposers <- mclapply((tmp |> html_elements("saker_oversikt > saker_liste > sak > forslagstiller_liste")), function(x){
if(identical(x |> html_elements("representant > id") |> html_text(), character()) == TRUE){
data.frame(rep_id = NA,
county_id = NA,
party_id = NA,
rep_sub = NA)
} else {
if(identical((x |> html_elements("representant > fylke > id") |> html_text()), character())) {
county_id = NA
} else {
county_id <- x |> html_elements("representant > fylke")
county_id <- lapply(county_id, function(y) {
tmp_county_id <- y |> html_elements("id") |> html_text()
tmp_county_id <- ifelse(identical(character(), tmp_county_id), NA, tmp_county_id)
}) |> unlist()
}
if(identical(x |> html_elements("representant > parti > id") |> html_text(), character())) {
party_id <- NA
} else {
party_id <- x |> html_elements("representant > parti")
party_id <- lapply(party_id, function(y) {
tmp_party_id <- y |> html_elements("id") |> html_text()
tmp_party_id <- ifelse(identical(character(), tmp_party_id), NA, tmp_party_id)
}) |> unlist()
}
data.frame(rep_id = x |> html_elements("representant > id") |> html_text(),
county_id = county_id,
party_id = party_id,
rep_sub = x |> html_elements("representant > vara_representant") |> html_text())
}
}, mc.cores = cores)
names(tmp2$proposers) <- tmp2$root$id
# Case committee
committee <- mclapply((tmp |> html_elements("saker_oversikt > saker_liste > sak")), function(x){
tmp3 <- x |> html_elements("komite > id") |> html_text()
if(identical(tmp3, character())) {
tmp3 <- NA
}
return(tmp3)
}, mc.cores = cores)
tmp2$root$committee_id <- unlist(committee)
# Case spokesperson
tmp2$spokespersons <- mclapply((tmp |> html_elements("saker_oversikt > saker_liste > sak > saksordfoerer_liste")), function(x){
if(identical((x |> html_elements("representant > id") |> html_text()), character())) {
rep_id <- NA
} else {
rep_id <- x |> html_elements("representant > id") |> html_text()
}
if(identical((x |> html_elements("representant > fylke > id") |> html_text()), character())) {
county_id <- NA
} else {
county_id <- x |> html_elements("representant > fylke > id") |> html_text()
}
if(identical((x |> html_elements("representant > parti > id") |> html_text()), character())) {
party_id <- NA
} else {
party_id <- x |> html_elements("representant > parti > id") |> html_text()
}
if(identical((x |> html_elements("representant > vara_representant") |> html_text()), character())) {
rep_sub <- NA
} else {
rep_sub <- x |> html_elements("representant > vara_representant") |> html_text()
}
data.frame(rep_id,
county_id,
party_id,
rep_sub)
}, mc.cores = cores)
names(tmp2$spokespersons) <- tmp2$root$id
tmp2$spokespersons <- do.call(rbind, tmp2$spokespersons)
tmp2$spokespersons$case_id <- sub("\\.[0-9]+$", "", rownames(tmp2$spokespersons))
rownames(tmp2$spokespersons) <- 1:nrow(tmp2$spokespersons)
tmp2$spokespersons <- tmp2$spokespersons[, c("case_id", "rep_id", "county_id", "party_id", "rep_sub")]
Sys.sleep(good_manners)
return(tmp2)
}