install.packages("devtools")
devtools::install_github("IPS-LMU/emuR",force=TRUE,build_vignettes=TRUE)


# ALLGEMEINE FRAGEN

#Welche Levels gibt es in der Datenbank kielread?
library(emuR)

#change this to your path
path2kielread = "/Users/reubold/kielread/kielread_emuDB/"
# load emuDB into current R session
kielread = load_emuDB(path2kielread, verbose = FALSE)
list_levelDefinitions(kielread)
#oder umständlicher (weil zu viel Information zurückgegeben wird)
summary(kielread)

#Welche (vier) Wörter sind die häufigsten in der Datenbank kielread?

#Deine    Diese    nicht      und, weil
wordlist=query(kielread,query="Word=~.*",calcTimes = FALSE) #"Word=~.*" = "alle Wörter"
#$labels zeigt nur die labels, table() zählt diese, und sort() sortiert den Table
sort(table(wordlist$labels))

#Fragen Sie die Datenbanken nach den Vokalen in den betonten Silben dieser Wörter ab!
list_levelDefinitions(kielread)
#es gibt ein level Syllable, aber:
unique(query(kielread,query="Syllable=~.*")$labels) #zeigt nur ein Label, nämlich "S" (wie "Syllable", nicht wie "strong")
#daher bleibt nichts übrig, als die erwarteten Vokale (also nicht Schwa) zu suchen, wenn diese dominiert sind von den
#gegebenen Wörtern:
Zielvokale = query(kielread,query="[Phonetic==I|i:|aI|U^Word==Deine|Diese|nicht|und]")
#die Frage ist beantwortet! Aber: 
nrow(Zielvokale) #sind aber nur 47, und nicht 4*12

#das hier MUSS jetzt NICHT sein, sondern dient nur der Überprüfung, warum da eines "fehlt":
Zielwörter=query(kielread,query="Word=~Deine|Diese|nicht|und",calcTimes = F)
(Zielphonstrings=requery_hier(kielread,Zielwörter,level = "Phonetic"))
#ein "und" wurde als nur als silbisches [n] realisiert (daher nur 47 statt 48 Vokale):
#6               n 1236.5938 1338.2188    0000 K67MR022 Phonetic SEGMENT
#weitere Probleme, die in der Praxis auftauchen könnten, wären denkbar
#z.B. bei MAuS-Segmentation, wenn MAuS ein anderes Label vergeben hat, als wir erwartet haben.



#Wieviele /k/-Phoneme gibt es in kielread? In welchen Wörtern kommen sie vor?
k=query(kielread,query="Phonetic==k")
nrow(k) #90

kWords=requery_hier(kielread,seglist=k,level="Word",calcTimes = F)$labels
kWords

#Suchen Sie stattdessen die Wörter, die mit /k/ anfangen.

kStart=query(kielread,query="[Phonetic==k & Start(Word,Phonetic)==TRUE]")
kStartWords=requery_hier(kielread,seglist=kStart,level="Word",calcTimes = F)$labels
kStartWords

#Wie sind die Dauern dieser initialen /k/s?
dur(kStart)

#Berechnen und plotten Sie - nach Sprechern getrennt - geglättete F1-Tracks für alle [u:]s aus dieser Datenbank! 
# (die genaue Implementierung der Glättung sei Ihnen überlassen). 
u=query(kielread,query="Phonetic==u:")

u.fdat = get_trackdata(kielread,
                             seglist = u,
                             ssffTrackName =  "FORMANTS",
                             resultType="emuRtrackdata")
u.fdat$bundle # die Zeichen 2 und 3 Kodieren den Sprecher/die Sprecherin (eigentlich reicht das dritte Zeichen;-) )
# benutzt substr() und faktoriere eventuell mit factor()
u.fdat$spkr=factor(substr(u.fdat$bundle,2,3))

u.fdat$smoothed_F1_dct = unlist(aggregate(T1~sl_rowIdx+spkr, data=u.fdat,FUN=dct, m=2, fit=T)$T1)

library(ggplot2)
#wir brauchen smoothed_F1_dct als abhängige Variable (also als "y"),
#spkr für eine Trennung (nach Fraben (col) oder linetype),
#times_rel (die relative Zeit, vom Onset (=0) bis Ende des Lauts) als x; 
#wir brauchen aber (das ist vielleicht am wenigsten intuitiv) auch
#group=sl_rowIdx, so dass pro Vokaltoken eine Linie gezeichnet wird...
ggplot(u.fdat) +
  aes(x=times_rel,group=sl_rowIdx) +
  geom_line(aes(y = smoothed_F1_dct, col = spkr)) +
  ylab("Frequency (Hz)") +
  xlab("Relative time")

#oder
ggplot(u.fdat) +
  aes(x=times_rel,group=sl_rowIdx) +
  geom_line(aes(y = smoothed_F1_dct, linetype = spkr)) +
  ylab("Frequency (Hz)") +
  xlab("Relative time")

#oder:
ggplot(u.fdat) +
  aes(x=times_rel,group=sl_rowIdx) +
  geom_line(aes(y = smoothed_F1_dct)) +
  facet_grid(~spkr) +
  ylab("Frequency (Hz)") +
  xlab("Relative time")




