I now currently try to read .wav file using delphi here is my code :
type
TWaveHeader = packed record
Marker_RIFF: array [0..3] of char;
ChunkSize: cardinal;
Marker_WAVE: array [0..3] of char;
Marker_fmt: array [0..3] of char;
SubChunkSize: cardinal;
FormatTag: word;
NumChannels: word;
SampleRate: longint;
BytesPerSecond: longint;
BytesPerSample: word;
BitsPerSample: word;
Marker_data: array [0..3] of char;
DataBytes: longint;
end;
TChannel = record
Data : array of double;
end;
some private delcaration
private
wavehdr:TWaveHeader;
wavedata:array[0..3]of TChannel;
numsamples:integer;
the function
FillChar(wavehdr, sizeof(wavehdr), 0);
Stream.Read(wavehdr, sizeof(wavehdr));
{ Log Header data }
with memo1.Lines do begin
Add('Filename : '+od.FileName);
Add('Header size : '+inttostr(sizeof(wavehdr)));
tmpstr := wavehdr.Marker_RIFF;
Add('RIFF ID : '+tmpstr+'');
Add('Chunk size : '+inttostr(wavehdr.ChunkSize));
tmpstr := wavehdr.Marker_WAVE;
Add('WAVE ID : '+tmpstr+'');
tmpstr := wavehdr.Marker_fmt;
Add('''fmt '' ID : '+tmpstr+''' ');
Add('SubChunk size : '+inttostr(wavehdr.SubChunkSize));
Add('Format : '+inttostr(wavehdr.FormatTag));
Add('Num Channels : '+inttostr(wavehdr.NumChannels));
Add('Sample rate : '+inttostr(wavehdr.SampleRate));
Add('Bytes per second : '+inttostr(wavehdr.BytesPerSecond));
Add('Bits per sample : '+inttostr(wavehdr.BitsPerSample));
Add('Block Align : '+inttostr((wavehdr.NumChannels*wavehdr.BitsPerSample)div 8));
end;
numsamples := (file.size div (wavehdr.NumChannels*wavehdr.BitsPerSample)div 8) div wavehdr.BytesPerSample;
case wavehdr.NumChannels of
1:begin
SetLength(wavedata[0].Data, numsamples);
Stream.Read(wavedata[0].Data[0], numsamples);
end;
2:begin
SetLength(wavedata[0].Data, numsamples);
SetLength(wavedata[1].Data, numsamples);
for i := 0 to high(wavedata[0].Data) do begin
Stream.Read(wavedata[0].Data[i], 2);
Stream.Read(wavedata[1].Data[i], 2);
end;
end;
end;
Above code give me the exact same information and detail about the .wav header (same as MATLAB DOES) which is :
Filename : E:\dephi\classic3.wav
RIFF ID : RIFF
Chunk size : 18312354
WAVE ID : WAVE
'fmt ' ID : fmt '
SubChunk size : 16
Format : 1 (PCM)
Num Channels : 2 (Stereo)
Sample rate : 44100
Bytes per second : 176400
Bits per sample : 16
Block Align : 4
Except the Total Sample Data Which i calculated by (size of wavedata/ blockalign of wavedata)-44, 44 is header of wav. It's not accurate, sometimes is miss by 5,1,10 . I have only tested using 5 sample.And here an example :
classic1.wav matlab:3420288, delphi(my calculation):(13681352/4)-44= 3420294
classic2.wav matlab:2912256, delphi(my calculation):(11649204/4)-44= 2912257
And also the sample data value from matlab and delphi is different like
classic1.wav
MATLAB:(first 10 value leftchannel and rightchannel)
-3.05175781250000e-05 [] 6.10351562500000e-05
-6.10351562500000e-05 [] 6.10351562500000e-05
-6.10351562500000e-05 [] 3.05175781250000e-05
0 [] -3.05175781250000e-05
6.10351562500000e-05 [] -6.10351562500000e-05
6.10351562500000e-05 [] -6.10351562500000e-05
3.05175781250000e-05 [] -3.05175781250000e-05
6.10351562500000e-05 [] -6.10351562500000e-05
3.05175781250000e-05 [] 0
-3.05175781250000e-05 [] 6.10351562500000e-05
DELPHI:(first 10 value leftchannel and rightchannel)
9.90156960830442E-320 [] 1.00265682167023E-319
9.90156960830442E-320 [] 9.77113627780233E-320
3.26083326255223E-322 [] 0
1.39677298735779E-319 [] 1.37088394751571E-319
1.45932169812129E-319 [] 1.33373021094845E-319
1.23175506164681E-319 [] 1.206903559661E-319
1.28239679034554E-319 [] 1.40932225476216E-319
1.37068632125737E-319 [] 1.33382902407761E-319
1.33373021094845E-319 [] 1.25685359645555E-319
1.40907522193924E-319 [] 1.33358199125469E-319
My question are :
When Finding the total sample of the wav file, how to do it correctly?
Are the way matlab and delphi reading wav file (data chunk) in a
different way? or maybe my code was the one here is wrong?
Is there a way to get the same value like MATLAB does?
EDIT : i followed mBo advise and changed it into mbo advise
Data : array of SmallInt;
numsamples := wavehdr.DataBytes div (wavehdr.NumChannels * wavehdr.BitsPerSample div 8);
Stream.Read(wavedata[0].Data[i], SizeOf(SmallInt));
the interpreting part i'm not sure but i changed it into
floattostr(wavedata[0].Data[i]/32768.0)
floattostr(wavedata[1].Data[i]/32768.0)
the result i get :
0.611602783203125 [] 0.61932373046875
0.611602783203125 [] 0.603546142578125
0.0023193359375 [] 0
0.862762451171875 [] 0.846771240234375
0.901397705078125 [] 0.823822021484375
0.760833740234375 [] 0.7454833984375
0.7921142578125 [] 0.870513916015625
0.799774169921875 [] 0.761016845703125
0.8238525390625 [] 0.782623291015625
0.354766845703125 [] 0.76123046875
Wav-file (Bits per sample : 16) contains signed 16 bit integer data (SmallInt type), but you read data in float 8-byte type Double array.
You can declare
Data : array of SmallInt;
calculate
numsamples := wavehdr.DataBytes div (wavehdr.NumChannels * wavehdr.BitsPerSample div 8);
read them as
Stream.Read(wavedata[0].Data[0], numsamples * SizeOf(SmallInt))
or multichannel case:
Stream.Read(wavedata[0].Data[i], SizeOf(SmallInt));
and then interpret data values as floats Data[i] / 32768.0
note that matlab value 3.05175781250000e-05 = 1/32768.0 is minimal quantum of 16-bit signal
Related
I'm trying to make a Latin Square program that accepts a user-entered size of square (e.g. entering 5 will generate a Latin Square 5x5) and then output the formatted square to the user.
If you don't know what a Latin Square is or want to see the actual task I have been set, look no further.
I have slightly coded some of this, but I'm failing at the first hurdle. Teachers are providing no help, you lot are my only hope.
uses
System.SysUtils;
var
// Variables
// 2D array, size defined in main code
Square: array of array of integer;
// Integer holding the square size
SquareSize: integer;
begin
// Introduction
writeln('This program will generate a Latin Squar of a size designated by you.');
// Ask for user input, receive and store in a variable
write('Enter the size of the Latin Square (1 value): ');
readln(SquareSize);
// More user friendly garbage
writeln('Latin Square size: ', SquareSize, ' x ', SquareSize, '.');
// Calculations
// Set size of the 2D array to user designated dimensions
setlength(Square, SquareSize, SquareSize);
end.
After the last line of code (setlength) I want to set ALL values in my new 2D array to the user-entered number. I think.
Other than that, I have no clue what I'm doing.
If you want to help me, please can you try to keep it as simple as possible so I can understand it?
Sorry for any screw-ups made in this, first time on Stack Overflow.
The link you gave also gives the answer, see below the code.
program LatinSquare;
{$APPTYPE CONSOLE}
type
TSquare = array of array of Integer;
procedure WriteLatinSquare(var Square: TSquare; N: Integer);
var
X, Y: Integer;
begin
{ Allocate and fill the square array. }
SetLength(Square, N, N);
for Y := 0 to High(Square) do
for X := 0 to High(Square[Y]) do
Square[X, Y] := (Y + X) mod N + 1;
{ Display the Square array. }
for Y := 0 to High(Square) do
begin
for X := 0 to High(Square[Y]) do
Write(Square[X, Y]:3);
Writeln;
end;
Writeln;
end;
var
Square: TSquare;
SquareSize: Integer;
begin
SquareSize := 6;
WriteLatinSquare(Square, SquareSize);
Readln;
end.
As the link says: start with 1 2 3 4 5 6, then the next line, shift by one, so that becomes 2 3 4 5 6 1, etc... That is what the first part (with the X, Y loops) does: it fills the square.
Of course, Y + X can go over the limit of 0..5 (I add the 1 later on), so you use mod to wrap the values around, so 6 becomes 0, 7 becomes 1, etc. In effect:
1st line: 0+0=0 -> 0, 0+1=1 -> 1, 0+2=2 -> 2, 0+3=3 -> 3, 0+4=4 -> 4, 0+5=5 -> 5
2nd line: 1+0=1 -> 1, 1+1=2 -> 2, 1+2=3 -> 3, 1+3=4 -> 4, 1+4=5 -> 5, 1+5=6 -> 0
3rd line: 2+0=2 -> 2, 2+1=3 -> 3, 2+2=4 -> 4, 2+3=5 -> 5, 2+4=6 -> 0, 2+5=7 -> 1
etc...
Then you add the 1, so instead of 0 1 2 3 4 5you get 1 2 3 4 5 6.
The second part of the routine just prints the Square array.
If you don't need to save the square, it can be done in one part:
procedure WriteMagicSquare2(N: Integer);
var
X, Y: Integer;
begin
for Y := 0 to N - 1 do
begin
for X := 0 to N - 1 do
Write((Y + X) mod N + 1, ' ');
Writeln;
end;
Writeln;
end;
Output (for N = 6):
1 2 3 4 5 6
2 3 4 5 6 1
3 4 5 6 1 2
4 5 6 1 2 3
5 6 1 2 3 4
6 1 2 3 4 5
Assuming your in my school given this is the exact homework I have from the same book word for word. On note of the code above I will add one point, the Latin squares size should be user entered so in the last block of code change it to this:
var
Square: TSquare;
X, UserI, SquareSize: Integer;
begin
X := 0;
Writeln('type -1000 to stop the loop');
repeat
Writeln('What size square do you want?');
readln(UserI);
if UserI = -1000 then
begin
goto gotolable;
end
else
SquareSize := UserI;
WriteLatinSquare(Square, SquareSize);
writeln ('Press enter to do another Latin square');
readln;
until X = 1;
gotolable:
I have an output txtfile with some float numbers and I like to print in different formats, y try with:
FormatFloat('00000;000.0;00.00', val)
FormatFloat('00.00;000.0;00000', val)
But I take wrong outputs. What I need is:
If val < 10 then output like '00.00'
If 10 < val < 100 then output like '000.0'
If val > 100 then output like '00000'
It's a huge amount of float values, so, I need a low processing solution and I think more conditionals will slow down the application. ¿Any advice?
Thank you
Using conditional tests to sort the values into separate outputs is not going to affect performance in a significant way. The format process is far more elaborate. One important thing about optimization is to only walk that path if you can measure a performance hit in the actual code.
if (val < 10) then
s := FormatFloat('00.00',val)
else
if (val < 100) then
s := FormatFloat('000.0',val)
else
s := FormatFloat('00000',val);
Also consider using the thread-safe FormatFloat with a supplied FormatSettings variable.
I suppose that conditionals would work faster, but consider this sketch (care about out-of-range values):
const
FormatString: array[-1..2] of string = ('0.000', '0.00', '0.0', '0');
var
x: Double;
i: integer;
begin
x := 0.314;
for i := 1 to 4 do begin
Memo1.Lines.Add(FormatFloat(FormatString[Floor(Log10(x))], x));
x := x * 10;
end;
0.314
3.14
31.4
314
I am trying to split a string using an integer array as mask.
The task is simple but I am not accustomed to ADA (which is a constraint).
Here is my code. It works exept that I have an one character offset when testing against a file. Can someone help me remove this offset. it is drinving me nuts.
generic_functions.adb :
package body Generic_Functions is
-- | Sums up the elements of an array of Integers
function Sum_Arr_Int(Arr_To_Sum: Int_Array) return Integer is
Sum: Integer;
begin
Sum := 0;
for I in Arr_To_Sum'Range loop
Sum := Sum + Arr_To_Sum(I);
end loop;
return Sum;
end Sum_Arr_Int;
-- | Split up a String into a array of Unbounded_String following pattern from an Int_Array
function Take_Enregistrements(Decoup_Tab: Int_Array; Str_To_Read: String) return Str_Array is
Previous, Next : Integer;
Arr_To_Return : Str_Array(Decoup_Tab'Range);
begin
if Sum_Arr_Int(Decoup_Tab) > Str_To_Read'Length then
raise Constraint_Error;
else
Previous := Decoup_Tab'First;
Next := Decoup_Tab(Decoup_Tab'First);
for I in Decoup_Tab'Range loop
if I /= Decoup_Tab'First then
Previous := Next + 1;
Next := (Previous - 1) + Decoup_Tab(I);
end if;
Arr_To_Return(I) := To_Unbounded_String(Str_To_Read(Previous..Next));
end loop;
return Arr_To_Return;
end if;
end Take_Enregistrements;
end Generic_Functions;
generic_functions.ads :
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
package Generic_Functions is
-- | Types
type Int_Array is array(Positive range <>) of Integer;
type Str_Array is array(Positive range <>) of Unbounded_String;
-- | end of Types
-- | Functions
function Sum_Arr_Int(Arr_To_Sum: Int_Array) return Integer;
function Take_Enregistrements(Decoup_Tab: Int_Array; Str_To_Read: String) return Str_Array;
-- | end of Functions
end Generic_Functions;
generic_functions_tests.adb :
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Generic_Functions; use Generic_Functions;
procedure Generic_Functions_Tests is
-- | Variables
Decoup_Test : constant Int_Array(1..8) := (11, 19, 60, 24, 255, 10, 50, 255);
Test_Str_Arr : Str_Array(Decoup_Test'Range);
Test_Str_Arr2 : Str_Array(Decoup_Test'Range);
Test_Str_Arr3 : Str_Array(Decoup_Test'Range);
--Test_Int : Integer;
Test_Handle : File_Type;
-- | end of Variables
begin
Open(Test_Handle, In_File, "EXPORTFINAL.DAT");
Test_Str_Arr := Take_Enregistrements(Decoup_Test, Get_Line(Test_Handle));
Test_Str_Arr2 := Take_Enregistrements(Decoup_Test, Get_Line(Test_Handle));
Test_Str_Arr3 := Take_Enregistrements(Decoup_Test, Get_Line(Test_Handle));
for I in Test_Str_Arr'Range loop
Put_Line(To_String(Test_Str_Arr(I)));
end loop;
for I in Test_Str_Arr2'Range loop
Put_Line(To_String(Test_Str_Arr2(I)));
end loop;
for I in Test_Str_Arr3'Range loop
Put_Line(To_String(Test_Str_Arr3(I)));
end loop;
-- for I in Test_Str_Arr'Range loop
-- Test_Int := To_String(Test_Str_Arr(I))'Length;
-- Put_Line(Integer'Image(Test_Int));
-- end loop;
-- for I in Test_Str_Arr2'Range loop
-- Test_Int := To_String(Test_Str_Arr2(I))'Length;
-- Put_Line(Integer'Image(Test_Int));
-- end loop;
-- for I in Test_Str_Arr3'Range loop
-- Test_Int := To_String(Test_Str_Arr3(I))'Length;
-- Put_Line(Integer'Image(Test_Int));
-- end loop;
Close(Test_Handle);
end Generic_Functions_Tests;
and finaly the file:
000000000012012-01-01 10:00:00 IBM IBM COMPAGNIE IBM FRANCE 17 AVENUE DE l'EUROPE 92275 BOIS-COLOMBES CEDEX CONFIGURATION COMPLETE SERVEUR000000000000000000000019 .6000000000001000000000000000000001000.00000000000000000000000000000196.00000000000000000000000000001196.00000000
000000000022012-01-01 11:00:00 MICROSOFT MSC 39 QUAI DU PRESIDENT ROOSEVELT 92130 ISSY-LES-MOULINEAUX AMENAGEMENT SALLE INFORMATIQUE000000000000000000000019.6000000000001000000000000000000001000.00000000000000000000000000000196.00000000000000000000000000001196.00000000
000000000032012-01-01 12:00:00 MICROSOFT MSC 39 QUAI DU PRESIDENT ROOSEVELT 92130 ISSY-LES-MOULINEAUX TESTS SUR SITE000000000000000000000019.6000000000001000000000000000000003226.52000000000000000000000000000632.39792000000000000000000000003858.91792000 DELEGATION TECHNICIEN HARD000000000000000000000019.60000000000000000000000000000001.00000000000000000000000000001000.00000000000000000000000000000196.00000000000000000000000000001196.00000000
These lines:
if I = Decoup_Tab'Last then
Arr_To_Return(I) := To_Unbounded_String(Str_To_Read(Previous..Next));
end if;
will overwrite the last element in your array.
Also, are you sure that the line number (00000000001, 00000000002, etc) is one of the strings you want to split based on the integer mask? As your code is right now, you use '11' twice, once for the line number and once for the date-field. If you skip the line number, the other numbers seem to make more sense.
I am tidying old code that used to use FastStrings and I've implemented an old routine of mine 'PosAnyCase' which should operate like 'Pos'. (I was hoping that SearchBuf was better than calling UpperCase on both strings).
function PosAnyCase( const AFindStr, AStr : string ) : integer;
// Returns the position of this substring within a string ignoring case
I'm using SearchBuf as follows:
function PosAnyCase( const AFindStr, AStr : string ) : integer;
// Returns the position of this substring within a string ignoring case
var
Start, ResultPos : PChar;
begin
Start := PChar( AStr );
ResultPos := SearchBuf(
Start, ByteLength( AStr ),
0, 0,
AFindStr, [soDown] );
if ResultPos = nil then
Result := 0
else
Result := ResultPos-Start+1;
end;
When I call this routine from my unit tests, the following tests PASS:
Check(
PosAnyCase( '', '123' ) = 0 );
Check(
PosAnyCase( '2', '123' ) = 2 );
Check(
PosAnyCase( 'A', 'ABC' ) = 1 );
Check(
PosAnyCase( 'a', 'ABC' ) = 1 );
Check(
PosAnyCase( 'the', 'hellot there' ) = 8 );
Check(
PosAnyCase( 'THE', 'hellot there' ) = 8 );
But this test FAILS:
Check(
PosAnyCase( 'nice', 'does not have n i c e' ) = 0 );
What am I doing wrong please? The documentation on SearchBuf is very limited....
Thanks
The call to ByteLength is incorrect. Although the documentation explicitly states that the parameter is the length in bytes, that is not the case. You should use Length instead because the function actually expects units of char rather than units of byte.
Hi there =) And sorry for my English, in advance
I have a task to calculate hurst exponent by method of linear regression. And I have text description of solution. It looks very easy, but always i get values, that go out from range 0..1. Usually, value is 1.9 or something similar. Sometimes it gets negative value that is close to zero.
I have looked over code about thousand times but couldn't see a mistake.
var
max_z,min_z,x_m:real; //max and min of cumulative sum and mean value of X for every Tau
st,ss,sst,st2 :real;
Al, Herst: real;
x_vr:array of double; //a piece of array with length=tau
i, j, nach: integer;
begin
//file opening and getting values of X array are in another function
nach:=3; //initial value of tau
Setlength(ln_rs,l-nach); //length of ln(R/S) array
Setlength(ln_t,l-nach); //length of ln(tau) array
Setlength(r,l-nach); //length of R array
Setlength(s,l-nach); //length of S array
//Let's start
for tau:=nach to l do //we will change tau
begin
Setlength(x_vr,tau+1); //set new local array (length=tau)
for i:=0 to length(x_vr)-1 do
x_vr[i]:=x[i];
x_m:=Mean(x_vr); //mean value
Setlength(y,tau+1); //length of array of difference from mean value
Setlength(z,tau+1); //length of array of cumulative sum
for i:=0 to tau do
y[i]:=x_vr[i]-x_m; //difference from mean value
z[0]:=y[0];
for i:=1 to tau do //cumulative sum
for j :=i downto 0 do
z[i]:=z[i]+y[j];
max_z:=z[0];
for i:=1 to tau do //max of cumulative sum
max_z:=max(max_z,z[i]);
min_z:=z[0];
for i:=1 to tau do //min of cumulative sum
min_z:=min(min_z,z[i]);
r[tau-nach]:=max_z-min_z; //R value
s[tau-nach]:=0;
for i:=0 to tau do
s[tau-nach]:=power(y[i],2)+s[tau-nach]; //S value
s[tau-nach]:=sqrt(s[tau-nach]/(tau+1));
//new array values
ln_rs[tau-nach]:=Ln(R[tau-nach]/S[tau-nach]); // ln(R/S)
ln_t[tau-nach]:=ln(tau); // ln (tau)
end; //End of calculating
//Method of Least squares
for i:=0 to length(ln_rs)-1 do
st:=st+ln_t[i];
st:=(1/length(ln_rs))*st;
for i:=0 to length(ln_rs)-1 do
ss:=ss+ln_rs[i];
ss:=(1/length(ln_rs))*ss;
for i:=0 to length(ln_rs)-1 do
sst:=sst+ln_t[i]*ln_rs[i];
sst:=(1/length(ln_rs))*sst;
for i:=0 to length(ln_rs)-1 do
st2:=st2+ln_t[i]*ln_t[i];
st2:=(1/length(ln_rs))*st2;
Herst:=(sst-st*ss)/(st2-st*st); //coefficient of approximal function
al:=ss-st*Herst;
Thanks everybody =)
P.S.
for tau:=nach to l do
There is L, not 1. And L is Length of X array. And L>nach always besides last step, when l=nach.
P.P.S.
It works, guys. But values are not right. And they go out from range. Maybe, there is mistake in algorithm. Or maybe I skiped some step.
Last Update
It's mystic, but i only changed method of calculating array Z and it started works correctly....
Thanks all =)
First thing I see:
nach := 3;
for tau := nach to l do //w
This counts up. And because nach>1, the body of this loop won't be executed.
If you expect to count down. Use the downto variant. To count down:
for tau := nach downto l do //w
Given that the main loop (for tau) iterates from nach to l, the first four SetLength calls should set the length of l - nach + 1 instead of l - nach.
Should the line
z[i]:=z[i]+y[j];
not be
z[i]:=z[i - 1]+y[j];
?