R for journalister

lenke: https://rpubs.com/chrilur/kurs21

Mandag

Hva er R
Derfor bruker jeg R
Installere R og Rstudio
Rstudios brukergrensesnitt (GUI)
R-syntaks
Laste inn data i R, behandle og visualisere dem

Tirsdag

Areal vs. befolkning
Valg 21: Et skript for å beregne mandater til Stortinget
Yr: Lage et temperaturvarsel oppdatert i sanntid
Egne oppgaver

Onsdag

rvest og skrape nettsider
Facebook-nettverk: Lag en venneanalyse
Egne oppgaver

Hva er R?

Objektorientert programspråk for statistisk analyse
Verktøy for å innhente, analysere og publisere data
Gratis
Utvikles hver eneste dag
> 18.000 pakker
Forståelig syntaks (etter hvert)
Mye gratis hjelp og inspirasjon å få!

Når velger jeg å bruke R?

Når det er eneste måte
Når det sparer tid
Når jeg skal løse en repeterende (kjedelig) oppgave
Når jeg vil ha full kontroll over mine data
Når jeg vil lære mer R
Når jeg vil ha det gøy

Når bruker jeg ikke R?

Når det er kjappere å la være

Men i starten vil det alltid være kjappere å la være...

=> Punkt 5 og 6 er viktigst!

De to-tre viktigste grunnene til å programmere

Skriptet ditt er for dine data det notatblokken er for din artikkel.

Skriptet ditt er for dine data det kakeoppskriften er for din kake.

Du har full kontroll, ref. pkt. 4.

Rstudio

Sjekk fileEncoding

R-syntaks

Objekt: Noe datainnhold som har fått et navn
<- : Putt inn noe i et objekt
Vektor: Flere objekter/verdier samlet
c() : Slå sammen verdier til en vektor
str() : Sjekk objektet
() : Parenteser rundt argumentene til funksjonen
[] : Hent noe fra en vektor
{} : Krølleparentes rundt funksjoner og if-uttrykk
character() : Vektoren er tekst
integer() : Vektoren er hele tall
numeric() : Vektoren er desimaltall
logical() : TRUE eller FALSE
data.frame() : Rs form for Excel-tabell. Hver kolonne er en vektor
ifelse() : Hvis noe er oppfylt, skal noe skje. Ellers skjer noe annet
function() : Denne koden kan brukes på flere verdier
sapply() : Kjør funksjon på flere verdier
gsub() : Bytt ut noe tekst
strsplit() : Del opp tekst
paste() : Lim sammen tekst og objekter
subset() : Filtrer data.frame

Last inn data: Elever i grunnskolen

#https://www.ssb.no/statbank/table/11971/tableViewLayout1/
#setwd("kurs_uib/2021")
library(ggplot2)

elever <- read.csv("data/elever.csv", sep=";")
str(elever)

## 'data.frame':    724 obs. of  7 variables:
##  $ region                                 : chr  "3001 Halden" "3002 Moss" "3003 Sarpsborg" "3004 Fredrikstad" ...
##  $ Elever.per.kommunal.skole..antall..2015: chr  "." "." "." "." ...
##  $ Elever.per.kommunal.skole..antall..2016: chr  "." "." "." "." ...
##  $ Elever.per.kommunal.skole..antall..2017: chr  "." "." "." "." ...
##  $ Elever.per.kommunal.skole..antall..2018: chr  "." "." "." "." ...
##  $ Elever.per.kommunal.skole..antall..2019: chr  "." "." "." "." ...
##  $ Elever.per.kommunal.skole..antall..2020: chr  "318.2" "309.5" "330.9" "303.2" ...

fjern <- c(2:6)
fjern

## [1] 2 3 4 5 6

elever <- elever[-fjern]
names(elever) <- c("region", "antall_2020")

head(elever)

##             region antall_2020
## 1      3001 Halden       318.2
## 2        3002 Moss       309.5
## 3   3003 Sarpsborg       330.9
## 4 3004 Fredrikstad       303.2
## 5     3005 Drammen       368.3
## 6   3006 Kongsberg       247.9

fjern.tomme <- which(elever$antall_2020 == ".")
elever <- elever[-fjern.tomme,]
elever$region <- substr(elever$region,6,nchar(elever$region))

elever$antall_2020 <- as.numeric(elever$antall_2020)

ggplot(elever, aes(x=region, y=antall_2020)) + geom_point()

elever <- elever[order(elever$antall_2020),]

#https://www.nrk.no/innlandet/800-elever-og-ansatte-ved-glommasvingen-skole-i-sor-odal-settes-i-karantene-1.15424260

elever$gruppe <- cut(elever$antall_2020, breaks = c(0,100,200,300,400,Inf))

