Falldynamik Berlin Update

Seit der Einführung des “Lockdown Light” sind ein paar Tage vergangen. Zeigt sich etwas in den Zahlen für Berlin? Ich würde sagen, ja!

Abbildung 1. 7-Tages Mittelwert (Stand: 10.11.2020)

Offenbar hat der 7-Tages Mittelwert vor ein paar Tagen ein relatives Maximum erreicht und eine sehr leichte Abwärtsdendenz der neu gemeldeten Fälle ist erkennbar. Spiegelt sich dies auch in den Beschleunigungswerten?

Abbildung 2. Beschleunigung der neuen Fälle in Berlin (Stand: 10.11.2020)

Offenbar. Wir sind zwar immernoch im positiven Bereich, aber die Beschleunigung hat in den letzten Tagen deutlich abgenommen. Langfristig müsste dieser Wert weit unter die Null gedrückt werden. Eine Beschleunigung von 0 bedeutet, dass der 7-Tages Mittelwert relativ konstant bleibt. Grob über den Daumen gepeilt würde eine Beschleunigung von -30 bedeuten, dass der 7-Tages Mittelwert pro Tag um 30 Fälle sinkt. Interessant finde ich hier, dass die Zahl der Neuinfektionen in der Tat durch gemeinsame Verhaltensänderungen beeinflussbar zu sein scheint.

Ein Snapshot des Skripts zur Berechnung befindet sich nun auf GitHub. Es lässt sich relativ leicht auch auf andere Datenquellen anpassen.

Monitoring der Falldynamik in Berlin mit Open Data

Das Open Data Portal der Stadt Berlin stellt die gemeldeten Corona-Fallzahlen nach Bezirk offen zur Verfügung. Sehr gut! Um die Lage im Auge zu behalten, habe ich ein kleines Skript geschrieben um die Daten zu visualisieren und einige Statistken zu berechnen, die mich interessieren. Gerade vor dem Hintergrund der erneut getroffenen Maßnahmen finde ich es wichtig, eine Heuristik zur Hand zu haben, um zu berurteilen, inwiefern die Einschränkungen, die wir uns auferlegen, dazu beitragen, das Infektionsgeschehen in userer Stadt zu bremsen. Eigentlich war das Skript nur für meinen persönlichen Gebrauch gedacht, aber vielleicht kann noch jemand etwas damit anfangen. Vielleicht beschreibe ich einfach mal die Funktionen.

Kurz gesagt lädt das Skript die Daten von der Webseite der Lageso herunter, auf deren Basis Grafiken mit verschiedenen Informationen erstellt werden können.

plot_cumsum_raw(x)

Diese Funktion stellt einfach die kumulierten Fallzahlen dar. In nachfolgender Abbildung geschieht dies für ganz Berlin, eine Visualisierung auf Bezirksebene ist ebenfalls möglich.

Abbildung 1. Kumulierte Fallzahlen in Berlin Stand 1.11.2020
plot_new_cases(x)

Diese Funktion stellt die neu gemeldeten Fälle pro Tag dar.

Abbildung 2. Neu gemeldete Fälle pro Tag in Berlin. Stand 1.11.2020

Relativ deutlich erkennbar sind die zyklischen Schwankungen, die mit dem Meldesystem zu tun haben. Eine Technik zur Glättung solcher Kurven besteht in der Berechnung eines gleitenden Mittelwertes über ein bestimmtes Zeitfenster.

plot_x_day_mean_cases(x)

Diese Funktion berechnet x-Tages-Mittelwerte und stellt sie im zeitlichen Verlauf dar. Im Folgenden wird ein 7-Tages-Fenster verwendet, aber auch andere Intervalle sind denkbar.

Abbildung 3. 7-Tages Mittelwert der gemeldeten Fälle in Berlin. Stand: 1.11.2020

