Dynamik der Covid-19-Ausbreitung
Verfasst: 22.03.2020 12:14
Dieses Programm berechnet für 185 Länder und die EU die Anzahl der akut Erkrankten, die Verdoppelungszeiten und die Anzahl der Neuerkrankten. Außerdem wird die jeweilige Prävalenz (akut Erkrankte pro 100 000 Einwohner) sowie die Inzidenz (Neuerkrankte pro 100 000 Einwohner pro Woche) berechnet. Diese relativen Zahlen sind wichtige epidemiologische Größen, die u.a. den Vergleich verschiedener Länder ermöglichen.
Auf der Basis von weniger als 20 Fällen werden keine Berechnungen vorgenommen, das Programm gibt dann "----" aus. Wo die Fallzahlen nicht mehr exponentiell steigen, gibt das Programm statt der Verdoppelungszeit "n/a" aus.
Im ersten Programmteil kann als 1. Sortierpriorität Prävalenz, Verdoppelungszeit oder Inzidenz gewählt werden.
Wenn man das freie Statistikprogramm R auf seinem PC hat und der Konstanten '#R_Script$' am Beginn des Codes den passenden absoluten oder relativen Pfad zuweist, so wird im zweiten Teil des Programms die Berechnung des Trends für das gewählte Land ggf. verbessert.
Der dritte Programmteil kann eine CSV-Datei mit dem Verlauf der Prävalenzen in ausgewählten Ländern erzeugen (s. Abb. unten, mit LibreOffice Calc erzeugt).
Bei der Interpretation von Daten zu Covid-19 sollte man immer bedenken, dass es bei allen Zahlen eine -- evtl. sehr große -- Dunkelziffer gibt. Z.B. werden längst nicht alle mit SARS-CoV-2 infizierten Personen getestet, auch gibt es im deutschen Infektionsschutzgesetz keine Meldepflicht für genesene Patienten.
Auf der Basis von weniger als 20 Fällen werden keine Berechnungen vorgenommen, das Programm gibt dann "----" aus. Wo die Fallzahlen nicht mehr exponentiell steigen, gibt das Programm statt der Verdoppelungszeit "n/a" aus.
Im ersten Programmteil kann als 1. Sortierpriorität Prävalenz, Verdoppelungszeit oder Inzidenz gewählt werden.
Wenn man das freie Statistikprogramm R auf seinem PC hat und der Konstanten '#R_Script$' am Beginn des Codes den passenden absoluten oder relativen Pfad zuweist, so wird im zweiten Teil des Programms die Berechnung des Trends für das gewählte Land ggf. verbessert.
Der dritte Programmteil kann eine CSV-Datei mit dem Verlauf der Prävalenzen in ausgewählten Ländern erzeugen (s. Abb. unten, mit LibreOffice Calc erzeugt).
Bei der Interpretation von Daten zu Covid-19 sollte man immer bedenken, dass es bei allen Zahlen eine -- evtl. sehr große -- Dunkelziffer gibt. Z.B. werden längst nicht alle mit SARS-CoV-2 infizierten Personen getestet, auch gibt es im deutschen Infektionsschutzgesetz keine Meldepflicht für genesene Patienten.
Code: Alles auswählen
; Dynamik der Covid-19-Ausbreitung, Version 1.32
; <https://www.purebasic.fr/german/viewtopic.php?f=8&t=31922>
;
; Cross-platform, getestet mit PB 5.72 LTS unter
; - Linux Mint 19.3
; - Windows 10
; - Mac OS
EnableExplicit
CompilerIf #PB_Compiler_OS = #PB_OS_Linux
#R_Script$ = "" ; Wenn R installiert ist, hier "Rscript" eintragen.
CompilerElseIf #PB_Compiler_OS = #PB_OS_Windows
#R_Script$ = "" ; z.B. "..\R\R-3.6.3\bin\Rscript.exe"
CompilerElseIf #PB_Compiler_OS = #PB_OS_MacOS
#R_Script$ = ""
CompilerEndIf
CompilerIf #PB_Compiler_Debugger = #False
CompilerError "Bitte den Debugger einschalten"
CompilerEndIf
;---------------------------------------------------------------------------------------
;- Utility functions
Macro FastMid (_string_, _start_, _length_=-1)
PeekS(@_string_ + ((_start_)-1)*SizeOf(Character), _length_)
EndMacro
Procedure.i CountStringEx (source$, stringToCount$, quoteChar$=#DQUOTE$)
; in : source$ : zu durchsuchender String;
; Fehlt ein rechtes Anführungszeichen, so wird es am Stringende angenommen.
; stringToCount$: zu zählender String
; quoteChar$ : verwendetes Anführungszeichen (1 Zeichen);
; "" um Anführungszeichen zu ignorieren
; out: Häufigkeit von 'stringToCount$' in 'source$' *außerhalb von Anführungszeichen*,
; -1 bei Fehler
Protected.i left, right, count=0
If FindString(stringToCount$, quoteChar$) > 0
ProcedureReturn -1 ; error
EndIf
left = 1
Repeat
right = FindString(source$, quoteChar$, left) ; position of left "
If right = 0 ; z.B. immer wenn quoteChar$ = #Empty$
count + CountString(FastMid(source$, left), stringToCount$)
Break
EndIf
count + CountString(FastMid(source$, left, right - left), stringToCount$)
left = FindString(source$, quoteChar$, right+1) + 1 ; position directly behind right "
Until left = 1 ; rechtes " am Stringende angenommen
ProcedureReturn count
EndProcedure
Procedure.i SplitIntoFields (source$, sep$, Array field$(1), quoteChar$=#DQUOTE$)
; -- Aufteilen eines Strings in einzelne Array-Elemente:
; - 'sep$' wird nur außerhalb von Anführungszeichen berücksichtigt
; - ist schneller als der wiederholte Aufruf von StringField()
; in : source$ : aufzuteilender String;
; Fehlt ein rechtes Anführungszeichen, so wird es am Stringende angenommen.
; sep$ : Trennstring (aus 1 oder mehreren Zeichen);
; Wenn sep$ = "", dann wird ein Array mit 1 Element zurückgegeben
; das gleich 'source$' ist (analog zu StringField(..., 1, "")).
; quoteChar$: verwendetes Anführungszeichen (1 Zeichen);
; "" um Anführungszeichen zu ignorieren
; out: field$() : Array mit allen Feldern (von evtl. vorhandene Anführungszeichen eingeschlossen)
; return value: 1 on success
; 0 on warning
; -1 on error
Protected.i lastElement, left, right, leftQuote, rightQuote, index=0, ret=1
Protected.i sourceLen = Len(source$)
Protected.i sepLen = Len(sep$)
lastElement = CountStringEx(source$, sep$, quoteChar$)
If lastElement = -1
ProcedureReturn -1 ; error
EndIf
Dim field$(lastElement)
left = 1
Repeat
right = FindString(source$, sep$, left) ; position of sep$
If right
leftQuote = FindString(source$, quoteChar$, left)
If leftQuote > 0 And leftQuote < right
rightQuote = FindString(source$, quoteChar$, leftQuote+1)
If rightQuote
right = FindString(source$, sep$, rightQuote+1)
Else
right = sourceLen + 1 ; rechtes " am Stringende angenommen
ret = 0 ; warning
EndIf
EndIf
EndIf
If right = 0
right = sourceLen + 1
EndIf
field$(index) = FastMid(source$, left, right - left)
index + 1
left = right + sepLen ; position directly behind sep$
Until left > sourceLen
ProcedureReturn ret
EndProcedure
Procedure.i Monotone (Array a.i(1), lo.i=0, hi.i=-1)
; -- Check whether all values in (a selected range of) an
; integer array are (strictly) decreasing or increasing
; in : a(): array to be checked
; lo : least index to be considered
; hi : largest index to be considered
; out: The values in the examined range are
; -2: strictly decreasing
; -1: monotonically decreasing
; 0: neither monotonically decreasing nor increasing
; 1: monotonically increasing
; 2: strictly increasing
; see <https://en.wikipedia.org/wiki/Monotonic_function>
Protected.i i, k, ret, sgn, factor=2
If hi = -1
hi = ArraySize(a())
EndIf
; -- Look for the first difference <> 0
i = lo + 1
Repeat
If i > hi
ProcedureReturn 0 ; neither decreasing nor increasing
EndIf
ret = Sign(a(i) - a(i-1))
i + 1
Until ret <> 0
If i > lo + 2
factor = 1 ; not *strictly* monotone
EndIf
; -- Check whether all other differences <> 0 have
; the same sign as the first difference <> 0
For k = i To hi
sgn = Sign(a(k) - a(k-1))
If sgn = 0
factor = 1 ; not *strictly* monotone
ElseIf sgn <> ret
ProcedureReturn 0 ; not monotone
EndIf
Next
ProcedureReturn ret * factor
EndProcedure
Procedure.d R_cor (x$, y$, *cor.Double, method$)
; -- Korrelation mit R berechnen (getestet mit R 3.6.3)
; in : x$, y$ : "parallel" lists of numeric values, separated by ',' (e.g. "1,2,3")
; method$: 'pearson', 'kendall', or 'spearman' (can be abbreviated)
; out: cor\d : Korrelationskoeffizient (aus dem Intervall [-1, 1])
; return value: p-Wert (aus dem Intervall [0, 1])
; bzw. -1, -2, -3, -4 oder -5 bei Fehler
Protected script$, result$, line$
Protected fn.i, p.i, ret.d=-1
If FindString(" pearson kendall spearman", " "+method$) = 0
ProcedureReturn -1 ; error
EndIf
If CountString(x$, ",") <> CountString(y$, ",")
ProcedureReturn -2 ; error
EndIf
script$ = GetTemporaryDirectory() + "script.r"
result$ = GetTemporaryDirectory() + "r_out.txt"
fn = CreateFile(#PB_Any, script$)
If fn = 0
ProcedureReturn -3 ; error
EndIf
WriteStringN(fn, "x <- c(" + x$ + ")")
WriteStringN(fn, "y <- c(" + y$ + ")")
WriteStringN(fn, "cor.test(x, y, method='" + method$ + "')")
CloseFile(fn)
CompilerIf #PB_Compiler_OS = #PB_OS_Linux
If RunProgram("/bin/bash", ~"-c \"" + #R_Script$ + " " + script$ + " > " + result$ + ~"\"", "", #PB_Program_Wait|#PB_Program_Hide) = #False
ProcedureReturn -4 ; error
EndIf
CompilerElseIf #PB_Compiler_OS = #PB_OS_Windows
If RunProgram(#R_Script$, script$ + " > " + result$, "", #PB_Program_Wait|#PB_Program_Hide) = #False
ProcedureReturn -4 ; error
EndIf
CompilerElseIf #PB_Compiler_OS = #PB_OS_MacOS
; not yet supported
CompilerEndIf
fn = ReadFile(#PB_Any, result$)
If fn = 0
ProcedureReturn -5 ; error
EndIf
ReadStringFormat(fn)
While Eof(fn) = #False
line$ = ReadString(fn)
p = FindString(line$, "p-value")
If p
ret = ValD(Mid(line$, p+10))
ElseIf FindString(line$, "sample estimates:") = 1
ReadString(fn)
line$ = ReadString(fn)
*cor\d = ValD(line$)
EndIf
Wend
CloseFile(fn)
ProcedureReturn ret
EndProcedure
Procedure.i R_cor_int (Array y.i(1), lo.i=0, hi.i=-1)
; -- Wrapper für die Prozedur R_cor() für Integer-Arrays
; in : y(): array to be checked
; lo : least index to be considered
; hi : largest index to be considered
; out: return value: -1: decreasing trend
; 0: steady trend
; 1: increasing trend
; -7: error
Protected x$, y$, i.i, p.d, cor.d
If hi = -1
hi = ArraySize(y())
EndIf
x$ = Str(lo)
y$ = Str(y(lo))
For i = lo+1 To hi
x$ + "," + Str(i)
y$ + "," + Str(y(i))
Next
p = R_cor(x$, y$, @cor, "spearman")
If p < 0
ProcedureReturn -7 ; error
ElseIf p > 0.05 Or cor = 0.0
ProcedureReturn 0
ElseIf cor < 0.0
ProcedureReturn -1
Else
ProcedureReturn 1
EndIf
EndProcedure
Procedure.i CalcTrend (Array a.i(1), iTarget.i, numElements.i, useR.i)
; -- Trend in den 'numElements' Elementen bis a(iTarget) berechnen
; in : a() : zu prüfendes Array
; iTarget : Array-Index des interessierenden Elements
; numElements: Anzahl zu berücksichtigender Elemente
; useR : 'Rscript' benutzen (#True/#False)
; out: return value: 0: bleibt ungefähr gleich
; 1: bleibt gleich
; -2: nimmt ab
; -4: nimmt zunehmend langsamer ab
; -6: nimmt zunehmend schneller ab
; 2: nimmt zu
; 4: nimmt zunehmend langsamer zu
; 6: nimmt zunehmend schneller zu
; -7: Fehler
Protected.i i, k, rise, ret
Protected Dim diff.i(numElements-2)
ret = Monotone(a(), iTarget-numElements+1, iTarget) ; -2, -1, 0, 1 oder 2
If ret ; (streng) monoton steigend oder fallend
If Abs(ret) = 1
ret * 2
EndIf
; prüfen, ob eine weitergehende Aussage gemacht werden kann
k = 0
For i = iTarget-numElements+2 To iTarget
diff(k) = a(i) - a(i-1)
k + 1
Next
rise = Monotone(diff()) ; -2, -1, 0, 1 oder 2
If Sign(rise) = Sign(ret)
ret * 3
ElseIf Sign(rise) = -Sign(ret)
ret * 2
ElseIf useR ; präzisere Trendberechnung
rise = R_cor_int(diff()) ; -1, 0, 1 oder -7
If rise = -7
ret = -7 ; error
ElseIf Sign(rise) = Sign(ret)
ret * 3
ElseIf Sign(rise) = -Sign(ret)
ret * 2
EndIf
EndIf
ElseIf useR ; präzisere Trendberechnung
ret = R_cor_int(a(), iTarget-numElements+1, iTarget) ; -1, 0, 1 oder -7
If ret = 0
ret = 1
Else
ret * 2
EndIf
EndIf
ProcedureReturn ret
EndProcedure
Procedure.s RAlign (s$, width.i, char$=" ")
; -- String rechts ausrichten
; in: s$ : auszurichtender String
; width: auszufüllender Platz (Anzahl Zeichen)
; char$: verwendetes Füllzeichen (nur 1 Zeichen!)
If Len(s$) >= width
ProcedureReturn s$
Else
ProcedureReturn RSet(s$, width, char$)
EndIf
EndProcedure
Macro RepeatChar (_count_, _char_=" ")
; *sehr* schnell, geht aber nur mit 1 Zeichen
; (evtl. folgende Zeichen werden ignoriert)
LSet("", _count_, _char_)
EndMacro
Macro RoundEx (_number_, _factor_, _mode_=#PB_Round_Nearest)
; in: _number_: zu rundende Zahl
; _factor_: 10 um auf 1 Nachkommastelle zu runden,
; 100 um auf 2 Nachkommastellen zu runden usw.
; _mode_ : Art der Rundung: #PB_Round_Nearest, #PB_Round_Up oder #PB_Round_Down
(Round((_number_) * (_factor_), _mode_) / (_factor_))
EndMacro
;---------------------------------------------------------------------------------------
#Auto = -1
#SecondsPerDay = 24 * 60 * 60
#DateMaskIn$ = "%mm/%dd/%yy"
#DateMaskOut$ = "%dd.%mm.%yyyy"
#None$ = " ----"
#NA$ = "n/a"
#MinCases = 20 ; Mindestanzahl von Fällen pro Land
#TrendDays = 7 ; Anzahl der Tage zur Berechnung des aktuellen Trends
#CSV_IndexCountry = 1
#CSV_IndexFirstDate = 4
; Zahlen für ein Land
Structure Record
Population.i ; Einwohnerzahl
Array Confirmed.i(0) ; bestätigte Fälle
Array Sick.i(0) ; akut Erkrankte (= bestätigte Fälle - Genesene - Verstorbene)
EndStructure
Structure CSV
Array Date.i(0) ; Datumsangaben
Map Country.Record() ; alle Länder
EndStructure
; "Arbeitsdaten" für ein Land für Procedure CurrentData() zum Sortieren
Structure Region
Name$ ; Name des Staates
ErrDate.i ; erster Tag im betrachteten Zeitraum, dessen Daten nicht konsistent sind
Sick.i ; akut Erkrankte
Td.d ; Verdoppelungszeit der Anzahl akut Erkrankter
New.i ; Neuerkrankte in der Woche bis zum jeweiligen Tag
Prevalence.d ; Prävalenz (Erkrankte pro 100 000 Einwohner)
Incidence.d ; Inzidenz (Neuerkrankte pro 100 000 Einwohner und Woche)
EndStructure
; Sortieroptionen für Procedure CurrentData()
Enumeration 1
#SortByPrevalence
#SortByDoublingTime
#SortByIncidence
EndEnumeration
Procedure.d DoublingTime (Array dates.i(1), Array cases.i(1), iFirst.i, iTarget.i)
; -- Verdoppelungszeit
; in : dates(): Array mit Datumsangaben (aufeinanderfolgende Tage)
; cases(): Array mit Fallzahlen;
; Die beiden Arrays sind "parallel".
; iFirst : Index des ersten zu berücksichtigenden Array-Elements
; iTarget: Index des interessierenden Datums
; out: return value: Zeit in Tagen, in der sich die Anzahl der Fälle verdoppelt hat
; (in Bezug auf dates(iTarget));
; 10 000 wenn keine Verdoppelung erkennbar ist
Protected.i iDate0, halfCases, halfDate, diff
halfCases = cases(iTarget) / 2
iDate0 = iTarget - 1
While iDate0 >= iFirst
diff = cases(iDate0+1) - cases(iDate0)
If diff < 0 ; Für die Berechnung der Verdoppelungszeit
Break ; müssen die Fallzahlen monoton steigen.
EndIf
If cases(iDate0) <= halfCases
If diff <> 0
; halfDate: durch lineare Interpolation zwischen zwei aufeinanderfolgenden Tagen
; geschätzter Zeitpunkt, an dem die Anzahl der Fälle = halfCases ist
halfDate = dates(iDate0) + (dates(iDate0+1)-dates(iDate0))/diff * (halfCases-cases(iDate0))
ProcedureReturn (dates(iTarget) - halfDate) / #SecondsPerDay
Else
Break
EndIf
EndIf
iDate0 - 1
Wend
ProcedureReturn 10000.0
EndProcedure
Procedure.i LastCSVdate (file$, sep$=",")
; -- return most recent date in given CSV file
; in : file$: local CSV file
; sep$ : separator between data fields
; out: return value: last date in header of the given CSV file,
; or 0 on error
Protected header$, ifn.i, lastField.i
ifn = ReadFile(#PB_Any, file$)
If ifn = 0
ProcedureReturn 0 ; error
EndIf
ReadStringFormat(ifn)
header$ = ReadString(ifn)
CloseFile(ifn)
lastField = CountString(header$, sep$) + 1
ProcedureReturn ParseDate(#DateMaskIn$, StringField(header$, lastField, sep$))
EndProcedure
;---------------------------------------------------------------------------------------
Define s_FileConfirmed$, s_FileRecovered$, s_FileDeaths$
Procedure.i GetCSVfiles (download.i)
; in : download: #True : download 3 CSV files to the same directory where the program is
; #False: use local CSV files
; #Auto : download CSV files only if local files are not up-to-date
; out: shared names of downloaded files
; return value: 0 on success / 1 or 2 on error
Shared s_FileConfirmed$, s_FileRecovered$, s_FileDeaths$
Protected urlConfirmed$, urlRecovered$, urlDeaths$
Protected.i lastDate, yesterday
; Übersicht: <https://github.com/CSSEGISandData/COVID-19>
urlConfirmed$ = "https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_confirmed_global.csv"
urlRecovered$ = "https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_recovered_global.csv"
urlDeaths$ = "https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_deaths_global.csv"
s_FileConfirmed$ = GetFilePart(GetURLPart(urlConfirmed$, #PB_URL_Path))
s_FileRecovered$ = GetFilePart(GetURLPart(urlRecovered$, #PB_URL_Path))
s_FileDeaths$ = GetFilePart(GetURLPart(urlDeaths$, #PB_URL_Path))
If download = #Auto
If FileSize(s_FileConfirmed$) = -1
download = #True
Else
lastDate = LastCSVdate(s_FileConfirmed$)
If lastDate = 0
ProcedureReturn 1 ; error
EndIf
yesterday = Int(AddDate(Date(), #PB_Date_Day, -1) / #SecondsPerDay) * #SecondsPerDay
If lastDate = yesterday
download = #False
Else
download = #True
EndIf
EndIf
EndIf
If download = #True
InitNetwork()
If ReceiveHTTPFile(urlConfirmed$, s_FileConfirmed$) = 0 Or
ReceiveHTTPFile(urlRecovered$, s_FileRecovered$) = 0 Or
ReceiveHTTPFile(urlDeaths$, s_FileDeaths$) = 0
ProcedureReturn 2 ; error
EndIf
EndIf
ProcedureReturn 0 ; success
EndProcedure
Procedure.i AddFirstCSV (file$, *covid.CSV, sep$=",")
; -- erste CSV-Datei lesen und die Fallzahlen zu
; *covid\Country()\Confirmed() sowie *covid\Country()\Sick() addieren
; in : file$: local CSV file
; sep$ : separator between data fields
; out: *covid : data from the CSV file
; return value: 0 on success / 1, 2, 3, 4 or 5 on error
Protected header$, record$, country$
Protected.i ifn, lastField, i
Protected Dim field$(0)
ifn = ReadFile(#PB_Any, file$)
If ifn = 0
ProcedureReturn 1 ; error
EndIf
ReadStringFormat(ifn)
header$ = ReadString(ifn)
If SplitIntoFields(header$, sep$, field$()) <= 0
CloseFile(ifn)
ProcedureReturn 2 ; error
EndIf
lastField = ArraySize(field$())
If lastField = 0
CloseFile(ifn)
ProcedureReturn 3 ; error
EndIf
Dim *covid\Date(lastField)
*covid\Date(#CSV_IndexFirstDate) = ParseDate(#DateMaskIn$, field$(#CSV_IndexFirstDate))
For i = #CSV_IndexFirstDate+1 To lastField
*covid\Date(i) = ParseDate(#DateMaskIn$, field$(i))
; Datumsangaben auf Plausibilität prüfen:
If *covid\Date(i-1) >= *covid\Date(i)
CloseFile(ifn)
ProcedureReturn 4 ; error
EndIf
Next
While Eof(ifn) = #False
record$ = ReadString(ifn)
If SplitIntoFields(record$, sep$, field$()) <= 0
CloseFile(ifn)
ProcedureReturn 5 ; error
EndIf
country$ = Trim(field$(#CSV_IndexCountry), #DQUOTE$)
If FindMapElement(*covid\Country(), country$) = #Null
AddMapElement(*covid\Country(), country$, #PB_Map_NoElementCheck)
Dim *covid\Country()\Confirmed(lastField)
Dim *covid\Country()\Sick(lastField)
EndIf
For i = #CSV_IndexFirstDate To lastField
*covid\Country()\Confirmed(i) + Val(field$(i))
*covid\Country()\Sick(i) = *covid\Country()\Confirmed(i)
Next
Wend
CloseFile(ifn)
ProcedureReturn 0 ; success
EndProcedure
Procedure.i SubNextCSV (file$, *covid.CSV, sep$=",")
; -- nächste CSV-Datei lesen und die Fallzahlen von *covid\Country()\Sick() subtrahieren
; in : file$ : local CSV file
; *covid: data from the CSV files
; sep$ : separator between data fields
; out: *covid : adapted data from the CSV files
; return value: 0 on success / 1, 2, 3, 4, 5 or 6 on error
Protected header$, record$, country$
Protected.i ifn, lastField, i
Protected Dim field$(0)
ifn = ReadFile(#PB_Any, file$)
If ifn = 0
ProcedureReturn 1 ; error
EndIf
ReadStringFormat(ifn)
header$ = ReadString(ifn)
If SplitIntoFields(header$, sep$, field$()) <= 0
CloseFile(ifn)
ProcedureReturn 2 ; error
EndIf
lastField = ArraySize(field$())
; prüfen, ob der Kopfdatensatz dieser CSV-Datei mit demjenigen der 1. CSV-Datei übereinstimmt
If lastField <> ArraySize(*covid\Date())
CloseFile(ifn)
ProcedureReturn 3 ; error
EndIf
For i = #CSV_IndexFirstDate To lastField
If *covid\Date(i) <> ParseDate(#DateMaskIn$, field$(i))
CloseFile(ifn)
ProcedureReturn 4 ; error
EndIf
Next
While Eof(ifn) = #False
record$ = ReadString(ifn)
If SplitIntoFields(record$, sep$, field$()) <= 0
CloseFile(ifn)
ProcedureReturn 5 ; error
EndIf
country$ = Trim(field$(#CSV_IndexCountry), #DQUOTE$)
If FindMapElement(*covid\Country(), country$) = #Null
CloseFile(ifn)
AddMapElement(*covid\Country(), country$, #PB_Map_NoElementCheck) ; nur für die Fehlermeldung
ProcedureReturn 6 ; error
EndIf
For i = #CSV_IndexFirstDate To lastField
*covid\Country()\Sick(i) - Val(field$(i))
Next
Wend
CloseFile(ifn)
ProcedureReturn 0 ; success
EndProcedure
Macro AssignPopulation (_country_, _size_)
; -- Assign population figure only if the country already exists in the map.
; in : _country_: name of country
; _size_ : size of its population
; out: *covid\Country()\Population aktualisiert
; knownCountries aktualisiert
knownCountries + 1
If FindMapElement(*covid\Country(), _country_)
*covid\Country()\Population = _size_
Else
AddMapElement(*covid\Country(), _country_, #PB_Map_NoElementCheck) ; nur für die Fehlermeldung
ProcedureReturn 1 ; error
EndIf
EndMacro
Procedure.i InitCountries (*covid.CSV)
; -- Einwohnerzahlen von 185 Staaten erfassen, auf 1 000 gerundet
; [aus der engl. Wikipedia (April/Mai 2020)
; <https://en.wikipedia.org/wiki/List_of_countries_by_population_(United_Nations)>]
; sowie die Zahlen aller 27 EU-Mitgliedsstaaten addieren, so dass
; dann die EU wie ein Staat behandelt werden kann
; in : *covid: data from the CSV files
; out: *covid : data from the CSV files, supplemented by
; population figures of all contained countries,
; and data for the EU as a whole
; return value: 0 on success / 1 on error
Protected *ptrEU.Record, msg$
Protected.i i, newCountries, knownCountries=0, lastField=ArraySize(*covid\Date())
Protected NewMap europe.i()
; -- Namen und Einwohnerzahlen aller 27 EU-Mitgliedsstaaten
; zunächst in einer Map speichern
europe("Austria") = 8955000
europe("Belgium") = 11539000
europe("Bulgaria") = 7000000
europe("Croatia") = 4130000
europe("Cyprus") = 1180000
europe("Czechia") = 10689000
europe("Denmark") = 5772000
europe("Estonia") = 1326000
europe("Finland") = 5532000
europe("France") = 65692000
europe("Germany") = 83517000
europe("Greece") = 10473000
europe("Hungary") = 9685000
europe("Ireland") = 4882000
europe("Italy") = 60550000
europe("Latvia") = 1907000
europe("Lithuania") = 2760000
europe("Luxembourg") = 616000
europe("Malta") = 440000
europe("Netherlands") = 17097000
europe("Poland") = 37888000
europe("Portugal") = 10226000
europe("Romania") = 19365000
europe("Slovakia") = 5457000
europe("Slovenia") = 2079000
europe("Spain") = 46737000
europe("Sweden") = 10036000
; -- Einwohnerzahlen der EU-Staaten zuweisen
ForEach europe()
AssignPopulation(MapKey(europe()), europe())
Next
; -- Zahlen für die gesamte EU berechnen
; (falls in der Map kein Land namens "EU" vorkommt)
If FindMapElement(*covid\Country(), "EU") = #Null
*ptrEU = AddMapElement(*covid\Country(), "EU", #PB_Map_NoElementCheck)
knownCountries + 1
Dim *ptrEU\Confirmed(lastField)
Dim *ptrEU\Sick(lastField)
ForEach europe()
*ptrEU\Population + europe()
FindMapElement(*covid\Country(), MapKey(europe()))
For i = #CSV_IndexFirstDate To lastField
*ptrEU\Confirmed(i) + *covid\Country()\Confirmed(i)
*ptrEU\Sick(i) + *covid\Country()\Sick(i)
Next
Next
EndIf
; -- Einwohnerzahlen anderer Staaten zuweisen
AssignPopulation("Afghanistan", 38042000)
AssignPopulation("Albania", 2881000)
AssignPopulation("Algeria", 43053000)
AssignPopulation("Andorra", 77000)
AssignPopulation("Angola", 31825000)
AssignPopulation("Antigua and Barbuda", 97000)
AssignPopulation("Argentina", 44781000)
AssignPopulation("Armenia", 2958000)
AssignPopulation("Australia", 25203000)
AssignPopulation("Azerbaijan", 10048000)
AssignPopulation("Bahamas", 389000)
AssignPopulation("Bahrain", 1641000)
AssignPopulation("Bangladesh", 163046000)
AssignPopulation("Barbados", 287000)
AssignPopulation("Belarus", 9452000)
AssignPopulation("Belize", 390000)
AssignPopulation("Benin", 11801000)
AssignPopulation("Bhutan", 763000)
AssignPopulation("Bolivia", 11513000)
AssignPopulation("Bosnia and Herzegovina", 3301000)
AssignPopulation("Botswana", 2304000)
AssignPopulation("Brazil", 211050000)
AssignPopulation("Brunei", 433000)
AssignPopulation("Burkina Faso", 20321000)
AssignPopulation("Burma", 54045000)
AssignPopulation("Burundi", 10864000)
AssignPopulation("Cabo Verde", 550000)
AssignPopulation("Cambodia", 16487000)
AssignPopulation("Cameroon", 25876000)
AssignPopulation("Canada", 37411000)
AssignPopulation("Central African Republic", 4745000)
AssignPopulation("Chad", 15947000)
AssignPopulation("Chile", 18952000)
AssignPopulation("China", 1433784000)
AssignPopulation("Colombia", 50339000)
AssignPopulation("Comoros", 851000)
AssignPopulation("Congo (Brazzaville)", 5381000)
AssignPopulation("Congo (Kinshasa)", 86791000)
AssignPopulation("Costa Rica", 5048000)
AssignPopulation("Cote d'Ivoire", 25717000)
AssignPopulation("Cuba", 11333000)
AssignPopulation("Djibouti", 974000)
AssignPopulation("Dominica", 72000)
AssignPopulation("Dominican Republic", 10739000)
AssignPopulation("Ecuador", 17374000)
AssignPopulation("Egypt", 100388000)
AssignPopulation("El Salvador", 6454000)
AssignPopulation("Equatorial Guinea", 1356000)
AssignPopulation("Eritrea", 3497000)
AssignPopulation("Eswatini", 1148000)
AssignPopulation("Ethiopia", 112079000)
AssignPopulation("Fiji", 890000)
AssignPopulation("Gabon", 2173000)
AssignPopulation("Gambia", 2348000)
AssignPopulation("Georgia", 3997000)
AssignPopulation("Ghana", 28834000)
AssignPopulation("Grenada", 112000)
AssignPopulation("Guatemala", 17581000)
AssignPopulation("Guinea", 12771000)
AssignPopulation("Guinea-Bissau", 1921000)
AssignPopulation("Guyana", 783000)
AssignPopulation("Haiti", 11264000)
AssignPopulation("Honduras", 9746000)
AssignPopulation("Iceland", 339000)
AssignPopulation("India", 1366418000)
AssignPopulation("Indonesia", 270626000)
AssignPopulation("Iran", 82914000)
AssignPopulation("Iraq", 39310000)
AssignPopulation("Israel", 8519000)
AssignPopulation("Jamaica", 2948000)
AssignPopulation("Japan", 126860000)
AssignPopulation("Jordan", 10102000)
AssignPopulation("Kazakhstan", 18551000)
AssignPopulation("Kenya", 52574000)
AssignPopulation("Korea, South", 51225000)
AssignPopulation("Kosovo", 1810000)
AssignPopulation("Kuwait", 4207000)
AssignPopulation("Kyrgyzstan", 6416000)
AssignPopulation("Laos", 7169000)
AssignPopulation("Lebanon", 6856000)
AssignPopulation("Lesotho", 2125000)
AssignPopulation("Liberia", 4937000)
AssignPopulation("Libya", 6777000)
AssignPopulation("Liechtenstein", 38000)
AssignPopulation("Madagascar", 26969000)
AssignPopulation("Malawi", 18629000)
AssignPopulation("Malaysia", 31950000)
AssignPopulation("Maldives", 531000)
AssignPopulation("Mali", 19658000)
AssignPopulation("Mauritania", 4526000)
AssignPopulation("Mauritius", 1199000)
AssignPopulation("Mexico", 127576000)
AssignPopulation("Moldova", 4043000)
AssignPopulation("Monaco", 39000)
AssignPopulation("Mongolia", 3225000)
AssignPopulation("Montenegro", 628000)
AssignPopulation("Morocco", 36472000)
AssignPopulation("Mozambique", 30366000)
AssignPopulation("Namibia", 2495000)
AssignPopulation("Nepal", 28609000)
AssignPopulation("New Zealand", 4783000)
AssignPopulation("Nicaragua", 6546000)
AssignPopulation("Niger", 23311000)
AssignPopulation("Nigeria", 200964000)
AssignPopulation("North Macedonia", 2083000)
AssignPopulation("Norway", 5379000)
AssignPopulation("Oman", 4975000)
AssignPopulation("Pakistan", 216565000)
AssignPopulation("Panama", 4246000)
AssignPopulation("Papua New Guinea", 8776000)
AssignPopulation("Paraguay", 7045000)
AssignPopulation("Peru", 32510000)
AssignPopulation("Philippines", 108117000)
AssignPopulation("Qatar", 2832000)
AssignPopulation("Russia", 145872000)
AssignPopulation("Rwanda", 12627000)
AssignPopulation("Saint Kitts and Nevis", 53000)
AssignPopulation("Saint Lucia", 183000)
AssignPopulation("Saint Vincent and the Grenadines", 111000)
AssignPopulation("San Marino", 34000) ; kleinster Staat in der Liste
AssignPopulation("Sao Tome and Principe", 215000)
AssignPopulation("Saudi Arabia", 34269000)
AssignPopulation("Senegal", 16296000)
AssignPopulation("Serbia", 6964000) ; ohne Kosovo (s.o.)
AssignPopulation("Seychelles", 98000)
AssignPopulation("Sierra Leone", 7813000)
AssignPopulation("Singapore", 5804000)
AssignPopulation("Somalia", 15443000)
AssignPopulation("South Africa", 58558000)
AssignPopulation("South Sudan", 11062000)
AssignPopulation("Sri Lanka", 21324000)
AssignPopulation("Sudan", 42813000)
AssignPopulation("Suriname", 581000)
AssignPopulation("Switzerland", 8591000)
AssignPopulation("Syria", 17070000)
AssignPopulation("Taiwan*", 23774000)
AssignPopulation("Tajikistan", 9321000)
AssignPopulation("Tanzania", 58005000)
AssignPopulation("Thailand", 69038000)
AssignPopulation("Timor-Leste", 1293000)
AssignPopulation("Togo", 8082000)
AssignPopulation("Trinidad and Tobago", 1395000)
AssignPopulation("Tunisia", 11695000)
AssignPopulation("Turkey", 83430000)
AssignPopulation("Uganda", 44270000)
AssignPopulation("Ukraine", 43994000)
AssignPopulation("United Arab Emirates", 9771000)
AssignPopulation("United Kingdom", 67530000)
AssignPopulation("Uruguay", 3462000)
AssignPopulation("US", 329065000)
AssignPopulation("Uzbekistan", 32982000)
AssignPopulation("Venezuela", 28516000)
AssignPopulation("Vietnam", 96462000)
AssignPopulation("West Bank and Gaza", 4981000)
AssignPopulation("Western Sahara", 582000)
AssignPopulation("Yemen", 29162000)
AssignPopulation("Zambia", 17861000)
AssignPopulation("Zimbabwe", 14645000)
; -- Kreuzfahrtschiffe und "Heiligen Stuhl" entfernen
DeleteMapElement(*covid\Country(), "Diamond Princess")
DeleteMapElement(*covid\Country(), "MS Zaandam")
DeleteMapElement(*covid\Country(), "Holy See")
; -- prüfen, ob die aktuellen Daten der Johns Hopkins Universität neue
; Staaten enthalten
newCountries = MapSize(*covid\Country()) - knownCountries
If newCountries > 0
If newCountries = 1
msg$ = "Ein neuer Staat ist hinzugekommen," + #LF$ +
"die Einwohnerzahl sollte erfasst werden:"
Else
msg$ = Str(newCountries) + " neue Staaten sind hinzugekommen," + #LF$ +
"die Einwohnerzahlen sollten erfasst werden:"
EndIf
ForEach *covid\Country()
If *covid\Country()\Population = 0
msg$ + #LF$ + Space(5) + MapKey(*covid\Country())
EndIf
Next
MessageRequester("Hinweis", msg$, #PB_MessageRequester_Warning)
EndIf
ProcedureReturn 0 ; success
EndProcedure
Procedure.i CurrentData (*covid.CSV, sort.i, countries$="")
; -- aktuelle Fallzahlen, Prävalenzen, Verdoppelungszeiten, Neuerkrankungen
; und Inzidenzen für ausgewählte oder alle Länder
; in : *covid : Länderdaten
; sort : #SortByPrevalence, #SortByDoublingTime oder #SortByIncidence
; countries$: Liste der interessierenden Länder (durch ';' getrennt),
; "" für alle Länder
; out: return value: 0 on success / 1 on error
Protected i.i, iCurDate.i, head2$, msg$
Protected NewList nation.Region()
If Asc(countries$) <> ''
countries$ = ";" + countries$ + ";"
EndIf
iCurDate = ArraySize(*covid\Date())
ForEach *covid\Country()
If Asc(countries$) = '' Or FindString(countries$, ";"+MapKey(*covid\Country())+";")
With *covid\Country()
AddElement(nation())
nation()\Name$ = MapKey(*covid\Country())
nation()\Sick = \Sick(iCurDate)
If \Sick(iCurDate) >= #MinCases
If \Population > 0
nation()\Prevalence = RoundEx(\Sick(iCurDate) * 100000 / \Population, 10) ; Prävalenz mit 1 Nachkommastelle
EndIf
nation()\Td = RoundEx(DoublingTime(*covid\Date(), \Sick(), #CSV_IndexFirstDate, iCurDate), 10) ; Tage mit 1 Nachkommastelle
Else
nation()\Td = -1.0
nation()\Prevalence = 10000.0
EndIf
; bestätigte Fälle auf Plausibilität prüfen:
For i = iCurDate-6 To iCurDate
If \Confirmed(i) < \Confirmed(i-1)
nation()\ErrDate = *covid\Date(i)
Break
EndIf
Next
nation()\New = Round(\Confirmed(iCurDate) - \Confirmed(iCurDate-7), #PB_Round_Nearest) ; durchschnittl. Neuerkrankte pro Woche
If nation()\New >= #MinCases And \Population > 0
nation()\Incidence = RoundEx(nation()\New * 100000 / \Population, 10) ; Inzidenz mit 1 Nachkommastelle
Else
nation()\Incidence = 10000.0
EndIf
EndWith
EndIf
Next
head2$ = "Land absolut pro 100 000 Einwohner Verdoppelungszeit | absolut pro 100 000 Einwohner "
; Der folgende Code funktioniert wie gewünscht, weil SortStructuredList() einen *stabilen* Sortieralgorithmus verwendet.
SortStructuredList(nation(), #PB_Sort_Ascending|#PB_Sort_NoCase, OffsetOf(Region\Name$), TypeOf(Region\Name$))
If sort = #SortByPrevalence
; Sortierprioritäten: 1. Prävalenz, 2. Verdoppelungszeit, 3. Inzidenz, 4. Ländernamen
SortStructuredList(nation(), #PB_Sort_Descending, OffsetOf(Region\Incidence), TypeOf(Region\Incidence))
SortStructuredList(nation(), #PB_Sort_Ascending, OffsetOf(Region\Td), TypeOf(Region\Td))
SortStructuredList(nation(), #PB_Sort_Descending, OffsetOf(Region\Prevalence), TypeOf(Region\Prevalence))
PokeC(@head2$ + 2*58, '▼')
ElseIf sort = #SortByDoublingTime
; Sortierprioritäten: 1. Verdoppelungszeit, 2. Inzidenz, 3. Prävalenz, 4. Ländernamen
SortStructuredList(nation(), #PB_Sort_Descending, OffsetOf(Region\Prevalence), TypeOf(Region\Prevalence))
SortStructuredList(nation(), #PB_Sort_Descending, OffsetOf(Region\Incidence), TypeOf(Region\Incidence))
SortStructuredList(nation(), #PB_Sort_Ascending, OffsetOf(Region\Td), TypeOf(Region\Td))
PokeC(@head2$ + 2*80, '▲')
ElseIf sort = #SortByIncidence
; Sortierprioritäten: 1. Inzidenz, 2. Verdoppelungszeit, 3. Prävalenz, 4. Ländernamen
SortStructuredList(nation(), #PB_Sort_Descending, OffsetOf(Region\Prevalence), TypeOf(Region\Prevalence))
SortStructuredList(nation(), #PB_Sort_Ascending, OffsetOf(Region\Td), TypeOf(Region\Td))
SortStructuredList(nation(), #PB_Sort_Descending, OffsetOf(Region\Incidence), TypeOf(Region\Incidence))
PokeC(@head2$ + 2*120, '▼')
Else
ProcedureReturn 1 ; error
EndIf
Debug "Lage in " + ListSize(nation()) + " Ländern am " + FormatDate(#DateMaskOut$, *covid\Date(iCurDate))
Debug ""
Debug " akut Erkrankte | Neuerkrankte/Woche"
Debug head2$
Debug "---- ------- ----------------------- ------------------- | ------- -----------------------"
ForEach nation()
msg$ = LSet(nation()\Name$, 24) + RAlign(Str(nation()\Sick), 9) + Space(9)
If nation()\Sick >= #MinCases
msg$ + RAlign(StrD(nation()\Prevalence, 1), 8) + Space(13)
If nation()\Td >= 10000.0
msg$ + Space(7) + #NA$ + Space(11)
Else
msg$ + RAlign(StrD(nation()\Td,1), 8) + " Tage" + Space(8)
EndIf
Else
msg$ + #None$ + Space(15) + #None$ + Space(11)
EndIf
msg$ + "|" + Space(2)
If nation()\ErrDate
msg$ + "inkonsistenter Wert von \Confirmed() am " +
FormatDate(#DateMaskOut$, nation()\ErrDate)
Else
msg$ + RAlign(Str(nation()\New), 8) + Space(9)
If nation()\Incidence < 10000.0
msg$ + RAlign(StrD(nation()\Incidence,1), 8)
Else
msg$ + #None$
EndIf
EndIf
Debug msg$
Next
ProcedureReturn 0 ; success
EndProcedure
Procedure.i CourseOfTime (*covid.CSV, country$)
; -- zeitliche Entwicklung der Fallzahlen, Prävalenzen, Verdoppelungszeiten,
; Neuerkrankungen und Inzidenzen in einem ausgewählten Land
; in : *covid : Länderdaten
; country$: interessierendes Land,
; "" um diesen Programmteil zu überspringen
; out: return value: 0 on success / 1 or 2 on error
Protected td.d, incidence.d, msg$
Protected.i i, error, new, iCurDate, iTarget, iTrend, checkTrend=#True
Protected *pOut, *pMax, max.i=0
Protected NewList out$()
If Asc(country$) = ''
ProcedureReturn 0 ; success
EndIf
If FindMapElement(*covid\Country(), country$) = #Null
ProcedureReturn 1 ; error
EndIf
Debug "Zeitliche Entwicklung in: " + country$
Debug ""
Debug " akut Erkrankte | Neuerkrankte/Woche"
Debug "Datum ▲ absolut pro 100 000 Einwohner Verdoppelungszeit | absolut pro 100 000 Einwohner"
Debug "------- ------- --------------------- ----------------- | ------- ---------------------"
iCurDate = ArraySize(*covid\Date())
For iTarget = 43 To iCurDate ; erst ab 1. März auswerten
With *covid\Country()
*pOut = AddElement(out$())
out$() = FormatDate(#DateMaskOut$, *covid\Date(iTarget)) + RAlign(Str(\Sick(iTarget)), 12) + Space(8)
If \Sick(iTarget) >= #MinCases
If \Population > 0
out$() + RAlign(StrD(\Sick(iTarget) * 100000 / \Population, 1), 8) + Space(10)
Else
out$() + #None$ + Space(12)
EndIf
td = DoublingTime(*covid\Date(), \Sick(), #CSV_IndexFirstDate, iTarget)
If td >= 10000.0
out$() + Space(7) + #NA$ + Space(11)
Else
out$() + RAlign(StrD(td,1), 8) + " Tage" + Space(8)
EndIf
Else
out$() + #None$ + Space(13) + #None$ + Space(10)
EndIf
out$() + "|" + Space(2)
If \Confirmed(iTarget) < \Confirmed(iTarget-1)
out$() + "inkonsistenter Wert von \Confirmed()"
Else
error = #False
For i = iTarget-6 To iTarget-1
If \Confirmed(i) < \Confirmed(i-1)
error = #True
Break
EndIf
Next
If error
out$() + #None$ + Space(8) + #None$
Else
new = Round(\Confirmed(iTarget) - \Confirmed(iTarget-7), #PB_Round_Nearest) ; Neuerkrankte pro Woche
If max < new
max = new
*pMax = *pOut
EndIf
out$() + RAlign(Str (new), 8) + Space( 8)
If new >= #MinCases And \Population > 0
incidence = new * 100000 / \Population
out$() + RAlign(StrD(incidence,1), 8)
Else
out$() + #None$
EndIf
EndIf
EndIf
; Die Sick()-Werte der letzten #TrendDays Tage prüfen
iTrend = iTarget - iCurDate + #TrendDays - 1
If iTrend >= 0
If \Sick(iTarget) < #MinCases
checkTrend = #False ; Es kann kein Trend berechnet werden.
EndIf
EndIf
EndWith
Next
ForEach out$()
If @out$() = *pMax
Debug out$() + " max."
Else
Debug out$()
EndIf
Next
; -- Trend berechnen
Debug ""
msg$ = "Trend der letzten " + #TrendDays + " Tage: "
If checkTrend = #False
Debug msg$ + Space(4) + #None$
ProcedureReturn 0 ; success
EndIf
msg$ + "Die Anzahl akut Erkrankter "
Select CalcTrend(*covid\Country()\Sick(), iCurDate, #TrendDays, Bool(Asc(#R_Script$) <> ''))
Case 0
Debug msg$ + "bleibt ungefähr gleich."
Case 1
Debug msg$ + "bleibt gleich."
Case -2
Debug msg$ + "nimmt ab."
Case -4
Debug msg$ + "nimmt zunehmend langsamer ab."
Case -6
Debug msg$ + "nimmt zunehmend schneller ab."
Case 2
Debug msg$ + "nimmt zu."
Case 4
Debug msg$ + "nimmt zunehmend langsamer zu."
Case 6
Debug msg$ + "nimmt zunehmend schneller zu."
Default
ProcedureReturn 2 ; error
EndSelect
ProcedureReturn 0 ; success
EndProcedure
Procedure.i ExportPrevalences (*covid.CSV, countries$, csvFile$, fieldSep$=";", decimalSep$=",")
; -- CSV-Datei mit dem Verlauf der Prävalenzen in den angegebenen Ländern erzeugen
; (Erkrankte pro 100 000 Einwohner)
; in : *covid : Länderdaten
; countries$ : Liste der interessierenden Länder (durch ';' getrennt),
; "" um keine CSV-Datei zu schreiben
; csvFile$ : Name der zu erzeugenden CSV-Datei,
; "" um keine CSV-Datei zu schreiben
; fieldSep$ : Feldtrennzeichen
; decimalSep$: Dezimaltrennzeichen (Voreinstellung für LibreOffice Calc)
; out: return value: 0 on success / 1 or 2 on error
Protected line$, country$, warning$=""
Protected.i ofn, i, d, numCountries, ret=0
Protected.i iCurDate = ArraySize(*covid\Date())
If Asc(countries$) = '' Or Asc(csvFile$) = ''
ProcedureReturn 0 ; success
EndIf
ofn = CreateFile(#PB_Any, csvFile$)
If ofn = 0
ProcedureReturn 1 ; error
EndIf
line$ = "Country"
For d = 43 To iCurDate ; erst ab 1. März auswerten
line$ + fieldSep$ + FormatDate(#DateMaskOut$, *covid\Date(d))
Next
WriteStringN(ofn, line$)
numCountries = CountString(countries$, ";") + 1
For i = 1 To numCountries
country$ = StringField(countries$, i, ";")
With *covid\Country()
If FindMapElement(*covid\Country(), country$) > 0 And \Population > 0
line$ = country$
For d = 43 To iCurDate ; erst ab 1. März auswerten
If \Sick(d) >= #MinCases
line$ + fieldSep$ + FormatNumber(\Sick(d) * 100000 / \Population, 1, decimalSep$)
Else
line$ + fieldSep$ + "0"
EndIf
If \Confirmed(d) < \Confirmed(d-1)
warning$ + ";" + country$
EndIf
Next
WriteStringN(ofn, line$)
Else
ret = 2 ; error
EndIf
EndWith
Next
CloseFile(ofn)
Debug "Die zeitliche Entwicklung der Prävalenzen in den Ländern" + #LF$ +
Space(3) + countries$ + #LF$ +
"wurde in die Datei '" + csvFile$ + "' geschrieben."
If Asc(warning$) <> ''
Debug ""
Debug "Achtung: Die 'confirmed'-Daten der Johns Hopkins Universität von" + #LF$ +
Space(3) + Mid(warning$, 2) + #LF$ +
"enthalten inkonsistente Werte."
EndIf
ProcedureReturn ret
EndProcedure
; ======= P R O G R A M M S T A R T =======
#Title$ = "Dynamics of Covid-19 propagation"
Define download.i, sortCurrentCountries.i, currentCountries$, ctCountry$, exportCountries$, exportFile$, covid.CSV
;-------------------------------------
;- * EINSTELLUNGEN *
download = #Auto
; currentCountries$ = "" ; means *all* countries
currentCountries$ = "Singapore;US;United Kingdom;Sweden;Italy;Norway;EU;Russia;Switzerland;Germany;Austria"
; sortCurrentCountries = #SortByPrevalence
; sortCurrentCountries = #SortByDoublingTime
sortCurrentCountries = #SortByIncidence
; -- Zeitliche Entwicklung zeigen für:
; ctCountry$ = "Austria"
; ctCountry$ = "EU"
; ctCountry$ = "France"
ctCountry$ = "Germany"
; ctCountry$ = "Italy"
; ctCountry$ = "Japan"
; ctCountry$ = "Korea, South"
; ctCountry$ = "New Zealand"
; ctCountry$ = "Norway"
; ctCountry$ = "Russia"
; ctCountry$ = "Singapore"
; ctCountry$ = "Spain"
; ctCountry$ = "Sweden"
; ctCountry$ = "Switzerland"
; ctCountry$ = "United Kingdom"
; ctCountry$ = "US"
; ctCountry$ = ""
exportCountries$ = "Singapore;US;United Kingdom;Sweden;Italy;Norway;EU;Russia;Switzerland;Germany;Austria"
exportFile$ = "Covid-19 prevalence.csv"
;-------------------------------------
; -- Vorbereitungen
Select GetCSVfiles(download)
Case 1
MessageRequester(#Title$, "Error reading most recent date in file '" +
s_FileConfirmed$ + "'.", #PB_MessageRequester_Error)
End
Case 2
MessageRequester(#Title$, "Error downloading CSV files.", #PB_MessageRequester_Error)
End
EndSelect
Select AddFirstCSV(s_FileConfirmed$, @covid)
Case 1
MessageRequester(#Title$, "Error reading CSV file '" + s_FileConfirmed$ + "'.", #PB_MessageRequester_Error)
End
Case 2, 3, 5
MessageRequester(#Title$, "Invalid CSV format in file '" + s_FileConfirmed$ + "'.", #PB_MessageRequester_Error)
End
Case 4
MessageRequester(#Title$, "No continuous dates in CSV file '" + s_FileConfirmed$ + "'.", #PB_MessageRequester_Error)
End
EndSelect
Select SubNextCSV(s_FileRecovered$, @covid)
Case 1
MessageRequester(#Title$, "Error reading CSV file '" + s_FileRecovered$ + "'.", #PB_MessageRequester_Error)
End
Case 2, 5
MessageRequester(#Title$, "Invalid CSV format in file '" + s_FileRecovered$ + "'.", #PB_MessageRequester_Error)
End
Case 3, 4
MessageRequester(#Title$, "Headers of files '" + s_FileConfirmed$ + "' and '" +
s_FileRecovered$ + "' are different.", #PB_MessageRequester_Error)
End
Case 6
MessageRequester(#Title$, "Country '"+ MapKey(covid\Country()) + "' is contained in file '" + s_FileRecovered$ +
"' but not in file '" + s_FileConfirmed$ + "'.", #PB_MessageRequester_Error)
End
EndSelect
Select SubNextCSV(s_FileDeaths$, @covid)
Case 1
MessageRequester(#Title$, "Error reading CSV file '" + s_FileDeaths$ + "'.", #PB_MessageRequester_Error)
End
Case 2, 5
MessageRequester(#Title$, "Invalid CSV format in file '" + s_FileDeaths$ + "'.", #PB_MessageRequester_Error)
End
Case 3, 4
MessageRequester(#Title$, "Headers of files '" + s_FileConfirmed$ + "' and '" +
s_FileDeaths$ + "' are different.", #PB_MessageRequester_Error)
End
Case 6
MessageRequester(#Title$, "Country '"+ MapKey(covid\Country()) + "' is contained in file '" + s_FileDeaths$ +
"' but not in file '" + s_FileConfirmed$ + "'.", #PB_MessageRequester_Error)
End
EndSelect
If InitCountries(@covid) = 1
MessageRequester(#Title$, "Unknown country '" + MapKey(covid\Country()) +
"' in procedure InitCountries().", #PB_MessageRequester_Error)
End
EndIf
; -- 1) aktuelle Lage in ausgewählten oder allen Ländern zeigen
If CurrentData(@covid, sortCurrentCountries, currentCountries$) = 1
MessageRequester(#Title$, "Invalid sort mode " + sortCurrentCountries + ".", #PB_MessageRequester_Error)
End
EndIf
Debug ""
Debug RepeatChar(121, "=")
Debug ""
; -- 2) zeitliche Entwicklung in einem Land zeigen
Select CourseOfTime(@covid, ctCountry$)
Case 1
MessageRequester(#Title$, "Country '" + ctCountry$ + "' not found.", #PB_MessageRequester_Error)
End
Case 2
MessageRequester(#Title$, "Error when calculating trend for country '" + ctCountry$ + "'.", #PB_MessageRequester_Error)
End
EndSelect
Debug ""
Debug RepeatChar(121, "=")
Debug ""
; -- 3) Prävalenzen ausgewählter Länder in CSV-Datei schreiben
Select ExportPrevalences(@covid, exportCountries$, exportFile$)
Case 1
MessageRequester(#Title$, "Can't create CSV file '" + exportFile$ + "'.", #PB_MessageRequester_Error)
End
Case 2
MessageRequester(#Title$, "The following list contains one or more unknown countries:" + #LF$ +
Space(3) + exportCountries$, #PB_MessageRequester_Error)
End
EndSelect