ggplot(elever, aes(x=region, y=antall_2020, color=gruppe)) + geom_point()

ggplot(elever, aes(x=region, y=antall_2020, color=gruppe)) + geom_point() +
  geom_text(aes(label=ifelse(antall_2020 > 400,as.character(region),"")),hjust=1.1,vjust=0) +
  theme(axis.text.x = element_blank(), 
        axis.ticks.x = element_blank()) +
  ggtitle("Antall elever på norske grunnskoler \npr. kommune (2020)")

Tirsdag

setwd() i RStudio
Spør om funksjoner i console

Last inn data: Areal vs befolkning

# install.packages("readxl")

options(scipen=999)  # Skru av vitenskapsnotasjon

library(ggplot2)
library(readxl)

theme_set(theme_bw())  # Sett designuttrykk.

kommuner <- read_xlsx("data/kommuner.xlsx")
names(kommuner) <- c("komnr", "navn", "admsenter", "fylke", "befolkning", "areal", "språk", "ordfører", "parti")

kommuner$språk <- gsub("Neutral", "Nøytral", kommuner$språk)

str(kommuner)

## tibble [356 x 9] (S3: tbl_df/tbl/data.frame)
##  $ komnr     : chr [1:356] "0301" "1101" "1103" "1106" ...
##  $ navn      : chr [1:356] "Oslo" "Eigersund" "Stavanger" "Haugesund" ...
##  $ admsenter : chr [1:356] "Oslo" "Egersund" "Stavanger" "Haugesund" ...
##  $ fylke     : chr [1:356] "Oslo" "Rogaland" "Rogaland" "Rogaland" ...
##  $ befolkning: chr [1:356] "673,469" "14,898" "141,186" "37,167" ...
##  $ areal     : chr [1:356] "454.03" "431.66" "262.52" "72.72" ...
##  $ språk     : chr [1:356] "Nøytral" "Bokmål" "Bokmål" "Bokmål" ...
##  $ ordfører  : chr [1:356] "Marianne Borgen" "Leif Erik Egaas" "Kari Nessa Nordtun" "Petter Steen jr" ...
##  $ parti     : chr [1:356] "SV" "H" "Ap" "H" ...

kommuner$befolkning <- gsub(",", "", kommuner$befolkning)
kommuner$befolkning <- as.integer(kommuner$befolkning)
kommuner$areal <- gsub(",", "", kommuner$areal)
kommuner$areal <- as.numeric(kommuner$areal)

str(kommuner)

## tibble [356 x 9] (S3: tbl_df/tbl/data.frame)
##  $ komnr     : chr [1:356] "0301" "1101" "1103" "1106" ...
##  $ navn      : chr [1:356] "Oslo" "Eigersund" "Stavanger" "Haugesund" ...
##  $ admsenter : chr [1:356] "Oslo" "Egersund" "Stavanger" "Haugesund" ...
##  $ fylke     : chr [1:356] "Oslo" "Rogaland" "Rogaland" "Rogaland" ...
##  $ befolkning: int [1:356] 673469 14898 141186 37167 76328 3331 3237 2826 18762 19042 ...
##  $ areal     : num [1:356] 454 431.7 262.5 72.7 304.5 ...
##  $ språk     : chr [1:356] "Nøytral" "Bokmål" "Bokmål" "Bokmål" ...
##  $ ordfører  : chr [1:356] "Marianne Borgen" "Leif Erik Egaas" "Kari Nessa Nordtun" "Petter Steen jr" ...
##  $ parti     : chr [1:356] "SV" "H" "Ap" "H" ...

kommuner$tetthet <- kommuner$befolkning / kommuner$areal

# Scatterplot
gg <- ggplot(kommuner, aes(x=areal, y=befolkning)) + 
  geom_point(aes(col=fylke, size=tetthet)) + 
  geom_smooth(method="loess", se=F) + 
  xlim(c(0, 9750)) + 
  ylim(c(0, 675000)) + 
  labs(subtitle="Areal vs befolkning", 
       y="Befolkning", 
       x="Areal", 
       title="Scatterplot")

plot(gg)

## `geom_smooth()` using formula 'y ~ x'

#Ta vekk Oslo og kommuner med størst areal
minste <- subset(kommuner, kommuner$areal < 500)
minste <- subset(minste, minste$navn != "Oslo")

ggminste <- ggplot(minste, aes(x=areal, y=befolkning)) + 
  geom_point(aes(col=fylke, size=tetthet)) + 
  geom_smooth(method="loess", se=F) + 
  xlim(c(0, 500)) + 
  ylim(c(0, 300000)) + 
  labs(subtitle="Areal vs befolkning, kommuner < 500 km^2, unntatt Oslo", 
       y="Befolkning", 
       x="Areal", 
       title="Scatterplot")

