Ero sivun ”Koronavirus” versioiden välillä

Opasnet Suomista
Siirry navigaatioon Siirry hakuun
Rivi 124: Rivi 124:
library(OpasnetUtils)
library(OpasnetUtils)
library(gsheet)
library(gsheet)
library(tidyverse)


objects.latest("Op_en3861", code_name="makeGraph") # [[Insight network]] makeGraph
objects.latest("Op_en3861", code_name="makeGraph2") # [[Insight network]] makeGraph
objects.latest("Op_en2382", code_name="update") # [[Discussion]] update_truth, update_relevance, infer_tree


if (!exists("formatted")) {
prepare_graph <- function(
  objects.latest("Op_en3861", code_name = "formatted")
   df = df,
}
   drop_gray = TRUE, # Drop gray branches?
if (!exists("chooseGr")) {
   drop_higher_levels = 0, # Drop higher levels (0: drop nothing)?
  objects.latest("Op_en3861", code_name = "chooseGr")
   RELEVANCE_LIMIT = 0.2,
}
   TRUTH_LIMIT = 0.05,
 
   verbose=FALSE
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.2
SENSITIVITY_PRIME <- 0.3
 
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_truth <- 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_truth(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
        ))
    }
  }
}
update_relevance <- function(
  pcplus, # P(C+)
#  colour, # df$colour of argument C, either PRO or CON
  seprimeb, # relevance parameter prior for argument B, ]-1,1[
  seprimec # relevance parameter for argument C, ]-1,1[
) {
  seprimeb_sign <- sign(seprimeb)
  out <- abs(seprimeb)
  if(seprimec>=0) {
    out <- out + seprimec*pcplus*(1-out)
  } else {
    out <- out - seprimec*pcplus*out
  }
  out <- out * seprimeb_sign
  return(out)
}
df$seprime <- SENSITIVITY_PRIME * ifelse(df$colour=="PRO",1,-1)
df$truth_prior <- TRUTHLIKENESS_PRIOR_PA
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)
      df$truth_prior[df$Item==arg] <- update_truth(
        df$truth_prior[df$Item==arg],
        df$truth_prior[df$Item==parent],
        df$seprime[df$Item==arg]
#        df$specificity[df$Item==arg]
#        t_
      )[1]
#      df$truth_prior[df$Item==arg] <- out[1]
#      df$seprime[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)
      df$seprime[df$Item==arg] <- update_relevance(
        df$truth_prior[df$Item==parent],
        df$seprime[df$Item==arg],
        df$seprime[df$Item==parent]
      )
#        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(df$seprime*15)
   df$edge.penwidth <- abs(df$seprime*15)
   df$node.width <- df$truth_prior
   df$node.width <- df$truth
   df$node.fontsize <- df$truth_prior*15
   df$node.fontsize <- df$truth*15
   df$node.color <- ifelse(df$class=="truth","orange","blue")
   df$node.color <- ifelse(df$class=="truth","orange","blue")
   df$Context <- "Koronakide"
   df$Context <- "Koronakide"
Rivi 339: Rivi 148:
   df$type <- ifelse(df$class %in% c("value","fact"), paste(df$class,"opening statement"), df$type)
   df$type <- ifelse(df$class %in% c("value","fact"), paste(df$class,"opening statement"), df$type)
   df$Description <- df$text
   df$Description <- df$text
   drop <- df$Item[(df$truth_prior<TRUTH_LIMIT | abs(df$seprime)<RELEVANCE_LIMIT) & df$level>0]
   drop <- df$Item[(df$truth<TRUTH_LIMIT | abs(df$seprime)<RELEVANCE_LIMIT) & df$level>0]
   print(drop)
   if(verbose) print(drop)
   out <- character()
   out <- character()
   tmp <- drop
   tmp <- drop
Rivi 346: Rivi 155:
     branch <- tmp[grep(paste0("^",i), tmp)]
     branch <- tmp[grep(paste0("^",i), tmp)]
     if(length(branch)>0) {
     if(length(branch)>0) {
       print(branch)
       if(verbose) print(branch)
       out <- c(out, branch[1])
       out <- c(out, branch[1])
       tmp <- tmp[!tmp %in% branch[-1]]
       tmp <- tmp[!tmp %in% branch[-1]]
Rivi 352: Rivi 161:
   }
   }
   drop <- out
   drop <- out
   print(drop)
   if(verbose) print(drop)
   df$node.fillcolor <- "white"
   df$node.fillcolor <- "white"
   for(i in drop) {
   for(i in drop) {
     df$node.fillcolor = ifelse(grepl(paste0("^",i), df$Item), "gray", df$node.fillcolor)
     df$node.fillcolor = ifelse(grepl(paste0("^",i), df$Item), "gray", df$node.fillcolor)
   }
   }
   df <- df[df$node.fillcolor!="gray" | df$Item %in% drop ,]
   if(drop_gray) df <- df[df$node.fillcolor!="gray" | df$Item %in% drop ,]
  if(drop_higher_levels>0) df <- df[df$level<drop_higher_levels,]
   return(df)
   return(df)
}
}


