library(reticulate)
library(xtable)
options(xtable.floating=FALSE)
library(lubridate)  
library(xml2)  
library(httr)
library(rvest)  
library(dplyr)
library(parallel)
options(mc.cores=detectCores()/2)
library(ggplot2)
library(mgcv)
library(tidymv)
if(!grepl("DataWrangling",getwd()))
    setwd("DataWrangling")


## -----------------------------------------------------------------------------
text <- c("Jane Smith","John Taylor","Susan Jones","Jack Brown","Susan Smith")
grep("Susan",text)
grep("Susan",text,value=TRUE)
grepl("Susan",text)
sub("Susan","Sally",text)


## -----------------------------------------------------------------------------
sub(".*A","-","xyzABCAgg")
sub(".*?A","-","xyzABCAgg")


## -----------------------------------------------------------------------------
text <- c("Jane Smith","John Taylor","Susan Jones","Jack Brown")
grep("s.n",text)
sub("s.n","-",text)
sub("^..s","-",text)
sub("t.*$","-",text)
sub("(?i)t.*$","-",text) ## (?i) ignores case


## -----------------------------------------------------------------------------
text <- c("Jane Smith","John Taylor","Susan Jones","Jack Brown")
sub("[a-z]*","-",text)
sub("[a-z]+","-",text)
gsub("[a-z]*","-",text)
gsub("[a-z]?","-",text)


## -----------------------------------------------------------------------------
text <- c("Jane Smith","John Taylor","Susan Jones","Jack Brown")
gsub("[a-z]","-",text)    ## [a-z] is a “set”
gsub("[^a-z]","-",text)


## -----------------------------------------------------------------------------
text <- c("Jane Smith","John Taylor","Susan Jones","Jack Brown")
gsub("Susan|John","-",text)  ## ...|... is an alternative
gsub("(Susan|John)"," [\\1] ",text)  ## (...) is a group


## -----------------------------------------------------------------------------
text <- c("Jane T. Smith","John W. Taylor","Susan S. Jones","Jack Brown, Jr.","Susan Smith")
sub("Susan (.*)$","\\1, S.",text)
gsub("(.)(.*)\\1","-\\2-",text)
sub("(.*) (.*)$","\\2, \\1",text)   ## greedy \1
sub("(.*?) (.*)$","\\2, \\1",text)  ## lazy \1


## -----------------------------------------------------------------------------
text <- "Susan Jones, susan.jones@some.domain.com, https://www.susan-jones.net/, 
         01234 Somecity,..."
sub("^.*?([a-z\\.]+@[a-z\\.]+).*$","\\1",text)
sub("^.*(https?://[a-z\\.-]+/?).*$","\\1",text)
sub("^.*[^0-9]([0-9]{4,5})[^0-9a-zA-Z]+([a-zA-Z]+).*$","\\2, \\1",text)


## -----------------------------------------------------------------------------
text <- c("Jane Smith","John Taylor","Susan Jones","Jack Brown")
stringr::str_replace_all(text,c("Jane"="Joan","John"="Jack","Jack"="Tim"))
stringr::str_count(text,c("J|a|o"))
stringr::str_extract_all(text,c("J|a|o"))


## -----------------------------------------------------------------------------
text <- c("Mary Jane Smith","John Taylor","Susan Jones","Jack-Brown")
strsplit(text," ")
strsplit("Jack-Brown","[ -]")


## -----------------------------------------------------------------------------
##         123456789 123456789 123456789 12  
text <- c("Today, Anne and John do the work",
          "Tomorrow, Susan and Joan are singing")


## -----------------------------------------------------------------------------
stringdist::afind(text,
                  c("Anna","John","Liz"),
                  value=FALSE,method="jw")


## -----------------------------------------------------------------------------
stringdist::afind(text,
                  c("Anna","John","Liz"),
                  value=FALSE,method="soundex")


## ----dateTime-----------------------------------------------------------------
as.POSIXct("01-02-03")
as.POSIXct("01-02-03") |> class()
as.POSIXct("01-02-03") |> unclass()
as.POSIXct("01-02-03") |> format("%d.%m.%Y")
as.POSIXct("01-02-03",format="%d-%m-%y",tz="UCT")
as.POSIXct("01-02-03",format="%d:%m:%y",tz="UCT")
as.POSIXct("01-02-03",format="%y-%m-%d",tz="UCT")


## ----dateTime2----------------------------------------------------------------
date.pct <- as.POSIXct("01-02-03"  ,
                       format="%d-%m-%y",tz="UCT")
format(date.pct,"%Y")
format(date.pct,"%A, %d %B %Y")
format(date.pct,"%s seconds since the epoch")
unclass(date.pct)