plot(ggminste)

## `geom_smooth()` using formula 'y ~ x'

Valg 21: Mandatberegning

I Norge brukes Sainte-LaguÃ«s modifiserte metode for å beregne hvor mange mandater hvert parti skal ha.

Mål: Regne ut antall distriktsmandater selv.
Forstå utregningen og vårt demokratiske system.
Frigjøre oss fra ekspertene.
Fastslå hvor mange stemmer som skiller kandidatene.
Lage egne prognoser neste gang.

library(tidyr)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(writexl)

#Laste inn valglister fra Valgdirektoratet
lister <- read.csv("data/lister21.csv", fileEncoding = "UTF-8")

#Laste inn resultater
fylkesfordeling <- read.csv("data/partifordeling.csv", sep=";", fileEncoding = "UTF-8")
distriktsres <- fylkesfordeling[c(1,2,7,8,9,10,13)]

names(distriktsres) <- c("fnr", "fylke", "kode", "parti", "pros", "ant_velgere", "stemmer")
head(distriktsres)

##   fnr   fylke kode                          parti     pros ant_velgere stemmer
## 1   1 Østfold    A                Arbeiderpartiet  30,4802      223945   49345
## 2   1 Østfold   SV SV - Sosialistisk Venstreparti  6,07874      223945    9841
## 3   1 Østfold RØDT                           Rødt  4,58145      223945    7417
## 4   1 Østfold   SP                  Senterpartiet 14,11311      223945   22848
## 5   1 Østfold  KRF           Kristelig Folkeparti  3,34235      223945    5411
## 6   1 Østfold  MDG         Miljøpartiet De Grønne  2,95444      223945    4783

str(distriktsres)

## 'data.frame':    380 obs. of  7 variables:
##  $ fnr        : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ fylke      : chr  "Østfold" "Østfold" "Østfold" "Østfold" ...
##  $ kode       : chr  "A" "SV" "RØDT" "SP" ...
##  $ parti      : chr  "Arbeiderpartiet" "SV - Sosialistisk Venstreparti" "Rødt" "Senterpartiet" ...
##  $ pros       : chr  "30,4802" "6,07874" "4,58145" "14,11311" ...
##  $ ant_velgere: int  223945 223945 223945 223945 223945 223945 223945 223945 223945 223945 ...
##  $ stemmer    : int  49345 9841 7417 22848 5411 4783 4770 30210 20526 172 ...

#Fikse prosenttall slik at de faktisk er tall
distriktsres$pros <- gsub(",", "\\.", distriktsres$pros)
distriktsres$pros <- as.numeric(distriktsres$pros)
str(distriktsres)

## 'data.frame':    380 obs. of  7 variables:
##  $ fnr        : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ fylke      : chr  "Østfold" "Østfold" "Østfold" "Østfold" ...
##  $ kode       : chr  "A" "SV" "RØDT" "SP" ...
##  $ parti      : chr  "Arbeiderpartiet" "SV - Sosialistisk Venstreparti" "Rødt" "Senterpartiet" ...
##  $ pros       : num  30.48 6.08 4.58 14.11 3.34 ...
##  $ ant_velgere: int  223945 223945 223945 223945 223945 223945 223945 223945 223945 223945 ...
##  $ stemmer    : int  49345 9841 7417 22848 5411 4783 4770 30210 20526 172 ...

#En tallfølge som brukes til St. LaguÃ«s modifiserte metode
delingstall  <- seq(1,129,2)
delingstall[1] <- 1.4
length(delingstall)

## [1] 65

#Antall distriktsmandater pr. fylke
ant.dman <- data.frame(fnr = c(1,2,3,4,5,6,7,8,9,10,11,12,14,15,16,17,18,19,20),
                       man = c(8,18,19,6,5,7,6,5,3,5,13,15,3,7,9,4,8,5,4))

#Funksjon regner ut hvem som kommer inn for hvert fylke
get.fylkesres <- function(f) {
  m <- ant.dman[f,2]
  
  fylkesres <- distriktsres %>% 
                filter(fnr == ant.dman[f,1])

  f_delingstall  <- seq(1,129,2)
  f_delingstall[1] <- 1.4
  f_delingstall <- f_delingstall[1:m]

  d_stlague <- function(i) {
    del <- fylkesres$stemmer/delingstall[i]
    fylkesres <<- cbind(fylkesres,del)
  }

  fylkesres <- lapply(1:m, function(x) d_stlague(x))
  fylkesres <- as.data.frame(fylkesres[[m]])
  dels <- paste0("del", 1:m)
  dels <- c("fnr", "fylke", "kode", "parti", "pros", "ant_velgere", "stemmer", dels)
  names(fylkesres) <- dels

  fylkesres <- pivot_longer(fylkesres, cols=starts_with("del")) %>% 
    arrange(-value)

  fylkesres$name <- gsub("del","", fylkesres$name)
  fylkesres$name <- as.integer(fylkesres$name)
  fylkesres <- fylkesres[1:m,]
  
  #Finne politikernavn
get.pol <- function(j) {
  lister %>% filter(valgdistrikt == as.character(fylkesres[j,2]),
                    partikode == as.character(fylkesres[j,3]),
                    kandidatnr == as.integer(fylkesres[j,8])) %>% 
                    select(navn)
  }

pols <- data.frame(unlist(sapply(1:m, function(j) get.pol(j))))
names(pols) <- "kandidat"
fylkesres <- cbind(fylkesres, pols)
return(fylkesres)
}

