https://community.wolfram.com RSS Feed for Wolfram Community showing ideas tagged with Signal Processing sorted by most replies. https://community.wolfram.com/groups/-/m/t/2527035 A Wolfram U daily study group on "Signals, Systems and Signal Processing" begins on May 16, 2022. Join instructors [@Leila Fuladi][at0] and [@Mariusz Jankowski][at1] and a cohort of fellow learners to study the concepts, mathematics, principles and techniques of signal processing. We'll cover methods of analysis for both continuous-time and discrete-time signals and systems, sampling and introductory filter design. The concepts and methods of signals and systems play an important role in many areas of science and engineering and many everyday signal processing examples are included. A basic working knowledge of the Wolfram Language is recommended. **[REGISTER HERE][1]** ![enter image description here][2] [1]: https://www.bigmarker.com/series/daily-study-group-signals-systems-and-signal-processing/series_details?utm_bmcr_source=community [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=WolframUBanner.jpeg&userId=130003 [at0]: https://community.wolfram.com/web/leilaf [at1]: https://community.wolfram.com/web/mariuszj Abrita Chakravarty 2022-05-06T22:26:34Z https://community.wolfram.com/groups/-/m/t/96823 Recently [b][url=http://community.wolfram.com/groups/-/m/t/91868]Christopher coded a neat wavelet-based method for peak detection[/url][/b]. Peak detection is often needed in various scientific fields: all sorts of spectral analysis, time series and general feature recognition in data come to mind right away.  There are many methods for peak detection. Besides his wavelet-based code Christopher also mentions a built-in MaxDetect function rooted in image processing. [b][url=http://reference.wolfram.com/mathematica/ref/MaxDetect.html]MaxDetect[/url][/b], though, being a rather elaborate tool for multi-dimensional data (2D, 3D images) and with a specific image-processing-minded parameter tuning, was not meant to target time series and other 1D data. This got me thinking. [b]Can we come up with a minimal compile-able peak detection code that would be accurate, robust and fast in most situations for 1D data?[/b] I am not an expert in the subject, but intuitively peak detection consists of two stages.  [list] [*][b]Finding all maxima[/b]. This can be done via Differences with selection of neighbor difference pairs that change from positive to negative. Such pair would indicate local maximum. [*][b]Filtering out peaks[/b]. Selecting those maxima that are “high” splashes of amplitude with respect to its “immediate neighborhood”. Quoted words are relative and depend on particular data. This is why they are set as tuning parameters in the algorithm. [/list]To illustrate 2nd point lets take a look at the [b][url=http://www.wolframalpha.com/input/?i=Albert+Einstein+Wikipedia+page+hits+history]Albert Einstein Wikipedia page hits history[/url][/b] below. Obviously a large peak in the past can be lower than current average in case if there is strong trend in the data. This is why we need “windowing” when looking for peaks, - to compare a peak to its immediate neighborhood.  [url=http://www.wolframalpha.com/input/?i=Albert+Einstein+Wikipedia+page+hits+history][img=width: 600px; height: 469px;]/c/portal/getImageAttachment?filename=ScreenShot2013-08-14at3.13.07PM.png&userId=11733[/img][/url] Without further ado here is a function written specifically in terms of functions that can be compiled. For example I do not use MovingAverage, but do trick with Partition instead.[mcode]PeakDetect = Compile[{{data, _Real, 1}, {width, _Integer}, {cut, _Real}}, (Table[0, {width}]~Join~ Map[UnitStep[# - cut] &, data[[1 + width ;; -1 - width]] - Map[Mean, Partition[data, 1 + 2 width, 1]]]~Join~ Table[0, {width}]) ({0}~Join~ Map[Piecewise[{{1, Sign[#] == {1, -1}}, {0, Sign[#] != {1, -1}}}] &, Partition[Differences[data], 2, 1]]~Join~{0}), CompilationTarget -> "C"];[/mcode]The legend for the function arguments is the following:[list] [*]data – 1D numerical list of data [*]width – half-width of the moving average window not including central point [*]cut – threshold at which to cut off the peak in natural units of data amplitudes  [/list]Now let’s see some usage cases. Let’s import the same Albert Einstein data as a proof of concept. [mcode]raw = WolframAlpha[ "albert einstein", {{"PopularityPod:WikipediaStatsData", 1}, "TimeSeriesData"}]; data = raw[[All, 2]][[All, 1]];[/mcode]We use total window width of 5 points here and cut off peak at a standard deviation of the whole data. The peak labeled “May 2008” is nicely picked up even though it is comparable then current average. This peak is most probably due to publication on May 13, 2008 of [b][url=http://www.amazon.com/Einstein-Life-Universe-Walter-Isaacson/dp/0743264746]one of the most famous books about Einstein[/url][/b] marked as New York Times bestseller that also got award Quill Award. Of course you can play with controls to pick or drop peaks. On the top plot one sees data, moving average, and bands formed by moving average displaced up and down by fraction of standard deviation. Any maximum above the top band becomes a peak. [url=http://www.amazon.com/Einstein-Life-Universe-Walter-Isaacson/dp/0743264746][img=width: 800px; height: 382px;]/c/portal/getImageAttachment?filename=9672ScreenShot2013-08-14at3.47.18PM.png&userId=11733[/img][/url] The code for the app is at the very end. Lets try a different data set – recent sun spot activity. [mcode]raw = WolframAlpha["sun spot", {{"SunspotsPartialTimeSeries:SpaceWeatherData", 1}, "TimeSeriesData"}]; data = raw[[All, 2]];[/mcode]We right away found on May 2013 mark - a [b][url=http://en.wikipedia.org/wiki/Solar_cycle_24#May_2013]most powerful recent event described in Wikipedia page here[/url][/b]. Please let me know if you have suggestions how to speed this up or improve it generally. I would be very curious to know your opinion and critique.  [color=#ff0000][i]The .GIF below is large - wait till it is loaded.[/i][/color] [img=width: 800px; height: 380px;]/c/portal/getImageAttachment?filename=sunspot.gif&userId=11733[/img] The following reference could be useful:[list] [*][b][url=http://www.tcs-trddc.com/trddc_website/pdf/SRL/Palshikar_SAPDTS_2009.pdf]Simple Algorithms for Peak Detection in Time-Series[/url][/b] [*][b][url=http://www.mdpi.com/1999-4893/5/4/588]An Efficient Algorithm for Automatic Peak Detection in Noisy Periodic and Quasi-Periodic Signals[/url][/b] [/list]The code for the interactive app:[mcode]Manipulate[ tt = {#, Rotate[DateString[#, {"MonthNameShort", " ", "Year"}], Pi/2]} & /@ Pick[raw, PeakDetect[data, wid, thr StandardDeviation[data]], 1][[ All, 1]]; Column[{ ListLinePlot[{data, ArrayPad[MovingAverage[data, 1 + 2 wid], wid, "Fixed"], ArrayPad[MovingAverage[data, 1 + 2 wid], wid, "Fixed"] + thr StandardDeviation[data], ArrayPad[MovingAverage[data, 1 + 2 wid], wid, "Fixed"] - thr StandardDeviation[data]}, AspectRatio -> 1/6, ImageSize -> 800, Filling -> {2 -> {1}, 3 -> {4}}, FrameTicks -> {None, Automatic}, FillingStyle -> {Directive[Red, Opacity[.7]], Directive[Blue, Opacity[.7]], Directive[Gray, Opacity[.1]]}, PlotStyle -> Opacity[.7], PlotRange -> All, Frame -> True, GridLines -> Automatic, PlotRangePadding -> 0], Show[ DateListPlot[raw, Joined -> True, AspectRatio -> 1/6, ImageSize -> 800, Filling -> Bottom, Ticks -> {tt, Automatic}, Frame -> False, Mesh -> All, PlotRange -> All], DateListPlot[ If[# == {}, raw[[1 ;; 2]], #, #] &[ Pick[raw, PeakDetect[data, wid, thr StandardDeviation[data]], 1]], AspectRatio -> 1/6, ImageSize -> 800, PlotStyle -> Directive[Red, PointSize[.007]], PlotRange -> All] , PlotRangePadding -> {0, Automatic}] }], Row[{ Control[{{thr, 1, "threshold"}, 0, 2, Appearance -> "Labeled"}], Spacer[100], Control[{{wid, 3, "hal-width"}, 1, 10, 1, Setter}] }] ][/mcode] [b]============== UPDATE =================[/b] Thank you all very much for contributing. I collected everyone's efforts and Danny's two functions in a single completely compile-able expression which seems to give shortest time; - but just vaguely faster then Danny's ingenious maneuver. I very much liked format suggested by Christopher, the one that Michael also kept in his packages. But I wanted to make some benchmarking and thus followed the format returned by the function [b][url=http://reference.wolfram.com/mathematica/ref/MaxDetect.html]MaxDetect[/url][/b] - simply for the sake of speed comparison. This format is just a binary list of the length of original data with 1s in positions of found peaks. Here is the function:[mcode]PeakDetect = Compile[{{data, _Real, 1}, {width, _Integer}, {cut, _Real}}, (Table[0, {width}]~Join~ UnitStep[ Take[data, {1 + width, -1 - width}] - (Module[{tot = Total[#1[[1 ;; #2 - 1]]], last = 0.}, Table[tot = tot + #1[[j + #2]] - last; last = #1[[j + 1]]; tot, {j, 0, Length[#1] - #2}]]/#2) &[data, 1 + 2 width] - cut] ~Join~Table[0, {width}]) ({0}~Join~ Table[If[Sign[{data[[ii + 1]] - data[[ii]], data[[ii + 2]] - data[[ii + 1]]}] == {1, -1}, 1, 0], {ii, 1, Length[data] - 2}]~Join~{0}), CompilationTarget -> "C"]; dat = RandomReal[1, 10^7]; pks = MaxDetect[dat]; // AbsoluteTiming Total[pks] (* ======== output ======== {62.807928, Null} 3333361 ======== output ======== *) pks = PeakDetect[dat, 1, 0]; // AbsoluteTiming Total[pks] (* ======== output ======== {1.560074, Null} 3333360 ======== output ======== *)[/mcode]And here are the speed benchmarks on 10 million data points which shows 40 times speed-up: Vitaliy Kaurov 2013-08-14T21:21:54Z https://community.wolfram.com/groups/-/m/t/91868 In Mathematica the closest thing (currently) to a peak detect function is a function called MaxDetect, which is unfortunately very slow with large datasets and could be better at finding peaks.  So (for a project which I will post here soon) I decided to write my own peak detection function. I found a nice article from National Instruments here: [url=http://www.ni.com/white-paper/5432/en/]http://www.ni.com/white-paper/5432/en/[/url] I have subsequently implemented this in Mathematica. So the basic idea behind this algorithm is whenever the detail wavelet passes zero, there is a peak.  Let me explain this: (I am assuming that you understand the basic concept of wavelets) When you get the wavelet of a 1-dimensional object, you will get the approximation coefficients, and the detail coefficients.  As their names suggest the approximation coefficients are the basic shape of the thing (used for noise reduction) while the detail coefficients are used for the little bumps and valleys that texture the original wave. For example Here is some noisy data: [img=width: 449px; height: 270px; ]/c/portal/getImageAttachment?filename=noisy.jpg&userId=24497[/img] Approximate: [img=width: 413px; height: 165px; ]/c/portal/getImageAttachment?filename=approx.jpg&userId=24497[/img] Detail: [img=width: 392px; height: 157px; ]/c/portal/getImageAttachment?filename=detail.jpg&userId=24497[/img] So to access the detail vs approx wavelets from some wavelet data like this: [mcode]data = Table[Sin[x] + RandomReal[{0, .1}], {x, 0, 2 Pi, .01}]; dwd = DiscreteWaveletTransform[data, HaarWavelet[], 3][/mcode] So I am running a wavelet transform of data with a haar wavelet for 3 layers. I can see the various coefficients like this: [mcode]dwd["ListPlot"][/mcode][img]/c/portal/getImageAttachment?filename=ScreenShot2013-08-06at8.39.46PM.png&userId=24497[/img] The coefficients that end in 1 are detail wavelets while those which end in 0 are approx wavelets. (There is a {0} and a {0,0} wavelet but it doesn't show them). The deeper you go into these coefficients the less wavelets are used to construct the wave and therefor they are more basic. In this case we want the highest quality data so we can just look at level 1. (So the coefficient named "{1}"). So time to get down to the real code. Here is some example data, in this case a fourier transform. [img=width: 764px; height: 473px; ]/c/portal/getImageAttachment?filename=data.jpg&userId=24497[/img] This is a fairly easy case but you can see that the number of datapoints is giant and there is some noise toward the bottom. So the first thing we need to do is get rid of all the little peaks we don't care about. Here "data" is the data with peaks in it and "min" is the minimum size of the peaks that will be detected. [mcode]dwd=DiscreteWaveletTransform[If[# < min, 0, #] & /@ data, HaarWavelet[], 1];[/mcode] In this case I have set "min" to 1. We can now run the inverse wavelet transform of that for the first detail coefficient: [mcode]InverseWaveletTransform[dwd, HaarWavelet[], {1}][/mcode]Which looks like this: [img=width: 800px; height: 491px; ]/c/portal/getImageAttachment?filename=inversewavelet.jpg&userId=24497[/img] Now we detect every time those peaks cross zero.  You may also notice that there is another threshold here which I found to be useful. [mcode]Normal[CrossingDetect[ If[Abs[#] < ther, 0, #] & /@ InverseWaveletTransform[ DiscreteWaveletTransform[If[# < min, 0, #] & /@ data, HaarWavelet[], 1], HaarWavelet[], {1}]]][/mcode] [img=width: 800px; height: 493px; ]/c/portal/getImageAttachment?filename=peaks.jpg&userId=24497[/img] This gets the position of the points in each peak: [mcode]Flatten[Position[ Normal[CrossingDetect[ If[Abs[#] < ther, 0, #] & /@ InverseWaveletTransform[ DiscreteWaveletTransform[If[# < min, 0, #] & /@ data, HaarWavelet[], 1], HaarWavelet[], {1}]]] , 1]][/mcode] We then split them into groups for each peak: [mcode]Split[Flatten[ Position[Normal[ CrossingDetect[ If[Abs[#] < ther, 0, #] & /@ InverseWaveletTransform[ DiscreteWaveletTransform[If[# < min, 0, #] & /@ data, HaarWavelet[], 1], HaarWavelet[], {1}]]], 1]], Abs[#1 - #2] < cther &][/mcode] "cther" is the distance 2 points have to be appart before they are counted as sepperate peaks.  In this case I use 50 because I don't want it detecting false peaks right next to the real ones.  But you could set it to split after every run of consecutive 1s. After this it is pretty technical and so I present (drumroll) the final function!!! [mcode]FindPeaks[data_, ther_: .2, min_: 0, cther_: 50] := Function[peaks, Transpose[{peaks, data[[peaks]]}]][(#[[Ordering[data[[#]], -1][[1]]]] & /@ Split[Flatten[ Position[ Normal[CrossingDetect[ If[Abs[#] < ther, 0, #] & /@ InverseWaveletTransform[ DiscreteWaveletTransform[If[# < min, 0, #] & /@ data, HaarWavelet[], 1], HaarWavelet[], {1}]]], 1]], Abs[#1 - #2] < cther &])][/mcode] So here is it working on the fourier transform! [img=width: 800px; height: 495px; ]/c/portal/getImageAttachment?filename=final.jpg&userId=24497[/img] The blue is the unmodified data and the red is a line from peak to peak that fell within our requirments, but with different settings we could get all of these smaller peaks off to the right. Well that's all I got so if you have any questions about the code or edits that make it better, post it here! :D Christopher Wolfram 2013-08-07T00:46:29Z https://community.wolfram.com/groups/-/m/t/463721 ![enter image description here][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=4902Hero.gif&userId=20103 [2]: https://www.wolframcloud.com/obj/5838919a-e64d-49fe-9193-c6ce123184f2 Marco Thiel 2015-03-21T01:18:08Z https://community.wolfram.com/groups/-/m/t/344278 Many fantastic posts in this community describe how to connect external devices to Mathematica and how to read the data. Connecting Mathematica to an Arduino for example allows you to read and then work with data from all kinds of sensors. In most of the cases, when we speak about connected devices, additional hardware is necessary. Smart phones, on the other hand, are our permanent companions and they host a wide array of sensors that we can tap into with Mathematica. For this post, I will be using an iPhone 5 - but a similar approach can be taken with many other smart phones. [Björn Schelter][1] and myself have worked on this together. The first thing we need in order to be able to read the iPhone is a little App which can be purchased on the iTunes App store: it is called [Sensor Data][2]. When you open the app you see a screen like this one. ![enter image description here][3] At the top of the screen you see an IP address and a port number (after the colon!). These numbers will be important to connect to the phone and either download data or stream sensor data directly. If you click on the "start capture" the iPhone's data will be stored on the phone and can be downloaded into Mathematica. In this post we are rather interested in the "Streaming" function. If you click on the respective button on the bottom you get to a screen like this: ![enter image description here][4] There you can choose a frequency for the measurements and start the streaming. In fact we also can choose which sensors we want to use with the Config button. ![enter image description here][5] The following Mathematica code will work when all (!) sensors are switched on. Now we are ready to connect to the iPhone. Switch the streaming on and execute the following commands: ClearAll["Global`*"]; For[i = 1, i < 3, i++, Quiet[InstallJava[]]]; Needs["JLink`"] and then LoadJavaClass["java.util.Arrays"]; packet = JavaNew["java.net.DatagramPacket", JavaNew["[B", 1024], 1024]; socket = JavaNew["java.net.DatagramSocket", 10552]; socket@setSoTimeout[10]; listen[] := If[$Failed =!= Quiet[socket@receive[packet], Java::excptn], record =JavaNew["java.lang.String", java`util`Arrays`copyOfRange @@ packet /@ {getData[], getOffset[], getLength[]}]@toString[] // Sow]; Next we have to define a ScheduledTask to read the sensors: RemoveScheduledTask[ScheduledTasks[]]; results = {}; RunScheduledTask[AppendTo[results, Quiet[Reap[listen[]][[2, 1]]]]; If[Length[results] > 1200, Drop[results, 150]], 0.01]; We also need to define a streaming function: stream := Refresh[ToExpression[StringSplit[#[[1]], ","]] & /@ Select[results[[-1000 ;;]], Head[#] == List &], UpdateInterval -> 0.01] Alright. Now comes the interesting part. Using (*Compass*) While[Length[results] < 1000, Pause[2]]; Dynamic[AngularGauge[Refresh[stream[[-1, 30]], UpdateInterval -> 0.01], {360, 0}, ScaleDivisions -> None, GaugeLabels -> {Placed["N", Top], Placed["S", Bottom], Placed["E", Right], Placed["W", Left]}, ScaleOrigin -> {{5 Pi/2, Pi/2}, 1}, ScalePadding -> All, ImageSize -> Medium], SynchronousUpdating -> False] we can measure the bearing of our iPhone. The resulting compass moves as we move the iPhone: ![enter image description here][6] We can also read the (x-,y-,z-) accelerometers (*Plot Ascelerometers*) While[Length[results] < 1000, Pause[2]]; Dynamic[Refresh[ListLinePlot[{stream[[All, 2]], stream[[All, 3]], stream[[All, 4]]}, PlotRange -> All], UpdateInterval -> 0.1]] which gives plots like this one: ![enter image description here][7] The update is a bit bumpy, because the data is only sent every second or so from the iPhone; the measurements, however, are taken with a frequency of up to 100Hz. We can also represent the FFT of the streamed data like so: (*Plot FFT of accelorometers*) While[Length[results] < 1000, Pause[2]]; Dynamic[ Refresh[ListLinePlot[ Log /@ {Abs[Fourier[Standardize[stream[[All, 2]]]]], Abs[Fourier[Standardize[stream[[All, 3]]]]], Abs[Fourier[Standardize[stream[[All, 4]]]]]}, PlotRange -> {{0, 200}, {-5, 2.5}}, ImageSize -> Large], UpdateInterval -> 0.1]] Adding a "real time" scale is also quite straight forward: (*Measurements with time scale*) While[Length[results] < 1000, Pause[2]]; starttime = IntegerPart[stream[[2, 1]]]; Dynamic[Refresh[ ListLinePlot[ Transpose[{(stream[[Max[-300, -Length[stream]] ;;, 1]] - starttime), stream[[Max[-300, -Length[stream]] ;;, 2]]}], PlotRange -> All, ImageSize -> Large], UpdateInterval -> 0.01]] Well, then. We can also plot our iPhone's position in space (*3d Motion*) While[Length[results] < 1000, Pause[2]]; Dynamic[ Refresh[ListLinePlot[{stream[[All, 5]], stream[[All, 6]], stream[[All, 7]]}, PlotRange -> All], UpdateInterval -> 0.1]] While[Length[results] < 1000, Pause[2]]; Dynamic[ Graphics3D[{Black, Rotate[Rotate[ Rotate[Cuboid[{-2, -1, -0.2}, {2, 1, 0.2}], stream[[-1, 7]], {0, 0, 1}], -1*stream[[-1, 6]], {0, 1, 0}], stream[[-1, 5]], {1, 0, 0}]}, PlotRange -> {{-3, 3}, {-3, 3}, {-3, 3}}, Boxed -> True], UpdateInterval -> 0.1, SynchronousUpdating -> False] This looks like so: ![enter image description here][8] Last but not least we can write a little GUI to access all different sensors. (This does run a bit slow though!) (*GUI all sensors*) sensororder = {"Timestamp", "Accel_X", "Accel_Y", "Accel_Z", "Roll", "Pitch", "Yaw", "Quat.X", "Quat.Y", "Quat.Z", "Quat.W", "RM11", "RM12", "RM13", "RM21", "RM22", "RM23", "RM31", "RM32", "RM33", "GravAcc_X", "GravAcc_Y", "GravAcc_Z", "UserAcc_X", "UserAcc_Y", "UserAcc_Z", "RotRate_X", "RotRate_Y", "RotRate_Z", "MagHeading", "TrueHeading", "HeadingAccuracy", "MagX", "MagY", "MagZ", "Lat", "Long", "LocAccuracy", "Course", "Speed", "Altitude", "Proximity"}; While[Length[results] < 1000, Pause[2]]; Manipulate[ Dynamic[Refresh[ ListLinePlot[{stream[[All, Position[sensororder, a][[1, 1]]]], stream[[All, Position[sensororder, b][[1, 1]]]], stream[[All, Position[sensororder, c][[1, 1]]]]}, PlotRange -> All, ImageSize -> Full], UpdateInterval -> 0.01]], {{a, "Accel_X"}, sensororder}, {{b, "Accel_Y"}, sensororder}, {{c, "Accel_Z"}, sensororder}, ControlPlacement -> Left, SynchronousUpdating -> False] This gives a user interface which looks like this: ![enter image description here][9] In the drop down menu we can choose three out of all sensors. These are all available sensors: > "Timestamp", "Accel_X", "Accel_Y", "Accel_Z", "Roll", "Pitch", "Yaw", > "Quat.X", "Quat.Y", "Quat.Z", "Quat.W", "RM11", "RM12", "RM13", > "RM21", "RM22", "RM23", "RM31", "RM32", "RM33", "GravAcc_X", > "GravAcc_Y", "GravAcc_Z", "UserAcc_X", "UserAcc_Y", "UserAcc_Z", > "RotRate_X", "RotRate_Y", "RotRate_Z", "MagHeading", "TrueHeading", > "HeadingAccuracy", "MagX", "MagY", "MagZ", "Lat", "Long", > "LocAccuracy", "Course", "Speed", "Altitude", "Proximity" There are certainly any things that can and should be improved. The main problem seems to be that the data, even if sampled at 100Hz, is sent to the iPhone only every second or so. So it is not really real time. I hope that someone who is better at iPhone programming than I am - I am really rubbish at it- could help and write an iPhone program to stream the data in a more convenient way: one by one rather than in packets. There are many potential applications for this. Here are some I could come up with: 1. You can carry the iPhone around and measure your movements (acceleration). Attached to your hand you can measure your tremor. 2. The magnetometer is really cool. You can use it to find metal bars in the walls an also electric cables. 3. You can collect GPS data for all sorts of applications; there are ideas to use this for the detection of certain diseases. For example if it takes you longer than usual to find your car when you come from shopping that might hint at early stages of dementia --- or sleep deprivation. 4. When you put the phone on a machine, like a running motor, you can measure the vibrations. When you perform a frequency analysis you can check whether the motor runs alright. 5. Using the accelerometers I was able to measure my breathing (putting the phone on my chest). I think that there might also be quite some potential for using the Wolfram Cloud here. Deploying a program in the cloud and reading from your phone is certainly quite interesting. The problem is that this particular app only works via WiFi. It would be nice to have one that works via 3G. So, in summary, it might be quite useful to use the iPhone's sensors. The advantage is that nearly everyone carries a smartphone with them all the time. Making more of your smart phone's sensors with Mathematica seems to be a nice playground for applications. I'd love to hear about your ideas... Cheers, Marco PS: When you are done with the streaming you should execute these commands: (*Remove Scheduled Tasks and close link*) RemoveScheduledTask[ScheduledTasks[]]; socket@close[]; [1]: http://community.wolfram.com/web/bschelter [2]: https://itunes.apple.com/gb/app/sensor-data/id397619802?mt=8 [3]: /c/portal/getImageAttachment?filename=sensorwelcome.PNG&userId=48754 [4]: /c/portal/getImageAttachment?filename=sensorstreaming.PNG&userId=48754 [5]: /c/portal/getImageAttachment?filename=Allsensors.PNG&userId=48754 [6]: /c/portal/getImageAttachment?filename=Compass.gif&userId=48754 [7]: /c/portal/getImageAttachment?filename=Accelerometer.gif&userId=48754 [8]: /c/portal/getImageAttachment?filename=Iphonemovement.gif&userId=48754 [9]: /c/portal/getImageAttachment?filename=ScreenShot2014-09-15at23.52.46.png&userId=48754 Marco Thiel 2014-09-15T23:53:14Z https://community.wolfram.com/groups/-/m/t/2166833 &[Wolfram Notebook][1] [1]: https://www.wolframcloud.com/obj/cdf7d474-f4fb-4cbd-bbd5-f1fac8699f7a Siria Sadeddin 2021-01-18T22:46:11Z https://community.wolfram.com/groups/-/m/t/1383518 ![A Representation of the emotion categorization system][1] ---------- #Abstract This project aims to develop a machine learning application to identify the sentiments in a music clip. The data set I used consists of one hundred 45-second clips from the Database for Emotional Analysis of Music and an additional 103 gathered by myself. I manually labeled all 203 clips and used them as training data for my program. This program works best with classical-style music, which is the main component of my data set, but also works with other genres to an reasonable extent. #Introduction One of the most important functions of music is to affect emotion, but the experience of emotion is ambiguous and subjective to individual. The same music may induce a diverse range of feelings in people as a result of different context, personality, or culture. Many musical features, however, usually lead to the same effect on the human brain. For example, louder music correlates more with excitement or anger, while softer music corresponds to tenderness. This consistency makes it possible to train a supervised machine learning program based on musical features. #Background This project is based on James Russell's circumplex model, in which a two-dimensional emotion space is constructed from the x-axis of valence level and y-axis of arousal level, as shown above in the picture. Specifically, valence is a measurement of an emotion's pleasantness, whereas arousal is a measurement of an emotion's intensity. Russell's model provides a metric on which different sentiments can be compared and contrasted, creating four main categories of emotion: Happy (high valence, high arousal), Stressed (low valence, high arousal), Sad (low valence, low arousal), and Calm (high valence, low arousal). Within these main categories there are various sub-categories, labeled on the graph above. Notably, "passionate" is a sub-category that does not belong to any main category due to its ambiguous valence value. ---------- #Program Structure The program contains a three-layer structure. The first layer is responsible for extracting musical features, the second for generating a list of numerical predictions based on different features, and the third for predicting and displaying the most probable emotion descriptors based on the second layer's output. ![enter image description here][2] ##First Layer The first layer consists of 23 feature extractors that generate numerical sequence based on different features: (*A list of feature extractors*) feMin[audio_] := Normal[AudioLocalMeasurements[audio, "Min", List]] feMax[audio_] := Normal[AudioLocalMeasurements[audio, "Max", List]] feMean[audio_] := Normal[AudioLocalMeasurements[audio, "Mean", List]] feMedian[audio_] := Normal[AudioLocalMeasurements[audio, "Median", List]] fePower[audio_] := Normal[AudioLocalMeasurements[audio, "Power", List]] feRMSA[audio_] := Normal[AudioLocalMeasurements[audio, "RMSAmplitude", List]] feLoud[audio_] := Normal[AudioLocalMeasurements[audio, "Loudness", List]] feCrest[audio_] := Normal[AudioLocalMeasurements[audio, "CrestFactor", List]] feEntropy[audio_] := Normal[AudioLocalMeasurements[audio, "Entropy", List]] fePeak[audio_] := Normal[AudioLocalMeasurements[audio, "PeakToAveragePowerRatio", List]] feTCent[audio_] := Normal[AudioLocalMeasurements[audio, "TemporalCentroid", List]] feZeroR[audio_] := Normal[AudioLocalMeasurements[audio, "ZeroCrossingRate", List]] feForm[audio_] := Normal[AudioLocalMeasurements[audio, "Formants", List]] feHighFC[audio_] := Normal[AudioLocalMeasurements[audio, "HighFrequencyContent", List]] feMFCC[audio_] := Normal[AudioLocalMeasurements[audio, "MFCC", List]] feSCent[audio_] := Normal[AudioLocalMeasurements[audio, "SpectralCentroid", List]] feSCrest[audio_] := Normal[AudioLocalMeasurements[audio, "SpectralCrest", List]] feSFlat[audio_] := Normal[AudioLocalMeasurements[audio, "SpectralFlatness", List]] feSKurt[audio_] := Normal[AudioLocalMeasurements[audio, "SpectralKurtosis", List]] feSRoll[audio_] := Normal[AudioLocalMeasurements[audio, "SpectralRollOff", List]] feSSkew[audio_] := Normal[AudioLocalMeasurements[audio, "SpectralSkewness", List]] feSSlope[audio_] := Normal[AudioLocalMeasurements[audio, "SpectralSlope", List]] feSSpread[audio_] := Normal[AudioLocalMeasurements[audio, "SpectralSpread", List]] feNovelty[audio_] := Normal[AudioLocalMeasurements[audio, "Novelty", List]] <br/> ##Second Layer Using data generated from the first layer, the valence and arousal predictors of the second layer provide 46 predictions for the audio input, based on its different features. (*RMSAmplitude*) (*Feature extractor*) feRMSA[audio_] := Normal[AudioLocalMeasurements[audio, "RMSAmplitude", List]] dataRMSA = Table[First[takeLast[feRMSA[First[Take[musicFiles, {n}]]]]], {n, Length[musicFiles]}]; (*Generating predictor*) pArousalRMSA = Predict[dataRMSA -> arousalValueC] ![Sample predictor function][3] <br/> ##Third Layer The two parts of the third layer, main category classifier and sub-category classifier, each utilize the tensors generated in the second layer to make a prediction within their realm of emotion. The output consists of two parts, a main category emotion and a sub-category emotion. (*Main*) emotionClassify1 = Classify[classifyMaterial -> emotionList1, PerformanceGoal -> "Quality"] (*Sub*) emotionClassify2 = Classify[classifyMaterial -> emotionList2, PerformanceGoal -> "Quality"] ![enter image description here][4] <br/> ##Output If the program receives an input that is longer than 45 second, it will automatically clip the audio file into 45 second segments and return the result for each. If the last segment is less than 45 seconds, the program would still work fine on it, though with reduced accuracy. The display for each clip includes a main-category and a sub-category descriptor, with each of their associated probability also printed. ###Sample testing: Debussy's Clair de Lune ![enter image description here][5] <br/> ---------- #Conclusion The program gives very reasonable result for most music in the classical style. However, the program have three shortcomings that I plan to fix in later versions of the this program. Firstly, the program may give contradictory result (ex. happy and depressed) if the sentiment dramatically changes in the middle of a 45 second segment, perhaps reflecting the music's changing emotional composition. The current 45 second clipping window is rather long and thus prone to capture contradicting emotions. In the next version of this program, the window will probably be shortened to 30 or 20 seconds to reduce prediction uncertainty. Secondly, the program's processing speed has a lot of room of improvement. It currently takes about one and half minutes to compute an one minute audio file. In future versions I will remove relative ineffective feature extractors to speed things up. Lastly, the data used in creating this application is solely from myself, and therefore it is prone to my human biases. I plan to expand the data set with more people's input and more genres of music. I have attached the application to this post so that everyone can try out the program. #Acknowledgement I sincerely thank my mentor, Professor Rob Morris, for providing invaluable guidance to help me carry out the project. I also want to thank Rick Hennigan for giving me crucial support with my code. [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=8714Emotion2DSpace.PNG&userId=1371765 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=2406DataStructure.PNG&userId=1371765 [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=8990capture1.PNG&userId=1371765 [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=5765capture2.PNG&userId=1371765 [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=3607SampleTesting.PNG&userId=1371765 William Yicheng Zhu 2018-07-14T02:40:20Z https://community.wolfram.com/groups/-/m/t/917048 The [new computational audio features][1] of Mathematica are really impressive. In no time you can cook up things as soon as you understand the basic algorithm. Even the simplest tricks can give quite surprising results. Before you read on, please do play this (file also uploaded to this post): ***[audio file][2]***. Have you noticed anything? I think that it sounds pretty much like the well known example ExampleData[{"Sound", "Apollo11SmallStep"}] As a matter of fact, it contains something a little special. If you import the file into Mathematica secsound = Import["/Users/thiel/Desktop/secretsound.wav"]; and calculate a spectrogram of it Spectrogram[secsound, ColorFunction -> "Rainbow", Frame -> None, ImageSize -> Full] you get this: ![enter image description here][3] How to inject images into spectrograms --------------------------- I will show now, how you can get this in a couple of lines of code. First we need to get a binary matrix (later we can do better!) of the message. This is quite straight forward: imgdata = Reverse@ImageData[ColorNegate@Image[Binarize[Rasterize[Text[" Wolfram "], RasterSize -> 100, ImageSize -> 100]]]]; There is nothing really tricky in here. The text is "Wolfram", I rasterise the image and resize it. Then I binarise it. The ColorNegate is needed to exchange ones and zeros in the matrix. Because I play with images and matrices, and they have a different coordinate system (the origin is at different corners) I need to Reverse the whole thing. I can plot the result like so: ArrayPlot[Reverse@imgdata] ![enter image description here][4] I now need to generate a sound that produces high amplitudes at the right places in the Spectrogram. At each and every place in the imagedata matrix that contains a one I need to proceed a little sine wave with the right frequency. The rows correspond to frequencies and the rows to time. So lets collect the different frequencies at each time: list = Flatten[Position[#, 1]] & /@ Transpose[imgdata]; Ok. Next we generate the corresponding sums of Sin-functions and generate a list of data from them. listcompete = 0.1*Flatten[Table[Table[N@Total[Sin[2 Pi 300 # t] &@(# & /@ list)[[k]]], {t, 0, 8.71/200., 1/16000}], {k, 1, 100}], 1]; We can generate the corresponding sound: Audio[Sound[SampledSoundList[listcompete, 8000]]] This gives you a little window like this ![enter image description here][5] which allows you to "listen to Wolfram in dolphin language". The file is attached to this post and sounds really cool. How to hide the images in sound files/music ------------------------------------------- In order to hide the string in the "A small step ..." recording, we first shift the frequencies a little bit and decrease the amplitude: listcompete2 = 0.02*Flatten[Table[Table[N@Total[Sin[2 Pi 1200 # t] &@(# & /@ list)[[k]]], {t, 0, 8.71/100., 1/64000}], {k, 1, 100}], 1]; It looks now like this: Spectrogram[Sound[SampledSoundList[listcompete2, 64000]], ColorFunction -> "Rainbow"] ![enter image description here][6] If you want to listen to it use: Audio[Sound[SampledSoundList[listcompete2, 64000]]] You should hear a sort of hissing sound. The new function AudioChannelCombine will now help us to merge the two sound objects: AudioChannelCombine[{Audio[ExampleData[{"Sound", "Apollo11SmallStep"}]], Audio[Sound[SampledSoundList[listcompete2, 64000]]]}] The resulting object is attached to this post. The spectrogram Spectrogram[AudioChannelCombine[{Audio[ExampleData[{"Sound", "Apollo11SmallStep"}]], Audio[Sound[SampledSoundList[listcompete2, 64000]]]}], ColorFunction -> "Rainbow", Frame -> None] ![enter image description here][7] clearly shows the secret message blended into the Apollo message. Like this you can export the sound object: secsound = Import["/Users/thiel/Desktop/secretsound.wav"]; Look for hidden messages ------------------------ This type of [procedure is quite well known][8]. I also saw it on [BBC's Click][9], but I cannot remember the episode. Now you can use this to look for hidden messages in the internet or in music. Here are two examples: [file1][10] and [file2][11], both from the website above. Let's look at file1 Spectrogram[snd, 150, Frame -> None] ![enter image description here][12] and file2 Spectrogram[Import["http://www.evansalazar.com/ohmpie/imageEncode/evan.mp3"], 150, Frame -> None, AspectRatio -> 1] ![enter image description here][13] You can clearly see that the second image is actually "grayscale". It is quite possible to achieve this by not Binarize-ing the image and using the grayscale values as amplitudes. Where to go from here? ---------------------- We could certainly try to increase the resolution and get everything into a nice little function to do all the steps for us. Another interesting thing would be to add multiple images/slices of a 3 D image into sound, and basically hide an entire 3D object. I'd love to see this being 3D printed. Can you detect the [message in this sound file][14]? Cheers, Marco [1]: http://www.wolfram.com/language/11/computational-audio/?product=language [2]: https://www.dropbox.com/s/83788i811rnjn39/secretsound.wav?dl=0 [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-09-01at00.21.25.png&userId=48754 [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-09-01at00.27.40.png&userId=48754 [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-09-01at00.33.34.png&userId=48754 [6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-09-01at00.39.48.png&userId=48754 [7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-09-01at00.43.10.png&userId=48754 [8]: http://www.ohmpie.com/imageencode/ [9]: http://www.bbc.co.uk/programmes/b006m9ry [10]: http://www.evansalazar.com/ohmpie/imageEncode/ohmpie.mp3 [11]: http://www.evansalazar.com/ohmpie/imageEncode/evan.mp3 [12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-09-01at00.52.56.png&userId=48754 [13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-09-01at00.51.55.png&userId=48754 [14]: https://www.dropbox.com/s/g6cqzute897szrz/finalmessage.wav?dl=0 Marco Thiel 2016-09-01T00:10:48Z https://community.wolfram.com/groups/-/m/t/587562 Are there solar systems with chaotic orbits? When astronomers look for exoplanets they look for periodic signals in the brightness of the central star. The analysis relies on predictable behaviors. But I have always wondered whether there are unpredictable solar systems out there. The reason for posting this now is the [news][1] of a star whose signal appears to be unpredictable (KIC 8462852). Some articles have suggested this is due to [aliens][2]. On the other hand, Stephen Wolfram has said many times (e.g. in his [New Kind of Science][3] book) that it is pretty easy for nature to produce unpredictable sequences, and regular signals would be a better sign of civilization. You can simulate hypothetical solar systems relatively easily in Wolfram language (search the demonstrations for [three body problem][4]). At the [Wolfram Science Summer School][5] in 2013, [Nicholas Lucas][6] did a systematic survey. He produced a nice phase-space type of diagram and in the process found a class of behaviors which were not regular in any sense except that all of the planets did not fly away. The possibility of planets zooming off to infinity is a possible explanation for the prevalence of regularity and order (at least when stars are far apart). This is an example of an irregular solution: ![irregular paths of 3 bodies][7] This code is a simple two body version: s = NDSolve[{x''[t] == 8 (y[t] - x[t])/Norm[y[t] - x[t]]^3, y''[t] == 8 (x[t] - y[t])/Norm[x[t] - y[t]]^3, x[0] == {-2, 0, 0}, y[0] == {2, 0, 0}, x'[0] == {0, 1, 0}, y'[0] == {0, -1, 0}}, {x, y}, {t, 0, 4}][[1]]; ParametricPlot3D[{Evaluate[x[t] /. s], Evaluate[y[t] /. s]}, {t, 0, 4}] Theoretically, from the study of simple rules (see Wolfram's [book][8]), one expects the possibility of [long transients][9], but also that most transients are short. From Wolfram's [principle of computational equivalence][10], one expects that solar system dynamics can be computationally universal even from simple initial conditions (for more see Wolfram's [note][11]). Maybe someone on Community knows more about this star. Is there data out there for KIC 8462852? In principle one should be able to take the orbital paths from a simulation and derive the brightness signal that someone would see from Earth, and do it systematically. [1]: http://www.skyandtelescope.com/astronomy-news/curious-case-of-kic-8462852-102020155/ [2]: http://www.nbcnews.com/tech/innovation/have-scientists-discovered-alien-civilization-not-so-fast-n445161 [3]: http://www.wolframscience.com/nksonline/page-822 [4]: http://demonstrations.wolfram.com/search.html?query=three%20body [5]: https://www.wolframscience.com/summerschool/ [6]: https://www.wolframscience.com/summerschool/2013/alumni/lucas.html [7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=alien-Kepler.png&userId=23275 [8]: http://www.wolframscience.com/nksonline/toc.html [9]: http://www.wolframscience.com/nksonline/page-754 [10]: http://www.wolframscience.com/nksonline/page-715 [11]: http://www.wolframscience.com/nksonline/page-972d-text Todd Rowland 2015-10-21T18:00:43Z https://community.wolfram.com/groups/-/m/t/861508 Introduction ------------ [Independent Component Analysis (ICA)](https://en.wikipedia.org/wiki/Independent_component_analysis) is a (matrix factorization) method for separation of a multi-dimensional signal (represented with a matrix) into a weighted sum of sub-components that have less entropy than the original variables of the signal. See \[1,2\] for introduction to ICA and more details. This article/post is to proclaim the implementation of the "FastICA" algorithm in the package [IndependentComponentAnalysis.m](https://github.com/antononcube/MathematicaForPrediction/blob/master/IndependentComponentAnalysis.m) and show a basic application with it. (I programmed that package last weekend. It has been in my ToDo list to start ICA algorithms implementations for several months... An interesting offshoot was [the procedure I derived](http://mathematica.stackexchange.com/questions/108182/extracting-signal-from-gaussian-noise/115715#115715) for the StackExchange question ["Extracting signal from Gaussian noise"](http://mathematica.stackexchange.com/questions/108182/extracting-signal-from-gaussian-noise).) In this article/post ICA is going to be demonstrated with both generated data and "real life" weather data (temperatures of three cities within one month). Generated data -------------- In order to demonstrate ICA let us make up some data in the spirit of the ["cocktail party problem"](https://en.wikipedia.org/wiki/Cocktail_party_effect). (*Signal functions*) Clear[s1, s2, s3] s1[t_] := Sin[600 \[Pi] t/10000 + 6*Cos[120 \[Pi] t/10000]] + 1.2 s2[t_] := Sin[\[Pi] t/10] + 1.2 s3[t_?NumericQ] := (((QuotientRemainder[t, 23][[2]] - 11)/9)^5 + 2.8)/2 + 0.2 (*Mixing matrix*) A = {{0.44, 0.2, 0.31}, {0.45, 0.8, 0.23}, {0.12, 0.32, 0.71}}; (*Signals matrix*) nSize = 600; S = Table[{s1[t], s2[t], s3[t]}, {t, 0, nSize, 0.5}]; (*Mixed signals matrix*) M = A.Transpose[S]; (*Signals*) Grid[{Map[ Plot[#, {t, 0, nSize}, PerformanceGoal -> "Quality", ImageSize -> 250] &, {s1[t], s2[t], s3[t]}]}] [](http://i.stack.imgur.com/lmvbk.png) (*Mixed signals*) Grid[{Map[ListLinePlot[#, ImageSize -> 250] &, M]}] [](http://i.stack.imgur.com/pB9Bl.png) I took the data generation formulas from \[6\]. ICA application --------------- Load the package: Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/IndependentComponentAnalysis.m"] It is important to note that the usual ICA model interpretation for the factorized matrix *X* is that each column is a variable (audio signal) and each row is an observation (recordings of the microphones at a given time). The matrix 3x1201 *M* was constructed with the interpretation that each row is a signal, hence we have to transpose *M* in order to apply the ICA algorithms, *X*=*M*\^T. X = Transpose[M]; {S, A} = IndependentComponentAnalysis[X, 3]; Check the approximation of the obtained factorization: Norm[X - S.A] (* 3.10715*10^-14 *) Plot the found source signals: Grid[{Map[ListLinePlot[#, PlotRange -> All, ImageSize -> 250] &, Transpose[S]]}] [](http://i.stack.imgur.com/83EBC.png) Because of the random initialization of the inverting matrix in the algorithm the result my vary. Here is the plot from another run: [](http://i.stack.imgur.com/lzQcr.png) The package also provides the function `FastICA` that returns an association with elements that correspond to the result of the function `fastICA` provided by the R package "fastICA". See \[4\]. Here is an example usage: res = FastICA[X, 3]; Keys[res] (* {"X", "K", "W", "A", "S"} *) Grid[{Map[ ListLinePlot[#, PlotRange -> All, ImageSize -> Medium] &, Transpose[res["S"]]]}] [](http://i.stack.imgur.com/QyHLH.png) Note that (in adherence to \[4\]) the function `FastICA` returns the matrices S and A for the centralized matrix X. This means, for example, that in order to check the approximation proper mean has to be supplied: Norm[X - Map[# + Mean[X] &, res["S"].res["A"]]] (* 2.56719*10^-14 *) Signatures and results ---------------------- The result of the function `IndependentComponentAnalysis` is a list of two matrices. The result of `FastICA` is an association of the matrices obtained by ICA. The function `IndependentComponentAnalysis` takes a method option and options for precision goal and maximum number of steps: In[657]:= Options[IndependentComponentAnalysis] Out[657]= {Method -> "FastICA", MaxSteps -> 200, PrecisionGoal -> 6} The intent is `IndependentComponentAnalysis` to be the front interface to different ICA algorithms. (Hence, it has a Method option.) The function `FastICA` takes as options the named arguments of the R function `fastICA` described in \[4\]. In[658]:= Options[FastICA] Out[658]= {"NonGaussianityFunction" -> Automatic, "NegEntropyFactor" -> 1, "InitialUnmixingMartix" -> Automatic, "RowNorm" -> False, MaxSteps -> 200, PrecisionGoal -> 6, "RFastICAResult" -> True} At this point `FastICA` has only the deflation algorithm described in \[1\]. (\[4\] has also the so called "symmetric" ICA sub-algorithm.) The R function `fastICA` in \[4\] can use only two neg-Entropy functions *log(cosh(x))* and *exp(-u\^2/2)*. Because of the symbolic capabilities of *Mathematica* `FastICA` of \[3\] can take any listable function through the option "NonGaussianityFunction", and it will find and use the corresponding first and second derivatives. Using NNMF for ICA ------------------ It seems that in some cases, like the generated data used in this article/blog post, Non-Negative Matrix Factorization (NNMF) can be applied for doing ICA. To be clear, NNMF does dimension reduction, but its norm minimization process does not enforce variable independence. (It enforces non-negativity.) There are at least several articles discussing modification of NNMF to do ICA. For example \[6\]. Load NNMF package \[5\] (from [MathematicaForPrediction at GitHub](https://github.com/antononcube/MathematicaForPrediction)): Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/NonNegativeMatrixFactorization.m"] After several applications of NNMF we get signals close to the originals: {W, H} = GDCLS[M, 3]; Grid[{Map[ListLinePlot[#, ImageSize -> 250] &, Normal[H]]}] [](http://i.stack.imgur.com/Bb3Fk.png) For the generated data in this blog post, FactICA is much faster than NNMF and produces better separation of the signals with every run. The data though is a typical representative for the problems ICA is made for. Another comparison with image de-noising, extending [my previous blog post](https://mathematicaforprediction.wordpress.com/2016/05/07/comparison-of-pca-and-nnmf-over-image-de-noising/), will be published shortly. ICA for mixed time series of city temperatures ---------------------------------------------- Using *Mathematica*'s function `WeatherData` we can get temperature time series for a small set of cities over a certain time grid. We can mix those time series into a multi-dimensional signal, *MS*, apply ICA to *MS*, and judge the extracted source signals with the original ones. This is done with the following commands. ### Get time series data cities = {"Sofia", "London", "Copenhagen"}; timeInterval = {{2016, 1, 1}, {2016, 1, 31}}; ts = WeatherData[#, "Temperature", timeInterval] & /@ cities; opts = {PlotTheme -> "Detailed", FrameLabel -> {None, "temperature,\[Degree]C"}, ImageSize -> 350}; DateListPlot[ts, PlotLabel -> "City temperatures\nfrom " <> DateString[timeInterval[[1]], {"Year", ".", "Month", ".", "Day"}] <> " to " <> DateString[timeInterval[[2]], {"Year", ".", "Month", ".", "Day"}], PlotLegends -> cities, ImageSize -> Large, opts] [](http://i.imgur.com/exsAGOr.png) ### Cleaning and resampling (if any) Here we check the data for missing data: Length /@ Through[ts["Path"]] Count[#, _Missing, \[Infinity]] & /@ Through[ts["Path"]] Total[%] (* {1483, 1465, 742} *) (* {0,0,0} *) (* 0 *) Resampling per hour: ts = TimeSeriesResample[#, "Hour", ResamplingMethod -> {"Interpolation", InterpolationOrder -> 1}] & /@ ts ### Mixing the time series In order to do a good mixing we select a mixing matrix for which all column sums are close to one: mixingMat = #/Total[#] & /@ RandomReal[1, {3, 3}]; MatrixForm[mixingMat] (* mixingMat = {{0.357412, 0.403913, 0.238675}, {0.361481, 0.223506, 0.415013}, {0.36564, 0.278565, 0.355795}} *) Total[mixingMat] (* {1.08453, 0.905984, 1.00948} *) Note the row normalization. Make the mixed signals: tsMixed = Table[TimeSeriesThread[mixingMat[[i]].# &, ts], {i, 3}] Plot the original and mixed signals: Grid[{{DateListPlot[ts, PlotLegends -> cities, PlotLabel -> "Original signals", opts], DateListPlot[tsMixed, PlotLegends -> Automatic, PlotLabel -> "Mixed signals", opts]}}] [](http://i.imgur.com/iULtIMV.png) ### Application of ICA At this point we apply ICA (probably more than once, but not too many times) and plot the found source signals: X = Transpose[Through[tsMixed["Path"]][[All, All, 2]] /. Quantity[v_, _] :> v]; {S, A} = IndependentComponentAnalysis[X, 3]; DateListPlot[Transpose[{tsMixed[[1]]["Dates"], #}], PlotTheme -> "Detailed", ImageSize -> 250] & /@ Transpose[S] [](http://i.imgur.com/f5tABhZ.png) Compare with the original time series: MapThread[DateListPlot[#1, PlotTheme -> "Detailed", PlotLabel -> #2, ImageSize -> 250] &, {tsPaths, cities}] [](http://i.imgur.com/dM6QPHp.png) After permuting and inverting some of the found sources signals we see they are fairly good: pinds = {3, 1, 2}; pmat = IdentityMatrix[3][[All, pinds]]; DateListPlot[Transpose[{tsMixed[[1]]["Dates"], #}], PlotTheme -> "Detailed", ImageSize -> 250] & /@ Transpose[S.DiagonalMatrix[{1, -1, 1}].pmat] [](http://i.imgur.com/jMlLQl5.png) References ---------- \[1\] A. Hyvarinen and E. Oja (2000) Independent Component Analysis: Algorithms and Applications, Neural Networks, 13(4-5):411-430 . URL: [https://www.cs.helsinki.fi/u/ahyvarin/papers/NN00new.pdf](https://www.cs.helsinki.fi/u/ahyvarin/papers/NN00new.pdf). \[2\] Wikipedia entry, [Independent component analysis](https://en.wikipedia.org/wiki/Independent_component_analysis). \[3\] A. Antonov, [Independent Component Analysis Mathematica package](https://github.com/antononcube/MathematicaForPrediction/blob/master/IndependentComponentAnalysis.m), (2016), source code [MathematicaForPrediction at GitHub](https://github.com/antononcube/MathematicaForPrediction/), package [IndependentComponentAnalysis.m](https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/IndependentComponentAnalysis.m) . \[4\] J. L. Marchini, C. Heaton and B. D. Ripley, fastICA, R package, URLs: <https://cran.r-project.org/web/packages/fastICA/index.html>, <https://cran.r-project.org/web/packages/fastICA/fastICA.pdf> . \[5\] A. Antonov, [Implementation of the Non-Negative Matrix Factorization algorithm in Mathematica](https://github.com/antononcube/MathematicaForPrediction/blob/master/NonNegativeMatrixFactorization.m), (2013), source code at [MathematicaForPrediction at GitHub](https://github.com/antononcube/MathematicaForPrediction/), package [NonNegativeMatrixFactorization.m](https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/NonNegativeMatrixFactorization.m). \[6\] H. Hsieh and J. Chien, [A new nonnegative matrix factorization for independent component analysis](https://www.researchgate.net/publication/224149642_A_new_nonnegative_matrix_factorization_for_independent_component_analysis), (2010), Conference: Acoustics Speech and Signal Processing (ICASSP). Anton Antonov 2016-05-24T18:31:16Z https://community.wolfram.com/groups/-/m/t/2071595 ![enter image description here][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=sig.gif&userId=2025695 [2]: https://www.wolframcloud.com/obj/67541fca-9014-4c66-8bbf-e6db0ca3d631 [Original]: https://www.wolframcloud.com/obj/f20171185/Published/cortex-bci.nb Anshul Chandra 2020-09-06T09:55:32Z https://community.wolfram.com/groups/-/m/t/992466 This project was part of a Wolfram Mentorship Program. The classification of human motions based on patterns and physical data is of great importance in developing areas such as robotics. Also, a function that recognizes a specific human motion can be an important addition to artificial intelligence and physiological monitoring systems. This project is about acquiring, curating and analyzing experimental data from certain actions such as walking, running and climbing stairs. The data taken with the help of an accelerometer needs to be turned into an acceptable input for the Classify function. Finally, the function can be updated with more data and classes to make it more efficient and whole. **Algorithms and procedures** The data for this project was acquired by programming an Arduino UNO microprocessor with a Raspberry Pi computer, using Wolfram Language. An accelerometer connected to the Arduino sent measurements each time it was called upon, and Mathematica in the Raspberry Pi collected and uploaded the data. The raw data had to be processed for it to be a good input for the classify function. First, it was transformed into an spectrogram (to analyze the frequency domain of the data). Then, the spectrogram's image was put through the IFData function which filters out some of the noise, and finally the images were converted into numerical data with the UpToMeasurements function (main function: ComponentMeasurements). This collection numerical data was put in a classify function under six different classes (standing, walking, running, jumping and waving). *The IFData function and the UpToMeasurements functions were sent to me by Todd Rowland during the Mentorship. Both functions will be shown at the end of this post. **Example visualization** The following ListLinePlot is an extract from the jumping data ![Example data][1] Next, the data from the plot above is turned into a spectrogram by the function Spectrogram, i.e.: spectrogramImage = Spectrogram[jumpingData, SampleRate -> 10, FrameTicks -> None, Frame -> False, Ticks -> None, FrameLabel -> None] ![Example jumping data spectrogram][2] Finally, all the spectrogram images are used as input for the UpToMeasurements function, along with some properties for the ComponentMeasurements function: i.e: numericalData = N@Flatten[ UpToMeasurements[ spectrogramImage, {"EnclosingComponentCount", "Max", "MaxIntensity", "TotalIntensity", "StandardDeviationIntensity", "ConvexCoverage", "Total", "Skew", "FilledCircularity", "MaxCentroidDistance", "ExteriorNeighborCount", "Area", "MinCentroidDistance", "FilledCount", "MeanIntensity", "StandardDeviation", "Energy", "Count", "MeanCentroidDistance"}, 1]] Which outputs a list of real numbers, one for each of the properties: {0., 1., 1., 1., 1., 19294.9, 0.222164, 0.985741, 31011.8, 15212.5, \ 9624.42, -0.0596506, 0.724527, 190.534, 0., 42584.5, 0.364667, \ 42584., 0.453101, 0.315209, 0.232859, 0.169549, 0.00909654, 42584., \ 98.7136} These numbers are grouped in a nested list which contains data for all 5 human motions. All the data is lastly classified in a classifier using the Classify function. After several combinations of both properties and data sets, I was able to produce classifier functions with an accuracy of 91%, and a total size of 269kb. ------------------------------------------------------------ **Attempt on building a classify function using image processing** On the other hand, the image processing capabilities of Mathematica lets us extract data from images, hence it should be possible to create a classifier which recognizes the moving patterns in the frames of a video. First, I had to take the noise out of every image, this proved to be troublesome, since the background can vary greatly between video samples. Then, I binarized the image in order to isolate the moving particles in each frame, and extract their position with ImageData. Lastly, a data set can be formed from all the analyzed frames; this data can essentially be used in the same way as the accelerometer's, but the classifier was unsuccessful in separating the samples accurately. This was mainly because the accelerometer's data is taken at a constant rate and very precisely, whereas the images depend on the camera's frame rate, and many other external factors. This is what made the data different enough to fail being classified with accuracy. Furthermore, if a big dataset is made from videos of people performing certain actions, the data processing can follow similar steps as the ones explained in this report. Thus producing a similar classifier function. This can further increase the functions accuracy, but the process needs an algorithm that can effectively trace the path of "a particle" that moves through each of the frames of the video, and extract precise velocity data from said movement. ------------------------------------------------------------ Conclusively, the classify function is working very well with the data provided, its accuracy is about 91% for the SupportVectorMachine method. This is a very good result for the human motion classifier. The next step is to add more classes to the function, and test the classifier with data acquired from different sources, such as another accelerometer and various videos of human motion footage. ----------------------------------------- **Code:** - UpToMeasurements function UpToMeasurements[image_,property_,n_]:=MaximalBy[ComponentMeasurements[image,"Count"],Last,UpTo[n]][[All,1]]/.ComponentMeasurements[image,property] *Note: This function simplifies the exploration of properties to input in ComponentMeasurements, also, it outputs a usable list of numerical data retrieved from a given group of images. - IFData function: imagefunctions=<|1-> (EntropyFilter[#,3]&), 2-> (EdgeDetect[EntropyFilter[#,3]]&), 3->Identity, 4-> (ImageAlign[reference110,#]&), 5-> (ImageHistogram[#,FrameTicks->None,Frame->False,FrameLabel->None,Ticks->None]&), 6-> (ImageApply[#^.6&,#]&), 7-> (Colorize[MorphologicalComponents[#]]&), 8-> (HighlightImage[#,ImageCorners[#,1,.001,5]]&), 9-> (HighlightImage[#,Graphics[Disk[{200,200},200]]]&), 10-> ImageRotate, 11-> (ImageRotate[#,45Degree]&), 12->(ImageTransformation[#,Sqrt]&), 13->(ImageTransformation[#,Function[p,With[{C=150.,R=35.},{p[[1]]+(R*Cos[(p[[1]]-C)*360*2/R]/6),p[[2]]}]]]&), 14->( Dilation[#,DiskMatrix[4]]&), 15->( ImageSubtract[Dilation[#,1],#]&), 16-> (Erosion[#,DiskMatrix[4]]&), 17-> (Opening[#,DiskMatrix[4]]&), 18->(Closing[#,DiskMatrix[4]]&), 19->DistanceTransform, 20-> InverseDistanceTransform, 21-> (HitMissTransform[#,{{1,-1},{-1,-1}}]&), 22->(TopHatTransform[#,5]&), 23->(BottomHatTransform[#,5]&), 24-> (MorphologicalTransform[Binarize[#],Max]&), 25-> (MorphologicalTransform[Binarize[#],"EndPoints"]&), 26->MorphologicalGraph, 27->SkeletonTransform, 28->Thinning, 29->Pruning, 30-> MorphologicalBinarize, 31-> (ImageAdjust[DerivativeFilter[#,{1,1}]]&), 32-> (GradientFilter[#,1]&), 33-> MorphologicalPerimeter, 34-> Radon |>; reference110=BlockRandom[SeedRandom["110"];Image[CellularAutomaton[110,RandomInteger[1,400],400]]]; IFData[n_Integer]:=Lookup[imagefunctions,n,Identity] IFData["Count"]:=Length[imagefunctions] IFData[All]:=imagefunctions *Note: This function groups together several image filtering fuctions; it was used to simplify the exploration of functions to be used in the classifier. **This function was written by the the Wolfram team, but was slightly modified for this project. - propertyVector function (this function automatically evaluates all the prior necessary code needed to create the classify functions): propertyVector[property_]:={walkingvector=N@Flatten[UpToMeasurements[#,property,1]]&/@IFData[6]/@(Spectrogram[#,SampleRate->10,FrameTicks->None,Frame->False,Ticks->None,FrameLabel->None]&/@walk); jumpingvector=N@Flatten[UpToMeasurements[#,property,1]]&/@IFData[6]/@(Spectrogram[#,SampleRate->10,FrameTicks->None,Frame->False,Ticks->None,FrameLabel->None]&/@jump); standingvector=N@Flatten[UpToMeasurements[#,property,1]]&/@IFData[6]/@(Spectrogram[#,SampleRate->10,FrameTicks->None,Frame->False,Ticks->None,FrameLabel->None]&/@stand); runningvector=N@Flatten[UpToMeasurements[#,property,1]]&/@IFData[6]/@(Spectrogram[#,SampleRate->10,FrameTicks->None,Frame->False,Ticks->None,FrameLabel->None]&/@run); wavingvector=N@Flatten[UpToMeasurements[#,property,1]]&/@IFData[6]/@(Spectrogram[#,SampleRate->10,FrameTicks->None,Frame->False,Ticks->None,FrameLabel->None]&/@wave); stairsvector=N@Flatten[UpToMeasurements[#,property,1]]&/@IFData[6]/@(Spectrogram[#,SampleRate->10,FrameTicks->None,Frame->False,Ticks->None,FrameLabel->None]&/@stairs); walkingvectortest=N@Flatten[UpToMeasurements[#,property,1]]&/@IFData[6]/@(Spectrogram[#,SampleRate->10,FrameTicks->None,Frame->False,Ticks->None,FrameLabel->None]&/@testwalk); jumpingvectortest=N@Flatten[UpToMeasurements[#,property,1]]&/@IFData[6]/@(Spectrogram[#,SampleRate->10,FrameTicks->None,Frame->False,Ticks->None,FrameLabel->None]&/@testjump); standingvectortest=N@Flatten[UpToMeasurements[#,property,1]]&/@IFData[6]/@(Spectrogram[#,SampleRate->10,FrameTicks->None,Frame->False,Ticks->None,FrameLabel->None]&/@teststand); runningvectortest=N@Flatten[UpToMeasurements[#,property,1]]&/@IFData[6]/@(Spectrogram[#,SampleRate->10,FrameTicks->None,Frame->False,Ticks->None,FrameLabel->None]&/@testrun); wavingvectortest=N@Flatten[UpToMeasurements[#,property,1]]&/@IFData[6]/@(Spectrogram[#,SampleRate->10,FrameTicks->None,Frame->False,Ticks->None,FrameLabel->None]&/@testwave); stairsvectortest=N@Flatten[UpToMeasurements[#,property,1]]&/@IFData[6]/@(Spectrogram[#,SampleRate->10,FrameTicks->None,Frame->False,Ticks->None,FrameLabel->None]&/@teststairs);} Training:=trainingSet=<|"walking"->walkingvector,"running"->runningvector, "standing"-> standingvector, "jumping"-> jumpingvector, "waving"-> wavingvector, "stairs"-> stairsvector|>; Test:=testSet=<|"walking"->walkingvectortest,"running"->runningvectortest, "standing"-> standingvectortest, "jumping"-> jumpingvectortest, "waving"-> wavingvectortest, "stairs"-> stairsvectortest|>; - Example code for the acceleration data acquisition from image processing: images=Import["$path"] motionData= Count[#,1]&/@ (Flatten[ ImageData[Binarize[ImageSubtract[ImageSubtract[#[[1]],#[[2]]],ImageSubtract[#[[2]],#[[3]]]]]]&/@ Partition[images,3,1],1]) *Note: before this code can be used, the backgrounds of the frames of the video have to be removed, and the image has to be binarized as much as possible (some examples will be shown in the next section). - Example code for the retrieval of raw data from DataDrop: rawData=Values[Databin["Serial#", {#}]]; data=Flatten[rawData["(xacc/yacc/zacc)"]]; --------------------------------- **Please feel free to contact me or comment if you are interested in the rest of the code ( uploading the C code to the Arduino, the manufacturer's code for the accelerometer, C code switch that lets Mathematica communicate with the Arduino, and the Wolfram Language code used to start each loop in the switch that retrieves data ). Also, I could send the classify function, or any other information that I might have left out; all suggestions welcome. [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=1.png&userId=602285 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=2.png&userId=602285 Pablo Ruales 2017-01-11T01:15:04Z https://community.wolfram.com/groups/-/m/t/1383630 During this year's Wolfram Summer Camp, being mentored by Christian Pasquel, I developed a tool that identifies chord sequences in music (from MIDI files) and generates a corresponding graph. The graph represents all [unique] chords as vertices, and connects every pair of chronologically subsequent chords with a directed edge. Here is an example of a graph I generated: ![Graph genehrated from Bach's prelude no.1 of the Well Tempered Klavier (Book I)][1] Below is a detailed account on the development and current state of the project, plus some background on the corresponding musical theory notions. #Introduction       **GOAL** | The aim of this project is to develop a utility that identifies chords (e.g. C Major, A minor, G7, etc.) from MIDI files, in chronological order, and then generates a graph for visualizing that chord sequence. In the graph, each vertex would represent a unique chord, and each pair chronologically adjacent chords would be connected by a directed edge (i.e. an arrow). So, for example, if at some point in the music that is being analyzed there is a transition from a major G chord to a major C chord, there would be an arrow that goes from the G Major chord to the C Major chord. Therefore, the graph would describe a [Markov chain][2] for the chords. The purpose of the graph is to visualize frequent chord sequences and progressions within a certain piece of music.       **MOTIVATION** | While brainstorming for project ideas, I don't know why, I had a desire to do something with graphs. Then I asked myself, "What are graphs good at modelling?". I mentally browsed through my areas of interest, searching for any that matched that requirement. One of my main interests is music; I am somewhat of a musician myself. And, in fact, [musical] harmony *is* a good subject to be modelled by graphs. Harmony, one of the fundamental pillars of music (and perhaps the most important), not only involves the chords themselves, but, more significantly, the *transitions* between those, which is what gives character to music. And directed graphs, and, specifically, Markov models, are a perfect match for transitions between states. ---------- #Some background *Skip this if you aren't interested in the musical theory part or if you already have a background in music theory!* ##What is a chord? A chord is basically a group of notes played together (contemporarily). Chords are the quanta of musical "feeling"; the typical—but somewhat naïve—example is the sensation of major chords sounding "happy" and minor chords sounding "sad" or melancholic (more on types of chords later). Types of chords are defined by the [intervals][3] (distance in pitch) between the notes. The *root* of a chord is the "most important" or fundamental note of the cord, in the sense that it is the "base" from which the aforementioned intervals are measured. In other words, the archetype of chord defines the "feel" and the general harmonic properties of the chord, while the root defines the pitch of the chord. So a "C Major" chord is a chord with archetype "major triad" (more on that later) built on the note C; i.e., its root is C. The *sequence* of chords in a piece constitutes its **harmony**, and it can convey much more complex musical messages or feelings than a single chord, just as in language: a single word does have meaning, but a sentence can have a much more complex meaning than any single word. ##Patterns in chord sequences The main difference that between language and music is that language, in general, has a much stricter structure (i.e. the order of words, a.k.a. syntax) than music: the latter is an art, and there are no predetermined rules to follow. But humans \[have a tendency to\] like patterns, and music wouldn't be so universally beloved if it didn't contain any patterns. This also explains the unpopularity of [atonal music][4] (example [here][5]). But even atonal music has patterns: it may do its best to avoid harmonic patterns, but it still contains some level of rythmic, textural or other kinds of patterns. This is why using graphs to visualize chord sequences is interesting: it is a semidirect way of identifying the harmonic patterns that distinguish different genres, styles, forms, pieces or even fragments of music. In my project, I have mainly focused on the "western" conception of tonal music, an particularly in its "classical" version (what I mean by "classical" is, in lack of a better definition, a classification that encompasses all music where the composer is, culturally, the most important artist). That doesn't mean this tool isn't apt for other types of music; it just means it will analyze it from this specific standpoint. In tonal music, the harmonic patterns are all related to a certain notion of "center of gravity": the [*tonic*][6], which is, in some way the music's harmonic "home". Classical (as in pre-XX-century) tonal music usually ends (and often starts) with the tonic chord. In fact, we can further extend the analogy with gravity by saying that music consists in a game of tension, in which the closer you are to the center of gravity (the tonic), the greater the "pull". In an oversimplified manner, the musical equivalent of the [Schwarzschild radius][7] is the [dominant chord][8]: it tends towards the tonic. Well, not really, because you *can* turn back from it—and in fact a lot of interesting harmonical sequences consist in doing just that. ##Some types of chords In "classical" music (see definition above), there are mainly these kinds of chords (based on the amount of unique notes they contain): triad chords (i.e. three-note chords), seventh chords (i.e. four-note chords; we'll see why they're called *seventh* in a bit), and ninth chords (five-note chords). There is another main distinction: major and minor chords (i.e. the cliché "happy" vs "sad" distinction). ###Triad chords Probably the most simple and frequent chord is the triad chord (either major or minor). Here is a picture of a major and a minor triad C chord (left to right): ![Major and minor triad C chords (ltr)][9] ###Seventh chords [Seventh chords][10] are called so because they contain a seventh [interval][11]. Their main significance is in dominant chords, where they usually appear in the major-triad-minor-seventh (a.k.a ["dominant"][12]) form. Another important seventh chord form is the fully diminished seventh chord (these will be relevant for the code later), which also tends to resolve ("resolve" is music jargon for "transition to a chord with less tension") to tonic. ![Seventh chords][13] ###Ninth chords Although not extremely frequent, they do appear in classical music. The most "popular" is the dominant ninth chord (an extension of the dominant 7th). An alternative for this chord is the minor ninth dominant chord (built from the same dominant 7th chord, but with a minor ninth instead). <br> ---------- #Algorithms and Code In this section I'm going to walk through my code in order of execution. Four main parts can be distinguished in my project: importing and preprocessing, splitting the note sequence into "chunks" to be analyzed as chords, identifying the chord in each of those chunks, and visualizing the whole sequence as a graph. ##First phase: importing and preprocessing the MIDI file The first operation that needs to be done is importing the MIDI file and preprocessing it. This includes selecting which elements to import from the file, converting them to a given simplified form, and performing any sorting, deletion of superfluous elements, or other modification that needs to be done. For this purpose I defined the function `importMIDI`: importMIDI[filename_String] := MapAt[Flatten[#, 1] &, MapAt[flattenAndSortSoundNotes, Import[(dir <> filename <> ".mid"), {{"SoundNotes", "Metadata"}}], 1], 2] Here `dir` stands for the directory where I saved all my MIDIs (to avoid having to type in the whole directory every time). Notice that we're importing the music as SoundNotes *and* the file's metadata—we will need it for determining the boundaries of measures (see below). The function `flattenAndSortNotes` does what it sound like: it converts the list of `SoundNote`s that `Import` returned into a flattened list of notes (i.e. a single track), sorted by their starting time. It also gets rid of anything that isn't necessary for chord identification (i.e. rhythmic sounds or effects). Consult the attached notebook for the explicit definition. Here is the format the sequence of notes is returned in (i.e. `importMIDI[...][[1]]`): {{"C4", {0., 1.4625}}, {"E4", {0.18125, 1.4625}}, {"G4", {0.36875, 0.525}}, <<562>>, {"G2", {105., 107.963}}, {"G4", {105., 107.963}}} Each sub-list represents a note. Its first element is the actual pitch; the second is a list that represents the timespan (i.e. start and end time in seconds). <br> ##Second phase: splitting the note sequence into chunks The challenge in this part of the project is knowing how to determine which notes form a single chord; i.e., where to put the boundary between one chord and the next. The solution I came up with is not optimal, but, until now, nothing better has occurred to me (suggestions are welcome!). It involves determining where each measure start/end lies in time from the metadata and splitting each of those into a certain amount of sub-parts; then the notes are grouped by the specific sub-part of the specific measure they pertain to. The rationale behind this is that chords in classical music tend to be well-contained within measures or rational fractions of these. This procedure is contained in the function `chordSequenceAnalyzeUsingMeasures`. I'm going to go over it quickly: chordSequenceUsingMeasures[midiData_List /; Length@midiData == 2, measureSplit_: 2, analyzer_String: "Heuristic"] := Block[{noteSequence, metadata, chunkKeyframes, chunkedSequence, result}, (*Separate notes from metadata*) noteSequence = midiData[[1]]; metadata = midiData[[2]]; Until here it's pretty self evident. (*Get measure keyframes*) chunkKeyframes = divideByN[ measureKeyframesFromMetadata[ metadata, (Last@noteSequence)[[2, 2]]], measureSplit]; Here the function `measureKeyframesFromMetadata` is called. It fetches all of the `TimeSignature` and `SetTempo` tags in the metadata and identifies the position of each measure from them. `divideByN` subdivides each measure by `measureSplit` (an optional argument with default value `2`). (*Chunk sequence*) chunkedSequence = {}; Module[{i = 1}, Do[ With[{k0 = chunkKeyframes[[j]], k1 = chunkKeyframes[[j + 1]]}, Module[{chunk = {}}, While[ i <= Length@noteSequence && ( k0 <= noteSequence[[i, 2, 1]] < k1 || k0 < noteSequence[[i, 2, 2]] <= k1 ), AppendTo[chunk, noteSequence[[i]]] i++;]; AppendTo[chunkedSequence, chunk] ] ], {j, Length@chunkKeyframes - 1}]]; chunkedSequence = DeleteCases[chunkedSequence, l_List /; Length@l == 0]; Once the measures' timespan has been determined, a list of "chunks" (lists of notes grouped by measure part) is generated. (*Call analyzer*) Switch[analyzer, "Deterministic", result = chordChunkAnalyze /@ chunkedSequence, "Heuristic", result = heuristicChordAnalyze /@ justPitch /@ chunkedSequence ]; result = resolveDiminished7th[Split[result][[All, 1]]] ] Finally, each chunk is sent to the chord analyzer function `heuristicChordAnalyze`, which I'll talk about in the next section, along with the currently mysterious `resolveDiminished7th`. Since this algorithm for "chunking" a note sequence doesn't work for everything, I also developed an alternative, more naïve approach: chordSequenceNaïve[midiData_List /; Length@midiData == 2, analyzer_String: "Heuristic", n1_Integer: 6, n2_Integer: 1] := Module[{noteSequence, chunkedSequence, result}, (*Separate notes from metadata*) noteSequence = midiData[[1]]; (*Chunk sequence*) chunkedSequence = Partition[noteSequence, n1, n2]; (*Call analyzer*) result = heuristicChordAnalyze /@ justPitch@chunkedSequence; result = resolveDiminished7th[Split[result][[All, 1]]] ] <br> ##Phase 3: identifying the chord from a group of notes This has been the main conceptual challenge in the whole project. After some unsucsessful ideas, with some suggestions from Rob Morris (one of the mentors), whom I thank, I ended up developing the following algorithm. It iterates through each note and assigns it a score that represents the likeliness of that note being the root of the chord based on the presence of certain indicators (i.e. notes the presence of which define a chord, to some degree), each of which with a different weight: having a fifth, having a third, a minor seventh... Then the note with the highest chord is assumed to be the root of the chord. In code: heuristicChordAnalyze[notes_List] := Block[{chordNotes, scores, root}, (*Calls to helper functions*) chordNotes = octaveReduce /@ convertToSemitones /@ notes // DeleteDuplicates; (*Scoring*) scores = Table[Total@ Pick[ (*Score points*) {24, 16, 16, 8, 2, 3, 1, 1, 10, 15, 15, 18}, (*Conditions*) SubsetQ[chordNotes, #] & /@octaveReduce /@ {{nt + 7}, {nt + 4}, {nt + 3}, {nt + 10}, {nt + 11}, {nt + 2}, {nt + 5}, {nt + 9}, {nt + 4, nt + 10}, {nt + 3, nt + 6, nt + 10}, {nt + 3, nt + 6, nt + 9}, {nt + 1, nt + 4, nt + 10}} ] (*Substract outliers*) - 18*Length@Complement[chordNotes, octaveReduce /@ {nt, 7 + nt, 4 + nt, 3 + nt, 10 + nt, 11 + nt, 2 + nt, 5 + nt, 9 + nt, 6 + nt}], {nt, chordNotes}]; (*Return*) root = Part[chordNotes, Position[scores, Max @@ scores][[1, 1]]]; {root, Which[ SubsetQ[chordNotes, octaveReduce /@ {root + 10 , root + 2, root + 5, root + 9}], "13", SubsetQ[chordNotes, octaveReduce /@ {root + 10, root + 2, root + 5}], "11", SubsetQ[chordNotes, octaveReduce /@ {root + 4, root + 10, root + 2}], "Dom9", SubsetQ[chordNotes, octaveReduce /@ {root + 4, root + 10, root + 1}], "Dom9m", SubsetQ[chordNotes, octaveReduce /@ {root + 11, root + 7, root + 3}], "m7M", SubsetQ[chordNotes, {octaveReduce[root + 11], octaveReduce[root + 4]}], "7M", SubsetQ[chordNotes, {octaveReduce[root + 10], octaveReduce[root + 4]}], "Dom7", SubsetQ[chordNotes, {octaveReduce[root + 10], octaveReduce[root + 7]}], "Dom7", SubsetQ[chordNotes, {octaveReduce[root + 10], octaveReduce[root + 6]}], "d7", SubsetQ[ chordNotes, {octaveReduce[root + 9], octaveReduce[root + 6]}], "d7d", SubsetQ[chordNotes, {octaveReduce[root + 10], octaveReduce[root + 3]}], "m7", MemberQ[chordNotes, octaveReduce[root + 4]], "M", MemberQ[chordNotes, octaveReduce[root + 3]], "m", MemberQ[chordNotes, octaveReduce[root + 7]], "5", True, "undef"]} ] ###A note on notation In this project I use the following abbreviations for chord notation (they're not in the standard format). "X" represents the root of the chord. - *X-**5*** = undefined triad chord (just the root and the fifth) - *X-**M*** = Major - *X-**m*** = minor - *X-**m7*** = minor triad with minor (a.k.a dominant) seventh - *X-**d7d*** = fully diminished 7thchord - *X-**d7*** = half diminished 7thchord - *X-**Dom7*** = Dominant 7th chord - *X-**7M*** = Major triad with Major 7th - *X-**m7M*** = minor triad with Major 7th - *X-**Dom9*** = Dominant 9th chord - *X-**Dom9m*** = Dominant 7th chord with a minor 9th - *X-**11*** = 11th chord - *X-**13*** = 13th chord ###Dealing with diminished 7th chords Now, on to `resolveDiminished7th`. What is this function on about? Well, recall the fully diminished seventh chords I mentioned in the Background section. Here's the problem: they're completely symmetrical! What I mean by that is that the intervals between subsequent notes are identical, even if you [invert][14] the chord. In other words, the distance in semitones between notes is constant (it's 3) and is a factor of 12 (distance of 12 semitones = octave). So, given one of these chords, there is no way to determine which note is the root just by analyzing the chord itself. In the context of our algorithm, every note would have the same score! At this point I thought: "How do humans deal with this?". And I concluded that the only way to resolve this issue is to have some contextual vision (looking at the next chord, particularly), which is how humans do it. So what `resolveDiminished7th` does is it brushes through the chord sequence stored in `result`, looking for fully diminished chords (marked with the string "d7d"), and re-assigns each of those a root by looking at the next chord: resolveDiminished7th[chordSequence_List] := Module[{result}, result = Partition[chordSequence, 2, 1] /. {{nt_, "d7d"}, c2_List} :> Which[ MemberQ[octaveReduce /@ {nt, nt + 3, nt + 6, nt + 9}, octaveReduce[c2[[1]] - 1]], {{c2[[1]] - 1, "d7d"}, c2}, MemberQ[octaveReduce /@ {nt, nt + 3, nt + 6, nt + 9}, octaveReduce[c2[[1]] + 4]], {{c2[[1]] + 4, "d7d"}, c2}, MemberQ[octaveReduce /@ {nt, nt + 3, nt + 6, nt + 9}, octaveReduce[c2[[1]] + 6]], {{c2[[1]] + 6, "d7d"}, c2}, True, {{nt, "d7d"}, c2}]; result = Append[result[[All, 1]], Last[result][[2]]] ] ##Phase 4: Visualization Basically, my visualization function (`visualizeChordSequence`) is fundamentally a highly customized call of the `Graph` function; so I'll just paste the code below and then explain what some parameters do: visualizeChords[chordSequence_List, layoutSpec_String: "Unspecified", version_String: "Full", mVSize_: "Auto", simplicitySpec_Integer: 0, normalizationSpec_String: "Softmax"] := Module[{purgedChordSequence, chordList, transitionRules, weights, graphicalWeights, nOfCases, edgeStyle, vertexLabels, vertexSize, vertexStyle, vertexShapeFunction, clip}, (*Preprocess*) Switch[version, "Full", purgedChordSequence = StringJoin[toNoteName[#1], "-", #2] & @@@ chordSequence, "Basic", purgedChordSequence = Split[toNoteName /@ chordSequence[[All, 1]]][[All, 1]]]; (*Amount of each chord*) chordList = DeleteDuplicates[purgedChordSequence]; nOfCases = Table[{c, Count[purgedChordSequence, c]}, {c, chordList}]; (*Transition rules between chords*) Switch[version, "Full", transitionRules = Gather[Rule @@@ Partition[purgedChordSequence, 2, 1]], "Basic", transitionRules =(*DeleteCases[*) Gather[Rule @@@ Partition[purgedChordSequence, 2, 1]](*, t_/; Length@t\[LessEqual]2]*) ]; (*Get processed weight for each transition*) weights = Length /@ transitionRules; If[normalizationSpec == "Softmax", graphicalWeights = SoftmaxLayer[][weights]];; graphicalWeights = If[Min@graphicalWeights != Max@graphicalWeights, Rescale[graphicalWeights, MinMax@graphicalWeights, {0.003, 0.04}], graphicalWeights /. _?NumericQ :> 0.03 ]; (*Final transition list*) transitionRules = transitionRules[[All, 1]]; (*Graph display specs*) clip = RankedMax[weights, 4]; edgeStyle = Table[(transitionRules[[i]]) -> Directive[Thickness[graphicalWeights[[i]]], Arrowheads[2.5 graphicalWeights[[i]] + 0.015], Opacity[Which[ weights[[i]] <= Clip[simplicitySpec - 2, {0, clip - 2}], 0, weights[[i]] <= Clip[simplicitySpec, {0, clip}], 0.2, True, 0.6]], RandomColor[Hue[_, 0.75, 0.7]], Sequence @@ If[weights[[i]] <= Clip[simplicitySpec - 1, {0, clip - 1}], { Dotted}, {}] ], {i, Length@transitionRules}]; vertexLabels = Thread[nOfCases[[All, 1]] -> (Placed[#, Center] & /@ (Style[#[[1]], Bold, Rescale[#[[2]], MinMax[nOfCases[[All, 2]]], Switch[mVSize, "Auto", {6, 20}, _List, 10*mVSize[[1]]/0.3*{1, mVSize[[2]]/mVSize[[1]]}]]] & /@ nOfCases))]; vertexSize = Thread[nOfCases[[All, 1]] -> Rescale[nOfCases[[All, 2]], MinMax[nOfCases[[All, 2]]], Switch[mVSize, "Auto", (Floor[Length@chordList/10] + 1)*{0.1, 0.3}, _List, mVSize]]]; vertexStyle = Thread[nOfCases[[All, 1]] -> Directive[Hue[0.53, 0.27, 1, 0.6], EdgeForm[Blue]]]; vertexShapeFunction = Switch[version, "Full", Ellipsoid[#1, {3.5, 1} #3] &, "Basic", Ellipsoid[#1, {2, 1} #3] &]; Graph[transitionRules, GraphLayout -> Switch[layoutSpec, "Unspecified", Automatic, _, layoutSpec], EdgeStyle -> edgeStyle, EdgeWeight -> weights, VertexLabels -> vertexLabels, VertexSize -> vertexSize, VertexStyle -> vertexStyle, VertexShapeFunction -> vertexShapeFunction, PerformanceGoal -> "Quality"] ] There are five main things to focus on in the above definition: the graph layout (passed as the argument `layoutSpec`), the edge thickness (defined in `edgeStyle`), the vertex size (defined in `vertexSize`), the version (passed as argument `version`) and the simplicity specification (`simplicitySpec`). The graph layout is a `Graph` option that can be specified in the argument `layoutSpec`. If `"Unspecified"` is passed, an automatic layout will be used. I find that the best layouts tend to be, in order of preference, "BalloonEmbedding" and "RadialEmbedding"; nevertheless, neither are a perfect fit for every piece. In the future I would like to to implement custom (i.e. pre-defined) positioning, so that I can design it in a way that best fits this project. The edge thickness is a function of the amount of times a certain transition between two chords has occurred in the chord sequence. There is an option (namely the `normalizationSpec` argument) to enable or disable using a Softmax function for assigning thicknesses to edges. This is due to the fact that for simple/short chord sequences, Softmax is actually counterproductive because it suppresses secondary but still top-ranked transitions; i.e., it assigns a very high thickness to the most frequent transition and a low thickness to all other transitions (even those that come in second or third in frequency ranking). But for large or complex sequences it is actually useful, because it "gets rid of" a lot of the \[relatively\] insignificant instances, thus making the output actually understandable (and not just a [jumbled mess of thick lines][15]). The vertex size is proportional to the number of occurrences of each particular chord (that is, without taking into account the transitions). It can also be specified manually by passing `vSize` as a list `{a,b}` such that `a` is the minimum size an `b` is the maximum. The `version` can be either `"Full"` or `"Basic"`; the default is `"Full"`. The `"Basic"` version consists of a simplified chord set in which only the root note of the chord is taken into account, and not the archetype. For example, all C chords (M, Dom7, m...) would be represented by a single `"C"` vertex. Finally, the simplicity specification (`simplicitySpec`) is a number that can be thought of, in some way, as a "noise" threshold: as it gets larger, fewer edges "stand out"—that is, more of the lower-significance ones are rendered with reduced opacity or are shown as dotted lines. This is useful for large or complex sequences. <br> ---------- #Some examples Here I will show some specific examples generated with this tool. I tried to use different styles of music for comparison. - **Bach**'s [prelude no.1][16] from the Well Tempered Clavier: ![Visualization of Bach's prelude no.1 ][17] - **Debussy**'s [*Passepied*][18] from the *Suite Bergamasque*: ![Visualization of Debussy's *Passepied*][19] - A "template" blues progression: ![Blues template][20] - **Beethoven**'s second movement from the *Pathétique* sonata (no.8): ![Beethoven][21] - Any "reggaeton" song (e.g. Despacito): ![Reggaeton][22] #Microsite Check out the form page (a.k.a. microsite) of this project [here][23]: https://www.wolframcloud.com/objects/lammenspaolo/Chord%20sequence%20visualization [![enter image description here][24]][23] Briefly, here is what each option does (see the section **Algorithms and code** for a more detailed explanation): - **Chunkifier funciton**: choose between splitting notes by measures or by a constant amount of notes - **Measure split factor**: choose into how many pieces you want to divide measures (each piece will be analyzed as a separate chord) - **Graph layout**: choose the layout option for the `Graph` call - **Normalization function**: choose whether to apply a Softmax function to the weights of edges (to make results clearer in case of complex sequences). - **Version**: choose "Full" for complete chord info (e.g. "C-M", "D-Dom7", "C-7M"...) or "Basic" for just the root of the chord (e.g. "C", "D"...) - **Vertex size**: specify vertex size as a list `{a,b}` where `a` is the minimum and `b` is the maximum size - **Simplicity parameter**: visual simplification of the graph (a value of 0 means no simplification is applied) <br> #Conclusions I have developed a functional tool to visualize chord sequences as graphs. It is far from perfect, though. In the future, I would like improving the positioning of vertices, being able to eliminate insignificant transitions from the graph altogether, and making other visual adjustments. Furthermore, I plan to refine and optimize the chord analyzer, as right now it is just an experimental version that isn't too accurate. A better "chunkifier" function could be developed too. Finally, I'd like to thank my mentor Christian Pasquel and all of the other WSC staff for this amazing opportunity. I'd also like to thank my music theory teacher, Raimon Romaní, for making me, over the years, sufficiently less terrible at musical analysis to be able to undertake this project. [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Prelude.png&userId=1372342 [2]: https://en.wikipedia.org/wiki/Markov_chain "Wikipedia: Markov chain" [3]: https://en.wikipedia.org/wiki/Interval_(music) "Wikipedia: Interval" [4]: https://en.wikipedia.org/wiki/Atonality "Wikipedia: Atonality" [5]: https://youtu.be/L85XTLr5eBE "Schönberg's 4th string quartet on YouTube" [6]: https://en.wikipedia.org/wiki/Tonic_%28music%29 "Wikipedia: Tonic" [7]: http://astronomy.swin.edu.au/cosmos/S/Schwarzschild+Radius "Basic info on Schwartzschild radius" [8]: https://en.wikipedia.org/wiki/Dominant_(music) "Dominant chord" [9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=2548Macro_analysis_chords_on_C.jpg&userId=1372342 [10]: https://en.wikipedia.org/wiki/Seventh_chord "Wikipedia: Seventh chord" [11]: https://en.wikipedia.org/wiki/Interval_(music) "Wikipedia: Interval" [12]: https://en.wikipedia.org/wiki/Dominant_seventh_chord "Wikipedia: Dominant seventh" [13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=images.png&userId=1372342 [14]: https://en.wikipedia.org/wiki/Inversion_(music)#Chords "Wikipedia: Inversion#Chords" [15]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Passepied.png&userId=1372342 "Jumbled mess!" [16]: https://www.youtube.com/watch?v=aengbLEFnM8 [17]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Prelude.png&userId=1372342 [18]: https://www.youtube.com/watch?v=hDWbVP-5DSA "Passepied" [19]: http://community.wolfram.com//c/portal/getImageAttachment?filename=deb_pass2.png&userId=1372342 [20]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Blues.png&userId=1372342 [21]: http://community.wolfram.com//c/portal/getImageAttachment?filename=pathetique.png&userId=1372342 [22]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Reggaeton.png&userId=1372342 [23]: https://www.wolframcloud.com/objects/lammenspaolo/Chord%20sequence%20visualization "Microsite" [24]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-07-19at1.53.02PM.png&userId=11733 Paolo Lammens 2018-07-14T05:10:03Z https://community.wolfram.com/groups/-/m/t/3299985 ![Signals, systems, and signal processing: a computational approach][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Main18102024.png&userId=20103 [2]: https://www.wolframcloud.com/obj/9fef1db9-ca5d-4080-9db5-fefdbb4d3085 Mariusz Jankowski 2024-10-17T21:55:31Z https://community.wolfram.com/groups/-/m/t/788811 Hi, This is an idea that has challenged me since I started using MMA a little over two years ago. The idea was to append `//stereo` to a 3D plot and instantly get a stereogram that can be manipulated just like a normal 3D plot, turning it around and viewing it from different angles. This is my first use of `Dynamic`, so it might be a little clunky. Help in speeding it up would be appreciated. stereo[expr_] := DynamicModule[ {vp = {1.3, -2.4, 2.0}, vv = {0., 0., 2.0}, plot}, plot = expr; GraphicsRow[ {Show[plot, ViewPoint -> Dynamic[vp + {0.4, 0, 0}], ViewVertical -> Dynamic[vv]], Show[plot, ViewPoint -> Dynamic[vp], ViewVertical -> Dynamic[vv]]}, ImageSize -> Large ] ] For instance, Plot3D[Sin[x] Cos[y] Cos[x y], {x, 0, 2 Pi}, {y, 0, 2 Pi}, PlotRange -> All, ColorFunction -> "BlueGreenYellow"] // stereo ![enter image description here][1] Viewing the stereogram takes a little practice. I learned it from a radiologist who used it to make 3D X-rays. He would position the patient, take an x-ray, move the x-ray source over a couple of inches, and take another x-ray. Then he put both x-rays side-by-side on the light panel, stepped back, and crossed his eyes until the two images superimposed. Voila! a 3D view of the interior of patient's body. When learning, it's helpful to hold a finger between your eyes and the image. Focus on the finger and move it back and forth until the images coalesce in the background. Now keep the images together and re-focus your eyes on them. That can be tricky as it's quite unnatural. Once the trick is learned, stereo images are as easy to see as flat ones. The right-hand image can be moved around using the mouse and the left will follow. The function needs improvement, though. Sometimes the images get out of sync. Just do a shift-enter to restart. Eric EDIT: I've changed the offset in the viewpoint from {0,0.4,0} to {0.4,0,0}. Strange how even the wrong offset results in a stereogram! [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=9384stereofunction.jpg&userId=455211 Eric Johnstone 2016-02-07T19:42:29Z https://community.wolfram.com/groups/-/m/t/2887842 ![enter image description here][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=CivilStructure2.gif&userId=20103 [2]: https://www.wolframcloud.com/obj/3b9a5696-068c-452b-bba3-2b7d47fece71 Vedat Senol 2023-04-06T08:24:12Z https://community.wolfram.com/groups/-/m/t/1219764 *MODERATOR NOTE: for true Star Wars fans this post has a related Wolfram Cloud App, which you can access by clicking on the image below. Read the full post below to understand how the app works. May the Force be with you.* [![enter image description here][1]][9] ---------- Kylo Ren voice in [Star Wars The Force Awakens][2] is very cool. When I watched the movie in 2015, one of the first things that came up to my mind was how to do such voice in Mathematica. At the time Mathematica capabilities to manipulate sounds were very simplistic, and was not possible to do such thing. I'm far far way to be a sound expert, but I tried do something like this: file = Import["https://s3-sa-east-1.amazonaws.com/rmurta/murta-audio.wav"]; audioOrg = Audio[file]; audioKylo = AudioPitchShift[audioOrg, 0.9]; audioKylo = AudioFrequencyShift[audioKylo,-200]//AudioAmplify[#, 4]& - Original Murta's record: [Murta original][3] - And here is the result: [Murta as Kylo][4] [![Kylo Voice][5]][6] [youtube link for Kylo][7] See [original post in Stack Exchange][8], where I ask for improvement in the sound hack. After that, why not create a cloud app for that?! This is amazing about Mathematica, with one line of code you can create a App, and everybody can play with It! CloudDeploy[FormFunction[{"sound"->"Sound"}, AudioAmplify[AudioFrequencyShift[AudioPitchShift[#sound,0.9],-200],4]&], "kylo-voice-by-murta",Permissions->"Public"] Here is the link, so you can try it: [kyle-voice-by-murta][9]. Record your sound and speak like Kylo! [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-11-14at1.40.15PM2.png&userId=11733 [2]: https://en.wikipedia.org/wiki/Star_Wars:_The_Force_Awakens [3]: https://s3-sa-east-1.amazonaws.com/rmurta/murta-audio.wav [4]: https://s3-sa-east-1.amazonaws.com/rmurta/murta-kylo-audio.wav [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=kylo-voice2.png&userId=11733 [6]: https://www.youtube.com/watch?v=zy-wqB4cbT8&feature=youtu.be&t=49s [7]: https://www.youtube.com/watch?v=zy-wqB4cbT8&feature=youtu.be&t=49s [8]: https://mathematica.stackexchange.com/questions/159744 [9]: https://www.wolframcloud.com/objects/murta/kylo-voice-by-murta Rodrigo Murta 2017-11-11T13:06:38Z https://community.wolfram.com/groups/-/m/t/203335 Hi, Continuing the topic started in [url=http://community.wolfram.com/groups/-/m/t/202094?p_p_auth=9HFetOtL]here[/url] I've decided to share my frequency search routine. Note that I do not have Newton algorithm in it and the routing is not optimized. The idea behind adding Newton algorithm is the following: when first approximation of the frequency is found instead of using convolution on the full signal convolution is performed for "left" and "right" regions separately. The best is then choosen and division is performed again. Division should be performed until some pre-defined accuracy for frequency is reached (typically ~10^-9...10^-10) This module can be used only for equally spaced data (in time or space). If someone is interested in improving this code I'll be happy to assist. Unfortunately, I have no time to finish it by myself. I.M. Ivan Morozov 2014-02-20T04:07:34Z https://community.wolfram.com/groups/-/m/t/2489380 ![enter image description here][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=FFT-image.jpg&userId=23275 [2]: https://www.wolframcloud.com/obj/d37e248b-a21a-4e24-bd53-397ce7e9e897 Todd Rowland 2022-03-14T00:03:17Z https://community.wolfram.com/groups/-/m/t/2200588 ![FFT][1] &[Wolfram Notebook][2] [Original]: https://www.wolframcloud.com/obj/74266892-afc7-48bc-bc81-45e47085a371 [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=fft_8.gif&userId=89693 [2]: https://www.wolframcloud.com/obj/7a9e9f3a-7fee-4ba8-ad52-914bdcc1d822 Christophe Favergeon 2021-02-21T14:12:07Z