void structHyperPage :: v_dataChanged () {
int oldError = Melder_hasError (); // this method can be called during error time
(void) v_goToPage (currentPageTitle);
if (Melder_hasError () && ! oldError) Melder_flushError (NULL);
HyperPage_clear (this);
updateVerticalScrollBar (this);
}
TableOfReal CCA_and_TableOfReal_predict (CCA me, TableOfReal thee, long from)
{
TableOfReal him = NULL;
long ny = my y -> dimension, nx = my x -> dimension;
long i, j, k, ncols, nev = my y -> numberOfEigenvalues;
double *buf = NULL, **v = my y -> eigenvectors;
double *d = my y -> eigenvalues;
/*
We can only predict when we have the largest dimension as input
and the number of coefficients equals the dimension of the smallest.
*/
if (ny != nev) return Melder_errorp1 (L"There are not enough correlations present for prediction.");
if (from == 0) from = 1;
ncols = thy numberOfColumns - from + 1;
if (from < 1 || ncols != nx) return Melder_errorp3 (L"The number of columns to analyze must be equal to ",
Melder_integer (nx), L".");
/* ???? dimensions if nx .. ny ?? */
him = Eigen_and_TableOfReal_project (my x, thee, from, ny);
if (him == NULL) return NULL;
buf = NUMdvector (1, ny);
if (buf == NULL) goto end;
/*
u = V a -> a = V'u
*/
for (i = 1; i <= thy numberOfRows; i++)
{
NUMdvector_copyElements (his data[i], buf, 1, ny);
for (j = 1; j <= ny; j++)
{
double t = 0;
for (k = 1; k <= ny; k++)
{
t += sqrt (d[k]) * v[k][j] * buf[k];
}
his data [i][j] = t;
}
}
end:
NUMdvector_free (buf, 1);
if (Melder_hasError ()) forget (him);
return him;
}
Activation FFNet_Categories_to_Activation (FFNet me, Categories thee)
{
Activation him = NULL;
Categories uniq;
long i, nl, cSize = thy size, hasCategories = 1;
uniq = Categories_selectUniqueItems (thee, 1);
if (uniq == NULL) Melder_error1 (L"There is not enough memory to create a Categories.");
if (my outputCategories == NULL)
{
if (my nUnitsInLayer[my nLayers] == uniq -> size)
{
my outputCategories = uniq;
hasCategories = 0;
}
else
{
(void) Melder_error1 (L"");
goto end;
}
}
else if (! ( (nl = OrderedOfString_isSubsetOf (uniq, my outputCategories, NULL)) &&
nl == uniq -> size && my nOutputs >= uniq -> size))
{
(void) Melder_error1 (L"The Categories do not match the categories of the FFNet.");
goto end;
}
him = Activation_create (cSize, my nOutputs);
if (him == NULL) goto end;
for (i=1; i <= cSize; i++)
{
long pos = OrderedOfString_indexOfItem_c (my outputCategories, OrderedOfString_itemAtIndex_c (thee, i));
if (pos < 1)
{
(void) Melder_error3 (L"The FFNet doesn't know the category ", OrderedOfString_itemAtIndex_c (thee, i), L" from Categories.");
goto end;
}
his z[i][pos] = 1.0;
}
end:
if (hasCategories) forget (uniq);
if (Melder_hasError ()) forget (him);
return him;
}
Index Index_extractPart (I, long from, long to)
{
iam (Index);
Index thee;
long i;
if (from == 0) from = 1;
if (to == 0) to = my numberOfElements;
if (to < from || from < 1 || to > my numberOfElements) return Melder_errorp
("Index_extractPart: range should be in interval [1,%d].", my numberOfElements);
if ((thee = Data_copy (me)) == NULL) return NULL;
thy numberOfElements = to - from + 1;
/* */
for (i = 1; i <= thy numberOfElements; i++)
{
thy classIndex[i] = my classIndex[from + i - 1];
}
/* Claim excess memory */
if (Melder_hasError ()) forget (thee);
return thee;
}
Collection FFNet_createIrisExample (long numberOfHidden1, long numberOfHidden2)
{
TableOfReal iris = NULL;
Collection c = NULL;
FFNet me = NULL;
Pattern thee = NULL;
Categories him = NULL, uniq = NULL;
long i, j;
MelderString ffnetname = { 0 };
if (! (c = Collection_create (classData, 3)) ||
! (uniq = Categories_sequentialNumbers (3)) ||
! (me = FFNet_create (4, numberOfHidden1, numberOfHidden2, 3, 0)) ||
! FFNet_setOutputCategories (me, uniq) ||
! Collection_addItem (c, me) ||
! (iris = TableOfReal_createIrisDataset ()) ||
! TableOfReal_to_Pattern_and_Categories (iris, 0, 0, 0, 0, &thee, &him) ||
! Collection_addItem (c, thee) ||
! Collection_addItem (c, him)) goto end;
/*
Scale data to interval [0-1]
*/
for (i = 1; i <= 150; i++)
{
for (j = 1; j <= 4; j++) thy z[i][j] /= 10.0;
}
FFNet_createNameFromTopology (me, &ffnetname);
Thing_setName (me, ffnetname.string);
Thing_setName (thee, L"iris");
Thing_setName (him, L"iris");
MelderString_free (&ffnetname);
end:
forget (uniq); forget (iris);
if (! Melder_hasError()) return c;
forget (c);
return NULL;
}
TableOfReal Matrix_and_Categories_to_TableOfReal (I, Categories thee)
{
iam (Matrix); TableOfReal him; long i, j;
if (thy size != my ny) return Melder_errorp1 (L"Matrix_and_Categories_to_TableOfReal: "
"number of rows and number of categories must be equal.");
if (! (him = TableOfReal_create (my ny, my nx)) ||
! TableOfReal_setSequentialColumnLabels (him, 0, 0, NULL, 1, 1)) goto end;
for (i = 1; i <= my ny; i++)
{
if (! (his rowLabels[i] = Melder_wcsdup_e (OrderedOfString_itemAtIndex_c (thee, i)))) goto end;
}
for (i = 1; i <= my ny; i++)
{
for (j = 1; j <= my nx; j++) his data[i][j] = my z[i][j];
}
end:
if (Melder_hasError()) forget (him);
return him;
}
CCA TableOfReal_to_CCA (TableOfReal me, long ny)
{
CCA thee = NULL;
SVD svdy = NULL, svdx = NULL, svdc = NULL;
double fnormy, fnormx, **uy, **vy, **ux, **vx, **uc, **vc;
double **evecy, **evecx;
long i, j, q, n = my numberOfRows;
long numberOfZeroedy, numberOfZeroedx, numberOfZeroedc;
long numberOfCoefficients;
long nx = my numberOfColumns - ny;
if (ny < 1 || ny > my numberOfColumns - 1) return Melder_errorp1 (L"Dimension of first part not correct.");
if (! TableOfReal_areAllCellsDefined (me, 0, 0, 0, 0)) return NULL;
/*
The dependent 'part' of the CCA should be the smallest dimension.
*/
if (ny > nx) return Melder_errorp5 (L"The dimension of the dependent "
"part (", Melder_integer (ny), L") must be less than or equal to the dimension of the "
"independent part (", Melder_integer (nx), L").");
if (n < ny) return Melder_errorp2 (L"The number of "
"observations must be larger then ", Melder_integer (ny));
/*
Use svd as (temporary) storage, and copy data
*/
svdy = SVD_create (n, ny);
if (svdy == NULL) goto end;
svdx = SVD_create (n, nx);
if (svdx == NULL) goto end;
for (i = 1; i <= n; i++)
{
for (j = 1; j <= ny; j++)
{
svdy -> u[i][j] = my data[i][j];
}
for (j = 1; j <= nx; j++)
{
svdx -> u[i][j] = my data[i][ny + j];
}
}
uy = svdy -> u; vy = svdy -> v;
ux = svdx -> u; vx = svdx -> v;
fnormy = NUMfrobeniusnorm (n, ny, uy);
fnormx = NUMfrobeniusnorm (n, nx, ux);
if (fnormy == 0 || fnormx == 0)
{
(void) Melder_errorp1 (L"One of the parts of the table contains only zeros.");
goto end;
}
/*
Centre the data and svd it.
*/
NUMcentreColumns (uy, 1, n, 1, ny, NULL);
NUMcentreColumns (ux, 1, n, 1, nx, NULL);
if (! SVD_compute (svdy) || ! SVD_compute (svdx)) goto end;
numberOfZeroedy = SVD_zeroSmallSingularValues (svdy, 0);
numberOfZeroedx = SVD_zeroSmallSingularValues (svdx, 0);
/*
Form the matrix C = ux' uy (use svd-object storage)
*/
svdc = SVD_create (nx, ny);
if (svdc == NULL) goto end;
uc = svdc -> u; vc = svdc -> v;
for (i = 1; i <= nx; i++)
{
for (j = 1; j <= ny; j++)
{
double t = 0;
for (q = 1; q <= n; q++)
{
t += ux[q][i] * uy[q][j];
}
uc[i][j] = t;
}
}
if (! SVD_compute (svdc)) goto end;
numberOfZeroedc = SVD_zeroSmallSingularValues (svdc, 0);
numberOfCoefficients = ny - numberOfZeroedc;
thee = CCA_create (numberOfCoefficients, ny, nx);
if (thee == NULL) goto end;
thy yLabels = strings_to_Strings (my columnLabels, 1, ny);
if ( thy yLabels == NULL) goto end;
thy xLabels = strings_to_Strings (my columnLabels, ny+1, my numberOfColumns);
if ( thy xLabels == NULL) goto end;
evecy = thy y -> eigenvectors;
evecx = thy x -> eigenvectors;
thy numberOfObservations = n;
/*
Y = Vy * inv(Dy) * Vc
X = Vx * inv(Dx) * Uc
For the eigenvectors we want a row representation:
colums(Y) = rows(Y') = rows(Vc' * inv(Dy) * Vy')
colums(X) = rows(X') = rows(Uc' * inv(Dx) * Vx')
rows(Y') = evecy[i][j] = Vc[k][i] * Vy[j][k] / Dy[k]
rows(X') = evecx[i][j] = Uc[k][i] * Vx[j][k] / Dx[k]
*/
for (i = 1; i <= numberOfCoefficients; i++)
{
double ccc = svdc -> d[i];
thy y -> eigenvalues[i] = thy x -> eigenvalues[i] = ccc * ccc;
for (j = 1; j <= ny; j++)
{
double t = 0;
for (q = 1; q <= ny - numberOfZeroedy; q++)
{
t += vc[q][i] * vy[j][q] / svdy -> d[q];
}
evecy[i][j] = t;
}
for (j = 1; j <= nx; j++)
{
double t = 0;
for (q = 1; q <= nx - numberOfZeroedx; q++)
{
t += uc[q][i] * vx[j][q] / svdx -> d[q];
}
evecx[i][j] = t;
}
}
/*
Normalize eigenvectors.
*/
NUMnormalizeRows (thy y -> eigenvectors, numberOfCoefficients, ny, 1);
NUMnormalizeRows (thy x -> eigenvectors, numberOfCoefficients, nx, 1);
end:
forget (svdy);
forget (svdx);
forget (svdc);
Melder_assert (thy x -> dimension == thy xLabels -> numberOfStrings &&
thy y -> dimension == thy yLabels -> numberOfStrings);
if (Melder_hasError ()) forget (thee);
return thee;
}
Pitch SPINET_to_Pitch (SPINET me, double harmonicFallOffSlope, double ceiling, int maxnCandidates)
{
Pitch thee = NULL;
long i, j, k, m, nPointsPerOctave = 48;
double fmin = NUMerbToHertz (Sampled2_rowToY (me, 1));
double fmax = NUMerbToHertz (Sampled2_rowToY (me, my ny));
double fminl2 = NUMlog2 (fmin), fmaxl2 = NUMlog2 (fmax);
double points = (fmaxl2 - fminl2) * nPointsPerOctave;
double dfl2 = (fmaxl2 - fminl2) / (points - 1);
long nFrequencyPoints = points;
long maxHarmonic = fmax / fmin;
double maxStrength = 0, unvoicedCriterium = 0.45;
double maxPower = 0, *sumspec = NULL, *power = NULL;
double *y = NULL, *y2 = NULL, *pitch = NULL, *fl2 = NULL;
if (nFrequencyPoints < 2) return Melder_errorp1 (L"SPINET_to_Pitch: frequency range too small.");
if (ceiling <= fmin) return Melder_errorp1 (L"SPINET_to_Pitch: ceiling is smaller than centre "
"frequency of lowest filter.");
if (! (thee = Pitch_create (my xmin, my xmax, my nx, my dx, my x1,
ceiling, maxnCandidates)) ||
! (power = NUMdvector (1, my nx)) ||
! (pitch = NUMdvector (1, nFrequencyPoints)) ||
! (sumspec = NUMdvector (1, nFrequencyPoints)) ||
! (y = NUMdvector (1, my ny)) ||
! (y2 = NUMdvector (1, my ny)) ||
! (fl2 = NUMdvector (1, my ny))) goto cleanup;
/*
From ERB's to log (f)
*/
for (i=1; i <= my ny; i++)
{
double f = NUMerbToHertz (my y1 + (i - 1) * my dy);
fl2[i] = NUMlog2 (f);
}
/*
Determine global maximum power in frame
*/
for (j=1; j <= my nx; j++)
{
double p = 0;
for (i=1; i <= my ny; i++) p += my s[i][j];
if (p > maxPower) maxPower = p;
power[j] = p;
}
if (maxPower == 0) goto cleanup;
for (j=1; j <= my nx; j++)
{
Pitch_Frame pitchFrame = &thy frame[j];
pitchFrame->intensity = power[j] / maxPower;
for (i=1; i <= my ny; i++) y[i] = my s[i][j];
if (! NUMspline (fl2, y, my ny, 1e30, 1e30, y2)) goto cleanup;
for (k=1; k <= nFrequencyPoints; k++)
{
double f = fminl2 + (k-1) * dfl2;
NUMsplint (fl2, y, y2, my ny, f, & pitch[k]);
sumspec[k] = 0;
}
/*
Formula (8): weighted harmonic summation.
*/
for (m=1; m <= maxHarmonic; m++)
{
double hm = 1 - harmonicFallOffSlope * NUMlog2 (m);
long kb = 1 + floor (nPointsPerOctave * NUMlog2 (m));
for (k=kb; k <= nFrequencyPoints; k++)
{
if (pitch[k] > 0) sumspec[k-kb+1] += pitch[k] * hm;
}
}
/*
into Pitch object
*/
if (! Pitch_Frame_init (pitchFrame, maxnCandidates)) goto cleanup;
pitchFrame->nCandidates = 0; /* !!!!! */
Pitch_Frame_addPitch (pitchFrame, 0, 0, maxnCandidates); /* unvoiced */
for (k=2; k <= nFrequencyPoints-1; k++)
{
double y1 = sumspec[k-1], y2 = sumspec[k], y3 = sumspec[k+1];
if (y2 > y1 && y2 >= y3)
{
double denum = y1 - 2 * y2 + y3, tmp = y3 - 4 * y2;
double x = dfl2 * (y1 - y3) / (2 * denum);
double f = pow (2, fminl2 + (k - 1) * dfl2 + x);
double strength = (2 * y1 * (4 * y2 + y3) - y1 * y1 - tmp * tmp) / (8 * denum);
if (strength > maxStrength) maxStrength = strength;
Pitch_Frame_addPitch (pitchFrame, f, strength, maxnCandidates);
}
}
}
/*
Scale the pitch strengths
*/
for (j=1; j <= my nx; j++)
{
double f0, localStrength;
Pitch_Frame_getPitch (&thy frame[j], &f0, &localStrength);
Pitch_Frame_resizeStrengths (&thy frame[j], localStrength / maxStrength, unvoicedCriterium);
}
cleanup:
NUMdvector_free (pitch, 1); NUMdvector_free (sumspec, 1);
NUMdvector_free (y, 1); NUMdvector_free (y2, 1);
NUMdvector_free (fl2, 1);NUMdvector_free (power, 1);
if (! Melder_hasError()) return thee;
forget (thee);
return Melder_errorp1 (L"SPINET_to_Pitch: not performed.");
}
SPINET Sound_to_SPINET (Sound me, double timeStep, double windowDuration,
double minimumFrequencyHz, double maximumFrequencyHz, long nFilters,
double excitationErbProportion, double inhibitionErbProportion)
{
Sound window = NULL, frame = NULL; SPINET thee = NULL;
long i, j, k, numberOfFrames;
double firstTime, b = 1.02, samplingFrequency = 1 / my dx;
double *f = NULL, *bw = NULL, *aex = NULL, *ain = NULL;
if (timeStep < my dx) timeStep = my dx;
if (maximumFrequencyHz > samplingFrequency / 2) maximumFrequencyHz = samplingFrequency / 2;
if (! Sampled_shortTermAnalysis (me, windowDuration, timeStep, &numberOfFrames, &firstTime) ||
! (thee = SPINET_create (my xmin, my xmax, numberOfFrames, timeStep, firstTime,
minimumFrequencyHz, maximumFrequencyHz, nFilters,
excitationErbProportion, inhibitionErbProportion)) ||
! (window = Sound_createGaussian (windowDuration, samplingFrequency)) ||
! (frame = Sound_createSimple (1, windowDuration, samplingFrequency)) ||
! (f = NUMdvector (1, nFilters)) || ! (bw = NUMdvector (1, nFilters)) ||
! (aex = NUMdvector (1, nFilters)) || ! (ain = NUMdvector (1, nFilters))) goto cleanup;
/*
Cochlear filterbank: gammatone
*/
for (i=1; i <= nFilters; i++)
{
f[i] = NUMerbToHertz (thy y1 + (i - 1) * thy dy);
bw[i] = 2 * NUMpi * b * (f[i] * (6.23e-6 * f[i] + 93.39e-3) + 28.52);
}
Melder_progress1 (0.0, L"SPINET analysis");
for (i=1; i <= nFilters; i++)
{
Sound gammaTone = NULL, filtered = NULL;
/* Contribution of outer & middle ear and phase locking */
double bb = (f[i] / 1000) * exp (- f[i] / 1000);
/* Time where gammafunction envelope has its maximum */
double tgammaMax = (thy gamma - 1) / bw[i];
/* Amplitude at tgammaMax */
double gammaMaxAmplitude = pow ((thy gamma - 1) / (NUMe * bw[i]), (thy gamma - 1));
double timeCorrection = tgammaMax - windowDuration / 2;
if (! (gammaTone = Sound_createGammaTone (0, 0.1, samplingFrequency,
thy gamma, b, f[i], 0, 0, 0)) ||
/* filtering can be made 30% faster by taking Spectrum(me) outside the loop */
! (filtered = Sounds_convolve (me, gammaTone, kSounds_convolve_scaling_SUM, kSounds_convolve_signalOutsideTimeDomain_ZERO))) { forget (gammaTone); goto cleanup; }
/*
To energy measure: weigh with broad-band transfer function
*/
for (j=1; j <= numberOfFrames; j++)
{
Sound_into_Sound (filtered, frame, Sampled_indexToX (thee, j) + timeCorrection);
Sounds_multiply (frame, window);
thy y[i][j] = Sound_power (frame) * bb / gammaMaxAmplitude;
}
forget (filtered); forget (gammaTone);
if (! Melder_progress5 ((double)i / nFilters, L"SPINET: filter ", Melder_integer (i), L" from ",
Melder_integer (nFilters), L".")) goto cleanup;
}
/*
Excitatory and inhibitory area functions
*/
for (i=1; i <= nFilters; i++)
{
for (k=1; k <= nFilters; k++)
{
double fr = (f[k] - f[i]) / bw[i];
aex[i] += fgamma (fr / thy excitationErbProportion, thy gamma);
ain[i] += fgamma (fr / thy inhibitionErbProportion, thy gamma);
}
}
/*
On-center off-surround interactions
*/
for (j=1; j <= numberOfFrames; j++)
for (i=1; i <= nFilters; i++)
{
double a = 0;
for (k=1; k <= nFilters; k++)
{
double fr = (f[k] - f[i]) / bw[i];
double hexsq = fgamma (fr / thy excitationErbProportion, thy gamma);
double hinsq = fgamma (fr / thy inhibitionErbProportion, thy gamma);
a += thy y[k][j] * (hexsq / aex[i] - hinsq / ain[i]);
}
thy s[i][j] = a > 0 ? a : 0;
}
Melder_progress1 (1.0, NULL);
cleanup:
NUMdvector_free (aex, 1); NUMdvector_free (ain, 1);
NUMdvector_free (f, 1); NUMdvector_free (bw, 1);
forget (window); forget (frame);
if (! Melder_hasError()) return thee;
forget (thee);
return Melder_errorp1 (L"Sound_to_SPINET: not performed.");
}
