Du hattest ja vorgehabt, eine Liste von Topics, nach denen der Text durchsucht werden sollte, vorzugeben und den Inhalt eines Topics bis zum Beginn des nächsten auszulesen.
Dieses Vorgehen hat zwei wesentliche Nachteile: zum einen gibt es sehr menschliche Varianten der Schreibweisen, die bei einer "einfachen" Textsuche dazu führen würde, dass viele Stellen nicht entdeckt werden.
Zum anderen würden von Dir nicht vorgegebene Topics zusammen mit dem Text des letzten gefundenen Topic extrahiert und so dessen Inhalt "belasten"!
Ich habe daher einen Vorlauf eingefügt, in dem erstmal alle Textstellen mit "Topicverdacht" in eine Excel-Datei geschrieben werden. In dieser Datei kannst Du dann neben jeden Eintrag Deine "Übersetzung" (so eine Art Norm-Topic) schreiben. Kein Eintrag bedeutet: kein Topic, sieht nur so aus! Im eigentlichen Suchlauf bilden dann die ursprünglichen Topics das Suchziel, die dann aber mit Deinen "Normtopics" bezeichnet werden. Es ist aber wichtig, dass auch die uninteressanten Topics identifiziert werden, damit sie nicht als Text an andere Topics angehängt werden. Sie werden dann extrahiert, ignorieren kannst Du sie später immer noch
!
Dieses Vorgehen basiert darauf, dass die Datei, die Du zur Verfügung gestellt hast, eine "ordinäre" csv-Datei ist - halt mit einem ziemlich langen Textfeld.
In dem Textfeld steckt steckt der Entlassungsbericht des jeweiligen Patienten - mit allen Formatierungen. Und - das ist zumindest mein Eindruck - eigentlich sollen Topics die Form haben - um es mal mit R-RegEx zu sagen "\\r\\n\\r\\n[ a-zA-Z]+:" - was heißt neue Zeile, Leerzeile, Text aus Buchstaben und Leerzeichen und danach einen Doppelpunkt!
Code: Alles auswählen
library(data.table)
library(openxlsx)
library(stringr)
Basisordner <- "P:/R/R Forum/Diagnose Auswertungen"
texte <- fread(file.path(Basisordner, "DischSumm_example.csv"))
#--- Vorbereitung, Erstellung der Vorlage für Übersetzungstabelle --------
Sammlung <- list()
for (i in 1:nrow(texte)){
Patient <- texte[i, TEXT]
Fundstellen <- data.table(str_locate_all(Patient, pattern="\\r\\n\\r\\n[ a-zA-Z]+:")[[1]])
Fundstellen[ , topic:=str_trim(str_sub(Patient, start + 2, end))]
Fundstellen[ , Patient:=i]
Sammlung[[i]] <- Fundstellen
}
Alles <- rbindlist(Sammlung)
Extrakt <- Alles[ , .N, by=topic]
Extrakt[ , TOPIC:=str_trim(toupper(topic))]
# Rohtopics mit zugehöriger Großschreibung
write.xlsx(Extrakt, file.path(Basisordner, "Rohtopics.xlsx"))
# Topics mit Häufigkeiten bzgl. der Großschreibungs-Variante
zuErgänzen <- Extrakt[ , .(wie.oft=sum(N)), by=TOPIC]
write.xlsx(zuErgänzen, file.path(Basisordner, "TOPICS.xlsx"))
# in dieser Excel-Datei müssen die Übersetzungen (Spaltenname "Übersetzungen" vergeben) hinzugefügt werden!
# Das Ganze wieder unter "TOPICS plus Übersetzungen.xlsx" speichern.
# Bitte auch uninteressante Topics übersetzen: nur echte Falschmeldungen
# erhalten keine Übersetzung!
#-------- Wenn Übersetzungstabelle fertig: -------------------------------
# Falls R zwischendurch beendet:
# Datei "texte" (s.o.) und beteiligte libraries nochmal laden
Extrakt <- data.table(read.xlsx(file.path(Basisordner, "Rohtopics.xlsx")))
setkey(Extrakt, TOPIC)
Transl <- data.table(read.xlsx(file.path(Basisordner, "TOPICS plus Übersetzungen.xlsx")))
setkey(Transl, TOPIC)
Zsamma <- Transl[Extrakt]
verwenden <- Zsamma[!is.na(Übersetzung), .(topic, Übersetzung)]
setkey(verwenden, topic)
#================================================
# Hier wird der reine Text (ohne die Zeilenumbrüche) verwendet!
Muster <- paste(verwenden[ , topic], collapse="|")
Sammlung.2 <- list()
for (i in 1:nrow(texte)){
Patient <- texte[i, TEXT]
Fundstellen <- data.table(str_locate_all(Patient, pattern=Muster)[[1]])
Fundstellen[ , topic:=str_trim(str_sub(Patient, start, end))]
Fundstellen[ , PNr:=i]
setkey(Fundstellen, topic)
FundPlus <- verwenden[Fundstellen]
setorder(FundPlus, start)
Patend <- nchar(Patient)
FundPlus[ , ":="(text_start=end + 1, text_end=c(tail(start, -1) - 1, Patend))]
FundPlus[ , Beschreibung:=str_trim(str_sub(Patient, text_start, text_end))]
Sammlung.2[[i]] <- FundPlus
}
Patientendaten <- rbindlist(Sammlung.2)
!