22 - Correlazione Punto-Biseriale

REM  *****  BASIC  *****

function VotoStr (value) as String
  dim intero as Integer
  dim frazione as Double
  dim intstr as String
  dim parte as String
  if (isNumeric (value) and value > 0) then
    intero=int(value)
    frazione=value-intero
    if (frazione < 0.125) then
      parte=""
    elseif (frazione < 0.375) then
      parte=" +"
    elseif (frazione < 0.625) then
      parte = ".5"
    elseif (frazione < 0.875) then
      intero=intero+1
      parte=" -"
    else
      intero=intero+1
      parte=""
    endif
    intstr = str(intero)
    VotoStr=intstr & parte
  else
    VotoStr=" "
  endif
End function

function CorrPuntoBiseriale (risp as Variant, voti as Variant) as Double
dim firstRow as integer, lastRow as integer, firstCol as integer, lastCol as integer
dim i as integer, j as integer
dim maxval as Double
dim sumitem as Double, nonsumitem as double, t as Double
dim count as integer
dim PercBuoni as Double, PercCattivi as Double, SommaBuoni as Double, SommaCattivi as Double
dim MediaBuoni as Double, MediaCattivi as Double
dim mediavoti as Double, Varianza as Double
  maxval = 1.0
  CorrPuntoBiseriale=NaN
  if not isArray(risp) then
    msgbox "Le valutazioni dell'item devono essere un range"
    exit function
  end if
  if not isArray(voti) then
    msgbox "I voti devono essere un range"
    exit function
  end if
  firstRow = LBound (risp, 1)
  lastrow = UBound (risp, 1)
  firstCol = LBound (risp, 2)
  lastCol = UBound (risp, 2)
  if firstRow <> LBound (voti, 1) or  lastrow <> UBound (voti, 1) or  firstCol <> LBound (voti, 2) or lastCol <> UBound (voti, 2) then
    msgbox "I range delle valutazioni dell'item e dei voti devono essere avere la stessa dimensione"
    exit function
  end if
  sumitem = 0.0
  nonsumitem = 0.0
  SommaBuoni = 0.0
  SommaCattivi = 0.0
  mediavoti = 0.0
  Varianza = 0.0
  count = 0

  for i = firstRow to lastRow
    for j =  firstCol to lastCol
      if not IsEmpty (risp(i,j)) and VarType (risp(i,j)) = 5 and VarType (voti(i,j)) = 5 then
        mediavoti = mediavoti + voti(i,j)
        count = count + 1
      end if
    next j
  next i
  if count = 0 then
    exit function
  end if

  mediavoti = mediavoti / count
  for i = firstRow to lastRow
    for j =  firstCol to lastCol
      if not IsEmpty (risp(i,j)) and VarType (risp(i,j)) = 5 and VarType (voti(i,j)) = 5  then
        t = (voti(i,j) - mediavoti)*(voti(i,j) - mediavoti)  rem Da erore se la cella dell'item è vuota
        sumitem = sumitem + risp(i,j)
        nonsumitem = nonsumitem + maxval - risp(i,j)
        SommaBuoni = SommaBuoni + risp(i,j) * voti(i,j)
        SommaCattivi = SommaCattivi + (maxval - risp(i,j)) * voti(i,j)
        Varianza = Varianza + t
      end if
    next j
  next i
  if maxval <> 0 and sumitem <> 0 and nonsumitem <> 0 and Varianza <> 0 then
    Varianza = Sqr(Varianza/count)
    PercBuoni = sumitem/ count / maxval
    PercCattivi = 1.0 - PercBuoni
    MediaBuoni = SommaBuoni / sumitem
    MediaCattivi = SommaCattivi / nonsumitem
    CorrPuntoBiseriale=(MediaBuoni-MediaCattivi)/Varianza*sqr(PercBuoni*PercCattivi)
  end if
end function

Sub Main

End Sub
La macro