#Beregne distriktsmandater for Hordaland valgkrets
get.fylkesres(11)

##    fnr    fylke kode                          parti     pros ant_velgere
## 1   11 Rogaland    H                          Høyre 23.94762      333475
## 2   11 Rogaland    A                Arbeiderpartiet 22.39353      333475
## 3   11 Rogaland  FRP             Fremskrittspartiet 16.75738      333475
## 4   11 Rogaland    H                          Høyre 23.94762      333475
## 5   11 Rogaland    A                Arbeiderpartiet 22.39353      333475
## 6   11 Rogaland   SP                  Senterpartiet 10.41354      333475
## 7   11 Rogaland  KRF           Kristelig Folkeparti  8.05710      333475
## 8   11 Rogaland  FRP             Fremskrittspartiet 16.75738      333475
## 9   11 Rogaland    H                          Høyre 23.94762      333475
## 10  11 Rogaland    A                Arbeiderpartiet 22.39353      333475
## 11  11 Rogaland   SV SV - Sosialistisk Venstreparti  5.12275      333475
## 12  11 Rogaland   SP                  Senterpartiet 10.41354      333475
## 13  11 Rogaland    H                          Høyre 23.94762      333475
##    stemmer name     value                  kandidat
## 1    61992    1 44280.000                  Tina Bru
## 2    57969    1 41406.429               Hadia Tajik
## 3    43379    1 30985.000            Roy Steffensen
## 4    61992    2 20664.000        Sveinung Stensland
## 5    57969    2 19323.000    Torstein Tvedt Solberg
## 6    26957    1 19255.000            Geir Pollestad
## 7    20857    1 14897.857   Olaug  Vervik Bollestad
## 8    43379    2 14459.667           Terje Halleland
## 9    61992    3 12398.400           Margret Hagerup
## 10   57969    3 11593.800        Tove Elise Madland
## 11   13261    1  9472.143             Ingrid Fiskaa
## 12   26957    2  8985.667 Lisa Marie Ness Klungland
## 13   61992    4  8856.000       Aleksander Stokkebø

#Beregne alle distriktsmandater og lagre dem som Excel-fil 
alle <- lapply(1:19, function(x) get.fylkesres(x))
alle <- do.call("rbind", alle)

write_xlsx(alle, "data/distriktsmandater_2021.xlsx")

Onsdag

Analyse av Facebook-likes

Brennpunkt: Millioneventyret (januar 2021)

Facebook er vanskelig å skrape etter Cambridge Analytica-skandalen.

Mål: Lage en venneoversikt basert på bilde-likes.

library(writexl)

