COVID-19 Number of Tests in Italy

Table of Contents

Menu

Introduction

This page presents some data about the number of tests and people tested for COVID-19 over time in Italy and compares them with the number of people found positive.

This page was created on <2020-08-20 Thu> and last updated on <2021-07-17 Sat>.

The source code available on the COVID-19 pages is distributed under the MIT License; the content is distributed under a Creative Commons - Attribution 4.0.

Getting data into R

We first read the data from the Civil Protection repository adding the ratio between positives and tests, computed on the same day and computed with data shifted by two days (on the assumption tests take two days to complete).

In fact data about tests is used with different semantics by different regions. Some regions reports tests with results (and the ratio new positives / tests makes sense). Other reports the number of test performed, in which case the correct ratio is between positives and tests performed some days earlier. We assume two days and report both ratios for all regions. See the following issue on GitHub for an explanation and some more details https://github.com/pcm-dpc/COVID-19/issues/577 (in Italian).

PATH="./data"
DIGITS = 4

national = read.csv(file.path(PATH, "dpc-covid19-ita-andamento-nazionale.csv"))
national$data <- as.Date(national$data)

national$nuovi_casi_testati = c(NA, diff(national$casi_testati, 1))
national$p_over_t <- round(national$nuovi_positivi / national$nuovi_casi_testati, digits = DIGITS) * 100

national$nuovi_tamponi = c(NA, diff(national$tamponi, 1))
national$p_tamponi_over_t <- round(national$nuovi_positivi / national$nuovi_tamponi, digits = DIGITS) * 100

# national$nuovi_casi_testati_2 <- c(NA, NA, head(national$nuovi_casi_testati, -2))
# national$p_over_t_2 = round(national$nuovi_positivi / national$nuovi_casi_testati_2, digits = DIGITS) * 100

# national$nuovi_tamponi_2 <- c(NA, NA, head(national$tamponi_2, -2))
# national$p_tamponi_over_t_2 = round(national$nuovi_positivi / national$nuovi_tamponi_2, digits = DIGITS) * 100

Concerning the regional level, computed columns, such as the number of people tested in a day, have to be computed after filtering, or the diif will work on values from different regions.

# evolution over time, by Region
data = read.csv(file.path(PATH, "dpc-covid19-ita-regioni.csv"))
data$data <- as.Date(data$data)

These are the columns we are interested in and their translation in English:

cols = c(
  "data",
  "nuovi_positivi",
  "nuovi_tamponi",
  "nuovi_casi_testati",
  "p_tamponi_over_t",
  "p_over_t"
)

We now define a function to ouput the last N rows of the input data frame. The real “challenge”, here, is transposing the data, to get a more natural presentation (with time progressing from left to right).

table_data <- function(df, cols, rows = 10) {
  # get the last 10 elements and the interesting columns of the dataframe
  f  <- tail(df, rows)
  rf <- f[, cols]

  # the labels in the transposed matrix are the column names of the original data.frame
  row_labels  <- colnames(rf)
  # the columns in the trasposed matrix are the dates
  col_labels  <- c("Label", format(rf$data, "%a, %b %d"))

  rft <- data.frame(row_labels, t(rf))
  colnames(rft) <- col_labels
  return(rft[-1,])
}

People Tested and Cases in Italy

Data of the last ten days

table_data(national, cols)
Label Thu, Jul 08 Fri, Jul 09 Sat, Jul 10 Sun, Jul 11 Mon, Jul 12 Tue, Jul 13 Wed, Jul 14 Thu, Jul 15 Fri, Jul 16 Sat, Jul 17
nuovi_positivi 1394 1390 1400 1391 888 1534 2153 2455 2898 3121
nuovi_tamponi 174852 196922 208419 143332 73571 192543 210599 190922 205602 244797
nuovi_casi_testati 44584 49127 47969 39267 22492 44655 49579 44491 47242 54371
p_tamponi_over_t 0.8 0.71 0.67 0.97 1.21 0.8 1.02 1.29 1.41 1.27
p_over_t 3.13 2.83 2.92 3.54 3.95 3.44 4.34 5.52 6.13 5.74

New Cases

New cases.

