Update Rscript.R - SW 21/5

Rscript.R

@@ -105,6 +105,58 @@ plot(spline_poly)
 w_poly_peaks_yval <- predict(spline_poly, w_poly_peaks)
 points(w_poly_peaks, w_poly_peaks_yval, pch = 19)
 
+## Find o in order to find the baseline
+o <- c()
+for(i in 1:length(w_poly_peaks)){
+  o[i] <- max(which(inflexion_points < w_poly_peaks[i]))
+}
+plot(spline_poly)
+points(inflexion_points[o], inflexion_points_yval[o], pch = 19)
+
+# Making a (non-polynomial) spline to fit the baseline
+sfunction3 <- splinefun(inflexion_points[o], inflexion_points_yval[o], method = "natural")
+spline_base <- sfunction3(seq(1, 1000), deriv = 0)
+# Plotting spline_base on spline_poly
+plot(spline_poly)
+points(inflexion_points[o], inflexion_points_yval[o], pch = 19)
+lines(spline_base)
+# Correcting for baseline:
+baseline_corrected <- undetrended_data$undetrended[1:1000] - spline_base
+plot(baseline_corrected, type = "l")
+# Plot new baseline (y = 0)
+lines(1:1000, seq(from = 0, to = 0, length.out = 1000))
+
+# Redefine splines now that baseline corrected:
+sfunction <- splinefun(1:1000, baseline_corrected, method = "natural")
+spline <- sfunction(seq(1, 1000), deriv = 0)
+deriv1 <- sfunction(seq(1, 1000), deriv = 1)
+deriv2 <- sfunction(seq(1, 1000), deriv = 2)
+
+# then re-find W for corrected baseline
+# Finding inflexion points on deriv1 requires redefining 1st deriv as a piece-meal spline
+deriv1_poly <- CubicInterpSplineAsPiecePoly(1:1000, deriv1, "natural") 
+# Find inflexion points on deriv1_poly
+inflexion_points_deriv1 <- solve(deriv1_poly, b = 0, deriv = 1)
+inflexion_points_deriv1_yval <- predict(deriv1_poly, inflexion_points_deriv1)
+plot(deriv1_poly)
+points(inflexion_points_deriv1, inflexion_points_deriv1_yval, pch = 19)
+# Find correct threshold using histogram
+# hdat<-hist(deriv1)
+quantiles<-quantile(deriv1,probs=c(.025,.95))
+threshold<-quantiles[2]
+# Identifying peaks of deriv1_poly:
+w_poly_peaks <- predict(deriv1_poly, inflexion_points_deriv1)
+w_poly_peaks <- which(w_poly_peaks > threshold)     
+w_poly_peaks <- inflexion_points_deriv1[w_poly_peaks]
+# Plot on deriv1_poly
+plot(deriv1_poly)
+w_poly_peaks_yval <- predict(deriv1_poly, w_poly_peaks)
+points(w_poly_peaks, w_poly_peaks_yval, pch = 19)
+# Plot back on spline_poly:
+plot(spline_poly)
+w_poly_peaks_yval <- predict(spline_poly, w_poly_peaks)
+points(w_poly_peaks, w_poly_peaks_yval, pch = 19)
+
 ##Finding U and V
 
 # Find half the height of w (on derivative y-axis)
@@ -181,83 +233,215 @@ for(i in 2:ncol(pulse)){
 }
 
 
-## Find U, V, W, O, S, N, D on the new polynomial splines:
+## Find W, O, S, N, D on the new polynomial splines:
+
 osnd <- list()
+x_osnd <- list()
 s <- c()
 s_yval <- c()
-x_osnd <- list()
-
+next_o <- c()
+next_o_yval <- c()
+pulse_width <- c()
 
