How to make a smooth revolution surface plot

I'm trying to plot a 3d revolution plot from a set of 2d points. These data points form a 2d curve, then we rotate that curve around y axis and get a 3d surface. @J. M. has a well explained and very helpful post at here which deals exactly the problem I have. However, I tried to use the method, and get a 3d surface that is very rough and not smooth. Here is the 2d data points:               points=Uncompress["1:eJx13Hc4lX/4OHAjW7JnhKRCpEIazrESokhCpUhZFR6KhLLik6w0NBSVShItoew9I7KyRcnWkozffY7v9/yuy/11/uJ6Xeec5zzPe9zv+z2kbF1Mj1cy0NG5L6Gjo9vl6O5xHP75//8RdP/zIthqIqQ/+0vkLfBLe+8n2IXeJBGHIt9WjWPnmTQW8VO6RSI2N3DYTGBXdrHfWfU5iURI5U2wswUgJ7HRV+oYvCIRno5F8Suwbz8vrxN8Hjz4Z/MhSezzn59JIra8NP+hir0mp0p1s0geiYjWrvMwwr41nt7/mjr4R/5HVsbYj8UYqbbYFZKIvQ+zPtthp/srzGocXkIiksU7dp7DXm417qP3CjyH0Nb3Xuz6y0kEs8qSs0L4/mU9C2Bjn6oiEZLfv5M9zyN/v1yw5qxqNYlQGLiXvR/7+URyyuG1tSSi0+RrY5Iv8u8lEaw2d+tIxOkpraiNPsj7ZBltr0+ANwfa5n4+t8j9qScR+/K2MYl4I+9K7mu/k9tAIvarV7UMeiGPKhcv4jH4RCJI1eSgA9gN/a1yTeMbSYTaFi39qDPIfY4VntjS0UQiakwvWu05jXxDDOtr/YfNJKKM59jbQI9F7n8Libj/8kbIMnfkcqumSvfNtJIIlvDKq0VuyEXVC3tGZz+TiFKrVOm7rsiFD3nU6Qq1k4i/B/+mm7sgl55d4dcu1kEiHJ+espI9hTylIOl3vmUniTBdbcbz6sQiz7eLRCRc+aUZ5Yy850lCrUgcuJTni2F/J+QrZHcyGVh1k4i2H5NzpQ7IieWlbstLwQ3KxqvK7ZG/Mt3Yo6PQA+VD++eF9uPIB5y2LnvF0ksi7PPiRtrsFik/4E+3nb7EiT1wuuiHyzvwSG41fvWjyD+Eu7LUvP9CIpwEXtowHUZuwd4wdY2hj0S8+ch8pPcQcmOJ+j4lErjuv9jOzIO4/A6d2l3i3U8ijoo1XPhtvkj5BA+0Pd1oij02bdO5zDxwsYIPfCn7kFtmj21dof6NRNDrfjrzwRi5xmRX4DINcEaTd1feYr9mFyhirAVuXafJ/gD7ilNL133wAd8JtznGCHnGRpn+Yc4BEjF6c9P9cQPkp+P7FHILwW8WTIpH6S1Sf8BTPiqWrcAuY/6+7v4f8LDpwIK4HciLyalHQnQGScTY5fK/pmT8fri6/86CNw4urdlDQr7tsWFHdzo4Q4n/+u0ayCcu2o5FFg+RiNy8q0Or1JELUevnMLSfW0P876ghv/Vlg4DeGXD7qwN89SrIL9+/P2e5Y4REDKzVJg0oI6cWvzfg0jma7g1KyCelRHc9UxklEdW2Jn8c1uH2J6eHS6YUnC9mPPqZ3CL1f4xECGtO23GuQZ6ceiE/1Bt8g3Jm66wM8t4TPMv+PADfPn3vi8tKfH2U4jcJPvoo0yFxBfLWgMa1OtbjJMKiL3V/lChys2ssAw1HwLOIs/Eu2D/SGfcPOoE7UcqRyCLtDzi9nJbINX7k9C52gh6iEySiXpOZuXYZ8pM9Ij0NeuCG9akKakuRD+2nPCFwn/dDvdmsuP3dma/N1wA+xB3jvJ4J+fFfb2+5Kv+A8m0f4N88J/5/t2/gNZcNjb5OIx/I+i2dFg5upMD5NHIKedvRFj4usZ8kgtOY77fXBPKOmqjYtxvBH7oZinGOI0/a+CxPXw983KBYb3gU+Zuxy4fVJsDD4GNk+pGPHBsY76f7RSLMd2il7upDPt++gg/KMp1VwT7Go2f3egl4Lv/sLD92/sHvDieywBWcE9TjW5F/1KXUUPC9BhZ6u1rw9fWfUyVGwGf0mPQSm5C7FPwInHL/TSLE1ZcITn5APt9+g3PJua1xrEZutTrl+vpm8EBdrp0qFcgnLg5+Clz3B+IH345wo2LkRe/jpJRdwP1W7Ji5mI+8xL7j90g+OLu2kH7xe+Q566W/jvSDV26y6IvJQj7fP0ySCH2xnV+yXiE3it0UmnIT/FNF7pKgZ8gbr4e2Zb0B1yg/GmL8FPl8//CXRLh/Lk93fYCfX7vYgeO7wH0+8Gx3u4vcy9c2UScZ/Km7cMPkdeTz/Qd43G3D/2RjkLdKMSqumAOXbjh62joKuZjdtlM18VMkQlCiWvJBIPKn1Bd4yYHqA20B+P4v3x3a/AK8baPDuCH2HUuKTzt1gtdQ2nE/5NRWi/cfifi8lUv3rTf25Lr6KDtw13aW/s0eyOf7N/Axsd2KVwj8/A0E1Syug/uX+Z80ckX+PNlmh6XQNPSPJMWRdceR35Wi3GHw3A8bL8fZIg9bw1leHwa+3/PJp9mDyC/5ZbNLVoCHhm1ZIW2BfL7/nCEReld8tThMcf2X0XULcgMfk2dymjFA3tAqsmbUh+JipT6i2FnISnqy/uDm/2WUFukjj6I2W+Aat0Y5vmgi/9LSUtCoNEsi3vkyiazYhuvHnlXasZ7gYxKdU1MqyOf7b/BLeZ6xXMrIL7Q+E9/SBb7riNG1bgXcvqrvyTLxnIP4X8/ZNVwcedAySg0GD7r6WENvOfKlcS3BGy+DN67UEnYRQ16RolGs9gach/ogkFf/snKSW05HJg6nRERwsyOfjx/Aq9svlVezINd3HT93Yju43pVCBnVGXP+jReT5CPCBp/ISlyaXo/hM2xa6KHAeneq90j+Qvy3MEl2fC36tTezal2/IrSaUOpeVgROnJBOEviL/S23+wN8frgjh7EAuLiRTYy5BTyY8f01Yj35C3nVAL6SWDC7Xk2b5qgZ5uh/lBoG79xSxRZQhb057oazgAX5m3Dp6XxHy605GFm8LwJXdqjK3vkbuTo1vwGe5yj4dfIU8hPWTHVsFuEPykZjCl8gP/2YzOtIMbkYZJqcil492NLsoyUAmdl+vN6lLQL4+69v9MEXw6yNpMar3kJdmbLFr1gbPzqPr/O8Wct4bjMYlZ8C9Zw1F70chH6bGV+BTS6PEYv5DzslrTb+qHFyVaY545oP8yH4md/YKcHYpBS5P7E9/UdoV8IupJsu43ZBb3H/hc1KckUzsqEnvd3JArnieT2O1KXitirO9yAHk9tT4DbyFXlom0xz5huO8B5VdwW1//rqauxe5Y2V2nPId8BvUhhj//uVMTNkF4H6cpZxtGshlqB0keDlfNuP5bcjvns0UX94GLt7SnxGzGX++3AbPboElZKLA56NRtBzybmr8CC42FM61byXy8yxb3MOPgf/9FnI1WhD5nXumzlcdwK+a1XF/EsDXd+Jluext8EKGFf6/2ZDHHo9X83gH3uA7k6xLj1wks0+EexR8+acZCb+fYgv9ALV4MZGJiMK1XdxjyEVv6bw/xQV+k+/CXO0Q8s+7r8Z93Q7eSmlHupAbxL58rm0DzulRlafajFz4CaUAgr9Y1+Df/gn5BYHNiiVe4IRg9Va1j8gtKkIqe16BH2K98Ox4IfJP1PiXiVL/zAP8spB7u61ocZwBn35NaamQ66Vb/z3IyEwmIs1VktySkTdyMZhHsoK3Zsnotichv9K7OaJ3M3iSuGmP5W3kOk7Vl96ZgteeCGCziUFuaj5dsToOXJRnF/1rH+S7qfE3eP5/mZ2l5/DvV5OXZrkP/uBOjst27BdH3+k8fwwuTg2kkCtbJRtfGQfXlBJ3tjyKnHOFz1g+CwuZ2Le8mT/tIPIVAnvotiuDs42JzCzdgzyPLN39lwzO70RUmRgiL6fG/+BOw6I8TtuRD93zKPOJAg+QfxBwbCPycIbIUqVicMv46eOXVuLfT02Pgts9jpUylEAuNFeSOtcJPj5Uv/msGHK+6mFD2TnwI9RAFrnd2j2D+9lZyYRNUFPSOy7kWtYiNwKUwA8/XzJ6mRG5NnV8Am5tI7hBYU50oU+NVkdIW4In7emsZf6D/FS2sx/TefAaF5XE+EHkdNchKk8ED/WxYDjVgTzoM7HmbRX4mjFRid465L+sZMgKP8GdA5/uOVGIPJs6/mGD57t1v7BlFvLrvW3n7IXBfayOkmXSkUfsFxd+owb+gDoQQf54cMcHITvw2qJk22O3kHvXURoA8JSLpRGuV5Fb/RR38rwBXhDycX9UCPKMH2nSZangMko/gx75IVejjr/Av0pe/Bp4Cnn5P9EzXv/AvW5ue/zVFnlhuNDVgi3sZELo8pT1a0PkP6FSbtUGr4sR331zJ/JO1RSvdXoUp/6BfEJtYlunCXg/9YOQf4RC++MM+A6jAYaHKsi/c4wub7kCLnmqetBRHvkL6mMBz2J+k/5cGrn8ap6cpR3gJ6OkjzcvQz5+Vkv+EsUdNebKkrGfolYrDjLx46EJj+aMyELfY7OeNVYOnCO00sPgJ3IW402pwSfB11IfFPKV68weHDoDLpVe3RHfjFye2iyC09/pIpOakIsbPXlR7Q+uxpryIKQe+VdHwup6DvjqfRV2TpnIv1G7TXDrwQdslU+R79fPPnGNmZNMfL7+Q3fqJvJ8ztyIms3ge/rf/vkViDyRGjaB893+1UP2xe9/y+ISbQwear9cKMQbuYRq+LD/QfAT1IqE/N2ES17ydfDiJUfVNhxAbksNq8EzVq86ZLwH+cC+vckvOsDVKmTGy7Yiv7ZNq6trFFzdzLzJdBPyFdRh21Jon2ydbnitxO/feEqwXhZ8FbuE/LnlyEdHeSpuG4CnUhsq5FktRzVHT4GH807IrJkRXuht1LQG+P1Vaf+MfyMPXP+wLPUROMusgOSPL8jvi53g5HoLnpHenNPUjvwmdXwOvnrvseFj5cjDDnk0KcyB91rlWoTkIHcPMtp7dSMXmZigXGci8ksa9f+mdMBl704b9t9Bbk6d9gD3dW2tMo1FHvTK6GyOI3iRcET83v+QP5i4ctk7FDzw9a3k317I+aj5AfAmgfpdmjbIsx+Zik9VgndWbOZg2Ye842vfFfE/4CrUjhJ5kxXv87PLlpGJbd2NTkLKyGvdKANIcOV3lVVKcshnlG9rTOwAZ91syxnJh/zLy+YE1r3gl2+fW6e2FHk4NT8B7u3Qu+baD6GFvmRq+9Gy6+CjOrnZIQPIPXo5lu/LAveiBirIj6qz99m2gkf3O3K9KkZukHIYIhBwF/5DEY3vkddLrh0c4uImEyImUTVZCcgZRoTkvXjAc+VHV9HdQx5IzX+AiwcZ+fNeRG6Zy/voy3pwhzFNvq1+yFs1Vb2aNMDfUQM95Nyj0XlbTMEFX0oIeVkit6VU/0Pgk3PDF2IM8fVbxyq9cgPXmGAr+rseOZfZuzfqkeC2M+WaQ+zIydT8C/jWLTc1elnx9RcTLbLR4Btk4vrdsB+IveaSSvFZCUqgjDzYttUjJQ28KtdgaFmXIGp/oXe+WAQu6lct+LAEeclgFZtcLXj0Jq6+m2+Rd09Oae7uAdekDhSQh+pfGkseBbcwtfdXjEQ+Q80Pga9Z+rxQKQi5wWO9pnXLeMiEhGueeOFx5OYOahzeK8AjiR+lrSbI21L5YQQIHuBoe7BZEzknE1NOqiL4l3CRrP0ayD94JfGObQAPog60kNfYFjxUNgZPTibMhwSQZ1HzU+D8jxSXNU0JLHSndLqmMWfwNW+q//s3gJw9xrZP6hx4KXWgiVzIsDMgIhS8mOyYVvoOeSwlPRID/iBmdPfOp8hLiuPH194G/wbF4H0c8uLObEWFRHDbqiVNMeHIWd9QfiB49GUJ2dALyP0nO2aU34GzUwfiyAmPO63l+eBz++NnDh9G7knNv4H7BxtNl5oj3y4vzr7lM7gCpR9RRf7qgNR1+w7wktBQbQVl5Cl1Lhwsf8Hvbn84qcSM3HyQkiADP+yZ/ESPEXlVnOUGpn/g6i5NBpMMyCcPHRDUorgRNRGC3MAinP+BEC+0vzvEO4oa+Bf6Jmr+D9yGWfi/ilTkZ5pZu3U2gfMlTejefIS88ar06j1bwaOoiR7kIXRWuxN2g3sfcB/vOY2clxLV24LvCovb8dAYeaHmMYteB/BNZIePf8jI675YbzF0Aa+nJrKQ99s83i8ZAJ7dU3GPgRP5ODU/Ce63vzxatocP9e9qavusboNbjZY5sjQhv7Jh7dGweHBBaqIO+UY9xq3Rr8E73EhLmO8jr5W9DTcOnHXj1M2Tp5Hzs0tOFFWDd1nu15w9gVz58fLYV3XgltREJfKmm6SmmX7w5M8erXSbkT+n5k/B975WGwtjQ97Ts6/Sjo6PTDDVno8+zIjvT6/4PR5G8DvzH7TQV30O9y0SAH8u58D/pgr5x2r3+3xC4GtYb3EZlyM/3mRzpG8NeOf8g1roOvKz6ooK4Marwjn5LyO/TJ2ABaefiSJW+yJ3fKqULqoJ/jm4pt7XGDkL/zlF9l3g0vMVZaGTCs7l85qDVwjpZs5yI3eefyxkwvzIlvclfTwLXcXzyGo+Z/DJ3qG9UfXIvRoT5sxcwI/NN1QLXU5BN5zvArhs2tURqevI100X7pgLBu8yaN1TG4ScWYosU3oF/Ml8R7LQo+lzBYaugqtlH685aoHcgBJexIIzPvuu5LwT+cs1HO4/EsHfn2zfz8iHvIu/cX9bMvjgfEe90PcRZh7hb8B1jxqvLatAbu2RzL4pC7zg/cCNP6+RnyvPUSzNB1ecD4QWep9+g0p3EeX3eyicowtAvma+WsP9T5MKS7JGLqwSd1i2Adw05U6cmDryzUrickQTuNt8oInGd6mtn/w6wW88caydYEBuKHn8P+de8D+VIhdOdi1b6L+vnlslPgzuOB+oo/hJujmwfRy88dZdlv2GyMMU9EY7J8HbpTqaA+q4UPluzfBRmgIfq6cOdBZ6wibnuiGKWz16/PlNPHJmOsqLH8an5SZx56SQb+rXD+ZiAFdS7txpPbJ0oe/J3HXrCMXPzA8kFzpj7F+6OooHbK5T6mpFLq8gJcPKBh659K/N8a3If/6ouuHKDj59kDoQX+gTxzKVrDnBdxdH8Fb3cS50aWKygJ4bfGyA99ypUOSxikbXLvCCB84nMha6W5ZGMr8AeLOaagH/T46FntoXEWxH8SSftSvFPiBXfpJWUs8Hzj6f6FnoCvmTAX084O7d7PQ/lJFf+KE/vo5y/ae9PrrYDrIv9BjpgLP+XOBR84myhX7RtWr/qqUU/+ZlKHAGuY310Lgb5f4GfBPmvsqEXN+AITOO8nwE5xORC91B2SI5gBU8Ion5dn4m8ktSKXTdS8BTMpu/uUki76Jr4wiheNx8InfR8jl4Ytr/bhXrQl8peJcpj1I/Uu85nFx2AHldtxjd2t/gMvOJblQ+Ha7NpI2Bi8SqetfTIX/Vvom8cpDS/utWSD4sYEHx7bEdFqmU+v90fiJhoWslVnpfbAfXHJJv2CyHvDElK3WiHvy7e2jXvxzmhb5+wDVNpQ58/fxEDOqfT9i+GfgAfulKeEh1NHJa+9jMwWIj6oq8TU0v2TEP/JvcW6NROuRaLTFbtN+Bv52f6FromeWUAAl81lBxO0cMcovPl+TePgf3tTk20uqFXMCbzbUyAdzZ8cL5C6uRb/IyYP9wG1xjfiJxoe98stYh9Ba4zsSja2+nliza/11oJtddG0H+5WlQgtJFcItnf4y2+SJPO37bfdQLvGh+IhbFb2wnBf1dwfl+8QoLMyGnxRcrEzXYZMoYF3pZXqy4kBV4U7vkze5I5Cos2YFtJuAG8xPd6P57FsmkaIPfKlEUTRZFTouvHmxu+1pWzIDKX9FL1q/y4EnmG9b0PUU+EGj8clQWvG5+oQDq33pvTi/hpcSPd01/R2gjp8WvTn6HT0VN0y/0wUp6Dt3f4EcLXazSepG3fWVqFR8Bt5hfiLHQP/sn20e3giukBQfHByKnxe9uNZaiAzuR78pd8e1nDviQn5vUppXIt2Q90cx4SRkfzC9kQe2nm+6I4wNwiXM3HvkXIKeNX9zH7dk2X0PuKRpPPAihjK9uD2zItkVef5HLTNsD3G5+IdBCNzNX8aynjL8OuprkSCxDThu/yZwseX9sei53gfso7zJlMgAXjhDkqY1C/k5n5ZE/euARv5+52oQgp41P97KO7nrGi1x6I4++2GrwY5xv7YLHZhe6q8Vgr4woeCM1fkGe/txpSScz+McMu+KnZshp4/PElFW8vJLIZVe2abcPgx+cX4i20IdM1KeG+sAV1zia+uUgb0vujWSvBmdrtihI34Gclp9Y43dByHcN8t836yOzisFHXLm7zaSR37oSPaFRCN5LjW+Qmx/zOhlLyb/8uXtUKSl4eqHT8jsN21sf7tuDfI9RyMqMAPAN345ljcz+W+hJTlHFHUfBnXV1NwncRk7LX+kyJJh+jECuH6Mt+uEQuJfmDMk7FHnBowaGzxbgY33UhZTo+89LVJpvpuTX7O/9PC+InJa/q/bnONk3PLXQn5cHrffkBz8zv5B0oe//UuL/mhdcqvKT96dE5GknluWXcYNfqypskIpHTstPSgeGXfxqiZzpgUptwhB4tnWL1vPNyE1yVlsrVIHPnKIupF3ow2az+pdKwC9aLE1LqUROy89GiM1J5ZYgz/O0WqGTB851535YZibyT8ylhUQ8uKmppniKNXJa/vnFmo6dyhrIX/x99qXiLHiITpiJ0u/Jha7J6vx5lpL/ZrmRsn5XH3Ja/rxaRV19Lgf5W7Imk7AJuPU121C2u8gHuV+r8cuD79jr0/TKEDltfkD7rtHHLTuR54R8WnVsDbhKv3pury5yw9EjI1dWgrPPL9Re6P6tAzay/5ZB/6KdkZA++2eh0+Y/1h6OfE76iXyIw9de5RP4FcLc52Ef8oba5zo298HHJsRNuYqQ0+Z3JoUncvtTkV8we2VrbAneyJG+rjgGuYb8AabP+uC7efsvOYUip81PVWWQ4znskVdciXdaNcEF8eeMvnKQPnLNru16w5/Bq14cD5rZipw2/8bg+6S4VBw543S58dWb4Pu7xds4uJDb6n5rLTsKvjP7+o01f3+j9vF/5w+DB9OkQ8eQO1829NyxFbx4TfTpiwPIJ4a385HGl5KJs43u23OqkNPmR12yU0uPlSF/tzz2y1wbeIRr87/eIuTqKc0Cc5T5W6H5jQwLfTWHScw7ig+TTvlsxk6b/2Xpuzeigj3J7j1LCsV3rflZvwH7lb9sWp6S4IbLlsxcPoecNr99WzJRxMMb+Uxjl0nhUvBoB878ndjNJUZ6MzI5oX4yDaeVeyGnzc+T++s9pM8iv5TQc0DyEXgm262Us9iLHzs5HjYBv+Hg0Uj4IKetP8js07YtxN75YpvNDRL4bH5oCK8vcrq7gjs3fucgE2+ENW4cx/eHtn6irqnebDP2uF3JZzKawIcelCfsxT6n5Tt6Mhi8dKm4Sq4rctr6j9zkMtM9bsir3Y++Uj0FnvB2vSWbO/LnZYaDw6LgQhcO+jPg30db37Jra8zpKj/8/qIbazXYwQWI0N+9F5DfOy4gZ/OMnUwciU7N97qJnLY+Z2xH8GwbdpvlTWYySeCNepwO6reQexnZnLGJZF+0fvAlFsecoKw/uta9a43QC+S09UsKTU0qPC+RX5NNW+qhAX5FNOeU6yvktxhOb3jXx0YmHtZE2XPh+k1bf3VBZcfo6Qrk7wVmc+/UgjN8nevirkZel/yenu4iuMd3FceOfuS09WO90vlvO4eQL1GaNaU/DD7CfrY2/xfyR+9Cy3bIgWfGD+1MF0DtJ2193OthQ4Pzq5FHPdvDJNrHSibK455o3Sch9/NQueheC77s36olsruQ09b36c7uC1l6GHnvN4d4Dg/wa9reytpeyOmF8zR+ngIXOGsX6+ONnLY+8UwwT0ZzJHIfl5GHlYLgIw2CrHQJyDdp/Q1qnGIhEyaWf7NUU5DT1mfamJ+OYM1GLvjbPSksE3zn8Vcd78uRO57YUJlxEfyyekT7WCdy2vrSsEPc9FzjyAMGDo6xHQYffdqeQ8zg/jM9ia+Psv517Lbcn4DtKD6hrY/ldLY2uoNddYPMdBLFX+r4v0zF/mjPegd5ii8S/+zx0PdKS2MmE0uL7thfPI+ctj54ewYxORCGnJHdQtAkFHzrp++rBXF855R+6me6JbijdsbyQ/nIaeubO+jPH1FtRf7zELNINmV9dDBXskXSLHKu8aLulwzgww9vXGdjxPHx/67fPvClv65iFfIguUs6z5LBs+g39ifrIPfjUPV9cAn8aPcxxr2WyGnrz1vYPmvtc0Fuwd9Tv8YMfHaFyDerIOSzwgk3WDnB3TZt/ESfjpy2vp7HbN+5kffIPfoGRPdOLyETtp9zyvIKkN93Sv51qWvJouOTM6znM/Qegx/ouMm4hxONb2j7B3gicoazBJHbm8aL+YeCNzel0h2VRd5uruSqbwI+HNH9iM8UOW3/w3LtoN+sJ5BLiYa3BDGBT2me0blxFbnZy4KaA9OMMD5zf9Mncgc5bf8Gc9TLhL25yDmvN7V8fwQedTaykfcL8gEPkyL7APDvhzsajBnR+JW2P6V25135AVHkB5YwcEmZgOcm5To/kUPuGsmo1z/LAOXHL5Ip1h05bX9NoqwvedYDufofJyPfafB1QwPrGk8jbzTW0XaZZFh0fC70K0rO/TFl/5EVq71TLnLa/qHXzfSWElXI07OtvbV9wauM77gfb0M+zZQk074HXEpglO8DA8pf0PY/hWzRS26WQh6c0bDn7jQ9jO/MZf6L2o2cdTnH9lWT4FHWdg+l9yKn7e/6w9Elb+6FnF+Pzzj4Mbg9S6LWQCzys9x3OqrcwRsFblmWliCn7U97sN5lruET8jM9lWciTMF7Bpc+rehBbvzlwCCrCP2i+aEzK5/fk52lg+8/Ls77TRE5bf/d1CrzYpFNyF+b1VrTj4L/Cte6unkb8lauVzZWSeCHwt52uJ9FTts/6Pp8OoslEjnH+EsXFyfwR4nKlwvTkKt63eg8ZAae9fjDLY1C5FcOa994u45u0fwdbX9kv+qDtF8DyHdWnq0MnJsjEc4Ng55hXCg/uF3u9urMavCjd8lqplLIafs/r253M2vZitwn5cnB86bgpctqrUmmyEvCtAY31cySiEN2zoNxAchp+1f/ef17syMc+4GWuDsPwRu73yaqXkVOTf8ZgTObnd7b9QJ5WDqvb7Mu5f3/d36VYfvB5wZ/ZkhE1nKdsN1NyGn7d5251BmOtSPXa0p0j60GdzCXEBTtR+7yd2rDGwPwi5yslt1iKD9M25/8qV328LKNyLdcHOsaLJ8mERH+DJ7pu5Hbb9unFHsX3IlNW9DOBjltf7WHS8VQRBDy0tqhtaUT/0jE8qTJD36Pkf83fdCdtQR8VvxBeF4mctr+8F9klx1bW5BnphikmeqBT7RsSTAdQf5m6anIq3lTJMJSy7fsNB/K39P2xz/NuPWGWxg50/0puUN3wHPvRK3jFUP+0uQ4g7EF+CLzB31PhI3Mxv+SCOHO8RdfNZDT9v///U8mLl0Tufev7/uG3oOLrci+R9qJXMgkUKRNG7yw4F6X0RHktPML+h+zvLntgFzqm25GeO4k1I8xic+5Z5BfdbU29o0BzxLP8az2Q047f0Hul5J682Xk6veC7kysApeab8gW+oYu7q8fu/+QiI9lrwj6O8gTkyMZmUvBZ8aj1znGI6edL/HAkVWs6jly1+BzV6aVwC8l2Vxgy0T++M3mA4MffpOIgGeJ7ollyGnnY6hkh4YeqUVutVvlNZsf+PBz6yW/PiGX2xB+fKT5F9TPn0uZi8aQ0873OClxK5N1AvlaYxEDsSpwlYHg6S/Yw6ws7Xqegi8yf+Zu8VJKVBT8r6KtasEyNP9GO79EwC6Z9Sof8k1bpMYnun+SCIYXqiLdwsglVoTcCXAAl1D25mNbh5x2Pstk0m7dKhXk/RaD9x9//0EimszXMhlrIh+TftRcnQ7u6Nr2YoMBctr5MlbM5OTL5sjXKF1O4GUGF8tgat/ngPyWfFP2oYkJEpG0cyok0wk57XyckODIPqPTyKeYquq8jcGPV4S63DmPvJfYKjTKBP612LRKPxQ57Xyf693bymcjkT/bLXd9yXXwK9Q/kJMj5R1WioJzn1ohopaInHZ+UfQhrbuHk5Ar9BWK5beDX5Zk8bv3DHlcsljmfkXwLYJDx2QKkNPOXwptfS+Vjz3F+1CC7yrwi+O9x7YUIt+Z4JbTyAS+yPyzleSIkUfrCIm4UJBn9KkFOe18KbMwXlXNNuQ/IoX4hYPBj+ZkvOTpxPfvt+ngQedhEjHkkD67ehw57XysIykGs8Rv5IEhWn7Xng6RCGmWI7c9ZnD54F3K/mh6kEQUvDQfe8qK5u9p53ud2KUgq8mNPCNfi7jz4TuJCH++PJd3OXKdnEvL1kaAdxdafDKQRE47n4x1ON2rcjVyL3tbFeOt4PzzA4GFHvT06TYPbnDvX/I1xuuRKwkMfShmBbcoX/L8Hnba+W0/M5Qnf23G7zfND1575SuJKA+aamAhI58qWjv1Qxf875v7qnJ4/QPt/DnfKDu+KX3kn/821XTwgYvwl3/O24281MNeRjqwj0TcvE/Ofb0POe38vPKNJ9O6rJD3/4rr0b32hUTEGo2Wmh5GLnaYaOnJ6yURv8c9GX7bI6ed/xc2ZbryuTNyT5bKXTGC4K08+p1Np5Dv1pDdUDzbTSJ6S1rdZb2R084v7GV+9NrWB/nYrpyHJTfAuceCh3f7IQ8Qb730eFsXiai9vb3P/DJy2vmLg5LpVhLhyJ2uvJj+KwyuV1PwrxQ7B7X+dpCIwO8RDt54/cs+K0J1JhJ8kfUx4SK6XD/WtpOIkYsaKx/dQk47f/Jt6phqC/bvwvGZwwzgbQ5zLdy3kd9vCjljy90K/bvblcOSDxapXy0k4lVVi1Ia9miNhG1B98H/9v5r3PUQuWL5C3/9X40komJtfNDm5EXKN7jrWLEy/zN8fdemtrzXBn9nKn1aMgV5XmcTvWJTPYn49n2IOerlIuUP/P6r7TW+r5BfiFZ0aRv4SCIMhD8yZb1G7rez3Vokoxb6lwtu5KTMRcoH+Lki5w3fs/D6p/wTzf6SH6B9+LYrSOs9cpO5SztOKFfC+KW8pv553iL3v5xEGIaHjygWIK874vPR4GQZiYjLLGWoLET+8OSBD4kTRdA+8CnYvy5d5P4UQvvYxXBiuAzX/8GWe5r5+SQiv6q55GQFcv3L6i22e7IhPj0rtF2nepHrz4TxK/PE4zPYtTxzbvQcSScRe77yuyRhn7MnJ2o4pJGIZmmxg/GLfX4SiTg1Jcp3G3vJhU6mHa33SYTODQlmlhrk2rkfi9mvhsH3z1wbkMbvp/ufF1H+sPq1Mvj/A+ndrWo="];      and this is how it looks like               Graphics[Line[points], Frame -> True]      ![enter image description here](http://i.stack.imgur.com/nscUw.png) and then I use J. M.'s method(code copied and modified from here) (it will take about 10 seconds to run)               parametrizeCurve[pts_List, a : (_?NumericQ) : 1/2] :=       FoldList[Plus, 0, Normalize[(Norm /@ Differences[pts])^a, Total]] /;        MatrixQ[pts, NumericQ]          tvals = parametrizeCurve[points];          m = 3;     knots = Join[ConstantArray[0, m + 1], MovingAverage[ArrayPad[tvals, -1], m], ConstantArray[1, m + 1]];     bas = Table[BSplineBasis[{m, knots}, j - 1, tvals[[i]]], {i, Length[points]}, {j, Length[points]}];     ctrlpts = LinearSolve[bas, points];          circPoints = {{1, 0}, {1, 1}, {-1, 1}, {-1, 0}, {-1, -1}, {1, -1}, {1,0}};     circKnots = {0, 0, 0, 1/4, 1/2, 1/2, 3/4, 1, 1, 1};     circWts = {1, 1/2, 1/2, 1, 1/2, 1/2, 1};          wgpts = Map[Function[pt, Append[#1 pt, #2]], circPoints] & @@@ ctrlpts;     wgwts = ConstantArray[circWts, Length[ctrlpts]];      and then generate the 3d surface               Graphics3D[{Directive[EdgeForm[]],        BSplineSurface[wgpts, SplineClosed -> {False, True},         SplineDegree -> {3, 2}, SplineKnots -> {knots, circKnots},         SplineWeights -> wgwts]}, Boxed -> False]      ![enter image description here](http://i.stack.imgur.com/Ds37G.png) We can see that the surface is not smooth. It looks like the surface is composed by flat rings. So how can we make the surface smooth? Edit: I think this unsmoothness may come from my data rather than the rotation process, so I tried to smooth my data using something like               pointsSmooth=ExponentialMovingAverage[points, 1/20];      then I get the a smoother surface, but `ExponentialMovingAverage` seems to have removed the end points and there is a hole on the surface, which I don't want. ![enter image description here](http://i.stack.imgur.com/oyGlp.png) Also smoothing using a smooth constant like 1/20 largely modified the original data:               Graphics[{Red, Line[ExponentialMovingAverage[points, 1/20]], Blue,        Line[points]}, Frame -> True, AspectRatio -> 1]      ![enter image description here](http://i.stack.imgur.com/kyf6Z.png) So is it possible to smooth the data while keep the general shape so that it will give a better smooth surface? Or there are other ways to contract a smooth surface from the data?


How can I "ORDER BY" using SQLSelect?

A pretty straightforward problem, you would think, but I cannot seem to find the answer in the documentation for SQLSelect. The query I want to run is the following:               SELECT id, measurement, timestamp FROM myTable WHERE id IN (1, 2) ORDER BY timestamp      The _Mathematica_ query I have so far is:               SQLSelect[dbConn,         "myTable",         {"id", "measurement", "timeStamp"},         SQLMemberQ[{1, 2}, SQLColumn["id"]]     ]      But I cannot seem to find an option to insert the `ORDER BY` requirement.


How to differentiate between formatted and unformatted strings?

StringQ returns True both for unformatted and internally formatted strings. To get True only for unformatted ones I have thought up the following function stringQ. Please, can you point out pitfalls, if any ? Thanks!               stringQ[str_] := Module[{ret, subStr},         subStr = "\!\(\*\nStyleBox[\"";         ret = Quiet[                 If[                 StringQ[str] && StringFreeQ[str, subStr]                 ,True, False, False                 ]             ];         Return[ret];     ];


Simplify DSolve solutions (all roots are known)

I have problem how to present the solution of the system of two differential equations in the form as in the case of one differential equation if I know the nature of roots. For example                DSolve[a y1''''[x] + b1 y1''[x] + k0 y1[x] == 0 ,y1[x], x]      gives the known and simple solution for the supposed                y1[x_] = A E^(s x);      with known roots                s11 = λ + I ω;      s12 = λ - I ω;           s13 = -λ + I ω;      s14 = -λ - I ω;      in this form generally (*)               y1[x] = E^(λ x) (C1 Cos[ω x] + C2 Sin[ω x]) +      E^(-λ x) (C3 Cos[ω x] + C4 Sin[ω x])      I want to simplify the solution in the above case for the system of two differential equations                DSolve[{a y1''''[x] + b1 y1''[x] + k0*(y1[x] - y2[x]) == 0,       a y2''''[x] + b2 y2''[x] + k0*(y2[x] - y1[x]) == 0}, {y1[x], y2[x]},      x]      supposing                y1[x_] = A E^(s x);      y2[x_] = B E^(s x);      Solution is long output with 8 unknown constants. Can I simplify the presentation of the solution as in example case (*) if I know that all roots are in the following form                s1 = 0;      s2 = 0;           s3 = I ω1;      s4 = -I ω1;           s5 = λ + I ω2;      s6 = λ - I ω2;           s7 = -λ + I ω2;      s8 = -λ - I ω2;


How to import a large (~50Mb) json file in mathematica

I am trying to import a 46Mb json file into mathematica (which by the way I exported using mathematica) but its failing with the following messages:               Java::pexcptn: A Java exception occurred after the result was returned to Mathematica: java.lang.OutOfMemoryError: Java heap space         at java.util.Arrays.copyOfRange(Arrays.java:3209)         at java.lang.String.<init>(String.java:216)         at java.lang.StringBuffer.toString(StringBuffer.java:585)         at org.json.JSONTokener.nextString(JSONTokener.java:250)         at org.json.JSONTokener.nextValue(JSONTokener.java:316)         at org.json.JSONObject.<init>(JSONObject.java:190)         at org.json.JSONTokener.nextValue(JSONTokener.java:319)         at org.json.JSONObject.<init>(JSONObject.java:205)         at org.json.JSONTokener.nextValue(JSONTokener.java:319)         at org.json.JSONArray.<init>(JSONArray.java:120)         at org.json.JSONTokener.nextValue(JSONTokener.java:322)         at org.json.JSONObject.<init>(JSONObject.java:205)         at org.json.JSONTokener.nextValue(JSONTokener.java:319)         at org.json.JSONArray.<init>(JSONArray.java:120)         at org.json.JSONTokener.nextValue(JSONTokener.java:322)         at System.Convert.JSONDump.jDecodeJSONString(JSONDump.java:79).      (full msg: http://i.imgur.com/RUx7ic9.png) How can I import the file? Is there another format I should use for large files in json? (I have tried .dat and other formats, but they seem to loose the json structure information) (or should I just not use json for large collections of data?)


Labeling points of intersection between plots

There are several answers where _Mathematica_ used mesh points to show graphically where curve intersections exist. For example: Marking points of intersection between two curves or Is there a better way to get the eight points of intersection? Is there a way to include the actual point values (maybe they are simply labeled as `a`, `b`, `c` ...) and then the actual value is displayed on the right of the graphic? Here is the specific example I am working.               Plot[{Cos[x],(1/2)^x},{x,-1,11},      PlotPoints->84,      MaxRecursion->9,      MeshFunctions->{Cos[#1]-(1/2)^#1&},      Mesh->{{0}},      MeshStyle->Directive[Red,PointSize[Large]]]


How can I generate this "domain coloring" plot?

I found this plot on Wikipedia: ![domain-colored plot of sine function](http://i.stack.imgur.com/GjMe4.jpg) > Domain coloring of $\sin(z)$ over $(-\pi,\pi)$ on $x$ and $y$ axes. > Brightness indicates absolute magnitude, saturation represents imaginary and > real magnitude. Despite following the link and reading the page nothing I have tried is giving me the result shown. How should this be done?


How to pick out terms in a linear equation with a positive coefficient?

Basically I have a really large output which looks like a long linear equation $AAA-BAA-CAA+DAA+...-ZZZ$ And I only am concerned about those terms that have a positive coefficient (i.e. a plus in front). The others I can ignore. How can I get mathematica to ignore those positive-coefficient terms, or at the very least order the list such that the negative coefficient terms are in the front (or back).


Can't Solve a system of differential equations, Solve takes too long

My question is probably not really interesting but I really need help on this because I won't have access to a more powerful computer. So my model contains 7 equations :               dM1dt = (1 - b1) gM M1 ((a11 p DC1/(h11 + p DC1)) + (a12 (1 - q) DC2/(h12 + (1 - q) DC2))) - dM M1;     dM2dt = (1 - b2) gM M2 ((a22 q DC2/(h22 + q DC2)) + (a21 (1 - p) DC1/(h21 + (1 - p) DC1))) - dM M2;     dZ1dt = b1 gZ M1 ((a11 p DC1/(h11 + p DC1)) + (a12 (1 - q) DC2/(h12 + (1 - q) DC2))) - dZ Z1;     dZ2dt = b2 gZ M2 ((a22 q DC2/(h22 + q DC2)) + (a21 (1 - p) DC1/(h21 + (1 - p) DC1))) - dZ Z2;     dDC1dt = 0.5 (ID + (1 - s) dM (M1 + M2) + dZ (Z1 + Z2)) + v1 SC Z1/(k1 + SC) - M1 (a11 p DC1/(h11 + p DC1)) - M2 (a21 (1 - p) DC1/(h21 + (1 - p) DC1));      dDC2dt = 0.5 (ID + (1 - s) dM (M1 + M2) + dZ (Z1 + Z2)) + v2 SC Z2/(k2 + SC) - M1 (a12 (1 - q) DC2/(h12 + (1 - q) DC2)) - M2 (a22 q DC2/(h22 + q DC2));      dSCdt = IS + s dM (M1 + M2) - v1 SC Z1/(k1 + SC) - v2 SC Z2/(k2 + SC);      And I just want Mathematica to give the equilibrium points of this system :               coex = Simplify[Solve[{dM1dt == 0, dM2dt == 0, dZ1dt == 0, dZ2dt == 0, dDC1dt == 0,dDC2dt == 0, dSCdt == 0}, {M1, M2, Z1, Z2, DC1, DC2, SC}]] // MatrixForm      It solved it almost instantaneously for a 4 equations system but it just keeps Running (I tried to leave it run for more than 1 hour) for my 7 equations system, so I can't get the results. Is there a way to simplify or divide the commands? Thanks a lot in advance.


Why the Block command does not forget the $ContextPath variable

I do not understand this behavior:               method[args_] :=         (* forget the context path *)         Block[{$ContextPath},                 (* should given nothing, right? *)              Print["cpath=", $ContextPath];                 ...      but when evaluated it gives the full context path (i.e. it does not forgets it). Why is that? This is against everything I (seem to) know about the `Block` function.


AbsoluteOptions prints error messages in V10

I am trying to use AbsoluteOptions in V10 but I am getting the Out with some errors as see in this picture: ![enter image description here](http://i.stack.imgur.com/K02jv.jpg) does anyone have same issue?


Can't find a fit for Erf

I have the following numbers               l={38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 37, 37, 37, 37, 37, 37,     37, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36,     35, 34, 34, 34, 34, 34, 33, 33, 33, 33, 33, 32, 31, 29, 29, 29, 28,     28, 28, 28, 27, 26, 25, 23, 21, 21, 16, 15, 15, 15, 11, 10, 6, 5, 4,     4, 4, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,     0, 0, 0, 0, 0, 0, 0, 0, 0}      which look like an error function. I'd like to automatically find a fit for these numbers. I tried two different approaches               Fit[l, {Erf[x], 1}, x]      and               FindFit[l, a Erf[b x - c] + d, {a, b, c, d}, x]      Both produce completely off results. As I have a lot of data lists, I'd very much appreciate to automatically find the fits for these data.


How to write series of Do[ ]'s with a single Table[ ]?

Edited to provide more information (sorry I don't know how to format matrices here) I would like to replace: m = 4;               mult[i_, j_] := mult[i, j] = (tstar[Abs[i - j]] + tstar[i + j - 2])/2     Do[pmult[j] = Sum[a[i - 1]*mult[i, j], {i, 1, m}], {j, 1, m}];      Do[pmult[j] = Expand[pmult[j]], {j, 1, m}];      Do[c[j] = {}, {j, 1, m}];      Do[Do[c[j] = Append[c[j], Coefficient[pmult[j], tstar[i], 1]], {i, 0,          m - 1}], {j, 1, m}];      q = Transpose[Table[c[i], {i, 1, m}]]      with a single `Table` function (I believe this is possible). I attempted               mult[i_, j_] := mult[i, j] = (tstar[Abs[i - j]] + tstar[i + j - 2])/2     pmult[j_] := pmult[j] = Sum[a[i - 1]*mult[i, j], {i, 1, m}];      q = Table[       Coefficient[Expand[pmult[j]], {j, 1, m}, tstar[i], 1], {j, 1, m}]      but I receive the error message               Coefficient::nonopt: Options expected (instead of 1) beyond position 3 in Coefficient[a(0) tstar(0)+a(1) tstar(1)+a(2) tstar(2)+a(3) tstar(3),1,tstar(i),1]. An option must be a rule or a list of rules. >>      The output should be               (a(0)   a(1)/2  a(2)/2  a(3)/2     a(1)    a(0)+a(2)/2 a(1)/2+a(3)/2   a(2)/2     a(2)    a(1)/2+a(3)/2   a(0)    a(1)/2     a(3)    a(2)/2  a(1)/2  a(0))      Can someone please shed some light on what I've done incorrectly? (i and j are indices) Thanks in advance!


ContourPlot or DensityPlot ColorFunction with x, y and z arguments

Is it possible to apply a color function to ContourPlot or DensityPlot that is function of x, y and z, and not simply of z? Example:               ContourPlot[Cos[x] + Cos[y], {x, 0, 4 Pi}, {y, 0, 4 Pi},       ColorFunction -> (If[#1 > 1/2, Red, White] &)]      but colored only for x > 2 Pi (obviously, there are alternative methods for this example, but typical cases are more complex)


Horizontal axis tick marks

I have a question about adjusting the number of horizontal tick marks on a 2D plot. Example: f[x_] := 4*Sin[4*x] Plot[{f[x]}, {x, -10, 10}, Ticks -> {Table[Pi n, {n, -5, 5}]}] Gives the following plot: ![enter image description here](http://i.stack.imgur.com/MTjQV.jpg) How would I go about adding more ticks so I could change the range (in terms of pi) to fractional values of pi? Say -pi/10 to pi/10 or...in increments of pi/2....or pi/4? The "Plot" command I am using is one I found from the _help_ because I couldn't figure out how to make the ticks in terms of pi. I'm still learning some of the basics, but I'm quite stuck on changing the # of ticks. Anyone have some ideas please? Thanks


Define PolyLog so that positive reals evaluate on upper edge of branch cut

Generalizing the previous question: Define Log so that negative reals evaluate on lower edge of branch For real positive values $x>1$, Mathematica's polylogarithm function `PolyLog[2,x]` yields a result whose imaginary part is negative (because it is defined to be evaluated just below the cut). for example:               In[1] := PolyLog[2, 1.6]     Out[1] = 2.41313 - 1.47656 I        In spirit of the previous question (linked above) what is the cleanest way to get Mathematica to evaluate the function just above the cut, so that I get a positive imaginary part, Desired output:               Out[1] = 2.41313 + 1.47656 I        **Edit** The `PolyLog` appears inside the definition of a larger function that I am using. I need to use this function for both analytic and numeric purposes. I should be able to evaluate it numerically, and also be able to differentiate it without giving a lot of non-analytic garbage associated with the deserved change. Is there anything I can do so that I get both properties?


Using Show to place a ParametricPlot on a LogLog scale

I wish to have a few plots on the same graph: ListLogLogPlot, LogLogPlot and a ParametricPlot drawing lines perpendicular to the x-axis. The problem is however that ParametricPlot doesn't seem to have the LogLog equivalent, as the other Plot functions do, and Show does not combine non-LogLog plots with LogLog plots, even when they coincide, eg.:               Show[LogLogPlot[x^4, {x,10^(-10),10^10}], Plot[x^5, {x,10^(-10),10^10}]]      should theoretically show two straight lines, but shows only one. Is there a way to combine such graphics without resolving to using non-LogLog plots?


Positions of a string in a list

Sorry for the bad title..Didn't know how to describe this, feel free to change it to be more specific. I have a list in this form:               list = {"a(0)", "a(1)", "a(2)"}      Now I want the positions of all a* in the list. At first I thought this is easily done with the Position-function, but then I had some difficulties:               Position[list, "a"]      Thought this would work, but somehow I'm missing something. So..how to implement the * to give me all a's regardless of the following characters?


How to plot an inequality?

I need some help in plotting the following inequality using Mathematica: $$\frac{1+(x/100+0.1)\times y/100}{1.15+1.15\times(x/100)\times(y/100)}\geq 1$$ assuming $x,y\in \mathbb{Q}$, the set of rational numbers and $5\leq x\leq 90,\ 50\leq y \leq 650$. Copyable code for the above inequality:               (1 + (x/100 + 0.1)(y/100))/(1.15 + 1.15 (x/100)(y/100)) >= 1      I've tried the following in Maple (because it's what we had available) but it only simplifies the term and does not plot it and enclosing the inequality with `plot()` in Maple only generates errors.               assume(x, rational);     assume(y, rational);     assume(x>=5 and x<=90);     assume(y>=50 and y<=650);     (1+1*(x/100+0.1)*(y/100))/(1.15+1.15*(x/100)*(y/100))>=1;      ### Optional theoretical problem: $x$ could theoretically (not in practice) be up to $100$, but $(x/100+0.1)$ on the left side would still always max out at $1$. Should the equation be changed to $x_1$ and $x_2$ with respective limits? But those limits would only apply for $x_1$ and $90< x_2 \leq 100$.


How do I toggle between the program snippet form of a displayformula and the human readable form of the equation?

I have a DisplayFormulaNumbered cell in my Mathematica notebook. If I use the Cell | Convert To menu item to convert the cell to Standard or Traditional Form, the formula is now rendered as a program snippet. For example:               TextCell[RawBoxes[Cell[BoxData[FormBox[RowBox[{RowBox[{RowBox[{RowBox[{"L","\[CenterDot]",RowBox[{RowBox[{"I","'"}],"'"}]}],RowBox[{"(","t",")"}]}],"+",RowBox[{RowBox[{"R","\[CenterDot]",RowBox[{"I","'"}]}],RowBox[{"(","t",")"}]}],"+",RowBox[{FractionBox["1","C"],"\[CenterDot]",RowBox[{"I","(","t",")"}]}]}],"=",RowBox[{RowBox[{"V","'"}],RowBox[{"(","t",")"}]}]}],TraditionalForm]],FormatType->"TraditionalForm"]]]      Is there a way to toggle this cell to the human readable form I started with?


How do you pattern match a DataDistribution

I have a function,               f[dist_, samp_]:=somework[dist, samp]      that I want to return `Null` or zero if passed a null distribution. I can't find a way to test for a difference between `Null` and Data distribution: none of `===`, `=!=`, `SameQ` and `==` can identify them. How can I tell if I'm being passed a `Null` value to handle it correctly?               f[dist_, samp_]:=something[dist, samp] /; TrueQ[dist==DataDistribution]      Seems to be close to what I want. EDIT: Edited for some clarity. Here's my function. If probKern is a Null, I want to return a Null, otherwise, I want to calculate the PDF for the sample, with the distribution. I can't quite get a handle on matching the types to make this work though.               calcPDF[probKern_, samp_] :=       Null /; TrueQ[probKern != DataDistribution]          calcPDF[probKern_Symbol, samp_] :=       PDF[probKern, samp] /; TrueQ[probKern == DataDistribution]      edit: Okay, I'm still having trouble with this. Here's what I have:               calcPDF[probKern_DataDistribution, samp_] := PDF[probKern, samp]       calcPDF[Except[_DataDistribution, probkern_?DistributionParameterQ], samp_] := -1      calcPDF[_] := $Failed      Given a data distribution and a value it works fine.               In[38]:= calcPDF[data, 3]          Out[38]= 0.007500611755      Given two numbers, it produces the symbolic value, rather than the -1 I was expect. (The -1 is just a placeholder)               In[39]:= calcPDF[3, 3]          Out[39]= calcPDF[3, 3]      EDIT dec 5th: Running calcPDF by hand seems to result in correct results, but now, when it is threaded over data, the result is a single result of whatever you return in the Except case. There's two sets of distributions I'm running over the sample data, so the final result is a list of two Nulls (or -1's). If you remove the Except case, you get closer to the expected result - two lists 205 elements long, containing PDF's for entries with matching Distributions, and PDF[Null, value] for those without. I'm confused. Clear[calcPDF] (*calcPDF[probKern_, samp_]:=PDF[probKern, samp]; *) calcPDF[probKern_DataDistribution, samp_] := PDF[probKern, samp]; calcPDF[Except[ _DataDistribution], samp_ ] := Null; (* Pass a list of samples, and a list of distributions's *) applyKernel[lsamples_, kernel_] := Thread[calcPDF[kernel, lsamples]]; (* Pass a list of samples, and a list of two lists of distribution's *) predClass[samples_, kernels_] := Map[applyKernel[samples, #] &, kernels]; predPDF = predClass[predictionSamples[[1]], kernels]


Find lengths of contours in a ContourPlot

I am trying to find the lengths of different contours in the following plot: ![ContourPlot of interest!!](http://i.stack.imgur.com/6qsD1.jpg) It is a complicated piecewise function evaluated on the unit disk. I am hoping there is an easy, generalized way to numerically approximate each of the contours' lengths. Essentially, I am looking for a way to solve for the length of a homogenous equation bound by a region. Given a function `f(x,y) - f* == 0` on a region `R`, where `f*` is the value of the contour of interest, is there a way to find the length of the curve that satisfies that equation? For concreteness, the above is the `ContourPlot` of               q[r_] := Piecewise[{{25/(0.1*1), r < 0.1}, {25/r, r >= 0.1}}]     phi[r_, t_] := (Pi/2) + q[r]*t     v[r_, t_] := q[r]*r*Cos[phi[r, t]]     s[x_] := Piecewise[{{x = -1, x < 0}, {x = 1, x >= 0}}]          f[x_,y_] := s[x]*v[Sqrt[x^2 + y^2],ArcTan[y/x]/q[Sqrt[x^2 + y^2]]]      How does one numerically find the lengths of each of those contours?


Small random disturbance of a flat surface

I am trying to create an initial condition which is: `1 + 0.05 rand(x,y)` Here rand is a pseudorandom function distributed in the interval (-1,1). This surface represents a random disturbance that I would like to use as an initial condition for PDEs in `NDSolve`. I assume I am being very silly when I try to use `RandomReal[]` as my random number generator for my random disturbance. How should I proceed with this.               L = 100;     Plot3D[      1 - 0.05 (Cos[2 \[Pi] x/L] + Sin[2 \[Pi] x/L]) Cos[         2 \[Pi] y/L] RandomReal[],      {x, 0, L},      {y, 0, L}      ]      Obviously this is wrong as this still retains the underlying Cos/Sin curve. How should I go about creating a random disturbance. ## Working example:               $HistoryLength = 0;     Needs["VectorAnalysis`"]     Needs["DifferentialEquations`InterpolatingFunctionAnatomy`"];     Clear[Eq0, EvapThickFilm, h, Bo, \[Epsilon], K1, \[Delta], Bi, m, r]     Eq0[h_, {Bo_, \[Epsilon]_, K1_, \[Delta]_, Bi_, m_, r_}] := \!\(     \*SubscriptBox[\(\[PartialD]\), \(t\)]h\) +          Div[-h^3 Bo Grad[h] +            h^3 Grad[Laplacian[h]] + (\[Delta] h^3)/(Bi h + K1)^3 Grad[h] +            m (h/(K1 + Bi h))^2 Grad[h]] + \[Epsilon]/(         Bi h + K1) + (r) D[D[(h^2/(K1 + Bi h)), x] h^3, x] == 0;     SetCoordinates[Cartesian[x, y, z]];     EvapThickFilm[Bo_, \[Epsilon]_, K1_, \[Delta]_, Bi_, m_, r_] :=        Eq0[h[x, y, t], {Bo, \[Epsilon], K1, \[Delta], Bi, m, r}];     TraditionalForm[       EvapThickFilm[Bo, \[Epsilon], K1, \[Delta], Bi, m, r]];                              L = 2*92.389; TMax = 3100*100;     Off[NDSolve::mxsst];     Clear[Kvar];     Kvar[t_] :=  Piecewise[{{1, t <= 1}, {2, t > 1}}]     (*Ktemp = Array[0.001+0.001#^2&,13]*)     hSol = h /. NDSolve[{          (*Bo,\[Epsilon],K1,\[Delta],Bi,m,r*)               EvapThickFilm[0.003, 0, 1, 0, 1, 0.025, 0],          h[0, y, t] == h[L, y, t],          h[x, 0, t] == h[x, L, t],          (*h[x,y,0] == 1.1+Cos[x] Sin[2y] *)               h[x, y, 0] == BSplineFunction[RandomReal[1, {30, 30, 1}]]          },         h,         {x, 0, L},         {y, 0, L},         {t, 0, TMax},         Method -> {"BDF", "MaxDifferenceOrder" -> 1},         MaxStepFraction -> 1/50         ][[1]]      With the BSpline as suggested by Vitaliy Kaurov in the answer below, I have the following error: > NDSolve::ndnum: Encountered non-numerical value for a derivative at t == > 0.`. >> > > ReplaceAll::reps: {(h^(0,0,1))[x,y,t]-0.009 h[x,y,t]^2 > (h^(0,1,0))[x,y,t]^2-(0.05 h[x,y,t]^2 > (h^(0,1,0))[x,y,t]^2)/(1+h[x,y,t])^3+<<13>>+h[x,y,t]^3 > ((h^(0,4,0))[x,y,t]+(h^(2,2,0))[x,y,t])+3 h[x,y,t]^2 (h^(1,0,0))[x,y,t] > ((h^(1,2,0))[x,y,t]+(h^(3,0,0))[x,y,t])+h[x,y,t]^3 > ((h^(2,2,0))[x,y,t]+(h^(4,0,0))[x,y,t])==0,h[0,y,t]==h[184.778,y,t],h[<<1>>]==<<1>>,h[x,y,0]==BSplineFunction[{{0.,1.},{0.,1.}},<>]} > is neither a list of replacement rules nor a valid dispatch table, and so > cannot be used for replacing. >>


How to get StreamPlot to draw many hundreds of streamlines?

For artistic reasons, I want to draw an extremely dense `StreamPlot` with something like a thousand streamlines. I tried setting `StreamPoints -> {Automatic, d}` where $d$ is a small value specifying the minimum distance between streamlines, but after a point reducing the value of $d$ stops having an effect.               GraphicsColumn[      StreamPlot[{-1 - x^2 + y, 1 + x - y^2}, {x, -3, 3}, {y, -3, 3},          StreamPoints -> {Automatic, #}, ImageSize -> Medium] & /@ {1, 0.3,         0.1, 0.03, 0.01}]      (click for image) The same thing happens when setting `StreamPoints -> n` for increasing values of $n$, or when manually seeding hundreds of seed points; Mathematica silently refuses to plot any more streamlines. How can I get around this? Is it possible to plot arbitrarily closely spaced streamlines using `StreamPlot`? **Update:** To clarify, I want to keep the style of the fully-automatic default `StreamPlot`, which attempts to maintain a uniform spacing between streamlines, and just make it denser. So I don't want to get rid of the minimum distance entirely; I just want to lower it. To save everyone some time, here is what I find unsatisfactory about all the documented settings for `StreamPoints`.   * `None`: Obviously no good.   * $n$: Stops having an effect somewhere between 50 and 100.   * `Automatic`, `Coarse`, and `Fine`: Not dense enough.   * `{p1, p2, ...}` and `{{p1, g1}, ...}`: See `n`.   * `{spec, d}`: `d` stops having an effect somewhere between 0.2 and 0.1.   * `{spec, {dStart, dEnd}}`: Strangely, increasing `dEnd` plots _more_ streamlines. Compare `{Automatic, {0.5, 10}}` with `{Automatic, 0.5}` and `{Automatic, {0.5, 0.5}}`. I don't understand this setting at all.   * `{spec, d, len}`: When `spec` is `Automatic`, `len` has no effect as far as I can tell. On the other hand, when `spec` is `{p1, p2, ...}`, `len` causes `d` to be ignored completely.


Embed a Microsoft RichEdit 8 control in a Mathematica notebook using .NETLink?

Does anyone know whether or not it's possible to embed a RichEdit 8 control within a Mathematica Notebook using .NETLink? The goal here would be able to both view and edit mathematical text typeset using Microsoft Word 2013 from within a Mathematica notebook. More background on the development of mathematical typesetting capabilities in Microsoft Office (and the RichEdit control) is available here: Murray Sargent's blog


solve an integral equation numerically

I am trying to find a numerical solution for an equation of the form: $$ f(t)=\int_{t_{min}}^{t} {\exp[2 (t^\prime - t)] E(t^\prime) f(t^\prime)} \+ \int_{t}^{0}{ \exp(t^\prime - t) E(t^\prime) f(t^\prime)} $$ where $E$ is the complete elliptic integral of the first kind and $t_{min}$ can be in principle any negative integer. I have tried `NIntegrate` and some iteration but didn't get me too far... can anyone help me with a better idea? Thank you very much for your help!!!


Adding ContourLabels changes contour colors?

I have an array `s5` I want to plot using `ListContourPlot`               s5 = Import[       "https://github.com/downloads/stackmma/Attachments/data_13545.m"];     ListContourPlot[s5, InterpolationOrder -> 6, ColorFunction -> "TemperatureMap",          ContourLabels -> True, ColorFunctionScaling -> True]      ![Mathematica graphic with labels](http://i.stack.imgur.com/ZmGGp.png) Note, the blue spot in the corner. Turning off `ContourLabels` gives               ListContourPlot[s5, InterpolationOrder -> 6, ColorFunction -> "TemperatureMap",        ContourLabels -> False, ColorFunctionScaling -> True]       ![Mathematica graphics](http://i.stack.imgur.com/OoQpV.png) The resulting images have entriely different colors. I cannot understand why adding `ContourLabels` should change the colors, and for other data sets it seems to not do that. I ended up using a workaround that involved making one of the pictures mostly transparent and overlaying it with a picture that had the right colors. This I think is actually the simplest workaround proposed so far:               wl = ListContourPlot[s5, InterpolationOrder -> 6,      ColorFunction -> (Append[ColorData["TemperatureMap"][#1], 0] &),      ContourLabels -> True, Contours -> contours];          nl = ListContourPlot[s5, InterpolationOrder -> 6,      ColorFunction -> "TemperatureMap", Contours -> contours];     Show[nl,wl]


Converting a matlab program into Mathematica 10

I sought help from this entry at Calling MATLAB from Mathematica to see if I could CONVERT a mathlab program which simulates polymer dynamics that is provided at the download section at http://tx.technion.ac.il/~yoniw/CompPhysProjectHtml/PolymerSimProject.htm#_Toc353147515 into a mathematica-10 code. Any ideas as to how the conversion can be done? The origin program simulates the behaviour of chained polymer placed in a solvent of interacting particles, and employs dissipative particle dynamics. There is a linear search via parallel computing. Not clear how this can be implemented in MMA.


How to display cell groups in documentation pages

I recently introduced my WildCats package in the Meta Thread What third-party packages do you use? and @Szabolcs promptly observed that:   "I noticed that there are many cell groups in the documentation that are collapsed. The documentation browser doesn't display cell brackets so it's a little difficult to expand them (I used the Ctrl-' shortcut)." Indeed I like to close all section groups in the tutorial pages so - upon opening the doc window - the user can immediately see the summarized full contents of the (often long) tutorial. This is much better than having to scroll through a long doc page in search of the relevant piece of information. But then the question is: how do we open these closed section groups, given that documentation pages do not display (section) cell brackets? One solution, although not very user-friendly, was already suggested by Szabolcs: use the Ctrl-' shortcut. But there are better ones! and since they do not seem to be very well-known, I thought of posting this question and my suggested solution


Is it safe to change the value of $TimeZone?

I'd like to configure some of my notebooks to assume all calculations using dates, times and locations (notably `AstronomicalData` , but others too) take place at the Greenwich Observatory. I know I can achieve this by unprotecting `$TimeZone` and setting it to `0`, as with                   $GeoLocation = {51.476786, 0.00000000};         Unprotect[$TimeZone];         $TimeZone = 0;         Protect[$TimeZone];      but worry that this might have some other consequences that would confuse date and time functions. Is it safe to do this? Does changing the value of `$TimeZone` have side effects I should avoid?


When are `If`, `Piecewise`, `Switch`, and `Which` interchangeable and when are they not?

Experimenting with joint dependent distributions via the `TransformedDistribution` function, I used the following to derive a distribution where the second variate is distributed dependent on the value of the first variate (very simplified & contrived example follows).               distA = TransformedDistribution[{b,         If[b == 1, d1, d2]}, {b \[Distributed]          DiscreteUniformDistribution[{1, 2}],        d1 \[Distributed] UniformDistribution[{1, 2}],        d2 \[Distributed] UniformDistribution[{2, 3}]}]               distB = TransformedDistribution[{b,         Piecewise[{{d1, b == 1}, {d2, b == 2}}]}, {b \[Distributed]          DiscreteUniformDistribution[{1, 2}],        d1 \[Distributed] UniformDistribution[{1, 2}],        d2 \[Distributed] UniformDistribution[{2, 3}]}]          distC = TransformedDistribution[{b,         Switch[b, 1, d1, 2, d2]}, {b \[Distributed]          DiscreteUniformDistribution[{1, 2}],        d1 \[Distributed] UniformDistribution[{1, 2}],        d2 \[Distributed] UniformDistribution[{2, 3}]}]          distD = TransformedDistribution[{b,         Which[b == 1, d1, b == 2, d2]}, {b \[Distributed]          DiscreteUniformDistribution[{1, 2}],        d1 \[Distributed] UniformDistribution[{1, 2}],        d2 \[Distributed] UniformDistribution[{2, 3}]}]      The first two behave as I'd expect: `Mean, Var, RandomVariate` all do what they're supposed to. The latter two, while behaving as expected for the _simple_ probability functions (e.g. `Mean`), puke on any attempt to sample with `RandomVariate`, with the message > TransformedDistribution::nnbprm: The valid numeric parameters of > distribution > TransformedDistribution[{\FormalX]1,Switch[\FormalX]1,1,\FormalX]2,2,\FormalX]3]},\FormalX]1,\FormalX]2,\FormalX]3}\Distributed]ProductDistribution[DiscreteUniformDistribution[{1,2}],UniformDistribution[{1,2}],UniformDistribution[{2,3}]]] > are expected. Use DistributionParameterAssumptions to obtain the parameter > assumptions. >> I'm a bit puzzled by this, seems the forms in this case should result in equivalent behavior. Any insights?


Re[x] vs. x ∈ Reals in the context of Assuming

Let's say that $x$ is some real valued number $>0$.   Are the following commands interchangeable in the context of using `Assuming`?   1. `Assuming[{Re[x] > 0}, Integrate[...,x]]`   2. `Assuming[{x ∈ Reals && x > 0}, Integrate[...,x]]` Or, as I suspect, is this not true for the reason that `Re[x] > 0` should just mean that the Real component of $x$ is $>0$? Also, is there a way to more compactly specify `{x ∈ Reals && x > 0}`?


Suspend computation so it can be resumed even after the PC is rebooted

Sometimes a computation takes a long time. But when I sleep in the night, I want to shutdown my PC. Next morning when I wake, I want to start _Mathematica_ and resume the computation. If you are familiar with the virtual machine `VMWare`, what I am looking for is a feature like `VMWare`'s `suspend/resume`. Does _Mathematica_ have such a feature?


Plotting time data with axes labels and point labels

I am trying to create a set of commands to automatically create clinical lab value plots. Using time is my major issue here. It is hard to dynamically reference the different point positions to include their labels. The value of each point located directly above it if possible. These values are located at value[i]. What I currently have ![Current Output](http://i.stack.imgur.com/e2O51.jpg) Would I would like roughly ![Desired](http://i.stack.imgur.com/TwIjV.jpg)               (* {{year,month,day,hour,minute},value}  *)     data = {        {{2014, 1, 20, 17, 42}, 6.84},        {{2014, 1, 20, 22, 33}, 5.87},        {{2014, 1, 21, 6, 30}, 4.7}        };          (* Effects the look of plot *)     min = 4;                                                              \           (* Minimum Stable level *)     max = 11;                                                             \         (* Maximum Stable level*)     Title = "WBC Count";                                    (* Label of \     Plot *)     taxis = "Time";                                                 (* \     Label of time axis *)     yaxis = "k/\[Mu]L";                                                (* \     Label of measured axis *)     tend = 20;                                                   (* make \     very large, defines how long the time for the min/max range is *)          RotationDegree = 0;                                    (* Rotate the \     labels by \[Theta] *)     Plotmin = 0;                                                     (* \     Minimum value to display *)     Plotmaxadd = 1;          times = Table[0, {i, Length[data]}];     Do[times[[i]] =        DateString[        data[[i, 1]], {"Month", "/", "Day", " ", "Hour", ":",          "Minute"}], {i, Length[data]}]     value = Table[0, {i, Length[data]}];     Do[value[[i]] = data[[i, 2]], {i, Length[data]}]     a = With[{labels =           Rotate[DateString@#, RotationDegree/180*\[Pi]] & /@ times},         ListPlot[data[[All, 2]], Mesh -> All,          MeshStyle -> PointSize[Large], Joined -> True,          PlotRange -> {Plotmin,            Max[Max[data[[All, 2]] + Plotmaxadd] + Plotmaxadd,             max + Plotmaxadd]},          PlotLabel -> Style[Row@{Title}, FontSize -> 18],          PlotStyle -> {Thick}, Frame -> True,          FrameTicks -> {Transpose[{Range@Length@labels, labels}],            Automatic}, FrameLabel -> (Style[#, 18] & /@ {taxis, yaxis})]];     b = Plot[{min, max}, {t, 0, tend},         PlotStyle -> {{Thick, Red}, {Thick, Green}},         Filling -> {1 -> {{2}, RGBColor[.4, 1, .4, .2]}}];     c = Show[a, b]      **Current Results:** What I currently have ![enter image description here](http://i.stack.imgur.com/ySqia.jpg)               (* Type of Date and units *)     Title = "Platelets";                                        (* Label \     of Plot *)     taxis = "Time";                                                     (* \     Label of time axis *)     yaxis = "k/\[Mu]L";                                                   \       (* Label of measured axis *)     (* {{year,month,day,hour,minute},value}  *)     data = {        {{2014, 1, 20, 17, 42}, 139},        {{2014, 1, 20, 22, 33}, 123},        {{2014, 1, 21, 6, 30}, 126}        };     (* Effects the look of plot *)     dateplotbegin = {2014, 1, 20, 16,         0};(* Time to begin showing extreme values *)     dateplotend = {2014, 1, 21, 7,         10};     (* Time to end showing extreme values *)     min = 150;                                                            \      (* Minimum Stable level *)     max = 450;                                                            \           (* Maximum Stable level*)     plotmin =        0;                                                             (* \     Minimum Value to plot *)     plotmax =        600;                                                       (* Max \     value from the highest value to plot, might need tweeking based on \     lab*)          (* Font Sizes *)     TitleFont = 24;     AxesFont = 24;     PointFont = 20;     TickFont = 12;     (* Plotting, no need to touch this *)     dlp[u_, dmn_, dmx_, plotmin_, plotmax_, min_, max_,        opts : OptionsPattern[]] :=       DateListPlot[u, GridLines -> {None, {min, max}},        FilterRules[{opts}, Options[DateListPlot]],        PlotRange -> {{dmn, dmx}, {plotmin, plotmax}}, Joined -> True,        Epilog -> {{Opacity[0.5], RGBColor[.4, 1, .4, .2],           Polygon[{{dmn, min}, {dmx, min}, {dmx, max}, {dmn,              max}}]}, (Text[             Style[#[[2]], FontSize -> PointFont], {1, 1.1} #] & /@ u)},        BaseStyle -> {FontFamily -> "Times", TickFont},        FrameLabel -> (Style[#, AxesFont] & /@ {taxis, yaxis})]     dlp[data, dateplotbegin, dateplotend, plotmin, plotmax, min, max,        PlotMarkers -> {Automatic, 8},        GridLinesStyle -> Directive[Red, Thick],        PlotLabel -> Style[Row@{Title}, FontSize -> TitleFont],        PlotStyle -> {Thick},       FrameTicks -> {{Automatic, None}, {data[[All, 1]], None}},        DateTicksFormat -> {"Month", "/", "Day", "\n", "Hour", ":",          "Minute"}];     plot = Show[%, ImageSize -> {644, 385}, AspectRatio -> Full]


Clustering a bivariate data set with Mathematica

I need to partition a bivariate data set into predetermined "n" clusters and, at the same time, to fix the centroid position of each cluster. Is the `ClusteringComponents` function useful? Thanks BR for your help. I will use your example to explain better my question I want to Split your “data” into two (n=2) clusters. Previously, I want to fix the coordinate (centroids) of the two clusters.               data = With[{\[Rho] = -0.4},      RandomVariate[BinormalDistribution[{-1, 1}, {1, 2}, \[Rho]], 10000]];          FIXEDcentroids = {{-2, 0}, {0.5, -0.4}};          Show[ListPlot[data, Frame -> True, Axes -> False],      ListPlot[FIXEDcentroids, Frame -> True, PlotStyle -> {Black, PointSize[0.02]}]]       The next step should be to "force" the clustering process to split the “data” set according the position of the two predefined centroids. If I use the `FindCluster` traditional form:               NumberOfCluster = 2;     clusterdata = FindClusters[data, NumberOfCluster];      I obtained two new centroids.               centroidFindClusters = Mean[#] & /@ clusterdata      Obviously the two new centroids are differents from those that I preselected (i.e. FIXEDcentroids). Therefore I am not able to solve my problem.... ...if were possible to write: `FindClusters[data, FIXEDcentroids]` it would be perfect......


Symbolic integration fails while numerical integration succeeds

I am hoping to evaluate the following integral               Integrate[((r^3 - 7)^(2/3)*(1 - (r^3 - 7)^(2/3)/r^2))/r^3, {r, 2, Infinity}]      but Mathematica informs me that this integral "does not converge on {2,$\infty$}." However, the numerical integration command               NIntegrate[((r^3 - 7)^(2/3)*(1 - (r^3 - 7)^(2/3)/r^2))/r^3, {r, 2, Infinity}]      yields `0.139837` without mention of any difficulties. Which should I believe?


Count sublists which match pattern

I have a list which looks like this: `data={{12,0},{0,0},{20,1},{0,0}, {0,-1}}`. Now I would like to count the number of sublists which:   * have both slots zero   * the first slot zero and the second not   * the second slot zero and the first not   * the first slot < 10 and any the second zero


I don't understand ListCorrelate!

I want to solve a PDE equation (like Schrodinger equation) using finite difference in Mathematica. I don't understand what this code does!               ListCorrelate[{1, -2, 1}/Subscript[h, n]^2,        U[t], {1, 2}, {Subscript[u, n - 1][t]}]/8      Anyone can help me? What does `{1, 2}` mean? and what's the role of `{Subscript[u, n - 1][t]}` ?


BaseStyle ->AbsoluteThickness[somenumber] doesn't work in version 10?

Users of version 9 might be surprised by this outcome:               Plot[{Sin[x], Cos[x]}, {x, 0, 5}, BaseStyle -> AbsoluteThickness[5]]      ![enter image description here](http://i.stack.imgur.com/0GheD.png) It seems that `BaseStyle->AbsoluteThickness[whatever]` doesn't work anymore. How can one fix this?


Set form of all output to InputForm

I try to interact with mathematica using MathLink for symbolic computations. By default it returns strings such as `2\012-1 + E\012-------\012 3\012 E` if the input is `Integrate[Exp[-x],{x,1,3}]`. For better usability I would like it to print all output in `InputForm` which I could achieve by wrapping all input by a `InputForm[]` command (would this be bullet-proof for all possible input?). However it would be more elegant if I could define this once for all at the beginning of a session. Is there a way to do this? Furthermore the output seems to include the `Out[#]` labels which I know from Notebook files. I would prefer to suppress it as well. Obviously I could do it by cutting it manually from the returned string but there might be an elegant solution as well.


How to convert equation to vector (matrix) form?

How can I **convert** expression `a1*u1+a2*u2+a3*u3` to the vector form of dot product `A.U`, where `A={a1,a2,a3}` and `U={u1,u2,u3}`?


ParametricNDSolve: Fails to differentiate an matrix differential equation

It seems like there is a problem with differentiating a ParametricNDSolve object when the underlying system contains an matrix differential equation. Create a simple ParametricNDSolveValue object which returns x[2], depending on parameter k.               pfun1 = ParametricNDSolveValue[{x'[t] == -k*x[t], x[0] == 10}, x[2], {t, 0, 10}, k]     ParametricFunction[SequenceForm["<", ">"]]      Now we have the same system but we add a matrix differential equation independent of the state `x[t]`. Here `P[t]` should be zero for all t due to the inital condition.               pfun2 = ParametricNDSolveValue[{x'[t] == -k*x[t], x[0] == 10,      P'[t] == P[t], P[0] == {{0, 0}, {0, 0}}}, x[2], {t, 0, 10}, k]     ParametricFunction[SequenceForm["<", ">"]]      We can take out the values for `k=0.4`.               pfun1[0.4]     pfun2[0.4]     4.49329     4.49329      Now we differentiate the systems and take out the value for `k=0.4`.               pfun1'[0.4]     pfun2'[0.4]     -8.98658     Thread::tdlen: Objects of unequal length in {{0.},{0.},{0.},{0.},{0.}}+{{0.},{-10.}} cannot be combined. >>*     Experimental`NumericalFunction::nlnum1: The function value {{{0.},{-10.}}+{{0.},{0.},{0.},{0.},{0.}}} is not a list of numbers with dimensions {5} when the arguments are {0.,{0.,0.,0.,0.,10.},{0.4},{{0.},{0.},{0.},{0.},{0.}}}.      The derivative of the ParametricNDSolveValue object seems to fail when there is a matrix differential equation in the system. Is this a bug?


How to save the results in an identical Excel file (.xls) in each iteration of a Do loop

Assume the following code (Below code is just an example to clearly illustrate my problem):               Res = {};     Iterations = 5;          Do[     Results = AppendTo[Res, i^2]     , {i, 1, Iterations}];      I have 2 questions:   1. I want to save the results in each iteration in an identical excel file (.xls file). In the end, when the iterations are finished, I will have one Excel file with all the results in it.   2. I tried to make the code more faster and elegant using `Scan[]` , but I failed to do it and I couldn't do that.(It is good to mention that I am just a rookie _Mathematica_ programmer and I don't have much experience in it!). Could you please help me with these poroblems ?


Exporting lists to files

I am trying to write a program which will generate a list of objects and then exports it in a separate file and clears its memory. As an example I tried the following               Do[{Subscript[l, p] = Table[Subscript[l, p, i], {i, 10}];       Export["\!\(\*SubscriptBox[\"l\", \"p\"]\).mnaz",         Compress[Subscript[l, p]], "String"]; Clear[Subscript[l, p]]}, {p,        1, 3}]      Of course, the above is just a sample (and my actual list(s) are more bulky (actually they are list of matrices)), but I hope it explains the spirit. I wanted to export each list separately so that I can get separate files like `l_1.mnaz`, `l_2.mnaz` etc., which I can import again by using the same type of code. **Motivation** : I need to actually generate a huge list of data. However whatever I do, my system goes out of memory after 5000 loops, which itself takes a lot of time. One reason is that, I need to modify the list at each loop. It seems 1000 loops takes a reasonable time. Hence I am trying to break the loop into smaller chunks, export the data, and clear the memory for the next loop. `Clear[Subscript[l, p]]` is used for that purpose.


Is it safe to use older version subkernels with a newer version main kernel?

At the moment we only have access to version 8 of the Lightweight Grid (i.e. version 8 of the Mathematica kernel). Is it safe to run version 8 subkernels together with a version 9 main kernel? It does appear to work, but I am not sure if things can go wrong in unexpected ways. (For safety I use a v8 main kernel for these calculations, but I since everything seems to work with a v9 main kernel as well, I was curious if this is actually supported.)


Loop in solving multiple matrix calculation

I am wondering is there a way to use loop, like `Do`, `For`, to rewrite the last line in the code. I tried to use `Do` to make this work, but mathematica keeps telling me that "svars will be suppressed during this calculation". I want to do the loop way, not the `Table` way i used below, because `Tabel` gives me a really ugly format of eigenvector. ![enter image description here](http://i.stack.imgur.com/S1rv2.jpg) ![enter image description here](http://i.stack.imgur.com/Lygo1.jpg) ![enter image description here](http://i.stack.imgur.com/nu0LW.jpg)               Remove["Global`*"]          Nmax = 4;          T = 1/2 Sum[m[i] x[i]'[t]^2, {i, 1, Nmax}];     U = 1/2 Sum[k[i] (x[i][t] - x[i - 1][t])^2, {i, 1, Nmax + 1}];     L = T - U;          EL[q_] := D[L, q] - D[D[L, D[q, t]], t]          eigen = Table[EL[x[i][t]], {i, 1, Nmax}];          x[i_][t_] = a[i] E^(I \[Omega] t);          sim = eigen /. t -> 0;     x[0][t] = 0;     x[Nmax + 1][t] = 0;          For[i = 1, i <= Nmax + 1, i++, m[i] = m; k[i] = k; m[5] = 0]          matrix = D[sim, {Array[a, Nmax]}];          Print["\nThe reduced eigenmatrix looks like ", matrix // MatrixForm]          soln = \[Omega] /. Solve[Det[matrix] == 0, \[Omega]];          eigenval = Pick[soln, Resolve[ForAll[{k, m}, k > 0 && m > 0, Positive[#]]] & /@ soln];          Do[Print["\n\nThe positive eigenfrequencies we computed are " \[Omega][i] , " = ", eigenval[[i]]], {i, 4}]          b = Table[a[i], {i, Nmax}];          Table[Solve[matrix.b == 0 /. \[Omega] -> eigenval[[i]], b], {i, 1,Nmax}]


Creating Optimal "Smoothed" Contour-Type Plots (X,Y,Z) Using Mathematica 8.04

### Update: data here Here is a contour plot produced in the SAS program: ![enter image description here](http://i.stack.imgur.com/Km8Yc.png) In this plot, variable 23405 forms the X axis, variable 20201 forms the Y axis, and outcome variable 50502 forms a pseudo Z axis via color and contour lines. As one can readily see, the red patch marks the "sweet spot" as far as combining 23405 and 20201. THE DATA: X and Y variables are continuous, with the range shown on both axes. The original Z data is continuous as well. However what is shown in the plot are not the original data. Z was "massaged" or "smoothed," based on the original Z data, so as to allow for the creation of the smooth-looking contour plot. In this sense, the surface shown itself does not pass through (precisely) the original Z points, but is an estimation. (Analagous to a single linear regression line not passing through all the data points.) This approximating process done by the particular program used (SAS vs. Mathematica vs. other) is what I'm particularly curious about. Bottom line -- will the supposed "sweet spot" arrived at be any different? Using the same data, I would like to create a similar -- or even better -- contour plot in Mathematica. At the very least, to compare it with the one from SAS, to see if the conclusions appear to be the same. There seem to be various ways of creating such plots in Mathematica, a few of the methods just recently added to the program in version 8. Some possible ways in Mathematica:   * ListContourPlot   * SmoothKernelDistribution   * SmoothDensityHistogram And other ways as well. I'm hoping someone here has had experience creating such contour plots in Mathematica, and can share insights as to which approach has worked well for him/her. Also, any added tricks or parameters needed to arrive at an optimal output?


Need help to finish this prime signature function?

I'm trying to create a prime signature for line segments.               lpfSignature[n_, k_] :=       Sort[Tally[Table[FactorInteger[m][[1, 1]], {m, n - k + 1, n }]]]     k = 10; n = k;     lpfSignature[n, k]     n = k^2;     lpfSignature[n, k]     n = k^2 + k;     lpfSignature[n, k]      $\\{\\{1,1\\},\\{2,5\\},\\{3,2\\},\\{5,1\\},\\{7,1\\}\\}$   $\\{\\{2,5\\},\\{3,2\\},\\{5,1\\},\\{7,1\\},\\{97,1\\}\\}$   $\\{\\{2,5\\},\\{3,1\\},\\{101,1\\},\\{103,1\\},\\{107,1\\},\\{109,1\\}\\}$ I want to strip the left-hand values to leave the following: $\\{1,5,2,1,1\\}$   $\\{5,2,1,1,1\\}$   $\\{5,1,1,1,1,1\\}$ How would I change the function to do this?


Version differences in Parallelize

I am having a problem which I guess is due to version difference. I have to generate a list of unitary matrices, which I can do easily. However I came to know about `Parallelize` command by which I wanted to speed the process. First the Hamiltonian (if anybody really wants to check)               X = 1/Sqrt[2] {{0, 1, 0}, {1, 0, 1}, {0, 1, 0}};     Y = I/Sqrt[2] {{0, -1, 0}, {1, 0, -1}, {0, 1, 0}};     Z = DiagonalMatrix[{1, 0, -1}];     Subscript[S, 1, x] = KroneckerProduct[X, IdentityMatrix[3], IdentityMatrix[3]];     Subscript[S, 2, x] = KroneckerProduct[IdentityMatrix[3], X, IdentityMatrix[3]];     Subscript[S, 3, x] = KroneckerProduct[IdentityMatrix[3], IdentityMatrix[3], X];     Subscript[S, 1, y] = KroneckerProduct[Y, IdentityMatrix[3], IdentityMatrix[3]];     Subscript[S, 2, y] = KroneckerProduct[IdentityMatrix[3], Y, IdentityMatrix[3]];     Subscript[S, 3, y] = KroneckerProduct[IdentityMatrix[3], IdentityMatrix[3], Y];     Subscript[S, 1, z] = KroneckerProduct[Z, IdentityMatrix[3], IdentityMatrix[3]];     Subscript[S, 2, z] =  KroneckerProduct[IdentityMatrix[3], Z, IdentityMatrix[3]];     Subscript[S, 3, z] = KroneckerProduct[IdentityMatrix[3], IdentityMatrix[3], Z];     H = Sum[Sum[(Subscript[S, i, x].Subscript[S, j, x] +            Subscript[S, i, y].Subscript[S, j, y] +            Subscript[S, i, z].Subscript[S, j, z]), {j, i + 1, 3}], {i, 1,          3}];      Now, the table               unitary = ParallelTable[Chop[N[MatrixExp[I θ H]]], {θ, 0, 1, 1/100}]; // Timing      The problem is, it is not working in _Mathematica_ 7 and gives the following errors:               MatrixExp::matsq: Argument 0 at position 1 is not a nonempty square matrix.      _Mathematica_ 8 gives result without any trouble and error! I guess it is due to some version difference. Can someone give me a workaround method for both _Mathematica_ 6 and 7? I can only use 6 for any lengthy calculation, and it seems to speed up the calculations a lot.


Solving System of Inequalities Relatively

I have been trying to figure out how to solve a system of inequalities relatively. I don't care about values, I just want all possible ordering. An example system might be:$${b > r,\; p > r,\; c - 1 = p,\; c < x,\; h > x,\; h < e, }$$ $${r < k,\; q > k,\; l - 1 = q,\; l < h,\; k > p}$$ I want to get all possible ways they could be arranged in order, satisfying the inequalities. If I am not explaining this well, please let me know, I'm not sure how to describe what I'm looking in a more mathematical way. Is there a straightforward way to do it? I tried using `Reduce` over the domain of `Integers`, but it choked. `FindInstance` was able to find a single instance, but not more than that. Edit: I tried:               FindInstance[{ b > r, p > r, c - 1 == p, c < x, h > x, h < e,                     r < k, q > k, l - 1 == q, l < h, k > p},                   { b, r, p, c, x, h, e, k, q, l}]      > >     {{b -> 0, r -> -1, p -> 0, c -> 1, x -> 2, h -> 3, e -> 4, k -> 1/2, q > -> 1, l -> 2}} >   This is basically what I'm looking for, but when I tried increasing `n`, I let it run for `5+` minutes and never got a solution. I also tried:               Reduce[{ b > r, p > r, c - 1 == p, c < x, h > x, h < e,               r < k, q > k, l - 1 == q, l < h, k > p},             {b, r, p, c, x, h, e, k, q, l}]      > >      b ∈ Reals && r < b && p > r && c == 1 + p && x > 1 + p && h > x && >      e > h && p < k < -1 + h && k < q < -1 + h && l == 1 + q >   when I tried `Reduce` over the domain `Integers`, the output was several hundred lines long. **Edit :** Sorting by the second element, the revised version is:                DeleteDuplicates[        Map[ First, Map[ SortBy[ #, Last] &,                          FindInstance[{ b > r, p > r, c - 1 == p, c < x, h > x, h < e, r < k,                                         q > k, l - 1 == q, l < h, k > p},                                         { b, r, p, c, x, h, e, k, q, l}, 10]                       ], {2}]]


How to use the Find and Replace Dialog Window?

The Find edit box in the Find and Replace Dialog Window shows a default word while opening. How do I tell it to show the word in which the mouse cursor is located in the Notebook, rather than the last word searched for? I want it to work like pressing F1 to open the right reference in Documentation Center does.


How to solve a "tensor equation"?

I am trying to solve equations which looks like this: $$ T_{ab} - T_{bc} = a_1 T_{ab} + a_2 T_{ac} + a_3 T_{bc}, $$ where $T_{xy}$ are tensors. I want to get the $a_i$'s (in this simple example $a_1=1$, $a_2=0$, $a_3=-1$). The problem is that the Mathematica solving routines (`Solve`, `LinearSolve`) divide the equation by $T_{xy}$ to obtain a solution (or solutions), which is (or some of them are), in turn, not a solution (solutions). What I tried to circumvent this problem: I know (from the construction of my equation) that all $a_i$'s are element $\\{-1,0,1\\}$. So I tried to set the domain to integers. But this gives me lots of condidtional solutions (like `if Tab=integer, then...`) which I don't want. Of course I could solve the above example equation by hand, but in the end I will need to solve a few hundred equations of this type with 70 tensors or so. Thanks in advance for any attempt to help me! Anton


Parallelization and Hadoop

The short question: Has anyone used _Mathematica_ in conjunction with Hadoop and does _Mathematica_ 's built in parallelization play well with Hadoop? The long version: So I have a _Mathematica_ program that I would like to do the following:   1. I have a kernel does some initial computations and produces some sets of equations which it outputs as context files to a bucket of some kind. The way it does this is essentially through searching a binary tree until it either a) finds a solution, b) finds a contradiction and thus prunes that branch, or c) it can't solve it for some reason.   2. I have several remote kernels running which monitor this directory and pick out context files (which are essentially sets of equations) to try and solve. If they succeed, they throw the solutions that they've found into a bucket for solutions. If they produce more equations to be solved I want them to put them into context files and put them back in the original bucket. If they fail for some reason (which is for all intents and purposes saying that the algorithm I just used to try and solve them did not work), I want them to save the context they are working on as is and put it in a separate bucket that I somehow mark "hard".   3. I want to have certain kernels which are marked to look into the "hard" bucket and try more intensive algorithms for solving them. I would like for them to do this in an "intelligent" way, whatever that ends up being.   4. I produce new sets of context files for computation by recursing further down the tree. I would like to (somehow) treat my bucket as a priority queue so that context files generated at greater depth are given priority over those closer to the root.   5. When all is said and done and I have (hopefully) produced all of the sets of solutions that I can to this system of equations, I want to have a kernel that goes through the sets of solutions and computes when they are equivalent. We (since this is certainly not a one person effort) have been looking at using the Parallelization capabilities built into Mathematica for this task. Some of the advantages to this are that when I initialize remote kernels, _Mathematica_ is supposed to have a means of making sure that the context running in that kernel has certain appropriate definitions. There are a few apparent problems we have identified: One is in handling the file distribution. Ideally we would like to make sure that two kernels are not trying to solve the equations in the same context at the same time. What also happens is that at some point all of the remote kernels are doing disk reads and writes from the same directory, which would probably be bad. Additionally, as it stands right now, the way we can think of to do this with the built in _Mathematica_ parallelization requires that all communication go through the original kernel which spawned the process. We would like to decentralize the algorithm to make it as modular as possible. Finally, not all of the problems that this software is used to solve are beyond the realm of a single kernel, however as it stands doing things in the current version using only a single kernel still requires treating the program as parallelized. I am basically familiar with Hadoop, its DFS, and the MapReduce paradigm that it uses. As I see it, steps 1-4 above could be considered as the map step of an algorithm and step 5 could be a reduce step. Additionally, the HDFS seems like it would provide a solution to the file system problems. The potential problem with hadoop is how to implement access through Mathematica. I have run across the HadoopLink (https://github.com/shadanan/HadoopLink) project, and it seems like the goal of the project could help provide some of the framework we desire. However, some of us have already done work on implementing a solution using the _Mathematica_ parallelization functions, and it is highly desirable to not have to abandon this code, especially since it's what's likely to be optimized for doing parallelization with _Mathematica_. My questions are as follows:   1. As above, has anyone had any experience with trying to get these two things to work together, and if so, was it worth it?   2. Does anyone have any experience with the HadoopLink project, and is it compatible with the _Mathematica_ parallelization? I'm emailing the github project owner, but there are also three other forks out there for the project.    3. Would this be killing a fly with a bazooka and using a 40 lb sledge where a 12oz claw hammer would do? Part of the reason for investigating this is that we anticipate having access to a moderate (few dozen) machines on which we can run kernels. On the one hand we would like to not get stuck thinking too small and having to implement something new all over again as we scale up, and on the other hand we don't want to waste time because we were trying to anticipate problems it was never reasonable to expect in the first place.   4. Is there a better way to do this? At this point, things are rather exploratory and I have no problems with taking new suggestions. Thanks!


Using ToExpression within Manipulate

I would like to use `ToExpression` (or `Symbol`) within `Manipulate`. Specifically, when running `Manipulate`, I want to build variables from strings, convert them to symbols (dynamic ones) and return values. But I guess I am missing something. Possibly very straight forward. Here's an example:               a2 = 37; (*GLOBAL*)          Manipulate[     Module[{a1 = 1, a2 = 2, a3 = 3, a4 = 4},      Column[{text, var, ToExpression[text <> ToString@var],a1}]], {{text,      "a"}, {"a", "b"}}, {var, 1, 2, 1, ControlType -> SetterBar}]      So I set a global `a2` (to visualize the effect), the rest is local and it returns: ![Manipulate 1](http://i.stack.imgur.com/dzN78.jpg)![Manipulate 2](http://i.stack.imgur.com/UUZUu.jpg) If I change to `a2`, the **global** value is retrieved in the third line, i.e. 37, see the screenshot on the right. So I think the contexts are confusing me. In order to solve my problem, here's what I tried then: I created a `Dynamic` `x`outside the `Manipulate` and well, consistently (to me), I can now use two different sliders to control the variables (both called `x`) within `Manipulate`, see here:               Column[{{Slider[Dynamic[x]], Dynamic[x]},        Manipulate[           Column[{            Style["Within Manipulate", Bold],               x, Dynamic[x],ToExpression[x], "",             Style["Context", Bold],               Context[x], Head[x],"",             Style["Converting String", Bold],               ToExpression["x"], Dynamic@ToExpression["x"],               ToExpression["Dynamic[x]", InputForm, Hold],               ToExpression["FE`x"], ToExpression["Global`x"],               ToExpression["x", InputForm, Dynamic]}],         {{x, 2.5}, 2, 3}]}]      resulting in: (note: running command in Mathematica directly returns context FE`, whereas it returns FE`Global` using export) ![Manipulate](http://i.stack.imgur.com/zKUfU.jpg) So, my question is: is there an easy way within `Manipulate` to go from strings to symbols? (outside `Manipulate`, it works just as I expect it to) Thanks in advance! **EDIT** To clarify: when I use a variable directly in `Manipualte`(such as `a1`) its (local) value is returned (i.e. `1`), if I use `ToExpression["a1"]` (i.e. from string) it retrieves the global value. And whats confusing: `ToExpression[a1]` yields local value. So the question: how to retrieve the local value of a variable in `Manipulate` when given the "name" (string) of the variable.


How to define a rule to simplify the notation for derivatives of chain rule?

Suppose that $u(x,y)$ is a function, and $x=r \cos t$, $y= r \sin t$, then we can define a new function $v(r,t):=u(x,y)$ with $x,y$ replaced by the above equations. It is quite easy to compute $v$'s derivatives, for example $\partial_{rr}v(r,t)$ can be computed in MMA as               v[r_, t_] := u[x, y] /. {x -> r Cos[t], y -> r Sin[t]}          D[v[r, t], {r, 2}] // Simplify      The output of which looks like ![enter image description here](http://i.stack.imgur.com/mhhqB.png) Then, my question is how to define a new rule, to make the output above look like: $$ \sin^2tu_{tt}+\sin(2t)u_{rt}+\cos^2tu_{rr}. $$


local logfiles for remote kernels

I'd like remote slave kernels to produce log files on my local machine, subject to the following constraints: 1) I don't want to install a distributed filesystem or do other administrative work on the remote machines. I am not their administrator. 2) I don't want to rewrite the interaction between master/slave kernels to support explicit passing of log messages. The slaves are doing long-running computations with lots of state; they need time to finish. On the other hand I need to see the log files as the computations are running. I know that it is possible to intercept a message (see here) and run a snippet of code, without disturbing the main line of computation (The answer in the link aborts the computation, but you could just as easily do something less intrusive). Is there some way, spiritually along these lines, to generate and then intercept an interprocess communication, which I can use to cause the master kernel to write log entries to files on my local machine?


How can I handle curve singularity in this NIntegrate integration?

Yesterday I asked a question about the **non converging integral**. Woods told me that it is due to the function which has a singularity along a line which passes through the integration region. (Why does this numeric integral fail to converge?) Now the question is that how can I find a correct answer for this integral? Should I eliminate these singularities from the integral bound? How can I understand it is integrable singularity and gives convergent value or not? I read **singularity handling** in documentation center, but I couldn't solve the problem using **Exclusions**.(http://reference.wolfram.com/mathematica/tutorial/NIntegrateIntegrationStrategies.html#122144792) function:                Msq2[w1_,         w2_] := (12.8228 + 10.518/(0.948338 - 2.0134 w1 - 2.0134 w2) -           6.69841/(1.72935 - 2.0134 w1 - 2.0134 w2) -           57.4434/(2.01348 - 2.0134 w1 - 2.0134 w2) -           13.4997/(3.45415 - 2.0134 w1 - 2.0134 w2) +           9.50782 (1/(-0.110612 + 2.0134 w1) +              1/(-0.110612 + 2.0134 w2)) -           82.5202 (1/(1.14046 + 2.0134 w1) + 1/(1.14046 + 2.0134 w2)))^2;      The region of the integral:               rpp = RegionPlot[        Re[r2] < mphy - w1 - w2 < Re[r1], {w1, .11, .4}, {w2, .11, .4},          BoundaryStyle -> Blue, FrameLabel -> {"w1", "w2"},         PlotRangePadding -> 0];      Where:               r1 = Sqrt[0.283 + (Sqrt[-0.018769 + w1^2] + Sqrt[-0.018769 + w2^2])^2];     r2 = Sqrt[0.283 + (Sqrt[-0.018769 + w1^2] - Sqrt[-0.018769 + w2^2])^2];     mphy = 1.007;      Integration:               NIntegrate[       Boole[Re[r2] < mphy - w1 - w2 < Re[r1]] 1/(64*Pi^3*mphy)*        Msq2[w1, w2], {w1, w1min, w1max}, {w2, w2min, w2max},        AccuracyGoal -> 14] // Chop      Where:                w1min = w2min = Min@rpp[[1, 1, All, 1]];      w1max = w2max = Max@rpp[[1, 1, All, 1]];      The green line is the singular curve which a part of it is in the integration region:               With[{sing = Solve[1/Msq2[w1, w2] == 0, {w1, w2}] /. Rule -> Equal},       Show[rpp, ContourPlot[sing, {w1, 0, 1}, {w2, 0, 1}]]]      ![enter image description here](http://i.stack.imgur.com/nLSNY.png) With the following code I can find the singular line, but I don't know how to eliminate this line from integration bound:               sing1 = Solve[         1/Msq2[w1, w2] == 0 && w1min < w1 < w1max && w2min < w2 < w2max &&           Re[r2] < mphy - w1 - w2 < Re[r1], {w1, w2}][[1, 1]] /.        Rule -> Equal      > ConditionalExpression[ w1 == 9.93345*10^-7 (474169.[VeryThinSpace]- > 1.0067*10^6 w2), 0.209029 < w2 < 0.261985]


Is it possible to model the piano key attack?

My purpose is to model the attack of a piano key. As the key is pressed a sound must be emitted. When the key is released the sound must stop with decreasing volume. I have a partial success when the time is fixed. For example, if time=2 then the following code simulates a key pressed for 2 seconds. But I don't know how to change it so that the sound stops (with a "natural feeling") immediately after the key is released!               Button[Graphics[{White, Rectangle[{0, 0}, {1, 2}]}],           EmitSound[SampledSoundList[{{0.}}, 8000], "Preemptive"]; EmitSound[            Play[(1 - E^(-30 t)) (1 - E^(-18 (time - t)))  Sin[           2 Pi 440  t], {t, 0, time}]       ]      ]


Can BoxWhiskerChart show both the median and outliers at the same time?

Is there an easy way to make `BoxWhiskerChart` show both the outliers and the median line? `g1` below shows outliers but not the median line, and `g2` shows the median line but not the outliers.               data = RandomReal[NormalDistribution[0, 1], 100];     g1 = BoxWhiskerChart[data, "Outliers"]     g2 = BoxWhiskerChart[data]      That is, can `BoxWhiskerChart` make a boxplot in the style of `BoxWhiskerPlot`?               Needs["StatisticalPlots`"]     data = RandomVariate[StudentTDistribution[5], 100];     BoxWhiskerPlot[data, BoxOutliers -> Automatic]      Thanks!


Followup question from "Temporarily redirect output of Print[ ] to a second file

I'm implementing the first answer to my earlier question about redirecting the output of Print[ ]. Opening a file with `OpenWrite[]` and assigning the stream to `$Output` seems to work satisfactorily. However, `Close[]` gives the error message shown below, and doesn't close the file. Does anyone know what's wrong? (Print statements and other code goes between opening the output stream and attempting to close it) ![enter image description here](http://i.stack.imgur.com/dwPTz.jpg)


Reassign Functions for Graphic Representation

How might I construct a function of the form `Rep[defs,code]`, `graphic[code]` and `display[code]` Such that the following outputs can occur?               Rep[      y[a__] := Graphics[{Circle[],         Inset[          graphic[a]          , Scaled[{0.498, 0.5020000000000002}], Center,           Scaled[{0.5, 0.5}]]}, ImagePadding -> 0,        PlotRangePadding -> 0];      Times[a_, b_] := Graphics[{RGBColor[1, 0, 0], Rectangle[{0, 0}],         Black, Inset[          display[a*b]          , Scaled[{0.498, 0.5020000000000002}], Center, Scaled[{0.5, 0.5}]]         }, ImagePadding -> 0, ImageSize -> {85., Automatic},         PlotRangePadding -> 0];      , graphic[y[y[a*b]]]      ]      ![enter image description here](http://i.stack.imgur.com/Yb2sq.png)               Rep[       Sum[f_, {i_, max_}] :=       Graphics[{Circle[],         Inset[          Sum[f, {i, max}]          , Scaled[{0.498, 0.5020000000000002}], Center,          Scaled[{0.5, 0.5}]]}, ImagePadding -> 0,        PlotRangePadding -> 0],      graphic[Sum[x^2 , {x, 10}]]      ]      ![enter image description here](http://i.stack.imgur.com/RDXQb.png) Here is my current attempt of creating `Rep[funs,code]`. The biggest problem that I have currently, is that I am trying to define custom functions on top of System attributes(`Times` & `Plus`). In addition I was originally going to add a namespace `Gr` to the passed in variables but I feel that there is likely a better way. Questions are welcome around the current implementation or a slightly better/different implementation. My question: **How can I construct the functions above such that they satisfy the graphic outputs?**


About Argument of complex numbers

Suppose my `z = x + iy` Now, if `y=0`, then `z = x` i.e it becomes a real number So, logically `Arg[z]` should be equal to zero for this case. If I assign the numeric value for `x`, then `Arg[z]` produces zero in _Mathematica_ easily. But if I do not assign the numeric value for `x` which is of course a real number always, then how to produce `Arg[z]=0` for this case ? Because assigning or not assigning numeric value to `x` should not prevent Argument of `z` to be zero i.e `Arg[z]=0`. Actually, my computation involves variables only i.e algebraic expressions, no numeric calculations. The final _Mathematica_ output has a term `Arg[r]`. The parameter `r` , radius, is always real. So, _Mathematica_ should understand that as `r` is always real number, so `Arg[r]` should be zero. Please guide me how to achieve this. (Pranjol Paul, Department of Mechanical Engineering, Indian Institute of Technology Guwahati, Assam, India)


Looking for a way to insert multiple elements into multiple positions simultaneously in a list

I would like to take the following data:               insertvalues = {r, x};     insertpositions = {{1}, {5}};     origlist = {a, b, c, d, e, f, g};      and generate output that looks like this:               {r,a,b,c,d,x,e,f,g}      Mathematica's `Insert` command seems limited in that it does not allow you to insert multiple elements simultaneously into different positions in a list. I wrote an ugly While loop to accomplish this, and it works, but seems inappropriate for Mathematica's functional approach to coding. Is there a "simpler" way to accomplish this goal with a functional approach? Thank you.               insertvalues = {r, x};     insertpositions = {{1}, {5}};     origlist = {a, b, c, d, e, f, g};          loopcounter = 0; poscounter = 0; final = origlist;     While[loopcounter < Length[insertvalues],       final =         Insert[final,          insertvalues[[loopcounter +             1]], (insertpositions[[loopcounter + 1]] + poscounter)];        loopcounter++; poscounter++];


Generating pairs of additive and multiplicative factors for integers

Given an integer $n$, I want to get two lists: > a) the set of pairs of the divsors $a,b$ into exactly two factors $n=a\cdot > b$, > > b) the set of pairs $a,b$ of two summands $n=a+b$. The code I came up with works, but I'd like to know if there is a more efficient/elegant or even build in alternative:                 Function[ int, {#,int/#}& /@ Divisors[int]][12]            Function[ int, {#,int-#}& /@ Range[int -1]][12]      Also, in case I want to do that later, how do I eliminate lists from a list, which only differ in order, e.g. how do I reduce `{{a,b},{b,a}}` to `{{a,b}}` ? (Side note: These problems arise in writing the code for this bigger problem)


Demonstrate aliasing effect in sound

I'm trying to demonstrate the aliasing effect using sound, that is, when the sample rate is fixed and the sound frequency is increased, we would hear the sound pitch go down when we pass the Nyquist frequency. Here is what I tried so far:               Manipulate[      EmitSound[       Play[Sin[ω* t], {t, 0, 0.2}, SampleRate -> 900]], {ω, 200, 6000, 10}]          Manipulate[      EmitSound[       Play[Sin[ω* t], {t, 0, 0.2}, SampleRate -> 8000]], {ω,200, 6000, 10}]      Question: The sound is a little bit lag to the slider. Is it possible to create a more responsive one like this               Manipulate[EmitSound[Sound[SoundNote[n, 3]]], {n, 1, 10, 1}]


Command line execution of Mathematica notebooks and conversion to .m

Sometimes one may want to execute a notebook via the command line (for example to run it remotely). As far as I know it's not possible to run notebooks directly, but `.m` files can be executed, typically with code like               math -noprompt -run "<<file.m"      So one needs to convert `.nb` to `.m`. One way to do this is to save the `.nb` as a Mathematica package and then to convert all cells to initialization cells. However, this conversion handles some of the typography (e.g. subscripts) improperly. Is there a less error-prone way to do this? * * * Edit: Examples for things that don't convert: Subscript part notation (`Ctrl+_+[[part]]`) The corresponding `FullForm` is `Part[list,n]`, the converted expression is `Subscript[list, [[n]]]`.


Different MeshStyle for different functions

By using `Plot` command I want to get one curve in form if circles and other like a solid line.               Plot[{Cos[x], Sin[x]}, {x, 0, 2 Pi},           PlotStyle -> {Opacity[0]}, Mesh -> 30, MeshStyle -> {PointSize[Large], Blue}]      ![enter image description here](http://i.stack.imgur.com/Iy7S4.jpg)


Example of Integrate applying a numerical evaluation N

Here is a minimal example:               Integrate[(a[1] + x)^2, {x, 1., 2.}]      > >     2.33333 + 3. a[1.] + 1. a[1.]^2 >   The problem is that `a[1]` has been turned into `a[1.]`, which is essentially different. A stranger result can be generated from               Integrate[(a[1] + x)^2, {x, 1., b}]      > >     -0.333333 + 0.333333 b^3 + 1. b^2 a[1] + 1. b a[1]^2 + 0.333333 a[1]^3 - >     1. a[1.] - 1. a[1.]^2 - 0.333333 a[1.]^3 >   That is, part of the result uses `a[1]` and another part uses `a[1.]`. Question: how to stop this behaviour and why is it happening?


How to convolve a Unit function (like "UnitTriangle") with a InterpolatedFunction

Recently discovered what `InterpolatingFunction`'s are in _Mathematica_...really amazing/useful. As I understand it, it's basically a curve fitter....sorta. So how would I use _Convolve_ with a unit triangle or some other analytical- esque function, to convolve over a _InterpolatingFunction_?? ![](http://i.stack.imgur.com/UafNj.png) In the image, the red triangle is `UnitTriangle[x]` (well, it's height and width are off, but you get the gist of it). So ideallly, I'd like to do something like `Convolve[ UnitTriangle[x], InterpolatedFunction, ?, ?]` But that won't work of course, since I don't know what the domains are (hence the ? ?) for the interpolated function.


Permuting indices to form fully symmetric tensor with repeated indices

I have written a function (version 8) that takes as an input a list of indices such as `{i,j,k}` and outputs a fully symmetric tensor function containing $p_i$ and $g_{ij}$ ($g_{ij}$ is itself understood to be symmetric under $i\leftrightarrow j$).               myFunc[tensorList_?ListQ] := Module[{rank = Length[tensorList], perms, i, j, k, r},       perms = Select[Permutations[tensorList, {rank}], Signature[#] == 1 &];            Return[Sum[If[rank <= 1, 1, 2^(1 - r)/(r! (rank - 2 r)!)]*         Factor[Sum[           Product[Subscript[p, perms[[i]][[j]]],             {j, 1, rank - 2 r}]            Product[Subscript[g, Times @@ perms[[i]][[2 k - 1 ;; 2 k]]],             {k, rank/2 - r + 1, rank/2}], {i, 1, Max[1, rank!/2]}]]          f[2 r, rank], {r, 0, rank/2}]]     ]      Example of usage: `myFunc[{i}]` returns $f[0, 1]p_i$ `myFunc[{i,j}]` returns $f[2, 2]g_{ij}+f[0,2]p_i p_j$. etc. **Problem:** My function only works when all elements of input list have unique names like `{i,j,k}`. I don't know how to modify it so that it can accept lists like `{i,j,j}`. for example, I'd like `myFunc[{i,i}]` to return $f[2,2]\,g_{i^2}+f[0,2]p_i p_i$. _and yes, I know that I'm multiplying indices of g, which I'd like to keep._ Any hints please? (and any pointers on ethics of function construction would be nice!)


How do you decompose a polynomial matrix into its matrix coefficients?

Let's say I have a matrix, $\mathbf{M}$, that is polynomially dependent on a single variable, such as               M = {{15 + a^2, a + 5 a^2}, {a - 5 a^2, 2}}      and I want to find the individual matrices, $\mathbf{A}_i$, such that $$\mathbf{M} = \mathbf{A}_0 + a \mathbf{A}_1 + a^2 \mathbf{A}_2 + \ldots$$ How do I do this? What do I use if there are multiple variables? Also, can I specify that certain symbols are not to be treated in this manner, e.g.               M = {{15 + a^2, a + 5 a^2}, {a - 5 a^2, 2 c}}      where the constant matrix would be `{{15, 0}, {0, 2 c}}`? Ideally, this should be applicable to vectors and tensors, also.


Redefine ArcCot to be inverse of range [0, Pi]

Mathematica implements `ArcCot` function as an inverse to `Cot` on range `[-Pi/2, Pi/2]`. I personally prefer the other definition (as it's used in courses I attend). Is it possible to redefine the function? Current implementation: ![range -Pi/2 to Pi/2](http://i.stack.imgur.com/Jr8Jc.gif) My prefered implementation: ![range 0 to Pi](http://i.stack.imgur.com/Z5vfv.gif) (images taken from http://intmstat.com/blog/2011/04/cotx_2.gif)


Web Browser Screen Shot

I have Safari, Opera, Chrome, Firefox and IE installed how might a get a browser screen shot of a set of HTML code from inside Mathematica(for any of those browsers)? ![enter image description here](http://i.stack.imgur.com/441Lu.png) (Image is optional) The shortest/leanest/fastest approach(within reason) is ideal. For example: Waiting for a website to serve a screen shot is to long. The solution should be local.                screenshot["<!doctype html><i>Italicized text</i>"]      screenshot["http://example.com"]      Possible ideas: SWT, HTMLunit ,http://watin.org/, Selenium (fairly certain Selenium will work with right install and code).


What summations can Mathematica do?

I was very pleased to discover that _Mathematica_ could do this summation and produce a symbolic result.               s1 =        1/nn Sum[Cos[2 π a (n - 1)] E^(-I (n - 1) (s - 1)/nn), {n, nn}] // Simplify      The answer is long but very useful for me. I also discovered that Mathematica could do some variants of this sum. However, _Mathematica_ cannot do this summation.               s2 =        1/nn Sum[              Cos[2 π ((a - ϵ) (n - 1) + ϵ/(nn - 1) (n - 1)^2)] E^(-I (n - 1) (s - 1)/nn),               {n, nn}]      This leads to the big question what summations can Mathematica do? Help suggest that "Sum can do essentially all sums that are given in standard books of tables". Is my sum s2 in some way pathological that it cannot be done? My second question is thus can my second sum be coerced into a solution? These sums come from Fourier analysis, where it is useful to have a symbolic expression for results that are often calculated numerically using the discrete Fourier transform (`Fourier` in _Mathematica_ ). In order to investigate my sum, I looked at the continuous Fourier transform in which time is equal to n -1 and frequency is (s - 1)/nn. The continuous Fourier transform is given by the integral               1/t2 Integrate[Cos[2 π ( (a - ϵ) t + ϵ/t2 t^2)] E^(-I 2 π f t), {t, 0, t2}]      _Mathematica_ can do this integral which comes out in terms of error functions. However, I can't see how to use this to help get the symbolic solution to the sum s2. In summary what summations can _Mathematica_ do? Is there any hope for getting an closed-form solution for my second sum?


Laplace: from differential equation to transfer function

First at all, this is trictly related to my own question: How to transform transfer functions into differential equations? How can I transfer my differential equation into a transfer function? For me (at the moment) the following works:               TimeDomain2TransferFunction[eqn_, y0_, u0_] :=      Solve[         LaplaceTransform[eqn, t, s] /. y0 /.            u0 /. {LaplaceTransform[y[t], t, s] -> Y[s],            LaplaceTransform[u[t], t, s] -> U[s]}         , Y[s]][[1, 1, 2]]/U[s]      So, let's say the differential equation is               sysEq = y'''[t] == -1/T2^2 y'[t] - T1/T2^2 y''[t] + Ki/T2^2 u[t]      Then the following gives me an satisfying result:               TimeDomain2TransferFunction[sysEq, {y[0] -> 0, y'[0] -> 0,        y''[0] -> 0}, {}]     ExpandDenominator[%]      Out: $\frac{\text{Ki}}{s \left(s^2 \text{T2}^2+s \text{T1}+1\right)}$ Out: $\frac{\text{Ki}}{s^3 \text{T2}^2+s^2 \text{T1}+s}$ Is there a more elegant way to do this? For example, for different letters (not only y and u).