Ärzte-Zulassungen: Analyse der Anwendung von Disziplinarmassnahmen seit 2013
Vorprozessierung und Analyse
SRF Data, Julius Mattern, Julian Schmidli (julian.schmidli@srf.ch)
Februar 2019
Vorbemerkungen
Dieses Dokument beschreibt die Vorprozessierung und explorative Analyse des Datensatzes, der Grundlage des auf srf.ch veröffentlichten Artikels zu Ärzte-Zulassungen ist.
SRF Data legt Wert darauf, dass die Datenvorprozessierung und -Analyse nachvollzogen und überprüft werden kann. SRF Data glaubt an das Prinzip offener Daten, aber auch offener und nachvollziehbarer Methoden. Zum anderen soll es Dritten ermöglicht werden, auf dieser Vorarbeit aufzubauen und damit weitere Auswertungen oder Applikationen zu generieren.
Die Endprodukte des vorliegenden Scripts, neben der vorliegenden explorativen Analyse, sind die folgenden Abbildungen:
Teil A: Verschiedene Disziplinarmassnahmen einzeln
- Grafik: Anwendung der verschiedenen Disziplinarmassnahmen
- Grafik: Kantonale Aufteilung der Anwendung der verschiedenen Disziplinarmassnahmen (Kantone > 1000 aktive Lizenzen)
- Grafik: Absolute kant. Anwendung der Disziplinarmassnahmen
- Grafik: Kant. Anwendung der Disziplinarmassnahmen im Verhältnis zu den aktiven Lizenzen
Teil B: Disziplinarmassnahmen aufgeteilt nach “weich” und “hart”
- Grafik: Anwendung von weichen/harte Disziplinarmassnahmen
- Grafik: Kantonale Aufteilung der Anwendung der weichen/harten Disziplinarmassnahmen (Kantone > 1000 aktive Lizenzen)
- Grafik: Absolute kant. Anwendung der weichen/harte Disziplinarmassnahmen
- Grafik: Kant. Anwendung der weichen/harte Disziplinarmassnahmen im Verhältnis zu den aktiven Lizenzen
Teil C: Analyse analog Teil A/B, aber nur Humanmediziner
R-Script & Daten
Die Vorprozessierung und Analyse wurde im Statistikprogramm R vorgenommen. Das zugrunde liegende Script sowie die prozessierten Daten können unter diesem Link heruntergeladen werden. Durch Ausführen von main.Rmd kann der hier beschriebene Prozess nachvollzogen und der für den Artikel verwendete Datensatz generiert werden. Dabei werden Daten aus dem Ordner input eingelesen und Ergebnisse in den Ordner output geschrieben.
Verwendet wird R Version 3.5.2. Wenn der Code nicht funktioniert, könnte es daran liegen, dass die installierte R Version eine ältere ist und deshalb aus Kompatibilitätsgründen ältere Packages installiert werden, als die von uns verwendeten. Manchmal hilft es, das Skript mehrmals auszuführen, wenn ein Fehler auftritt. Besonders bei Package-Installationsproblemen kann es helfen, die R-Session mehrmals neuzustarten und den Code nochmals auszuführen. Allenfalls müssen noch Third-Party-Libraries wie z.B. libgdal-dev installiert werden.
Debug-Informationen: This report was generated on 2019-02-12 16:37:40. R version: 3.5.2 on x86_64-pc-linux-gnu. For this report, CRAN packages as of 2018-09-01 were used.
GitHub
Der Code für die vorliegende Datenprozessierung ist auf https://github.com/srfdata/2019-02-aerzte-zulassungen zur freien Verwendung verfügbar.
Lizenz
2019-02-aerzte-zulassungen von SRF Data ist lizenziert unter einer Creative Commons Namensnennung - Weitergabe unter gleichen Bedingungen 4.0 International Lizenz.
Weitere Projekte
Code & Daten von SRF Data sind unter http://srfdata.github.io verfügbar.
Haftungsausschluss
Die veröffentlichten Informationen sind sorgfältig zusammengestellt, erheben aber keinen Anspruch auf Aktualität, Vollständigkeit oder Richtigkeit. Es wird keine Haftung übernommen für Schäden, die durch die Verwendung dieses Scripts oder der daraus gezogenen Informationen entstehen. Dies gilt ebenfalls für Inhalte Dritter, die über dieses Angebot zugänglich sind.
Originalquellen
Alle hier verwendeten Daten stammen vom Bundesamt für Gesundheit (BAG).
Quelle 1: Disziplinarmassnahmen.xlsx
Das Dokument Disziplinarmassnahmen.xlsx enthält die pro Kanton und Jahr aggregierten Anwendungen der Disziplinarmassnahmen für Medizinalberufe seit 2013. Die aggregierten Daten wurden SRF Data vom BAG zur Verfügung gestellt. Es handelt sich dabei um eine Excel-Datei, die auf den jeweiligen Sheets die Daten für ein Jahr enthält.
Quelle 2: 20190117_Disziplinarmassnahmen_humanmed.xlsx
Das Dokument 20190117_Disziplinarmassnahmen_humanmed.xlsx enthält die pro Kanton und Jahr aggregierten Anwendungen der Disziplinarmassnahmen nur für Humanmediziner seit 2013. Die aggregierten Daten wurden SRF Data vom BAG zur Verfügung gestellt. Es handelt sich dabei um eine Excel-Datei, die auf den jeweiligen Sheets die Daten für ein Jahr enthält.
Quelle 3: Rohdaten Aktive BAB MED GVSP.xlsx, Rohdaten Aktive BAB DENT.xlsx, Rohdaten Aktive BAB PHARM.xlsx, Rohdaten Aktive BAB VET.xlsx, Rohdaten Aktive BAB CHIRO.xlsx
Die fünf im Titel genannten Tabellen stammen von der BAG-Website und enthalten die per 31.12.2016 erteilten aktiven Berufsausübungsbewilligungen mit Informationen zu den Weiterbildungstiteln nach Grundversorger und Spezialisten zu den folgenden Typen von Medizinalpersonen:
- Ärztinnen und Ärzte
- Zahnärztinnen und Zahnärzte
- Apothekerinnen und Apotheker
- Tierärztinnen und Tierärzte
- Chiroporaktorinnen und Chiropraktoren
‘Erteilt’ bedeutet, dass die Bewilligung aktiv und gültig ist (aber keine Information, dass die Person sie auch benutzt). Abgemeldete Bewilligungen, Bewilligungen von pensionierten Personen, und Bewilligungen mit dem Status ‘keine Bewilligung’ sind nicht Teil dieser Tabellen.
Quellen der BAG-Dateien zu den aktiven BAB:
Rohdaten Aktive BAB MED GVSP.xlsx: https://www.bag.admin.ch/dam/bag/de/dokumente/berufe-gesundheitswesen/medizinalberufe/statistiken/med/aktive-bab/aktive-bab-med-2016.xlsx.download.xlsx/Rohdaten%20Aktive%20BAB%20MED%20GVSP.xlsx
Rohdaten Aktive BAB DENT.xlsx: https://www.bag.admin.ch/dam/bag/de/dokumente/berufe-gesundheitswesen/medizinalberufe/statistiken/dent/rohdaten-dent/Aktive%20BAB%20DENT/aktive-bab-dent-2016.xlsx.download.xlsx/Rohdaten%20Aktive%20BAB%20DENT.xlsx
Rohdaten Aktive BAB PHARM.xlsx: https://www.bag.admin.ch/dam/bag/de/dokumente/berufe-gesundheitswesen/medizinalberufe/statistiken/pharma/aktive-bab/aktive-bab-pharm-2016.xlsx.download.xlsx/Rohdaten%20Aktive%20BAB%20PHARM.xlsx
Rohdaten Aktive BAB VET.xlsx: https://www.bag.admin.ch/dam/bag/de/dokumente/berufe-gesundheitswesen/medizinalberufe/statistiken/vet/aktive-bab/aktive-bab-vet-2016.xlsx.download.xlsx/Rohdaten%20Aktive%20BAB%20VET.xlsx
Rohdaten Aktive BAB CHIRO.xlsx: https://www.bag.admin.ch/dam/bag/de/dokumente/berufe-gesundheitswesen/medizinalberufe/statistiken/chiro/rohdaten-chiro/aktive-bab-chiro/rohdaten-aktive-bab-chiro-2016.xlsx.download.xlsx/Rohdaten%20Aktive%20BAB%20CHIRO.xlsx
Vorbereitungen
## [1] "package package:rmarkdown detached"## Loading required package: knitr## Loading required package: rstudioapiPackages definieren
# von https://mran.revolutionanalytics.com/web/packages/checkpoint/vignettes/using-checkpoint-with-knitr.html
# alle Packages, die nicht gebraucht werden,
# können hier entfernt werden (auskommentieren reicht nicht!)
# Wichtig: wenn neues Package installiert werden soll,
# scanForPackages = T setzen im checkpoint() call im nächsten Chunk
cat("
library(rstudioapi)
library(tidyverse) # ggplot2, dplyr, tidyr, readr, purrr, tibble
library(magrittr) # pipes
library(scales) # scales for ggplot2
library(readxl) # read excel files
library(lintr) # code linting, auf keinen Fall entfernen ;-)
library(styler) # code formatting
library(rmarkdown) # muss für automatisches knitting
# in deploy.sh eingebunden werden",
file = "manifest.R")Packages installieren
if (!require(checkpoint)) {
if (!require(devtools)) {
install.packages("devtools",
repos = "http://cran.us.r-project.org")
require(devtools)
}
devtools::install_github("RevolutionAnalytics/checkpoint",
ref = "v0.3.2",
repos = "http://cran.us.r-project.org")
require(checkpoint)
}## Loading required package: checkpoint##
## checkpoint: Part of the Reproducible R Toolkit from Microsoft
## https://mran.microsoft.com/documents/rro/reproducibility/# nolint start
if (!dir.exists("~/.checkpoint")) {
dir.create("~/.checkpoint")
}
# nolint end
checkpoint(snapshotDate = package_date,
project = path_to_wd,
verbose = T,
# hier ggf. auf F setzen, um Wartezeit zu verkürzen
scanForPackages = T,
use.knitr = F,
R.version = R_version) # wenn eine "ähnliche" Version von R## Scanning for packages used in this project## rmarkdown files found and will not be parsed. Set use.knitr = TRUE## - Discovered 9 packages## All detected packages already installed## checkpoint process complete## ---# installiert ist (3.4.x in diesem Fall), kann dieses
# Argument hier entfernt und die vorhandene R-Version
# verwendet werden - vorausgesetzt, die hier verwendeten
# Packages funktionieren mit dieser.
rm(package_date, R_version)Packages laden
source("manifest.R")## ── Attaching packages ────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse 1.2.1 ──## ✔ ggplot2 3.0.0 ✔ purrr 0.2.5
## ✔ tibble 1.4.2 ✔ dplyr 0.7.6
## ✔ tidyr 0.8.1 ✔ stringr 1.3.1
## ✔ readr 1.1.1 ✔ forcats 0.3.0## ── Conflicts ───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()##
## Attaching package: 'magrittr'## The following object is masked from 'package:purrr':
##
## set_names## The following object is masked from 'package:tidyr':
##
## extract##
## Attaching package: 'scales'## The following object is masked from 'package:purrr':
##
## discard## The following object is masked from 'package:readr':
##
## col_factorunlink("manifest.R")
sessionInfo()## R version 3.5.2 (2018-12-20)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 18.04.1 LTS
##
## Matrix products: default
## BLAS: /usr/lib/x86_64-linux-gnu/openblas/libblas.so.3
## LAPACK: /usr/lib/x86_64-linux-gnu/libopenblasp-r0.2.20.so
##
## locale:
## [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
## [3] LC_TIME=de_CH.UTF-8 LC_COLLATE=en_US.UTF-8
## [5] LC_MONETARY=de_CH.UTF-8 LC_MESSAGES=en_US.UTF-8
## [7] LC_PAPER=de_CH.UTF-8 LC_NAME=C
## [9] LC_ADDRESS=C LC_TELEPHONE=C
## [11] LC_MEASUREMENT=de_CH.UTF-8 LC_IDENTIFICATION=C
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] rmarkdown_1.10 styler_1.0.2 lintr_1.0.2 readxl_1.1.0
## [5] scales_1.0.0 magrittr_1.5 forcats_0.3.0 stringr_1.3.1
## [9] dplyr_0.7.6 purrr_0.2.5 readr_1.1.1 tidyr_0.8.1
## [13] tibble_1.4.2 ggplot2_3.0.0 tidyverse_1.2.1 checkpoint_0.4.0
## [17] rstudioapi_0.7 knitr_1.20
##
## loaded via a namespace (and not attached):
## [1] Rcpp_0.12.18 cellranger_1.1.0 compiler_3.5.2 pillar_1.3.0
## [5] plyr_1.8.4 bindr_0.1.1 tools_3.5.2 digest_0.6.16
## [9] lubridate_1.7.4 jsonlite_1.5 evaluate_0.11 nlme_3.1-137
## [13] gtable_0.2.0 lattice_0.20-38 pkgconfig_2.0.2 rlang_0.2.2
## [17] rex_1.1.2 cli_1.0.0 yaml_2.2.0 haven_1.1.2
## [21] bindrcpp_0.2.2 withr_2.1.2 xml2_1.2.0 httr_1.3.1
## [25] hms_0.4.2 rprojroot_1.3-2 grid_3.5.2 tidyselect_0.2.4
## [29] glue_1.3.0 R6_2.2.2 modelr_0.1.2 backports_1.1.2
## [33] htmltools_0.3.6 rvest_0.3.2 assertthat_0.2.0 colorspace_1.3-2
## [37] stringi_1.2.4 lazyeval_0.2.1 munsell_0.5.0 broom_0.5.0
## [41] crayon_1.3.4rm(list = ls(all.names = TRUE))Hilfsfunktionen
Erstelle eine Funktion, die aufgrund der Kantonskürzel den gesamten Kantonsnamen zurückgibt.
# return the canton name if the abbrevation is given
get_canton_name <- function(canton_short) {
canton_name <-
case_when(
canton_short == "AG" ~ "Aargau",
canton_short == "AR" ~ "Appenzell Ausserrhoden",
canton_short == "AI" ~ "Appenzell Innerrhoden",
canton_short == "BL" ~ "Basel-Land",
canton_short == "BS" ~ "Basel-Stadt",
canton_short == "BE" ~ "Bern",
canton_short == "FR" ~ "Freiburg",
canton_short == "GE" ~ "Genf",
canton_short == "GL" ~ "Glarus",
canton_short == "GR" ~ "Graubünden",
canton_short == "JU" ~ "Jura",
canton_short == "LU" ~ "Luzern",
canton_short == "NE" ~ "Neuenburg",
canton_short == "NW" ~ "Nidwalden",
canton_short == "OW" ~ "Obwalden",
canton_short == "SH" ~ "Schaffhausen",
canton_short == "SZ" ~ "Schwyz",
canton_short == "SO" ~ "Solothurn",
canton_short == "SG" ~ "St. Gallen",
canton_short == "TI" ~ "Tessin",
canton_short == "TG" ~ "Thurgau",
canton_short == "UR" ~ "Uri",
canton_short == "VD" ~ "Waadt",
canton_short == "VS" ~ "Wallis",
canton_short == "ZG" ~ "Zug",
canton_short == "ZH" ~ "Zürich",
TRUE ~ ""
)
return(canton_name)
}Erstelle Themes für die Plots.
# theme with x grid lines
plot_theme <- theme(
text = element_text(color = "#22211d"),
legend.position = "bottom",
legend.key = element_blank(),
legend.title = element_blank(),
plot.title = element_text(size = 14),
panel.grid.major.x = element_line(
color = "#D3D3D3",
size = 0.3,
linetype = "longdash"
),
panel.grid.major.y = element_blank(),
panel.background = element_blank(),
axis.title.x = element_text(size = 14),
axis.title.y = element_text(size = 14),
axis.text.x = element_text(size = 10),
axis.text.y = element_text(size = 12),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank()
)
# the same theme, but with y grid lines (instead of only x)
plot_theme_ygrid <- plot_theme +
theme(
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_line(
color = "#D3D3D3",
size = 0.3,
linetype = "longdash"
)
)
# create also a theme for the legend
legend_theme <- guide_legend(
nrow = 1,
direction = "horizontal",
keyheight = unit(3, units = "mm"),
keywidth = unit(20, units = "mm"),
title.position = "top",
title.hjust = 0.5,
label.hjust = 1,
byrow = T,
label.position = "bottom"
)
# reverse
legend_theme_rev <- guide_legend(
nrow = 1,
reverse = T,
direction = "horizontal",
keyheight = unit(3, units = "mm"),
keywidth = unit(20, units = "mm"),
title.position = "top",
title.hjust = 0.5,
label.hjust = 1,
byrow = T,
label.position = "bottom"
)Lade Anzahl aktiver Lizenzen
Hole die BAG-Tabellen mit der Anzahl der aktiven Lizenzen für alle Medizinalperson-Typen, Stand 31.12.2018.
# load active licenses of all doc types from bag tables,
# as of 2016-12-31
active_2016 <-
read_excel("input/disciplinary_measures/active_licenses/Rohdaten Aktive BAB CHIRO.xlsx", 2) %>%
bind_rows(
read_excel("input/disciplinary_measures/active_licenses/Rohdaten Aktive BAB DENT.xlsx", 2) %>%
mutate(JahrGleichwertigkeitDiplom =
as.numeric(JahrGleichwertigkeitDiplom))
) %>%
bind_rows(
read_excel("input/disciplinary_measures/active_licenses/Rohdaten Aktive BAB MED GVSP.xlsx", 2) %>%
mutate(JahrGleichwertigkeitDiplom =
as.numeric(JahrGleichwertigkeitDiplom))
) %>%
bind_rows(
read_excel("input/disciplinary_measures/active_licenses/Rohdaten Aktive BAB PHARM.xlsx", 2) %>%
mutate(JahrGleichwertigkeitDiplom =
as.numeric(JahrGleichwertigkeitDiplom))
) %>%
bind_rows(
read_excel("input/disciplinary_measures/active_licenses/Rohdaten Aktive BAB VET.xlsx", 2) %>%
mutate(JahrGleichwertigkeitDiplom =
as.numeric(JahrGleichwertigkeitDiplom))
)
# count distinct persons with licenses
nrow(active_2016 %>%
group_by(Beruf) %>%
distinct(Identifikator) %>%
ungroup()) # 44'015## [1] 44015# 44'015 persons with licenses. this number is correct, it
# is also reported in the bag report of 2016:
# https://tinyurl.com/yccawnbn
# get active licenses per canton, count every
# person only once
active_2016_licensed_persons_cantons <- active_2016 %>%
group_by(Bewilligungskanton) %>%
# get distinct persons, not
# 'weiterbildungen' etc.
distinct(Identifikator) %>%
summarise(license_amount = n())
# 50'875 cantonal licenses hold by distinct persons.
# makes sense, the 6'860 diff to 44'015 persons is due
# to persons having licenses in multiple cantons
sum(active_2016_licensed_persons_cantons$license_amount)## [1] 50875# get active human med licenses per canton, count every
# doc only once
active_2016_licensed_humandocs_cantons <- active_2016 %>%
# ONLY HUMAN DOCS
filter(Beruf == "Ärztin/Arzt") %>%
group_by(Bewilligungskanton) %>%
# get distinct persons, not
# 'weiterbildungen' etc.
distinct(Identifikator) %>%
summarise(license_amount = n())
# clean up
rm(active_2016)Lade die Tabelle mit den Disziplinarmassnahmen (DM) des BAG.
# load bag disciplinary measures data
disciplinary <-
read_excel("input/disciplinary_measures/Disziplinarmassnahmen.xlsx", 1, skip = 2) %>%
mutate(Year = 2018) %>%
bind_rows(read_excel("input/disciplinary_measures/Disziplinarmassnahmen.xlsx", 2, skip = 2) %>%
mutate(Year = 2017)) %>%
bind_rows(read_excel("input/disciplinary_measures/Disziplinarmassnahmen.xlsx", 3, skip = 2) %>%
mutate(Year = 2016)) %>%
bind_rows(read_excel("input/disciplinary_measures/Disziplinarmassnahmen.xlsx", 4, skip = 2) %>%
mutate(Year = 2015)) %>%
bind_rows(read_excel("input/disciplinary_measures/Disziplinarmassnahmen.xlsx", 5, skip = 2) %>%
mutate(Year = 2014)) %>%
bind_rows(read_excel("input/disciplinary_measures/Disziplinarmassnahmen.xlsx", 6, skip = 2) %>%
mutate(Year = 2013)) %>%
# dont take the total col, not needed
select(-X__2) %>%
# rename the cols
rename(Canton = X__1,
Verwarnung = a,
Verweis = b,
Busse = c,
Verbot_befr = d,
Verbot_def = e
) %>%
# replace the nas with zeroes
mutate(Verwarnung = ifelse(is.na(Verwarnung), 0, Verwarnung),
Verweis = ifelse(is.na(Verweis), 0, Verweis),
Busse = ifelse(is.na(Busse), 0, Busse),
Verbot_befr = ifelse(is.na(Verbot_befr), 0, Verbot_befr),
Verbot_def = ifelse(is.na(Verbot_def), 0, Verbot_def),
Entzug = ifelse(is.na(Entzug), 0, Entzug),
Verweigerung = ifelse(is.na(Verweigerung), 0, Verweigerung)
) %>%
# remove total rows
filter(Canton != "Total") %>%
# make it tidy
gather("Measure", "Amount", 2:8) %>%
# create factor for ordering in plot
mutate(Measure =
factor(
Measure,
levels =
c(
"Verwarnung",
"Verweis",
"Busse",
"Verweigerung",
"Entzug",
"Verbot_befr",
"Verbot_def"
),
labels =
c(
"Verwarnung",
"Verweis",
"Busse",
"Verweigerung",
"Entzug",
"befr. Verbot",
"def. Verbot"
)
)) %>%
# update: no 'verweigerungen'
filter(Measure != "Verweigerung")Lade die Tabelle mit den Disziplinarmassnahmen (DM) des BAG (NUR HUMANMEDIZINER).
# load bag disciplinary measures data
disciplinary_humanmed <-
read_excel("input/disciplinary_measures/20190117_Disziplinarmassnahmen_humanmed.xlsx", 1, skip = 2) %>%
mutate(Year = 2018) %>%
bind_rows(read_excel("input/disciplinary_measures/20190117_Disziplinarmassnahmen_humanmed.xlsx", 2, skip = 2) %>%
mutate(Year = 2017)) %>%
bind_rows(read_excel("input/disciplinary_measures/20190117_Disziplinarmassnahmen_humanmed.xlsx", 3, skip = 2) %>%
mutate(Year = 2016)) %>%
bind_rows(read_excel("input/disciplinary_measures/20190117_Disziplinarmassnahmen_humanmed.xlsx", 4, skip = 2) %>%
mutate(Year = 2015)) %>%
bind_rows(read_excel("input/disciplinary_measures/20190117_Disziplinarmassnahmen_humanmed.xlsx", 5, skip = 2) %>%
mutate(Year = 2014)) %>%
bind_rows(read_excel("input/disciplinary_measures/20190117_Disziplinarmassnahmen_humanmed.xlsx", 6, skip = 2) %>%
mutate(Year = 2013)) %>%
# dont take the total col, not needed
select(-X__2) %>%
# rename the cols
rename(Canton = X__1,
Verwarnung = a,
Verweis = b,
Busse = c,
Verbot_befr = d,
Verbot_def = e
) %>%
# replace the nas with zeroes
mutate(Verwarnung = ifelse(is.na(Verwarnung), 0, Verwarnung),
Verweis = ifelse(is.na(Verweis), 0, Verweis),
Busse = ifelse(is.na(Busse), 0, Busse),
Verbot_befr = ifelse(is.na(Verbot_befr), 0, Verbot_befr),
Verbot_def = ifelse(is.na(Verbot_def), 0, Verbot_def),
Entzug = ifelse(is.na(Entzug), 0, Entzug),
Verweigerung = ifelse(is.na(Verweigerung), 0, Verweigerung)
) %>%
# remove total rows
filter(Canton != "Total") %>%
# make it tidy
gather("Measure", "Amount", 2:8) %>%
# create factor for ordering in plot
mutate(Measure =
factor(
Measure,
levels =
c(
"Verwarnung",
"Verweis",
"Busse",
"Verweigerung",
"Entzug",
"Verbot_befr",
"Verbot_def"
),
labels =
c(
"Verwarnung",
"Verweis",
"Busse",
"Verweigerung",
"Entzug",
"befr. Verbot",
"def. Verbot"
)
)) %>%
# update: no 'verweigerungen'
filter(Measure != "Verweigerung")Datenanalyse
Absolute totale Anwendung der DM seit 2013
Plotte die absoluten Werte aller Kantone. Weise einmal alle DM einzeln aus, separiere einmal nur weich / hart.
Als weich gelten die folgenden Massnahmen:
Verwarnung
Verweis
Busse bis CHF 20’000
Als hart gelten die folgenden Massnahmen:
Entzug
befristetes Berufsausübungsverbot
unbefristetes Berufsausübungsverbot
# how many times was each measure applied since 2013?
total_applications <- disciplinary %>%
group_by(Measure) %>%
summarise(Total_Amount = sum(Amount))
# assign 'heat' colors
heat_colors <-
c("#2166ac",
"#4393c3",
"#92c5de",
"#f4a582",
"#d6604d",
"#b2182b")
# only_soft_hard 'heat' colors, one color for
# soft measures, one color for hard measures
heat_colors_only_soft_hard <- c("#4393c3", "#d6604d")
# plot absolute dm vals
p_total_applications <-
ggplot(total_applications,
aes(x = Measure, y = Total_Amount, fill = Measure)) +
geom_col(width = 0.8, color = "white") +
scale_fill_manual(values = heat_colors, guide = legend_theme) +
# scale_fill_brewer(palette = "Blues") +
plot_theme_ygrid +
scale_y_continuous(breaks = seq(0, 80, 10)) +
theme(legend.position = "none") +
geom_text(aes(label = Total_Amount, y = Total_Amount + 3),
color = "#4d4d4d") +
labs(x = NULL, y = NULL, fill = "Massnahme",
title = "Schweizweite Anwendung der Disziplinarmassnahmen",
subtitle = "2013 - 4.12.2018")
p_total_applications
# plot the same for soft / hard measures
total_applications_soft_hard <- disciplinary %>%
mutate(Measure = ifelse(
Measure %in% c("Verwarnung", "Verweis", "Busse"),
"weich",
ifelse(
Measure %in% c("Entzug", "befr. Verbot", "def. Verbot"),
"hart",
""
)
)) %>%
group_by(Measure) %>%
summarise(Total_Amount = sum(Amount))
# plot soft / hard absolute
p_total_applications_soft_hard <-
ggplot(total_applications_soft_hard,
aes(x = reorder(Measure, -Total_Amount), y = Total_Amount,
fill = Measure)) +
geom_col(width = 0.8, color = "white") +
scale_fill_manual(values = rev(heat_colors_only_soft_hard),
guide = legend_theme) +
plot_theme_ygrid +
scale_y_continuous(breaks = seq(0, 160, 10)) +
theme(legend.position = "none") +
geom_text(aes(label = Total_Amount, y = Total_Amount + 3),
color = "#4d4d4d") +
labs(x = NULL, y = NULL, fill = "Massnahme",
title = "Schweizweite Anwendung der Disziplinarmassnahmen",
subtitle = "2013 - 4.12.2018")
p_total_applications_soft_hard
# clean up
rm(total_applications_soft_hard,
p_total_applications_soft_hard,
p_total_applications)Absolute kantonale Anwendung der DM
Plotte die absoluten Werte auf Kantonsebene. Einmal alle DM separiert, einmal nur weich / hart.
# plot absolute values of cantonal measure application
# only_soft_hard = only soft or hard measures vs all measures
plot_measure_absolute <- function(only_soft_hard) {
# count how many times each measure was applied per canton
# (since 2013)
if (only_soft_hard) {
cantonal_measure_amounts <- disciplinary %>%
mutate(Measure = ifelse(
Measure %in% c("Verwarnung", "Verweis", "Busse"),
"weich",
ifelse(
Measure %in% c("Entzug", "befr. Verbot", "def. Verbot"),
"hart",
""
)
)) %>%
group_by(Canton, Measure) %>%
summarise(Total_Amount = sum(Amount))
# set colors for only_soft_hard
cols <- heat_colors_only_soft_hard
} else {
cantonal_measure_amounts <- disciplinary %>%
group_by(Canton, Measure) %>%
summarise(Total_Amount = sum(Amount))
# reverse factor ordering
cantonal_measure_amounts$Measure <-
fct_rev(cantonal_measure_amounts$Measure)
# set colors for all dms
cols <- heat_colors
}
# calc the totals of all measures per canton
canton_totals <- cantonal_measure_amounts %>%
group_by(Canton) %>%
summarise(Total_Canton_Amount = sum(Total_Amount))
# join together with the cantonal totals
cantonal_measure_amounts <- cantonal_measure_amounts %>%
left_join(canton_totals, by = c("Canton"))
# plot absolute dm values, cantonal
p_discliplinary <-
ggplot(
cantonal_measure_amounts,
aes(
x = reorder(Canton, Total_Amount),
y = Total_Amount,
fill = Measure,
text = paste0(Canton, ": <b>", Measure, "</b><br>", Total_Amount)
)
) +
geom_col(position = "stack", width = 1, color = "white") +
coord_flip() +
scale_y_continuous(breaks = seq(0, 55, 5)) +
geom_text(aes(label = ifelse(Total_Amount > 0, Total_Amount, "")),
position = position_stack(vjust = 0.5), color = "white",
size = 3) +
scale_fill_manual(values = rev(cols), guide = legend_theme_rev) +
plot_theme +
# only print when measure = verwarnung to print it only
# once, and not 6 times
geom_text(aes(y = 0, label = ifelse(Total_Canton_Amount == 0 & Measure
%in% c("Verwarnung", "weich"),
"keine DM", "")),
color = "#4d4d4d",
size = 3, hjust = 0) +
theme(legend.position = "bottom") +
labs(
x = NULL,
y = NULL,
fill = "Massnahme",
title = "Kantonale Aufteilung der Disziplinarmassnahmen, absolut",
subtitle = "2013 - 4.12.2018"
)
return(p_discliplinary)
}
# draw graph with detailed info of the dms
plot_measure_absolute(F)
# draw graph with only_soft_hard dm info soft / hard
plot_measure_absolute(T)
Relative kantonale Anwendung der DM
Setze die Werte der einzelnen DM mit der Anzahl an aktiven BAB ins Verhältnis. Einmal alle DMs separiert, einmal nur weich / hart.
# function to draw the disciplinary measures relative to the
# amount of licenses, once with the specific dm, once only
# differing soft v. hard measures (argument 'only_soft_hard')
plot_measure_relative <- function(only_soft_hard) {
# count how many times each measure was applied per canton
# (since 2013)
if (only_soft_hard) {
cantonal_measure_amounts <- disciplinary %>%
mutate(Measure = ifelse(
Measure %in% c("Verwarnung", "Verweis", "Busse"),
"weich",
ifelse(
Measure %in% c("Entzug", "befr. Verbot", "def. Verbot"),
"hart",
""
)
)) %>%
group_by(Canton, Measure) %>%
summarise(Total_Amount = sum(Amount))
# set colors for only_soft_hard
cols <- heat_colors_only_soft_hard
} else {
cantonal_measure_amounts <- disciplinary %>%
group_by(Canton, Measure) %>%
summarise(Total_Amount = sum(Amount))
# reverse factor ordering
cantonal_measure_amounts$Measure <-
fct_rev(cantonal_measure_amounts$Measure)
# set colors for all dms
cols <- heat_colors
}
# calc the totals of all measures per canton
canton_totals <- cantonal_measure_amounts %>%
group_by(Canton) %>%
summarise(Total_Canton_Amount = sum(Total_Amount))
# join together with the cantonal totals
cantonal_measure_amounts <- cantonal_measure_amounts %>%
left_join(canton_totals, by = c("Canton"))
# calc the ratios in comparison to the total amount
# of licenses of all med persons (2018)
# get the long canton names
cantonal_measure_amounts <- cantonal_measure_amounts %>%
mutate(Canton_Long = get_canton_name(Canton))
# join together with the amount of active cantonal licenses
# per person and canton (if one person has more then one canton's
# license, she/he is counted multiple times)
cantonal_measure_amounts <- cantonal_measure_amounts %>%
left_join(active_2016_licensed_persons_cantons,
by = c("Canton_Long" = "Bewilligungskanton")) %>%
# calc percent of all licenses
mutate(Amount_per_License = (Total_Amount / license_amount))
# plot it
p_discliplinary_per_license <-
ggplot(
cantonal_measure_amounts,
aes(
x = reorder(Canton, Amount_per_License),
y = Amount_per_License,
fill = Measure)
) +
geom_col(position = "stack", width = 1, color = "white") +
coord_flip() +
geom_text(aes(label = ifelse(
Amount_per_License > 0.0007, paste0(round(Amount_per_License * 100, 2),
"%"), ""
)),
position = position_stack(vjust = 0.5),
color = "white",
size = 3
) +
geom_text(aes(y = (Total_Canton_Amount / license_amount) + 0.00025,
# only when verwarnung/weich: to print it only once
label = ifelse(Measure %in% c("Verwarnung", "weich"),
paste0(license_amount, " Liz / ",
Total_Canton_Amount, " DM"), "")),
color = "#4d4d4d",
size = 3, hjust = 0) +
scale_fill_manual(
values = rev(cols),
guide = legend_theme_rev
) +
scale_y_continuous(
labels = percent,
limits = c(0, 0.016),
breaks = seq(0, 0.016, 0.002)
) +
plot_theme +
theme(legend.position = "bottom") +
labs(
x = NULL,
y = NULL,
fill = "Massnahme",
title =
"Disziplinarmassnahmen im Verhältnis zu aktiven Lizenzen
(2013 - 4.12.2018)",
subtitle =
"Aktive Lizenzen aller kant. Medizinalpersonen, Stand 31.12.2016"
)
return(p_discliplinary_per_license)
}
# draw graph with detailed info of the dms
plot_measure_relative(F)
# draw graph with only_soft_hard dm info soft / hard
plot_measure_relative(T)
# clean up
rm(
total_applications
)Kantonaler Anwendungsanteil der versch. DM
Plotte die prozentualen Anteile der verschiedenen DM innerhalb der Kantone, immer auf 100% aufgeschlüsselt.
# calculate how big the usage share of each
# different dm is within the cantons
measure_frequencies <- disciplinary %>%
group_by(Canton, Measure) %>%
summarise(total_amount = sum(Amount)) %>%
mutate(freq = total_amount / sum(total_amount),
freq = ifelse(is.na(freq), 0, freq))
# get the dm total usage amount and active licenses
# per canton to later display it on the graph
measure_totals <- measure_frequencies %>%
group_by(Canton) %>%
summarise(tot = sum(total_amount)) %>%
mutate(Canton_Long = get_canton_name(Canton)) %>%
# join to get the amount of active licenses
left_join(active_2016_licensed_persons_cantons,
by = c("Canton_Long" = "Bewilligungskanton"))
# join with the total amount of easch dm's usage
# to display this number of the graph
measure_frequencies <- measure_frequencies %>%
left_join(measure_totals, by = c("Canton"))
# plot the cantonal usage shares of each dm for the
# cantons with more than 1000 licenses
# display only the cantons with > 1000 active licenses
plot_data <- measure_frequencies %>%
filter(license_amount > 1000)
# take only the total of cantons with > 1000 lic.
plot_data_measure_totals <- measure_totals %>%
filter(license_amount > 1000)
# plot
p_measure_frequencies <- ggplot(plot_data,
aes(x = reorder(Canton, license_amount),
y = freq,
fill = forcats::fct_rev(Measure))) +
geom_col(position = "stack", width = 1, color = "white") +
coord_flip() +
geom_text(aes(label = ifelse(freq > 0, paste0(
round(freq * 100, 0), "%"
), "")),
position = position_stack(vjust = 0.5),
color = "white") +
geom_text(data = plot_data_measure_totals,
aes(x = Canton, y = 1.08,
label = paste0(tot, " DM", " / ", license_amount, " Liz."),
fill = NULL),
size = 3, color = "#4d4d4d") +
scale_fill_manual(values = rev(heat_colors), guide = legend_theme_rev) +
plot_theme +
scale_y_continuous(labels = percent,
breaks = seq(0, 1, 0.2), limits = c(0, 1.1)) +
labs(x = NULL, y = NULL, fill = NULL,
title = paste0("Aufteilung der verhängten Disziplinarmassnahmen ",
"(Kantone mit > 1000 Lizenzen)"),
subtitle = "2013 - 2018 (4. Dez), sortiert nach kantonaler Anzahl
Lizenzen der Medizinalpersonen")
# draw graph for cantons with > 1000 licenses
p_measure_frequencies
Kantonaler Anwendungsanteil der DM, weich/hart
Das gleiche nochmals, nur hier aber ohne die Unterscheidung der einzelnen Massnahmen, sondern nur noch die Unterscheidung in weiche / harte Massnahmen.
# calculate how big the usage share of each
# different dm is within the cantons. separate
# only soft and hard shares
measure_frequencies <- disciplinary %>%
mutate(Measure = ifelse(
Measure %in% c("Verwarnung", "Verweis", "Busse"),
"weich",
ifelse(
Measure %in% c("Entzug", "befr. Verbot", "def. Verbot"),
"hart",
""
)
)) %>%
group_by(Canton, Measure) %>%
summarise(total_amount = sum(Amount)) %>%
mutate(freq = total_amount / sum(total_amount),
freq = ifelse(is.na(freq), 0, freq))
# get the total of measures and licenses per
# canton to later display it on the graph
measure_totals <- measure_frequencies %>%
group_by(Canton) %>%
summarise(tot = sum(total_amount)) %>%
mutate(Canton_Long = get_canton_name(Canton)) %>%
left_join(active_2016_licensed_persons_cantons,
by = c("Canton_Long" = "Bewilligungskanton"))
# join with the total amount usage of soft / hard3
# dms to display this number of the graph
measure_frequencies <- measure_frequencies %>%
left_join(measure_totals, by = c("Canton"))
# plot the measure freuqncies for
# the ones with over 1000 licenses
# set data for plot
plot_data <- measure_frequencies
plot_data_measure_totals <- measure_totals
# only the cantons with > 1000 active licenses should
# be displayed
# take only cantons with > 1000 licenses
plot_data <- measure_frequencies %>%
filter(license_amount > 1000)
# take only the total of cantons with > 1000 lic.
plot_data_measure_totals <- measure_totals %>%
filter(license_amount > 1000)
# plot
p_measure_frequencies <- ggplot(plot_data, aes(x = reorder(Canton,
license_amount),
y = freq,
fill = Measure)) +
geom_col(position = "stack", width = 1, color = "white") +
coord_flip() +
geom_text(aes(label = ifelse(freq > 0, paste0(round(freq * 100, 0), "%"),
"")),
position = position_stack(vjust = 0.5), color = "white") +
geom_text(data = plot_data_measure_totals,
aes(x = Canton, y = 1.08,
label = paste0(tot, " DM", " / ", license_amount, " Liz."),
fill = NULL),
size = 3, color = "#4d4d4d") +
scale_fill_manual(values = rev(heat_colors_only_soft_hard),
guide = legend_theme_rev) +
plot_theme +
scale_y_continuous(labels = percent,
breaks = seq(0, 1, 0.2), limits = c(0, 1.1)) +
labs(x = NULL, y = NULL, fill = NULL,
title = paste0("Aufteilung der verhängten Disziplinarmassnahmen ",
"(Kantone mit > 1000 Lizenzen)"),
subtitle = "2013 - 2018 (4. Dez), sortiert nach kantonaler Anzahl
Lizenzen der Medizinalpersonen")
# draw graph for cantons with > 1000 licenses
p_measure_frequencies
# clean up
rm(measure_totals, measure_frequencies,
active_2016_licensed_persons_cantons)Datenanalyse (NUR HUMANMEDIZINER)
Absolute totale Anwendung der DM seit 2013, NUR HUMANMEDIZINER.
Plotte die absoluten Werte aller Kantone. Weise einmal alle DM einzeln aus, separiere einmal nur weich / hart.
Als weich gelten die folgenden Massnahmen:
Verwarnung
Verweis
Busse bis CHF 20’000
Als hart gelten die folgenden Massnahmen:
Entzug
befristetes Berufsausübungsverbot
unbefristetes Berufsausübungsverbot
# how many times was each measure applied since 2013?
total_applications <- disciplinary_humanmed %>%
group_by(Measure) %>%
summarise(Total_Amount = sum(Amount))
# assign 'heat' colors
heat_colors <-
c("#2166ac",
"#4393c3",
"#92c5de",
"#f4a582",
"#d6604d",
"#b2182b")
# only_soft_hard 'heat' colors, one color for
# soft measures, one color for hard measures
heat_colors_only_soft_hard <- c("#4393c3", "#d6604d")
# plot absolute dm vals
p_total_applications <-
ggplot(total_applications,
aes(x = Measure, y = Total_Amount, fill = Measure)) +
geom_col(width = 0.8, color = "white") +
scale_fill_manual(values = heat_colors, guide = legend_theme) +
# scale_fill_brewer(palette = "Blues") +
plot_theme_ygrid +
scale_y_continuous(breaks = seq(0, 80, 10)) +
theme(legend.position = "none") +
geom_text(aes(label = Total_Amount, y = Total_Amount + 3),
color = "#4d4d4d") +
labs(x = NULL, y = NULL, fill = "Massnahme",
title = "Schweizweite Anwendung der Disziplinarmassnahmen",
subtitle = "2013 - 2018, nur Humanmediziner")
p_total_applications
# plot the same for soft / hard measures
total_applications_soft_hard <- disciplinary_humanmed %>%
mutate(Measure = ifelse(
Measure %in% c("Verwarnung", "Verweis", "Busse"),
"weich",
ifelse(
Measure %in% c("Entzug", "befr. Verbot", "def. Verbot"),
"hart",
""
)
)) %>%
group_by(Measure) %>%
summarise(Total_Amount = sum(Amount))
# plot soft / hard absolute
p_total_applications_soft_hard <-
ggplot(total_applications_soft_hard,
aes(x = reorder(Measure, -Total_Amount), y = Total_Amount,
fill = Measure)) +
geom_col(width = 0.8, color = "white") +
scale_fill_manual(values = rev(heat_colors_only_soft_hard),
guide = legend_theme) +
plot_theme_ygrid +
scale_y_continuous(breaks = seq(0, 160, 10)) +
theme(legend.position = "none") +
geom_text(aes(label = Total_Amount, y = Total_Amount + 3),
color = "#4d4d4d") +
labs(x = NULL, y = NULL, fill = "Massnahme",
title = "Schweizweite Anwendung der Disziplinarmassnahmen",
subtitle = "2013 - 2018, nur Humanmediziner")
p_total_applications_soft_hard
# clean up
rm(total_applications_soft_hard,
p_total_applications_soft_hard,
p_total_applications)Absolute kantonale Anwendung der DM (NUR HUMANMEDIZINER)
Plotte die absoluten Werte auf Kantonsebene. Einmal alle DM separiert, einmal nur weich / hart.
# plot absolute values of cantonal measure application
# only_soft_hard = only soft or hard measures vs all measures
plot_measure_absolute <- function(only_soft_hard) {
# count how many times each measure was applied per canton
# (since 2013)
if (only_soft_hard) {
cantonal_measure_amounts <- disciplinary_humanmed %>%
mutate(Measure = ifelse(
Measure %in% c("Verwarnung", "Verweis", "Busse"),
"weich",
ifelse(
Measure %in% c("Entzug", "befr. Verbot", "def. Verbot"),
"hart",
""
)
)) %>%
group_by(Canton, Measure) %>%
summarise(Total_Amount = sum(Amount))
# set colors for only_soft_hard
cols <- heat_colors_only_soft_hard
} else {
cantonal_measure_amounts <- disciplinary_humanmed %>%
group_by(Canton, Measure) %>%
summarise(Total_Amount = sum(Amount))
# reverse factor ordering
cantonal_measure_amounts$Measure <-
fct_rev(cantonal_measure_amounts$Measure)
# set colors for all dms
cols <- heat_colors
}
# calc the totals of all measures per canton
canton_totals <- cantonal_measure_amounts %>%
group_by(Canton) %>%
summarise(Total_Canton_Amount = sum(Total_Amount))
# join together with the cantonal totals
cantonal_measure_amounts <- cantonal_measure_amounts %>%
left_join(canton_totals, by = c("Canton"))
# plot absolute dm values, cantonal
p_discliplinary <-
ggplot(
cantonal_measure_amounts,
aes(
x = reorder(Canton, Total_Amount),
y = Total_Amount,
fill = Measure,
text = paste0(Canton, ": <b>", Measure, "</b><br>", Total_Amount)
)
) +
geom_col(position = "stack", width = 1, color = "white") +
coord_flip() +
scale_y_continuous(breaks = seq(0, 55, 5)) +
geom_text(aes(label = ifelse(Total_Amount > 0, Total_Amount, "")),
position = position_stack(vjust = 0.5), color = "white",
size = 3) +
scale_fill_manual(values = rev(cols), guide = legend_theme_rev) +
plot_theme +
# only print when measure = verwarnung to print it only
# once, and not 6 times
geom_text(aes(y = 0, label = ifelse(Total_Canton_Amount == 0 & Measure
%in% c("Verwarnung", "weich"),
"keine DM", "")),
color = "#4d4d4d",
size = 3, hjust = 0) +
theme(legend.position = "bottom") +
labs(
x = NULL,
y = NULL,
fill = "Massnahme",
title = "Kantonale Aufteilung der Disziplinarmassnahmen, absolut",
subtitle = "2013 - 2018, nur Humanmediziner"
)
return(p_discliplinary)
}
# draw graph with detailed info of the dms
plot_measure_absolute(F)
# draw graph with only_soft_hard dm info soft / hard
plot_measure_absolute(T)
Relative kantonale Anwendung der DM (NUR HUMANMEDIZINER)
Setze die Werte der einzelnen DM mit der Anzahl an aktiven BAB (DER HUMANMEDIZINER) ins Verhältnis. Einmal alle DMs separiert, einmal nur weich / hart.
# function to draw the disciplinary human med measures relative to the
# amount of licenses, once with the specific dm, once only
# differing soft v. hard measures (argument 'only_soft_hard')
plot_measure_relative <- function(only_soft_hard) {
# count how many times each measure was applied per canton
# (since 2013)
if (only_soft_hard) {
cantonal_measure_amounts <- disciplinary_humanmed %>%
mutate(Measure = ifelse(
Measure %in% c("Verwarnung", "Verweis", "Busse"),
"weich",
ifelse(
Measure %in% c("Entzug", "befr. Verbot", "def. Verbot"),
"hart",
""
)
)) %>%
group_by(Canton, Measure) %>%
summarise(Total_Amount = sum(Amount))
# set colors for only_soft_hard
cols <- heat_colors_only_soft_hard
} else {
cantonal_measure_amounts <- disciplinary_humanmed %>%
group_by(Canton, Measure) %>%
summarise(Total_Amount = sum(Amount))
# reverse factor ordering
cantonal_measure_amounts$Measure <-
fct_rev(cantonal_measure_amounts$Measure)
# set colors for all dms
cols <- heat_colors
}
# calc the totals of all measures per canton
canton_totals <- cantonal_measure_amounts %>%
group_by(Canton) %>%
summarise(Total_Canton_Amount = sum(Total_Amount))
# join together with the cantonal totals
cantonal_measure_amounts <- cantonal_measure_amounts %>%
left_join(canton_totals, by = c("Canton"))
# calc the ratios in comparison to the total amount
# of licenses of all human med persons (2018)
# get the long canton names
cantonal_measure_amounts <- cantonal_measure_amounts %>%
mutate(Canton_Long = get_canton_name(Canton))
# join together with the amount of active cantonal licenses of HUMAN DOCS
# per person and canton (if one person has more then one canton's
# license, she/he is counted multiple times)
cantonal_measure_amounts <- cantonal_measure_amounts %>%
left_join(active_2016_licensed_humandocs_cantons,
by = c("Canton_Long" = "Bewilligungskanton")) %>%
# calc percent of all licenses
mutate(Amount_per_License = (Total_Amount / license_amount))
# plot it
p_discliplinary_per_license <-
ggplot(
cantonal_measure_amounts,
aes(
x = reorder(Canton, Amount_per_License),
y = Amount_per_License,
fill = Measure)
) +
geom_col(position = "stack", width = 1, color = "white") +
coord_flip() +
geom_text(aes(label = ifelse(
Amount_per_License > 0.0007, paste0(round(Amount_per_License * 100, 2),
"%"), ""
)),
position = position_stack(vjust = 0.5),
color = "white",
size = 3
) +
geom_text(aes(y = (Total_Canton_Amount / license_amount) + 0.00025,
# only when verwarnung/weich: to print it only once
label = ifelse(Measure %in% c("Verwarnung", "weich"),
paste0(license_amount, " Liz / ",
Total_Canton_Amount, " DM"), "")),
color = "#4d4d4d",
size = 3, hjust = 0) +
scale_fill_manual(
values = rev(cols),
guide = legend_theme_rev
) +
scale_y_continuous(
labels = percent,
limits = c(0, 0.02),
breaks = seq(0, 0.02, 0.002)
) +
plot_theme +
theme(legend.position = "bottom") +
labs(
x = NULL,
y = NULL,
fill = "Massnahme",
title =
"Disziplinarmassnahmen im Verhältnis zu aktiven Lizenzen
2013-2018, nur Humanmediziner",
subtitle =
"Aktive Lizenzen der Humanmediziner, Stand 31.12.2016"
)
return(p_discliplinary_per_license)
}
# draw graph with detailed info of the dms
plot_measure_relative(F)
# draw graph with only_soft_hard dm info soft / hard
plot_measure_relative(T)
# clean up
rm(
total_applications
)Kantonaler Anwendungsanteil der versch. DM (NUR HUMANMEDIZINER)
Plotte die prozentualen Anteile der verschiedenen DM innerhalb der Kantone, immer auf 100% aufgeschlüsselt.
# calculate how big the usage share of each
# different dm is within the cantons
measure_frequencies <- disciplinary_humanmed %>%
group_by(Canton, Measure) %>%
summarise(total_amount = sum(Amount)) %>%
mutate(freq = total_amount / sum(total_amount),
freq = ifelse(is.na(freq), 0, freq))
# get the dm total usage amount and active licenses
# per canton to later display it on the graph
measure_totals <- measure_frequencies %>%
group_by(Canton) %>%
summarise(tot = sum(total_amount)) %>%
mutate(Canton_Long = get_canton_name(Canton)) %>%
# join to get the amount of active licenses
left_join(active_2016_licensed_humandocs_cantons,
by = c("Canton_Long" = "Bewilligungskanton"))
# join with the total amount of easch dm's usage
# to display this number of the graph
measure_frequencies <- measure_frequencies %>%
left_join(measure_totals, by = c("Canton"))
# plot the cantonal usage shares of each dm for the
# cantons with more than 1000 licenses
# display only the cantons with > 1000 active licenses
plot_data <- measure_frequencies %>%
filter(license_amount > 1000)
# take only the total of cantons with > 1000 lic.
plot_data_measure_totals <- measure_totals %>%
filter(license_amount > 1000)
# plot
p_measure_frequencies <- ggplot(plot_data,
aes(x = reorder(Canton, license_amount),
y = freq,
fill = forcats::fct_rev(Measure))) +
geom_col(position = "stack", width = 1, color = "white") +
coord_flip() +
geom_text(aes(label = ifelse(freq > 0, paste0(
round(freq * 100, 0), "%"
), "")),
position = position_stack(vjust = 0.5),
color = "white") +
geom_text(data = plot_data_measure_totals,
aes(x = Canton, y = 1.08,
label = paste0(tot, " DM", " / ", license_amount, " Liz."),
fill = NULL),
size = 3, color = "#4d4d4d") +
scale_fill_manual(values = rev(heat_colors), guide = legend_theme_rev) +
plot_theme +
scale_y_continuous(labels = percent,
breaks = seq(0, 1, 0.2), limits = c(0, 1.1)) +
labs(x = NULL, y = NULL, fill = NULL,
title = paste0("Aufteilung der verhängten Disziplinarmassnahmen",
"(Kantone mit > 1000 Lizenzen) - nur Humanmediziner"),
subtitle = "2013 - 2018, sortiert nach kantonaler Anzahl
Lizenzen der Humanmediziner")
# draw graph for cantons with > 1000 licenses
p_measure_frequencies
Kantonaler Anwendungsanteil der DM, weich/hart (NUR HUMANMEDIZINER)
Das gleiche nochmals, nur hier aber ohne die Unterscheidung der einzelnen Massnahmen, sondern nur noch die Unterscheidung in weiche / harte Massnahmen.
# calculate how big the usage share of each
# different dm is within the cantons. separate
# only soft and hard shares
measure_frequencies <- disciplinary_humanmed %>%
mutate(Measure = ifelse(
Measure %in% c("Verwarnung", "Verweis", "Busse"),
"weich",
ifelse(
Measure %in% c("Entzug", "befr. Verbot", "def. Verbot"),
"hart",
""
)
)) %>%
group_by(Canton, Measure) %>%
summarise(total_amount = sum(Amount)) %>%
mutate(freq = total_amount / sum(total_amount),
freq = ifelse(is.na(freq), 0, freq))
# get the total of measures and licenses per
# canton to later display it on the graph
measure_totals <- measure_frequencies %>%
group_by(Canton) %>%
summarise(tot = sum(total_amount)) %>%
mutate(Canton_Long = get_canton_name(Canton)) %>%
left_join(active_2016_licensed_humandocs_cantons,
by = c("Canton_Long" = "Bewilligungskanton"))
# join with the total amount usage of soft / hard3
# dms to display this number of the graph
measure_frequencies <- measure_frequencies %>%
left_join(measure_totals, by = c("Canton"))
# plot the measure freuqncies for
# the ones with over 1000 licenses
# set data for plot
plot_data <- measure_frequencies
plot_data_measure_totals <- measure_totals
# only the cantons with > 1000 active licenses should
# be displayed
# take only cantons with > 1000 licenses
plot_data <- measure_frequencies %>%
filter(license_amount > 1000)
# take only the total of cantons with > 1000 lic.
plot_data_measure_totals <- measure_totals %>%
filter(license_amount > 1000)
# plot
p_measure_frequencies <- ggplot(plot_data, aes(x = reorder(Canton,
license_amount),
y = freq,
fill = Measure)) +
geom_col(position = "stack", width = 1, color = "white") +
coord_flip() +
geom_text(aes(label = ifelse(freq > 0, paste0(round(freq * 100, 0), "%"),
"")),
position = position_stack(vjust = 0.5), color = "white") +
geom_text(data = plot_data_measure_totals,
aes(x = Canton, y = 1.08,
label = paste0(tot, " DM", " / ", license_amount, " Liz."),
fill = NULL),
size = 3, color = "#4d4d4d") +
scale_fill_manual(values = rev(heat_colors_only_soft_hard),
guide = legend_theme_rev) +
plot_theme +
scale_y_continuous(labels = percent,
breaks = seq(0, 1, 0.2), limits = c(0, 1.1)) +
labs(x = NULL, y = NULL, fill = NULL,
title = paste0("Aufteilung der verhängten Disziplinarmassnahmen ",
"(Kantone mit > 1000 Lizenzen) - nur Humanmediziner"),
subtitle = "2013 - 2018, sortiert nach kantonaler Anzahl
Lizenzen der Humanmediziner")
# draw graph for cantons with > 1000 licenses
p_measure_frequencies
# clean up
rm(measure_totals, measure_frequencies,
active_2016_licensed_humandocs_cantons)Linting
Der Code in diesem RMarkdown wird mit lintr automatisch auf den Wickham’schen tidyverse style guide überprüft.
lintr::lint(
"main.Rmd",
linters =
lintr::with_defaults(
commented_code_linter = NULL,
trailing_whitespace_linter = NULL
)
)## Warning in readLines(filename): incomplete final line found on 'main.Rmd'## Warning in readLines(file): incomplete final line found on 'main.Rmd'## main.Rmd:349:1: style: lines should not be more than 80 characters.
## read_excel("input/disciplinary_measures/active_licenses/Rohdaten Aktive BAB CHIRO.xlsx", 2) %>%
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:351:1: style: lines should not be more than 80 characters.
## read_excel("input/disciplinary_measures/active_licenses/Rohdaten Aktive BAB DENT.xlsx", 2) %>%
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:353:27: style: Variable and function names should be all lowercase.
## as.numeric(JahrGleichwertigkeitDiplom))
## ^~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:356:1: style: lines should not be more than 80 characters.
## read_excel("input/disciplinary_measures/active_licenses/Rohdaten Aktive BAB MED GVSP.xlsx", 2) %>%
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:358:27: style: Variable and function names should be all lowercase.
## as.numeric(JahrGleichwertigkeitDiplom))
## ^~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:361:1: style: lines should not be more than 80 characters.
## read_excel("input/disciplinary_measures/active_licenses/Rohdaten Aktive BAB PHARM.xlsx", 2) %>%
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:363:27: style: Variable and function names should be all lowercase.
## as.numeric(JahrGleichwertigkeitDiplom))
## ^~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:366:1: style: lines should not be more than 80 characters.
## read_excel("input/disciplinary_measures/active_licenses/Rohdaten Aktive BAB VET.xlsx", 2) %>%
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:368:27: style: Variable and function names should be all lowercase.
## as.numeric(JahrGleichwertigkeitDiplom))
## ^~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:383:1: style: Variable and function names should not be longer than 30 characters.
## active_2016_licensed_persons_cantons <- active_2016 %>%
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:393:5: style: Variable and function names should not be longer than 30 characters.
## sum(active_2016_licensed_persons_cantons$license_amount)
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:397:1: style: Variable and function names should not be longer than 30 characters.
## active_2016_licensed_humandocs_cantons <- active_2016 %>%
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:416:1: style: lines should not be more than 80 characters.
## read_excel("input/disciplinary_measures/Disziplinarmassnahmen.xlsx", 1, skip = 2) %>%
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:418:1: style: lines should not be more than 80 characters.
## bind_rows(read_excel("input/disciplinary_measures/Disziplinarmassnahmen.xlsx", 2, skip = 2) %>%
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:420:1: style: lines should not be more than 80 characters.
## bind_rows(read_excel("input/disciplinary_measures/Disziplinarmassnahmen.xlsx", 3, skip = 2) %>%
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:422:1: style: lines should not be more than 80 characters.
## bind_rows(read_excel("input/disciplinary_measures/Disziplinarmassnahmen.xlsx", 4, skip = 2) %>%
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:424:1: style: lines should not be more than 80 characters.
## bind_rows(read_excel("input/disciplinary_measures/Disziplinarmassnahmen.xlsx", 5, skip = 2) %>%
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:426:1: style: lines should not be more than 80 characters.
## bind_rows(read_excel("input/disciplinary_measures/Disziplinarmassnahmen.xlsx", 6, skip = 2) %>%
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:488:1: style: lines should not be more than 80 characters.
## read_excel("input/disciplinary_measures/20190117_Disziplinarmassnahmen_humanmed.xlsx", 1, skip = 2) %>%
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:490:1: style: lines should not be more than 80 characters.
## bind_rows(read_excel("input/disciplinary_measures/20190117_Disziplinarmassnahmen_humanmed.xlsx", 2, skip = 2) %>%
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:492:1: style: lines should not be more than 80 characters.
## bind_rows(read_excel("input/disciplinary_measures/20190117_Disziplinarmassnahmen_humanmed.xlsx", 3, skip = 2) %>%
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:494:1: style: lines should not be more than 80 characters.
## bind_rows(read_excel("input/disciplinary_measures/20190117_Disziplinarmassnahmen_humanmed.xlsx", 4, skip = 2) %>%
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:496:1: style: lines should not be more than 80 characters.
## bind_rows(read_excel("input/disciplinary_measures/20190117_Disziplinarmassnahmen_humanmed.xlsx", 5, skip = 2) %>%
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:498:1: style: lines should not be more than 80 characters.
## bind_rows(read_excel("input/disciplinary_measures/20190117_Disziplinarmassnahmen_humanmed.xlsx", 6, skip = 2) %>%
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:815:15: style: Variable and function names should not be longer than 30 characters.
## left_join(active_2016_licensed_persons_cantons,
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:906:13: style: Variable and function names should not be longer than 30 characters.
## left_join(active_2016_licensed_persons_cantons,
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:989:13: style: Variable and function names should not be longer than 30 characters.
## left_join(active_2016_licensed_persons_cantons,
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:1045:4: style: Variable and function names should not be longer than 30 characters.
## active_2016_licensed_persons_cantons)
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:1313:15: style: Variable and function names should not be longer than 30 characters.
## left_join(active_2016_licensed_humandocs_cantons,
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:1404:13: style: Variable and function names should not be longer than 30 characters.
## left_join(active_2016_licensed_humandocs_cantons,
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:1487:13: style: Variable and function names should not be longer than 30 characters.
## left_join(active_2016_licensed_humandocs_cantons,
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## main.Rmd:1543:4: style: Variable and function names should not be longer than 30 characters.
## active_2016_licensed_humandocs_cantons)
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~