.packageName <- "tuneR"
FFpure <- 
function(object, peakheight = 0.01, diapason = 440, 
    notes = NULL, interest.frqs = seq(along = object@freq),
    search.par = c(0.8, 10, 1.3, 1.7))
{
# Interesting frequencies up to 1396 (--> 1421) Hz = 66. FF (Soprano) for 512 window-width
    if(is.character(interest.frqs)){
        if(interest.frqs == "bass") interest.frqs <- 4:17
        else if(interest.frqs == "tenor") interest.frqs <- 5:28
        else if(interest.frqs == "alto") interest.frqs <- 6:37
        else if(interest.frqs == "soprano") interest.frqs <- 11:66
        else stop("Value for 'interest.frqs' not valid")
    }

    if(!is.null(notes)){
        expected.frqs <- 2^(notes / 12) * diapason
        if(!is.null(interest.frqs)){
            warning("Argument 'interest.frqs' ignored. Only one of 'interest.frqs' or 'notes' can be specified.")
            interest.frqs <- NULL
        }
        interest.frqs <- sort(unique(unlist(
            lapply(expected.frqs, 
                function(x){ 
                    temp <- abs(x - object@freq)
                    which(temp %in% sort(temp)[1:2])
                })
        )))
    }

    N <- length(object@spec)
    interesse <- numeric(N)

    for(k in 1:N){
        spec <- object@spec[[k]]
        spec[!(seq(along = spec) %in% interest.frqs)] <- 0
        index <- (max(spec[interest.frqs]) * peakheight) < spec
        peak.1 <- interest.frqs[match(spec[index][1], spec[interest.frqs])]
        peak.1.weiter <- max(peak.1 + floor(peak.1 * search.par[1]), search.par[2])  # Heuristik!
        if(peak.1.weiter >= max(interest.frqs)) peak.1.weiter <- max(interest.frqs) - 1
        temp <- (peak.1:peak.1.weiter)[(peak.1:peak.1.weiter) %in% interest.frqs]
        peak.2 <- interest.frqs[match(max(spec[temp]), spec[interest.frqs])]
        temp <- na.omit(spec[round(peak.2*search.par[3]):round(peak.2*search.par[4])])
        if(length(temp) && any(temp > max(spec[interest.frqs]) * peakheight)){
            index <- (max(spec[interest.frqs]) * peakheight * 0.1) < spec
            peak.1 <- interest.frqs[match(spec[index][1], spec[interest.frqs])]
            peak.1.weiter <- max(peak.1 + floor(peak.1 * search.par[1]), search.par[2])  # Heuristik!
            if(peak.1.weiter >= max(interest.frqs)) peak.1.weiter <- max(interest.frqs) - 1
            temp <- (peak.1:peak.1.weiter)[(peak.1:peak.1.weiter) %in% interest.frqs]
            peak.2 <- interest.frqs[match(max(spec[temp]), spec[interest.frqs])]
        }
        if((peak.2 + 1) %in% interest.frqs){
            if((peak.2 - 1) %in% interest.frqs)
                peak.2.neben <- peak.2 + if(spec[peak.2 - 1] > spec[peak.2 + 1]) -1 else 1
            else
                peak.2.neben <- peak.2 + 1
        }
        else peak.2.neben <- peak.2 - 1
#        interesse[k] <- peak.2 + (((spec[peak.2.neben] / spec[peak.2])^exp(-1)) * (peak.2.neben - peak.2) / 2)
        interesse[k] <- peak.2 + (sqrt(spec[peak.2.neben] / spec[peak.2]) * (peak.2.neben - peak.2) / 2)
    }
    return(interesse * object@freq[1])
}    


FF <- 
function(object, peakheight = 0.01, silence = 0.2, minpeak = 9, 
    diapason = 440, notes = NULL, interest.frqs = seq(along = object@freq),
    search.par = c(0.8, 10, 1.3, 1.7))
{
    FFvalue <- FFpure(object, peakheight = peakheight, diapason = diapason, 
        notes = notes, interest.frqs = interest.frqs, search.par = search.par)
    N <- length(FFvalue)
    silence <- if(silence) sort(object@energy)[round(N * silence)] else -Inf
    energy <- object@energy < silence
    for(k in 1:N){
      if(energy[k] && (sum(object@spec[[k]] > peakheight) > minpeak)){
        is.na(FFvalue[k]) <- TRUE
      }
    }
    return(FFvalue)
}

noteFromFF <-
function(x, diapason = 440)
{
    round(12 * log(x / diapason, 2))
}
require(methods)
##########
# define class Wave
setClass("Wave",
    representation = representation(left = "numeric",
    right = "numeric", stereo = "logical",
    samp.rate = "numeric", bit = "numeric"),
    prototype = prototype(stereo = TRUE, samp.rate = 44100, 
        bit = 16))

