Код:
## Equal-loudness contour function.
## May complain ISO 226:2003.
## Contains sole and nearly official numbers I*ve found in the Internet at the moment.
## Site: "http://www.mathworks.com/matlabcentral", author Jeff Tackett.
## The function valid if 20<=Freq<=12500 (Hz) and 1<=Loudness<=100 (phon).
## Adopted to R by Nikolay_Po.
EqSpl <- function(Freq,Loudness)
{
f <- c(20,25,31.5,40,50,63,80,100,125,160,200,250,315,400,500,630,800,1000,1250,1600,2000,2500,3150,4000,5000,6300,8000,10000,12500)
af <- c(0.532,0.506,0.480,0.455,0.432,0.409,0.387,0.367,0.349,0.330,0.315,0.301,0.288,0.276,0.267,0.259,0.253,0.250,0.246,0.244,0.243,0.243,0.243,0.242,0.242,0.245,0.254,0.271,0.301)
Lu <- c(-31.6,-27.2,-23.0,-19.1,-15.9,-13.0,-10.3,-8.1,-6.2,-4.5,-3.1,-2.0,-1.1,-0.4,0.0,0.3,0.5,0.0,-2.7,-4.1,-1.0,1.7,2.5,1.2,-2.1,-7.1,-11.2,-10.7,-3.1)
Tf <- c(78.5,68.7,59.5,51.1,44.0,37.5,31.5,26.5,22.1,17.9,14.4,11.4,8.6,6.2,4.4,0,2.2,2.4,3.5,1.7,-1.3,-4.2,-6.0,-5.4,-1.5,6.0,12.6,13.9,12.3)
A <- 4.47E-3*(10^(0.025*Loudness)-1.15)+(0.4*10^(((Tf+Lu)/10)-9))^af
Lp <- ((10/af)*log10(A))-Lu+94
Level <- splinefun(f,Lp,method="monoH.FC")
return (Level(Freq))
}
## Example
EqSpl(1000,80)
Результаты хорошо согласуются с данными из разных источников и очень похожи на цифры из стандарта. Автор кода-первоисточника явно ссылается на ISO 226, похоже, видел сам стандарт. Да, точно видел - ссылается на конкретные разделы.
Социальные закладки