wavmetrics in the wild !

This commit is contained in:
tTh 2024-02-07 02:36:08 +01:00
parent 49183e4153
commit cd715e902f
5 changed files with 106 additions and 11 deletions

2
Modules/.gitignore vendored
View File

@ -1,6 +1,6 @@
chkpixels
t
twavm
trnd
*.pgm

View File

@ -31,6 +31,7 @@ mathstuff2.o: mathstuff2.f90 Makefile
noisepictures.o: noisepictures.f90 Makefile
gfortran $(GFOPT) -c $<
# new: Wed Feb 7 01:27:48 UTC 2024
wavmetrics.o: wavmetrics.f90 Makefile
gfortran $(GFOPT) -c $<
@ -59,3 +60,8 @@ t_centermag: t_centermag.f90 Makefile libtth90modules.a
trnd: trnd.f90 Makefile libtth90modules.a
gfortran $(GFOPT) $< libtth90modules.a -o $@
# new: Wed Feb 7 01:27:48 UTC 2024
twavm: twavm.f90 Makefile libtth90modules.a
gfortran $(GFOPT) $< libtth90modules.a -o $@

View File

@ -3,6 +3,11 @@
## Modules disponibles
### wavmetrics
This module try to make some computations on *stereo* buffers.
This is just a [WIP](./wavmetrics.f90), see [twavm](./twavm.f90) for a no-use case.
### spitpgm
@ -32,4 +37,4 @@ See [Makefile](./Makefile) for an example.
## TODO
- écrire la doc !
- write the fscking doc !

39
Modules/twavm.f90 Normal file
View File

@ -0,0 +1,39 @@
program essai
! new: Wed Feb 7 01:27:48 UTC 2024
use mathstuff2
use wavmetrics
implicit none
write(0, *) "----------------- essai -------------------"
call run_first_test(44100/30)
contains
!-----------------------------------------------------------------------
subroutine run_first_test(nbs)
integer, intent(in) :: nbs ! nombre d'echantillons
type(intsample), allocatable :: samples(:)
type(wavmetric) :: metrics
integer :: foo, bar
write(0, '(1X, "first test on ", I0, " samples.")') nbs
! create the buffer, and fill it with garbage
allocate(samples(nbs))
do foo=1, nbs
samples(foo)%left = mod(irand(), 65534) - 32700
samples(foo)%right = mod(irand(), 60000) - 29999
enddo
! compute and display the metrics (gi-go)
call compute_wavmetric(samples, nbs, metrics)
call display_wavmetrics(metrics)
end subroutine
!-----------------------------------------------------------------------
end program

View File

@ -1,15 +1,16 @@
! new: Thu Jan 4 00:08:04 UTC 2024
module wavmetrics
! new: Thu Jan 4 00:08:04 UTC 2024
use mathstuff2
implicit none
type wavmetric
integer :: num
real :: freql, freqr
integer :: maxl, maxr
integer :: nbre ! number of slices/samples
real :: freql, freqr ! zero-crossing estimation
integer :: maxl, maxr ! maximum of abs values
real :: meanl, meanr
end type
type intsample
@ -17,14 +18,51 @@ module wavmetrics
end type
contains
!-------------------------------------------------------------
subroutine compute_wavmetric(samples, start, size, metrics)
!-
! main computation routine, still full buggy
!-
subroutine compute_wavmetric(samples, size, metrics)
type(intsample), intent(in) :: samples(:)
integer, intent(in) :: start, size
integer, intent(in) :: size
type(wavmetric), intent(out) :: metrics
integer :: Lmax, Rmax
integer :: Lval, Rval
integer :: idx
integer :: Lfreq, Rfreq
real :: Lsum, Rsum
Lmax = 0 ; Rmax = 0
Lfreq = 1 ; Rfreq = 1
Lsum = 0.0 ; Rsum = 0.0
do idx=1, size
Lval = samples(idx)%left
Rval = samples(idx)%right
! print *, Rval, Lval
if (abs(Lval) .GT. Lmax) Lmax = abs(Lval)
if (abs(Rval) .GT. Rmax) Rmax = abs(Rval)
if (idx .GT. 1) then
if (diff_sign(samples(idx-1)%left, Lval)) Lfreq = Lfreq + 1
if (diff_sign(samples(idx-1)%right, Lval)) Rfreq = Rfreq + 1
endif
Lsum = Lsum + Lval
Rsum = Rsum + Rval
enddo
metrics%num = size
metrics%maxl = Lmax ; metrics%maxr = Rmax
metrics%freql = 1.0 / (Lfreq / real(size))
metrics%freqr = 1.0 / (Rfreq / real(size))
metrics%meanl = Lsum / real(size)
metrics%meanr = Rsum / real(size)
end subroutine
!-------------------------------------------------------------
@ -32,6 +70,13 @@ end subroutine
subroutine display_wavmetrics(metrics)
type(wavmetric), intent(in) :: metrics
! print '(1X, "metrics are :")'
print '(1X, " | num ", I0)', metrics%num
print '(1X, " | freq ", 2F12.2)', metrics%freql, metrics%freqr
print '(1X, " | mean ", 2F12.2)', metrics%meanl, metrics%meanr
print '(1X, " | maxi ", 2I8)', metrics%maxl, metrics%maxr
end subroutine
!-------------------------------------------------------------