setValidity("Wave", 
function(object){
    if(!is(object@left, "numeric")) return("channels of Wave objects bust be numeric")
    if(!(is(object@stereo, "logical") && (length(object@stereo) < 2)))
        return("slot stereo of a Wave object must be a logical of length 1")
    if(object@stereo){
        if(!is(object@right, "numeric"))
            return("channels of Wave objects bust be numeric")
        if(length(object@left) != length(object@right))
            return("both channels of Wave objects must have the same length")
    }
    else if(length(object@right))
        return("right channel of a wave object is not supposed to contain data if slot stereo==FALSE")
    if(!(is(object@samp.rate, "numeric") &&
        (length(object@samp.rate) < 2) && (object@samp.rate > 0)))
            return("slot samp.rate of a Wave object must be a positive numeric of length 1")
    if(!(is(object@bit, "numeric") &&
        (length(object@bit) < 2) && (object@bit %in% c(8, 16))))
            return("slot bit of a Wave object must be a positive numeric (either 8 or 16) of length 1")
    return(TRUE)
})

setMethod("[", signature(x = "Wave"),
function(x, i, j, ..., drop=FALSE){
    if(!is(x, "Wave")) 
        stop("'x' needs to be of class 'Wave'")
    validObject(x)
    x@left <- x@left[i]
    if(x@stereo)
        x@right <- x@right[i]
    return(x)
})

##########
# Wave object generating functions
setGeneric("Wave",
function(left, ...) standardGeneric("Wave"))

setMethod("Wave", signature(left = "numeric"), 
function(left, right = numeric(0), samp.rate = 44100, bit = 16, ...){
    if(missing(samp.rate)) 
        warning("'samp.rate' not specified, assuming 44100Hz")
    if(missing(bit)) 
        warning("'bit' not specified, assuming 16bit")
    return(
        new("Wave", stereo = length(right) > 0, samp.rate = samp.rate, 
            bit = bit, left = left, right = right))
})

setMethod("Wave", signature(left = "matrix"), 
function(left, ...)
    Wave(as.data.frame(left), ...)
)

setMethod("Wave", signature(left = "data.frame"), 
function(left, ...)
    Wave(as.list(left), ...)
)

setMethod("Wave", signature(left = "list"), 
function(left, ...){
    if(length(left) > 1){
        if(all(c("left", "right") %in% names(left)))
            Wave(left$left, left$right, ...)
        else 
            Wave(left[[1]], left[[2]], ...)
    }
    else Wave(left[[1]], ...)
})


setAs("matrix", "Wave", function(from, to) Wave(from))
setAs("data.frame", "Wave", function(from, to) Wave(from))
setAs("list", "Wave", function(from, to) Wave(from))
setAs("numeric", "Wave", function(from, to) Wave(from))
setAs("Wave", "data.frame", 
function(from, to){
    dat <- if(from@stereo) data.frame(left = from@left, right = from@right) 
           else data.frame(mono = from@left)
    return(dat)
})
setAs("Wave", "matrix", function(from, to) 
    return(as(as(from, "data.frame"), "matrix")))
setAs("Wave", "list", function(from, to)
    return(as(as(from, "data.frame"), "list")))


setMethod("show", signature(object = "Wave"), 
function(object){
    l <- length(object@left)
    cat("\nWave Object")
    cat("\n\tNumber of Samples:     ", l)
    cat("\n\tDuration (seconds):    ",
        round(l / object@samp.rate, 2))
    cat("\n\tSamplingrate (Hertz):  ", object@samp.rate)
    cat("\n\tChannels (Mono/Stereo):",
        if(object@stereo) "Stereo" else "Mono")
    cat("\n\tBit (8/16):            ", object@bit, "\n\n")
})

setMethod("summary", signature(object = "Wave"), 
function(object, ...){
    l <- length(object@left)
    cat("\nWave Object")
    cat("\n\tNumber of Samples:     ", l)
    cat("\n\tDuration (seconds):    ",
        round(l / object@samp.rate, 2))
    cat("\n\tSamplingrate (Hertz):  ", object@samp.rate)
    cat("\n\tChannels (Mono/Stereo):",
        if(object@stereo) "Stereo" else "Mono")
    cat("\n\tBit (8/16):            ", object@bit)
    cat("\n\nSummary statistics for channel(s):\n\n")
    if(object@stereo)
        print(rbind(left = summary(object@left), right = summary(object@right)))
    else print(summary(object@left))
    cat("\n\n")
})
require(methods)
##########
# define class Wspec
setClass("Wspec",
    representation = representation(
        freq = "numeric",
        spec = "list", 
        # coh, phase,
        kernel = "ANY",
        df = "numeric",
        taper = "numeric",
        width = "numeric",
        overlap = "numeric",
        normalize = "logical",
        starts = "numeric",
        stereo = "logical",
        samp.rate = "numeric",
        variance = "numeric",
        energy = "numeric"),
    prototype = prototype(taper = 0, 
        stereo = FALSE, samp.rate = 44100))


