#- This code produces Lissajous curves for tuning systems                #
#  The Just Intonation System, and the 12-tone equal temperament system  #
##########################################################################

#               Functions
##########################################################################
# Harmonic function for producing coordinates x and y
harmonic_function<-function(t, A, f, p, d){
  A*sin(t*f + p) * exp(-d*t)
}

# Function to compute number of recurrent points passing through a fixed x
recurrent_points<-function(y, x, fixed_x){
  xline<-which(round(x,6)==fixed_x)
  unique(round(y[xline],6))
}
##########################################################################

# Obtain first x coordinate
tm<-seq(0, 300, by=0.01)
A=1; d=0
x<-harmonic_function(tm,A,f=pi,p=0,d)

# Obtain y coordinate for each interval for each tuning system
interval_names<-c("Unison", "Minor second", "Major second", "Minor third", "Major third",
                  "Perfect fourth", "Tritone", "Perfect fifth", "Minor sixth", "Major sixth",
                  "Minor seventh", "Major seventh", "Octave")
just<-c(1, 16/15, 9/8, 6/5, 5/4, 4/3, 64/45, 3/2, 8/5, 5/3, 16/9, 15/8, 2)*pi
exact<-2^(seq(0,12)/12)*pi
phase<-c(0, 1/3, 1/4)*pi


# Compute y coordinate for combinations of different values of p = phase
yJust<-lapply(X=just,FUN=function(x){
  sapply(FUN=harmonic_function, X=phase, t=tm, A=A, f=x, d=d)})
names(yJust)<-interval_names

yExact<-lapply(X=exact,FUN=function(x){
  sapply(FUN=harmonic_function, X=phase, t=tm, A=A, f=x, d=d)})
names(yExact)<-interval_names

# A color for plotting. This simulates the color used by Whitty (1893). 
colp<-rgb(120,70,155, maxColorValue = 255)

# Plot intervals and reproduce Fig 1
pdf("../article/Figures/Just0phase.pdf", width=3*2, height = 4*2)
par(mfrow=c(4,3),mar=rep(0,4))
for(i in 2:13){
  plot(x,yJust[[i]][,1], type="l", axes=FALSE, xlab="", ylab="", col=colp, lwd=0.15, bty="n")
}
par(mfcol=c(1,1))
dev.off()

# Reproduce Fig 2
pdf("../article/Figures/Exact0phase.pdf", width=3*2, height = 4*2)
par(mfrow=c(4,3),mar=rep(0,4))
for(i in 2:13){
 plot(x,yExact[[i]][,1], type="l", axes=FALSE, xlab="", ylab="", col=colp, lwd=0.15, bty="n")
}
par(mfcol=c(1,1))
dev.off()

# Compute recurrent points passing by x = 0
recurrentJust<-lapply(yJust, FUN=recurrent_points, x=x, fixed_x=0)
sapply(recurrentJust, length)

recurrentExact<-lapply(yExact, FUN=recurrent_points, x=x, fixed_x=0)
sapply(recurrentExact, length)

# Addiing friction
d=0.01

xf<-harmonic_function(tm,A,f=pi,p=0,d)
yJustf<-lapply(X=just,FUN=function(x){
  sapply(FUN=harmonic_function, X=phase, t=tm, A=A, f=x, d=d)})
names(yJustf)<-interval_names

yExactf<-lapply(X=exact,FUN=function(x){
  sapply(FUN=harmonic_function, X=phase, t=tm, A=A, f=x, d=d)})
names(yExactf)<-interval_names

pdf("../article/Figures/JustFriction.pdf", width=3*2, height = 4*2)
par(mfrow=c(4,3),mar=rep(0,4))
for(i in 2:13){
  plot(xf,yJustf[[i]][,1], type="l", axes=FALSE, xlab="", ylab="", col=colp, lwd=0.15, bty="n")
}
par(mfcol=c(1,1))
dev.off()

pdf("../article/Figures/ExactFriction.pdf", width=3*2, height = 4*2)
par(mfrow=c(4,3),mar=rep(0,4))
for(i in 2:13){
  plot(xf,yExactf[[i]][,1], type="l", axes=FALSE, xlab="", ylab="", col=colp, lwd=0.15, bty="n")
}
par(mfcol=c(1,1))
dev.off()
# End