Die Abbildung entspricht derjenigen, die auch von der Berliner Senatskanzlei im Corona-Lagebericht unter dem Punkt “Zeitlicher Verlauf” zur Verfügung gestellt wird. Nebenbei bemerkt, ich finde die Seite gut gemacht und informativ. Bei einer Betrachtung am 1.11.2020 gab es in den vorhergehenden 7 Tagen im Schnitt 895 gemeldete Fälle pro Tag. Diese Zahl kann analog zur physikalischen Geschwindigkeit verstanden werden (Fälle/Tag, anstatt km/h). Interessant ist nun, wie sich die Beschleunigung der Fallzahlen beschreiben lässt. Um bei der physikalischen Analogie zu bleiben, ließe sich die Beschleunigung im diskreten Fall über eine einfache Geschwindigkeitsdifferenz berechnen. Allerdings hat ein solcherart gebildeter Index ein ähnliches Problem, wie der R-Wert: er ist relativ anfällig gegenüber Schwankungen. Daher wurde die Kurve über gefensterte Regressionen weiter geglättet.

plot_x_day_smoothed_cases(x)

Diese Funktion gibt die weiter geglätteten Fallzahlen aus. Die jeweiligen Datenpunkte sind die geschätzten Steigungskoeffizienten von Regressionen in den jeweiligen 7-Tages Intervallen.

Abbildung 4. Regressionsgeglättete, neue Fälle pro Tag (7-Tages Intervall). Stand 1.11.2020.

Hierbei muss allerdings beachtet werden, dass diese Kurve ein Fallgeschehen abbildet, dass – abhängig von gewählten Intervall – einige Tage zurückliegt.

Zur Bewertung der Beschleunigung bzw. der Bremsung des Fallgeschehens werden nun Differenzen der geglätteten, neuen Fälle pro Tag berechnet.

plot_acc(x)

Diese Funktion bildet die Beschleunigung ab.

Abbildung 5. Beschleunigung der neuen Fälle pro Tag basierend auf regressionsgeglätteten Fallzahlen in 7-Tages Intervallen

Eine Beschleunigung von 0 bedeutet, dass die Fallzahlen von Tag zu Tag linear wachsen. Eine Beschleunigung größer 0 bedeutet ein beschleunigtes Wachstum und eine Beschleunigung von kleiner 0 bedeutet ein gehemmtes Wachstum: da müssen wir hin. In dieser Abbildung finde ich interessant, dass Mitte März deutlich “auf die Bremse” getreten wurde. Zwischen Mitte April und September wurde zögerlich “Gas gegeben” und wieder gebremst, bis seit September ein deutlicher Zuwachs an Beschleunigung zu verzeichnen war, der sich natürlich in immer schneller wachsenden Fallzahlen niedergeschlagen hat. An dieser Stelle ist psychologisch interessant, dass diese Kurve in gewisser Weise auch das Resultat unseres kollektiven Verhaltens ist. Individuelles Einzelverhalten, was darauf ausgelegt ist, eine eigene Infektion und die Infektion anderer zu vermeiden, sollte in der Summe des Einzelverhaltens in einem Rückgang der Beschleunigung und einer Schrumpfung der Fallzahlen münden. Aktuell zeigt sich, dass in den letzten Tagen zumindest die Beschleunigung nicht weiter ansteigt. Wichtig ist es nun, die Kurve unter Null zu drücken. Und dazu kann jede und jeder beitragen.

Was ich damit sagen möchte ist, dass wir der Situation nicht hilflos ausgeliefert sind, sondern durch unser kollektives Verhalten einen Einfluss auf die Fallzahlen ausüben können. Das Gewinnen gegen das Virus ist ein Team-Sport. Ironischerweise heißt das in bestimmten Fällen auch einfach gemeinsam Abstand halten.

Laurie Spiegel’s Algorithm

In her article Sonic Set Theory: A Tonal Music Theory for Computers, Laurie Spiegel described a little algorithm, a chord sequence generator, to demonstrate principles of algorithmic composition. Curious of if it could be done in R and how it would sound I wrote a simple sine- and envelope generator and implemented the algorithm in R. Here it is:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
library("audio")
 
# gen_sin(): generate sine signal
#
# sample rate=44100 Hz
# f:    frquency in Hz
# ms:   duration in milliseconds
gen_sin<-function(f, ms)
{
  x<-NULL
  k=44100/(2*pi*f)
  x<-sin(0:(44100*(ms/1000))/k)
  return(x)
}
 
# Check
gen_sin(440,10)
 