setMethod("[", signature(x = "Wspec"),
function(x, i, j, ..., drop=FALSE){
    if(!is(x, "Wspec")) 
        stop("'x' needs to be of class 'Wspec'")
    validObject(x)

    x@spec <- x@spec[i]
    x@starts <- x@starts[i]
    x@variance <- x@variance[i]
    x@energy <- x@energy[i]
    return(x)
})


setMethod("show", signature(object = "Wspec"), 
function(object){
    l <- length(object@freq)
    cat("Wspec Object (use summary() for more details)\n\n")
    cat("Number of Periodograms:", length(object@spec), "\n")
    cat("Estimated at", l, "Frequencies:", 
        object@freq[1], "...", object@freq[l], "\n\n")
    cat("Further parameters:\n")
    cat("width:  ", object@width,   "\n")
    cat("overlap:", object@overlap, "\n")
    cat("normal.:", object@normalize, "\n\n")
})


setMethod("summary", signature(object = "Wspec"),
function(object, ...){
    l <- length(object@freq)
    cat("Wspec Object", 
        if(!is.null(object@kernel)) 
            "(see object@kernel for details on the kernel)", 
        "\n\n")
    cat("Number of Periodograms:", length(object@spec), "\n")
    cat("Estimated at", l, "Frequencies:", 
        object@freq[1], "...", object@freq[l], "\n\n")
    cat("Further parameters:\n")
    cat("df:     ", object@df,      "\n")
    cat("taper:  ", object@taper,   "\n")
    cat("width:  ", object@width,   "\n")
    cat("overlap:", object@overlap, "\n")
    cat("normal.:", object@normalize, "\n\n")

    cat("Properties of the Wave object:\n")
    cat(if(object@stereo) "Stereo" else "Mono", "with sampling rate", object@samp.rate, "\n\n")
})
bind <- 
function(...){
    allobjects <- as.list(list(...))
    object <- allobjects[[1]]
    lapply(allobjects[-1], equalWave, object)
    object@left <- unlist(lapply(allobjects, slot, "left"))
    if(object@stereo)
        object@right <- unlist(lapply(allobjects, slot, "right"))
    return(object)
}
channel <- 
function(object, which = c("both", "left", "right")){
    if(!is(object, "Wave")) 
        stop("Object not of class 'Wave'")
    validObject(object)
    which <- match.arg(which)
    return(as.data.frame(
        switch(which,
            both = object,
            left = {
                object@stereo <- FALSE
                object@right <- numeric(0)
                object
            },
            right = {
                object@left <- object@right
                object@stereo <- FALSE
                object@right <- numeric(0)
                object
            }
        )
    ))
}
downsample <- 
function(object, samp.rate){
    if(!is(object, "Wave")) 
        stop("'object' needs to be of class 'Wave'")
    validObject(object)
    if((!is.numeric(samp.rate)) || (samp.rate < 2000) || (samp.rate > 192000))
            stop("samp.rate must be an integer in [2000, 192000].")
    if(object@samp.rate > samp.rate){
        ll <- length(object@left)
        object <- object[seq(1, ll, length = samp.rate * ll / object@samp.rate)]
        object@samp.rate <- samp.rate
    }
    else warning("samp.rate < object's original sampling rate, hence object is returned unchanged.")
    return(object)
}
equalWave <- 
function(object1, object2){
    if(!(is(object1, "Wave") && is(object2, "Wave"))) 
        stop("Object not of class 'Wave'")
    if(!(validObject(object1) && validObject(object2)))
        stop("Not a valid 'Wave' object")
    if(object1@samp.rate != object2@samp.rate)
        stop("Sampling Rate of 'Wave' objects differ")    
    if(object1@bit != object2@bit)
        stop("Bit resolution of 'Wave' objects differ")    
    if(xor(object1@stereo, object2@stereo))
        stop("One 'Wave' object is mono, the other one stereo")
}
extractWave <-
function(object, from = 1, to = length(object@left), 
    interact = interactive(), xunit = c("samples", "time"), ...){

    if(!is(object, "Wave")) 
        stop("'object' needs to be of class 'Wave'")
    validObject(object)

    xunit <- match.arg(xunit)

    if(interact){
        mf <- missing(from)
        mt <- missing(to)
        if(mf || mt)
            plot(object, xunit = xunit, ...)
        if(mf){
            cat("Click for 'from'\t")
            if(.Platform$OS.type == "windows") flush.console()
            from <- locator(1)$x
            cat(from, "\n")
            abline(v = from, ...)
        }
        if(mt){
            cat("Click for 'to'  \t")
            if(.Platform$OS.type == "windows") flush.console()
            to <- locator(1)$x
            cat(to, "\n")
            abline(v = to, ...)
        }
    }
    
    if(xunit == "time"){
        to <- to * object@samp.rate
        from <- from * object@samp.rate
    }

    lo <- length(object@left)
    from <- max(from, 1)
    to <- min(to, lo)

    if(from > to){
        warning("'from' > 'to', object is unchanged")
        return(object)
    }
    
    return(object[seq(from, to)])
}
lilyinput <- function(X, file = "Rsong.ly", 
    Dur = TRUE, grundton = "c", schlusselart = 1, takt = "4/4",
    endbar = TRUE,
    midi = TRUE, tempo = "2 = 60", 
    textheight = 220, linewidth = 150, indent = 0)
{
  # Notenzuweisung
  # 97 Eintrge in Notentopf (a,,, bis a''''')
  if(Dur){
  notentopf <- 
    switch(grundton,
        d = c("c", "cis", "d", "dis", "e", "f", "fis", "g", "gis", "a", "bes", "b"),
        e = c("c", "cis", "d", "dis", "e", "f", "fis", "g", "gis", "a", "ais", "b"),
        f = c("c", "cis", "d", "es", "e", "f", "fis", "g", "as", "a", "bes", "b"),
        g = c("c", "cis", "d", "es", "e", "f", "fis", "g", "gis", "a", "bes", "b"),
        a = c("c", "cis", "d", "dis", "e", "f", "fis", "g", "gis", "a", "bes", "b"),
        b = c("c", "des", "d", "es", "e", "f", "fis", "g", "as", "a", "bes", "b"),
        es = c("c", "des", "d", "es", "e", "f", "ges", "g", "as", "a", "bes", "b"),
        c("c", "cis", "d", "es", "e", "f", "fis", "g", "gis", "a", "bes", "b")
    )
  }
  else{
  notentopf <- 
    switch(grundton,
        h = c("c", "cis", "d", "dis", "e", "f", "fis", "g", "gis", "a", "bes", "b"),
        cis = c("c", "cis", "d", "dis", "e", "f", "fis", "g", "gis", "a", "ais", "b"),
        d = c("c", "cis", "d", "es", "e", "f", "fis", "g", "as", "a", "bes", "b"),
        e = c("c", "cis", "d", "es", "e", "f", "fis", "g", "gis", "a", "bes", "b"),
        fis = c("c", "cis", "d", "dis", "e", "f", "fis", "g", "gis", "a", "bes", "b"),
        g = c("c", "des", "d", "es", "e", "f", "fis", "g", "as", "a", "bes", "b"),
        c = c("c", "des", "d", "es", "e", "f", "ges", "g", "as", "a", "bes", "b"),
        c("c", "cis", "d", "es", "e", "f", "fis", "g", "gis", "a", "bes", "b")
    )
  }  

  notentopf <- unlist(lapply(
    c(",,,", ",,", ",", "", "'", "''", "'''", "''''", "'''''"), 
        function(x) paste(notentopf, x, sep="")))[-c(1:9, 107:108)]
  # Initialisierung
  bindung <- toene <- character(length(X$noten)) 
  
  #Tonhhe, -lnge, -punktierung
  ton <- ifelse(is.na(X$noten), "r", notentopf[X$noten + 49])
  laenge <- ifelse(X$laenge %in% 2^(0:8), X$laenge, "")
  punkt <- ifelse(X$punkt, ".", "")
  # Abfangen von Beginn / Ende von Bindungen:
  if(sum(X$bindung) %% 2) 
    stop("Mehr Anfnge als Enden bei Bindebgen")
  bindung[which(X$bindung)] <- 
    rep(c("(", ")"), sum(X$bindung) %/% 2)
  # Zusammenfhren der Notenzeichen:
  toene <- ifelse(bindung == ")", 
    paste(bindung, ton, laenge, punkt, sep = ""),
    paste(ton, laenge, punkt, bindung, sep = ""))

  # Notenschlsselzuweisung:
  if(!(schlusselart %in% 1:4))
    stop(paste("Falsche Eingabe des Notenschlssels!",
        "\nViolin - 1 , Bass - 2 , Alto - 3 , Tenor - 4\n"))
  notenschlussel <- switch(schlusselart, 
    "treble", "bass", "alto", "tenor")
  # Tonart
  art <- if(Dur) "\\major" else "\\minor"        

 # Grundton
  if(Dur){
    topf <- c("fis" , "h" , "e" , "a" , "d" , "g" , "c" , "f" , 
        "b" , "es" , "as" , "des" , "ges") 
    if(!(grundton %in% topf))
        stop(paste("Falsche Eingabe des Grundtons!\nDurtonarten:", 
            paste(topf, collapse = " "), "\n"))
  }
  else{
    topf <- c("cis" , "gis" , "dis" , "fis" , "h" , "e" , "a" , 
        "d" , "g" , "c" , "f" , "b" , "es")
    if(!(grundton %in% topf))
        stop(paste("Falsche Eingabe des Grundtons!\nMolltonarten:", 
            paste(topf, collapse = " "), "\n"))
  }
  if(grundton == "b") grundton <- "bes"
  else if(grundton == "h") grundton <- "b"

  # Lilypond Datei erzeugen:
  write(file = file,
    c("\\include \"paper16.ly\"", 
        "\\header{tagline = \"\"}",
        "\\score{", 
        "  \\notes{", 
        paste("    \\time", takt),
        paste("    \\key", grundton, art),
        paste("    \\clef", notenschlussel),
        paste("   ", toene),
    if(endbar) 
        "   \\bar \"|.\"",
        "  }",
        "  \\paper{",
        "    \\paperSixteen",
        paste("    textheight = ", textheight, ".\\mm", sep = ""),
        paste("    linewidth = ", linewidth, ".\\mm", sep = ""),
        paste("    indent = ", indent, ".\\mm", sep = ""),
        "  }",
    if(midi){ 
      c("  \\midi{", 
        paste("    \\tempo", tempo),
        "  }")
    },
        "}"))
}