## add extra space to right margin of plot within frame
par(mar=c(5, 4, 4, 6) + 0.1)

## Allow a second plot on the same graph
# par(new=TRUE)
new_cases_limits = c( min(national[national$data >= "2020-08-01", c("nuovi_positivi")]), max(national[national$data >= "2020-08-01", c("nuovi_positivi")]) )

p = plot(x = national[national$data >= "2020-08-01", c("data")], 
     y = national[national$data >= "2020-08-01", c("nuovi_positivi")], 
     type="l", lwd=6, pch=21, cex=1.5, col=c("#AA0000"),
     axes=FALSE,
     ylim=new_cases_limits,
     ylab="", xlab="")
text(x = tail(national[national$data >= "2020-08-01", c("data")], 5),
     y = tail(national[national$data >= "2020-08-01", c("nuovi_positivi")], 5),
     labels = tail(national[national$data >= "2020-08-01", c("nuovi_positivi")], 5),
     pos = 1, cex = 1, col="#AA0000")
mtext("New Cases", side=4, line=4, col="#AA0000") 
axis(4, ylim=new_cases_limits, las=1)

grid(p, col = "black", lty = "dotted")

# x-axis
dates = national[national$data >= "2020-08-01", c("data")]
axis.Date(1, at=seq(min(dates), max(dates), by="week"), format="%b %d", las=2)
mtext("Day", side=1, line=2.5)

## Add Legend
legend("topleft", legend = c("Tests", "New Cases"),
       text.col = c("#3B3176", "#AA0000"), pch= c(15, 17), col=c("#3B3176", "#AA0000"))

new_cases_italia.png

New Cases Tested

plot(x = national[national$data >= "2020-08-01", c("data")], 
     y = national[national$data >= "2020-08-01", c("nuovi_casi_testati")], 
     type="l", lwd=6, pch=16, cex=2.5, col=c("#3B3176"))
text(x = tail(national[national$data >= "2020-08-01", c("data")], 1),
     y = tail(national[national$data >= "2020-08-01", c("nuovi_casi_testati")], 1),
     labels = tail(national[national$data >= "2020-08-01", c("nuovi_casi_testati")], 1),
     pos = 4, cex = 1.2, col=c("#3B3176"))
 grid(col="black")

tests_italia.png

Number of Tests and New Cases Tested

Plot new cases and tests together. (Solution taken from How can I plot with 2 different y-axes? on Stack Overflow.)

## add extra space to right margin of plot within frame
par(mar=c(5, 4, 4, 6) + 0.1)

## Plot first set of data and draw its axis
tests_limits = c( min(national[national$data >= "2020-08-01", c("nuovi_casi_testati")]), max(national[national$data >= "2020-08-01", c("nuovi_casi_testati")]) )
plot(x = national[national$data >= "2020-08-01", c("data")], 
     y = national[national$data >= "2020-08-01", c("nuovi_casi_testati")], 
     type="l", lwd=6, pch=11, cex=1.5, col=c("#3B3176"),
     axes=FALSE,
     ylim=tests_limits,
     ylab="", xlab="")
text(x = tail(national[national$data >= "2020-08-01", c("data")], 1),
     y = tail(national[national$data >= "2020-08-01", c("nuovi_casi_testati")], 1),
     labels = tail(national[national$data >= "2020-08-01", c("nuovi_casi_testati")], 1),
     pos = 4, cex = 1, col=c("#3B3176"))
mtext("Number of Tests", side=2, col="#3B3176", line=4) 
axis(2, ylim=tests_limits, col="black", las=1)  
box()

## Allow a second plot on the same graph
par(new=TRUE)
new_cases_limits = c( min(national[national$data >= "2020-08-01", c("nuovi_positivi")]), max(national[national$data >= "2020-08-01", c("nuovi_positivi")]) )

p = plot(x = national[national$data >= "2020-08-01", c("data")], 
     y = national[national$data >= "2020-08-01", c("nuovi_positivi")], 
     type="l", lwd=6, pch=21, cex=1.5, col=c("#AA0000"),
     axes=FALSE,
     ylim=new_cases_limits,
     ylab="", xlab="")