fb <- function(x) {
  path <- "data\\fbbilder"
  mappe <- dir(path)
  nytt.bilde <- paste0(path, "\\", mappe[grep(".jpg", mappe)])
  
  fiks.tegn <- function(i) {
    tekst <- ny.tekst[,i]
    tekst <- gsub("Ø", "?", tekst)
    tekst <- gsub("æ", "?", tekst)
    tekst <- gsub("ø", "?", tekst)
    tekst <- gsub("å", "?", tekst)
    tekst <- gsub("ö", "?", tekst)
    tekst <- gsub("ä", "?", tekst)
    tekst <- gsub("?.", "?", tekst)
    return(tekst)
  }
  
  if (file.exists(nytt.bilde) == TRUE){
    ny.tekst <- read.delim(paste0(path, "\\", "tekst.txt"), header=FALSE)
    ny.tekst[,1] <- fiks.tegn(1)
    
    navn <- ny.tekst[2,]
    navn <- strsplit(navn, ",")[[1]][1]
    
    dato <- ny.tekst[3,]
    
    #Lag ny mappe hvis navn ikke eksisterer
    dir.create(file.path(path, navn), showWarnings = FALSE)
    
    #gi nytt navn til bilde
    ny.mappe <- paste0("data\\fbbilder\\",navn)
    filer <- dir(ny.mappe)
    index <- length(grep(".jpg", filer)) + 1
    nytt.bildenavn <- paste0("data\\fbbilder\\",navn, "_", index, ".jpg")
    nytt.bildenavn2 <- paste0(navn, "_", index, ".jpg")
    file.rename(nytt.bilde, nytt.bildenavn)
    
    #Flytt bildet til ny mappe
    file.copy(from = nytt.bildenavn,
              to   = ny.mappe)
    file.remove(nytt.bildenavn)
    
    #Lag mappe til kommentarer
    kommentarmappe <- paste0(navn, "_kommentarer")
    dir.create(file.path(ny.mappe, kommentarmappe), showWarnings = FALSE)
    
    #Hente ut tekst fra fil
    start <- nrow(ny.tekst) - x + 1
    slutt <- nrow(ny.tekst)
    likes <- ny.tekst[start:slutt,]
    
    df <- data.frame(fil=nytt.bildenavn2, likes = likes, dato = dato)
    
    ##Sjekk om data allerede eksisterer. Hvis ikke, lagre data
    filnavn <- paste0("data\\fbbilder\\",navn,"\\",navn,".csv")
    filnavnexcel <- paste0("data\\fbbilder\\",navn,"\\",navn,".xlsx")
    
    if (file.exists(filnavn) == TRUE){
      alle.data <- read.csv(filnavn)} else {
        alle.data <- data.frame(fil=character(), likes=character())
      }
    
    alle.data <- rbind(alle.data, df)
    write.csv(alle.data, filnavn, row.names = FALSE)
    write_xlsx(alle.data, filnavnexcel)
    
    ##Lag liste over de som liker mest
    freq <- as.data.frame(table(alle.data[,2]))
    freq <- freq[order(freq[,2], decreasing=TRUE),]
    names(freq) <- c("navn", "antall")
    freqfile <- paste0("data\\fbbilder\\",navn,"\\",navn,"_freq.xlsx")
    write_xlsx(freq, freqfile)
    
    #Lagre fil av kommentarer
    kommentarfilnavn <- paste0("data\\fbbilder\\",navn,"\\",kommentarmappe, "\\",navn, "_", index, ".txt")
    write.table(ny.tekst, kommentarfilnavn, sep="", row.names = FALSE, col.names = FALSE, fileEncoding = "UTF-8")
  } else {
    print("bildefil mangler")
  }
}

Lage nettverk av Facebook-data

#Lage nettverk av to navn fra Facebook-basen
library(readxl)
library(networkD3)
library(htmlwidgets)

## 
## Attaching package: 'htmlwidgets'

## The following object is masked from 'package:networkD3':
## 
##     JS

path <- "C:\\Users\\n633164\\Documents\\R\\kurs_uib\\2021\\data\\"
dmapper <- dir(paste0(path, "fbbilder"))
dmapper <- dmapper[-grep("tekst.txt", dmapper)]
ant.mapper <- length(dmapper)


