R im Rahmen eines Seminares in Politikwissenschaft

Projektausschreibungen für statistische Auswertungen und Analysen mit R.

R im Rahmen eines Seminares in Politikwissenschaft

Beitragvon R in Politikwissenschaft » Sa 26. Jan 2019, 18:05

Guten Tag! :)

Ich melde mich hier stellvertretend für eine kleine Gruppe aus 7 Studenten der Politikwissenschaft, die sich im Rahmen eines Vertiefungsseminars mit R befassen. Keiner von uns hatte zu Beginn des Semesters irgendwelche Vorkenntnisse in R oder allgemein im Programmieren.
Zum Seminar gehört es auch, jeweils eine "Programmierhausaufgabe" zu lösen. Die Aufgaben dabei orientieren sich immer an vorher in der Sitzung benutzten Zeilen und Befehlen.
Nun neigt sich unser Seminar dem Ende zu und am kommenden Montag findet die letzte Sitzung statt. Leider zerbrechen wir uns schon seit über einer Woche den Kopf über die bis Montag zu erledigenden Aufgaben. Bereits bei den ersten Zeilen häufen sich die Fehlermeldungen und wir haben noch nichts wirklich vernünftiges erreicht.
Unser Dozent riet uns, bei Fehlern und Problemen auch Hilfe in Olineforen zu suchen, konkret bei Stack Overflow. Leider scheint dort aktuell keine Registrierung möglich. Vielleicht gibt es hier jemanden, der uns weiterhelfen und die Aufgaben mit dem Skript der letzten Sitzung besser einordnen kann.