## Test-Code:
#X <- data.frame(noten = c(3, 0, 1, 3, -4, -2, 0, 1, 3, 1, 0, -2, NA),  
#    laenge = c(2, 4, 8, 2, 2, 8, 8, 8, 8, 4, 4, 1, 1), 
#    punkt = c(FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE), 
#    bindung = c(FALSE, TRUE, TRUE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE))
#
#lilyinput(X, file = "c:/test.ly")
melodyplot <- 
function(object, observed, expected = NULL, bars = NULL, main = NULL, 
    xlab = NULL, ylab = "note", xlim = NULL, ylim = NULL, 
    observedcol = "red", expectedcol = "grey", gridcol = "grey",
    lwd = 2, las = 1, cex.axis = 0.9, mar = c(5, 4, 4, 4) + 0.1){

    par(las = las, cex.axis = cex.axis, mar = mar)
  
    notenames <- c(rep(" ", 7), "C", "C#", "D", "D#", "E", "F", 
        "F#", "G", "G#", "A", "A#", "B", "c", "c#", "d", "d#", 
        "e", "f", "f#", "g", "g#", "a", "a#", "b", "c'", "c#'", 
        "d'", "d#'", "e'", "f'", "f#'", "g'", "g#'", "a'", "a#'", 
        "b'", "c''", "c#''", "d''", "d#''", "e''", "f''", "f#''", 
        "g''", "g#''", "a''", "a#''", "b''", "c'''", "c#'''", 
        "d'''", "d#'''", "e'''", "f'''", "f#'''", "g'''", "g#'''", 
        "a'''", "a#'''", "b'''", rep(" ", 14))
    notenames <- data.frame(notenum = -40:40, notename = I(notenames))

    if(is.null(bars)){
        starts <- object@starts
        bars <- starts[length(starts)] + object@width
        bars <- bars / object@samp.rate 
        if(is.null(xlab)) xlab <- "time"
    }
    else if(is.null(xlab)) xlab <- "bar"
    
    observed[observed == -100] <- NA
    rg <- range(observed, expected, na.rm = TRUE)
    y.ticks <- c("silence", 
        notenames$notename[which(notenames$notenum %in% rg[1]:rg[2])])
    rg.s <- rg[1] - 2
    observed[is.na(observed)] <- rg.s
    x <- bars * seq(0, 1, length = length(observed))
    if(is.null(xlim)) xlim <- c(0, if(bars < 1) 1 else bars)
    if(is.null(ylim)) ylim <- c(rg.s - 2, rg[2] + 0.5)
    plot(x, observed - .05, xaxt = "n", yaxt = "n", 
        main = main, xlab = xlab, ylab = ylab, 
        type = "n", lwd = lwd, xaxs = "i", yaxs = "i",
        xlim = xlim, ylim = ylim)
    axis(1, at = 1:bars)
    if(!is.null(expected)) 
        rect(c(0, x[-length(x)]), expected - 0.5, x, expected + 0.5, 
            col = expectedcol, border = expectedcol)    
    axis(2, at = (rg.s:rg[2])[-2], label = as.character(y.ticks))
    lines(x, observed + .05, col = observedcol, lwd = 2)
    abline(v = 1:(bars), col = gridcol)
    abline(h = rg[1]:(rg[2]-1) + 0.5, col = gridcol)
    abline(h = rg.s + 1.5)
    energy <- object@energy
    energy <- rg.s - 2 + 
        (3.5 * (energy - min(energy)) / diff(range(energy)))
    lines(x, energy)
    mtext("energy", side = 4, line = 2.5, at = rg.s - 0.25, las = 3)
    axis(4, at = rg.s + c(-2, 1.5), 
        label = round(range(object@energy), 1))
    box()   
}
mono <- 
function(object, which = c("left", "right")){
    if(!is(object, "Wave")) 
        stop("Object not of class 'Wave'")
    validObject(object)
    which <- match.arg(which)
    return(
        switch(which,
            left = {
                object@stereo <- FALSE
                object@right <- numeric(0)
                object
            },
            right = {
                object@left <- object@right
                object@stereo <- FALSE
                object@right <- numeric(0)
                object
            }
        )
    )
}
periodogram <-
function(object, width = length(object@left), overlap = 0,
    starts = NULL, ends = NULL, taper = 0, normalize = TRUE, ...)
{
   if(!is(object, "Wave")) 
        stop("'object' needs to be of class 'Wave'")
    validObject(object)

    if(object@stereo) stop("Stereo processing not yet implemented...")
    
    testwidth <- 2^ceiling(log(width, 2))
    if(width !=  testwidth) {
        width <- testwidth
        warning("'width' must be a potence of 2, hence using the ceiling: ", width, "\n")
    }
        
    Wspec <- new("Wspec")
    Wspec@stereo <- object@stereo
    Wspec@samp.rate <- object@samp.rate
    Wspec@taper <- taper
    temp <- width / 2
    Wspec@freq <- object@samp.rate * seq(1, width / 2) / width

    wo <- width - overlap
    lo <- length(object@left)
    lw <- lo - width
    n <- lw %/% wo
    add <- lw - n*wo
    lo <- lo + add
    dat <- c(object@left, rep(0, add))
    dat <- dat - mean(dat)
    if(normalize) 
        dat <- dat / max(abs(dat))
        
    n <- n + 1
    if(is.null(starts) && is.null(ends)){
        starts <- seq(1, lo-width+1, by = wo)
        ends <- seq(width, lo, by = wo)
    }
    else{
        if(is.null(starts)) starts <- ends - width
        if(is.null(ends)) ends <- starts + width
    }

    temp <- spec.pgram(dat[starts[1]:ends[1]], taper = taper,
        pad = 0, fast = TRUE, demean = FALSE, detrend = FALSE,
        plot = FALSE, na.action = na.fail, ...)

    Wspec@kernel <- temp$kernel
    Wspec@df <- temp$df
    Wspec@starts <- starts
    Wspec@width <- width
    Wspec@overlap <- overlap
    Wspec@normalize <- normalize
    
    spec <- vector(n, mode = "list")
    spec[[1]] <- temp$spec
    for(i in (seq(along = starts[-1]) + 1)){
        spec[[i]] <- spec.pgram(dat[starts[i]:ends[i]], taper = taper, 
            pad = 0, fast = TRUE, demean = FALSE, detrend = FALSE,
            plot = FALSE, na.action = na.fail, ...)$spec
        
    }
    Wspec@spec <- if(normalize)
        lapply(spec, function(x){
            sx <- sum(x)
            lx <- length(x)
            if(!sx) rep(1 / lx, lx) else x / sum(x)
        })
        else spec

    Wspec@variance <- mapply(function(x,y) var(dat[x:y]), starts, ends)
    Wspec@energy <- 20 * log10(mapply(function(x,y) sum(abs(dat[x:y])), starts, ends))
    
    return(Wspec)
}
setGeneric("play",
function(object, player, ...) standardGeneric("play"))