## ----theEpoch-----------------------------------------------------------------
as.POSIXct(0)
as.POSIXct(-2^31)
as.POSIXct(2^31)


## ----dateTime3----------------------------------------------------------------
date <- "01-02-03"  
date2 <- "02:03:04"  
as.POSIXct(c(date,date2),format="%d-%m-%y",tz="UCT")
##
library(lubridate)  
parse_date_time(c(date,date2),orders="dmy",
                locale = "de_DE.UTF-8")
dmy(c(date,date2))


## ----dateTime4----------------------------------------------------------------
dmy(date2)-dmy(date)
mean(c(dmy(date) ,dmy(date2)))
mean(c(dmy(date) ,dmy(date2))) + dweeks(2)
dmy(date) + dweeks(3)/2


## import pandas as pd

## text = pd.Series(["Mary Jane Smith","John Taylor","Susan Jones","Jack-Brown"])

## text.str.count("Susan")

## text.str.contains("Susan")


## text.str.replace("Susan","Sally")

## text.str.split(" ")


## ----results='asis',echo=FALSE,cache=FALSE------------------------------------
library(xml2)  
xmlTree <- read_xml("<html>
  <head>
    <title>My webpage</title>
  </head>
  <body>
    <div class='heading'>
      <h1>This is a Title</h1>
    </div>
    <div class='abstract'>
      Lorem ipsum dolor sit amet, consectetur adipisici elit,...
    </div>
    <div class='intro'>
      <h2>Introduction</h2>
      Ut enim ad minim <a href='https://www.veniam.org/'><i>veniam</i></a>,...
      <ul>
        <li class='myItems'>Item one.</li>
        <li class='otherItems'>Item two.</li>
      </ul>
    </div>
  </body>  
</html>")
##myHTMLpage <- system("pygmentize -l html -f latex",input=as.character(xmlTree),intern=TRUE)
###cat(myHTMLpage)
cat("\\begin{minted}{html}\n")
cat(as.character(xmlTree))
cat("\\end{minted}\n")
##myHTMLpage <- system("highlight -S html -O latex",input=as.character(xmlTree),intern=TRUE)
##z <- grep("\\\\ttfamily|\\\\mbox\\{\\}",myHTMLpage)
##cat(myHTMLpage[seq(min(z),max(z))])


## ----eval=FALSE---------------------------------------------------------------
## library(httr)
## library(xml2)
## thisPage <- httr::GET("https://www.some.domain.org/")
## httr::content(thisPage,as="text")
## xmlTree <- httr::content(thisPage,as="parsed")

## -----------------------------------------------------------------------------
xmlTree
xml_children(xml_children(xmlTree)[2])


## ----htmlPage3,results='asis',echo=FALSE--------------------------------------
cat("\\begin{minted}{html}\n")
cat(as.character(xmlTree))
cat("\\end{minted}\n")


## -----------------------------------------------------------------------------
xml_find_all(xmlTree,"//a")


## -----------------------------------------------------------------------------
node <- xml_find_all(xmlTree,"//a")
xml_children(node)
xml_parent(node)


## -----------------------------------------------------------------------------
xml_children(xml_parent(node))
xml_text(node)
xml_attrs(node)
xml_find_all(xmlTree,"//li[@class='myItems']")



## ----results='asis',echo=FALSE------------------------------------------------
cat("\\begin{minted}{html}\n")
cat(as.character(xmlTree))
cat("\\end{minted}\n")


## ----eval=FALSE---------------------------------------------------------------
## "https://www.some.domain.org/" |>
##    httr::GET() |>
##    httr::content(as="parsed") -> xmlTree

## -----------------------------------------------------------------------------
xmlTree |> xml_find_all("//*[contains(text(),'veniam')]")
xmlTree |> xml_find_all("//*[contains(text(),'veniam')]") |> xml_parent()
xmlTree |> xml_find_all("//*[contains(text(),'veniam')]") |> xml_parent() |> xml_attrs()


## ----eval=FALSE---------------------------------------------------------------
## library(rvest)
## "https://www.some.domain.org/" |>
##    httr::GET() |>
##    httr::content() |>
##    rvest::html_table()


## ----list2df,eval=FALSE-------------------------------------------------------
## lapply(data,function(x) {
##     ...
##     do_something_with_x()
##     ...
##     data.frame(a=...,b=...,c=...)
## }) |>
##     bind_rows()
## 
## sapply(data,function(x) {...})


## ----funnyDataDF0,eval=FALSE--------------------------------------------------
## data |>
## group_by(variable) |>
## mutate(...) |>     ## → df with same # of rows
## summarise(...) |>  ## → df with 1 row
## reframe(...) |>    ## → df with new # of rows
## ungroup()


## ----funnyDataList,eval=FALSE-------------------------------------------------
## lapply(data,function(x) {...})  ## → list
## bind_rows()            ## list → dataframe
## sapply(data,function(x) {...})  ## → matrix


## ----funnyDataDF,eval=FALSE---------------------------------------------------
## data |>
## group_by(variable) |>
## mutate(...) |>     ## → df with same # of rows
## summarise(...) |>  ## → df with 1 row
## reframe(...) |>    ## → df with new # of rows
## ungroup()


## ----eval=FALSE---------------------------------------------------------------
## group_by(variable)
## rowwise()          ## each row is one group
## ##
## ungroup()


## ----eval=FALSE---------------------------------------------------------------
## mutate(across(...variables...,function() {}))


## ----eval=FALSE---------------------------------------------------------------
## mutate(a=f(b),x=I(list(...)))
## data.frame(a=f(b),x=I(list(...))


## ----libsToLoad---------------------------------------------------------------
library(xml2)
library(dplyr)
library(parallel)
options(mc.cores=detectCores()/2)
library(httr)
library(ggplot2)
library(xtable)


## ----setwdDW,cache=FALSE------------------------------------------------------
if(!grepl("DataWrangling",getwd()))
    setwd("DataWrangling")


## ----robotsPolicy,eval=FALSE--------------------------------------------------
## get robots policy:
HOST <- "https://www.bundesverfassungsgericht.de/"
robots <- httr::GET(paste0(HOST,"robots.txt"))
cat(httr::content(robots))

## ----robots2,echo=FALSE,cache=FALSE-------------------------------------------
if(!grepl("DataWrangling",getwd()))
    setwd("DataWrangling")
load("data/all.Rdata")
load("data/TOCresponse.Rdata")
cat(httr::content(robots))


## ----tocPage,echo=FALSE,results='asis'----------------------------------------
search='<ol id="searchResult" class="links">
   <li>1. ... <a href="SharedDocs/Entscheidungen...">
                    <span class="aktenzeichen">...</span>
                    <div>Beschluss vom ...</div>
               </a>
               <div class="kurztext">...</div>
   </li>
   <li>2. ...</li>
   ...
</ol>
'
cat("\\begin{minted}{html}\n")
cat(as.character(search))
cat("\\end{minted}\n")


## ----readAllPages,eval=FALSE--------------------------------------------------
## ## get search results for all judgements:
## page <- 1
## allTOC <- list()
## while(TRUE) {
##     thisPage <- httr::GET(paste0("https://www.bundesverfassungsgericht.de/SiteGlobals/Forms/",
##                               "Suche/Entscheidungensuche_Formular.html?gtp=5403124_list%3D",page))
##     if(thisPage |> httr::content(as="parsed") |> xml_find_all("//ol[@id='searchResult']") |>
##                                                               xml_children() |> length() < 1)
##         break; ## stop if there are no more search results
##     cat(page,",") ## some feedback to watch
##     allTOC[[page]] <- thisPage
##     page <- page + 1
##     Sys.sleep(10)
## }
## save(file="data/TOCresponse.Rdata",allTOC)


## ----parseSummaries-----------------------------------------------------------
## parse these search results:
lapply(allTOC,function(p) {
    thisPage <- httr::content(p,as="parsed") ## translate search result into xml tree
    links <- xml_find_all(thisPage,
                          "//ol[@id='searchResult']/li/a[@href[contains(.,'Entscheidungen')]]")
    lapply(links,function(n) {
        data.frame(
            az = xml_text(xml_find_first(n,"./span[@class='aktenzeichen']")),
            date = xml_text(xml_find_first(n,"./div")),
            href = xml_attr(n,"href"),
            summary = xml_text(xml_find_first(xml_parent(n),"./div[@class='kurztext']/p"))
        )}) |>   
        bind_rows()
}) |> bind_rows() -> allTOC.df


## ----controlMultipleObs-------------------------------------------------------
str(allTOC.df)
allTOC.df |>
    group_by(az,date) |>
    summarise(n=n()) |>
    ungroup() |>
    with(table(n))


## ----obtainIndivJudgem,eval=FALSE---------------------------------------------
## ##
## wPages <- list()
## for (i in 1:nrow(allTOC.df)) {
##     url <- paste0(HOST,allPages.df[i,"href"])
##     wPages[[i]] <- GET(url)
##     cat(i,",")
##     Sys.sleep(10)
## }
## save(file="data/wPages.Rdata",wPages,allTOC.df)


## ----include=FALSE,cache=FALSE------------------------------------------------
if(!grepl("DataWrangling",getwd()))
    setwd("DataWrangling")
load("data/wPages.Rdata")


## ----chamberPage,echo=FALSE,results='asis'------------------------------------
search='...
<div class="absatz">
   <div class="rechts">...</div>
   <div class="links">
     <p class="rr1">
       <span>
          hat die 2. Kammer des Zweiten Senats des Bundesverfassungsgerichts durch
       </span>
     </p>
   </div>
</div>
...
'
cat("\\begin{minted}{html}\n")
cat(as.character(search))
cat("\\end{minted}\n")


## ----helper1------------------------------------------------------------------
str2num <- function(x) {
    x |> stringr::str_replace_all(c(`(?i)first|erst|premier`="1",
                                     `(?i)second|zweite`="2",
                                     `(?i)third|dritte`="3",
                                     `(?i)fourth|vierte`="4")) |>
        gsub("[^0-9]","",x=_) |>
        as.numeric()
}
##
str2num("Le premier Senat")
str2num("The Second Chamber")
str2num("Die dritte Kammer")


## ----ptree2body---------------------------------------------------------------
ptree2body <- function (ptree) {
    ptree |> xml_find_all("//*[@class='rr1']/span") |> xml_text() -> ctable
    if(length(ctable)==0)
        ptree |> xml_find_all("//*[@class='rr1']") |> xml_text() -> ctable
    ctable |> stringr::str_count("Kammer|Chamber|Senat") -> cmatchnum
    which(max(cmatchnum)==cmatchnum)[1] -> cmatch
    ifelse(is.na(cmatch),NA,ctable[cmatch]) |>
    stringr::str_replace_all("[\n  ]+"," ") |>
    stringr::str_replace(paste0("^.*? (([1-9]\\.|First|Second|Third) *(Kammer|Chamber).*",
                                "(Senat[se]?|Panel)|[a-zA-Z]+ [sS][eé]nat[se]?|Beschwerdekammer|",
                                "Complaints Chamber|Plenum|Plenary).*"),"\\1") -> bvbody
    bvbody |> stringr::str_replace("^((.*) (Kammer|Chamber))?.*$","\\2") |> str2num() -> chamber
    bvbody |> stringr::str_replace("^.*?(([^ ]+) (Senat|Panel|[sS]énat)).*$","\\2") |>
        str2num() -> senat
    "" -> bvbody2
    if(grepl("Plenum|Plenary",bvbody)) "Plenum" -> bvbody2
    if(grepl("Beschwerdekammer|Complaints Chamber",bvbody)) "Beschwerdekammer" -> bvbody2
    if(!is.na(senat)) paste0(senat,".S") -> bvbody2
    if(!is.na(chamber)) paste0(senat,"/",chamber) -> bvbody2
    bvbody2
}


## ----ptree2body2--------------------------------------------------------------
wpage=wPages[[4103]]
ptree <- content(wpage,as="parsed")
ptree2body(ptree)


## ----judgePage,echo=FALSE,results='asis'--------------------------------------
search='...
<div class="absatz">
   <div class="rechts">...</div>
   <div class="links">
     <p class="rr2">
       <span>
          den Richter ...
       </span>
     </p>
   </div>
   <div class="rechts">...</div>
   <div class="links">
     <p class="rr2">
       <span>
          und die Richterinnen ...
       </span>
     </p>
   </div>
</div>
'
cat("\\begin{minted}{html}\n")
cat(as.character(search))
cat("\\end{minted}\n")


## ----ptree2judges-------------------------------------------------------------
ptree2judges1 <- function(ptree) {
    jtable1 <- xml_text(xml_find_all(ptree,"//p[@class='rr2']//span"))
    if(length(jtable1)==0)
        lapply(xml_text(xml_find_all(ptree,"//p[@class='rr2']")),strsplit,"\n| und |,") |>
            unlist() -> jtable1 
    ##
    paste0("^(nd | *| *und |and |durch |unter Mitwirkung )|([Dd]er |[Dd]ie |[Dd]en |des )?",
           "(Richter|Judge|Justice|(Vi[zc]e[ -]?)?[pP]r[äeé]sident(e)?)(in|en|innen)?s? ?|",
           "$| ?[()]|(und|and)$") |> gsub("",jtable1) |> as.list() |>
    lapply(X=_,strsplit,",") |> unlist() -> jtable2  ## multiple judges in one cell
    paste0(", *|^[  ]*| *$|.*hat die Kammer|.*Senat.*|.*Bundesverfassungsgericht|",
           ".*Mitwirkung|.*in Verbindung|.*Bekanntmachung.*|.*beschlossen.*") |>
    gsub("",jtable2) |> setdiff(c("und","and",""))
}
##
ptree2judges1(content(wPages[[4103]],as="parsed"))


## ----judgePage2,echo=FALSE,results='asis'-------------------------------------
search='...
<table class="st" summary="Unterschriften der Richter" width="80%" align="center">
  <tbody ...>
    <tr>
      <td class="st" colspan="4" width="33%">
         <span>Müller</span>
      <td>
      <td class="st" colspan="4" width="33%">
         <span>Langenfeld</span>
      <td>
      <td class="st" colspan="4" width="33%">
         <span>Fetzer</span>
      <td>
    </tr>
   </tbody>
<table>
...'
cat("\\begin{minted}{html}\n")
cat(as.character(search))
cat("\\end{minted}\n")


## ----ptree2judges2------------------------------------------------------------
ptree2judges2 <- function(ptree) {    
    jtable2 <- xml_find_all(ptree,"//table[@summary='Unterschriften der Richter']//td//span")
    if(length(jtable2)==0)
        jtable2 <- xml_find_all(ptree,"//table[@summary='Unterschriften der Richter']//td")
    ##
    jtable2 |> xml_text() |> lapply(strsplit," und |:|,") |> unlist() |>
        gsub("[, :]*$","",x=_) |>
        gsub("[_ \n]"," ",x=_) |>
        gsub("^[ ]*","",x=_) |>
        gsub(paste0("Dr. |Die |Der |(Richter|Vizepräsident)(in)? |(ist|deshalb).*gehindert|",
                    "Amt ausgeschieden|deshalb an der Unterschrift|gehindert."),"",x=_) |>
        gsub("- *","-",x=_) |>
        setdiff(c(""," ","Judges","unter","Mitwirkung"))
}
##
ptree2judges2(content(wPages[[4103]],as="parsed"))


## ----art2topic----------------------------------------------------------------
read.csv(text="art,topic
2.1|3.1|9.3|12.1|14.[12],econ
2.2|10.|11.|13.|16.2|19.4|101.|103.[123],justice
5.[123]|8.|9.[12]|28.2|33.[2345]|38.,political
4.[12]|6.|7.|16a.|140.,person") |>
    mutate(art = paste0("^(",gsub("\\.","\\\\.",art),").*$"),
           pat=setNames(topic,art)) |> pull(pat) -> art2topic


## ----art2topic2---------------------------------------------------------------
art2topic


## ----swpage2topic-------------------------------------------------------------
ptree2topic <- function(ptree) {
    ptree  |>
    xml_find_all("//*[contains(text(),' GG')]")   |>
        lapply(function(n) stringr::str_extract_all(xml_text(n),
               "Art\\.[  ]*[0-9]+[  ,]*(Abs.[  ][0-9]+)?.{0,10}GG")) |>
    unlist() |>
    stringr::str_replace_all("^Art\\.[  ]*([0-9]+)[  ,]*(Abs.[  ]([0-9]+))?.*$","\\1.\\3") |>
    stringr::str_replace_all(art2topic) -> dirtyMatches
    dirtyMatches[dirtyMatches %in% art2topic] |>
        table() |> sort(decreasing=TRUE) |> names() |> head(1) -> topic
    if(is.null(topic)) topic<-NA
    topic
}
##
sapply(4104:4110,function(p) ptree2topic(content(wPages[[p]],as="parsed")))


## ----evalIndivJudgement,eval=FALSE--------------------------------------------
## mclapply(wPages,function(wpage) {
##     href <- sub(HOST,"",wpage[["url"]])
##     ptree <- content(wpage,as="parsed")
##     bvbody2 <- ptree2body(ptree)
##     topic <- ptree2topic(ptree)
##     judges1 <- ptree2judges1(ptree)
##     judges2 <- ptree2judges2(ptree)
##     data.frame(href=href,bvbody=bvbody2,topic=topic,j1=I(list(judges1)),j2=I(list(judges2)))
## }) |> bind_rows() -> judgesRaw

## ----include=FALSE,eval=FALSE-------------------------------------------------
## save(judgesRaw,file="data/judgesRaw.Rdata")

## ----include=FALSE,cache=FALSE------------------------------------------------
if(!grepl("DataWrangling",getwd()))
    setwd("DataWrangling")
load("data/judgesRaw.Rdata")


## ----realJudges1,results='asis'-----------------------------------------------
## find names of judges
judgesRaw |> select(j1,j2) |> unlist() |>  table() |>
   sort(decreasing=TRUE) -> jTable
##
head(jTable) |> t() |> xtable()
tail(jTable,5) |> t() |> xtable()


## ----realJudges2,results='asis'-----------------------------------------------
(names(jTable)[jTable>10] -> realJudges) |> paste(collapse=", ")


## ----judgesDist---------------------------------------------------------------
realJudges[!grepl("\\.|- Erster|BVerfGG|s durch",realJudges)]  |>
    sub("^Wolff","H.A.Wolff",x=_) -> realJudges
unrealJ <- setdiff(names(jTable),realJudges)
sapply(realJudges,function(j) grep(paste0("^(.*[^A-Z])?",j,"([^a-z].*)?$"),unrealJ)) |>
    unlist() |>  unique() |> sort() -> knownJ
unrealJ[-knownJ] -> unknown ## ← these contain missspelled names
str(unknown)
stringdist::afind(unknown,realJudges,value=FALSE,method="jw") -> jDist
str(jDist)


## ----judgesDist2,results='asis'-----------------------------------------------
lapply(1:length(unknown),
       function(i) {
           best=min(jDist$distance[i,]);
           ji=which(best==jDist$distance[i,])[1];
           data.frame(best=best,ji=ji,judge=realJudges[ji],
                      match=substr(unknown[i],jDist$location,40))}) |>
    bind_rows() |> filter(best < .2) |> 
    summarise(pat=paste0(paste0(match,collapse="|"),",",judge[1]),.by="judge") |>
    xtable()
## ↑ this gives us a template for the following table ↓


## ----judgeCorrect-------------------------------------------------------------
## correct spelling of some judges:
read.csv(text="pattern,replace
Bro$|Brox,Broß
Gerhard$,Gerhardt
Grasshof,Graßhof
Hasseme$|Hasssemer,Hassemer
Hentschel,Henschel
Herrmanns,Hermanns
Hofmann-Riem,Hoffmann-Riem
Hohmann -Dennhardt|Hohmann-Dennhard$,Hohmann-Dennhardt
Hmig,Hömig
Kessal-Wulff,Kessal-Wulf
Khling,Kühling
Lübbe-Woff|Lübbe -Wolff|Lübbe- Wolff|Lübbe-Wollf,Lübbe-Wolff
Stein$|Steine ,Steiner
Vosskuhle,Voßkuhle
Wallrabensein,Wallrabenstein
^Wolff,H.A.Wolff") |>
    with(data=_,setNames(replace,pattern)) ->
    judgeTrans


## ----bulkReplace,cache=FALSE--------------------------------------------------
str(judgeTrans)
## spell-correct realJudges:
stringr::str_replace_all(realJudges,judgeTrans) -> realJudges2
## clean all judges:
cleanJudges <- function(j) {
    stringr::str_replace_all(unlist(j),judgeTrans) |>
    sapply(function(text) realJudges2[sapply(realJudges2,grepl,text )]) |>
        unlist() |> unique() |> sort()
}
##
cleanJudges(c("Der Vorsitzende Bro","Lübbe-Woff und Vosskuhle"))


## ----bulkReplace2,eval=FALSE--------------------------------------------------
## judgesRaw |> rowwise() |>
##     mutate(across(c(j1,j2),function(j) I(list(cleanJudges(j))))) |>
##     ungroup() -> jjClean

## ----include=FALSE,eval=FALSE-------------------------------------------------
## save(jjClean,file="data/jjClean.Rdata")

## ----include=FALSE,cache=FALSE------------------------------------------------
if(!grepl("DataWrangling",getwd()))
    setwd("DataWrangling")
load("data/jjClean.Rdata")  


## ----cache=TRUE---------------------------------------------------------------
jjClean |>
    rowwise() |>
    mutate(j=list(unique(unlist(j1,j2)))) |>
    tidyr::unnest(cols=c(j)) |> with(table(j))


## ----compareJ1J2,results='asis'-----------------------------------------------
jjClean |> rowwise() |> mutate(n1 = length(j1), n2=length(j2)) -> jjNN
with(jjNN,table(n1,n2)) |> xtable()


## ----numj1j2differs0----------------------------------------------------------
(probs <- with(jjNN,which(n1>0 & n2>0 & n1 != n2)))

## ----numj1j2differs,eval=FALSE------------------------------------------------
## ## look at cases where number of judges j1 and j2 differ:
## for (i in 1:length(probs)) {
##     cat("\n--------------------",i,"-",probs[i],"--------------------\n")
##     cat("1 clean:",paste(sort(unlist(jjClean[probs[i],"j1"])),collapse=","))
##     cat("\n")
##     cat("1 raw:  ",paste(sort(unlist(judgesRaw[probs[i],"j1"])),collapse=","))
##     cat("--\n")
##     cat("2 clean:",paste(sort(unlist(jjClean[probs[i],"j2"])),collapse=","))
##     cat("\n")
##     cat("2 raw:  ",paste(sort(unlist(judgesRaw[probs[i],"j2"])),collapse=","))
##     cat("\n")
## }


## ----numj1j2differs2,echo=FALSE-----------------------------------------------
  ## look at cases where number of judges j1 and j2 differ:
  for (i in 1:length(probs)) {
      cat("\n--------------------",i,"-",probs[i],"--------------------\n")
      cat("1 clean:",paste(sort(unlist(jjClean[probs[i],"j1"])),collapse=","))
      cat("\n")
      cat("1 raw:  ",paste(sort(unlist(judgesRaw[probs[i],"j1"])),collapse=","))
      cat("--\n")
      cat("2 clean:",paste(sort(unlist(jjClean[probs[i],"j2"])),collapse=","))
      cat("\n")
      cat("2 raw:  ",paste(sort(unlist(judgesRaw[probs[i],"j2"])),collapse=","))
      cat("\n")
  }


## ----outcome0-----------------------------------------------------------------
PAT <- list()
PAT[["reject"]] <- paste0("unsuccessful|abgelehnt|ablehnung|unzulässig|erfolglos|unbegrün|",
                          "nichtannahme|verfristet|verworfen|zurückgewiesen")
PAT[["accept"]] <- "^successful|erfolgreich| annahme"
##
PAT[["reject2"]] <- paste0("bestätigung| darf |erledigt|einstellung| genüg|",
                          "missbrauchsgebühr|verwerfung|versagung|verfassungsgemäß|",
                           "verfassungsmaßig| vereinbar|zulässig")
PAT[["accept2"]] <- paste0("anspruch|auslagenerstattung|aussetzung|ausgeschlossen|",
           "begründ|angenommen|angeordnet|anordnung|bedenken|bedürfnis|beanstand|",
           "berichtig|berücksichtig|bewillig| muss | bedarf|erfolgreich|fristgerecht|",
           "fehlende| hätte |hinreichen|klarstell|kompetenzwidrig|prozesskosten|",
           "rechtsschutzinteresse| nichtig|verstößt|pflicht|substantiier| verletz|trennung|",
           "unvereinbar|untersag|verfassungswidrig|verstoß|verstößt|verletzung|vorrang")
PAT[["not"]] <- "nicht|kein|trotz|unzureichen|entfällt|wegfall"


## ----outcomeOfCases,cache=FALSE-----------------------------------------------
## always take the longer list:
jjClean |> rowwise() |>
  mutate(judge = ifelse(length(j1)>length(j2),I(list(j1)),I(list(j2)))) |>
  ungroup() |>
  left_join(allTOC.df) |>
  mutate(date1 =  lubridate::dmy(date,locale = "de_DE.UTF-8",tz="CET")) |> 
  filter(!is.na(date1) & date1 > as.POSIXct("1951-01-01")) |>
  mutate(reject = grepl(PAT[["reject"]],summary,ignore.case=TRUE),
         accept = !reject & grepl(PAT[["accept"]],summary,ignore.case=TRUE),
         not = grepl(PAT[["not"]],summary,ignore.case=TRUE),
         reject2 = xor(not,grepl(PAT[["reject2"]],summary,ignore.case=TRUE)),
         accept2 = xor(not,grepl(PAT[["accept2"]],summary,ignore.case=TRUE)),
         sumx = 10*(accept-reject) + (accept2-reject2),
         sumdec = ifelse(sumx==0,NA,sumx>0)
         ) -> jjSucc
jjSucc |> with(table(sumx))  


## ----jjSuccPlot,fig.height=2.5------------------------------------------------
jjSucc |> filter(grepl("Baer",judge)) |>
    rowwise() |>
    reframe(data.frame(date=date1,body=bvbody,j=setdiff(judge,"Baer"))) |>
    ggplot(aes(x=date,y=factor(j,levels=rev(sort(unique(j)))),color=factor(body))) +
    geom_point() + labs(x=NULL,y=NULL,color="Body")


## ----familiarity,include=FALSE,eval=FALSE-------------------------------------
## jjSucc |>
##     rowwise() |>
##     mutate(other=I(list(judge))) |>
##     tidyr::unnest(col=judge) |>
##     group_by(judge) |>
##     arrange(date1) |>
##     mutate(ownExp=1:n()) |>
##     tidyr::unnest(col=other) |>
##     filter(other != judge) |>
##     group_by(judge,other) |>
##     mutate(otherExp=0:(n()-1)/ownExp) |>
##     group_by(href,bvbody,date1,judge) |>
##         summarise(familiarity=mean(otherExp),.groups="drop") -> bvFamiliarityOri

## ----familiarityAlt-----------------------------------------------------------
jjSucc |>
    rowwise() |>
    reframe(href,bvbody,date1,other=I(list(judge)),judge=data.frame(judge)) |>
    group_by(judge) |>
    arrange(date1) |>
    mutate(ownExp=1:n()) |>
    rowwise() |>
    reframe(href,bvbody,date1,judge,ownExp,data.frame(other)) |>
    filter(other != judge) |>
    group_by(judge,other) |>
    mutate(otherExp=0:(n()-1)/ownExp) |>
    group_by(href,bvbody,date1,judge) |> 
        summarise(familiarity=mean(otherExp),.groups="drop") -> bvFamiliarity


## ----familiarityPlot----------------------------------------------------------
bvFamiliarity |> filter(judge=="Baer" & date1>as.POSIXct("1950-01-01")) |>
    ggplot(aes(x=date1,y=familiarity,color=bvbody)) + geom_point() + labs(x=NULL,color="Body")


## ----parties------------------------------------------------------------------
"https://de.wikipedia.org/wiki/Liste_der_Richter_des_Bundesverfassungsgerichts" |>
   httr::GET() |>
   httr::content() |>
   rvest::html_table() |> first() -> jWiki

stringdist::afind(x=unlist(jWiki[,1]),
                  pattern=sub("H.A.Wolff","Heinrich Amadeus Wolff",realJudges2),
                  value=FALSE,
                  method="jw") -> jwDist

lapply(seq(length(realJudges2)),function(j) {
    distances <- jwDist$distance[,j]
    m <- min(distances)
    pos=which(m==distances)[1]
    data.frame(judge=realJudges2[j],dist=m,jWiki[pos,])}) |>
    bind_rows() -> judgeDF


## ----parties2,results='asis'--------------------------------------------------
judgeDF |> arrange(-dist) |> select(judge,Name..Lebensdaten.,Vorschlag,dist)  |>
    head(12) |> xtable()


## ----parties3,results='asis'--------------------------------------------------
judgeDF |> with(table(Vorschlag)) |>
    xtable()


## ----parties3b,results='asis'-------------------------------------------------
judgesRaw |>
    with(table(topic,useNA="always")) |>
    xtable()


## ----vorschlagData------------------------------------------------------------
jjSucc |>
    rowwise() |>
    reframe(href,accept,topic,data.frame(judge)) |>
    left_join( judgeDF |> select(judge,Vorschlag)) |>
    mutate(topic=factor(topic),Vorschlag=factor(Vorschlag)) -> judgeVS


## ----vorschlagDataCount,fig.height=2.4----------------------------------------
partyCol <- scale_color_manual(values=c("CDU/CSU"="black","FDP"="yellow","Grüne"="green","SPD"="red"))
judgeVS |>
  group_by(Vorschlag,topic) |>
  summarise(count=n()) |>
  ggplot(aes(x=topic,y=count,color=Vorschlag)) + geom_point() + partyCol
  


## ----vorschlagData2,fig.height=2.4--------------------------------------------
judgeVS |>
    group_by(Vorschlag,topic) |>
    summarise(accept=mean(accept)) |>
    ggplot(aes(x=topic,y=accept,color=Vorschlag)) + geom_point() + partyCol


## ----jjSuccPlot2--------------------------------------------------------------
jjSucc |>
    filter(sumx != 0) |>
    mutate(accept = sumx > 1) |>
    select(href,accept) |>
    left_join(bvFamiliarity) -> jjAcceptFam

jjAcceptFam |>
    filter(!is.na(familiarity)) |>
    group_by(href,bvbody,date1) |> 
    summarise(familiarity=mean(familiarity),
              accept=mean(accept),
              nJudge=n(),
              .groups="drop") -> jjAcceptFamShort



## ----familiarityGLM-----------------------------------------------------------
summary(glm(accept ~ familiarity + nJudge + date1 ,family=binomial,data=jjAcceptFamShort))


## ----familiarityGLMplotLibs---------------------------------------------------
library(mgcv)
library(tidymv)

jjAcceptFam |> mutate(date=as.numeric(date1)) |>
    gam(accept ~ s(familiarity) + s(date) + factor(judge),data=_) -> est


## ----familiarityGLMplot-------------------------------------------------------
predict_gam(est,values=list(judge="Papier",date=as.numeric(as.POSIXct("2000-01-01")))) |>
    ggplot(aes(familiarity,fit)) + geom_smooth_ci() + labs(y="$\\Delta P($accept$)$")


## ----familiarityGLMplot2------------------------------------------------------
predict_gam(est,values=list(judge="Papier",familiarity=.5)) |>
    ggplot(aes(as.POSIXct(date),fit)) + geom_smooth_ci() + labs(x=NULL,y="P(accept)")


## ----familiarityGLMplot3------------------------------------------------------
jjAcceptFam |> mutate(date=as.numeric(date1),bvf=factor(bvbody)) |>
    gam(accept ~ s(familiarity,by=bvf) + s(date),data=_) -> estBody


## ----familiarityGLMplot4,fig.height=2.5---------------------------------------
predict_gam(estBody,values=list(date=as.numeric(as.POSIXct("2000-01-01")))) |>
ggplot(aes(x=familiarity,y=fit)) + geom_smooth_ci() + facet_wrap(~bvf) +
    coord_cartesian(ylim=c(0,1)) + labs(y="P(accept)")