Das Skript ist wie folgt:

    ###### Exkurs: OCR-Erkennung ######

    ipak <- function(pkg){
    new.pkg <- pkg[!(pkg %in% installed.packages()[, "Package"])]
    if (length(new.pkg))
    install.packages(new.pkg, dependencies = TRUE)
    sapply(pkg, require, character.only = TRUE)
    }
    packages <- c("tesseract", "pdftools")
    ipak(packages)



    eng <- tesseract("eng")
    text <- tesseract::ocr("http://jeroen.github.io/images/testocr.png", engine = eng)
    cat(text)

    tesseract_info()
    tesseract_download("nld")
    tesseract_info()

    dutch <- tesseract("nld")
    dutch
    text <- ocr("https://jeroen.github.io/images/utrecht2.png", engine = dutch)
    cat(text)

    pngfile <- pdftools::pdf_convert('https://jeroen.github.io/images/ocrscan.pdf', dpi = 600)
    text <- tesseract::ocr(pngfile)
    cat(text)





    ###### Supervised-Classification - Structural Topic Modelling ######

    ipak <- function(pkg){
    new.pkg <- pkg[!(pkg %in% installed.packages()[, "Package"])]
    if (length(new.pkg))
    install.packages(new.pkg, dependencies = TRUE)
    sapply(pkg, require, character.only = TRUE)
    }
    packages <- c("tesseract", "topicmodels", "quanteda", "topicmodels", "ldatuning", "stm", "igraph", "stmCorrViz", "pdftools")
    ipak(packages)



    immig_corp <- corpus(data_char_ukimmig2010,
    docvars = data.frame(party = names(data_char_ukimmig2010)))

    dfm <- dfm(immig_corp, remove = stopwords("english"), remove_numbers = T, remove_punct = T, stem= T)

    dfm.trim <- dfm_trim(dfm, min_termfreq = 2, max_termfreq = 75)
    dfm.trim

    anzahl.themen <- 5
    dfm2topicmodels <- convert(dfm.trim, to = "topicmodels")
    lda.modell <- LDA(dfm2topicmodels, anzahl.themen)
    as.data.frame(terms(lda.modell, 10))


    # 5,000 articles about the economy published in the New York Times between 1980 and 2014

    nyt <- read.csv("./nytimes.csv", stringsAsFactors = FALSE)

    nytcorpus <- corpus(nyt$lead_paragraph)

    nyt_dfm <- dfm(nytcorpus, remove = stopwords("english"), tolower = T, remove_numbers = T, remove_punct = T, stem= T)

    nyt_dfm_trim <- dfm_trim(nyt_dfm, min_docfreq = 2)

    nyt_dfm_lda <- LDA(nyt_dfm_trim , k = 30, method = "Gibbs",
    control = list(verbose=25L, seed = 123, burnin = 100, iter = 500))

    as.data.frame(terms(nyt_dfm_lda, 20))

    View(nyt)

    topics <- get_topics(nyt_dfm_lda , 1)

    nyt$pred_topic <- topics
    nyt$year <- substr(nyt$datetime, 1, 4)

    terms <- get_terms(nyt_dfm_lda, 30)
    terms[,21]
    paste(terms[,21], collapse=", ")

    sample(nyt$lead_paragraph[topics==21], 1)

    tab <- table(nyt$year[nyt$pred_topic==21])

    plot(tab)




    round(nyt_dfm_lda@gamma[1,], 2)


    nyt$prob_topic_21 <- nyt_dfm_lda@gamma[,21]

    agg <- aggregate(nyt$prob_topic_21, by=list(year=nyt$year), FUN=mean)

    plot(agg$year, agg$x, type="l", xlab="Year", ylab="Avg. prob. of article about topic 21",
    main="Estimated proportion of articles about the financial crisis")






    # STM


    data <- read.csv("poliblogs2008.csv")

    data <- sample_n(data, 1000)

    processed <- textProcessor(data$documents, metadata=data)

    out <- prepDocuments(processed$documents, processed$vocab, processed$meta)

    docs <- out$documents
    vocab <- out$vocab
    meta <- out$meta

    poliblogPrevFit <- stm(out$documents, out$vocab, K=20, prevalence=~rating+s(day),
    max.em.its=75, data=out$meta, init.type="Spectral",
    seed=8458159)

    plot(poliblogPrevFit, type="summary", xlim=c(0,.4))

    plot(poliblogPrevFit, type="labels", topics=c(6,3))

    plot(poliblogPrevFit, type="hist")

    plot(poliblogPrevFit, type="perspectives", topics=c(6,3))

    out$meta$rating <- as.factor(out$meta$rating)
    prep <- estimateEffect(1:20 ~ rating+s(day), poliblogPrevFit, meta=out$meta,
    uncertainty="Global")

    plot(prep, covariate="rating", topics=c(6,3), model=poliblogPrevFit,
    method="difference", cov.value1="Liberal", cov.value2="Conservative",
    xlab="More Conservative ... More Liberal", main="Effect of Liberal vs. Conservative",
    xlim=c(-.15,.15), labeltype ="custom", custom.labels=c())


    plot(prep, "day", method="continuous", topics=6, model=z, printlegend=FALSE, xaxt="n",
    xlab="Time (2008)")
    monthseq <- seq(from=as.Date("2008-01-01"), to=as.Date("2008-12-01"), by="month")
    monthnames <- months(monthseq)
    axis(1, at=as.numeric(monthseq)-min(as.numeric(monthseq)), labels=monthnames)


    mod.out.corr <- topicCorr(poliblogPrevFit)
    plot(mod.out.corr)






    ###### WORDSCORES ######

    ipak <- function(pkg){
    new.pkg <- pkg[!(pkg %in% installed.packages()[, "Package"])]
    if (length(new.pkg))
    install.packages(new.pkg, dependencies = TRUE)
    sapply(pkg, require, character.only = TRUE)
    }
    packages <- c("countrycode", "classInt", "tidyverse", "maps", "rworldmap", "quanteda", "readtext", "RColorBrewer", "topmodel")
    ipak(packages)



    ungd_debates <- readtext("./UNGDC1970-2017.zip",
    ignore_missing_files = TRUE,
    docvarsfrom = "filenames",
    dvsep = "_",
    docvarnames = c("country", "session", "year"),
    verbosity = 0)

    ungd_corpus <- corpus(ungd_debates)

    ungd_2014 <- corpus_subset(ungd_corpus, year == 2014)

    ungd_data <- as.data.frame(docvars(ungd_2014))

    ungd_dfm <- dfm(ungd_2014,
    stem = TRUE,
    remove = stopwords("english"),
    remove_punct = TRUE,
    remove_numbers = TRUE)

    ungd_dfm <- dfm_trim(ungd_dfm, min_termfreq = 10, min_docfreq = 5)

    rus_index <- which(ungd_data$country == "RUS")
    usa_index <- which(ungd_data$country == "USA")

    refscores <- rep(NA, nrow(ungd_dfm))
    refscores[rus_index] <- -1
    refscores[usa_index] <- 1

    wordscores_model <- textmodel_wordscores(ungd_dfm,
    refscores)

    wordscores <- predict(wordscores_model, rescaling = "mv")

    ungd_data$wordscore <- wordscores

    class_intervals <- classIntervals(ungd_data$wordscore,
    rtimes = 10,
    style = 'bclust')

    spatial_data <- joinCountryData2Map(ungd_data,
    joinCode = "ISO3",
    nameJoinColumn = "country")

    wordscore_map <- mapCountryData(spatial_data,
    nameColumnToPlot = "wordscore",
    catMethod = class_intervals$brks,
    mapTitle = "Russia vs USA: Wordscores 2014",
    colourPalette = brewer.pal(9, "Blues"),
    missingCountryCol = "grey",
    addLegend = FALSE)

    do.call(addMapLegend, c(wordscore_map,
    legendLabels = "limits",
    labelFontSize = 0.7,
    legendShrink = 0.7,
    legendMar = 5,
    legendWidth = 0.5))

    ###### WORDFISH ######

    # Irish budget speeches from 2010


    irish_dfm <- dfm(data_corpus_irishbudget2010, remove_punct = TRUE)

    wf <- textmodel_wordfish(irish_dfm, dir = c(6,5))

    summary(wf)

    doclab <- paste(docvars(irish_dfm, "name"), docvars(irish_dfm, "party"))
    textplot_scale1d(wf, doclabels = doclab)

    textplot_scale1d(wf, doclabels = doclab, groups = docvars(irish_dfm, "party"))

    textplot_scale1d(wf, margin = "features",
    highlighted = c( "environment"))