gr <- makeGraph(ova=prepare_graph(df=df), formatted=formatted)
preprocess_arguments <- function(FILE_PATH, file_list, n) {
render_graph(gr, title="Kialo-keskustelu koronarokotteiden pakollisuudesta")
  dfl <- read_lines(paste0(FILE_PATH,file_list[n]))
export_graph(gr, "~/home/jouni/Documents/Koronakide.svg")
  df_title <- gsub("Discussion Title: ", "", dfl[1])
  dfl <- dfl[-(1:2)]
  df <- data.frame(level = regexpr("\\. ",dfl))
  df$Item = substr(dfl,1,df$level-1)
  df$colour = toupper(substr(dfl,df$level+2,df$level+4))
  df$colour[1] <- "Value"
  df$text = substr(dfl,ifelse(df$level==2,4,df$level+7),999)
  df$level <- nchar(gsub("[0-9]","", df$Item))
  df$Object <- gsub("\\.[0-9]$","", df$Item)
  df$seprime <- SENSITIVITY_PRIME * ifelse(df$colour=="PRO",1,-1)
  df$truth <- ifelse(grepl("http", df$text), TRUTH_PRIOR_WITH_REFERENCE, TRUTH_PRIOR)
  if(!"class" %in% colnames(df)) df$class <- "truth"
  df$class[1] <- "fact"
 
  return(list(df_title, df))
}
 
if (!exists("formatted")) {
  objects.latest("Op_en3861", code_name = "formatted")
}
if (!exists("chooseGr")) {
  objects.latest("Op_en3861", code_name = "chooseGr")
}
 
TRUTH_PRIOR <- 0.3
TRUTH_PRIOR_WITH_REFERENCE <- 0.7
SENSITIVITY_PRIME <- 0.3
TRUTH_LIMIT <- 0.05
RELEVANCE_LIMIT <- 0.2
FILE_PATH <- "~/discussion/corona/"
 
df <- gsheet2tbl("https://docs.google.com/spreadsheets/d/1Wzj_VqubkV6uomQS-St5UxzS5k25dDBs15DQFEsroOg/edit#gid=0")
df <- read.csv(text=gsheet2text("https://docs.google.com/spreadsheets/d/1Wzj_VqubkV6uomQS-St5UxzS5k25dDBs15DQFEsroOg/edit#gid=2050636969",
                                format='csv'),skip=1)
 
file_list <- c(
"are-tracking-apps-a-legitimate-and-proportional-means-to-fight-covid-19-36145.txt"                ,
"do-people-have-a-right-to-not-wear-a-mask-in-public-spaces-during-the-covid-19-pandemic-38770.txt",
"do-we-need-a-vaccine-to-fight-the-covid-19-pandemic-38268.txt"                                    ,
"do-we-need-a-vaccine-to-fight-the-covid-19-pandemic-38268(1).txt"                                ,
"education-will-never-be-the-same-as-it-was-before-covid-19-43590.txt"                            ,
"is-covid-19-more-dangerous-than-regular-flu-viruses-34602.txt"                                    ,
"is-herd-immunity-for-covid-19-achievable-39248.txt"                                              ,
"is-it-wrong-to-have-a-lockdown-for-covid-19-36981.txt"                                            ,
"should-a-global-curfew-be-introduced-to-stop-covid-19-34523.txt"                                  ,
"should-countries-have-closed-their-borders-to-china-to-reduce-the-spread-of-covid-19-33660.txt"  ,
"should-covid-19-vaccines-be-mandatory-39517.txt"                                                  ,
"should-schools-close-during-the-covid-19-pandemic-44845.txt"                                      ,
"should-vaccine-passports-be-mandatory-49452.txt"                                                  ,
"will-covid19-bring-lasting-environmental-changes-34939.txt"                                      ,
"will-the-covid-19-pandemic-have-a-lasting-impact-on-society-34267.txt"       
)
 
df <- preprocess_arguments(FILE_PATH = FILE_PATH, file_list = file_list, n=8)
gr <- makeGraph(
  ova=prepare_graph(
    df=infer_tree(df[[2]], SENSITIVITY_PRIME, TRUTH_PRIOR),
    drop_gray = TRUE, drop_higher_levels = 3, TRUTH_LIMIT = 0.1, RELEVANCE_LIMIT = 0.2, verbose=FALSE),
  formatted=formatted)
render_graph(gr, title=df[[1]])
#export_graph(gr, "~/home/jouni/Documents/Koronakide.svg")
 
out <- prepare_graph(
  df=infer_tree(df[[2]], SENSITIVITY_PRIME, TRUTH_PRIOR),
  drop_gray = TRUE, drop_higher_levels = 3, TRUTH_LIMIT = 0.1, RELEVANCE_LIMIT = 0.2, verbose=FALSE)
 
 
df_default <- infer_tree(df, SENSITIVITY_PRIME, TRUTH_PRIOR)
df_no_relevance <- infer_tree(df %>% mutate(class="truth"), SENSITIVITY_PRIME, TRUTH_PRIOR)
plot(df_default$truth, df_no_relevance$truth)
# The correlation between inference with truth/relevance classification and that without is not great.
# However, it is reasonable for very high and very low values.
# So, let's try to analyze a large amount of discussions with truth-only setting
</rcode>
</rcode>


Versio 31. heinäkuuta 2021 kello 09.09




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|Cr) = F(B) Π R(Cr), jossa Cr 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

Hae kirjanmerkit Firefoxista

+ Näytä koodi

Katso myös

Noudettu kohteesta ”https://fi.opasnet.org/index.php?title=Koronavirus&oldid=36857”