Astronomik Ha Filter

library(ggplot2)

filter.parameters <- function(x, y, peak=NULL, range=100) {

  df <- data.frame(x, y)

  if (is.null(peak)) {
    maximum <- df[which.max(df$y),]
  } else {
    lo <- subset(df, x > peak-range)
    hi <- subset(df, x < peak+range)
    df <- merge(lo, hi, by="x")
    df <- df[,1:2]
    names(df) <- c("x","y")
    maximum <- df[which.max(df$y),]
  }

  lo <- subset(df, x<maximum$x & x>maximum$x-range & y<maximum$y/2)
  hi <- subset(df, x<maximum$x & x>maximum$x-range & y>maximum$y/2)
  x0 <- (lo[which.max(lo$x),1] + hi[which.min(hi$x),1]) / 2

  lo <- subset(df, x>maximum$x & x<maximum$x+range & y<maximum$y/2)
  hi <- subset(df, x>maximum$x & x<maximum$x+range & y>maximum$y/2)
  x1 <- (lo[which.min(lo$x),1] + hi[which.max(hi$x),1]) / 2

  list(center=(x1+x0)/2, fwhm=x1-x0, peak=maximum$y)
}

Read filter data

data <- read.csv("Astronomik Ha Filter.csv", col.names=c("wavelength","t","X"))[,1:2]

Plot transmission curves

ggplot(data) +
    geom_line(aes(x=wavelength, y=t), color="darkred") +
    labs(title="Astronomik Hα Filter", x="Wavelength [nm]", y="Transmission [%]") + 
    coord_cartesian(xlim=c(300, 850), ylim=c(0.0,100.0)) +
    theme_bw()

Parameters for Astronomik Hα Filter

filter.parameters(data$wavelength, data$t)

## $center
## [1] 657.25
## 
## $fwhm
## [1] 24.59998
## 
## $peak
## [1] 97.80981