text(x = tail(national[national$data >= "2020-08-01", c("data")], 1),
     y = tail(national[national$data >= "2020-08-01", c("nuovi_positivi")], 1),
     labels = tail(national[national$data >= "2020-08-01", c("nuovi_positivi")], 1),
     pos = 4, cex = 1, col="#AA0000")
mtext("New Cases", side=4, line=4, col="#AA0000") 
axis(4, ylim=new_cases_limits, las=1)

grid(p, col = "black", lty = "dotted")

# x-axis
dates = national[national$data >= "2020-08-01", c("data")]
axis.Date(1, at=seq(min(dates), max(dates), by="week"), format="%b %d", las=2)
mtext("Day", side=1, line=2.5)

## Add Legend
legend("topleft", legend = c("Tests", "New Cases"),
       text.col = c("#3B3176", "#AA0000"), pch= c(15, 17), col=c("#3B3176", "#AA0000"))

tests_and_new_cases_italia.png

Positive/Number of Tests

Here we plot the number of positive people over tests performed. The standard measurement is the ratio between positive and tests performed (shown in blue). The way I understand it is that this number also includes tests performed on people already diagnosed and recovered.

The second graph, in red, shows the ration of positive over new people tested, that is, of all the people not yet diagnosed, how many resulted positive?

plot(national$p_over_t ~ national$data, type="o", lwd=3, pch=21, col="#ff0000", main="Positive over Tests", xlab="Date", ylab="Percentage")
text(y = tail(national, 1)$p_over_t, x = tail(national, 1)$data, lab = paste(tail(national, 1)$p_over_t, "%", sep=""), pos=4, col="#ff0000", cex=1.3)

# Second plot with Positive over tests
p = lines(national$p_tamponi_over_t ~ national$data, type="o", lwd=3, pch=21, col="#000088", xlab="Date", ylab="Percentage")
text(y = tail(national, 1)$p_tamponi_over_t, x = tail(national, 1)$data, lab = paste(tail(national, 1)$p_tamponi_over_t, "%", sep=""), pos=4, col="#000088", cex=1.3)

## Add Legend
grid(col="black")
legend("bottomleft", legend = c("Positive over new People Tested", "Positive over Tests Performed"),
       text.col = c("#ff0000", "#000088"), pch= c(15, 17), col=c("#AA0000", "#000088"))

positive_over_tests_italia.png

People Tested and Cases in Trentino

region <- subset(data, denominazione_regione == "P.A. Trento")

region$nuovi_casi_testati = c(NA, diff(region$casi_testati, 1))

region$p_over_t <- round(region$nuovi_positivi / region$nuovi_casi_testati, digits = DIGITS) * 100
region$nuovi_casi_testati_2 = c(NA, NA, diff(region$casi_testati, 2))
region$p_over_t_2 = round(region$nuovi_positivi / region$nuovi_casi_testati_2, digits = DIGITS) * 100
region$nuovi_casi_testati_2 <- c(NA, NA, head(region$nuovi_casi_testati, -2))
region$p_over_t_2 = round(region$nuovi_positivi / region$nuovi_casi_testati_2, digits = DIGITS) * 100

region$nuovi_tamponi = c(NA, diff(region$tamponi, 1))
region$p_tamponi_over_t <- round(region$nuovi_positivi / region$nuovi_tamponi, digits = DIGITS) * 100
region$nuovi_tamponi_2 <- c(NA, NA, head(region$tamponi_2, -2))
region$p_tamponi_over_t_2 = round(region$nuovi_positivi / region$nuovi_tamponi_2, digits = DIGITS) * 100

table_data(region, cols)
Label Thu, Jul 08 Fri, Jul 09 Sat, Jul 10 Sun, Jul 11 Mon, Jul 12 Tue, Jul 13 Wed, Jul 14 Thu, Jul 15 Fri, Jul 16 Sat, Jul 17
nuovi_positivi 4 3 7 6 2 10 24 23 33 26
nuovi_tamponi 1387 1433 1815 1087 300 1198 1365 1613 1496 1960
nuovi_casi_testati 555 573 726 435 120 479 546 645 598 784
p_tamponi_over_t 0.29 0.21 0.39 0.55 0.67 0.83 1.76 1.43 2.21 1.33
p_over_t 0.72 0.52 0.96 1.38 1.67 2.09 4.4 3.57 5.52 3.32