setMethod("play", signature(object = "character", player = "ANY"),
function(object, player, ...){
    if(.Platform$OS.type == "windows" && missing(player)){
        player <- "mplay32"
        if(missing(...))
            player <- paste(player, "/play /close")
    }
    system(paste(player, ..., object))
})

setMethod("play", signature(object = "Wave", player = "ANY"),
function(object, player, ...){
    filename <- "tuneRtemp.wav"
    wd <- getwd()
    setwd(tempdir())
    on.exit({unlink(filename); setwd(wd)})
    writeWave(object, filename)
    play(filename, player, ...)
})
plot.Wave.channel <- 
function(x, xunit, ylim, xlab, ylab, main, nr, simplify, ...){
    null <- if(x@bit == 8) 128 else 0
    l <- length(x@left)
    at <- round((ylim[2] - null) * 2/3, -floor(log(ylim[2], 10)))
    at <- null + c(-at, 0, at)
    if(simplify && (l > nr)){
        nr <- ceiling(l / round(l / nr))
        index <- seq(1, l, length = nr)
        if(xunit == "time") index <- index / x@samp.rate
        mat <- matrix(c(x@left, rep(null, nr - (l %% nr))), 
            nrow = nr, byrow = TRUE)
        rg <- apply(mat, 1, range)
        plot(index, rg[1,], type = "n", yaxt = "n", ylim = ylim, 
            xlab = xlab, ylab = ylab, main = main, ...)
        segments(index, rg[1,], index, rg[2,], ...)
    }
    else{
        index <- seq(along = x@left)
        if(xunit == "time") index <- index / x@samp.rate
        plot(index, x@left,
            type = "l", yaxt = "n", ylim = ylim, xlab = xlab, 
            ylab = ylab, main = main, ...)
    }
    axis(2, at = at)
}
    
    
setMethod("plot", signature(x = "Wave", y = "missing"),
function(x, info = FALSE, xunit = c("time", "samples"), 
    ylim = NULL, main = NULL, sub = NULL, xlab = NULL, ylab = NULL, 
    simplify = TRUE, nr = 1500, ...){
    
    xunit <- match.arg(xunit)
    if(is.null(xlab)) xlab <- xunit
    stereo <- x@stereo
    l <- length(x@left)
    if(is.null(ylim)){
        ylim <- range(x@left, x@right)
        if(x@bit == 8)
            ylim <- c(-1, 1) * max(abs(ylim - 127)) + 127
        else
            ylim <- c(-1, 1) * max(abs(ylim))
    }
    if(stereo){
        opar <- par(mfrow = c(2,1), 
            oma = c(if(info) 6.1 else 5.1, 0, 4.1, 0))
        on.exit(par(opar))
        mar <- par("mar")
        par(mar = c(0, mar[2], 0, mar[4]))
        plot.Wave.channel(mono(x, "left"), xunit = xunit,
            ylab = if(is.null(ylab)) "left channel" else ylab, 
            main = NULL, sub = NULL, xlab = NULL, ylim = ylim, 
            xaxt = "n", simplify = simplify, nr = nr, ...)
        plot.Wave.channel(mono(x, "right"), xunit = xunit,
            ylab = if(is.null(ylab)) "right channel" else ylab,
            main = NULL, sub = sub, xlab = NULL, ylim = ylim,  
            simplify = simplify, nr = nr, ...)
        title(main = main, outer = TRUE, line = 2)
        title(xlab = xlab, outer = TRUE, line = 3)
        title(sub  = sub , outer = TRUE, line = 4)
        par(mar = mar)
    }
    else{
        if(info){
            opar <- par(oma = c(2, 0, 0, 0))
            on.exit(par(opar))
        }
        plot.Wave.channel(x, xunit = xunit, 
            ylab = if(is.null(ylab)) "" else ylab,
            main = main, sub = sub, xlab = xlab, ylim = ylim,
            simplify = simplify, nr = nr, ...)
    }
    if(info){
        mtext(paste("Wave Object: ",  
                l, " samples (", 
                round(l / x@samp.rate, 2),  " sec.), ",
                x@samp.rate, " Hertz, ",
                x@bit, " bit, ",
                if(stereo) "stereo." else "mono.", sep = ""), 
            side = 1, outer = TRUE, line = if(stereo) 5 else 0, ...)
    }
})
setMethod("plot", signature(x = "Wspec", y = "missing"),
function(x, which = 1, type = "h", xlab = "Frequency", ylab = NULL, log = "", ...){

    if(is.null(ylab)){
        ylab <- if(x@normalize) "normalized periodogram" else "periodogram"
        if(!missing(log) && (log == "y")) ylab <- paste("log(", ylab, ")", sep = "")
    }        
    spec <- x@spec[[which]]
    plot(x@freq, spec, type = type, 
        xlab = xlab, ylab = ylab, log = log, ...)
})
readWave <- 
function(filename){
    if(!is.character(filename))
        stop("'filename' must be of type character.")
    if(length(filename) != 1)
        stop("Please specify exactly one 'filename'.")
    if(!file.exists(filename))
        stop("File '", filename, "' does not exist.")
    if(file.access(filename, 4))
        stop("No read permission for file ", filename)

    # Open connection
    con <- file(filename, "rb")
    on.exit(close(con)) # be careful ...
    int <- integer()
    
    # Reading in the header:
    RIFF <- readChar(con, 4)
    file.length <- readBin(con, int, n = 1, size = 4)
    WAVE <- readChar(con, 4)
    FMT <- readChar(con, 4)
    fmt.length <- readBin(con, int, n = 1, size = 4)
    pcm <- readBin(con, int, n = 1, size = 2)
    channels <- readBin(con, int, n = 1, size = 2)
    sample.rate <- readBin(con, int, n = 1, size = 4)
    bytes.second <- readBin(con, int, n = 1, size = 4)
    block.align <- readBin(con, int, n = 1, size = 2)
    bits <- readBin(con, int, n = 1, size = 2)
    DATA <- readChar(con, 4)
    data.length <- readBin(con, int, n = 1, size = 4)

    bytes <- bits / 8
    
    # Checking header infos for validity:
    if(!(RIFF == "RIFF" && WAVE == "WAVE" && FMT == "fmt " && 
        (DATA == "data" || DATA == "PAD ") && fmt.length == 16 && pcm == 1))
            warning("Looks like '", filename, "' is not a valid wave file.")
    if(((sample.rate * block.align) != bytes.second) || 
        ((channels * bytes) != block.align))
            warning("Wave file '", filename, "' seems to be corrupted.")

    # Wild guess:
    if(DATA == "PAD "){
        N <- data.length / bytes
        data.length <- file.length - 40 - data.length
        pad <- readBin(con, int, n = N, size = bytes, signed = (bytes == 2))
        if(any(pad)) stop("This is not a valid wave file.")
        DATA <- readChar(con, 4)
        if(DATA != "data")
            warning("Looks like '", filename, "' is not a valid wave file.")
    }
        

    ## reading in sample data
    N <- data.length / bytes
    sample.data <- readBin(con, int, n = N, size = bytes, 
        signed = (bytes == 2))
    
    # Constructing the Wave object:    
    object <- new("Wave", stereo = (channels == 2), samp.rate = sample.rate, bit = bits)
    if(channels == 2) {
        sample.data <- matrix(sample.data, nrow = 2)
        object@left <- sample.data[1, ]
        object@right <- sample.data[2, ]
    }   
    else object@left <- sample.data
    
    # Return the Wave object
    return(object)
}
smoother <- function(notes, method ="median", order=4, times=2){
    require(pastecs)
    notes[is.na(notes)] <- 999
    dmnotes <- unclass(decmedian(notes, order = order, times = times)$series[,1])
    is.na(dmnotes[dmnotes==999]) <- TRUE
    return(as.numeric(dmnotes))
}
stereo <- 
function(left, right){
    ln <- deparse(substitute(left))
    rn <- deparse(substitute(right))
    equalWave(left, right)
    if(right@stereo)
        stop(rn, " already is a stereo 'Wave' object")
    if(left@stereo)
        stop(ln, " already is a stereo 'Wave' object")
    if(length(right@left) != length(left@left))
        stop("Channel length of ", ln, " and ", rn, " differ")
    left@stereo <- TRUE
    left@right <- right@left
    return(left)
}
writeWave <- 
function(object, filename){
    if(!is(object, "Wave")) 
        stop("'object' needs to be of class 'Wave'")
    validObject(object)

    if(object@stereo){
        sample.data <- matrix(c(object@left, object@right), nrow = 2, byrow = TRUE)
        dim(sample.data) <- NULL
    }
    else sample.data <- object@left

    if((object@bit == 8) && ( (max(sample.data) > 255) || (min(sample.data) < 0) ))
        stop("for 8-bit Wave files, data range is supposed to be in [0, 255]")
    if((object@bit == 16) && ( (max(sample.data) > 32767) || (min(sample.data) < -32768)))
        stop("for 16-bit Wave files, data range is supposed to be in [-32768, 32767]")
    if(any(sample.data %% 1)) 
        warning("channels' data will be rounded to integers for writing the wave file")

    # Open connection
    con <- file(filename, "wb")
    on.exit(close(con)) # be careful ...
        
    # Some calculations:
    l <- length(object@left)
    byte <- as.integer(object@bit / 8)
    channels <- object@stereo + 1
    block.align <- channels * byte
    bytes <- l * byte * channels
        
    # Writing the header:
    writeChar("RIFF", con, 4, eos = NULL)
    writeBin(as.integer(bytes + 36), con, size = 4)
    writeChar("WAVE", con, 4, eos = NULL)
    writeChar("fmt ", con, 4, eos = NULL)
    writeBin(as.integer(16), con, size = 4)    
    writeBin(as.integer(1), con, size = 2)
    writeBin(as.integer(channels), con, size = 2)
    writeBin(as.integer(object@samp.rate), con, size = 4)
    writeBin(as.integer(object@samp.rate * block.align), con, size = 4)
    writeBin(as.integer(block.align), con, size = 2)
    writeBin(as.integer(object@bit), con, size = 2)
    writeChar("data", con, 4, eos = NULL)
    writeBin(as.integer(bytes), con, size = 4)

    # Write data: 
    writeBin(as.integer(sample.data), con, size = byte)
    invisible(NULL)
}
