Ero sivun ”Koronavirus” versioiden välillä

Versio 27. heinäkuuta 2021 kello 09.51

Tämä sivu on ensyklopedia-artikkeli. Sivutunniste: Op_fi5925
Moderaattori:Jouni (katso kaikki) Sivun edistymistä ei ole arvioitu. Arvostuksen määrää ei ole arvioitu (ks. peer review).
Lisää dataa {{#opasnet_base_link:Op_fi5925}}

Koronavirus käsittelee SARS-COV-2-viruksen ja sen aiheuttaman COVID-19-taudin olennaisia piirteitä.

Laskenta

Piirrä näkemysverkko Kialon koronakeskustelusta

Argumentaatio koskien koronarokotusten pakollisuutta.

Koronakide-hankkeeseen liittyen tehdään näkemysverkkoja koronarokotusten argumentaatiosta.

Laskennan logiikka on seuraava. Alkuperäiseen väitteeseen A kohdistuu argumentti B ja tähän kohdistuu argumentti C eli C → B → A. Prioritodennäköisyys, että A on totta eli A+ on P(A), kun meillä ei ole muuta tietoa. Kun lisätään argumentti B, saadaan Bayesin kaavalla

P(A|B) = P(B|A)P(A)/P(B).

Vastaava kaava saadaan todennäköisyydelle että A ei tapahdu eli A- jolloin P(A-) = 1-P(A+). Sama voidaan merkitä jos P(A) = p niin vastaava vedonlyöntisuhde (odds) on O(A) = q = p/(1-p) ja p = q/(q+1). Tällöin voidaan laskea vedonlyöntisuhde

P(A+|B) / P(A-|B) = P(B|A+)P(A+)/P(B) / (P(B|A-)P(A-)/P(B))
O(A|B) = P(B|A+)/P(B|A-) O(A).

Yhtälössä esiintyvää termiä P(B|A+)/P(B|A-) kutsutaan myös Bayes-tekijäksi tai -faktoriksi F eli

O(A|B) = F(B) O(A).

Merkintänä F(B) tarkoittaa yleensä, että on havaittu B. Kuitenkin ennen havaintoa meillä on kaksi vaihtoehtoa, B+ todennäköisyydellä P(B+) ja B- todennäköisyydellä P(B-) = 1-P(B+). Ensimmäisessä tapauksessa Bayes-tekijä on F(B+), mutta jälkimmäisessä tapauksessa F(B-) riippuu ehdollisen todennäköisyystaulun sisällöstä. Tämän kuvauksessa käytetään kahta parametria: todennäköisyys että B on totta eli P(B+) (B:n totuusarvo) ja F(B+) eli P(B+|A+)/P(B+|A-) (relevanssi). Näistä lasketaan odotusarvo. Täydellisempi kuvaus sisältäisi kaikki mahdolliset kombinaatiot todennäköisyyksineen eli koko Bayes-verkon (BBN) yhteisjakauman. Se on kuitenkin myöhempien laskentojen asia.

Spesifisyys (sp) on testin (B) tarkkuus eli kuinka vähän tulee vääriä positiivisia: sp = 1-P(B+|A-) = 1 - b/(b+d)

Sensitiivisyys (se) on testin herkkyys eli kuinka vähän tulee vääriä negatiivisia: se = P(B+|A+) = a/(a+c)

Bayes-tekijä F(B+) = se / (1 - sp) eli sensitiivisyys se = 1 - sp/F(B+). Eli mitä suuremmat sensitiivisyys ja spesifisyys, sitä suurempi F. Jos sensitiivisyys oletetaan vakioksi kaikissa argumenteissa, voidaan laskea kaikki tarpeelliset tiedot mukaan lukien F(B-), kun tiedetään argumentin P(B+) ja F(B+).

F(B-) = (1 - se) / sp

Esimerkkinä laskennasta on oheinen taulukko.

	A+	A-	Sum
B+	0.29 (a)	0.60 (b)	0.89
B-	0.01 (c)	0.10 (d)	0.11
Sum	0.30	0.70	1.00

F(B+) = P(B+|A+)/P(B+|A-) = 0.29/(0.29+0.01) / (0.6/(0.6+0.10)) = 0.29 * 0.70 / (0.30 * 0.60) = 203/180 ≈ 1.12778

F(B-) = P(B-|A+)/P(B-|A-) = 0.01/(0.29+0.01) / (0.10/(0.6+0.10)) = 0.01 * 0.70 / (0.30 * 0.10) = 7/30 ≈ 0.2333

se = 0.29/0.30 = 29/30

sp = 0.10/0.70 = 1/7

F(B-) = (1-se) / (1-sp/F(B+)) = (1-29/30) / (1-29/30/(203/180)) = (1/30) / (1-174/203) = 203/(29*30) = 7/30 ≈ 0.2333

Argumentin vaikutus keskusteluun lasketaan seuraavasti:

Argumenttien sensitiivisyys (vakio) se = 0.7
Argumenttien totuuden prioritodennäköisyys P(A) = 0.5
Argumentin relevanssin eli Bayes-tekijän "priori" F(B+) = 1.1
Argumentin alavirtaan kohdistama relevanssikerroin R(C) = 3/2 (puolustus), 2/3 (hyökkäys)
Argumentin totuuden posterioritodennäköisyys ylävirran totuusarvoon liittyvän argumentin B jälkeen: P(A|B) = P(A|B+)P(B+) + P(A|B-)P(B-), jossa
- P(A|B+) = O(A|B+)/(O(A|B+)+1), jossa O(A|B+) = O(A) F(B+)
- P(A|B-) = O(A|B-)/(O(A|B-)+1), jossa O(A|B-) = O(A) F(B-)
  - F(B-) = (1-se)/(1-se/F(B+))
Argumentin relevanssin eli Bayes-tekijän "posteriori" F(B|C_r) = F(B) Π R(C_r), jossa C_r ovat ne ylävirran argumentit, jotka ovat relevanssityyppiä. Huom: vaikka tämä on matemaattisesti konsistentti rakenne, R(C):n määritelmä on epäselvä ja siksi sen arvon määräytyminen on pelkkää heuristiikkaa. Se kuitenkin mahdollistaa kokonaisen keskustelun automaattisen päivittämisen.

Siksipä voisi yrittää kuvausta, joka ei perustu F(B+)-tekijään vaan sensitiivisyyteen ja spesifisyyteen.

Jos tiedetään se, sp ja P(A+), voidaan laskea kaikki muut tekijät:

P(A+) = p = a+c
se = a/(a+c) = a/p
sp = d/(b+d) = d/(1-a-c) = d/(1-p)
d = sp (1-p)
b = 1-a-c-d = 1-d-p
a = se p
c = p-a

Jos argumenttia A vastaan hyökätään totuusargumentilla B, se pienentää P(A+|B+) mutta P(A+|B-) ei muutu. Eli tarvitaan totuustekijä t*, joka muuttaa tietoja seuraavasti (pilkku tarkoittaa päivitetty arvoa):

a' = a+t*
b' = b-t*
se' = (a+t*)/(a+t*+c)
sp' = d/(b-t*+d)
P(A+)' = a+t+c

Tällöin t*>0 jos argumentti on puolustus ja muutoin se on hyökkäys. Kaavoista saa myös matemaattiset rajat: t*<1-a, t*<b, t*>b-1, t*>-a eli min(a,1-b) < t* < min(1-a,b). On syytä huomata, että t* vaikuttaa jonkin verran myös F(B+)-arvoon, eli se ei ole puhtaasti totuusparametri. Vaikutus on kuitenkin sen verran pieni, että sitä nimitetään sellaiseksi.

Jos argumenttia B vastaan hyökätään relevanssiargumentilla C, se ei vaikuta P(B+):hen mutta pienentää B:n vaikutusta A:han eli tuo F(B+) kohti ykköstä. Tarvitaan relevanssitekijä r* (negatiivinen arvo on hyökkäys, positiivinen on puolustus), joka muuttaa tietoja seuraavasti:

a' = a+r*
b' = b-r*
c' = c-r*
d' = d+r*
P(B+)' = P(B+)
se' = (a+r*)/(a+c)
sp' = (d+r*)/(b+d)
F(B+)' = se'/(1-sp') = (a+r*)/(a+c)/(1-(d+r*)/(b+d))

Tällöin r*>0 jos argumentti lisää argumentin B puolustusvoimaa ja r*<=0 jos se vähentää sitä. Tämä on hankalaa, koska vaikutus siis riippuu siitä, onko F(B+)>1 vai ei. Siksi tämä on syytä huomioida parametrisoinnissa. Matemaattiset rajat ovat r*<min(1-a, b, c, 1-d) ja r*>max(-a, b-1, c-1, -d).

Parametrisoidaan tämä niin, että t* ja r* lasketaan parametreista t ja r, jotka voivat saada arvoja ]-1 .. 1[, jolloin

t* = t min(a, 1-b), jos t<0
t* = t min(1-a, b), jos t>=0
r* = -abs(r) min(a, 1-b, 1-c, d), jos F(B+)<1 ja r>=0 tai F(B+)>=1 ja r<0
r* = abs(r) min(1-a, b, c, 1-d), jos F(B+)>=1 ja r>=0 tai F(B+)<1 ja r<0.

Jos unohdetaan t* ja r* ja keskitytään nelikentän muodostamiseen. Mitä tietoja tarvitaan, jotta se saadaan yksikäsitteisesti muodostettua?

Jos tiedetään poikkisummat A+ ja B+, saadaan laskettua myös A- = 1-A+ ja B- = 1-B+. Tällöin A+ = a+c, B+ = a+b, 1-A+ = b+d ja 1-B+ = c+d, mutta lisäksi on tiedettävä vielä kolmas asia eli a, b, c tai d, jotta saadaan yksikäsitteinen nelikenttä.
Voisivatko ne kolme asiaa olla A+, B+ ja F(B+)? Tai entä se?

A+ = a+c
B+ = a+b
F(B+) = a/(a+c)/(b/(b+d)) = (A+-c)/(A+)/(B+-(A+-c))/(1-A+)) = (A+-c-A+^2+cA+)/(A+B+-A+^2-cA+) ⇤--arg3163: . Vaikeaa. --Jouni Tuomisto (keskustelu) 26. heinäkuuta 2021 kello 21.04 (UTC) (type: ; paradigms: science: attack)
se = a/(a+c) <=> a = se(A+), joten b = B+ -se(A+), c = A+-se(A+), d=1-A+-B+ +se(A+) ←--arg5025: . Tämä toimii. --Jouni Tuomisto (keskustelu) 26. heinäkuuta 2021 kello 21.04 (UTC) (type: ; paradigms: science: defense)

Koska P(A+|B+) saadaan laskettua a/(a+b), matemaattinen määrittelyjoukko on 0 < P(A+), P(B+), se, a, b < 1 eli erityisesti 0 < P(B+)-se P(A+) < 1 eli (P(B+)-1)/P(A+) < se < P(B+)/P(A+). Koska P(B+)<=1, alarajaehto ei tule koskaan vastaan vaan riittää, että se>0. Sen sijaan ylärajaehto voi hyvinkin olla <1 eli tulee joskus rajoittavaksi tekijäksi.

Argumentti on epärelevantti, jos P(A+) = P(A+|B+) = a/(a+b) = seP(A+)/P(B+) eli se = P(B+).

Jotta käyttäjän antamat parametrit olisivat aina määriteltyjä ja helppo ymmärtää, voitaisiin ottaa käyttöön seprime-parametri, joka saa arvoja välillä ]-1,1[, joka kattaa koko sensitiivisyyden määrittelyjoukon ja joka saa epärelevantin argumentin kohdalla arvon 0. Niinpä

se = P(B+) + seprime(min(1,P(B+)/P(A+)) - P(B+)), jos 0 <= seprime < 1
se = P(B+) + seprimeP(B+), jos -1 < seprime < 0.

+ Näytä koodi - Piilota koodi

# This code is Op_fi5925/koronakide on page [[Koronavirus]]

library(OpasnetUtils)
library(gsheet)

objects.latest("Op_en3861", code_name="makeGraph") # [[Insight network]] makeGraph

if (!exists("formatted")) {
  objects.latest("Op_en3861", code_name = "formatted")
}
if (!exists("chooseGr")) {
  objects.latest("Op_en3861", code_name = "chooseGr")
}

get_probability_a_given_b <- function(
  paplus, # P(A+) prior probability for A being true
  pbplus, # P(B+) probability of argument B being true
  sp, # specificity of argument B about A
  se # sensitivity of argument B about A # fbplus # F(B+) Bayes factor for argument B when true
) {
  oaplus <- paplus/(1-paplus) # O(A) prior odds for argument A being true
  fbplus <- (sp/(1-se))
  fbminus <- (1-sp)/(1-sp/fbplus)
#  fbminus[fbminus<0] <- 50 # Error check; if it goes to negativity, it is actually large.
  oabminus <- oaplus * fbminus # O(A|B-) odds of A given that B is false
  oabplus <- oaplus * fbplus
  pabminus <- oabminus/(oabminus+1) # P(A|B-) probability of A given that B is false
  pabplus <- oabplus/(oabplus+1)
  pab <- c(pabplus*pbplus, pabminus*(1-pbplus)) # P(A|B) probability of A given B
  print(signif(c(paplus, pbplus,sp, fbplus, fbminus,pabplus,pab,sum(pab)),3))
  return(c(sum(pab)))
}

# Prior odds and probability values
TRUTHLIKENESS_PRIOR_PA <- 0.7
RELEVANCE_PRIOR_FBPLUS <- 3
SPECIFICITY_PRIOR_SP <- 0.9
SENSITIVITY_PRIOR_SE <- 0.8
RELEVANCE_FACTOR_DEFENSE_RC <- 5
RELEVANCE_FACTOR_R <- 0.7
TRUTH_FACTOR_T <- 0.7
TRUTH_LIMIT <- 0.05
RELEVANCE_LIMIT <- 0.05

se <- SENSITIVITY_PRIOR_SE
sp <- SPECIFICITY_PRIOR_SP
paplus <- TRUTHLIKENESS_PRIOR_PA
colour <- "PRO"

update_relevance <- function(
  param_vector, # vector of three numeric values: P(A+), se, sp
  r_ # relevance change parameter: ]-1,1[: 
) {
  paplus <- param_vector[1]
  se <- param_vector[2]
  sp <- param_vector[3]
  fbplus <- se/(1-sp)
  d <- sp * (1-paplus)
  b <- 1-d-paplus
  a <- se * paplus
  c <- paplus-a
  rstar <- r_ * ifelse(
    fbplus>=1 & r_>=0 | fbplus<1 & r<0,
    min(1-a, b, c, 1-d), -1*min(a, 1-b, 1-c, d))
  seprime <- (a+rstar)/(paplus)
  spprime <- (d+rstar)/(b+d)
  paplusprime <- a/(a+b)
  return(c(paplus = paplusprime, se = seprime, sp = spprime))
}
# P(A|B) = P(B|A)P(A)/P(B) = (a/(a+c))*(a+c)/(a+b) = a/(a+b)

#update_relevance(c())
update_node <- function(
  paplus, # P(A+)
  pbplus, # P(B+)
  seprime # parameter for producing se
) {
  if(any(paplus>=1) | any(paplus<=0)) stop("probability P(A+) must be between ]0,1[, not ",paplus)
  if(any(pbplus>=1) | any(pbplus<=0)) stop("probability P(B+) must be between ]0,1[, not", pbplus)
  if(any(seprime <= -1) | any(seprime >=1)) stop("seprime must be between ]-1,1[, not", seprime)
  if(seprime>=0) {
    se <- pbplus + seprime * (pmin(1,pbplus/paplus) - pbplus)
  } else {
    se <- pbplus + seprime * pbplus
  }
  a <- se* paplus
  b <- pbplus -se*paplus
  c <- paplus -se*paplus
  d <- 1-paplus-pbplus+se*paplus
  sp <- d/(b+d)
  pab <- a/(a+b)
  fb <- se/(1-sp)
  papost <- a/(a+b)*pbplus + c/(c+d)*(1-pbplus)
  return(c(pab,se,papost))#, a, b, c, d, sum(a, b, c, d), se, sp, fb))
#  return(c(paplus = paplusprime, pbplus = pbplusprime, se = seprime))
}

ps <- c(0.001, 0.01, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 0.99, 0.999)
out <- data.frame()
for(i in ps) {
  for(j in ps) {
    for(k in c(rev(-ps), 0, ps)) {
      tmp <- update_node(i,j,k)
      out <- rbind(out, data.frame(
        pa=i,
        pb=j,
        seprime=k,
        se=tmp[2],
        pab=tmp[1],
        papost=tmp[3],
        lower=(j-1)/i,
        upper=j/i
        ))
    }
  }
}
args_by_level <- df$Item[order(-df$level)]
for(arg in args_by_level) {
  parents <- df$Item[df$Object==arg]
  for(parent in parents) {
    if(df$class[df$Item==parent]=="truth") {
      t_ <- ifelse(df$colour[df$Item==parent]=="PRO",TRUTH_FACTOR_T, -TRUTH_FACTOR_T)
      out <- update_truth(param_vector = c(
        df$truth_prior[df$Item==arg],
        df$sensitivity[df$Item==arg],
        df$specificity[df$Item==arg]),
        t_
      )
      df$truth_prior[df$Item==arg] <- out[1]
      df$sensitivity[df$Item==arg] <- out[2]
      df$specificity[df$Item==arg] <- out[3]
    }
    if(df$class[df$Item==parent]=="relevance") {
      r_ <- ifelse(df$colour[df$Item==parent]=="PRO",RELEVANCE_FACTOR_R, -RELEVANCE_FACTOR_R)
      out <- update_relevance(param_vector = c(
        df$truth_prior[df$Item==arg],
        df$sensitivity[df$Item==arg],
        df$specificity[df$Item==arg]),
        r_)
      df$truth_prior[df$Item==arg] <- out[1]
      df$sensitivity[df$Item==arg] <- out[2]
      df$specificity[df$Item==arg] <- out[3]
    }
  }
}

get_probability_a_given_b(0.8,0.99,0.99,1/10)

df <- gsheet2tbl("https://docs.google.com/spreadsheets/d/1Wzj_VqubkV6uomQS-St5UxzS5k25dDBs15DQFEsroOg/edit#gid=0")

df$Item <- gsub("\\.$", "", df$position)
#df <- df[1:133,] #-c(2,4,5,7,8)]

df$Object <- gsub("\\.[0-9]$","", df$Item)
df$truth_prior <- df$truth_post <- TRUTHLIKENESS_PRIOR_PA
df$relev_prior <- RELEVANCE_PRIOR_FBPLUS
df$specificity <- ifelse(df$colour=="PRO", SPECIFICITY_PRIOR_SP, 1-SPECIFICITY_PRIOR_SP)
df$sensitivity <- ifelse(df$colour=="PRO", SENSITIVITY_PRIOR_SE, 1-SENSITIVITY_PRIOR_SE)
#df$relevance_factor <- ifelse(
#  df$class!="relevance", NA,
#  ifelse(df$colour=="PRO", RELEVANCE_FACTOR_DEFENSE_RC, 0.1/RELEVANCE_FACTOR_DEFENSE_RC))
df$level <- nchar(gsub("[0-9]","", df$Item))
df$fbplus <- RELEVANCE_PRIOR_FBPLUS
#df <- df[df$level<4,]

args_by_level <- df$Item[order(-df$level)]
for(arg in args_by_level) {
  # Relevance factors of parents R(C_r)
  rcr <- prod(df$relevance_factor[df$Object==arg & df$class=="relevance"])
  rcr <- 1 + df$relev_prior[df$Item==arg] * rcr
  if(df$colour[df$Item==arg]=="CON") rcr <- 0.1/rcr
  df$fbplus[df$Item==arg] <- rcr
  parents <- df$Item[df$Object==arg & df$class=="truth"]
  for(parent in parents) {
    print(c(arg, parent))
    df$truth_post[df$Item==arg] <- get_probability_a_given_b(
      paplus = df$truth_prior[df$Item==arg],
      pbplus = df$truth_post[df$Item==parent],
      sp = df$specificity[df$Item==parent],
      fbplus = df$fbplus[df$Item==parent]
    )
  }
}

prepare_graph <- function(df=df) {
  df$edge.penwidth <- abs(log(df$fbplus))*5
#  df$node.width <- df$truth_post*0.7
  df$node.fontsize <- df$truth_post*15
  df$node.color <- ifelse(df$class=="truth","red","blue")
  df$Context <- "Koronakide"
  df$label <- substr(df$text, 1,30)
  df$rel <- ifelse(toupper(df$colour)=="PRO","relevant defense","relevant attack")
  df$rel <- paste0(ifelse(abs(log(df$fbplus)) < RELEVANCE_LIMIT, "ir", ""), df$rel)
  df$type <- "argument"
  df$type <- ifelse(df$class %in% c("value","fact"), paste(df$class,"opening statement"), df$type)
  df$Description <- df$text
  drop <- df$Item[(df$truth_post<TRUTH_LIMIT | abs(log(df$fbplus))<RELEVANCE_LIMIT) & df$level>0]
  out <- character()
  for(i in na.omit(drop)) {
    if(length(grep(i, drop))==1) out <- c(out, i)
  }
  drop <- out
  df$node.fillcolor <- "white"
  for(i in drop) {
    df$node.fillcolor = ifelse(grepl(paste0("^",i), df$Item), "gray", df$node.fillcolor)
  }
  df <- df[df$node.fillcolor!="gray" | df$Item %in% drop ,]
  return(df)
}

gr <- makeGraph(ova=prepare_graph(df=df), formatted=formatted)
render_graph(gr, title="Kialo-keskustelu koronarokotteiden pakollisuudesta")
export_graph(gr, "~/home/jouni/Documents/Koronakide.svg")

Hae kirjanmerkit Firefoxista