duo <- function(x,y) {
  pers1 <- dmapper[x]
  pers2 <- dmapper[y]
  
  #Finne felles kjente
  fil1 <- paste0(path, "fbbilder\\", pers1,"\\",pers1, "_freq.xlsx")
  fil2 <- paste0(path, "fbbilder\\", pers2,"\\",pers2, "_freq.xlsx")
  
  if (file.exists(fil1) & file.exists(fil2)){
    data1 <- read_xlsx(fil1)
    data2 <- read_xlsx(fil2)
    felles <- intersect(data1$navn, data2$navn)
    
    
    #Fjern skit
    fjern1 <- grep("Kommentarer", felles)
    fjern2 <- grep("Skriv en kommentar", felles)
    fjern3 <- grep("4 år", felles)
    fjern4 <- grep("5 år", felles)
    fjern5 <- grep("6 år", felles)
    fjern6 <- grep("1 år", felles)
    fjern7 <- grep("Se opprinnelig tekst", felles)
    fjern8 <- grep("Oversett alle kommentarer", felles)
    fjern9 <- grep("2 år", felles)
    fjern10 <- grep("3 år", felles)
    fjern <- c(fjern1,fjern2,fjern3,fjern4,fjern5,fjern6,fjern7,fjern8,fjern9,fjern10)
    felles <- if (length(fjern) > 0) {felles[-fjern]} else {felles}
    
    #Fiks bokstaver
    felles <- gsub("ÃƒËœ", "Å", felles)
    felles <- gsub("ÃƒÂ¸", "ø", felles)
    felles <- gsub("ÃƒÂ¸", "ø", felles)
    felles <- gsub("ÃƒÂ¥", "å", felles)
    felles <- gsub("ÃƒÂ¦", "æ", felles)
    felles <- gsub("Ãƒâ€¦", "Ã…", felles)
    
    #Sjekk om pers1 kjenner pers2
    vennesjekk <- grepl(pers1, data2[,1], fixed=TRUE)
    
    #Hvis det er ingen felles venner, avbryt.
    if (length(felles) == 0) {
      print(paste0(pers1, " og ", pers2, " har ingen felles venner."))
      break} else {
        #Lage nettverk
        df1 <- data.frame(person = pers1, bekjent = felles)
        df2 <- data.frame(person = pers2, bekjent = felles)
        df <- rbind(df1,df2)
        
        #Hvis pers1 og pers2 er venner, legg til node
        if(vennesjekk == TRUE) {
          venner <- data.frame(person=pers1, bekjent=pers2)
          df <- rbind(df, venner)
        }
        
        
        names(df) <- c("from", "to")
        nw <- simpleNetwork(df, height="200px", width="200px",        
                            Source = 1,                 # column number of source
                            Target = 2,                 # column number of target
                            linkDistance = 10,          # distance between node. Increase this value to have more space between nodes
                            charge = -2000,                # numeric value indicating either the strength of the node repulsion (negative value) or attraction (positive value)
                            fontSize = 16,               # size of the node names
                            fontFamily = "serif",       # font og node names
                            linkColour = "#666",        # colour of edges, MUST be a common colour for the whole graph
                            nodeColour = "#99098a",     # colour of nodes, MUST be a common colour for the whole graph
                            opacity = 0.9,              # opacity of nodes. 0=transparent. 1=no transparency
                            zoom = T                    # Can you zoom on the figure?
        )
        
        filnavn <- paste0("C:\\Users\\n633164\\Documents\\R\\kurs_uib\\2021\\nettverk\\",pers1,"-", pers2,".html")
        saveWidget(nw, file=filnavn)
      }} else {
        df <- "Mangler fil"
      }
  return(df)
}

Temperaturvarsel i sanntid

Mål: Lage et skript som henter temperaturdata fra Yr, lagrer dem og laster dem opp til Google for publisering.

Yr api -> R -> Google Drive -> Polopoly -> www

library(jsonlite)
library(ggplot2)
library(lubridate)

## 
## Attaching package: 'lubridate'

## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union

library(googlesheets4)

#Hente data
yrurl <- "https://api.met.no/weatherapi/locationforecast/2.0/complete?altitude=0&lat=60.39299&lon=5.32415"
yr <- fromJSON(yrurl)

#Ta en kikk
#head(yr)
str(yr)