People Tested and Cases in Liguria

region <- subset(data, denominazione_regione == "Liguria")

region$nuovi_casi_testati = c(NA, diff(region$casi_testati, 1))

region$p_over_t <- round(region$nuovi_positivi / region$nuovi_casi_testati, digits = DIGITS) * 100
region$nuovi_casi_testati_2 = c(NA, NA, diff(region$casi_testati, 2))

region$nuovi_tamponi = c(NA, diff(region$tamponi, 1))
region$p_tamponi_over_t <- round(region$nuovi_positivi / region$nuovi_tamponi, digits = DIGITS) * 100

table_data(region, cols)
Label Thu, Jul 08 Fri, Jul 09 Sat, Jul 10 Sun, Jul 11 Mon, Jul 12 Tue, Jul 13 Wed, Jul 14 Thu, Jul 15 Fri, Jul 16 Sat, Jul 17
nuovi_positivi 16 17 26 26 9 25 40 31 54 55
nuovi_tamponi 5000 4620 5529 3235 2377 5643 5658 4187 5400 5873
nuovi_casi_testati 1545 1384 1999 1273 825 1581 1578 1375 1789 2221
p_tamponi_over_t 0.32 0.37 0.47 0.8 0.38 0.44 0.71 0.74 1.0 0.94
p_over_t 1.04 1.23 1.3 2.04 1.09 1.58 2.53 2.25 3.02 2.48

People Tested and Cases in Veneto

region <- subset(data, denominazione_regione == "Veneto")

region$nuovi_casi_testati = c(NA, diff(region$casi_testati, 1))
region$p_over_t <- round(region$nuovi_positivi / region$nuovi_casi_testati, digits = DIGITS) * 100

region$nuovi_tamponi = c(NA, diff(region$tamponi, 1))
region$p_tamponi_over_t <- round(region$nuovi_positivi / region$nuovi_tamponi, digits = DIGITS) * 100

table_data(region, cols)
Label Thu, Jul 08 Fri, Jul 09 Sat, Jul 10 Sun, Jul 11 Mon, Jul 12 Tue, Jul 13 Wed, Jul 14 Thu, Jul 15 Fri, Jul 16 Sat, Jul 17
nuovi_positivi 149 106 157 125 76 254 261 318 425 424
nuovi_tamponi 21060 28961 30640 21240 10446 26017 29465 27948 30079 38846
nuovi_casi_testati 5418 3374 3514 2852 1307 4176 4800 4886 4144 5359
p_tamponi_over_t 0.71 0.37 0.51 0.59 0.73 0.98 0.89 1.14 1.41 1.09
p_over_t 2.75 3.14 4.47 4.38 5.81 6.08 5.44 6.51 10.26 7.91

People Tested and Cases in Lombardia

region <- subset(data, denominazione_regione == "Lombardia")

region$nuovi_casi_testati = c(NA, diff(region$casi_testati, 1))
region$p_over_t <- round(region$nuovi_positivi / region$nuovi_casi_testati, digits = DIGITS) * 100

region$nuovi_tamponi = c(NA, diff(region$tamponi, 1))
region$p_tamponi_over_t <- round(region$nuovi_positivi / region$nuovi_tamponi, digits = DIGITS) * 100

table_data(region, cols)
Label Thu, Jul 08 Fri, Jul 09 Sat, Jul 10 Sun, Jul 11 Mon, Jul 12 Tue, Jul 13 Wed, Jul 14 Thu, Jul 15 Fri, Jul 16 Sat, Jul 17
nuovi_positivi 215 230 205 250 95 241 420 381 399 438
nuovi_tamponi 31272 32953 35138 26712 8701 29313 34930 32332 34711 38089
nuovi_casi_testati 10772 12008 10234 8386 6315 7686 8936 7908 9116 10973
p_tamponi_over_t 0.69 0.7 0.58 0.94 1.09 0.82 1.2 1.18 1.15 1.15
p_over_t 2.0 1.92 2.0 2.98 1.5 3.14 4.7 4.82 4.38 3.99