Und die Aufgaben sehen so aus:

Für beide Aufgabenteile verwenden wir den (integrierten) Datensatz der Antrittsreden der US Präsidenten (data_corpus_inaugural). Als zentrale packages werden primär „quanteda“ und „stm“ benötigt.

Aufgabe 1

Verwenden Sie den Datensatz um eine wordscore Analyse durchzuführen. Dabei wollen wir uns die Reden nach 1980 anschauen und folgende Referenscores vergeben: Reagan 1981: +1; Obama 2009: -1; Clinton 1993: 0. Versuchen Sie mit Hilfe einer geeigneten Darstellungsform die übrigen Präsidenten in diesem Zeitraum zu analysieren.


Aufgabe 2

Hier verwenden wir den gleichen Datensatz, wenden uns aber dem Verfahren stm (structural topic models) zu. Wir wollen vor allem relevante Topics identifizieren und betrachten inwieweit sich diese über die Zeit verändern und ob es einen Unterschied macht welcher Partei ein Präsident angehört. Der Betrachtungszeitraum erschreckt sich von 1970-heute


Anmerkungen:
Verwenden Sie ein K = 5 (5 Topics)

Einflussfaktoren sind das Jahr und die Parteizugehörigkeit der Präsidenten. Diese können Sie mit Hilfe von „party_list.csv“ (im VC) generieren.


Vielen Dank und beste Grüße! :)
R in Politikwissenschaft
 
Beiträge: 1
Registriert: Sa 26. Jan 2019, 17:30
Danke gegeben: 0
Danke bekommen: 0 mal in 0 Post

Zurück zu Projektbörse

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 0 Gäste

cron