-for(i in 3:ncol(pulse)){
+for(i in 2:(ncol(pulse))){     # start from 3 for source 2 data, start from 2 for source data
 
   sfunction2 <- splinefun(1:91, pulse[, i], method = "natural")
   deriv1_wave <- sfunction2(seq(1, 91), deriv = 1)
   deriv1_wave_poly <- CubicInterpSplineAsPiecePoly(1:91, deriv1_wave, "natural") 
 
-# Find inflexion points on deriv1_wave_poly
+  # Find inflexion points on deriv1_wave_poly
   inflexion_points_deriv1_wave_poly <- solve(deriv1_wave_poly, b = 0, deriv = 1)
   inflexion_points_deriv1_wave_poly_yval <- predict(deriv1_wave_poly, inflexion_points_deriv1_wave_poly)
-    plot(deriv1_wave_poly) 
-    points(inflexion_points_deriv1_wave_poly, inflexion_points_deriv1_wave_poly_yval, pch = 19)
+  #plot(deriv1_wave_poly)
+  #points(inflexion_points_deriv1_wave_poly, inflexion_points_deriv1_wave_poly_yval, pch = 19)
 
-# Find correct threshold using histogram
-  hdat_2<-hist(deriv1_wave)
-  quantiles_2<-quantile(deriv1_wave, probs=c(.025,.95))
-  threshold_2<-quantiles_2[2]
+  # Find correct threshold using histogram
+  # hdat_2<-hist(deriv1_wave)
+  quantiles_2 <- quantile(deriv1_wave, probs=c(.025,.95))
+  threshold_2 <- quantiles_2[2]
 
-# Identifying peaks of deriv1_poly:
+  # Identifying peaks of deriv1_poly:
   w_poly_peaks_wave <- predict(deriv1_wave_poly, inflexion_points_deriv1_wave_poly)
-  w_poly_peaks_wave <- which(w_poly_peaks_wave > threshold_2)     
+  w_poly_peaks_wave <- which(w_poly_peaks_wave > threshold)     
   w_poly_peaks_wave <- inflexion_points_deriv1_wave_poly[w_poly_peaks_wave]
 
-# Plot on deriv1_wave_poly
-# plot(deriv1_wave_poly)
-# w_poly_peaks_yval <- predict(deriv1_wave_poly, w_poly_peaks_wave)
-# points(w_poly_peaks_wave, w_poly_peaks_yval, pch = 19)
+  # Plot on deriv1_wave_poly
+   #plot(deriv1_wave_poly)
+   #w_poly_peaks_yval <- predict(deriv1_wave_poly, w_poly_peaks_wave)
+   #points(w_poly_peaks_wave, w_poly_peaks_yval, pch = 19)
 
-#Find U and V
+  # Finding the 'notch' (renal wave)    #### there are issues with this on the canonical waveform only
+  #Identifying troughs of deriv1_poly:
+  # no need to make histogram, just take minimum inflection point and then find the next one
+  notch <- inflexion_points_deriv1_wave_poly[(which(inflexion_points_deriv1_wave_poly_yval == min(inflexion_points_deriv1_wave_poly_yval)))+1]
+  notch_yval <- inflexion_points_deriv1_wave_poly_yval[(which(inflexion_points_deriv1_wave_poly_yval == min(inflexion_points_deriv1_wave_poly_yval)))+1]
+  #plot(deriv1_wave_poly)
+  #points(notch, notch_yval, pch = 19)
+  #Find corresponding y value on poly_wave
+  notch_poly_yval <- predict(poly_wave[[i-1]], notch)
 
-# Find half the height of w (on derivative y-axis)
+  #Find U and V
+
+  # Find half the height of w (on derivative y-axis)
   w_half_height_wave <- predict(deriv1_wave_poly, w_poly_peaks_wave[1])/2
-# Find u and v for derivative:
+  # Find u and v for derivative:
   half_heights_wave_new <- solve(deriv1_wave_poly, b = w_half_height_wave[1])
   half_heights_wave_new_yval <- predict(deriv1_wave_poly, half_heights_wave_new)
   u <- half_heights_wave_new[1]
   v <- half_heights_wave_new[2]
-# Find u and v y-values for original wave:
+  # Find u and v y-values for original wave:
   u_v_yval_wave <- predict(poly_wave[[i-1]], half_heights_wave_new)
   u_yval <- u_v_yval_wave[1]
   v_yval <- u_v_yval_wave[2]
 
-
-# Find OSND
+  # Find OSND
   inflexion_points_new <- solve(poly_wave[[i-1]], b = 0, deriv = 1)
-#Find the four inflexion points that are 1 to the left and 3 to the right of W
+  #Find the four inflexion points that are 1 to the left and 3 to the right of W
   o <- max(which(inflexion_points_new < w_poly_peaks_wave[1]))
   inflexion_points_new_yval <- predict(poly_wave[[i-1]], inflexion_points_new)
+  # Find x coords of OSND
   x_osnd[[i-1]] <- inflexion_points_new[o:(o+3)]
-  osnd[[i-1]] <- inflexion_points_new_yval[o:(o+3)]
-  osnd[[i-1]] <- osnd[[i-1]] - inflexion_points_new_yval[o]
 
-#Alternative S calculation for waveforms with undefined peaks
-
-  s[i-1] <- w_poly_peaks_wave + (2*(v - w_poly_peaks_wave))
+  # Find new S
+  s[i-1] <- w_poly_peaks_wave[1] + (2*(v - w_poly_peaks_wave[1]))
   s_yval[i-1] <- predict(poly_wave[[i-1]], s[i-1])
 
-  if((inflexion_points_new[o+1] - w_poly_peaks_wave) > (s[i-1] - w_poly_peaks_wave)){
-  osnd[[c(i-1,2)]] <- s_yval[i-1]
+  # Continue to define OSND (divergence here between waveforms based on if Paul type or not)
+  if((inflexion_points_new[o+1] - w_poly_peaks_wave[1]) > (s[i-1] - w_poly_peaks_wave[1])){
+
+    # Remove false N and D values 
+    x_osnd_precursor <- x_osnd[[i-1]]
+    if(length(which(complete.cases(x_osnd_precursor) ==1)) != 4){
+      x_osnd_precursor <- x_osnd_precursor[-(which(is.na(x_osnd_precursor)))]
+    }
+    if(length(x_osnd_precursor) == 2){
+      x_osnd[[i-1]] <- x_osnd_precursor
+    }else{
+      false_points <- which(x_osnd_precursor > notch) 
+      x_osnd_precursor <- x_osnd_precursor[-false_points]
+      x_osnd[[i-1]] <- x_osnd_precursor
+    }
+    # Find y coords of OSND
+    osnd[[i-1]] <- inflexion_points_new_yval[o:(o+3)]
+
+    # Remove false values again
+    osnd_precursor <- osnd[[i-1]]
+    if(length(which(complete.cases(osnd_precursor) ==1)) != 4){
+      osnd_precursor <- osnd_precursor[-(which(is.na(osnd_precursor)))]
+    }
+    if(length(osnd_precursor) == 2){
+      osnd[[i-1]] <- osnd_precursor
+    }else{
+      osnd_precursor <- osnd_precursor[-false_points]
+      osnd[[i-1]] <- osnd_precursor
+    }
+
+    osnd[[c(i-1, 3)]] <- osnd[[c(i-1, 2)]]
+    osnd[[c(i-1, 2)]] <- s_yval[i-1]
+    x_osnd[[c(i-1, 3)]] <- x_osnd[[c(i-1, 2)]]
+    x_osnd[[c(i-1, 2)]] <- s[i-1]
+    osnd[[c(i-1, 4)]] <- notch_poly_yval
+    x_osnd[[c(i-1, 4)]] <- notch
+
+  }else{
+    osnd[[i-1]] <- inflexion_points_new_yval[o:(o+3)]
+    osnd[[i-1]] <- osnd[[i-1]] - inflexion_points_new_yval[o]
   }
-
-# Plot back on poly_wave[[i]]:
+
+
+  # Find pulse width = width at half the amplitude of the wave
+  max_amp_precursor <- osnd[[i-1]] # second element will give amplitude of the wave
+  half_amp <- max_amp_precursor[2]/2
+  half_amp <- half_amp - inflexion_points_new_yval[o] # correcting for the fact that the spline goes below 0
+  # find all x values where y = half_amp
+  xval_width <- solve(poly_wave[[i-1]], b = half_amp)
+  # Calculate width from the first two x-values:
+  pulse_width[i-1] <- xval_width[2] - xval_width[1]
+
+  # Find the next o_point
+  next_o[i-1] <- inflexion_points_new[(which(abs(inflexion_points_new_yval[-c(1:3)]) == min(abs(inflexion_points_new_yval[-c(1:3)])))) + 3]
+  next_o_yval[i-1] <- inflexion_points_new_yval[which(abs(inflexion_points_new_yval[-c(1:3)]) == min(abs(inflexion_points_new_yval[-c(1:3)]))) + 3]
+
+  # Plot back on poly_wave[[i]]:
   plot(poly_wave[[i-1]])
   w_poly_peaks_yval <- predict(poly_wave[[i-1]], w_poly_peaks_wave)
   points(w_poly_peaks_wave[1], w_poly_peaks_yval[1], pch = 19)
-  points(inflexion_points_new, inflexion_points_new_yval, pch = 19)
-  points(s[i-1], s_yval[i-1], pch=19, col='red')
-# points(half_heights_wave_new, u_v_yval_wave, pch = 19)
+  points(x_osnd[[i-1]], osnd[[i-1]], pch = 19, col = "red")
+  points(next_o[i-1], next_o_yval[i-1], pch = 19)
+  #points(half_heights_wave_new, u_v_yval_wave, pch = 19)
+  #points(notch, notch_poly_yval, pch = 19)
 
 }
 
+#Print all osnd's (O, S, late systolic peak and inflexion point if no notch)
+for(i in 1:length(osnd)){
+  osnd_correction <- osnd[[i]]
+  osnd_correction <- osnd_correction - osnd_correction[1]
+  osnd[[i]] <- osnd_correction
+  print(osnd[[i]])
+}
+
+## Features (canonical waveform):
+
+# Peak to notch time (waveforms need to be normalized on o-o interval first (or can divide by the pulse duration)):
+pn_time <- c()
+for(i in 1:length(osnd)){
+  pn_time[i] <- (x_osnd[[c(i, 3)]] - x_osnd[[c(i, 2)]])/(next_o[i] - x_osnd[[c(i, 1)]])
+}
+
+# Peak to peak time (PPT):
+PPT <- c()
+for(i in 1:length(osnd)){
+  PPT[i] <- x_osnd[[c(i, 4)]] - x_osnd[[c(i, 2)]]
+}
+
+# Stiffness Index = height / PPT
+SI <- c()
+for(i in 1:length(osnd)){
+  SI[i] <- # Insert height here # / PPT[i]
+}
+
+# Notch to peak ratio  = height of notch / height of primary peak (this was referred to as RI in Lee et al (the multivariate SVR paper))
+np_ratio <- c()
+for(i in 1:length(osnd)){
+  np_ratio[i] <-  osnd[[c(i, 3)]] / osnd[[c(i, 2)]]
+}
+
+# Notch-time ratio = time interval from notch to end of pulse / time interval from notch to beginning of pulse
+nt_ratio <- c()
+for(i in 1:length(osnd)){
+  nt_ratio[i] <- (next_o[i] - x_osnd[[c(i, 3)]]) /  (x_osnd[[c(i, 3)]] - x_osnd[[c(i, 1)]])
+}
+
+# Systolic amplitude (aka amplitude):
+sa <- c()
+for(i in 1:length(osnd)){
+  sa[i] <-  osnd[[c(i, 2)]]
+}
+
+# Reflectance peak to forward peak ratio (Augmentation index as per Takazawa et al, Reflection index as per Padilla et al)
+AI <- c()
+for(i in 1:length(osnd)){
+  AI[i] <-  osnd[[c(i, 4)]] / osnd[[c(i, 2)]]
+}
+
+# Alternate augmentation index (Rubins et al) ( (x-y)/x ):
+aAI <- c()
+for(i in 1:length(osnd)){
+  aAI[i] <- (osnd[[c(i, 2)]] - osnd[[c(i, 4)]]) / osnd[[c(i, 2)]]
+}
+
+# Crest time (time from foot of waveform (o) to peak (S)):
+CT <- c()
+for(i in 1:length(osnd)){
+  CT[i] <- x_osnd[[c(i, 2)]] - x_osnd[[c(i, 1)]]
+}
+
+
+
+
+
+
 
 ###sines sines sines