# envelope(): generate simple linear AD envelope
#
# x:            signal returned by gen_sin
# attack_ms:    attack time in milliseconds
# decay:        decay time in milliseconds
# max_vol:      maximum volume should not exceed 1 
#               to avoid clipping
envelope<-function(x, attack_ms, decay_ms, max_vol)
{
  length=length(x)
 
  attack_start=1
  attack_end=44100*(attack_ms/1000)
  attack_slope=max_vol/(attack_end-attack_start)
 
  decay_end=length(x)
  decay_start=decay_end-44100*(decay_ms/1000)
  decay_slope=max_vol/(decay_end-decay_start)
 
  env<-rep(max_vol, length)
 
  volume_attack=0
  for(i in attack_start:attack_end)
  { 
    env[i]=volume_attack
    volume_attack=volume_attack+attack_slope
  }
  volume_decay=max_vol
  for(i in (decay_start):decay_end)
  {
    env[i]=volume_decay
    volume_decay=volume_decay-decay_slope
  }
  return(env)  
}
 
# Checks
x<-gen_sin(440,100)
length(x)
plot(x)
env<-envelope(x,50,50,0.5)
length(env)
plot(env)
 
# gen note(): generate note
#
# f:          frequency in Hertz
# ms:         duration in milliseconds
# attack_ms:    attack time in milliseconds
# decay:        decay time in milliseconds
# max_vol:      maximum volume should not exceed 1 
#               to avoid clipping
gen_note<-function(f, ms, attack_ms, decay_ms, max_vol)
{
  x<-gen_sin(f,ms)
  env<-envelope(x,attack_ms, decay_ms, max_vol)
  env_signal<-x*env
  return(env_signal)
}
 
x<-gen_note(440,1000,100,500,1)
play(x)
plot(x)
 
# gen_triad(): generate frequencies of a triad
# note:        base note of triad
# freq_scale:  scale frequencies
gen_triad<-function(note, freq_scale)
{
  chord<-NULL
  for(i in 1:3)
  {
    index=((note-1)%%16)+1 # R starts counting with 1
    note=note+2
    chord<-c(chord, gen_note(freq_scale[index], 400,40,200,0.8))
  }
    return(chord)
}
 
# Frequencies of the C major scale
freq_scale<-c(261.63, 293.66,  # C4 D4 
              329.63, 349.23,  # E4 F4
              392.00, 440.00,  # G4 A4
              493.88, 523.25,  # B4 C5
              587.33, 659.25,  # D5 E5
              698.46, 783.99)  # F5 G5  
 
# Check
plot(freq_scale)
# Play C Major chord
x<-gen_triad(1, freq_scale)
play(x)
 
### Generate piece ###
# Source of the alogrithm:
# Spiegel, L. (1982). Sonic Set Theory: A Tonal Music Theory for Computers. 
# In Proceedings of the Second Annual Symposium on Small Computers and the Arts.
#     
stages<-matrix(c(0, 0, 1, 0, 0, 0, 0,
                 0.5, 0, 0, 0, 0, 0.5, 0,
                 0, 0.5, 0, 0.5, 0, 0, 0,
                 0, 0, 0, 0, 0.5, 0, 0.5,
                 0.5, 0, 0, 0, 0, 0.5, 0), byrow=TRUE, ncol=7)
 
# Base notes of chords
base_notes<-rep(1:7) 
 
piece<-NULL
cycles=0
start=1
max_cycles=4
 
while(cycles<max_cycles)
{
  for(i in start:5)
  {
    index<-sample(base_notes,1, p=stages[i,])    
    piece<-c(piece, gen_triad(index, freq_scale))
    cat(index)
  }
  start=sample(2:5,1)
  cycles=cycles+1
}
 
play(piece)

Hope I got it right. Read the article, play around with the probabilities and have fun! You do not have to use C major of course. Oh, and be careful with your speakers.

ProTrackR

While exploring a bit if R could be used for algorithmic composition I stumbled over the R ProTrackR package.

Check out this funky tune:

1
2
3
require("ProTrackR")
x<-read.module("https://api.modarchive.org/downloads.php?moduleid=40475#ELYSIUM.MOD")
playMod(x)

By the way, algorithmic composition in R? I think so, thanks to the R audio package.