## List of 3
##  $ type      : chr "Feature"
##  $ geometry  :List of 2
##   ..$ type       : chr "Point"
##   ..$ coordinates: num [1:3] 5.32 60.39 0
##  $ properties:List of 2
##   ..$ meta      :List of 2
##   .. ..$ updated_at: chr "2021-10-20T08:55:29Z"
##   .. ..$ units     :List of 24
##   .. .. ..$ air_pressure_at_sea_level    : chr "hPa"
##   .. .. ..$ air_temperature              : chr "celsius"
##   .. .. ..$ air_temperature_max          : chr "celsius"
##   .. .. ..$ air_temperature_min          : chr "celsius"
##   .. .. ..$ air_temperature_percentile_10: chr "celsius"
##   .. .. ..$ air_temperature_percentile_90: chr "celsius"
##   .. .. ..$ cloud_area_fraction          : chr "%"
##   .. .. ..$ cloud_area_fraction_high     : chr "%"
##   .. .. ..$ cloud_area_fraction_low      : chr "%"
##   .. .. ..$ cloud_area_fraction_medium   : chr "%"
##   .. .. ..$ dew_point_temperature        : chr "celsius"
##   .. .. ..$ fog_area_fraction            : chr "%"
##   .. .. ..$ precipitation_amount         : chr "mm"
##   .. .. ..$ precipitation_amount_max     : chr "mm"
##   .. .. ..$ precipitation_amount_min     : chr "mm"
##   .. .. ..$ probability_of_precipitation : chr "%"
##   .. .. ..$ probability_of_thunder       : chr "%"
##   .. .. ..$ relative_humidity            : chr "%"
##   .. .. ..$ ultraviolet_index_clear_sky  : chr "1"
##   .. .. ..$ wind_from_direction          : chr "degrees"
##   .. .. ..$ wind_speed                   : chr "m/s"
##   .. .. ..$ wind_speed_of_gust           : chr "m/s"
##   .. .. ..$ wind_speed_percentile_10     : chr "m/s"
##   .. .. ..$ wind_speed_percentile_90     : chr "m/s"
##   ..$ timeseries:'data.frame':   79 obs. of  2 variables:
##   .. ..$ time: chr [1:79] "2021-10-20T09:00:00Z" "2021-10-20T10:00:00Z" "2021-10-20T11:00:00Z" "2021-10-20T12:00:00Z" ...
##   .. ..$ data:'data.frame':  79 obs. of  4 variables:
##   .. .. ..$ instant      :'data.frame':  79 obs. of  1 variable:
##   .. .. .. ..$ details:'data.frame': 79 obs. of  17 variables:
##   .. .. .. .. ..$ air_pressure_at_sea_level    : num [1:79] 983 983 983 982 982 ...
##   .. .. .. .. ..$ air_temperature              : num [1:79] 12.3 12.2 11.8 11.6 11.1 11 10.9 10.8 10.8 9.2 ...
##   .. .. .. .. ..$ air_temperature_percentile_10: num [1:79] 11.6 11.3 11.1 10.9 10.4 10.3 10.1 10 9.6 8.5 ...
##   .. .. .. .. ..$ air_temperature_percentile_90: num [1:79] 12.9 12.8 12.5 12.3 12 11.8 11.6 11.6 11.5 10.7 ...
##   .. .. .. .. ..$ cloud_area_fraction          : num [1:79] 100 100 100 100 100 100 99.9 100 100 100 ...
##   .. .. .. .. ..$ cloud_area_fraction_high     : num [1:79] 0 0 0 0 0 0 0 0 0 0 ...
##   .. .. .. .. ..$ cloud_area_fraction_low      : num [1:79] 100 100 100 100 100 100 99.9 100 100 100 ...
##   .. .. .. .. ..$ cloud_area_fraction_medium   : num [1:79] 75.6 95.9 97.5 99.3 91.8 88.3 70.1 79.7 94.8 99.9 ...
##   .. .. .. .. ..$ dew_point_temperature        : num [1:79] 12.2 11.6 11 10.4 10.1 10.2 10.1 10 9.7 8.8 ...
##   .. .. .. .. ..$ fog_area_fraction            : num [1:79] 0.9 0 0 0 0 0 0 0 0 0.2 ...
##   .. .. .. .. ..$ relative_humidity            : num [1:79] 98.8 95.6 94.5 91.9 93.3 94.5 94.7 94.9 92.5 97.2 ...
##   .. .. .. .. ..$ ultraviolet_index_clear_sky  : num [1:79] 0.5 0.7 0.9 0.8 0.6 0.4 0.1 0 0 0 ...
##   .. .. .. .. ..$ wind_from_direction          : num [1:79] 213 206 210 216 206 ...
##   .. .. .. .. ..$ wind_speed                   : num [1:79] 6.4 5.5 6 6.7 6.3 7.1 7.3 6.5 7.7 3.7 ...
##   .. .. .. .. ..$ wind_speed_of_gust           : num [1:79] 12.8 11.7 11.3 12.3 12.1 13.2 13.8 13.8 14.1 14.5 ...
##   .. .. .. .. ..$ wind_speed_percentile_10     : num [1:79] 5.5 5.3 5.5 4.9 5.7 6.6 7 6.5 6.4 3.7 ...
##   .. .. .. .. ..$ wind_speed_percentile_90     : num [1:79] 7.2 6.8 7.5 7.3 7.6 7.8 7.9 7.9 8.2 7.6 ...
##   .. .. ..$ next_12_hours:'data.frame':  79 obs. of  2 variables:
##   .. .. .. ..$ summary:'data.frame': 79 obs. of  2 variables:
##   .. .. .. .. ..$ symbol_code      : chr [1:79] "rain" "rain" "rain" "heavyrain" ...
##   .. .. .. .. ..$ symbol_confidence: chr [1:79] "certain" "certain" "certain" "certain" ...
##   .. .. .. ..$ details:'data.frame': 79 obs. of  1 variable:
##   .. .. .. .. ..$ probability_of_precipitation: num [1:79] 100 100 100 100 100 100 100 100 100 100 ...
##   .. .. ..$ next_1_hours :'data.frame':  79 obs. of  2 variables:
##   .. .. .. ..$ summary:'data.frame': 79 obs. of  1 variable:
##   .. .. .. .. ..$ symbol_code: chr [1:79] "lightrain" "cloudy" "cloudy" "rain" ...
##   .. .. .. ..$ details:'data.frame': 79 obs. of  5 variables:
##   .. .. .. .. ..$ precipitation_amount        : num [1:79] 0.2 0 0 0.5 0.8 0.6 0.6 0.5 2.7 1.4 ...
##   .. .. .. .. ..$ precipitation_amount_max    : num [1:79] 1.1 0.6 1.3 1.5 1.7 1.7 2.4 3.6 4.2 5 ...
##   .. .. .. .. ..$ precipitation_amount_min    : num [1:79] 0 0 0 0 0.2 0 0 0.3 0.9 0.9 ...
##   .. .. .. .. ..$ probability_of_precipitation: num [1:79] 48.6 33.9 33.6 68.5 86.1 75.7 80 91.8 97.3 99.5 ...
##   .. .. .. .. ..$ probability_of_thunder      : num [1:79] 1.1 1.1 0.6 0.3 0.4 0.3 0.4 0.6 1 0.1 ...
##   .. .. ..$ next_6_hours :'data.frame':  79 obs. of  2 variables:
##   .. .. .. ..$ summary:'data.frame': 79 obs. of  1 variable:
##   .. .. .. .. ..$ symbol_code: chr [1:79] "rain" "rain" "rain" "heavyrain" ...
##   .. .. .. ..$ details:'data.frame': 79 obs. of  6 variables:
##   .. .. .. .. ..$ air_temperature_max         : num [1:79] 12.2 11.8 11.6 11.1 11 10.9 10.8 10.8 9.2 8.8 ...
##   .. .. .. .. ..$ air_temperature_min         : num [1:79] 10.9 10.8 10.8 9.2 8.8 8.4 8.2 7.9 7.4 7.2 ...
##   .. .. .. .. ..$ precipitation_amount        : num [1:79] 2.8 2.8 4 6.7 8.7 9.1 9.1 9.5 8.7 5.5 ...
##   .. .. .. .. ..$ precipitation_amount_max    : num [1:79] 5.7 6.5 8.7 11.5 14.4 16.2 16.3 16.2 14.5 13.1 ...
##   .. .. .. .. ..$ precipitation_amount_min    : num [1:79] 1.1 1.4 2.2 3.7 5.1 5.4 5.7 6 5.5 3.8 ...
##   .. .. .. .. ..$ probability_of_precipitation: num [1:79] 95.2 97.5 99.9 100 100 100 100 100 100 100 ...