#####################################################################################################
#####################################################################################################
#####################################################################################################
#####################################################################################################
#####################################################################################################
#####################################################################################################
#####################################################################################################
#####################################################################################################
##################################INTERMISSION#######################################################
#####################################################################################################
#####################################################################################################
#####################################################################################################
#####################################################################################################
#####################################################################################################
#####################################################################################################
#####################################################################################################
#####################################################################################################
#####################################################################################################
#####################################################################################################
#####################################################################################################
# ema 5 ist hier erhältlich: http://www.phonetik.uni-muenchen.de/~jmh/lehre/sem/ws1718/ema5_emuDB.zip

#change this to your path
path2ema5 = "/Users/reubold/ema5/ema5_emuDB/"
# load emuDB into current R session
ema5 = load_emuDB(path2ema5, verbose = FALSE)
summary(ema5)

#5.7 Questions (EINIGE FRAGEN AUS jmh's Buch, Kapitel 5)
#1. This question is about exploring whether the data shows a relationship 
# between the extent of jaw lowering and the first formant frequency 
# in the first [a] component of [aɪ] of Kneipe, Kneipier or of [aʊ] of Claudia and Klausur. 
# In general (see e.g., Lindblom & Sundberg, 1971), a more open vocal tract is accompanied 
# both by F1-raising and by a lower jaw position.

# 1(a) Re-calculate the first two formants of this database (ema5) and save these as files with the extension fms2. 
# Since this is a female speaker, change the formant estimation settings.

##1(b) Assuming the existence of the segment list k.s  of word-initial /k/ segments 
# as defined by:
  
k.s = query(ema5, query="Segment=k & Start(Word, Segment)=TRUE")

# how could you make a segment list, vow, containing the diphthongs in the same words, 
# given that these are positioned three segments to the right in relation to these word-initial /k/ segments? 
# Once you have made vow, make a emuRtrackdata object vow.fm, for this segment list containing the formants. 
vow = requery_seq(ema5,k.s,offset=3)
# 1(d) Make an length-normalized emuRtrackdata object, vow.jaw, containing vertical jaw movement data (in track jw_posz) 
# for the segment list you made in 1(b, vow).

vow.jaw = get_trackdata(ema5,vow,ssffTrackName = "jw_posz",resultType = "emuRtrackdata")
vow.jaw_norm = normalize_length(vow.jaw)
#Eher eine Code-Verstehensaufgabe:
#1(e) The jaw height should show a trough in these diphthongs somewhere in the first component 
# as the jaw lowers and the mouth opens. Use peakT1fun() given below 
# to find the times at which the jaw height is at its lowest point in these diphthongs.
# Call the resulting emuRtrackdata object "lowpoint" 

peakT1fun <- function(fr,maxtime=T)
{ peaks=NULL
  for (i in unique(fr$sl_rowIdx)){
  if(maxtime) num = which.max(fr[fr$sl_rowIdx==i,]$T1)
  else num = which.min(fr[fr$sl_rowIdx==i,]$T1)
  peaks=rbind(peaks,fr[fr$sl_rowIdx==i,][num,])
  }
  peaks
}

lowpoint = peakT1fun(vow.jaw_norm,maxtime=F) #maxtime=F wegen der Eigenschaft der Funktion, im default-Fall das Maximum zu suchen - wir suchen aber das Minimum
lowpoint$times_orig

# Wie muss die Funktion angewendet werden, um die obenstehende Frage 1e zu beantworten?
# (f) lasse ich aus ...
# 1(g) Extract (i) the first formant frequency (from the preexisting fms-data, not the data created above) 
# , and length-normalize it (call it vow.fm_norm)
# extract the values of F1 at the time-points given above 
# and add them to "lowpoint"



vow.fm = get_trackdata(ema5,vow,ssffTrackName = "FORMANTS",resultType = "emuRtrackdata")
vow.fm_norm = normalize_length(vow.fm)

lowpoint$F1 = vow.fm_norm[row.names(vow.fm_norm)%in%row.names(lowpoint),]$T1
#man könnte alternativ für jeden sl_rowIdx über eine Schleife die
#times_norm-Werte matchen; wesentlich unkomplizierter ist es jedoch
#die in lowpoint erhalten gebliebenen row.names (Namen der Zeilen) mit den row.names
#aus vow.fm_norm abzugleichen.


# 1(h) Plot F1 as a function of the jaw height minimum showing the word labels at the corresponding points.
# (Getting the word labels will be a bit tricky;-) )
words = requery_hier(ema5,seglist=k.s,level="Word") #funktioniert so nicht; Fehlermeldung studieren; dort wird angegeben, was zu tun ist...
words = requery_hier(ema5,seglist=k.s,level="Word",timeRefSegmentLevel = "Segment")

lowpoint$words=words$labels

#oder direkt:
lowpoint$words = requery_hier(ema5,seglist=k.s,level="Word",timeRefSegmentLevel = "Segment")$labels

print.data.frame(lowpoint)

ggplot(lowpoint) +
  aes(x=T1,y=F1,label=words) +
  geom_text()

##EoF