Knihovny a nastavení
'
## Sys.setlocale("LC_TIME", lct)
format(Sys.Date(), "%d/%B/%d")
setwd("C:/Users/karel_chajim/Documents/zeman")
set.seed(2016)
library(rvest)
require(reshape)
library(stringr)
library(car)
library(xlsx)
library(dplyr)
library(ggplot2)
library(plotly)
library(tidytext)
library(RTextTools)
library(e1071)
library(tm)
library(stringi)
'
## [1] "\n## Sys.setlocale(\"LC_TIME\", lct)\nformat(Sys.Date(), \"%d/%B/%d\")\n\nsetwd(\"C:/Users/karel_chajim/Documents/zeman\")\nset.seed(2016)\n\nlibrary(rvest)\nrequire(reshape)\nlibrary(stringr)\nlibrary(car)\nlibrary(xlsx)\nlibrary(dplyr)\nlibrary(ggplot2)\nlibrary(plotly)\nlibrary(tidytext)\nlibrary(RTextTools)\nlibrary(e1071)\nlibrary(tm)\nlibrary(stringi)\n"
"### Webscraping!
SCRAPER IDĚSU
vezmi ze záložky domácí všechny titulky a čas publikování, ulož do tabulky
"
## [1] "### Webscraping!\nSCRAPER IDĚSU\nvezmi ze záložky domácí všechny titulky a čas publikování, ulož do tabulky\n"
'
pgs<-2:139
idnes_urls <- paste("http://zpravy.idnes.cz/domaci.aspx?strana",
pgs,
sep = "="
)
idnes_url_titulka <- "http://zpravy.idnes.cz/domaci.aspx?strana=1"
get_idnes_titulky <- function(url) {
url %>%
read_html() %>%
html_nodes("#list-art-count") %>%
html_nodes("h3") %>%
html_text()
}
get_idnes_titulka_times <- function(url) {
url %>%
read_html() %>%
html_nodes(xpath="//@datetime") %>%
html_text()
}
get_idnes_times <- function(url) {
url %>%
read_html() %>%
html_nodes("#list-art-count") %>%
html_nodes("span") %>%
html_nodes(".time-date") %>%
html_text()
}
get_idnes_links_titulka <- function(url) {
url %>%
read_html() %>%
html_nodes("#list-art-count") %>%
html_nodes("h3") %>%
html_nodes("a") %>%
html_attr("href")
}
get_idnes_links <- function(url) {
url %>%
read_html() %>%
html_nodes("#list-art-count") %>%
html_nodes("h3") %>%
html_nodes("a") %>%
html_attr("href")
}
#tabulka z titulky - titulky
idnes_titulka_t <- lapply(idnes_url_titulka, get_idnes_titulky )
idnes_titulka_t <- unlist(idnes_titulka_t)
idnes_tt <- data.frame(titulky=idnes_titulka_t,
stringsAsFactors=FALSE)
"pokud je komerční sdělení"
idnes_titulky<- data.frame(titulky=idnes_tt$titulky,
stringsAsFactors = FALSE)
rm(idnes_titulka_t, idnes_tt)
#tabulka z titulky - časy
idnes_titulka_tim <- lapply(idnes_url_titulka, get_idnes_titulka_times)
idnes_titulka_tim <- unlist(idnes_titulka_tim)
idnes_titulka_time <- data.frame(date=idnes_titulka_tim,
stringsAsFactors=FALSE)
rm(idnes_titulka_tim)
idnes_titulka_time <- transform(idnes_titulka_time,
datum = colsplit(idnes_titulka_time$date,
split = "\\T",
names = c("Date","s")
)
)
#tabulka z titulky - linky
linky <- lapply(idnes_url_titulka, get_idnes_links )
linky <- unlist(linky)
id_linky <- data.frame(odkaz=linky,
stringsAsFactors = FALSE)
"pokud komerční článek na stárnce..."
idnes_linky<- data.frame(odkaz=id_linky$odkaz,
stringsAsFactors = FALSE)
rm(linky, id_linky)
#date and titles and links
titulka<- data.frame(date = idnes_titulka_time$datum.Date,
titulek = idnes_titulky,
odkaz = idnes_linky,
stringsAsFactors=FALSE)
titulka$date<-as.Date(titulka$date, "%Y-%m-%d")
rm(idnes_linky, idnes_titulky,idnes_titulka_time)
#zbylé stránky - titulky
idnes_t <- lapply(idnes_urls, get_idnes_titulky)
idnes_t <- unlist(idnes_t)
idnes_titulky <- data.frame(titulky=idnes_t,
stringsAsFactors = FALSE)
rm(idnes_t)
#zbylé stránky - časy
idnes_c <- lapply(idnes_urls, get_idnes_times)
idnes_c <- unlist(idnes_c)
idnes_times <- data.frame(date=idnes_c,
stringsAsFactors = FALSE)
rm(idnes_c)
#zbylé stránky - linky
linky <- lapply(idnes_urls, get_idnes_links)
linky <- unlist(linky)
idnes_linky <- data.frame(odkaz=linky,
stringsAsFactors = FALSE)
rm(linky)
#date and titles
stranky <- data.frame(date=idnes_times,
titulek=idnes_titulky,
odkaz=idnes_linky,
stringsAsFactors = FALSE)
stranky$date<-as.Date(stranky$date, "%d.%m.%Y")
#vyčistit plochu
rm(idnes_times, idnes_titulky, idnes_linky)
#finální produkt - tabulka z titulky a ostatních
id<-rbind(titulka,stranky)
idnes<-data.frame(date=id$date,
titulek=id$titulky,
zdroj="idnes.cz",
odkaz=id$odkaz,
stringsAsFactors = FALSE)
#vyčistit plochu
rm(titulka, stranky, id, idnes_urls, idnes_url_titulka, pgs)
"
KONEC IDĚSÍHO SCRAPERU
"
'
## [1] "\npgs<-2:139\nidnes_urls <- paste(\"http://zpravy.idnes.cz/domaci.aspx?strana\",\n pgs, \n sep = \"=\"\n )\nidnes_url_titulka <- \"http://zpravy.idnes.cz/domaci.aspx?strana=1\"\n\nget_idnes_titulky <- function(url) {\n url %>% \n read_html() %>% \n html_nodes(\"#list-art-count\") %>%\n html_nodes(\"h3\") %>%\n html_text()\n }\n\nget_idnes_titulka_times <- function(url) {\n url %>% \n read_html() %>% \n html_nodes(xpath=\"//@datetime\") %>% \n html_text() \n }\n\nget_idnes_times <- function(url) {\n url %>%\n read_html() %>%\n html_nodes(\"#list-art-count\") %>%\n html_nodes(\"span\") %>%\n html_nodes(\".time-date\") %>%\n html_text()\n}\n\n\nget_idnes_links_titulka <- function(url) {\n url %>% \n read_html() %>% \n html_nodes(\"#list-art-count\") %>%\n html_nodes(\"h3\") %>%\n html_nodes(\"a\") %>%\n html_attr(\"href\")\n}\n\n\nget_idnes_links <- function(url) {\n url %>% \n read_html() %>% \n html_nodes(\"#list-art-count\") %>%\n html_nodes(\"h3\") %>%\n html_nodes(\"a\") %>%\n html_attr(\"href\")\n}\n\n#tabulka z titulky - titulky\nidnes_titulka_t <- lapply(idnes_url_titulka, get_idnes_titulky )\nidnes_titulka_t <- unlist(idnes_titulka_t)\nidnes_tt <- data.frame(titulky=idnes_titulka_t, \n stringsAsFactors=FALSE)\n\"pokud je komerční sdělení\"\nidnes_titulky<- data.frame(titulky=idnes_tt$titulky, \n stringsAsFactors = FALSE)\n\nrm(idnes_titulka_t, idnes_tt)\n\n#tabulka z titulky - časy\nidnes_titulka_tim <- lapply(idnes_url_titulka, get_idnes_titulka_times)\nidnes_titulka_tim <- unlist(idnes_titulka_tim)\nidnes_titulka_time <- data.frame(date=idnes_titulka_tim, \n stringsAsFactors=FALSE)\nrm(idnes_titulka_tim)\n\nidnes_titulka_time <- transform(idnes_titulka_time, \n datum = colsplit(idnes_titulka_time$date, \n split = \"\\T\", \n names = c(\"Date\",\"s\")\n )\n )\n\n#tabulka z titulky - linky\nlinky <- lapply(idnes_url_titulka, get_idnes_links )\nlinky <- unlist(linky)\nid_linky <- data.frame(odkaz=linky, \n stringsAsFactors = FALSE)\n\n\"pokud komerční článek na stárnce...\"\nidnes_linky<- data.frame(odkaz=id_linky$odkaz,\n stringsAsFactors = FALSE)\n\nrm(linky, id_linky)\n\n\n#date and titles and links\ntitulka<- data.frame(date = idnes_titulka_time$datum.Date,\n titulek = idnes_titulky,\n odkaz = idnes_linky,\n stringsAsFactors=FALSE)\ntitulka$date<-as.Date(titulka$date, \"%Y-%m-%d\")\nrm(idnes_linky, idnes_titulky,idnes_titulka_time)\n\n#zbylé stránky - titulky\nidnes_t <- lapply(idnes_urls, get_idnes_titulky)\nidnes_t <- unlist(idnes_t)\nidnes_titulky <- data.frame(titulky=idnes_t, \n stringsAsFactors = FALSE)\nrm(idnes_t)\n\n#zbylé stránky - časy\nidnes_c <- lapply(idnes_urls, get_idnes_times)\nidnes_c <- unlist(idnes_c)\nidnes_times <- data.frame(date=idnes_c, \n stringsAsFactors = FALSE)\nrm(idnes_c)\n\n\n#zbylé stránky - linky\nlinky <- lapply(idnes_urls, get_idnes_links)\nlinky <- unlist(linky)\nidnes_linky <- data.frame(odkaz=linky, \n stringsAsFactors = FALSE)\nrm(linky)\n\n#date and titles\nstranky <- data.frame(date=idnes_times, \n titulek=idnes_titulky, \n odkaz=idnes_linky,\n stringsAsFactors = FALSE)\nstranky$date<-as.Date(stranky$date, \"%d.%m.%Y\")\n\n#vyčistit plochu\nrm(idnes_times, idnes_titulky, idnes_linky)\n\n#finální produkt - tabulka z titulky a ostatních\nid<-rbind(titulka,stranky)\nidnes<-data.frame(date=id$date,\n titulek=id$titulky,\n zdroj=\"idnes.cz\",\n odkaz=id$odkaz,\n stringsAsFactors = FALSE)\n#vyčistit plochu\nrm(titulka, stranky, id, idnes_urls, idnes_url_titulka, pgs)\n\n\n\"\nKONEC IDĚSÍHO SCRAPERU\n\"\n"
"SCRAPER NOVINEK"
## [1] "SCRAPER NOVINEK"
'
mesice<-1:12
novinky_urls <- paste("https://www.novinky.cz/archiv?id=8&date=25",
mesice, "2016&listType=month",
sep = "."
)
get_novinky_links <- function(url){
url %>%
read_html() %>%
html_nodes("#sectionBox") %>%
html_nodes("h3") %>%
html_nodes("a") %>%
html_attr("href")
}
get_novinky_titulky <- function(url){
url %>%
read_html() %>%
html_nodes("#sectionBox") %>%
html_nodes("h3") %>%
html_text()
}
get_novinky_date <- function(url) {
url %>%
read_html() %>%
html_nodes("#sectionBox") %>%
html_nodes(".dateLine") %>%
html_text()
}
novinky_link <- data.frame(odkaz=unlist(
lapply(
novinky_urls,
get_novinky_links
)
),
stringsAsFactors = FALSE
)
novinky_titles <- data.frame(titulky=unlist(
lapply(
novinky_urls,
get_novinky_titulky
)
),
stringsAsFactors = FALSE
)
novinky_dates <- data.frame(date=unlist(
lapply(
novinky_urls,
get_novinky_date
)
), stringsAsFactors = FALSE
)
#vektor názvů měsíců pro konverzi datumů
cesky <- c("ledna", "února", "března",
"dubna", "května", "června",
"července", "srpna", "září",
"října", "listopadu", "prosince")
cz_nom <- c("leden", "únor", "březen",
"duben", "květen", "červen",
"červenec", "srpen", "září",
"říjen", "listopad", "prosinec")
#nahraď NA a divný časy
#bacha! Novinky mají u dnešních článků prázdné pole a u včerejších "Včera"
novinky_dates$date<- mgsub("Včera","25. prosince 2016",novinky_dates$date)
#nahraď správným formátem názvy měsíců
novinky_dates$date<- mgsub(cesky,cz_nom,novinky_dates$date)
#transformuj na Date
novinky_dates$date <- as.Date(novinky_dates$date, "%d. %B %Y")
"merge tabulky a vytvoř finální produkt"
novinky <- data.frame(date=unlist(novinky_dates$date),
titulek=unlist(novinky_titles$titulky),
zdroj=unlist("novinky.cz"),
odkaz=unlist(novinky_link$odkaz),
stringsAsFactors = FALSE)
#úklid plochy
rm(novinky_dates,novinky_link, novinky_titles, cesky,cz_nom,mesice,novinky_urls)
"KONEC SCRAPERU NOVINEK"'
## [1] "\n\nmesice<-1:12\nnovinky_urls <- paste(\"https://www.novinky.cz/archiv?id=8&date=25\",\n mesice, \"2016&listType=month\", \n sep = \".\"\n )\nget_novinky_links <- function(url){\n url %>%\n read_html() %>%\n html_nodes(\"#sectionBox\") %>%\n html_nodes(\"h3\") %>%\n html_nodes(\"a\") %>%\n html_attr(\"href\")\n}\n\nget_novinky_titulky <- function(url){\n url %>%\n read_html() %>%\n html_nodes(\"#sectionBox\") %>%\n html_nodes(\"h3\") %>%\n html_text()\n}\n\nget_novinky_date <- function(url) {\n url %>%\n read_html() %>%\n html_nodes(\"#sectionBox\") %>%\n html_nodes(\".dateLine\") %>%\n html_text()\n}\n\n\nnovinky_link <- data.frame(odkaz=unlist(\n lapply(\n novinky_urls,\n get_novinky_links\n )\n ), \n stringsAsFactors = FALSE\n )\nnovinky_titles <- data.frame(titulky=unlist(\n lapply(\n novinky_urls, \n get_novinky_titulky\n )\n ), \n stringsAsFactors = FALSE\n )\nnovinky_dates <- data.frame(date=unlist(\n lapply(\n novinky_urls, \n get_novinky_date\n )\n ), stringsAsFactors = FALSE\n )\n\n#vektor názvů měsíců pro konverzi datumů\ncesky <- c(\"ledna\", \"února\", \"března\", \n \"dubna\", \"května\", \"června\", \n \"července\", \"srpna\", \"září\", \n \"října\", \"listopadu\", \"prosince\")\ncz_nom <- c(\"leden\", \"únor\", \"březen\",\n \"duben\", \"květen\", \"červen\",\n \"červenec\", \"srpen\", \"září\",\n \"říjen\", \"listopad\", \"prosinec\")\n\n\n\n#nahraď NA a divný časy\n#bacha! Novinky mají u dnešních článků prázdné pole a u včerejších \"Včera\"\nnovinky_dates$date<- mgsub(\"Včera\",\"25. prosince 2016\",novinky_dates$date)\n\n\n#nahraď správným formátem názvy měsíců\nnovinky_dates$date<- mgsub(cesky,cz_nom,novinky_dates$date)\n#transformuj na Date\nnovinky_dates$date <- as.Date(novinky_dates$date, \"%d. %B %Y\")\n\n\"merge tabulky a vytvoř finální produkt\"\nnovinky <- data.frame(date=unlist(novinky_dates$date), \n titulek=unlist(novinky_titles$titulky), \n zdroj=unlist(\"novinky.cz\"), \n odkaz=unlist(novinky_link$odkaz),\n stringsAsFactors = FALSE)\n\n#úklid plochy\nrm(novinky_dates,novinky_link, novinky_titles, cesky,cz_nom,mesice,novinky_urls)\n\n\"KONEC SCRAPERU NOVINEK\""
"SCRAPER PARLÁČŮ"
## [1] "SCRAPER PARLÁČŮ"
'
pgs <- 1:900
parlace_urls <- paste("http://www.parlamentnilisty.cz/zpravy?p",
pgs,
sep = "="
)
get_parlace_titulky <- function(url){
url %>%
read_html() %>%
html_nodes(".articles-list") %>%
html_nodes("div") %>%
html_nodes("h2") %>%
html_text()
}
get_parlace_links <- function(url) {
url %>%
read_html() %>%
html_nodes(".articles-list") %>%
html_nodes("a") %>%
html_attr("href")
}
get_parlace_date <- function(url) {
url %>%
read_html() %>%
html_nodes(".articles-list") %>%
html_nodes(".time") %>%
html_text()
}
plink <- unlist(lapply(parlace_urls, get_parlace_links))
plinks <- paste("http://www.parlamentnilisty.cz", plink, sep = "")
parlace_linky <- data.frame(odkaz=unlist(plinks), stringsAsFactors = FALSE)
rm(plink, plinks)
parlace_titulky<-data.frame(titulek=unlist(lapply(parlace_urls, get_parlace_titulky)))
parlace_date <- data.frame(date=as.Date(unlist(lapply(parlace_urls,get_parlace_date)),
format="%d. %m. %Y %H:%M"), stringsAsFactors = FALSE)
parlace <- data.frame(date=parlace_date$date,
titulek=parlace_titulky$titulek,
zdroj="parlamentnilisty.cz",
odkaz=parlace_linky$odkaz,
stringsAsFactors = FALSE)
#uklidit plochu
rm(parlace_date, parlace_linky, parlace_titulky)
"KONEC PARLÁČOVÝHO SCRAPERU"'
## [1] "\npgs <- 1:900\nparlace_urls <- paste(\"http://www.parlamentnilisty.cz/zpravy?p\",\n pgs, \n sep = \"=\"\n )\n\nget_parlace_titulky <- function(url){\n url %>%\n read_html() %>%\n html_nodes(\".articles-list\") %>%\n html_nodes(\"div\") %>%\n html_nodes(\"h2\") %>%\n html_text()\n}\n\nget_parlace_links <- function(url) {\n url %>% \n read_html() %>%\n html_nodes(\".articles-list\") %>%\n html_nodes(\"a\") %>%\n html_attr(\"href\") \n}\n\nget_parlace_date <- function(url) {\n url %>%\n read_html() %>%\n html_nodes(\".articles-list\") %>%\n html_nodes(\".time\") %>%\n html_text()\n}\n\nplink <- unlist(lapply(parlace_urls, get_parlace_links))\nplinks <- paste(\"http://www.parlamentnilisty.cz\", plink, sep = \"\")\nparlace_linky <- data.frame(odkaz=unlist(plinks), stringsAsFactors = FALSE)\nrm(plink, plinks)\n\nparlace_titulky<-data.frame(titulek=unlist(lapply(parlace_urls, get_parlace_titulky)))\n\nparlace_date <- data.frame(date=as.Date(unlist(lapply(parlace_urls,get_parlace_date)),\n format=\"%d. %m. %Y %H:%M\"), stringsAsFactors = FALSE)\n\nparlace <- data.frame(date=parlace_date$date, \n titulek=parlace_titulky$titulek,\n zdroj=\"parlamentnilisty.cz\",\n odkaz=parlace_linky$odkaz,\n stringsAsFactors = FALSE)\n#uklidit plochu\nrm(parlace_date, parlace_linky, parlace_titulky)\n\n\"KONEC PARLÁČOVÝHO SCRAPERU\""
"sluč dohromady"
## [1] "sluč dohromady"
'
media<-rbind(idnes,novinky,parlace)
"export do csv"
write.xlsx(media,file="moje_media.xlsx")
"udělej novej dataset jen se zemanem"
zeman[grep("zeman", zeman$titulek, ignore.case = TRUE),"zeman"]<-"TRUE"
zeman<-subset(zeman,zeman=="TRUE")
write.xlsx(zeman,file="zeman.xlsx")
zeman<-subset(zeman,date>"2015-12-31")
zeman$date<-format(zeman$date, "%m")
'
## [1] "\nmedia<-rbind(idnes,novinky,parlace)\n\n\"export do csv\"\nwrite.xlsx(media,file=\"moje_media.xlsx\")\n\n\"udělej novej dataset jen se zemanem\"\nzeman[grep(\"zeman\", zeman$titulek, ignore.case = TRUE),\"zeman\"]<-\"TRUE\"\nzeman<-subset(zeman,zeman==\"TRUE\")\nwrite.xlsx(zeman,file=\"zeman.xlsx\")\nzeman<-subset(zeman,date>\"2015-12-31\")\nzeman$date<-format(zeman$date, \"%m\")\n"
'
zeman <- read.xlsx("zeman_f.xlsx", sheetIndex = 1, encoding="UTF-8")
stop_words <- read_data("stopwords_cz.txt", encoding="UTF-8")
tonalita<-read.xlsx("tonalita.xlsx", sheetIndex = 1, encoding="UTF-8")
## text analýza
text <- data_frame(datum=zeman$date, ttl=zeman$titulek, stringsAsFactors = FALSE)
text$ID<-seq.int(nrow(text))
text$ttl<-as.character(text$ttl)
#klasifikace - zdroje
positivni<-read_data("pos.txt", encoding="UTF-8")
negativni<-read_data("neg.txt", encoding="UTF-8")
tonalita<-tonalita[-1]
zeman<-zeman[-1]
zeman<-zeman[-5]
duvera_pct <- c(56,59,59,59,62,56,57,58,57,56,48,56)
duvera_m <- c(01:12)
duvera_prezident <- data.frame(date=duvera_m, pct=duvera_pct)
rm(duvera_pct,duvera_m)
grupen <- zeman %>%
group_by(date) %>%
summarise(pocet_clanku = n())
grupen["duvera"] <- duvera_prezident$pct
grupen["podil"] <- grupen$pocet_clanku/sum(grupen$pocet_clanku)*100
rm(duvera_prezident)
original <- text %>%
group_by(ID) %>%
unnest_tokens(word,ttl) %>%
ungroup()
freq <- original %>%
group_by(word) %>%
count(word, sort = TRUE)
'
## [1] "\nzeman <- read.xlsx(\"zeman_f.xlsx\", sheetIndex = 1, encoding=\"UTF-8\")\nstop_words <- read_data(\"stopwords_cz.txt\", encoding=\"UTF-8\")\ntonalita<-read.xlsx(\"tonalita.xlsx\", sheetIndex = 1, encoding=\"UTF-8\")\n\n## text analýza\ntext <- data_frame(datum=zeman$date, ttl=zeman$titulek, stringsAsFactors = FALSE)\ntext$ID<-seq.int(nrow(text))\ntext$ttl<-as.character(text$ttl)\n\n#klasifikace - zdroje\npositivni<-read_data(\"pos.txt\", encoding=\"UTF-8\")\nnegativni<-read_data(\"neg.txt\", encoding=\"UTF-8\")\n\ntonalita<-tonalita[-1]\nzeman<-zeman[-1]\nzeman<-zeman[-5]\n\nduvera_pct <- c(56,59,59,59,62,56,57,58,57,56,48,56)\nduvera_m <- c(01:12)\n\nduvera_prezident <- data.frame(date=duvera_m, pct=duvera_pct)\nrm(duvera_pct,duvera_m)\n\ngrupen <- zeman %>%\n group_by(date) %>%\n summarise(pocet_clanku = n())\n\ngrupen[\"duvera\"] <- duvera_prezident$pct\ngrupen[\"podil\"] <- grupen$pocet_clanku/sum(grupen$pocet_clanku)*100\nrm(duvera_prezident)\n\noriginal <- text %>%\n group_by(ID) %>%\n unnest_tokens(word,ttl) %>%\n ungroup()\n\n\nfreq <- original %>%\n group_by(word) %>%\n count(word, sort = TRUE)\n"
"Přidej tonalitu do souboru"
## [1] "Přidej tonalitu do souboru"
'
#onálepkuj tonalitu
library(e1071)
library(RTextTools)
# co budu štítkovat
data <- zeman
# document term matrix - pro štítkování
dtMatrix <- create_matrix(data["titulek"])
# konfigurace - trénovací data
container <- create_container(dtMatrix, tonalita$tonal, trainSize=1:206, virgin=FALSE)
# SVM model
model <- train_model(container, "SVM", kernel="linear", cost=1)
# nová data
predictionData <- zeman$titulek
# document term matrix pro predikční data
predMatrix <- create_matrix(predictionData, originalMatrix=dtMatrix)
# vytvořit kontejner z dat
predSize = length(predictionData);
predictionContainer <- create_container(predMatrix, labels=rep(0,predSize), testSize=1:predSize, virgin=FALSE)
# prediktuj
results <- classify_model(predictionContainer, model)
#připoj procenta k souboru
zeman$lbl_prob <- round(results$SVM_PROB,2)
# připoj nálepky
zeman$ton <- ifelse(zeman$lbl_prob<0.55, "NEG", ifelse(zeman$lbl_prob>0.65, "POS", ifelse(zeman$lbl_prob>=0.55 & zeman$lbl_prob<=0.65, "0","")))
zeman$ton <- as.factor(zeman$ton)
'
## [1] "\n#onálepkuj tonalitu\n\nlibrary(e1071)\nlibrary(RTextTools)\n\n# co budu štítkovat\ndata <- zeman\n\n# document term matrix - pro štítkování\ndtMatrix <- create_matrix(data[\"titulek\"])\n\n# konfigurace - trénovací data\ncontainer <- create_container(dtMatrix, tonalita$tonal, trainSize=1:206, virgin=FALSE) \n\n# SVM model\nmodel <- train_model(container, \"SVM\", kernel=\"linear\", cost=1)\n\n# nová data\npredictionData <- zeman$titulek\n\n# document term matrix pro predikční data\npredMatrix <- create_matrix(predictionData, originalMatrix=dtMatrix) \n\n# vytvořit kontejner z dat\npredSize = length(predictionData);\npredictionContainer <- create_container(predMatrix, labels=rep(0,predSize), testSize=1:predSize, virgin=FALSE) \n\n# prediktuj\nresults <- classify_model(predictionContainer, model)\n\n#připoj procenta k souboru\nzeman$lbl_prob <- round(results$SVM_PROB,2)\n\n# připoj nálepky\nzeman$ton <- ifelse(zeman$lbl_prob<0.55, \"NEG\", ifelse(zeman$lbl_prob>0.65, \"POS\", ifelse(zeman$lbl_prob>=0.55 & zeman$lbl_prob<=0.65, \"0\",\"\")))\nzeman$ton <- as.factor(zeman$ton)\n"
# přidej úrovně důvěry do datasetu
'
datumy <- levels(zeman$date)
datumy<-as.numeric(datumy)
for(i in datumy) {
zeman$duvera[which(zeman$date==i)]<-grupen$duvera[grupen$date==i]
}
zeman$duvera <- as.numeric(zeman$duvera)
'
## [1] "\ndatumy <- levels(zeman$date)\ndatumy<-as.numeric(datumy)\nfor(i in datumy) {\n zeman$duvera[which(zeman$date==i)]<-grupen$duvera[grupen$date==i]\n}\nzeman$duvera <- as.numeric(zeman$duvera)\n"
## kde se zeman vyskytoval nejvíc?
'
plot(zeman$zdroj, xlab="zdroj", ylab="četnost", main="kde se nejvíce vyskytoval Zeman v roce 2016")
'
## [1] "\nplot(zeman$zdroj, xlab=\"zdroj\", ylab=\"četnost\", main=\"kde se nejvíce vyskytoval Zeman v roce 2016\")\n"
## udělej graf počet článků vs. důvěra
'
x <- grupen$date
y1 <- grupen$pocet_clanku
y2 <- grupen$duvera
ay <- list(
tickfont = list(color = "red"),
overlaying = "y",
side = "right",
title = "% důvěra"
)
plot_ly() %>%
add_lines(x = ~x, y = ~y1, name = "počet článků") %>%
add_lines(x = ~x, y = ~y2, name = "důvěra", yaxis = "y2") %>%
layout(
title = "počet článků o vs důvěra v prezidenta", yaxis2 = ay,
xaxis = list(title="měsíc 2016"),
yaxis= list(title="počet článků")
)
'
## [1] "\nx <- grupen$date\ny1 <- grupen$pocet_clanku\ny2 <- grupen$duvera\n\nay <- list(\n tickfont = list(color = \"red\"),\n overlaying = \"y\",\n side = \"right\",\n title = \"% důvěra\"\n)\n\nplot_ly() %>%\n add_lines(x = ~x, y = ~y1, name = \"počet článků\") %>%\n add_lines(x = ~x, y = ~y2, name = \"důvěra\", yaxis = \"y2\") %>%\n layout(\n title = \"počet článků o vs důvěra v prezidenta\", yaxis2 = ay,\n xaxis = list(title=\"měsíc 2016\"), \n yaxis= list(title=\"počet článků\")\n )\n"
## jaký je vztah mezi počtem článků a důvěrou?
'
ggplot(grupen, aes(pocet_clanku, duvera)) + geom_point() + geom_smooth(fill="blue", colour="red", size=1) + ggtitle("vztah počtu článků a důvěry v prezidenta") + labs(x="frekvence výskytu v médiích", y="% důvěra")
'
## [1] "\nggplot(grupen, aes(pocet_clanku, duvera)) + geom_point() + geom_smooth(fill=\"blue\", colour=\"red\", size=1) + ggtitle(\"vztah počtu článků a důvěry v prezidenta\")\t+ labs(x=\"frekvence výskytu v médiích\", y=\"% důvěra\")\n"
## scatter plot s korelací
'
model <- lm(duvera ~ pocet_clanku, data = grupen)
abline(model, col = "red")
summary(model)
coef(model)
plot(grupen$pocet_clanku, grupen$duvera, xlab="frekvence výskytu", ylab = "% důvěra", main="důvěra v prezidenta vs. počet článků o něm + regres_line", col="black")
abline(model)
'
## [1] "\nmodel <- lm(duvera ~ pocet_clanku, data = grupen)\nabline(model, col = \"red\")\nsummary(model)\ncoef(model)\n\nplot(grupen$pocet_clanku, grupen$duvera, xlab=\"frekvence výskytu\", ylab = \"% důvěra\", main=\"důvěra v prezidenta vs. počet článků o něm + regres_line\", col=\"black\")\nabline(model)\n"
'
library(vcd)
# ukaž tonalitu celkem
plot(zeman$ton, xlab="tón titulku", ylab="četnost", main="Tonalita titulků o Zemanovi")
# tonalita ve zdrojích
plot(factor(zeman$ton)~factor(zeman$zdroj), col=c("grey","red","green"), las=2,ylab = "Tonalita", xlab = "Zdroj", main = "Tonalita titulků se Zemanem ve zdrojích")
plot(zeman$date,zeman$ton, col=c("grey","red","green"), las=2,ylab = "Tonalita", xlab = "Měsíc", main = "Tonalita titulků se Zemanem v měsících 2016")
'
## [1] "\nlibrary(vcd)\n# ukaž tonalitu celkem\nplot(zeman$ton, xlab=\"tón titulku\", ylab=\"četnost\", main=\"Tonalita titulků o Zemanovi\")\n\n# tonalita ve zdrojích\nplot(factor(zeman$ton)~factor(zeman$zdroj), col=c(\"grey\",\"red\",\"green\"), las=2,ylab = \"Tonalita\", xlab = \"Zdroj\", main = \"Tonalita titulků se Zemanem ve zdrojích\")\n\nplot(zeman$date,zeman$ton, col=c(\"grey\",\"red\",\"green\"), las=2,ylab = \"Tonalita\", xlab = \"Měsíc\", main = \"Tonalita titulků se Zemanem v měsících 2016\")\n"
'
# regrese závislosti - lineární
linearni_model_duvery <- lm(duvera ~ date + lbl_prob + zdroj + ton, data = zeman)
summary(linearni_model_duvery)
# při použití zeman$date vychází 100% vysvětlení (R-squared = 1), což se stane i když použiju zeman$date jako jedinou vysvětlující proměnnou
glm_model_duvery <- glm((zeman$duvera/100) ~ zeman$date * zeman$ton * zeman$zdroj + zeman$lbl_prob, family = binomial(link = logit))
summary(glm_model_duvery)
# nelineární modely
# ANOVA
aov_model_duvery <- aov(duvera ~ as.numeric(date) + lbl_prob + ton * zdroj, data = zeman)
summary(aov_model_duvery)
'
## [1] "\n# regrese závislosti - lineární\nlinearni_model_duvery <- lm(duvera ~ date + lbl_prob + zdroj + ton, data = zeman)\nsummary(linearni_model_duvery)\n\n# při použití zeman$date vychází 100% vysvětlení (R-squared = 1), což se stane i když použiju zeman$date jako jedinou vysvětlující proměnnou\nglm_model_duvery <- glm((zeman$duvera/100) ~ zeman$date * zeman$ton * zeman$zdroj + zeman$lbl_prob, family = binomial(link = logit))\nsummary(glm_model_duvery)\n\n# nelineární modely\n# ANOVA\naov_model_duvery <- aov(duvera ~ as.numeric(date) + lbl_prob + ton * zdroj, data = zeman)\nsummary(aov_model_duvery)\n"
'
zem_pred<-zeman
zem_pred$duveraP_LM <- round(predict(linearni_model_duvery, newdata = zem_pred, type = "response"),2)
zem_pred$duveraP_GLM <- round(predict(glm_model_duvery, newdata = zem_pred, type = "response")*100,2)
zem_pred$duveraP_AOV <- round(predict(aov_model_duvery, newdata = zem_pred, type = "response"),2)
'
## [1] "\nzem_pred<-zeman\nzem_pred$duveraP_LM <- round(predict(linearni_model_duvery, newdata = zem_pred, type = \"response\"),2)\n\nzem_pred$duveraP_GLM <- round(predict(glm_model_duvery, newdata = zem_pred, type = \"response\")*100,2)\n\nzem_pred$duveraP_AOV <- round(predict(aov_model_duvery, newdata = zem_pred, type = \"response\"),2)\n"
'
plot(as.factor(zem_pred$date), zem_pred$duveraP_LM, xlab="měsíc 2016", ylab="odhad % důvěry", main="Predikované hodnoty důvěry ve sledovaném období (lineární)", ylim=c(45,65))
lines(zem_pred$date, zem_pred$duvera, col="red")
plot(as.factor(zem_pred$date), zem_pred$duveraP_GLM, xlab="měsíc 2016", ylab="odhad % důvěry", main="Predikované hodnoty důvěry ve sledovaném období (logistic)", ylim=c(45,65))
lines(zem_pred$date, zem_pred$duvera, col="red")
plot(as.factor(zem_pred$date), zem_pred$duveraP_AOV, xlab="měsíc 2016", ylab="odhad % důvěry", main="Predikované hodnoty důvěry ve sledovaném období (AOV)", ylim=c(45,65))
lines(zem_pred$date, zem_pred$duvera, col="red")
'
## [1] "\nplot(as.factor(zem_pred$date), zem_pred$duveraP_LM, xlab=\"měsíc 2016\", ylab=\"odhad % důvěry\", main=\"Predikované hodnoty důvěry ve sledovaném období (lineární)\", ylim=c(45,65))\nlines(zem_pred$date, zem_pred$duvera, col=\"red\")\n\nplot(as.factor(zem_pred$date), zem_pred$duveraP_GLM, xlab=\"měsíc 2016\", ylab=\"odhad % důvěry\", main=\"Predikované hodnoty důvěry ve sledovaném období (logistic)\", ylim=c(45,65))\nlines(zem_pred$date, zem_pred$duvera, col=\"red\")\n\nplot(as.factor(zem_pred$date), zem_pred$duveraP_AOV, xlab=\"měsíc 2016\", ylab=\"odhad % důvěry\", main=\"Predikované hodnoty důvěry ve sledovaném období (AOV)\", ylim=c(45,65))\nlines(zem_pred$date, zem_pred$duvera, col=\"red\")\n"
'
# přidej počet pos a neg zpráv do data setu
datumy <- levels(grupen$date)
for(i in datumy) {
# doplň hodnoty tonalit v měsících
grupen$POS[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton=="POS")
grupen$NEG[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton=="NEG")
grupen$NEU[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton=="0")
# která média psala positivně?
grupen$pos_zdroj_idnes[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton=="POS" & zeman$zdroj=="idnes.cz")
grupen$pos_zdroj_novinky[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton=="POS" & zeman$zdroj=="novinky.cz")
grupen$pos_zdroj_pl[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton=="POS" & zeman$zdroj=="parlamentnilisty.cz")
# která média psala negativně?
grupen$neg_zdroj_idnes[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton=="NEG" & zeman$zdroj=="idnes.cz")
grupen$neg_zdroj_novinky[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton=="NEG" & zeman$zdroj=="novinky.cz")
grupen$neg_zdroj_pl[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton=="NEG" & zeman$zdroj=="parlamentnilisty.cz")
# neutrální zmínky
grupen$neu_zdroj_idnes[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton=="0" & zeman$zdroj=="idnes.cz")
grupen$neu_zdroj_novinky[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton=="0" & zeman$zdroj=="novinky.cz")
grupen$neu_zdroj_pl[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton=="0" & zeman$zdroj=="parlamentnilisty.cz")
}
'
## [1] "\n# přidej počet pos a neg zpráv do data setu\ndatumy <- levels(grupen$date)\nfor(i in datumy) {\n\n# doplň hodnoty tonalit v měsících \n grupen$POS[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton==\"POS\")\n grupen$NEG[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton==\"NEG\")\n grupen$NEU[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton==\"0\")\n\n# která média psala positivně?\n grupen$pos_zdroj_idnes[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton==\"POS\" & zeman$zdroj==\"idnes.cz\")\n grupen$pos_zdroj_novinky[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton==\"POS\" & zeman$zdroj==\"novinky.cz\")\n grupen$pos_zdroj_pl[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton==\"POS\" & zeman$zdroj==\"parlamentnilisty.cz\")\n\n# která média psala negativně?\n grupen$neg_zdroj_idnes[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton==\"NEG\" & zeman$zdroj==\"idnes.cz\")\n grupen$neg_zdroj_novinky[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton==\"NEG\" & zeman$zdroj==\"novinky.cz\")\n grupen$neg_zdroj_pl[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton==\"NEG\" & zeman$zdroj==\"parlamentnilisty.cz\")\n \n# neutrální zmínky\n grupen$neu_zdroj_idnes[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton==\"0\" & zeman$zdroj==\"idnes.cz\")\n grupen$neu_zdroj_novinky[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton==\"0\" & zeman$zdroj==\"novinky.cz\")\n grupen$neu_zdroj_pl[which(grupen$date==i)]<-sum(zeman$date==i & zeman$ton==\"0\" & zeman$zdroj==\"parlamentnilisty.cz\") \n}\n"
# regrese závislosti
'
linearni_model_duvery_grup <- lm(duvera ~ POS + NEG + NEU + pos_zdroj_idnes + pos_zdroj_novinky + pos_zdroj_pl + neg_zdroj_idnes + neg_zdroj_novinky + neg_zdroj_pl + neu_zdroj_idnes + neu_zdroj_novinky + neu_zdroj_pl + pocet_clanku, data=grupen)
summary(linearni_model_duvery_grup)
grupen$duvera_predict <- round(predict(linearni_model_duvery_grup, newdata = grupen, type = "response"),2)
plot(c(1:12), grupen$duvera, xlab="měsíce 2016", ylab="% důvěry", ylim=c(45,65), main="Důvěra v prezidenta - skutečnost vs. model", col="blue", type="l", lwd=2.5)
lines(grupen$duvera_predict, col="red", type="l", lwd=2.5)
legend(2, 55, x.intersp=0.4, y.intersp=0.4, legend=c("model", "důvěra"), col=c("red", "blue"), lty=1, cex = 0.75, bty="n")
'
## [1] "\nlinearni_model_duvery_grup <- lm(duvera ~ POS + NEG + NEU + pos_zdroj_idnes + pos_zdroj_novinky + pos_zdroj_pl + neg_zdroj_idnes + neg_zdroj_novinky + neg_zdroj_pl + neu_zdroj_idnes + neu_zdroj_novinky + neu_zdroj_pl + pocet_clanku, data=grupen)\n\nsummary(linearni_model_duvery_grup)\n\ngrupen$duvera_predict <- round(predict(linearni_model_duvery_grup, newdata = grupen, type = \"response\"),2)\n\nplot(c(1:12), grupen$duvera, xlab=\"měsíce 2016\", ylab=\"% důvěry\", ylim=c(45,65), main=\"Důvěra v prezidenta - skutečnost vs. model\", col=\"blue\", type=\"l\", lwd=2.5)\nlines(grupen$duvera_predict, col=\"red\", type=\"l\", lwd=2.5)\n\nlegend(2, 55, x.intersp=0.4, y.intersp=0.4, legend=c(\"model\", \"důvěra\"), col=c(\"red\", \"blue\"), lty=1, cex = 0.75, bty=\"n\")\n"
'
require(forecast)
arima_model <- auto.arima(grupen$duvera)
summary(arima_model)
plot(forecast(arima_model, h = 6), main="Předpověď vývoje důvěry", xlab="měsíce - start 1/2016", ylab="% důvěry")
'
## [1] "\nrequire(forecast)\narima_model <- auto.arima(grupen$duvera)\nsummary(arima_model)\n\nplot(forecast(arima_model, h = 6), main=\"Předpověď vývoje důvěry\", xlab=\"měsíce - start 1/2016\", ylab=\"% důvěry\")\n"
'
library(corrgram)
corrgram(korelacni_matice, order=NULL, lower.panel=panel.shade, upper.panel=NULL, text.panel=panel.txt, main="Korelace")
'
## [1] "\nlibrary(corrgram)\ncorrgram(korelacni_matice, order=NULL, lower.panel=panel.shade, upper.panel=NULL, text.panel=panel.txt, main=\"Korelace\")\n"