#Finne og fikse tider
tid <- yr$properties$timeseries$time
tid <- gsub("Z", "", tid)
tid <- gsub("T", " ", tid)
tid <- ymd_hms(tid, tz=Sys.timezone())
tid <- tid + 2*60*60

#Finne temperaturene
temp <- yr$properties$timeseries$data$instant$details$air_temperature

#Lag data frame
tempbergen <- data.frame(tid=tid, temp=temp)
head(tempbergen)

##                   tid temp
## 1 2021-10-20 11:00:00 12.3
## 2 2021-10-20 12:00:00 12.2
## 3 2021-10-20 13:00:00 11.8
## 4 2021-10-20 14:00:00 11.6
## 5 2021-10-20 15:00:00 11.1
## 6 2021-10-20 16:00:00 11.0

#Lag et plot
tempplot <- ggplot(tempbergen, aes(x=tid, y=temp)) + geom_abline() +
  xlab("dato") + ylab("temperatur") +
  labs(title = "Temperaturvarsel for Bergen") 

#tempplot
tempplot + geom_smooth()

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

#Lagre dataene med unikt filnavn
filnavn <- paste0("data/temp/yrbergen_",Sys.time(),".csv")
filnavn <- gsub(" ", "_", filnavn)
filnavn <- gsub(":", "-", filnavn)
write.csv(tempbergen, filnavn, row.names = FALSE)

#Laste data opp til rett Google-regneark
#vær <- gs4_create("temperatur i Bergen")
tempbergen$tid <- as.character(tempbergen$tid)
id <- "1xBtpuNezTT6yD8Ba_ikW_6_OrainVVWGCmlQmCvw6nI"
tempbergen %>% sheet_write(id, sheet = "Ark 1")

## ! Using an auto-discovered, cached token.

##   To suppress this message, modify your code or options to clearly consent to
##   the use of a cached token.

##   See gargle's "Non-interactive auth" vignette for more details:

##   <https://gargle.r-lib.org/articles/non-interactive-auth.html>

## i The googlesheets4 package is using a cached token for
##   'christian.lura@gmail.com'.

## Auto-refreshing stale OAuth token.

## v Writing to "temperatur i Bergen".

## v Writing to sheet 'Ark 1'.

R for journalister

Christian Lura

UiB, oktober 2021

Mandag

Tirsdag

Onsdag

Hva er R?

Når velger jeg å bruke R?

Når bruker jeg ikke R?

Men i starten vil det alltid være kjappere å la være...

=> Punkt 5 og 6 er viktigst!

De to-tre viktigste grunnene til å programmere

Rstudio

R-syntaks

Last inn data: Elever i grunnskolen

Tirsdag

Last inn data: Areal vs befolkning

Valg 21: Mandatberegning

Onsdag

Analyse av Facebook-likes

Lage nettverk av Facebook-data

Temperaturvarsel i sanntid