Hi guys. I have created plugins for shorttime analysis, use as you want.
(the code was originaly written in Slovak, please notify me, if there are some problem caused by translation)
Energy
;; Copyright 2014, Michal Matúšov
;;Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
;;Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License.
;nyquist plug-in
;version 3
;type analyze
;name "Energy"
;action "Calculing energy"
; lenght of window equals to lenght of microsegment
;control window-ms "Window lenght" int "ms" 10 5 80
; election of window
; rectangular window multipliy by 1, so it has the index 1
;control window-typ "Typ okna" choice "Hammingove okno, Pravouhlé okno" 0
; this module works with one-channel sound only
; if the sound is multichanel, it will analyse the first (left) channel
(if (arrayp s) (setf sound (aref s 0)) (setf sound s))
;--------------------------------------
; calculation of some important times and counts
; lenght of window in ms is converted to float to simplify calculations
(setf window-ms (float window-ms))
; lenght of window in sec (float)
(setf window-s (/ window-ms 1000))
; exact lenght of original sellection (seconds) (float)
(setf lenght-orig (/ len *sound-srate*))
; this module works with sound of maximal lenght of 1 sec
; if the sound is longer, the module analyse only the first 1 sec
(setf lenght-orig-n (if (> lenght-orig 1) 1 lenght-orig))
; count of microsegments in the sellection (int)
(setf countsegm (truncate (/ lenght-orig-n window-s)))
; lenght of proccesed selection (seconds) - it trunk part of the end, that don't fit to last microsegment (float)
(setf lenght-proc (* countsegm window-s))
; lenght of interval between 2 samples
(setf rv (/ 1 *sound-srate*))
; avarage number of samples in segment
(setf samplesinsegm (truncate (/ window-s rv)))
;------------------------------------------
; definition of the function
; shorttime energy
(defun energy (ordersegm)
(let ((valuesegm 0))
(dotimes (ordersample samplesinsegm valuesegm)
(setq valuesegm (+ valuesegm (expt (* (sref sound (+ (* ordersegm window-s) (* ordersample rv))) (if (= window-typ 0) (- 0.54 (* 0.46 (cos (/ (* 2 pi (- (- samplesinsegm 1) ordersample)) (- samplesinsegm 1))))) 1)) 2))))))
;---------------------------------
; tagging whole processed part
; list to be filled by triples (time-begin time-end text-of-label)
(setf list-of-labels nil)
; this function add new label to the list
(defun add-new-label (tbegin tend text)
(setq list-of-labels (cons (list tbegin tend text) list-of-labels)))
; tagging
(dotimes (ordersegm countsegm) (add-new-label (* ordersegm window-s) (* (1+ ordersegm) window-s) (format nil "~a" (energy ordersegm))))
;----------------------------------------
; printout
; warning if window is of negative lenght
; printout if the list is filled in, warning otherwise
(if (<= window-ms 0) "Error!nLenght of window must be higher than 1."
(if (null list-of-labels)
"Error!nProbably yu elected shorter selection than window."
list-of-labels))
Intensity
;; Copyright 2014, Michal Matúšov
;;Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
;;Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License.
;nyquist plug-in
;version 3
;type analyze
;name "Intensity"
;action "Calculing intensity"
; lenght of window equals to lenght of microsegment
;control window-ms "Window lenght" int "ms" 10 5 80
; election of window
; rectangular window multipliy by 1, so it has the index 1
;control window-typ "Typ okna" choice "Hammingove okno, Pravouhlé okno" 0
; this module works with one-channel sound only
; if the sound is multichanel, it will analyse the first (left) channel
(if (arrayp s) (setf sound (aref s 0)) (setf sound s))
;--------------------------------------
; calculation of some important times and counts
; lenght of window in ms is converted to float to simplify calculations
(setf window-ms (float window-ms))
; lenght of window in sec (float)
(setf window-s (/ window-ms 1000))
; exact lenght of original sellection (seconds) (float)
(setf lenght-orig (/ len *sound-srate*))
; this module works with sound of maximal lenght of 1 sec
; if the sound is longer, the module analyse only the first 1 sec
(setf lenght-orig-n (if (> lenght-orig 1) 1 lenght-orig))
; count of microsegments in the sellection (int)
(setf countsegm (truncate (/ lenght-orig-n window-s)))
; lenght of proccesed selection (seconds) - it trunk part of the end, that don't fit to last microsegment (float)
(setf lenght-proc (* countsegm window-s))
; lenght of interval between 2 samples
(setf rv (/ 1 *sound-srate*))
; avarage number of samples in segment
(setf samplesinsegm (truncate (/ window-s rv)))
;------------------------------------------
; definition of the function
; shortime intensity
(defun intensity (ordersegm)
(let ((valuesegm 0))
(dotimes (ordersample samplesinsegm valuesegm)
(setq valuesegm (+ valuesegm (* (abs (sref zvuk (+ (* ordersegm window-s) (* ordersample rv)))) (if (= window-typ 0) (- 0.54 (* 0.46 (cos (/ (* 2 pi (- (- samplesinsegm 1) ordersample)) (- samplesinsegm 1))))) 1)))))))
;---------------------------------
; tagging whole processed part
; list to be filled by triples (time-begin time-end text-of-label)
(setf list-of-labels nil)
; this function add new label to the list
(defun add-new-label (tbegin tend text)
(setq list-of-labels (cons (list tbegin tend text) list-of-labels)))
; tagging
(dotimes (ordersegm countsegm) (add-new-label (* ordersegm window-s) (* (1+ ordersegm) window-s) (format nil "~a" (intensity ordersegm))))
;----------------------------------------
; printout
; warning if window is of negative lenght
; printout if the list is filled in, warning otherwise
(if (<= window-ms 0) "Error!nLenght of window must be higher than 1."
(if (null list-of-labels)
"Error!nProbably yu elected shorter selection than window."
list-of-labels))
Zero crossing
;; Copyright 2014, Michal Matúšov
;;Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
;;Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License.
;nyquist plug-in
;version 1
;type analyze
;name "Zero crossing"
;action "Calculing zero crossings"
; lenght of window equals to lenght of microsegment
;control window-ms "Window lenght" int "ms" 10 5 80
; this module works with one-channel sound only
; if the sound is multichanel, it will analyse the first (left) channel
(if (arrayp s) (setf sound (aref s 0)) (setf sound s))
;--------------------------------------
; calculation of some important times and counts
; lenght of window in ms is converted to float to simplify calculations
(setf window-ms (float window-ms))
; lenght of window in sec (float)
(setf window-s (/ window-ms 1000))
; exact lenght of original sellection (seconds) (float)
(setf lenght-orig (/ len *sound-srate*))
; this module works with sound of maximal lenght of 1 sec
; if the sound is longer, the module analyse only the first 1 sec
(setf lenght-orig-n (if (> lenght-orig 1) 1 lenght-orig))
; count of microsegments in the sellection (int)
(setf countsegm (truncate (/ lenght-orig-n window-s)))
; lenght of proccesed selection (seconds) - it trunk part of the end, that don't fit to last microsegment (float)
(setf lenght-proc (* countsegm window-s))
; lenght of interval between 2 samples
(setf rv (/ 1 *sound-srate*))
;------------------------------------------
; definition of the function
; subfunction sgn
(defun sgn (k) (if (>= (sref sound k) 0) 1 -1))
; zero crossing
(defun zerocross (ordersegm)
(let ((valuesegm 0))
(dotimes (ordersample (truncate (/ window-s rv)) valuesegm)
(setq valuesegm (+ valuesegm (abs (- (sgn (+ (* ordersegm window-s) (* ordersample rv))) (sgn (+ (* ordersegm window-s) (* (1- ordersample) rv))))))))))
;---------------------------------
; tagging whole processed part
; list to be filled by triples (time-begin time-end text-of-label)
(setf list-of-labels nil)
; this function add new label to the list
(defun add-new-label (tbegin tend text)
(setq list-of-labels (cons (list tbegin tend text) list-of-labels)))
; tagging
(dotimes (porsegm pocetsegm) (pridat-menovku (* porsegm window-s) (* (1+ porsegm) window-s) (format nil "~a" (zerocross porsegm))))
;----------------------------------------
; printout
; warning if window is of negative lenght
; printout if the list is filled in, warning otherwise
(if (<= window-ms 0) "Error!nLenght of window must be higher than 1."
(if (null list-of-labels)
"Error!nProbably yu elected shorter selection than window."
list-of-labels))
Autocorrelation
;; Copyright 2014, Michal Matúšov
;;Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
;;Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License.
;nyquist plug-in
;version 3
;type analyze
;name "Autocorrelation"
;action "Calculing autocorrelation"
; lenght of window equals to lenght of microsegment
;control window-ms "Window lenght" int "ms" 10 5 80
;control shift "Shift" int "ms" 10 1 50
; election of window
; rectangular window multipliy by 1, so it has the index 1
;control window-typ "Typ okna" choice "Hammingove okno, Pravouhlé okno" 0
; this module works with one-channel sound only
; if the sound is multichanel, it will analyse the first (left) channel
(if (arrayp s) (setf sound (aref s 0)) (setf sound s))
;--------------------------------------
; calculation of some important times and counts
; lenght of window in ms is converted to float to simplify calculations
(setf window-ms (float window-ms))
; lenght of window in sec (float)
(setf window-s (/ window-ms 1000))
; exact lenght of original sellection (seconds) (float)
(setf lenght-orig (/ len *sound-srate*))
; this module works with sound of maximal lenght of 1 sec
; if the sound is longer, the module analyse only the first 1 sec
(setf lenght-orig-n (if (> lenght-orig 1) 1 lenght-orig))
; count of microsegments in the sellection (int)
(setf countsegm (truncate (/ lenght-orig-n window-s)))
; lenght of proccesed selection (seconds) - it trunk part of the end, that don't fit to last microsegment (float)
(setf lenght-proc (* countsegm window-s))
; lenght of interval between 2 samples
(setf rv (/ 1 *sound-srate*))
; avarage number of samples in segment
(setf samplesinsegm (truncate (/ window-s rv)))
; shift - diff between processed samples
(setf m (/ (float shift) 1000))
;------------------------------------------
; definition of the function
; Autocorrelation
(defun autocorrelation (ordersegm shifted)
(let ((valuesegm 0))
(dotimes (ordersample samplesinsegm valuesegm)
(setq valuesegm (+ valuesegm (*
(sref sound (+ (* ordersegm window-s) (* ordersample rv)))
(if (= window-typ 0) (- 0.54 (* 0.46 (cos (/ (* 2 pi (- (- samplesinsegm 1) ordersample)) (- samplesinsegm 1))))) 1)
(sref sound (+ (* ordersegm window-s) (* ordersample rv) shifted))
(if (= window-typ 0) (- 0.54 (* 0.46 (cos (/ (* 2 pi (- (1- samplesinsegm) ordersample shifted)) (- samplesinsegm 1))))) 1)))))))
;---------------------------------
; tagging whole processed part
; list to be filled by triples (time-begin time-end text-of-label)
(setf list-of-labels nil)
; this function add new label to the list
(defun add-new-label (tbegin tend text)
(setq list-of-labels (cons (list tbegin tend text) list-of-labels)))
; tagging
(dotimes (ordersegm countsegm) (add-new-label (* ordersegm window-s) (* (1+ ordersegm) window-s) (format nil "~a" (autocorrelation ordersegm m))))
;----------------------------------------
; printout
; warning if window is of negative lenght
; printout if the list is filled in, warning otherwise
(if (<= window-ms 0) "Error!nLenght of window must be higher than 1."
(if (null list-of-labels)
"Error!nProbably yu elected shorter selection than window."
list-of-labels))