https://community.wolfram.com RSS Feed for Wolfram Community showing any discussions tagged with Units sorted by most viewed. https://community.wolfram.com/groups/-/m/t/344241 Together with [Björn Schelter][1] I have tried to read in data from the personal weather station [Netatmo][2] ![Reading high resolution weather data from Netatmo][3] which, as it turns out, is a very good companion for Mathematica; it also features in the [connected devices list of Wolfram][4].This device measures temperature, humidity, pressure, noise level and potentially the precipitation indoors and outdoors. Users are encouraged to share the outdoors data; as the weather station is rather popular there are lots of measurements. On their website [https://www.netatmo.com/][5] the company makes these measurements available. You can represent worldwide data ![enter image description here][6] (I know that that figure does not show the entire world!) or zoom in to street level data: ![enter image description here][7] On the website [https://dev.netatmo.com][8] you can sign up for a developer account which gives you access to the API of netatmo. In this post I am going to show how to access the data with Mathematica. When you sign up for a netatmo developer account you will be issued a client id and a client secret. These are rather long strings. You will also get a username and a password for your account. Next you need to request an access token, which you can do via the following command: > curl -X POST -d > "grant_type=password&client_id=AAAAAAAAAAAAAAAAAAAA&client_secret=BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB > &username=XXXXXXXXXXXXXXXX&password=YYYYYYYYYYYYYYY&scope=read_station" > http://api.netatmo.net/oauth2/token> ~/Desktop/request-token.txt On a Mac I generate a file called netatmo.sh containing that string on the desktop; I obviously substitute AAAAAAAAAAAA by the client id, BBBBBBBBBBBBBBBB by the client secret, XXXXXXXXXXXX and YYYYYYYYYY by the user name and the password. Then I use the terminal command > chmod a+x netatmo.sh The rest is child's play. We need to execute the command Run["~/Desktop/netatmo.sh"]; data = Import["https://api.netatmo.net/api/getpublicdata?access_token="<>Last[StringSplit[Import["~/Desktop/request-token.txt", "CSV"][[1, 1]], "\""]] <> "&lat_ne=59.91&lon_ne=13.75&lat_sw=40.42&lon_sw=-20.0&filter=True", "Text"]; Note that the numbers following lat_ne, lon_ne, lat_sw, lon_sw are the north east and south west latitudes and longitudes. If we want to request data for other regions we can do so by changing these entries. Next we clean the data a little bit: tab = Quiet[ Select[Select[Table[ToExpression /@ Flatten[StringSplit[#, "]"] & /@ StringSplit[#, "["] & /@ If[Length[StringSplit[StringSplit[data, "place"][[k]], ","]] > 12, Drop[StringSplit[StringSplit[data, "place"][[k]],","], {5}], StringSplit[StringSplit[data, "place"][[k]], ","]]][[{2, 3, 7, 8, 15}]], {k, 2, Length[StringSplit[data, "place"]]}], Length[Cases[Flatten[#], $Failed]] == 0 & ], Length[#] == 5 &]]; That does look a bit cryptic but gives us what we want. tab[[1]] gives {10.5673, 59.8929, 13, 80, 1032.9}, wich are the gps coordinates, the temperature in Celsius, the humidity in % and the pressure in mbar. I will now propose three different representations of the data. scaled = Rescale[tab[[All, 3]]]; GeoGraphics[Table[{GeoStyling[Opacity[0.99], RGBColor[scaled[[k]], 1 - scaled[[k]], 0]], GeoDisk[{tab[[k, 2]], tab[[k, 1]]}, Quantity[20, "Kilometers"] ]}, {k,1, Length[tab]}]] which gives: ![enter image description here][9] The second representation is calculated using GeoRegionValuePlot[GeoPosition[{#[[2]], #[[1]]}] -> #[[3]] & /@ tab, PlotRange -> {0, 30}, ColorFunction -> "TemperatureMap", ImageSize -> Full] which looks like this ![enter image description here][10] Finally, the lengthy sequence of commands surface = Interpolation[{{#[[1]], #[[2]]}, #[[3]]} & /@ tab, InterpolationOrder -> 1]; cPlot = Quiet[ContourPlot[surface[x, y], {x, Min[tab[[All, 1]]], Max[tab[[All, 1]]]}, {y, Min[tab[[All, 2]]], Max[tab[[All, 2]]]}, ImagePadding -> None, ClippingStyle -> None, Frame -> None, Contours -> 60, ContourLines -> False, PlotRange -> {0, 30}, ColorFunction -> "TemperatureMap"]]; multipoly = Polygon[GeoPosition[Join @@ (EntityValue[EntityClass["Country", "Europe"], "Polygon"] /. Polygon[GeoPosition[x_]] :> x)]]; GeoGraphics[{GeoStyling[{"GeoImage", cPlot}], multipoly, Black, Opacity[1]}, ImageSize -> Full] gives this representation ![enter image description here][11] I am quite sure that with some modifications one can make a useful program out of this if one uses cloud deploy. Also, netatmo's data are updated every 30 minutes (every 5 minutes on the individual devices), so one can run a scheduled task and look at the development of the temperature. The large number of netatmo weather stations complements the data available from the Wolfram Data servers very nicely as they provide very up to date street level data. I would be glad to see a good idea of a cloud deployed service based on this or any other ideas that you might have. Cheers, Marco [1]: http://community.wolfram.com/web/bschelter [2]: https://www.netatmo.com/en-US/product/weather-station [3]: /c/portal/getImageAttachment?filename=ScreenShot2014-09-15at22.55.05.png&userId=48754 [4]: http://devices.wolfram.com/devices/netatmo-weather-station.html [5]: https://www.netatmo.com/weathermap [6]: /c/portal/getImageAttachment?filename=ScreenShot2014-09-15at22.59.02.png&userId=48754 [7]: /c/portal/getImageAttachment?filename=ScreenShot2014-09-15at22.59.37.png&userId=48754 [8]: https://dev.netatmo.com [9]: /c/portal/getImageAttachment?filename=netatmofig1.gif&userId=48754 [10]: /c/portal/getImageAttachment?filename=Netatmofig2.gif&userId=48754 [11]: /c/portal/getImageAttachment?filename=Netatmofig3.gif&userId=48754 Marco Thiel 2014-09-15T22:35:11Z https://community.wolfram.com/groups/-/m/t/203498 I have written a palette and a package to help input properly typeset units.  The palette and package allow for quick input of units in Mathematica, avoiding the clunky units-discovery approach involving Wolfram Alpha queries. As an example, the expression below can be inputted quickly using the palette or by using the input aliases that are loaded by the package.[center][img=width: 206px; height: 89px;]/c/portal/getImageAttachment?filename=InputExample.jpg&userId=23384[/img][/center]The link to a page for downloads is: [url=http://www.blinn.edu/brazos/natscience/phys/thonan/Mathematica/]http://www.blinn.edu/brazos/natscience/phys/thonan/Mathematica/[/url] . Terrence Honan 2014-02-20T02:03:07Z https://community.wolfram.com/groups/-/m/t/293403 TL;DR --- I have three issues with getting sun positions in Mathematica V10: - It is extremely slow compared to V9 - It doesn't *seem* to yield correct results - a) It needs an Internet connection, which b) is not assured to always return results and c) if not used optimally can easily consume your monthly allowance of W|A calls Long story === With the advent of V10 `AstronomicalData` has been deprecated, as shown on its documentation page: ![enter image description here][1]. I'm not an astronomer, so my main use of this function has been restricted to its capability to get the sun position using functions calls like this: { AstronomicalData["Sun", {"Azimuth", {2013, 3, 1, #, 0, 0}, {52.37`, 4.89`}}, TimeZone -> 1], AstronomicalData["Sun", {"Altitude", {2013, 3, 1, #, 0, 0}, {52.37`, 4.89`}}, TimeZone -> 1] } & /@ Range[0, 23] > {{341.47732, -43.93930}, {2.33417, -45.21747}, {22.94232, -43.19133}, > {41.52167, -38.28400}, {57.55208, -31.30276}, {71.47253, -23.03159}, > {84.02194, -14.08294}, {95.91940, -4.92723}, {107.80166, 4.03418}, {120.23770, 12.40167}, {133.72303, 19.72563}, {148.59433, > 25.48377}, {164.84179, 29.12209}, {181.93103, 30.19428}, {198.91284, > 28.55117}, {214.89602, 24.41962}, {229.46400, > 18.28613}, {242.70064, 10.70703}, {254.98998, > 2.19073}, {266.84760, -6.82566}, {278.85594, -15.94505}, {291.66723, -24.75464}, {306.00911, -32.75641}, {322.57956, > -39.29877}} So, this gets me the sun positions in steps of an hour during a particular day in Amsterdam (TZ 1). The same call still works in V10, though it now returns numbers with units; degrees in this case. On its first call, it reads some paclet information from a Wolfram server, but on any successive call no Internet connection is needed. I will be going into detail about timing further on, but I'll say here that the V10 function takes about three times longer than its V9 namesake. I blame the addition of units for that. With `AstronomicalData` apparently deprecated we are supposed to use its successors. In this case I need `SunPosition`. A direct translation of the above would be: SunPosition[GeoPosition[{52.37`, 4.89`}], DateObject[{2013, 3, 1, #, 0, 0}, TimeZone -> 1]] & /@ Range[0, 23] > {{95.7, -5.1}, {107.6, 3.9}, {120.0, 12.3}, {133.5, 19.6}, {148.3, 25.4}, {164.5, 29.1}, {181.6, 30.2}, {198.6, 28.6}, {214.6, 24.5}, {229.2, 18.4}, {242.5, 10.9}, {254.8, 2.4}, {266.6, -6.7}, {278.6, -15.8}, {291.4, -24.6}, {305.7, -32.6}, {322.2, -39.2}, {341.3, -43.5}, {2.0, -44.8}, {22.5, -42.9}, {41.1, -38.0}, {57.1, -31.1}, {71.0, -22.9}, {83.6, -13.9}} As with the new `AstronomicalData` the output is actually in degrees which I have removed in the above output for the sake of clarity. There are a few things to note: - `SunPosition` uses position and date objects, the latter being new in V10 - `SunPosition` does not have a `TimeZone` option, but you can set it in `DateObject` - `SunPosition` can use the old lat/long list position indication. It also can use a date list to enter the date instead of a `DateObject`. In the latter case you are out of options with respect to time zones and you have to add the appropriate amount of time offset - It is extremely slow, and it may even time-out: ![enter image description here][2] - Last but not least: the results seem to be plain wrong. It suggests that sunrise is somewhat before 1 am, which is -of course- incorrect. I assume that this has something to do with a `$GeoLocation` setting for the observer of the sun positions, but I haven't managed to sort out what I am supposed to enter to get the correct sun positions for the location provided in the same call. As to timing: I noticed very inconsistent timings for `SunPosition` compared to `AstronomicalData`, so I used the following code to collect a somewhat more statistical sound sample: SetAttributes[timingTest, HoldFirst]; timingTest[code_, repeats_Integer] := Table[ ClearSystemCache[]; code // AbsoluteTiming // First, {repeats} ] Using this, I collected timing of 20 calls to the following code snippets: - `AstronomicalData` V9 and V10: As above - `SunPosition`: As above - `SunPosition` without `GeoPosition`, just the lat/long list. - `SunPosition` without `GeoPosition`, and also without the `DateObject` date, just a classical date list (with the hour set to +1 to accommodate TZ 1) - `SunPosition` V10 without `GeoPosition` and with the `Map` (`/@`) gone and replaced by a `DateRange` inside the call. In the last case, the returned value is a `TimeSeries` object from which I extract the positions using the `"Paths"` method: SunPosition[{52.37`, 4.89`}, DateRange[{2013, 3, 1, 1, 0, 0}, {2013, 3, 1, 24, 0, 0}, "Hour"]]["Paths"][[1, All, 2]] The results were as follows: ![enter image description here][3] Clearly, the `SunPosition` results are very disappointing. Getting the sun positions with `SunPosition` is almost 40 times slower than using the old V9 method (which, I should add, wasn't particularly quick either. I have an implementation in Mathematica code which is faster). The V10 implementation of `AstronomicalData` is also more than three times slower than the V9 version. The `DateRange` version of the call saves a lot of communication overhead. Still, it is almost *five times slower* than in V9. The cause of all this slowness is that `SunPosition` simply does a call to Wolfram|Alpha. Sniffing the communication one sees the following string passed to the server: "1:eJxTTMoPSuNgYGAoZgESPpnFJcHcQEZwaV5AfnFmSWZ+XhoTsmxR/6GvGjH9wg4Qhr6XQxobsnzmXXYGhkxmIC+TEUSIgwggZihigIJgoAIGj/yizKr8PJigA5yBZtubwB1yrdxeDkXVIuvcH1aJOBRzAqUcS0vycxNLMpMBSAArww==" which can be turned into readable form using `Uncompress`: {"SunPosition", {4.89, 52.37}, {2013, 3, 1, 23, 0, 0.}, "Horizon", 2., 2., {52.09, 5.12}, Automatic} Here, we can recognize the lat/long of the position I used (but with lat/long reversed - Is this somehow significant?). At the end is my own `$GeoLocation`, but I don't believe it is used at all (and it shouldn't: I'm asking for the sun position over Amsterdam, not where I live). Changing it with `Block` I get the same results: Block[{$GeoLocation = GeoPosition[{52.37`, 40.89`}]}, SunPosition[{52.37`, 4.89`}, {2013, 3, 1, 1, 0, 0}]] Apart from the slowness, there's the issue of the necessary Internet connectivity (Want to give a demonstration and you don't have Internet? Sorry, you're out of luck). And what of the use of W|A calls? Each of the `SunPosition` tests (except the last one) took me 20 * 24 = 480 calls. So this part of my testing only already took 1440 calls, and one should be reminded that a typical Home Use license allows for only 3,000 calls per month. Things like this can go pretty fast. In fact, I once wrote an application that calculates the impact of building changes on shadows around your house throughout the year. It does in the order of 17,000 `AstronomicalData` calls. I couldn't implement that naively using `SunPosition` and have it actually work. Clearly, one should now use the `DateRange` version of the call as much as possible. ---------- To wrap up: I have one real question, i.e., how to get `SunPosition` to return the same values as `AstronomicalData`, and a request to the WRI team: please put `SunPosition` in the kernel and don't use W|A calls, because the situation as it is now is rather annoying and IMHO a real step backwards. [1]: /c/portal/getImageAttachment?filename=AstronomicalData.png&userId=43903 [2]: /c/portal/getImageAttachment?filename=timeout.png&userId=43903 [3]: /c/portal/getImageAttachment?filename=results.png&userId=43903 Sjoerd de Vries 2014-07-13T16:39:48Z https://community.wolfram.com/groups/-/m/t/553861 Yesterday [IFTTT][1] (IF This Then That) released the [Wolfram Data Drop Channel][2]. This is a BIG step forward in making the data from the Internet of Things computable. Currently there are more than [150 trigger channels][3] that can be connected to [Data Drop][4]. Let's take a look at one of those channels: [Numerous][5]. In this post I'll show you how to get a Numerous recipe running in a few simple steps. - Sign in to [https://ifttt.com][6]. Go to My Recipes. Click "Create Recipe" ![Click Create Recipe][7] - Step 1: Select the Numerous Trigger Channel ![Choose Trigger][8] - Step 2: Select the trigger that fires every time a number changes by any amount ![chooseType][9] - Step 3: Select the number that you want to track, elevation in my case ![Select number][10] - Step 4: Select Wolfram Data Drop as Your Action Channel ![then action][11] ![data drop channel][12] - Step 5: Select "Add entry" Action ![add entry][13] - Step 6: Complete Action Fields ![action fields][14] Use the Wolfram Language function [CreateDatabin][15] to provide a name, and to specify that we want the values of the entries to be interpreted as a physical quantities (feet in this case). bin = CreateDatabin[<|"Name" -> "My Elevation"|>, "Interpretation" -> {"elevation" ->Restricted["StructuredQuantity","Feet"]}]; bin["ShortID"] **"6F9_LE8T"** - Copy-paste this ID - Write *elevation=* and select the ingredient **FormattedValue**. ![ingredient][17] elevation={{FormattedValue}} - Step 7: Create and Connect ![create][18] Voilà! ====== ![Numerous recipe][19] Now you can take an insight of the elevation measurements with [Wolfram|Alpha][20] by entering *Data drop* along with your databin's *ID*. **Data drop 6F9_LE8T** in my case. ![WA][21] Or you can access this data directly from the Wolfram Language: DateListPlot[Databin["6F9_LE8T"], Filling -> Bottom, FillingStyle -> LightBrown] ![WLelevation][22] Please, feel free to share your own recipes below. Enjoy! [1]: https://ifttt.com/wtf [2]: https://ifttt.com/wolfram_data_drop [3]: https://ifttt.com/channels [4]: https://datadrop.wolframcloud.com/ [5]: https://ifttt.com/numerous [6]: https://ifttt.com [7]: /c/portal/getImageAttachment?filename=createRecipe.png&userId=56204 [8]: /c/portal/getImageAttachment?filename=1.png&userId=56204 [9]: /c/portal/getImageAttachment?filename=2v.png&userId=56204 [10]: /c/portal/getImageAttachment?filename=2.png&userId=56204 [11]: /c/portal/getImageAttachment?filename=3.png&userId=56204 [12]: /c/portal/getImageAttachment?filename=3v.png&userId=56204 [13]: /c/portal/getImageAttachment?filename=4.png&userId=56204 [14]: /c/portal/getImageAttachment?filename=6v1.png&userId=56204 [15]: https://reference.wolfram.com/language/ref/CreateDatabin.html [16]: /c/portal/getImageAttachment?filename=6v4.png&userId=56204 [17]: /c/portal/getImageAttachment?filename=6v5.png&userId=56204 [18]: /c/portal/getImageAttachment?filename=7.png&userId=56204 [19]: /c/portal/getImageAttachment?filename=recipe.png&userId=56204 [20]: https://www.wolframalpha.com/input/?i=Data+drop+6F9_LE8T [21]: /c/portal/getImageAttachment?filename=WAelev.png&userId=56204 [22]: /c/portal/getImageAttachment?filename=WLelevation.png&userId=56204 Bernat Espigulé 2015-08-26T16:55:04Z https://community.wolfram.com/groups/-/m/t/775253 If I for instance change rectangular to polar coordinate it comes out like this: ToPolarCoordinates[{15, 20}] {25, ArcTan[4/3]} Can anyone tell me how to get this in degrees? So far I've tried this, which is described in the documentation under "Radian" Convert[n Radian,newunits] converts n Radian to a form involving units newunits.: Convert[ArcTan[4/3] Radian, Degree] Convert[ArcTan[4/3], °] Thanks! Benny Bomstærk 2016-01-18T22:34:52Z https://community.wolfram.com/groups/-/m/t/844216 Hello, I have a basic question which I cannot find the answer to: How do I make Mathematica convert 1040 seconds into 17 minutes and 20 seconds? I want Mathematica to give me the conversion with one command or cell input. I would also like for the output to have the words "minutes" and "seconds" if possible. Thanks. Dan M 2016-04-22T10:07:25Z https://community.wolfram.com/groups/-/m/t/745753 I'm a new user of MMA ver. 10.3.0 Home Edition. I'm trying to learn how to use Units, but it's not working. For example In[47]:= UnitConvert[Quantity[12, "Meters"/"Seconds"], "Miles"/"Hours"] Out[47]= UnitConvert[ QuantityUnits`Private`ToQuantity[ QuantityUnits`Private`UnknownQuantity[12, ("Meters")/( "Seconds")]], ("Miles")/("Hours")] If I load the Units` package I get the answer I seek: In[48]:= << Units` Convert[12 Meter/Second, Mile/Hour] Out[49]= (37500 Mile)/(1397 Hour) But starting with ver 9 I shouldn't have had to do that. Any ideas about what's going on? Victor Bloomfield 2015-11-27T05:01:46Z https://community.wolfram.com/groups/-/m/t/1747298 I'm using Mathematica to teach a Physics course (Theoretical Mechanics) this fall, and am having lots of trouble with units (Quantity...). My most recent issue is this: Mathematica doesn't seem to recognize that Radians are a dimensionless unit. So if I type: QuantityMagnitude[5, "Radians"] I get the error message: Quantity::compat: DimensionlessUnit and Radians are incompatible units You might wonder why I would like to do something like this anyway. The issue is that NDSolve doesn't seem to work with Quantities, so I need to strip units off of everything before running it through there. But if I have an angle, I don't know if it is in Degrees, Radians or without any specific angular unit which means the dimensionless angular unit of Radians if coming out of some calculation like \[Phi] = \[Sqrt](k/m) t Is there some way for me to tell Mathematica that Radians are compatible with DimensionlessUnit? Or do I need to write some wrapper that checks if compatible and if not then don't try to convert? Thanks, Eric Eric Hudson 2019-07-29T14:14:35Z https://community.wolfram.com/groups/-/m/t/1899870 *MODERATOR NOTE: coronavirus resources & updates:* https://wolfr.am/coronavirus ---------- ![enter image description here][1] ![enter image description here][2] ![enter image description here][3] There are many much more sophisticated models out there using the COVID-19 data but i wanted a simple overview of the data to monitor the progression of the countries and do some comparisons. . Therefore i made a simple plot interface of the Infected and deaths of the countries which can be plotted linear and logarithmic. i chose to align all the data to day 0 which is defined as the first day of >100 confirmed infected cases in a country. This makes comparison of countries in their early stage to more affected countries more intuitive. To fill my own curiosity i have added sigmoidal fits to data to see the "prediction", which only becomes reliable once a tipping point in controlling the disease is reached. I also calculate the mortality of the confirmed cases. I have chosen to only include the first 20 most affected countries but changing the included countries is easy. The interface allows to turn on and off countries to make comparisons. Hope its also useful to others. &[Wolfram Notebook][4] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=COVID-3.PNG&userId=1332602 [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=COVID-2.PNG&userId=1332602 [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=COVID-1.PNG&userId=1332602 [4]: https://www.wolframcloud.com/obj/be9243ef-6580-442f-9fbf-764b515d577e Martijn Froeling 2020-03-17T14:00:10Z https://community.wolfram.com/groups/-/m/t/1862464 ###Introduction### Recently, I was learning about infinite space filling curves and their applications in real life. I became fascinated with [Hilbert Curves][1], one of many [plane-filling functions][2]. I wanted to see how these shapes could be used in image to video conversion. To begin with, I explored how pseudo Hilbert Curves could be used to convert a square image to audio so that each pixel color was associated with a specific sound. Theoretically, a person would be able to learn this association and would be able to reconstruct a mental image by listening to audio. This could help with people who are visually impaired, letting blind people "hear" pictures. The reverse is also true. People who are deaf will be able to "see" sound. I thought I could implement this using Mathematica, which I learned last summer at the Wolfram High School Camp. ###Why Hilbert Curves### ![Pseudo-Hilbert Curves from Order 1 to 10][3] As you can see above, as you increase the order, the limit of these curves start to fill an infinite amount of space. A true Hilbert Curve is actually $\lim_{n\to\infty} PseudoHilbertCurve_n$. Each one of these curves can be used on an image of dimensions 2 by 2, 4 by 4, 8 by 8, etc. The curve needed is accordingly: HilbertCurve[Log[2, ImageDimensions[image]]] Each line in the curve will go over one pixel in the image, starting at the bottom left and ending at the bottom right. ![Example of Order 3 Pseudo Hilbert Curve][4] But why would you need to use this specific pattern, as supposed to something more simple? Here: https://youtu.be/3s7h2MHQtxc?t=355. In short, if you were to increase the resolution of your image, you would now have to retrain your brain to re-associate the pixel value and the associated frequency at that point on the image. But this is not the case on a Hilbert Curve. As you increase the resolution of your image, and thus the order pseudo-Hilbert Curve, a point will just move closer and closer to its limit in the same space, which solves our problem. ###Converting Color to Sound### This was the main hurdle when writing the program. I needed to convert each pixel value to a unique sound frequency. My initial thought was to just create an association between each wavelength in the visible electromagnetic spectrum and a frequency, but I was quick to learn that doesn't work in the digital world. RGB colors could be a combination of different wavelengths. And I couldn't just add these wavelengths separately because there could be overlap. There was also brightness and darkness which isn't part of the light spectrum. So instead of the RGB format, I decided to use the HSB format (hue, saturation, and brightness). This is also more compatible for human learning, as the human eye uses these three characteristics to determine color, as supposed to the RGB values on a computer image. ![Graphics3D Visualizer of HSB][5] As you can see from the image, Hue could be used to determine the color. Now, instead of RGB with three values to one color, Hue gave me one number to a specific color. ![Graphics Hue Color Chart][6] But I still needed to show saturation and brightness in my sound waves. Color in a computer is expressed in three dimensions while sound has two: amplitude and frequency. I would be leaving one color property out. I could think of multiple ways to express all three as sound waves, but none of them made sure that similar colors sounded the same. For example, if I had a hue playing a certain frequency, I could define a range around this point that could express either saturation or brightness using a plus/minus system. To solve this, I decided to use [AudioChannel][7] functions. This way, one channel could express the hue through a specific frequency, while the other channel could express the saturation and brightness combined through volume and frequency respectively. This way, colors that were similar would sound similar too. ###Creating the Function### Obviously, I needed to get real images. I used *image1*, where the pixels were easily noticeable, and my baby picture for the school yearbook as *image2*, as a test image. The first one, being resized to a 8 by 8 image, would utilize an order 3 pseudo-Hilbert Curve ($\log _{2}8=3$), and the second one, being resized to a 32 by 32 image, would utilize an order 5 pseudo-Hilbert Curve ($\log _{2}32=5$). ![The images I used to test the program.][8] To get the HSB values, I used Wolfram's in-built [Hilbert Curve][9] and [Pixel Value][10] functions. I used Pixel Value to read the image's pixel values as bytes, which was converted to RGB and then to HSB. To get the points on the Hilbert Curve that was associated with their respective position on the image, I added {1,1} to each point so that it matched the pixel space (the origin on a Cartesian Plane is designated as (1,1) on an image). getHSB[image_] := ColorConvert[ RGBColor /@ Divide[PixelValue[ image, ({1, 1} + #) & /@ HilbertCurve[Log[2, ImageDimensions[image][[1]]]][[1]], "Byte"], 255.], "HSB"] In the Wolfram Language, HSB values range from 0 to 1 instead of the normal 0 to 360 which I guess gives the user more control of the specific color they want to implement. I had to scale these values to the frequency range I wanted for the hue and brightness. Through trial and error, I decided that 100-3900 Hz was a good range so that people of all ages could hear the lowest and highest frequencies. For the amplitude dictated by the saturation, I could just use the direct value as [SoundVolume][11]. I made it so that the sound for each pixel had a duration of 0.1 seconds for demonstrative purposes. In the real world, I would think that this should be a lot smaller so that images don't take too long to hear. getHSB[image_] := ColorConvert[ RGBColor /@ Divide[PixelValue[ image, ({1, 1} + #) & /@ HilbertCurve[Log[2, ImageDimensions[image][[1]]]][[1]], "Byte"], 255.], "HSB"] hueToFrequencyMatch[HSB_] := Rescale[HSB[[1]], {0, 1}, {100, 3900}] saturationToAmplitudeMatch[HSB_] := HSB[[2]] brightnessToFrequencyMatch[HSB_] := Rescale[HSB[[3]], {0, 1}, {100, 3900}] soundFrequency[frequency_] := Sound[Play[Sin[frequency*2 Pi t], {t, 0, 0.1}]] soundFrequencyVolume[frequency_, ampSaturation_] := Sound[soundFrequency[frequency], SoundVolume -> ampSaturation] After this, I just had to apply these functions over the HSB values of each pixel in the order dictated by the appropriate pseudo-Hilbert Curve, and then merge the hue sound and saturation+brightness sound as separate audio channels. convertHToSound[image_] := soundFrequency /@ hueToFrequencyMatch /@ getHSB[image] // AudioJoin convertBSToSound[picture_] := (soundList = {}; n = 1; While[n <= Length@getHSB[picture], AppendTo[soundList, soundFrequencyVolume[ getHSB[picture][[n]] // brightnessToFrequencyMatch, getHSB[picture][[n]] // saturationToAmplitudeMatch]]; n++]) convertHSBToSound[audio1_, audio2_] := AudioChannelCombine[{audio1, audio2}] Because hue is the most important color characteristic, I wanted to emphasize this AudioChannel more. Thus, editChannel2[audio_, factor_] := AudioPan[audio, -factor] To put everything together, I made a separate function to organize the results. seperateTable[picture_] := (convertBSToSound[picture]; Module[{a = convertHToSound[picture], b = soundList // AudioJoin}, c = editChannel2[convertHSBToSound[a, b], 0.05]; table = Grid[{{Image[picture, ImageSize -> 100], a, b, c}, {Blank[], AudioPlot@a, AudioPlot@b, AudioPlot@c}}]; ReplacePart[table, 1 -> Prepend[ First[table], {"Image", "Hue", "Saturation+Brightness", "HSB"}]]]) These were my results. I will attach the *hsb1* and *hsb2* sound files to this post, along with my notebook. ![Final image to sound representation.][12] Because they use two channels, you should use earbuds or headphones so that you can clearly differentiate the sounds coming through your left and right ears. ![Spectrogram of *hsb1* and *hsb2*][13] ###Visualizing the Process### animate[image_, audio_] := Module[{list = ({1, 1} + #) & /@ HilbertCurve[Log[2, ImageDimensions[image][[1]]]][[1]]}, (AudioPlay@audio; Animate[ ReplacePixelValue[Image[image, ImageSize -> 100], list[[1 ;; index]] -> Orange], {index, 1, list // Length, 1}, DefaultDuration -> QuantityMagnitude[ UnitConvert[Quantity[audio // Duration, "Seconds"]]], AnimationRepetitions -> 1])] I used this to create the following two animations. If you ran these programs, the HSB sound would play alongside the animation, showing exactly which pixel correlates to each sound. Unfortunately, I couldn't play the audio here on the post, but it is in the attached notebook if you would like to see. Here is what it looks like: ![*hsb1* Conversion][14] ![*hsb2* Conversion][15] ###Future Work### In the future, I hope to create a machine learning algorithm that can learn this association between audio and image in reverse (recreate the image from audio). If anyone has any ideas or pointers for me, please share in the comments below - I would really appreciate it! ##Updated Information:## Presented work at the [New Hampshire Science & Engineering Expo][16] and won the Office of Naval Research award. Youtube Link: [Video Presentation][17] [1]: http://mathworld.wolfram.com/HilbertCurve.html [2]: http://mathworld.wolfram.com/Plane-FillingFunction.html [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2020-01-19at12.07.19PM.png&userId=1725131 [4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=example.gif&userId=1725131 [5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=HSB.png&userId=1725131 [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Hue.png&userId=1725131 [7]: https://reference.wolfram.com/language/ref/AudioChannels.html [8]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2020-01-19at1.39.00PM.png&userId=1725131 [9]: https://reference.wolfram.com/language/ref/HilbertCurve.html [10]: https://reference.wolfram.com/language/ref/PixelValue.html [11]: https://reference.wolfram.com/language/ref/SoundVolume.html [12]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2020-01-19at2.23.47PM.png&userId=1725131 [13]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2020-01-19at2.32.49PM.png&userId=1725131 [14]: https://community.wolfram.com//c/portal/getImageAttachment?filename=animation1.gif&userId=1725131 [15]: https://community.wolfram.com//c/portal/getImageAttachment?filename=animation2.gif&userId=1725131 [16]: https://nhsee.org/ [17]: https://youtu.be/gwpK2KIfVmA Srinath Rangan 2020-01-19T19:42:34Z https://community.wolfram.com/groups/-/m/t/2134507 I am trying to update 100k lines of Mathematica I wrote 15-20 years ago in Version 4. I am struggling with getting Quantity, Solve/NSolve and Integrate to correctly deal with units. Solve/NSolve always return the correct numerical values, but the "Units" are quite often lost. I can not figure out why. But it seems related to the Integrate function and places where variable definitions first appear in the code as arguments to the Quantity function. The Plus function may also be failing. Also of note, is how "unit-less" variable name definitions seem the direct cause of the errors produced by the Integrate function. And perhaps at the root of my programming dilemma is the way multiplying a scalar Quantity by zero wrongly preserves Units. In V4: 200 kg times 0 equals 0 In V12 200 kg times 0 equals 0 kg This bug/feature, breaks simple vector calculus computations in countless ways. See the detailed examples given far below in this thread, where V12's forcing of units on values of zero magnitude causes simple exercises in Newtonian Mechanics to "blow up". Any help would be appreciated. See attached notebook for examples of this behavior. JPEG attached for easy demonstration of typesetting. Code is in the attached notebook. \!\(\*OverscriptBox[\(a\), \(\[RightVector]\)]\) = {Quantity[0, ( "Meters")/("Seconds")^2], Quantity[0, ("Meters")/("Seconds")^2]}; ![Solve not returning Units][1] ![NSolve working almost correctly][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=SolvenotreturningUnits.JPG&userId=2125101 [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ExampleofNSolveworkingcorrectlywithQuantify.JPG&userId=2125101 Francis Bush 2020-12-10T00:20:52Z https://community.wolfram.com/groups/-/m/t/1260622 Hi all, I have a list of Rad angles {-1.69347, 1.70849, 0.181325, -1.69539, 1.73843, 0.357308, etc} and I want to convert it to 0 360 Degree. Can anyone help? If I just {-1.69347, 1.70849, 0.181325, -1.69539, 1.73843, 0.357308} / Degree, it will become {-97.029, 97.8892, 10.3892, -97.1386, 99.6046, 20.4723}. I want to add only those negative angles in the list by 360 Degree. Thanks Thong Ly 2018-01-06T15:45:56Z https://community.wolfram.com/groups/-/m/t/3389913 ![Is asteroid 2024 YR4 going to hit Earth in 2032? Numeric n-body simulation, NASA data, gravitational interactions, astronomical data.][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=fin_astero-ezgif.com-optimize.gif&userId=20103 [2]: https://www.wolframcloud.com/obj/6ec5ebb8-fdbb-4705-b942-8514e3e827ec Jeffrey Bryant 2025-02-09T07:38:44Z https://community.wolfram.com/groups/-/m/t/133220 I need to generate a pdf image file that is dimensionally accurate for print-out into a hard copy. In addition, I need to accurately specify of the margins around the printed image. Here is an simple test example of a possible solution (that does not seem to work correctly): [mcode] SetDirectory[NotebookDirectory[]]; {xsize,ysize} = {7,9}; (*scale is in inches*) {{left,right},{bottom,top}} = {{1/4.,8.5-xsize-1/4.},{1/2.,11-ysize-1/2.}}; (*scale is in inches*) Export["TestPDFNotebook.pdf", Rasterize[Graphics[Line[72*{{0,0},{0,ysize},{xsize,ysize},{xsize,0},{0,0}}]], ImageSize->{xsize,ysize}*72], ImageSize->{xsize,ysize}*72, ImageMargins->Floor[72.*{{left,right},{bottom,top}}]] (*scale is now in printer points*) [/mcode] Note that here I am using Export to generate a pdf file of a bitmapped image that is created with Rasterize. In addition, I am using the ImageSize option to specify the intended image size during printout. I am also using the ImageMargins options to specify margin widths. Both ImageSize and ImageMargins have units of printer points (72 pnts/inch). The intended paper size is 8.5 x 11 inches. The intended image size in this example is 7 inches x 9 inches. Unfortunately the image dimensions are completely lost during printout. Why is this happening? and more importantly, how to fix it? Donald Barnhart 2013-10-01T20:58:24Z https://community.wolfram.com/groups/-/m/t/292343 Like many engineers my calculations have to be readable to others that do not use Mathematica. There are standard ways of representing variables and units which make the calculations readable and give a certain familarity which helps to spot errors etc. There are two particular items that give trouble in trying to achieve this. With units I have been able to create my own abbreviated unit definitions e.g.. kN for kiloNewton and m for metres. However, UnitConvert insists on converting to its own form rather than the form I want e.g.. m N rather than kNm. Is there away to force it to give you the units you want? This used to work well in "Automatic Units" but "Automatic Units" does not seem to work with v.10. The second problem is subscripts. I need a very large number of symbols that have subscripts. It is convenient to use the Symbolize function to produce these when needed. However, I then run into trouble when I want to use subscripts as indices of lists. Is there any way over this? I have attached a notebook which explains what I want with a couple of trivial examples as I do not seem to be able to post nicely formatted Mathematica code in here when it contains subscripts etc. Malcolm Woodruff 2014-07-12T13:24:05Z https://community.wolfram.com/groups/-/m/t/430038 Hello everyone, I have questions regarding properties stored inside Mathematica. I am a master student researching on heat transfer. As I found out that Mathematica itself have data related to the thermodynamic data for the materials, for example, steel, aluminium, water, ammonia and others. I would like to use the data for my calculations. But the problem is that, the properties are dependant on the temperatures of the material itself (though, for heat conductivity, does not change much in the range of 300 K to 400 K). Now how do I extract data for the properties for different temperature? For example, thermal conductivity for aluminium for the range of 100 K to 1000 K. What I have learned is how to find the properties of Air, for room temperature? ThermodynamicData["Air", "ThermalConductivity"] Thank you very much for your help. Thai Kee Gan 2015-01-28T04:13:41Z https://community.wolfram.com/groups/-/m/t/1135312 In this project we measure the energy produced by a solar Heater; we use a microcontroller, three temperature sensors and a flow sensor. The microcontroller made the calculations for the energy integration and the calculation of volume of water consumed. We send this data to datadrop, for its manipulation and visualization. datos2 = Dataset[Databin["mCC3DAXt"]]; data = datos2[ All, {"tempTank" -> N[Quantity[#tempTank/10, "DegreesCelsius"]] &, "tempIn" -> N[Quantity[#tempIn/10, "DegreesCelsius"]] &, "tempOut" -> N[Quantity[#tempOut/10, "DegreesCelsius"]] &, "ms" -> Identity[#ms] &, "Volume" -> N[Quantity[#Volume/100, "liters"]] &, "Energy" -> N[Quantity[#Energy/100, "Kilojoules"]] &, "id" -> Identity[#id] &, "Timestamp" -> Identity[#Timestamp] &}][ All, Association]; dataSort = data[Reverse, Reverse] We totalize variables such as energy and volume of water consumed during the life of the Arduino. So we initialize all the variables we need to show on the sketch. fVol[n_] := n/100 ftemp[n_] := n/10 fCel[n_] := N[Quantity[n, "DegreesCelsius"]] fVol1[n_] := N[Quantity[n, "Liters"]] fEngy[n_] := N[Quantity[n, "Kilojoules"]] datos3 = datos2[All, { "tempTank" -> ftemp, "tempIn" -> ftemp, "tempOut" -> ftemp, "Volume" -> fVol, "Energy" -> fVol } ] datos4 = datos3[All, { "tempTank" -> fCel, "tempIn" -> fCel, "tempOut" -> fCel, "Volume" -> fVol1, "Energy" -> fEngy } ] es = TimeSeries[Databin["mCC3DAXt"]]; time = DateObject /@ Flatten[es[[1]][[2, 2]]]; en1 = fVol /@ Flatten[es[[1]][[2, 1]]]; en2 = fEngy /@ en1; tsEngy = TimeSeries[en2, {time}]; vol1 = fVol /@ Flatten[es[[7]][[2, 1]]]; vol2 = fVol1 /@ vol1; tsVol = TimeSeries[vol2, {time}]; temptank = ftemp /@ Flatten[es[[6]][[2, 1]]]; temptank1 = fCel /@ temptank; tstempTank = TimeSeries[temptank1, {time}]; tempIn = ftemp /@ Flatten[es[[4]][[2, 1]]]; tempIn1 = fCel /@ tempIn; tstempIn = TimeSeries[tempIn1, {time}]; tempOut = ftemp /@ Flatten[es[[5]][[2, 1]]]; tempOut1 = fCel /@ tempOut; tstempOut = TimeSeries[tempOut1, {time}]; totalVolume1 = Total[vol2]; totalEnergy1 = Total[en2]; Including the starting time of data and the end time. lastday = DateList[ Last[Flatten[tstempTank[[2, 2]]]]][[3]] firstday = DateList[ First[Flatten[tstempTank[[2, 2]]]]][[3]]; firstmonth = DateList[ First[Flatten[tstempTank[[2, 2]]]]][[2]]; lastmonth = DateList[ Last[Flatten[tstempTank[[2, 2]]]]][[2]]; dates = tstempTank["Dates"]; So at the end we can visualize the data on a dice Interface. Manipulate[ DynamicModule[{firstPage, stadistics}, firstPage = Show[GraphicsGrid[{ {AngularGauge[totalVolume1, {0, 3000}, ScaleOrigin -> {6 Pi/5, -Pi/5}, PlotTheme -> "Business", GaugeLabels -> "Value", PlotLabel -> "Volume L", ImageSize -> 300], Animate[ Graphics3D[{Red, Rotate[First@PolyhedronData["Spikey"], p*2 \[Pi], {1, 1, 1}]}, Boxed -> False, AspectRatio -> 1, ImageSize -> Medium], {p, 0, Infinity}, Paneled -> False, AnimationRunning -> False ] , Row@{ThermometerGauge[Last[tempIn1], {0, 120}, PlotLabel -> "Temperature In", TargetUnits -> "Celsius", GaugeLabels -> Full, PlotTheme -> "Marketing", ImageSize -> {100, 300}], ThermometerGauge[Last[tempOut1], {0, 120}, PlotLabel -> "Temperature Out", TargetUnits -> "Celsius", GaugeLabels -> Full, PlotTheme -> "Marketing", ImageSize -> {100, 300}]}}, {AngularGauge[totalEnergy1, {0, 5000}, ScaleOrigin -> {6 Pi/5, -Pi/5}, PlotTheme -> "Business", GaugeLabels -> "Value", PlotLabel -> "Energy kJ", ImageSize -> 300], SpanFromAbove, ThermometerGauge[Last[temptank1], {0, 120}, PlotLabel -> "Tank Temperature", TargetUnits -> "Celsius", GaugeLabels -> Full, PlotTheme -> "Marketing", ImageSize -> {200, 300}]}} , Frame -> False, Alignment -> Center, Background -> Transparent, BaseStyle -> {FontColor -> GrayLevel[0.6], FontFamily -> "Times", 30} ]]; stadistics = Show[GraphicsGrid[{{relojes, SpanFromLeft, SpanFromLeft}, {With[{dataAssoc = GroupBy[dates, #["Month"] &]}, Manipulate[Manipulate[ DateListPlot[ TimeSeriesWindow[tsEngy, DateObject[{2017, month, day}, "Day"]], PlotTheme -> "Web", Joined -> False, Filling -> Axis, ImageSize -> 200, PlotRange -> All, PlotLabel -> DateObject[{2017, month, day}, "Day"] ], Style["Energy Produced", 25, Bold, FontFamily -> "Times", TextAlignment -> Center], {day, Sequence @@ (MinMax[#["Day"] & /@ (dataAssoc[month])]), 1}, Paneled -> False], {{month, lastmonth}, Sequence @@ MinMax[Keys[MinMax[#["Day"] & /@ #] & /@ dataAssoc]], 1} , SynchronousUpdating -> True, Paneled -> False]], With[{dataAssoc = GroupBy[dates, #["Month"] &]}, Manipulate[Manipulate[ DateListPlot[ TimeSeriesWindow[tstempTank, DateObject[{2017, month, day}, "Day"]], PlotTheme -> "Web", Joined -> False, Filling -> Axis, ImageSize -> 200, PlotRange -> All, PlotLabel -> DateObject[{2017, month, day}, "Day"] ], Style["Tank Temperature", 25, Bold, FontFamily -> "Times", TextAlignment -> Center], {day, Sequence @@ (MinMax[#["Day"] & /@ (dataAssoc[month])]), 1}, Paneled -> False], {{month, lastmonth}, Sequence @@ MinMax[Keys[MinMax[#["Day"] & /@ #] & /@ dataAssoc]], 1}, SynchronousUpdating -> True, Paneled -> False]], With[{dataAssoc = GroupBy[dates, #["Month"] &]}, Manipulate[Manipulate[ DateListPlot[ TimeSeriesWindow[tsVol, DateObject[{2017, month, day}, "Day"]], PlotTheme -> "Web", Joined -> False, Filling -> Axis, ImageSize -> 200, PlotRange -> All, PlotLabel -> DateObject[{2017, month, day}, "Day"] ], Style["Hot Water Consumed ", 25, Bold, FontFamily -> "Times", TextAlignment -> Center], {day, Sequence @@ (MinMax[#["Day"] & /@ (dataAssoc[month])]), 1}, Paneled -> False], {{month, lastmonth}, Sequence @@ MinMax[Keys[MinMax[#["Day"] & /@ #] & /@ dataAssoc]], 1}, SynchronousUpdating -> True, Paneled -> False]]}}, ItemAspectRatio -> 1 , ImageSize -> 1000, Frame -> False, Alignment -> Center, Background -> Transparent, BaseStyle -> {FontColor -> Black, FontFamily -> "Times", 30}] ]; Show[Switch[vizualization, 1, firstPage, 2, stadistics], ImageSize -> {1000, 700}] ], Control[{{vizualization, 1, ""}, {1 -> "Parameters", 2 -> "Statistics"}, Setter}], PaneSelector[{ 1 -> Column@{Spacer@2, Style["Measurement and Visualization of Energy production \ \"Solar Heaters\"", 40, Bold, FontFamily -> Times, TextAlignment -> Center]}, 2 -> Column@{Spacer@2, Style["Statistics", 40, Bold, FontFamily -> Times, TextAlignment -> Center]}}, Dynamic@vizualization], SaveDefinitions -> True, Paneled -> False] ![Visualization][1] ![enter image description here][2] [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Capturadepantalla2017-07-04ala%28s%2921.28.03.png&userId=1017357 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Capturadepantalla2017-07-04ala%28s%2921.28.33.png&userId=1017357 Ruben Garcia 2017-07-05T01:33:20Z https://community.wolfram.com/groups/-/m/t/984688 Units are important in engineering and science, so I need to get my students to be religious about using them. I provide answers to homework and exams using Mathematica. Incorporating units in simple computations is relatively easy, but I have difficulty in using units with functions. For example how do I define a function d[t_]:=10*t^2 + 5*t+25 where the units of t are seconds? In subsequent calls of the function, do I need to use the Quantity notation for every specific numeric value of t? Orest Gogosha 2016-12-21T21:01:23Z https://community.wolfram.com/groups/-/m/t/1731427 ![pic03][4] Disclaimer -------- This computational notebook is not to be sold or exchanged for either monetary or non-monetary gains in anyway. The notebook is not to be modified without prior written consent from the author. ?The calculation only serves as an additional reference for equity investors and investment advisors. Any liability, including any liability for negligence, for any loss or damage arising from reliance on this computational notebook, is expressly excluded. Under no circumstance shall the author of this computational notebook or Wolfram Research be held responsible for third-party's application, investment recommendation, or other usage originating from this computational notebook. I. Abstract -------- A quantitative model was derived to analyze common collections of investment tactics. The model was designed with flexibility: it can choose and weight the stocks into a portfolio of any size, based on any analytic expression of the stocks' financial characteristics, allowing both whole and fractional shares, with an option for additional investment. Using the model, several common investment strategies were investigated: chosen and weighted by price; chosen by price, equally weighted; chosen by volume, weighted by market capitalization; chosen and weighted by market capitalization. The model shows that a less frequently adjusted portfolio seems to perform better, supporting the buy-and-hold tactic. The model also indicate that the size of the portfolio, does not exert a strong effect on the strategy's overall performance. II. Introduction -------- Equity investing remains a significant vehicle to preserve and generate wealth. Owing to the advances in technology and computational instruments, as well as the readily available financial data, strategical equity investing has become more technically accessible. Yet, apart from large financial institutions (such as hedge-funds and investment banks), the analyzing tools for investment strategies are not readily available to most individual investors - and even when the tools are available, the analysis are often basic and limited. Hence, a mathematically robust, versatile tool for investment strategy would enable more people to participate in investing, to make better-informed choice, which may narrows the standard of living gap between different social classes. Here, a computational model was derived and freely distributed to help quantifying the most common collection of investment strategies: the model aims to quantify the portfolio's performance, in which stocks are chosen and weighted based on certain criteria. The model consists of two distinct parts: the gathering of historical data/financial information, and the construction of the portfolios - back-testing on historical data for theoretical performance (transactional fees and other necessary costs are not included in the model). III. Data Gathering -------- ClearAll["Global`*"]; SetDirectory[NotebookDirectory[]]; First, a collection of stocks is specified: this collection will serve as the "set of all stocks", from which the portfolios will be constructed. For the purpose of constructing and testing a computational model, the collection is chosen to be SP500: all the stocks that are listed on the Standard and Poor 500 Index (^SPX) listStock = EntityList[EntityClass["Financial", "SP500"]]; DumpSave["listStock.MX", listStock]; This specified "set of all stocks" SP500 is then associated with multiple other financial properties: price, option2, option3, option4, option5, option6. Price is always included, since stock price is necessary to quantify an investment strategy's performance. The other options are chosen from the following list, so that they result in timeseries (measurements over time) of the properties (as currently supported by Wolfram Mathematica kernel, 2019-07-10): {"Change", "Close", "CumulativeFractionalChange", "Dividend", "DividendPerShare", "Last", "MarketCap", "Open", "Price", "RawVolume", "Return", "Volume"}. If an option is not used, that option must be specified as "None". The financial properties for the "set of all stocks" are collected with one call of FinanciaData[], in order to minimize the downloading time. Yet, because of the sheer size of the timeseries: all daily data points of several properties of all stocks since the stocks' inception, the financial properties may take as much as two hours to be procured (the Boolean variable run is used to prevent inadvertently overwriting the obtained data file - it needs to be changed to True in order to execute the codes in this section). option2 = "MarketCap"; option3 = "Volume"; option4 = "Close"; option5 = "Open"; option6 = "None"; listOptions = DeleteCases[{option2, option3, option4, option5, option6}, "None"]; DumpSave["listOptions.MX", listOptions]; run = False; If[run == True, listStockPropRaw = FinancialData[listStock, Prepend[listOptions, "Price"], All]]; The portfolios will be compared against a benchmark to assess their performance. This benchmark is chosen to be the Standard and Poor 500 Index (^SPX): the data is stored in sp500All variable. sp500All = FinancialData["^SPX", All]; DumpSave["sp500All.MX", sp500All]; Once all the financial properties are (finally) obtained, the timeseries are changed into interpolation order of 0, which means missing/interval measurements will be identical to its immediately previous measurement, effectively describing a step function (instead of interpolating the interval measurement from both its immediate previous data point and its next data point - i.e. using future data to make a present decision). This step is crucial for back-testing, especially with quarterly (every three months) financial data such as dividend, total asset, total liability, EBITDA (earnings before interest, tax, depreciation and amortization), etc. (At the moment, Wolfram Research has plan to incorporate EntityValue[] of entity "Company" into the FinancialData[] function, so that by querying a stock, the associated company's financial and accounting information can be obtained.) If[run == True, listStockProp = Replace[listStockPropRaw, List["Interpolation", Rule[InterpolationOrder, 1]] -> List["Interpolation", Rule[InterpolationOrder, 0]], {5}]; DumpSave["listStockProp.MX", listStockProp]; ] The SP500 stocks's name and financial properties are combined into one variable: masterThread, with its definition saved into "masterThreadGeneral.MX". The variable masterThread is ascertained with its length and an excerpt of its contents. If[run == True, CompoundExpression[ masterThreadNotIndexed = DeleteMissing[ Transpose[Prepend[Transpose[listStockProp], listStock]], 1, 3]; masterThread = Transpose[ Prepend[Transpose[masterThreadNotIndexed], Range[Length[masterThreadNotIndexed]]]]; DumpSave["masterThreadGeneral.MX", masterThread]; masterThread // Length RandomSample[masterThread, 5] // TableForm // Print ]] For the sole purpose of constructing the computational model, a smaller set of 64 randomly selected stocks from SP500 are obtained (since making a portfolio by sorting the whole 505 stocks in the SP500 set would take a bit longer - which is unnecessary at this stage). If[run == True, CompoundExpression[ ClearAll[masterThread]; masterThreadNotIndexedSample = RandomSample[ DeleteMissing[ Transpose[Prepend[Transpose[listStockProp], listStock]], 1, 3], 64]; masterThread = Transpose[ Prepend[Transpose[masterThreadNotIndexedSample], Range[Length[masterThreadNotIndexedSample]]]]; DumpSave["masterThreadSample64.MX", masterThread]; masterThread // Length RandomSample[masterThread, 5] // TableForm // Print ]] IV. Constructing the computational model -------- First, the previously constructed listOptions, sp500All, and the masterThread variables are reloaded into a clean Mathematica kernel. ClearAll["Global`*"]; SetDirectory[NotebookDirectory[]]; Off[InterpolatingFunction::dmval]; Off[EntityValue::conopen]; Get["listOptions.MX"]; Get["sp500All.MX"]; Get["masterThreadGeneral.MX"]; The inputs for the computational model are specified: - timePeriod denotes the portfolio's frequency of adjustment in whole number of days: timePeriod = n means that the portfolio is updated/adjusted every n days. - sizePortfolio denotes the portfolio's size - the pre-specified number of stocks the portfolio contains. Obviously, the portfolio size must be smaller than the number of stocks in masterThread. - taxRate takes into account the rate of tax on capital gain. Here, the tax is set at 40% for any capital gain each time the portfolio is rebalanced, and immediately deducted. This setup is much more restrictive than the personal income tax schedule in the U.S.: rate depending on personal income (maximum 37%, 2019), calculated for the whole year, and not due until April of the following year. - initialInvest specifies the initial amount of money invested in the portfolio. - dailyInvest specifies the additional daily amount of money invested in the portfolio. Each time the portfolio is rebalanced, an amount of dailyInvest*timePeriod will be added into the portfolio. - optionWholeShare specified whether only whole numbers (positive integers) of stock share are allowed, or fractional shares are also possible, as some trading platforms permit whole share only. Variable optionWholeShare accepts only Boolean values True or False. - beginDate denotes the first date of the investigated time window. - endDate denotes the last date of the investigated time window. - funcSort[] determines how the stocks in masterThread (the "set of all stocks") at one specific instant of time are sorted for selection, from largest to smallest. Function funcSort accepts any analytic expression of x1, x2, x3, x4, x5,..., corresponding to the financial properties "Price", option2, option3, option4, option5,... - optionTake, which is linked to funcTake[] on the following paragraph, specified how the stocks are collected into a portfolio from the sorted masterThread (using funcSort). Variable optionTake is designed to accept only three designation: "high", meaning the largest stocks are taken (with respect to their metrics obtained from funcSort); "low", meaning the smallest stocks are taken; and mid", meaning the middle stocks are taken. - funcWeight[] determines how the selected stocks in the portfolio are weighted for investment. Function funcWeight accepts any analytic expression of x1, x2, x3, x4, x5,..., corresponding to the financial properties "Price", option2, option3, option4, option5,... To use funcWeight, optionEqualWeight must be False. - optionEqualWeight denotes whether to use funcWeight[], or to assign equal weight to all selected stocks in the portfolio. Variable optionEqualWeight accepts only Boolean values True or False. - Function funcTake[], mentioned earlier with variable optionTake, is defined to execute the input given to optionTake. - Variable sp500Ratio stores the relative value of the Standard and Poor 500 Index (^SPX) since the first date of the investigated time window - of which the portfolio performance is compared against. timePeriod = 56; sizePortfolio = 10; taxRate = 0.4; initialInvest = 100.00; dailyInvest = 0.00; optionWholeShare = False; beginDate = DateObject["2004-07-01"]; endDate = DateObject["2019-07-01"]; funcSort[x1_, x2_, x3_, x4_, x5_] := x2/10^6 + x3/10^3 + Sqrt[(Sin[Log[x2 + 1]])^2 + (ArcTan[x3])^2]; optionTake = "low"; (*high mid low*) funcWeight[x1_, x2_, x3_, x4_, x5_] := ( Abs[2 (x5 - x4)] + Log[x5 + x4 + 1]^-1)/(x5 + x4) x1; optionEqualWeight = False; initialFunc[] := Module[{}, CompoundExpression[ portValue[beginDate] = Quantity[initialInvest, "USDollars"]; investAmount = Quantity[dailyInvest, "USDollars"]*timePeriod; funcTake[sortedListVar_, sizePortfolioVar_] := Which[ optionTake == "high", Take[sortedListVar, sizePortfolioVar], optionTake == "mid", Take[sortedListVar, {Floor[( Length[sortedListVar] - sizePortfolioVar)/2], Floor[(Length[sortedListVar] + sizePortfolioVar)/2] - 1}], optionTake == "low", Take[sortedListVar, -sizePortfolioVar] ]; sp500 = TimeSeriesWindow[sp500All, {beginDate, endDate}, IncludeWindowTimes -> True, ResamplingMethod -> {"Interpolation", InterpolationOrder -> 0}]; sp500Ratio = sp500/QuantityMagnitude[sp500[beginDate]]; ]]; The function callFuncBody[] constitutes the essence of the model: it determines the portfolio's value at each instant of adjustment. First, the function chooses the stocks to be included in the portfolio along with their weight-by-investment-amount: by sorting with funcSort, choosing with optionTake/funcTake, and weighting with funcWeight, on the pre-defined stocks' properties, from the previous day (to assure that all properties are available, that future information is not used to make present decision). Then, the function distributes the current portfolio value to the chosen list of stocks , from which it registers the number of shares of the chosen stocks. If only whole share number is allowed, the function ensures that portfolio's value remains sufficient to purchase at least one share of each stock chosen, by mean of additional investment. At the next date of adjustment, the function uses the previous number of shares and new stock prices to compute the new portfolio value - after any applicable tax and additional investment. This new portfolio value is hence used to derive the new number of shares, etc. The function repeats the process until it spans over the whole pre-specified time window. The portfolio value is capped at 100 times the total amount of investment. The function callFunc[] imposes necessary conditions on callFuncBody[]: the model will only evaluates with proper inputs. More importantly, the function callFunc[] incorporates the model's downstream processing steps. (*callFuncBody[]*) callFuncBody[] := Module[{threadPrevious = {}, indexPrevious = {}, threadAtTime, threadAtTimeMinus1, newPriceList, threadAtTimeAppend, sortedList, listChosen, t, tMinus1, tprevious, newPortValue, portValuePrevious, fractionalAmount, priceListPrevious, differenceValue}, initialFunc[]; listDate = {}; TimeConstrained[ For[t = beginDate, t <= endDate, t = DatePlus[t, timePeriod], threadAtTime = MapAt[#[t] &, masterThread, {All, Table[n, {n, 3, Length[listOptions] + 3}]}]; tMinus1 = DatePlus[t, -1]; threadAtTimeMinus1 = MapAt[#[tMinus1] &, masterThread, {All, Table[n, {n, 3, Length[listOptions] + 3}]}]; If[And[ FreeQ[QuantityMagnitude[threadAtTime], _Missing, 2], FreeQ[QuantityMagnitude[threadAtTimeMinus1], _Missing, 2], threadAtTime != threadPrevious], CompoundExpression[ If[indexPrevious != {}, CompoundExpression[ newPriceList = Select[threadAtTime, MemberQ[indexPrevious, #[[1]]] &][[All, 3]]; differenceValue = Dot[newPriceList - priceListPrevious, listShareNumber[tPrevious]]; portValue[t] = If[QuantityMagnitude[differenceValue] > 0, Min[100 (investAmount* QuantityMagnitude[ DateDifference[beginDate, endDate]] + (portValue[ beginDate] + addFund[beginDate])), portValuePrevious + (1 - taxRate) differenceValue + investAmount], Min[100 (investAmount* QuantityMagnitude[ DateDifference[beginDate, endDate]] + (portValue[ beginDate] + addFund[beginDate])), portValuePrevious + differenceValue + investAmount] ](*IF*); ](*CompoundExpression*)](*IF*); sortList = funcSort[x1, x2, x3, x4, x5] /. Table[ Evaluate[Symbol[StringJoin["x", ToString[n - 2]]]] -> QuantityMagnitude[threadAtTimeMinus1[[All, n]]], {n, 3, Length[listOptions] + 3}]; (*{x1\[Rule]QuantityMagnitude[threadAtTimeMinus1[[All,3]]], x2\[Rule]QuantityMagnitude[threadAtTimeMinus1[[All,4]]], x3\[Rule]QuantityMagnitude[threadAtTimeMinus1[[All,5]]], x4\[Rule]QuantityMagnitude[threadAtTimeMinus1[[All,6]]], x5\[Rule]QuantityMagnitude[threadAtTimeMinus1[[All,7]]]};*) weightList = If[optionEqualWeight == False, funcWeight[x1, x2, x3, x4, x5] /. Table[ Evaluate[Symbol[StringJoin["x", ToString[n - 2]]]] -> QuantityMagnitude[threadAtTimeMinus1[[All, n]]], {n, 3, Length[listOptions] + 3}], ConstantArray[1/Length[masterThread], Length[masterThread]] ]; threadAtTimeAppend = Transpose[ Join[Transpose[threadAtTime], {sortList}, {weightList}]]; sortedList = Sort[threadAtTimeAppend, #1[[-2]] > #2[[-2]] &]; listChosen = Sort[funcTake[sortedList, sizePortfolio], #1[[1]] < #2[[1]] &]; weight = If[And[optionEqualWeight == False, 0 < QuantityMagnitude[Min[weightList]], QuantityMagnitude[Max[weightList]] < \[Infinity]], listChosen[[All, -1]]/Total[listChosen[[All, -1]]], ConstantArray[1/sizePortfolio, sizePortfolio] ]; If[optionWholeShare == True, CompoundExpression[ If[ portValue[t] < Dot[listChosen[[All, 3]], ConstantArray[1, sizePortfolio]], CompoundExpression[ addFund[t] = investAmount + Dot[listChosen[[All, 3]], ConstantArray[1, sizePortfolio]] - portValue[t]; portValue[t] = investAmount + Dot[listChosen[[All, 3]], ConstantArray[1, sizePortfolio]]; ], addFund[t] = investAmount]; listShareNumber[t] = Floor[weight*portValue[t]/listChosen[[All, 3]]]; ](*CompoundExpression*), CompoundExpression[ addFund[t] = investAmount; listShareNumber[t] = weight*portValue[t]/listChosen[[All, 3]]; ](*CompoundExpression*); ](*If*); portAtTime[t] = Thread[{listChosen[[All, 1]], listChosen[[All, 2]], listChosen[[All, 3]], listShareNumber[t], listChosen[[All, -2]], listChosen[[All, -1]]}]; Do[ shareNo[listChosen[[i, 1]], t] = listShareNumber[t][[i]], {i, 1, Length[listChosen]} ]; Do[ shareNo[n, t] = 0, {n, Complement[Range[Length[masterThread]], listChosen[[All, 1]]]} ]; AppendTo[listDate, t]; threadPrevious = threadAtTime; tPrevious = t; portValuePrevious = portValue[t]; indexPrevious = listChosen[[All, 1]]; priceListPrevious = listChosen[[All, 3]]; ](*CompoundExpression*), t = DatePlus[t, -timePeriod + 1];](*If*) ](*For*), 10*60, Print["Time Out!"](*TimeConstrained*)]; ](*Module*); (*&&&***&&&***&&&***&&&***&&&***&&&***&&&***&&&***&&&***&&&***&&&*) (*callFunc[]*) callFunc[] := If[ And[ Length[masterThread] > sizePortfolio, IntegerQ[sizePortfolio], sizePortfolio > 0, beginDate <= endDate, IntegerQ[timePeriod], timePeriod > 0, MemberQ[{"high", "mid", "low"}, optionTake], BooleanQ[optionEqualWeight], BooleanQ[optionWholeShare] ](*And*), CompoundExpression[ callFuncBody[]; addFund[beginDate] = portValue[beginDate]; Do[ shareNumberTimeSeries[n] = TimeSeries[Table[shareNo[n, t], {t, listDate}], {listDate}, ResamplingMethod -> {"Interpolation", InterpolationOrder -> 0}], {n, 1, Length[masterThread]} ](*Do*); portValueTimeSeries = TimeSeries[Table[portValue[t], {t, listDate}], {listDate}, ResamplingMethod -> {"Interpolation", InterpolationOrder -> 0}]; portValueTimeSeriesRatio = portValueTimeSeries/portValueTimeSeries["FirstValue"]; addFundTimeSeries = TimeSeries[Table[addFund[t], {t, listDate}], {listDate}, MissingDataMethod -> {"Constant", Quantity[0.00, "USDollars"]}, ResamplingMethod -> {"Constant", Quantity[0.00, "USDollars"]}]; addFundTimeSeriesRatio = addFundTimeSeries/portValueTimeSeries["FirstValue"]; finalList = Transpose[ Append[Transpose[masterThread], Table[shareNumberTimeSeries[n], {n, 1, Length[masterThread]}]]]; ](*CompoundExpression*), Print["Error: problematic input(s)! Model will not run."] ](*If*); Function callFunc[] defines several global variables: - listDate: the list of all the dates at which the portfolio was adjusted. - portAtTime[t]: the component of the portfolio at an instance of time t. The instance of time t must be an element of the list of all date listDate. - shareNumberTimeSeries[n]: the timeseries of the share number in portfolio of the nth stock in masterThread (1 <= n <= Length[masterThread]) - portValueTimeSeries: the timeseries of portfolio value. - addFundTimeSeries: the timeseries of additional investment. - finalList: the list of all stocks and their properties, with their share number appended. callFunc[]; Hold[ Take[listDate, 6] // TableForm // Print; Table[{t, portAtTime[t]}, {t, listDate}] // TableForm // Print; Table[{n, shareNumberTimeSeries[n]}, {n, 1, 6}] // TableForm // Print; portValueTimeSeries // Print; addFundTimeSeries // Print; Take[finalList, 5] // TableForm // Print; ]; Here is an example of the finalList, with appropriate annotation. finalListHeadings = Style[Framed[#], 16] & /@ Flatten[{"No.", "Name", "Price", listOptions, "No. of shares in portfolio"}]; finalListwithHeadings = Insert[finalList, finalListHeadings, {{1}, {-1}}]; Rasterize[Take[finalListwithHeadings, 6] // TableForm, RasterSize -> 2400, ImageSize -> 1200] ![pic01][2] Here is an example of the portAtTime, with appropriate annotation. portfolioAtTimeHeadings = Style[Framed[#], 16] & /@ {"No.", "Name", "Price", "No. of shares", "Sort value", "Weight value"}; dateVar = RandomChoice[listDate]; portfolioAtTime = Insert[portAtTime[dateVar], portfolioAtTimeHeadings, {{1}, {-1}}]; Rasterize[Column[{dateVar, Take[portfolioAtTime, 12] // TableForm}], RasterSize -> 1024, ImageSize -> 512] ![pic02][3] Function callPlot[] is defined to expeditiously visualize the portfolio performance, in comparison with the Standard and Poor 500 Index if applicable (when there is no additional investment). The plot is saved in the global variable "plotVal"; and the annual rate of return is saved in the global variable "returnVal". Function callExport[] will save the graph as a .PNG file, at the notebook's directory. Function callPlot has to be called before callExport[]. (*callPlot*) callPlot[] := Module[{}, frameLabel = Style[Framed[#], 12] & /@ {"Time", "Relative Value"}; frameLable2 = {{Style[Framed["Portolio Value"], 12], Style[Framed["Additional Investment"], 12]}, {Style[ Framed["Time"], 12], None}}; stringTotal = ToString[ Round[QuantityMagnitude[ portValueTimeSeries["FirstValue"] + Total[addFundTimeSeries] - addFundTimeSeries["FirstValue"]], 1]]; stringMax = ToString[Round[QuantityMagnitude[Max[portValueTimeSeries]], 1]]; stringEnd = ToString[ Round[QuantityMagnitude[portValueTimeSeries["LastValue"]], 1]]; firstVal = QuantityMagnitude[addFundTimeSeries["FirstValue"]]; regularVal = QuantityMagnitude[investAmount]; dateVal = QuantityMagnitude[DateDifference[beginDate, endDate]]/ timePeriod; lengthVal = Floor[dateVal]; totalVal = QuantityMagnitude[portValueTimeSeries["LastValue"]]; If[firstVal + regularVal != totalVal, CompoundExpression[ sol = NSolve[(firstVal*(1 + interest)^lengthVal + regularVal ((1 + interest)^lengthVal - 1)/interest) (1 + interest)^(dateVal - lengthVal) == totalVal, interest, Reals][[1]]; returnVal = ((1 + interest)^(365.25/timePeriod) - 1) //. sol;], returnVal = 0]; stringReturn = ToString[PercentForm[returnVal, 4]]; (* stringReturn=ToString[PercentForm[QuantityMagnitude[(Exp[Log[ portValueTimeSeries["LastValue"]/Total[addFundTimeSeries]]/( QuantityMagnitude[DateDifference[beginDate,endDate]]/365.25)]-1;)], 4]]; stringTotal=StringTake[StringPadRight[ToString[portValueTimeSeries[ "FirstValue"]+Total[addFundTimeSeries]-addFundTimeSeries[ "FirstValue"]],9,"0"],9]; stringMax=StringTake[StringPadRight[ToString[Max[ portValueTimeSeries]],9,"0"],9]; stringEnd=StringTake[StringPadRight[ToString[portValueTimeSeries[ "LastValue"]],9,"0"],9]; stringReturn=StringTake[StringPadRight[ToString[PercentForm[Exp[ Log[portValueTimeSeries["LastValue"]/(portValueTimeSeries[ "FirstValue"]+Total[addFundTimeSeries]-addFundTimeSeries[ "FirstValue"])]/QuantityMagnitude[DateDifference[beginDate,endDate, "Year"]]]-1,5]],5,"0"],5]; *) plotLabel = Style[Framed[ StringJoin["Total investment: $", stringTotal, ". Annual return: ", stringReturn, "\nPortfolio value max: $", stringMax, "; end: $", stringEnd]], 16]; max = Max[ Min[QuantityMagnitude[Max[portValueTimeSeriesRatio]], 12], Max[sp500Ratio]]; min = Min[ Max[QuantityMagnitude[Min[portValueTimeSeriesRatio]], -1], Min[sp500Ratio]]; plotVal = If[dailyInvest == 0, DateListPlot[{portValueTimeSeriesRatio, sp500Ratio, addFundTimeSeriesRatio}, FrameLabel -> frameLabel, PlotLabel -> plotLabel, PlotRange -> {Automatic, {0, max}}, PlotStyle -> {Thick, Thick}, Joined -> {True, True, False}, Filling -> {1 -> Axis, 2 -> {{1}, {None, Directive[Opacity[0.3], ColorData[97, "ColorList"][[2]]]}}}, FillingStyle -> Opacity[0.3], PlotLegends -> Placed[{"Portfolio", "SP500", "add"}, {Left, Top}], ImageSize -> Large], addFundTimeSeriesRescaled = addFundTimeSeries/addFundTimeSeries["LastValue"]* Max[portValueTimeSeries]/2; DateListPlot[{portValueTimeSeries, addFundTimeSeriesRescaled}, FrameLabel -> frameLable2, PlotLabel -> plotLabel, PlotRange -> {Automatic, {0, QuantityMagnitude[Max[portValueTimeSeries]]}}, FrameTicks -> {{Table[ x Round[Max[portValueTimeSeries], 5]/5, {x, 0, 4}], Table[{x Max[portValueTimeSeries]/4, x addFundTimeSeries["LastValue"]/2}, {x, 1, 3}]}, {Automatic, None}}, PlotStyle -> {Thick, Thick}, Joined -> {True, False}, Filling -> {1 -> Axis}, FillingStyle -> Opacity[0.3], PlotLegends -> Placed[{"Portfolio", "add"}, {Left, Top}], ImageSize -> Large] ] ]; callExport[plotVar_] := Export[ StringJoin["plot", ToString[plotVar], StringPadLeft[ToString[sizePortfolio], 3, "0"], StringTake[ToString[optionTake], 2], StringPadLeft[ToString[timePeriod], 3, "0"], ".png" ] , plotVal]; callPlot[] Hold[callExport[]]; ![pic03][4] V. Explicit quality-control: checking the model manually -------- The model was explicitly checked to assure that it does what it is designed to do, given appropriate input data. The quality-control process is readily available using the following block of code. (Again, the sort value and weight value are derived from the day immediately before, not the current day of portfolio balancing.) timePeriod = 112; sizePortfolio = 5; taxRate = 0.4; initialInvest = 100.00; dailyInvest = 0.00; optionWholeShare = False; beginDate = DateObject["2014-07-01"]; endDate = DateObject["2019-07-01"]; funcSort[x1_, x2_, x3_, x4_, x5_] := x1; funcWeight[x1_, x2_, x3_, x4_, x5_] := (2 Abs[x5 - x4])/(x5 + x4); optionEqualWeight = False; callFunc[]; listDate; listIndexTest = Flatten[Table[portAtTime[listDate[[q]]][[All, 1]], {q, 1, 10}]]; portfolioAtTimeHeadings = Style[Framed[#], 16] & /@ {"No.", "Name", "Price", "No. of shares", "Sort value", "Weight value"}; finalListHeadings = Style[Framed[#], 16] & /@ Flatten[{"No.", "Name", "Price", listOptions}]; For[h = 1, h <= 2, h++, col1x = MapAt[QuantityMagnitude[#[DatePlus[listDate[[h]], -1]]] &, Select[masterThread, MemberQ[listIndexTest, #[[1]]] &], {All, Table[n, {n, 3, Length[listOptions] + 3}]}]; col1 = Insert[col1x, finalListHeadings, {{1}, {-1}}]; col2x = portAtTime[listDate[[h]]]; col2 = Insert[col2x, portfolioAtTimeHeadings, {{1}, {-1}}]; Rasterize[TableForm[{ Rasterize[listDate[[h]]], Style[ StringJoin["Portfolio's value: $", ToString[QuantityMagnitude[portValue[listDate[[h]]]]]], 16], {Style[Framed["Sublist from list of all Stocks, previous day"], 16], " ", Style[Framed["Portfolio, rebalancing day"], 16]}, {col1 // TableForm, " ", col2 // TableForm} }, TableAlignments -> {Left, Top}], RasterSize -> 2048, ImageSize -> 1024] // Print; ] ![pic04][5] ![pic05][6] VI. Analysis of investment strategies -------- Since market conditions vary with time, the investment strategies are evaluated and compared using the same set of initial inputs, which is prescribed to best represents the current market conditions: - taxRate 40% - beginDate July 01st, 2014 - endDate July 01st, 2019 The function reEvaluateFunc[] simplifies the model's implementation, providing both the graph of the portfolio's performance and the annual return. taxRate = 0.4; initialInvest = 100.00; dailyInvest = 0.00; optionWholeShare = False; beginDate = DateObject["2014-07-01"]; endDate = DateObject["2019-07-01"]; reEvaluateFunc[sizePortfolioVar_, optionTakeVar_, timePeriodVar_, export_] := Module[{o = optionTakeVar, t = timePeriodVar, s = sizePortfolioVar, ex = export}, timePeriod = t; sizePortfolio = s; optionTake = o; callFunc[]; callPlot[]; If[ex == True, callExport[]]; {plotVal, returnVal} ]; ## a) The sorted and weighted by price strategy ## The sorted and weighted by price portfolio is one of the most common and simple strategies. This strategy results in equal number of shares for the stocks in portfolio (almost equal actually, since price of the day before adjustment is used as weight, but portfolio value is distributed to price of adjustment day). funcSort[x1_, x2_, x3_, x4_, x5_] := x1 ; funcWeight[x1_, x2_, x3_, x4_, x5_] := x1; optionEqualWeight = False; plota11 = reEvaluateFunc[10, "high", 056, False][[1]]; plota21 = reEvaluateFunc[10, "high", 014, False][[1]]; plota31 = reEvaluateFunc[60, "high", 056, False][[1]]; plota41 = reEvaluateFunc[60, "high", 014, False][[1]]; plota12 = reEvaluateFunc[10, "mid", 056, False][[1]]; plota22 = reEvaluateFunc[10, "mid", 014, False][[1]]; plota32 = reEvaluateFunc[60, "mid", 056, False][[1]]; plota42 = reEvaluateFunc[60, "mid", 014, False][[1]]; plota13 = reEvaluateFunc[10, "low", 056, False][[1]]; plota23 = reEvaluateFunc[10, "low", 014, False][[1]]; plota33 = reEvaluateFunc[60, "low", 056, False][[1]]; plota43 = reEvaluateFunc[60, "low", 014, False][[1]]; k = 32; tabLabel = Style[Framed[ "Portfolio's value, comparing to S&P500\nSorted and Weighted by \ Price"], 1.25 k]; row1 = Style[Framed["Base Case:\nperiod 56\nsize 10"], k]; row2 = Style[Framed["\[DownArrow]period 14\nsize 10"], k]; row3 = Style[Framed["period 56\n\[UpArrow]size 60"], k]; row4 = Style[Framed["\[DownArrow]period 14\n\[UpArrow]size 60"], k]; col1 = Style[Framed["Largest Stocks"], k]; col2 = Style[Framed["Middle Stocks"], k]; col3 = Style[Framed["Smallest Stocks"], k]; plotLista = { {"", col1, col2, col3}, {row1, plota11, plota12, plota13}, {row2, plota21, plota22, plota23}, {row3, plota31, plota32, plota33}, {row4, plota41, plota42, plota43}, {"", tabLabel, SpanFromLeft, SpanFromLeft}}; Rasterize[TableForm[plotLista, TableAlignments -> Center]] ![pic06][7] For this simple investment strategy: - a longer period of adjustment - a less frequent portfolio rebalancing schedule would generally yield a significantly better return (comparing row 1 and row 2, row 3 and row 4). - independent of how the stocks are chosen (largest, middle, and smallest, with respect to the sorting criteria), the size of the portfolio does not seem to affect portfolio's performance: gaining portfolios remains gaining, and losing portfolios remains losing (comparing row 1 and row 3, row 2 and row 4). Among the twelves scenarios investigated for this investment strategy, the scenario of choosing the smallest stocks and holding them for a longer period of time seems to be nearly as profitable as passive investing in SP500 Index, yielding a 1.50 times profit, corresponding to an annual return of 4.68%. ## b) The sorted by price, equally weighted strategy ## This investment strategy is very similar to its cousin above: instead of equal number of share, each stock in the portfolio receive an equal amount of investment. funcSort[x1_, x2_, x3_, x4_, x5_] := x1; funcWeight[x1_, x2_, x3_, x4_, x5_] := x1; optionEqualWeight = True; plotb11 = reEvaluateFunc[10, "high", 056, False][[1]]; plotb12 = reEvaluateFunc[10, "mid", 056, False][[1]]; plotb13 = reEvaluateFunc[10, "low", 056, False][[1]]; k = 32; tabLabel = Style[Framed[ "Portfolio's value, comparing to S&P500\nSorted by Price, Equally \ Weighted"], 1.25 k]; row1 = Style[Framed["period 56\nsize 10"], k]; col1 = Style[Framed["Largest Stocks"], k]; col2 = Style[Framed["Middle Stocks"], k]; col3 = Style[Framed["Smallest Stocks"], k]; plotListb = { {"", col1, col2, col3}, {row1, plotb11, plotb12, plotb13}, {"", tabLabel, SpanFromLeft, SpanFromLeft}}; Rasterize[TableForm[plotListb, TableAlignments -> Center]] ![pic07][8] The sorted by price, equally weighted strategy performs a bit better comparing to its relative (sorted and weighted by price). Nevertheless, it remains inferior to passively investing in SP500 Index: it only gives an annual return of 6.78%, similar to SP500. ## c) The sorted by volume, weighted by market capitalization strategy ## funcSort[x1_, x2_, x3_, x4_, x5_] := x3; funcWeight[x1_, x2_, x3_, x4_, x5_] := x2; optionEqualWeight = False; plotc11 = reEvaluateFunc[10, "high", 056, False][[1]]; plotc12 = reEvaluateFunc[10, "mid", 056, False][[1]]; plotc13 = reEvaluateFunc[10, "low", 056, False][[1]]; k = 32; tabLabel = Style[Framed[ "Portfolio's value, comparing to S&P500\nSorted by Volume, \ Weighted by Market Cap."], 1.25 k]; row1 = Style[Framed["period 56\nsize 10"], k]; col1 = Style[Framed["Largest Stocks"], k]; col2 = Style[Framed["Middle Stocks"], k]; col3 = Style[Framed["Smallest Stocks"], k]; plotListc = { {"", col1, col2, col3}, {row1, plotc11, plotc12, plotc13}, {"", tabLabel, SpanFromLeft, SpanFromLeft}}; Rasterize[TableForm[plotListc, TableAlignments -> Center]] ![pic08][9] This strategy is abysmal: it manages to earn significantly less than the SP500 Index, or even lose money over time. However, it indicates perhaps a relevant strategy of shorting (selling) these portfolios - instead of longing (buying) them - might be profitable. ## d) The sorted and weighted by market capitalization strategy ## funcSort[x1_, x2_, x3_, x4_, x5_] := x2; funcWeight[x1_, x2_, x3_, x4_, x5_] := x2; optionEqualWeight = False; beginDate = DateObject["2014-07-01"]; endDate = DateObject["2019-07-01"]; plotd11 = reEvaluateFunc[10, "high", 056, False][[1]]; plotd12 = reEvaluateFunc[10, "mid", 056, False][[1]]; plotd13 = reEvaluateFunc[10, "low", 056, False][[1]]; beginDate = DateObject["2009-07-01"]; endDate = DateObject["2019-07-01"]; plotd21 = reEvaluateFunc[10, "high", 056, False][[1]]; plotd22 = reEvaluateFunc[10, "mid", 056, False][[1]]; plotd23 = reEvaluateFunc[10, "low", 056, False][[1]]; beginDate = DateObject["2004-07-01"]; endDate = DateObject["2019-07-01"]; plotd31 = reEvaluateFunc[10, "high", 056, False][[1]]; plotd32 = reEvaluateFunc[10, "mid", 056, False][[1]]; plotd33 = reEvaluateFunc[10, "low", 056, False][[1]]; k = 32; tabLabel = Style[Framed[ "Portfolio's value, comparing to S&P500\nSorted and Weighted by \ Market Capitalization"], 1.25 k]; row1 = Style[Framed["period 56\nsize 10\n5 years"], k]; row2 = Style[Framed["10 years"], k]; row3 = Style[Framed["15 years"], k]; col1 = Style[Framed["Largest Stocks"], k]; col2 = Style[Framed["Middle Stocks"], k]; col3 = Style[Framed["Smallest Stocks"], k]; plotListd = { {"", col1, col2, col3}, {row1, plotd11, plotd12, plotd13}, {row2, plotd21, plotd22, plotd23}, {row3, plotd31, plotd32, plotd33}, {"", tabLabel, SpanFromLeft, SpanFromLeft}}; Rasterize[TableForm[plotListd, TableAlignments -> Center]] ![pic09][10] Theoretically, this strategy looks wonderful for stocks of small market capitalization: an annual return of 15.8% is impressive. It consistently performs significantly better than SP500 Index over different time frame (data not shown): 5, 10, 15 years till today. However, the strategy's consistent performance instills doubts of systematic errors, either in the model itself or in the input data (as discussed in the next section). VII. Discussion -------- A versatile computation model for portfolio's performance was derived, which allows investment strategies to be analyzed and quantified. The model shows that a less frequently adjusted portfolio seems to perform better, supporting the buy-and-hold tactic. The model also indicate that the size of the portfolio does not exert a strong effect on the strategy's overall performance. Generally, the model suggests that portfolios of small stocks (with respect to the sorting criteria) seem to outperform portfolios of larger stocks. There are two know systematic errors regarding the input data, which may significantly distort the results the model provided: - The stocks in Entity Class SP500 are the current components of the Standard and Poor 500 Index. Since the composition of SP500 changes over time, some of these stocks might not be included in the index until recently. As SP500 signifies large, successful companies, choosing the stocks that would be in SP500 in the future, but not at the time of portfolio rebalancing, would result in survivor bias. The same is true for excluding stocks that were in SP500 in the past, but is no longer a component of the index (for example, Enron). This survivor bias is expected to be much less significant with recent time period (e.g. past 5 years), comparing to more distant time period (e.g. past 10, 15 years). - At least one stock received insufficient property, which affects how the stocks are chosen and weighed: as of 2019-07-28, the FinancialData[] call for Loews, "NYSE:L", only provide a timeseries of price up to 2013-11-05, which means price after that day is erroneous (due to missing value and interpolation), as shown in the block of codes below. FinancialData[Entity["Financial", "NYSE:L"], "Price"] FinancialData[Entity["Financial", "NYSE:L"], "Price", All]["LastValue"] FinancialData[Entity["Financial", "NYSE:L"], "Price", {2013-01-01, 2019-07-01}] Just For Fun -------- ![just for fun][11] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=pic01.png&userId=1707333 [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=pic01.png&userId=1707333 [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=pic02.png&userId=1707333 [4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=pic03.png&userId=1707333 [5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=pic04.png&userId=1707333 [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=pic05.png&userId=1707333 [7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=pic06.png&userId=1707333 [8]: https://community.wolfram.com//c/portal/getImageAttachment?filename=pic07.png&userId=1707333 [9]: https://community.wolfram.com//c/portal/getImageAttachment?filename=pic08.png&userId=1707333 [10]: https://community.wolfram.com//c/portal/getImageAttachment?filename=pic09.png&userId=1707333 [11]: https://community.wolfram.com//c/portal/getImageAttachment?filename=2019-07-09photoforpresentation.PNG&userId=1707333 Nam Tran 2019-07-11T16:21:18Z https://community.wolfram.com/groups/-/m/t/1046869 Is there any way to overwrite the x-axis values in a plot? I have numerical solution to a differential equation, the solution is plotted against time in seconds. However, I want to change the x-scale of my plot to show minutes, without having to go back and solve the differential equation again. Plot[Evaluate[(((y[x]) /. solutionNum))], {x, 0, signalLength}, PlotRange -> {{0, signalLength}, {All, All}}, FrameLabel -> {"time / s", "temperature / ºC" }, PlotLegends -> {"Model"}]; I want to overwrite the x-axis values to show for instance 0-250 minutes, and not 0-15000 seconds, without having to redo my soluton . Thanks in advance! ![enter image description here][1] [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=result.JPG&userId=980020 Sara K 2017-03-29T13:56:54Z