Removing of artificial sampling step effects

Look at this plot, it represents an underground interface between two formations, this interface should dip very gently left-downward, all the steps are artificial effects due to sampling. The natural slope of this curve is very important to me, for example, if a seismic ray happens to incident at the joint of step, then the refection path is totally wrong. I have tried methods of spline interpolation, moving average, etc, somehow I am not satisfactory with the results, some methods alter the general location of the curve. It might be better to let the end points of the curve be fixed. It might work if I resample the data, but it takes too much efforts and you may need to resample differently for different interface curves. Could someone show me how to efficiently get rid of these step artificials? Data is attached below (two interfaces, if you method works on both interfaces, then it works). Thanks a lot! ( _Note: both the horizontal and vertical sampling interval is 20 feet, the general slope of this interface should be about 1 degree, but at the steps, the slope is about 45 degree!_ ) ![enter image description here](http://i.stack.imgur.com/2utW5.png)               curve1={{62700,-2460},{62720,-2460},{62740,-2460},{62760,-2460},{62780,-2460},{62800,-2460},{62820,-2460},{62840,-2460},{62860,-2460},{62880,-2460},{62900,-2460},{62920,-2460},{62940,-2460},{62960,-2460},{62980,-2460},{63000,-2460},{63020,-2460},{63040,-2460},{63060,-2460},{63080,-2460},{63100,-2460},{63120,-2460},{63140,-2460},{63160,-2460},{63180,-2460},{63200,-2440},{63220,-2440},{63240,-2440},{63260,-2440},{63280,-2440},{63300,-2440},{63320,-2440},{63340,-2440},{63360,-2440},{63380,-2440},{63400,-2440},{63420,-2440},{63440,-2440},{63460,-2440},{63480,-2440},{63500,-2440},{63520,-2440},{63540,-2440},{63560,-2440},{63580,-2440},{63600,-2440},{63620,-2440},{63640,-2440},{63660,-2440},{63680,-2440},{63700,-2440},{63720,-2440},{63740,-2440},{63760,-2440},{63780,-2440},{63800,-2440},{63820,-2440},{63840,-2440},{63860,-2420},{63880,-2420},{63900,-2420},{63920,-2420},{63940,-2420},{63960,-2420},{63980,-2420},{64000,-2420},{64020,-2420},{64040,-2420},{64060,-2420},{64080,-2420},{64100,-2420},{64120,-2420},{64140,-2420},{64160,-2420},{64180,-2420},{64200,-2420},{64220,-2420},{64240,-2420},{64260,-2420},{64280,-2420},{64300,-2420},{64320,-2420},{64340,-2420},{64360,-2420},{64380,-2420},{64400,-2420},{64420,-2420},{64440,-2400},{64460,-2400},{64480,-2400},{64500,-2400},{64520,-2400},{64540,-2400},{64560,-2400},{64580,-2400},{64600,-2400},{64620,-2400},{64640,-2400},{64660,-2400},{64680,-2400},{64700,-2400},{64720,-2400},{64740,-2400},{64760,-2400},{64780,-2400},{64800,-2400},{64820,-2400},{64840,-2400},{64860,-2400},{64880,-2400},{64900,-2400},{64920,-2400},{64940,-2400},{64960,-2400},{64980,-2400},{65000,-2400},{65020,-2380},{65040,-2380},{65060,-2380},{65080,-2380},{65100,-2380},{65120,-2380},{65140,-2380},{65160,-2380},{65180,-2380},{65200,-2380},{65220,-2380},{65240,-2380},{65260,-2380},{65280,-2380},{65300,-2380},{65320,-2380},{65340,-2380},{65360,-2380},{65380,-2380},{65400,-2380},{65420,-2380},{65440,-2380},{65460,-2380},{65480,-2380},{65500,-2380},{65520,-2380},{65540,-2380},{65560,-2380},{65580,-2380},{65600,-2360},{65620,-2360},{65640,-2360},{65660,-2360},{65680,-2360},{65700,-2360},{65720,-2360},{65740,-2360},{65760,-2360},{65780,-2360},{65800,-2360},{65820,-2360},{65840,-2360},{65860,-2360},{65880,-2360},{65900,-2360},{65920,-2360},{65940,-2360},{65960,-2360},{65980,-2360},{66000,-2360},{66020,-2360},{66040,-2360},{66060,-2360},{66080,-2360},{66100,-2360},{66120,-2360},{66140,-2360},{66160,-2360},{66180,-2360},{66200,-2360},{66220,-2340},{66240,-2340},{66260,-2340},{66280,-2340},{66300,-2340},{66320,-2340},{66340,-2340},{66360,-2340},{66380,-2340},{66400,-2340},{66420,-2340},{66440,-2340},{66460,-2340},{66480,-2340},{66500,-2340},{66520,-2340},{66540,-2340},{66560,-2340},{66580,-2340},{66600,-2340},{66620,-2340},{66640,-2340},{66660,-2340},{66680,-2340},{66700,-2340},{66720,-2340},{66740,-2340},{66760,-2340},{66780,-2340},{66800,-2340},{66820,-2340},{66840,-2340},{66860,-2320},{66880,-2320},{66900,-2320},{66920,-2320},{66940,-2320},{66960,-2320},{66980,-2320},{67000,-2320},{67020,-2320},{67040,-2320},{67060,-2320},{67080,-2320},{67100,-2320},{67120,-2320},{67140,-2320},{67160,-2320},{67180,-2320},{67200,-2320},{67220,-2320},{67240,-2320},{67260,-2320},{67280,-2320},{67300,-2320},{67320,-2320},{67340,-2320},{67360,-2320},{67380,-2320},{67400,-2320},{67420,-2320},{67440,-2320},{67460,-2320},{67480,-2320},{67500,-2300},{67520,-2300},{67540,-2300},{67560,-2300},{67580,-2300},{67600,-2300},{67620,-2300},{67640,-2300},{67660,-2300},{67680,-2300},{67700,-2300},{67720,-2300},{67740,-2300},{67760,-2300},{67780,-2300},{67800,-2300},{67820,-2300},{67840,-2300},{67860,-2300},{67880,-2300},{67900,-2300},{67920,-2300},{67940,-2300},{67960,-2300},{67980,-2300},{68000,-2300},{68020,-2300},{68040,-2300},{68060,-2300},{68080,-2300},{68100,-2300},{68120,-2300},{68140,-2280},{68160,-2280},{68180,-2280},{68200,-2280},{68220,-2280},{68240,-2280},{68260,-2280},{68280,-2280},{68300,-2280},{68320,-2280},{68340,-2280},{68360,-2280},{68380,-2280},{68400,-2280},{68420,-2280},{68440,-2280},{68460,-2280},{68480,-2280},{68500,-2280},{68520,-2280},{68540,-2280},{68560,-2280},{68580,-2280},{68600,-2280},{68620,-2280},{68640,-2280},{68660,-2280},{68680,-2280},{68700,-2280},{68720,-2280},{68740,-2280},{68760,-2280},{68780,-2260},{68800,-2260},{68820,-2260},{68840,-2260},{68860,-2260},{68880,-2260},{68900,-2260},{68920,-2260},{68940,-2260},{68960,-2260},{68980,-2260},{69000,-2260},{69020,-2260},{69040,-2260},{69060,-2260},{69080,-2260},{69100,-2260},{69120,-2260},{69140,-2260},{69160,-2260},{69180,-2260},{69200,-2260},{69220,-2260},{69240,-2260},{69260,-2260},{69280,-2260},{69300,-2260},{69320,-2260},{69340,-2260},{69360,-2260},{69380,-2260},{69400,-2260},{69420,-2260},{69440,-2260},{69460,-2260},{69480,-2260},{69500,-2260},{69520,-2260},{69540,-2260},{69560,-2260},{69580,-2260},{69600,-2260},{69620,-2260},{69640,-2260},{69660,-2260},{69680,-2260},{69700,-2260},{69720,-2240},{69740,-2240},{69760,-2240},{69780,-2240},{69800,-2240},{69820,-2240},{69840,-2240},{69860,-2240},{69880,-2240},{69900,-2240},{69920,-2240},{69940,-2240},{69960,-2240},{69980,-2240},{70000,-2240},{70020,-2240},{70040,-2240},{70060,-2240},{70080,-2240},{70100,-2240},{70120,-2240},{70140,-2240},{70160,-2240},{70180,-2240},{70200,-2240},{70220,-2240},{70240,-2240},{70260,-2240},{70280,-2240},{70300,-2240},{70320,-2240},{70340,-2240},{70360,-2240},{70380,-2240},{70400,-2240},{70420,-2240},{70440,-2240},{70460,-2240},{70480,-2240},{70500,-2240},{70520,-2240},{70540,-2240},{70560,-2240},{70580,-2240},{70600,-2240},{70620,-2240},{70640,-2240},{70660,-2240},{70680,-2240},{70700,-2240},{70720,-2240},{70740,-2240},{70760,-2240},{70780,-2240},{70800,-2240},{70820,-2240},{70840,-2240},{70860,-2240},{70880,-2240},{70900,-2240},{70920,-2240},{70940,-2240},{70960,-2240},{70980,-2240},{71000,-2240},{71020,-2240},{71040,-2240},{71060,-2240},{71080,-2240},{71100,-2240},{71120,-2240},{71140,-2240},{71160,-2240},{71180,-2240},{71200,-2240},{71220,-2240},{71240,-2240},{71260,-2240},{71280,-2240},{71300,-2240},{71320,-2240},{71340,-2240},{71360,-2240},{71380,-2240},{71400,-2240},{71420,-2240},{71440,-2240},{71460,-2240},{71480,-2240},{71500,-2240},{71520,-2240},{71540,-2240},{71560,-2240},{71580,-2240},{71600,-2240},{71620,-2240},{71640,-2240},{71660,-2240},{71680,-2240},{71700,-2240},{71720,-2240},{71740,-2240},{71760,-2240},{71780,-2240},{71800,-2240},{71820,-2240},{71840,-2240},{71860,-2240},{71880,-2240},{71900,-2240},{71920,-2240},{71940,-2240},{71960,-2240},{71980,-2240},{72000,-2240},{72020,-2240},{72040,-2240},{72060,-2240},{72080,-2240},{72100,-2240},{72120,-2240},{72140,-2240},{72160,-2240},{72180,-2240},{72200,-2240},{72220,-2240},{72240,-2240},{72260,-2240},{72280,-2240},{72300,-2240},{72320,-2240},{72340,-2240}};          curve2= {{20,-27980},{80,-27980},{140,-27980},{200,-27980},{260,-27980},{320,-27980},{380,-27980},{440,-27980},{500,-27980},{560,-27980},{620,-27980},{680,-27980},{740,-27980},{800,-27980},{860,-27980},{920,-27980},{980,-27980},{1040,-27980},{1100,-27960},{1160,-27960},{1220,-27960},{1280,-27960},{1340,-27960},{1400,-27960},{1460,-27960},{1520,-27960},{1580,-27960},{1640,-27960},{1700,-27960},{1760,-27960},{1820,-27960},{1880,-27940},{1940,-27940},{2000,-27940},{2060,-27940},{2120,-27940},{2180,-27940},{2240,-27940},{2300,-27940},{2360,-27940},{2420,-27940},{2480,-27940},{2540,-27940},{2600,-27940},{2660,-27920},{2720,-27920},{2780,-27920},{2840,-27920},{2900,-27920},{2960,-27920},{3020,-27920},{3080,-27920},{3140,-27920},{3200,-27920},{3260,-27920},{3320,-27920},{3380,-27920},{3440,-27920},{3500,-27900},{3560,-27900},{3620,-27900},{3680,-27900},{3740,-27900},{3800,-27900},{3860,-27900},{3920,-27900},{3980,-27900},{4040,-27900},{4100,-27900},{4160,-27900},{4220,-27900},{4280,-27900},{4340,-27900},{4400,-27900},{4460,-27900},{4520,-27900},{4580,-27900},{4640,-27900},{4700,-27880},{4760,-27880},{4820,-27880},{4880,-27880},{4940,-27880},{5000,-27880},{5060,-27880},{5120,-27880},{5180,-27880},{5240,-27880},{5300,-27880},{5360,-27880},{5420,-27880},{5480,-27880},{5540,-27880},{5600,-27880},{5660,-27880},{5720,-27880},{5780,-27880},{5840,-27880},{5900,-27860},{5960,-27860},{6020,-27860},{6080,-27860},{6140,-27860},{6200,-27860},{6260,-27860},{6320,-27860},{6380,-27860},{6440,-27860},{6500,-27860},{6560,-27860},{6620,-27860},{6680,-27860},{6740,-27860},{6800,-27860},{6860,-27860},{6920,-27860},{6980,-27860},{7040,-27860},{7100,-27840},{7160,-27840},{7220,-27840},{7280,-27840},{7340,-27820},{7400,-27820},{7460,-27820},{7520,-27800},{7580,-27800},{7640,-27780},{7700,-27780},{7760,-27780},{7820,-27760},{7880,-27760},{7940,-27760},{8000,-27740},{8060,-27740},{8120,-27720},{8180,-27720},{8240,-27720},{8300,-27700},{8360,-27700},{8420,-27680},{8480,-27680},{8540,-27680},{8600,-27660},{8660,-27660},{8720,-27660},{8780,-27640},{8840,-27640},{8900,-27620},{8960,-27620},{9020,-27620},{9080,-27600},{9140,-27600},{9200,-27600},{9260,-27580},{9320,-27580},{9380,-27560},{9440,-27560},{9500,-27560},{9560,-27540},{9620,-27540},{9680,-27520},{9740,-27520},{9800,-27500},{9860,-27500},{9920,-27480},{9980,-27460},{10040,-27460},{10100,-27440},{10160,-27420},{10220,-27400},{10280,-27400},{10340,-27380},{10400,-27360},{10460,-27360},{10520,-27340},{10580,-27320},{10640,-27300},{10700,-27300},{10760,-27280},{10820,-27260},{10880,-27260},{10940,-27240},{11000,-27220},{11060,-27200},{11120,-27200},{11180,-27180},{11240,-27160},{11300,-27160},{11360,-27140},{11420,-27120},{11480,-27100},{11540,-27100},{11600,-27080},{11660,-27060},{11720,-27060},{11780,-27040},{11840,-27020},{11900,-27000},{11960,-27000},{12020,-26980},{12080,-26960},{12140,-26960},{12200,-26940},{12260,-26920},{12320,-26900},{12380,-26900},{12440,-26880},{12500,-26860},{12560,-26840},{12620,-26840},{12680,-26820},{12740,-26800},{12800,-26800},{12860,-26780},{12920,-26760},{12980,-26740},{13040,-26740},{13100,-26720},{13160,-26700},{13220,-26680},{13280,-26680},{13340,-26660},{13400,-26640},{13460,-26640},{13520,-26620},{13580,-26600},{13640,-26580},{13700,-26580},{13760,-26560},{13820,-26540},{13880,-26520},{13940,-26520},{14000,-26500},{14060,-26480},{14120,-26460},{14180,-26460},{14240,-26440},{14300,-26420},{14360,-26420},{14420,-26400},{14480,-26380},{14540,-26360},{14600,-26360},{14660,-26340},{14720,-26320},{14780,-26300},{14840,-26300},{14900,-26280},{14960,-26260},{15020,-26240},{15080,-26240},{15140,-26220},{15200,-26200},{15260,-26200},{15320,-26180},{15380,-26160},{15440,-26140},{15500,-26140},{15560,-26120},{15620,-26100},{15680,-26080},{15740,-26080},{15800,-26060},{15860,-26040},{15920,-26040},{15980,-26020},{16040,-26000},{16100,-25980},{16160,-25980},{16220,-25960},{16280,-25940},{16340,-25920},{16400,-25920},{16460,-25900},{16520,-25880},{16580,-25860},{16640,-25860},{16700,-25840},{16760,-25820},{16820,-25800},{16880,-25780},{16940,-25760},{17000,-25720},{17060,-25700},{17120,-25680},{17180,-25660},{17240,-25620},{17300,-25600},{17360,-25580},{17420,-25560},{17480,-25520},{17540,-25500},{17600,-25480},{17660,-25460},{17720,-25420},{17780,-25400},{17840,-25380},{17900,-25360},{17960,-25320},{18020,-25300},{18080,-25280},{18140,-25240},{18200,-25220},{18260,-25200},{18320,-25180},{18380,-25140},{18440,-25120},{18500,-25100},{18560,-25080},{18620,-25040},{18680,-25020},{18740,-25000},{18800,-24980},{18860,-24940},{18920,-24920},{18980,-24900},{19040,-24880},{19100,-24840},{19160,-24820},{19220,-24800},{19280,-24780},{19340,-24740},{19400,-24720},{19460,-24700},{19520,-24660},{19580,-24640},{19640,-24620},{19700,-24600},{19760,-24560},{19820,-24540},{19880,-24520},{19940,-24500},{20000,-24460},{20060,-24440},{20120,-24420},{20180,-24400},{20240,-24360},{20300,-24340},{20360,-24320},{20420,-24300},{20480,-24260},{20540,-24240},{20600,-24220},{20660,-24180},{20720,-24160},{20780,-24140},{20840,-24120},{20900,-24080},{20960,-24060},{21020,-24040},{21080,-24020},{21140,-23980},{21200,-23960},{21260,-23940},{21320,-23920},{21380,-23880},{21440,-23860},{21500,-23840},{21560,-23820},{21620,-23780},{21680,-23760},{21740,-23740},{21800,-23720},{21860,-23680},{21920,-23660},{21980,-23640},{22040,-23620},{22100,-23600},{22160,-23580},{22220,-23560},{22280,-23540},{22340,-23520},{22400,-23500},{22460,-23460},{22520,-23440},{22580,-23420},{22640,-23400},{22700,-23380},{22760,-23360},{22820,-23340},{22880,-23320},{22940,-23300},{23000,-23260},{23060,-23240},{23120,-23220},{23180,-23200},{23240,-23180},{23300,-23160},{23360,-23140},{23420,-23120},{23480,-23100},{23540,-23080},{23600,-23040},{23660,-23020},{23720,-23000},{23780,-22980},{23840,-22960},{23900,-22940},{23960,-22920},{24020,-22900},{24080,-22880},{24140,-22840},{24200,-22820},{24260,-22800},{24320,-22800},{24380,-22800},{24440,-22780},{24500,-22780},{24560,-22780},{24620,-22760},{24680,-22760},{24740,-22760},{24800,-22760},{24860,-22740},{24920,-22740},{24980,-22740},{25040,-22720},{25100,-22720},{25160,-22720},{25220,-22720},{25280,-22700},{25340,-22700},{25400,-22700},{25460,-22680},{25520,-22680},{25580,-22680},{25640,-22680},{25700,-22660},{25760,-22660},{25820,-22660},{25880,-22640},{25940,-22640},{26000,-22640},{26060,-22620},{26120,-22620},{26180,-22620},{26240,-22620},{26300,-22600},{26360,-22600},{26420,-22600},{26480,-22580},{26540,-22580},{26600,-22580},{26660,-22580},{26720,-22560},{26780,-22560},{26840,-22560},{26900,-22540},{26960,-22540},{27020,-22540},{27080,-22520},{27140,-22520},{27200,-22520},{27260,-22520},{27320,-22500},{27380,-22500},{27440,-22500},{27500,-22480},{27560,-22480},{27620,-22480},{27680,-22500},{27740,-22500},{27800,-22520},{27860,-22520},{27920,-22540},{27980,-22540},{28040,-22560},{28100,-22580},{28160,-22580},{28220,-22600},{28280,-22600},{28340,-22620},{28400,-22640},{28460,-22640},{28520,-22660},{28580,-22660},{28640,-22680},{28700,-22680},{28760,-22700},{28820,-22720},{28880,-22720},{28940,-22740},{29000,-22740},{29060,-22760},{29120,-22780},{29180,-22780},{29240,-22800},{29300,-22800},{29360,-22820},{29420,-22820},{29480,-22840},{29540,-22860},{29600,-22860},{29660,-22880},{29720,-22880},{29780,-22900},{29840,-22920},{29900,-22920},{29960,-22940},{30020,-22940},{30080,-22960},{30140,-22960},{30200,-22980},{30260,-23000},{30320,-23000},{30380,-23020},{30440,-23020},{30500,-23040},{30560,-23060},{30620,-23060},{30680,-23080},{30740,-23080},{30800,-23100},{30860,-23100},{30920,-23120},{30980,-23140},{31040,-23140},{31100,-23160},{31160,-23160},{31220,-23180},{31280,-23200},{31340,-23200},{31400,-23220},{31460,-23220},{31520,-23240},{31580,-23240},{31640,-23260},{31700,-23280},{31760,-23280},{31820,-23300},{31880,-23320},{31940,-23320},{32000,-23340},{32060,-23360},{32120,-23380},{32180,-23380},{32240,-23400},{32300,-23420},{32360,-23420},{32420,-23440},{32480,-23460},{32540,-23460},{32600,-23480},{32660,-23500},{32720,-23500},{32780,-23520},{32840,-23540},{32900,-23540},{32960,-23560},{33020,-23580},{33080,-23600},{33140,-23600},{33200,-23620},{33260,-23640},{33320,-23640},{33380,-23660},{33440,-23680},{33500,-23680},{33560,-23700},{33620,-23720},{33680,-23720},{33740,-23740},{33800,-23760},{33860,-23760},{33920,-23780},{33980,-23800},{34040,-23820},{34100,-23820},{34160,-23840},{34220,-23860},{34280,-23860},{34340,-23880},{34400,-23900},{34460,-23900},{34520,-23920},{34580,-23940},{34640,-23940},{34700,-23960},{34760,-23980},{34820,-23980},{34880,-24000},{34940,-24020},{35000,-24020},{35060,-24040},{35120,-24060},{35180,-24080},{35240,-24080},{35300,-24100},{35360,-24120},{35420,-24120},{35480,-24140},{35540,-24160},{35600,-24160},{35660,-24180},{35720,-24200},{35780,-24200},{35840,-24220},{35900,-24240},{35960,-24240},{36020,-24260},{36080,-24280},{36140,-24300},{36200,-24300},{36260,-24320},{36320,-24340},{36380,-24340},{36440,-24360},{36500,-24380},{36560,-24380},{36620,-24400},{36680,-24420},{36740,-24420},{36800,-24440},{36860,-24460},{36920,-24480},{36980,-24500},{37040,-24520},{37100,-24520},{37160,-24540},{37220,-24560},{37280,-24580},{37340,-24600},{37400,-24620},{37460,-24640},{37520,-24640},{37580,-24660},{37640,-24680},{37700,-24700},{37760,-24720},{37820,-24740},{37880,-24760},{37940,-24760},{38000,-24780},{38060,-24800},{38120,-24820},{38180,-24840},{38240,-24860},{38300,-24880},{38360,-24880},{38420,-24900},{38480,-24920},{38540,-24940},{38600,-24960},{38660,-24980},{38720,-25000},{38780,-25000},{38840,-25020},{38900,-25040},{38960,-25040},{39020,-25060},{39080,-25060},{39140,-25080},{39200,-25100},{39260,-25100},{39320,-25120},{39380,-25120},{39440,-25140},{39500,-25140},{39560,-25160},{39620,-25160},{39680,-25180},{39740,-25180},{39800,-25200},{39860,-25200},{39920,-25220},{39980,-25220},{40040,-25240},{40100,-25240},{40160,-25260},{40220,-25260},{40280,-25280},{40340,-25280},{40400,-25300},{40460,-25300},{40520,-25320},{40580,-25340},{40640,-25340},{40700,-25360},{40760,-25360},{40820,-25380},{40880,-25380},{40940,-25400},{41000,-25400},{41060,-25420},{41120,-25420},{41180,-25440},{41240,-25440},{41300,-25460},{41360,-25460},{41420,-25480},{41480,-25480},{41540,-25500},{41600,-25500},{41660,-25520},{41720,-25520},{41780,-25540},{41840,-25540},{41900,-25560},{41960,-25580},{42020,-25580},{42080,-25600},{42140,-25600},{42200,-25620},{42260,-25620},{42320,-25640},{42380,-25640},{42440,-25660},{42500,-25660},{42560,-25680},{42620,-25680},{42680,-25700},{42740,-25700},{42800,-25720},{42860,-25720},{42920,-25740},{42980,-25740},{43040,-25760},{43100,-25780},{43160,-25780},{43220,-25800},{43280,-25800},{43340,-25820},{43400,-25840},{43460,-25840},{43520,-25860},{43580,-25860},{43640,-25880},{43700,-25880},{43760,-25900},{43820,-25920},{43880,-25920},{43940,-25940},{44000,-25940},{44060,-25960},{44120,-25960},{44180,-25980},{44240,-26000},{44300,-26000},{44360,-26020},{44420,-26020},{44480,-26040},{44540,-26040},{44600,-26060},{44660,-26080},{44720,-26080},{44780,-26100},{44840,-26100},{44900,-26120},{44960,-26120},{45020,-26140},{45080,-26160},{45140,-26160},{45200,-26180},{45260,-26180},{45320,-26200},{45380,-26200},{45440,-26220},{45500,-26240},{45560,-26240},{45620,-26260},{45680,-26260},{45740,-26280},{45800,-26280},{45860,-26280},{45920,-26280},{45980,-26280},{46040,-26300},{46100,-26300},{46160,-26300},{46220,-26300},{46280,-26300},{46340,-26300},{46400,-26300},{46460,-26320},{46520,-26320},{46580,-26320},{46640,-26320},{46700,-26320},{46760,-26320},{46820,-26320},{46880,-26340},{46940,-26340},{47000,-26340},{47060,-26340},{47120,-26340},{47180,-26340},{47240,-26360},{47300,-26360},{47360,-26360},{47420,-26360},{47480,-26380},{47540,-26380},{47600,-26380},{47660,-26400},{47720,-26400},{47780,-26400},{47840,-26400},{47900,-26420},{47960,-26420},{48020,-26420},{48080,-26420},{48140,-26440},{48200,-26440},{48260,-26440},{48320,-26440},{48380,-26460},{48440,-26460},{48500,-26460},{48560,-26460},{48620,-26480},{48680,-26480},{48740,-26480},{48800,-26500},{48860,-26500},{48920,-26500},{48980,-26500},{49040,-26520},{49100,-26520},{49160,-26520},{49220,-26520},{49280,-26540},{49340,-26540},{49400,-26540},{49460,-26540},{49520,-26560},{49580,-26560},{49640,-26560},{49700,-26560},{49760,-26580},{49820,-26580},{49880,-26580},{49940,-26600},{50000,-26600},{50060,-26600},{50120,-26600},{50180,-26620},{50240,-26620},{50300,-26620},{50360,-26620},{50420,-26640},{50480,-26640},{50540,-26640},{50600,-26640},{50660,-26660},{50720,-26660},{50780,-26660},{50840,-26680},{50900,-26680},{50960,-26680},{51020,-26680},{51080,-26700},{51140,-26700},{51200,-26700},{51260,-26700},{51320,-26720},{51380,-26720},{51440,-26720},{51500,-26720},{51560,-26740},{51620,-26740},{51680,-26740},{51740,-26740},{51800,-26740},{51860,-26740},{51920,-26740},{51980,-26740},{52040,-26740},{52100,-26740},{52160,-26740},{52220,-26740},{52280,-26740},{52340,-26740},{52400,-26740},{52460,-26740},{52520,-26740},{52580,-26740},{52640,-26740},{52700,-26740},{52760,-26740},{52820,-26740},{52880,-26740},{52940,-26740},{53000,-26740},{53060,-26740},{53120,-26740},{53180,-26740},{53240,-26740},{53300,-26740},{53360,-26740},{53420,-26760},{53480,-26760},{53540,-26760},{53600,-26760},{53660,-26760},{53720,-26760},{53780,-26760},{53840,-26760},{53900,-26760},{53960,-26780},{54020,-26780},{54080,-26780},{54140,-26780},{54200,-26780},{54260,-26780},{54320,-26780},{54380,-26780},{54440,-26800},{54500,-26800},{54560,-26800},{54620,-26800},{54680,-26800},{54740,-26800},{54800,-26800},{54860,-26800},{54920,-26820},{54980,-26820},{55040,-26820},{55100,-26820},{55160,-26820},{55220,-26820},{55280,-26820},{55340,-26820},{55400,-26820},{55460,-26840},{55520,-26840},{55580,-26840},{55640,-26840},{55700,-26840},{55760,-26840},{55820,-26840},{55880,-26840},{55940,-26860},{56000,-26860},{56060,-26860},{56120,-26860},{56180,-26860},{56240,-26860},{56300,-26860},{56360,-26860},{56420,-26860},{56480,-26860},{56540,-26860},{56600,-26860},{56660,-26840},{56720,-26840},{56780,-26840},{56840,-26840},{56900,-26840},{56960,-26840},{57020,-26840},{57080,-26820},{57140,-26820},{57200,-26820},{57260,-26820},{57320,-26820},{57380,-26820},{57440,-26820},{57500,-26800},{57560,-26800},{57620,-26800},{57680,-26800},{57740,-26800},{57800,-26800},{57860,-26800},{57920,-26780},{57980,-26780},{58040,-26780},{58100,-26780},{58160,-26780},{58220,-26780},{58280,-26760},{58340,-26760},{58400,-26760},{58460,-26760},{58520,-26760},{58580,-26760},{58640,-26760},{58700,-26740},{58760,-26740},{58820,-26740},{58880,-26740},{58940,-26740},{59000,-26740},{59060,-26740},{59120,-26720},{59180,-26720},{59240,-26720},{59300,-26720},{59360,-26720},{59420,-26720},{59480,-26720},{59540,-26700},{59600,-26700},{59660,-26700},{59720,-26700},{59780,-26700},{59840,-26700},{59900,-26700},{59960,-26680},{60020,-26680},{60080,-26680},{60140,-26680},{60200,-26680},{60260,-26680},{60320,-26680},{60380,-26660},{60440,-26660},{60500,-26660},{60560,-26640},{60620,-26640},{60680,-26640},{60740,-26640},{60800,-26620},{60860,-26620},{60920,-26620},{60980,-26600},{61040,-26600},{61100,-26600},{61160,-26600},{61220,-26580},{61280,-26580},{61340,-26580},{61400,-26580},{61460,-26560},{61520,-26560},{61580,-26560},{61640,-26540},{61700,-26540},{61760,-26540},{61820,-26540},{61880,-26520},{61940,-26520},{62000,-26520},{62060,-26500},{62120,-26500},{62180,-26500},{62240,-26500},{62300,-26480},{62360,-26480},{62420,-26480},{62480,-26480},{62540,-26460},{62600,-26460},{62660,-26460},{62720,-26440},{62780,-26440},{62840,-26440},{62900,-26440},{62960,-26420},{63020,-26420},{63080,-26420},{63140,-26400},{63200,-26400},{63260,-26400},{63320,-26400},{63380,-26380},{63440,-26380},{63500,-26380},{63560,-26360},{63620,-26360},{63680,-26360},{63740,-26360},{63800,-26340},{63860,-26340},{63920,-26320},{63980,-26320},{64040,-26300},{64100,-26280},{64160,-26280},{64220,-26260},{64280,-26240},{64340,-26240},{64400,-26220},{64460,-26200},{64520,-26180},{64580,-26180},{64640,-26160},{64700,-26140},{64760,-26140},{64820,-26120},{64880,-26100},{64940,-26100},{65000,-26080},{65060,-26060},{65120,-26060},{65180,-26040},{65240,-26020},{65300,-26000},{65360,-26000},{65420,-25980},{65480,-25960},{65540,-25960},{65600,-25940},{65660,-25920},{65720,-25920},{65780,-25900},{65840,-25880},{65900,-25880},{65960,-25860},{66020,-25840},{66080,-25820},{66140,-25820},{66200,-25800},{66260,-25780},{66320,-25780},{66380,-25760},{66440,-25740},{66500,-25740},{66560,-25720},{66620,-25700},{66680,-25700},{66740,-25680},{66800,-25680},{66860,-25660},{66920,-25660},{66980,-25640},{67040,-25640},{67100,-25640},{67160,-25620},{67220,-25620},{67280,-25600},{67340,-25600},{67400,-25580},{67460,-25580},{67520,-25580},{67580,-25580},{67640,-25580},{67700,-25560},{67760,-25560},{67820,-25560},{67880,-25560},{67940,-25560},{68000,-25560},{68060,-25560},{68120,-25540},{68180,-25540},{68240,-25540},{68300,-25540},{68360,-25540},{68420,-25540},{68480,-25540},{68540,-25520},{68600,-25520},{68660,-25520},{68720,-25520},{68780,-25520},{68840,-25520},{68900,-25520},{68960,-25500},{69020,-25500},{69080,-25500},{69140,-25500},{69200,-25500},{69260,-25500},{69320,-25500},{69380,-25480},{69440,-25480},{69500,-25480},{69560,-25480},{69620,-25480},{69680,-25480},{69740,-25460},{69800,-25460},{69860,-25460},{69920,-25460},{69980,-25460},{70040,-25460},{70100,-25460},{70160,-25440},{70220,-25440},{70280,-25440},{70340,-25440},{70400,-25440},{70460,-25440},{70520,-25440},{70580,-25420},{70640,-25420},{70700,-25420},{70760,-25400},{70820,-25380},{70880,-25380},{70940,-25360},{71000,-25340},{71060,-25340},{71120,-25320},{71180,-25300},{71240,-25300},{71300,-25280},{71360,-25260},{71420,-25260},{71480,-25240},{71540,-25220},{71600,-25220},{71660,-25200},{71720,-25180},{71780,-25180},{71840,-25160},{71900,-25140},{71960,-25140},{72020,-25120},{72080,-25100},{72140,-25100},{72200,-25100},{72260,-25100},{72320,-25100}};


Export to CSV is very slow - can performance be improved?

I have to provide data exports from _Mathematica_ to CSV format and it is very slow compared to other formats as can be seen in the following table:   * JSON, 15 sec, 8.4 MB    * TXT, 23 sec, 5.6 MB    * XLSX, 37 sec, 3.0 MB   * CSV, 704 sec, 4.4 MB Can somebody give me a hint on how to speed this up? Or an explanation why it is so slow?


Mathematica: Extract the piece that contains x=0 from within a piecewise function

In mathematica, I have a piecewise function similar to:               Piecewise[{ {x^2 + 2*x - 4, 0 <= x <= 1/4},                 {0, true}                    }]      I don't know how many pieces there will be, or what the internal ordering will look like, but I know that exactly one of the pieces will have `x=0` as its left endpoint. How do I extract that piece in its general form (`x^2 + 2*x - 4`) without knowing the upper end of its domain (`1/4`)?


Computational complexity of symbolic determinant

I'm using the Det function in Mathematica to compute the determinant of an $n\times n$ matrix $A$ with entries of the form $a+bt$ with $a,b$ integers and $t$ a variable, and I would like to know what the computational complexity of this function is. For a non-symbolic matrix one can find its determinant in time $O(n^3)$ by Gaussian elimination, but it seems to be more expensive to compute the determinant of my matrix $A$. Does someone know _how_ expensive?


Invisible \[Conjugate]  glyph in the linux frontend

I have a very annoying problem. The Conjugate glyph (*) does not show when I type.   That is, if I type `\[Conjugate]` or `⋮co⋮` then no character appears on the screen, although the conjugation operator is definitely there and working. I'm running Mathematica 8 under Fedora. Here's a screenshot: ![annoying bug](http://i.stack.imgur.com/FU40M.png) So far, it's the only character that I have noticed missing. Any ideas?


How to plot and find the volume of a solid?

How to plot and find the volume of the solid enclosed between the paraboloid `z=5(x^2+y^2)` and `z=6-7x^2-y^2` And the answer of the volume is `3Pi/(2)^1/2`


Is it possible to Print into a collapsable CellGroup?

During rather long computation I have intermediate steps `Print`ed with useful information which should be collected for possible use in future inside of the evaluation `Notebook`. When the computation is finished the final results are printed. But there are hundreds of intermediate `Print`s which fill the screen and contain supporting information which is interesting to see during computation but impede reading the final results. I wish to have an ability to collapse the intermediate prints in a `CellGroup`. Here is an example from the Documentation page for `EvaluationMonitor`:               FindRoot[x^2 - 2, {x, 1},       EvaluationMonitor :> Print["x = ", x " x^2 - 2 =", x^2 - 2]]      After evaluation of the above we get intermediate results in one collapsable `CellGroup` (note the collapsed cell group selected on the right): ![screenshot](http://i.stack.imgur.com/Gy1Ti.png) My problem is that my computation involves several cycles with intermediate evaluations and I am forced to `Print` the final results after a cycle is finished. So all the prints by default belong to one cell group. It can be simulated as follows:               Do[Print@FindRoot[x^a - 2, {x, 1},         EvaluationMonitor :> Print["x = ", x , ", x^", a, " - 2 = ", x^a - 2]], {a, 1, 3}]      How is it possible to have intermediate prints grouped together and collapsable?


List density plot for non-uniform data

I am trying to make a density plot to show the data that can found here. I tried with GNUplot previously. The result of GNUplot density plot for a rectangular set of data. I am able to do this only for a square (n x n) data set of the type:               x_1, y_1, z_1     ...     x_n, y_n, z_n      where n is the number of lines. The file that I post here is different. It is more similar to the one in the example from `ListLinePlot` page, which shows how to make a density plot for a spherical distribution of numbers. Now the question is: Can I make the density plot of this data set with `listdensityplot` in _Mathematica_? The 2D map of the x-y is like that ![2D map](http://i.stack.imgur.com/RA62g.png) and the ![3D map](http://i.stack.imgur.com/b15Rw.png). As You can see all the points are in particular regions of the plot. So I expect that the density map works only in this part of the space (something simliar to this link Spreading colors in ListDensityPlot)


Non commutative multiply- expand expression

I began to use Mathematica a few days. My problem is: How to expand expression like $(a+b)*(a+b)$, where this multiplication is non commutative? Mathematica can do this?


How to troubleshoot CUDALink?

This is a follow-up question from linking the libraries for CUDALlink in Ubuntu 12.10. The tests that I execute (`CUDAQ[]`, `CUDAInformation[]`, `CUDADriver[]`) seem to give successful outputs. However, when I try to execute actual CUDA commands the results are clearly wrong. For instance, `CUDATranspose[Table[i, {i, 2}, {j, 2}]]` returns                   {{140191557896416,140191327433448},{17523916273012,0}}      And the numbers change each time I execute it. I also noticed that some commands complain that CUDALink is actually not initialised, like `CUDADot[Table[i, {i, 2}, {j, 2}], Table[i, {i, 2}, {j, 2}]]`:                   CUDADot::notinit: CUDALink is not initialized      But according to `CUDAQ[]`, `CUDAInformation[]` and `CUDADriver[]` it should be. Before trying to solve the problem, how can I determine _where_ it is? Is it within Mathematica? At the NVIDIA drivers level? Does it have to do with the `gcc` version?


First positive root

Simple question but problem with `NSolve`. I need help how to extract first positive root?   For example:                eq = -70.5 + 450.33 x^2 - 25 x^4;      NSolve[ eq == 0, x]      If I have an equation `eq` that I am not sure of polynomial order and I need to define all positive roots `x[1], ..., x[2]`.


Image padding problem with transparent

I have an image that I'm trying to pad some transparent border. But I get error: "The specified padding value is not compatible with a 3-channel image."               data = Table[{45, 45, 45}, {20}, {25}];     p = Image[RawArray["Byte", data], "Byte", Rule[ColorSpace, Automatic],         Rule[Interleaving, True]];          ImagePad[p, 10, Transparent]      What does this error mean and how to solve it? **Update** If test on the documentation figure, padding transparent works even it has a Automatic color space: ![enter image description here](http://i.stack.imgur.com/fwHep.png)


An efficient way to merge a pair of 4d arrays of non regular length lists

## Question I have two 4 dimensional non regular length lists of complex values. I have working code however it seems quite slow and I am not sure how I could improve this. Mathematically I am trying to achieve a partial trace. totalSpace is the 4 dimensional array of lists, The first two parameters are two position parameters which generally range from 1 to 10, the second two variables have lengths dependent on the position variable. So we have a matrix at each position (specified by two position variables) whose dimensions depend on the position variables. Then we take two copies of totalSpace, one of which is the complex conjugate of the other. Finally we need to merge (via summation) these two lists together when the second and fourth dimensions have equivalent values.               Sum[Sum[           ArrayFlatten[Table[Table[         Flatten[Table[Table[           totalSpace[[x1a, x2, c1a, c2]]*Conjugate[totalSpace[[x1b, x2, c1b, c2]]],         {c1b, 1, LengthNode[x1b]}], {x1b, MinG, MaxG}]],       {c1a, 1, LengthNode[x1a]}],{x1a, MinG, MaxG}], 1],     {c2, 1, LengthNode[x2]}],{x2, MinG, MaxG}]      I am looking for ways to speed up this code, is there a Mathematica function which more naturally merges these lists? I have looked into Sow and Reap but I am not sure if they work for this as I really want to sum as I reap. `MinG` and `MaxG` are the minimum and maximum number for indexing a position. Normally `MinG` is just 1, however for some graphs it makes sense to have a negative indies such as for the Number line. `LengthNode` is a function which takes in a position index and returns the number of connected nodes to that node.               LengthNode[x_] := LengthNode[x] = Length[ConnectedNodes[[x]]]     MinG = Min[ConnectedNodes]     MaxG = Max[ConnectedNodes]      `ConnectedNodes` is a list storing the graph shape and is probably best explained by an example below. ## Example To make my question clearer below is a small but concrete example of what I am trying to achieve. The space we will consider has four different positions indexed from 1 to 4 (nothing to do with being 4D). How they are connected to each other is shown pictorially in the below graph. This is given below: ![Graph](http://i.stack.imgur.com/LIWt5.png) In Mathematica this is encoded as a list of nodes that the position is connected to, the data of above example is shown below.               ConnectedNodes = {{2, 3, 4}, {1}, {1}, {1}}      From this we have two quantum mechanical objects, on the graph. Ignoring the fact this should be normalised, an example of the total state space is given below.               totalSpace =     Table[Table[       Table[Table[         1,       {c2, ConnectedNodes[[x2]]}], {c1, ConnectedNodes[[x1]]}],      {x2, 1, 4}], {x1, 1, 4}]          Out: {{{{1, 1, 1}, {1, 1, 1}, {1, 1, 1}}, {{1}, {1}, {1}}, {{1}, {1}, {1}}, {{1}, {1}, {1}}}, {{{1, 1, 1}}, {{1}}, {{1}}, {{1}}}, {{{1, 1, 1}}, {{1}}, {{1}}, {{1}}}, {{{1, 1, 1}}, {{1}}, {{1}}, {{1}}}}      This means we have a 4 dimensional object called totalSpace, which is indexed as:               totalSpace[[x1,x2,c1,c2]]      Now we consider `totalSpace[[x1a,x2,c1a,c2]]` and `Conjugate[totalSpace[[x1b,x2,c1b,c2]]]`, I want to output a matrix which has every permutation of x1a, c1a in one direction and every permutation of x1b, c1b in the other direction, where we have summed over every combination of x2, c2. My code for doing this is given below:               Sum[      ArrayFlatten[Table[        Flatten[Table[          totalSpace[[x1a, x2, c1a, c2]]*Conjugate[totalSpace[[x1b, x2, c1b, c2]]],          {x1b, 1, 4}, {c1b, 1, Length[ConnectedNodes[[x1b]]]} ]],        {x1a, 1, 4}, {c1a, 1, Length[ConnectedNodes[[x1a]]]} ], 1],      {x2, 1, 4}, {c2, 1, Length[ConnectedNodes[[x2]]]} ]      When I scale my code up to larger graphs of say 10+ nodes this implementation is found to take several seconds. ## Update 1 Upon the suggestions below I have updated my code to look a bit cleaner.               Sum[        ArrayFlatten[Table[         Flatten[Table[           totalSpace[[x1a, x2, c1a, c2]]*Conjugate[totalSpace[[x1b, x2, c1b, c2]]],         {x1b, MinG, MaxG},{c1b, 1, LengthNode[x1b]}]],       {x1a, MinG, MaxG},{c1a, 1, LengthNode[x1a]}], 1],     {x2, MinG, MaxG},{c2, 1, LengthNode[x2]}]      Unfortunately I couldn't detect any real performace increase.


Network problem of visualization of vertex

I have a question about visualization of network in _Mathematica_ : for example: for this network               g = ExampleData[{"NetworkGraph", "Friendship"}];      when we calculate `ClosenessCentrality[g]` and visualize with               HighlightGraph[g, VertexList[g], VertexSize -> Thread[VertexList[g] -> Rescale[%]]]      ![Mathematica graphics](http://i.stack.imgur.com/iqjsz.png) We can not see the vertex of James. Why? The value exists and is positive.


Running unit tests while debug session is running in Workbench

Is it possible to run unit test while a debug session is already open in Wolfram Workbench 2.0? A typical use case follows: I have a debug in Workbench session open. ![enter image description here](http://i.stack.imgur.com/6GR8p.png) I evaluate some cells in a sample Notebook. Find some bugs, fix them and write the unit test. Now I would like to run the unit tests. ![enter image description here](http://i.stack.imgur.com/eApfH.png) But Workbench says ![enter image description here](http://i.stack.imgur.com/bAQav.png) If I terminate the Mathematica session, than the kernel state is lost and I have to re-evaluate all the notebook cells.


Plot a function which depends on itself

How can I plot a stepwise function like `f[a, t] = 10 Exp[-0.1 Sin[t]]` for `a > t` and `f[a, t] = f[a, t - 1] Exp[-0.1 a]` for `a < t`? If you see, for `a < t`, the function `f[a, t]` dependes on a previous value of itself.


Combining more than two lists by first column as index

Please bear with me. It might be easy but its been hard for me. I have say three lists:               list1={{1,a,aa},{2,b,bb},{3,c,cc},{4,d,dd},{5,e,ee},{6,f,ff},{7,g,gg},{8,h,hh},{9,i,ii},{10,j,jj}};          list2={{2,.2},{3,.3},{5,.5},{6,.6},{10,.1}};          list3={{1,10,100,1000},{2,20,200,2000},{5,50,500,5000},{6,60,600,6000},            {7,70,700,7000},{9,90,900,9000},{10,100,1000,10000}};      I want the final results as:               result={{2,b,bb,.2,20,200,2000},{5,e,ee,.5,50,500,5000},{6,f,ff,.6,60,600,6000},            {10,j,jj,.1,100,1000,10000}};      I have seen earlier similar question at How do I obtain an intersection of two or more list of lists conditioned on the first element of each sub-list? Thanks to Murta for his function               {#[[1,1]],#[[All,2]]}&/@Select[GatherBy[list1~Join~list2,First],Length[#]>1&]      It works pretty well to merge two lists and pretty fast. However, the final format is little different from what I want. Similarly, there is another post dealing similar issue. Combining two lists Again, thanks to VLC for his function               Join[list1, List /@ Last /@ Select[list2, MemberQ[First /@ list1, #[[1]]] &], 2]      Again, it works for two lists but pretty slow. I can not make either one to work for my purpose. Any help is greatly appreciated. Please consider seriously before putting some kind of tag like "Duplicate" etc. Please don't stop answering. This is so common question. We need varieties in answers in terms of simplicity and speed. May be we can extend answers to combine any numbers of lists not just three. Thank you.


Parameters for modelica booleanExpression?

In SystemModeler, left-hand side, Libraries > Modelica > Blocks > Examples > ShowLogicalSources, we see a diagram with several disconnected blocks: ![enter image description here](http://i.stack.imgur.com/0O1nj.png) The `booleanExpression` block contains an expression, `pulse.y and step.y`, that implicitly links it to the other blocks -- by "implicitly," I mean "without connectors drawn on the canvas surface." The documentation here states "The (time varying) Boolean output signal of this block can be defined in its parameter menu via variable y," so I go look at (what I think is) the parameter menu for that block, but there are no parameters: ![enter image description here](http://i.stack.imgur.com/1Nkg6.png) Notice that the block is properly selected in the UI (green outline). Also, I checked that the other blocks have parameters. Here are the parameters for block `step`, for instance: ![enter image description here](http://i.stack.imgur.com/CjEb6.png) What am I doing wrong? Without the ability to inspect and edit the `booleanExpression` in the block, it's pretty much useless. EDIT: I should add that I clicked every menu item, every promising-looking icon in the "component browser" on the right-hand side of the screen, and right-clicked every context-menu item looking for some way to open up the instance and change its parameters. I didn't find any way.


Unicode beyond Basic Multilingual Plane

String manipulation takes a dive when characters beyond `\:FFFF` are used e.g. Mathematical Alphanumeric Symbols. The characters display fine but doing string manipulation is very unpredictable:               ToCharacterCode[""] (* Actually is \U0001d56c *)     StringLength[""]     (* {55349, 56684} *)     (* 2 *)      Compare with python               >>> len(u'')      1      `$CharacterEncoding = "Unicode"` or `$CharacterEncoding = "UTF8"` does not help, is there some way to set string encoding properly?


How can I create some shorthand notation for a custom control?

Per this question, I have created a custom graphical control object which evaluates to a list of values. I would like to be able to create such an object quickly, rather than typing some command, pressing shift+enter, then copying the resulting object into wherever I want to use it. For example, something like typing `\[Theta]` which turns into `θ`... is it possible to create such a custom shorthand notation? (Even better, is it possible that when I start to type in a function which takes such a list as arguments, it pops up this control object for me to type the values in?)


How to generate new random numbers in a Manipulate only on demand?

I was playing with a `Manipulate`to visually compare calculating the mean of Normal and Cauchy random data.               Manipulate[      ListLinePlot[       {        Table[Mean@Take[#, i], {i, 1000}] &[         RandomVariate[NormalDistribution[10, 1], 1000]],        Table[Mean@Take[#, i], {i, 1000}] &[         RandomVariate[CauchyDistribution[10, 1], 1000]]        },       PlotRange -> Full,       DataRange -> n,       Frame -> True,       Axes -> False       ],      {n, 50, 1000}      ]      The result looks nice, but there is one problem. It regenerates the random data each time I move the slider for `n`. Is there some way I could set it up so that is only generates new random data when the `Manipulate` is first evaluated and when a button is pushed?


How to generate and draw simple bipartite graphs?

A bipartite graph is a graph whose vertices can be divided into two disjoint sets. Given two lists: `{1, 2, 3}` and `{x, y, z}`, where some of the elements are connected:               {{1, x}, {1, y}, {1, z},{2, x}, {2, y}, {3, x}}      I want to draw a bipartite graph with the numbers `{1, 2, 3}` on one side, the letters `{x, y, z}` on the other, and with edges connecting those which are paired together. **How can I draw such a graph?** Furthermore, **how can one generate bipartite graphs?** All I was able to find in the _Mathematica_ documentation is `BipartiteGraphQ` that tests whether or not a graph is bipartite. I found nothing on how to generate one. Is there a way to do this without the `Combinatorica`` package?


"LinkOpen::linke : specified file is not a mathlink executable"

The following code runs fine if I run it interactively:               Clear@realpath;     realpath[path_] := Import["!readlink "<>path, "Text"];     testsymlink = FileNameJoin[{$HomeDirectory, "testsymlink"}];     test = realpath[testsymlink];      In particular, the variable `test` gets the expected (non-`Null`) value. The same code runs fine also if I put it in a standalone script and execute it with               << "/path/to/script.m";      But if I put the same code, all by itself, in my `Kernel/init.m` file, it fails: the variable `test` gets the incorrect value `Null`. (The variable `testsymlink`, on the other hand, is still correctly set.) Furthermore, if I _then_ evaluate               realpath[testsymlink]      _interactively_ (in the newly started Mathematica session), I get the error shown in this post's title, twice: ![Mathematica graphics](http://i.stack.imgur.com/eXxeO.png) I can't figure out why I'm getting this error, but I'm having it may give someone else a clue as to why the snippet is failing in the first place (when run as part of executing `Kernel/init.m`. PS: It appears that the offending snippet puts the session in a corrupted state, because when I attempted to upload the image shown above, I got this error: ![Mathematica graphics](http://i.stack.imgur.com/vGmDU.png) I had first restart Mathematica (after deleting the offending snippet from `Kernel/init.m`), before I could upload these images.


Strange behaviour when line-wrapping text in a Pane

I noticed some strange behaviour of `Pane`. In the result from the following code, the line wrapping is not consistent: why do the first and last line contain four times "test" while the other lines only three times? Secondly, why doesn't it fill up the green rectangle with text, as it is supposed to do with its width of 84?               Graphics[{       Nest[Lighter, Blue, 6], Rectangle[{0, 0}, {110, 70}],       Nest[Lighter, Green, 6], Rectangle[{16, 10}, {100, 60}],       Darker@Red,       Inset[         Pane[           Text["test test test test test test test test test test test test \             test test test test test", BaseStyle -> {12}]           , 84]         , {16, 60}, {Left, Top}]     }]      ![test](http://i.stack.imgur.com/tM4Ef.png) Am I using `Pane` in a wrong way? Many thanks in advance! **EDIT** As for the second question, I realised that the width I specify for `Pane`(which is 84) is not in the same units as the rectangles, which becomes apparent by using `Framed` around `Pane`: ![testframed](http://i.stack.imgur.com/cc8ew.png) But this still leaves the question why the line wrapping doesn't work the same on all lines, and how to relate the point units of the width of `Pane` to those used in the `Graphics` environment. I'd like to be able to draw a rectangle of given width and height, and wrap text inside of it (possibly two or more panes in the same rectangle). **EDIT 2** Even stranger (as I just noticed): what I get on my screen differs from the exported image (using right-click); the line wrapping is again different. I made a screenshot to illustrate the difference: ![testscreen](http://i.stack.imgur.com/6Q0js.png) This is from the same code (even from the same execution).. Does anybody know why this happens? Thanks a lot!


Choosing min/max values of transcendental equation

With help from here, I have succeeded in plotting the equation `z = -a Log[2 Cosh[(2 f[x] + x)/a]]`, with `f[x]` being defined by the transcendental equation `f[x] = Tanh[(2 f[x] + x)/a`. However, for `a < 2` each `x` in the vicinity of `0` has up to three possible values of `y` as a soultion.               f[x_] := y /. FindRoot[y == Tanh[(2 y + x)/1.5], {y, 0}]     p1 = Plot[-1.5 Log[2 Cosh[(2 f[x] + x)/1.5]], {x, -1.5, 1.5}];     Show[p1,  PlotRange -> {{-1.5, 1.5}, {-3.1, -0.9}},  AspectRatio -> Automatic]      I know that `y = Tanh[(2 y + x)/1.5]` is supposed to have a jump-discontinuity for `x = 0`, and be one-to-one everywhere else. So, how do I make _Mathematica_ use only the **minimum** values of                 y = Tanh[(2 y + x)/1.5] for x ∈ [-∞, 0]       and **maximum** values of                 y = Tanh[(2 y + x)/1.5] for x ∈ [0, ∞]      when I plot               z = -1.5 Log[2 Cosh[(2 y + x)/1.5]]      ?


Netlink interface for arduino - led blink example implementation

I'm trying to learn of how I can use netlink in Mathematica to communicate with arduino. So question is the following: Can some one that has such experience in programming arduino using netlink in Mathematica share a simple example such led blinker so I can understand of how it works?


Why do NumberForm and Round apparently use different tie-breaking methods?

When rounding numbers (for example, rounding a real number to the nearest integer), the "round to nearest" rule is usually used. For example, **1.4 is rounded down to 1** and **1.6 is rounded up to 2**. However, some sort of tie-breaking rule is needed in the case of a real number exactly halfway between two integers, such as **2.5** or **3.5**. There are several such tie-breaking rules; here are two possibilities:   1. When I was in elementary school in the United States in the 1990s, the rule taught was to round up in the case of a tie. So, **2.5 is rounded up to 3** and **3.5 is rounded up to 4**. Wikipedia calls this the "round half up" tie-breaking rule. This method introduces a "toward-infinity" bias, since 0.5 is always rounded up. I guess we were taught this way because that was before we were taught about even and odd integers?    2. Another ( _perhaps better_ ) possibility is the "round half to even" tie-breaking rule, where the halfway value is rounded to the nearest _even_ integer. So, **2.5 is rounded to 2** and **3.5 is rounded to 4**. This method does not have the overall "toward-infinity" bias that method (1) has, but it does introduce a "toward-zero" bias for even numbers, and a "toward-infinity" bias for odd numbers. Wikipedia says that this method is the default method in IEEE 754 floating point functions, so apparently this is a well-established method. Of course, there are still other possibilities, like "round half to odd" and so on, but for now, let's just consider methods (1) and (2). My original question was, which method does Mathematica use? I did the following test using `NumberForm` and `Round`:               list1 = {2.5, 3.5};     NumberForm[#, {Infinity, 0}] & /@ list1     Round[#] & /@ list1      which gives this output: > >     {3., 4.} >     {2, 4} >   so it seems that `NumberForm` uses method (1) whereas `Round` uses method (2). Is this a correct assessment? The Mathematica (version 8) documentation for `NumberForm` does not seem to comment on this, as far as I can tell. On the other hand, the Mathematica (version 8) documentation for `Round` says, "`Round` rounds numbers of the form `x.5` toward the nearest even integer." Based on this, my question is, why do `NumberForm` and `Round` apparently use different tie-breaking methods? (I suppose that there may not be an answer to this question, since perhaps it is just "what it is.") Moreover, are `NumberForm` and `Round` different in other ways? For one thing, `NumberForm` acts as a wrapper and thus only affects printing, not evaluation, whereas `Round` affects evaluation. But, besides this, are there other fundamental differences between `NumberForm` and `Round` in Mathematica 8?


How do I flatten transparency on a graphics, for conversion to eps or similar?

I've got a graphic that I'd like to save as an eps file. Trouble is, the graphic has some transparency to it. Since the eps format doesn't handle transparency, I want to flatten the transparency out, effectively making an image with no transparency on a fixed (white) background that looks like the original transparent image. To give some background: To make my original image, I started with a plot, combined it with some background grids, and rasterized the result with Background->None. I then combined the image with an image of (vector) grid axes. I do this because I need the plot rasterized because it's built from a very large data set, but I need the axes vectorized because I need them to appear in a LaTeX document. I set Background->None in order to keep the plot's white background from blotting out the axes, and I combined the original plot with background grids so that the grids can be seen behind the image when rasterized. Currently when I try to save the document as an eps it gets rid of the transparency in the rasterized plot, which ends up meaning that the grids can no longer be seen through it. I'd like to be able to save as an eps and "flatten" the transparency, so that the image looks like it does with the transparency without the document actually using transparency (since eps can't handle transparency). Alternatively, if I could save it as a pdf but still get rid of the transparency in a similar way that would also be acceptable. I need to save the document in a vector format to keep the axes looking right. In case anyone is curious, here is my code. RatioPlotData is a big (~2,000 points) array.               SetDirectory[NotebookDirectory[]];     SetOptions[$FrontEnd, PrintingStyleEnvironment -> "Working"];     in = 72;     G3D = Graphics3D[AlignmentPoint -> Center, AspectRatio -> 0.925,         Axes -> {True, True, True},         AxesEdge -> {{-1, -1}, {-1, -1}, {-1, 1}},         AxesStyle -> Directive[10, Black],         BaseStyle -> {FontFamily -> "Arial", FontSize -> 12},         Boxed -> False, BoxRatios -> {3, 3, 1},         LabelStyle -> Directive[Black], ImagePadding -> 40,         ImageSize -> 5 in, PlotRangePadding -> 0,         TicksStyle -> Directive[10], ViewPoint -> {-2, -2, 2},         ViewVertical -> {0, 0, 1}];     (*axesLabels=Graphics3D[{Text[Style["v",Black,12],Scaled[{.5,-.15,0}],\     {0,0},{1.,0}],Text[Style["u",Black,12],Scaled[{-.15,.5,0}],{0,0},{1.,\     0}],Text[Style["Subsuperscript[R, 6, (3)]/Subsuperscript[R, 6, \     (2)]",Black,12],Scaled[{-.2,1.15,.6}],{0,0},{1.0,0}],Text[Style[\     "Collinear \     Limit",ColorData[1,2],12],Scaled[{0.5,0.5,-0.2}],{0,0},{1.0,0}]}];*)     fig = Show[       ListPlot3D[        Join[Append[RatioPlotData, {1, 1, -7.004088513718098`}],          Join[Transpose[Prepend[Transpose[ratlinepoints], Table[1, {19}]]],           Transpose[{Transpose[ratlinepoints][[1]], Table[1, {19}],             Transpose[ratlinepoints][[2]]}]]],         PlotRange -> {{0, 1}, {0, 1}, {-7.35, -7}}, ClippingStyle -> None,         Mesh -> {{0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9}, {0.1, 0.2,            0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9}}, MeshStyle -> Gray,         PlotStyle -> Opacity[0.8](*,AxesLabel->{"v","u","R63/R62"}*)],        ImagePadding -> {{70, 10}, {15, 0}}, Options[G3D]]     (*collline=Show[ParametricPlot3D[{u,1-u,-7.35},{u,0,1},PlotStyle->{\     ColorData[1,2],Dashed,Thick}],AbsoluteOptions[fig]]*)     axes = Show[         Graphics3D[{},          FaceGrids -> {{{1, 0,              0}, {{0, 0.2, 0.4, 0.6, 0.8,               1}, {-7.0, -7.1, -7.2, -7.3, -7.35}}}, {{0, 1,               0}, {{0, 0.2, 0.4, 0.6, 0.8,               1}, {-7.0, -7.1, -7.2, -7.3, -7.35}}}, {{0,              0, -1}, {{0.2, 0.4, 0.6, 0.8}, {0.2, 0.4, 0.6, 0.8}}}},          AbsoluteOptions[fig]](*,axesLabels,collline*)];     fig = Show[fig,         FaceGrids -> {{{1, 0,             0}, {{0, 0.2, 0.4, 0.6, 0.8,              1}, {-7.0, -7.1, -7.2, -7.3, -7.35}}}, {{0, 1,              0}, {{0, 0.2, 0.4, 0.6, 0.8,              1}, {-7.0, -7.1, -7.2, -7.3, -7.35}}}, {{0,             0, -1}, {{0.2, 0.4, 0.6, 0.8}, {0.2, 0.4, 0.6, 0.8}}}}];      fig = Show[fig, AxesStyle -> Directive[Opacity[0]]];     Row[{fig, axes}]     fig = Magnify[fig, 5];     fig = Rasterize[fig, Background -> None];     axes = First@ImportString[ExportString[axes, "PDF"], "PDF"];     result = Show[axes,          Epilog -> Inset[fig, {0, 0}, {0, 0}, ImageDimensions[axes]],          Background -> White];     result


3D Contour Plot - parts with gradients less and more than zero

I'm trying to plot sections of the 3D Contours, with gradient less than zero, and more than zero and equal to zero. It manages to solve for the derivative, but when I apply the conditions `deriv2 < 0` or `deriv2 > 0` it gives the error: > deriv2 < 0 must be a boolean condition               C1 = 10^(-1);     C2 = 0.1*C1;     R = 50;     Tb = 0.1;     Geb = 5.;     Z0 = 50;     L[Te_] := 1. + 1.*(Te - 0.1);     Zlcr[Te_, w_] := (1/R + 1/(I*L[Te]*w) + I*C1*w)^-1;     Zload[Te_, w_] := -I*w*C2 + Zlcr[Te, w];     Γ[Te_, w_] := (Zload[Te, w] - Z0)/(Zload[Te, w] + Z0);     y[Te_, w_] := (Abs[Γ[Te, w]])^2;     DeltaPlocal = 10.^-5;     eq2 = (1 -   y[Te, w]) Pprobe  ==  (Te - Tb) Geb     ContourPlot3D[       Evaluate[eq2], {w, 2.5, 2.8}, {Te, 0, 0.5}, {Pprobe, 0, 5}    ]          deriv2 = Derivative[1, 0][Te][w, Pprobe] /.         First[  Solve[    D[eq2 /. Te ->   Te[w, Pprobe], w],            Derivative[1, 0][Te][w, Pprobe]  ]  ]  /. Te[w, Pprobe] ->  Te          Positive2 =       ContourPlot3D[       Evaluate[eq2], {w, 2.5, 2.8}, {Pprobe, 0, 5}, {Te, 0, 0.5},        RegionFunction ->  Function[{w, Pprobe, Te}, deriv2 > 0], Mesh -> False,        ContourStyle -> Blue, MaxRecursion -> 5]          Negative2 =       ContourPlot3D[       Evaluate[eq2], {w, 2.5, 2.8}, {Pprobe, 0, 5}, {Te, 0, 0.5},        RegionFunction ->  Function[{w, Pprobe, Te}, deriv2 < 0], Mesh -> False,        ContourStyle -> Red, MaxRecursion -> 5]          zero2 = ContourPlot3D[       Evaluate[eq2], {w, 2.5, 2.8}, {Pprobe, 0, 5}, {Te, 0, 0.5},        RegionFunction ->  Function[{w, Pprobe, Te}, deriv2 = 0], Mesh -> False,        ContourStyle -> Green, MaxRecursion -> 5]


Common tangent to a curve

I need to find out the x and y coordinates of the points where the common tangent touches the curve. How can I do this ? Thanks a lot in advance. Data points:                 {{0,0},{1,-2.60788},{2,-4.42757},{3,-5.81138},{4,-6.90601},{5,-7.79825},{6,-8.52885},{7,-9.14314},{8,-9.64544},{9,-10.0547},{10,-10.3912},{11,-10.6627},{12,-10.8925},{13,-11.0713},{14,-11.2247},{15,-11.3377},{16,-11.424},{17,-11.4841},{18,-11.5183},{19,-11.5377},{20,-11.5467},{21,-11.5557},{22,-11.5551},{23,-11.5499},{24,-11.5393},{25,-11.5195},{26,-11.497},{27,-11.4729},{28,-11.4499},{29,-11.4331},{30,-11.4205},{31,-11.4144},{32,-11.4177},{33,-11.4222},{34,-11.4425},{35,-11.4702},{36,-11.492},{37,-11.5226},{38,-11.5466},{39,-11.5708},{40,-11.6143},{41,-11.6676},{42,-11.7275},{43,-11.8006},{44,-11.8758},{45,-11.9709},{46,-12.0729},{47,-12.1757},{48,-12.2869},{49,-12.401},{50,-12.5252},{51,-12.6564},{52,-12.7897},{53,-12.9267},{54,-13.0701},{55,-13.2254},{56,-13.3851},{57,-13.5441},{58,-13.711},{59,-13.8749},{60,-14.0373},{61,-14.2137},{62,-14.3937},{63,-14.576},{64,-14.754},{65,-14.9408},{66,-15.1289},{67,-15.3154},{68,-15.5015},{69,-15.6975},{70,-15.883},{71,-16.059},{72,-16.2309},{73,-16.4038},{74,-16.5645},{75,-16.7132},{76,-16.8584},{77,-16.9923},{78,-17.1227},{79,-17.2374},{80,-17.3432},{81,-17.438},{82,-17.5079},{83,-17.5681},{84,-17.615},{85,-17.6297},{86,-17.6146},{87,-17.5747},{88,-17.5074},{89,-17.4181},{90,-17.295},{91,-17.124},{92,-16.9207},{93,-16.6747},{94,-16.3812},{95,-16.0254},{96,-15.6106},{97,-15.1331},{98,-14.5669},{99,-13.918},{100,-13.1851},{101,-12.3401},{102,-11.3608},{103,-10.2353},{104,-8.91009},{105,-7.34354},{106,-5.4565},{107,-3.11396},{108,0}}      `ListPlot[list]` gives, ![enter image description here](http://i.stack.imgur.com/MklG7.png)


How to solve this simple equation?

I want to minimize a quadratic equation, but Mathematica does not solve it and only rewrites the solution. I wonder if there exist any way I can skip the computation by hand (I can solve it using Lagrangian method, but it is too long).               y = {y1, y2, y3}     yp = {yp1, yp2, yp3}     ypp = {ypp1, ypp2, ypp3}     Minimize[{(ypp1 - yp1)^2 + (ypp2 - yp2)^2 + (ypp3 - yp3)^2,                  Mean[ypp] == 0 && Variance[ypp] == 1}, ypp]


Problem to plot GDP data coming from Wolfram Alpha

I'm working with economic data and realized that I could extract it directly from _WolframAlpha_ using _Mathematica. So I did it. I extracted the GDP data of the country I'm studying.               nominal =        WolframAlpha[        "nominal gdp of brazil", {{"History:GDP:WorldDevelopmentData", 1},          "TimeSeriesData"},         PodStates -> {"History:GDP:WorldDevelopmentData__Linear scale"}];      So until now I'm ok. The trouble begins when I try to plot it using `DateListPlot[nominal]` because I just get an empty frame? I noticed that the GDP comes in US dollars and maybe some additional parameters are needed. I looked for it in the doc but couldn't find the solution. Thank's for the help. Here goes a sample of what I got > >     {{{1960, 1, 1, 0, 0, 0.}, Quantity[1.51656*10^10, > ("USDollars")/("Years")]}, >        {{1961, 1, 1, 0, 0, 0.}, Quantity[1.52369*10^10, > ("USDollars")/("Years")]}, >        {{1962, 1, 1, 0, 0, 0.}, Quantity[1.99263*10^10, > ("USDollars")/("Years")]}, >        {{1963, 1, 1, 0, 0, 0.}, Quantity[2.30215*10^10, > ("USDollars")/("Years")]}, >        {{1964, 1, 1, 0, 0, 0.}, Quantity[2.12119*10^10, > ("USDollars")/("Years")]}, >        {{1965, 1, 1, 0, 0, 0.}, Quantity[2.179*10^10, > ("USDollars")/("Years")]}, >        {{1966, 1, 1, 0, 0, 0.}, Quantity[2.70627*10^10, > ("USDollars")/("Years")]}, >        {{1967, 1, 1, 0, 0, 0.}, Quantity[3.05918*10^10, > ("USDollars")/("Years")]}, >        {{1968, 1, 1, 0, 0, 0.}, Quantity[3.38759*10^10, > ("USDollars")/("Years")]}, >        {{1969, 1, 1, 0, 0, 0.}, Quantity[3.74589*10^10, > ("USDollars")/("Years")]}......... >


Differences in SetDelayed (:=) in Module and DynamicModule

I have a question about the differences in `SetDelayed` assignment functions in a `Module` and in a `DynamicModule`. In all likelihood, the answer is pretty basic as I am rather new to _Mathematica_. Nevertheless, I have failed to find the answer in the docs nor in this forum, so I thought I would ask. The basic problem is the following: `SetDelayed` does not seem to "delay" when used in `DynamicModule`, whereas it does in `Module`. Below I provide code for four different functions that show the behavior.   * `func1` pops up **two** dialog windows, **once** for the `SetDelayed` assignment of `insidefunc` and once when `insidefunc` is called (`DynamicModule`)   * `func2` pops up **one** dialog window, **once** when `insidefunc` is called (`Module`)   * `func3` pops up **one** dialog window, **once** when `insidefunc` is `SetDelayed` (`DynamicModule`)   * `func4` pops up **no** dialog window * * *               Clear[func1,func2,func3,func4];               func1:=DynamicModule[{insidefunc},              insidefunc:=DialogInput[CancelButton[]];              insidefunc];          func2:=Module[{insidefunc},              insidefunc:=DialogInput[CancelButton[]];              insidefunc];          func3:=DynamicModule[{insidefunc},              insidefunc:=DialogInput[CancelButton[]];];          func4:=Module[{insidefunc},              insidefunc:=DialogInput[CancelButton[]];];          Row[{         Button["func1", func1["This is function 1"], Method->"Queued"],         Button["func2", func2, Method->"Queued"],         Button["func3", func3, Method->"Queued"],         Button["func4", func4, Method->"Queued"]}]      So, any ideas what I am doing wrong here?


How do I emulate DiscreteUniformDistribution in Mathematica?

How do I define a function from scratch that emulates `DiscreteUniformDistribution`?   As shown below, attempting to use `ProbabilityDistribution` does not preserve the condition that the distribution should be unique.               unif = DiscreteUniformDistribution[{0, 1}];     mine = ProbabilityDistribution[1/2, {x, 0, 1, 1}];     PDF[unif, 0.5]     PDF[mine, 0.5]          Out[65]= 0     Out[66]= 1/2      I suppose my real question is how do I enforce the condition that x should be discrete while using `ProbabilityDistribution`? By the way, I originally asked this on stackoverflow. Update: After going back and forth between Wolfram support, this is their official response: "I have consulted with our developers and this function is working as designed. There is no reason for evaluating a discrete distribution with non- integer values. The program recognizes the distribution as discrete and properly calculates such things as mean a variance. If you us the built-in functions rather than defining your own you will get the behavior you want. To fully implement the suggestions you have made would significantly impact the performance of the program both in memory usage and in speed. The function is working as designed and this case is closed."


How can I merge two lists in a special way?

It's been over a year since I've used Mathematica, and I'm having a total brain fart on a home project. I'd like to take an existing list of lists, say,               x = {{1, 2}, {3, 4}, {5, 6}}      and append 9 and 10 onto the end of each sublist of x to get a list y, where               y = {{1, 2, 9}, {1 ,2, 10}, {3, 4, 9}, {3, 4, 10}, {5, 6, 9}, {5, 6, 10}}      I'm sure there's a built-in function to do this, but cannot recall it for the life of me.


Chart illustrating options that affect Graphics/Graphics3D objects

In _Mathematica_ there is a seemingly never-ending list of parameters that affect the appearance of `Graphics` and `Graphics3D` objects: `ImageSize`, `ImageSizeRaw`, `ImagePadding`, `ImageMargins`, `PlotRange`, `PlotRangePadding`, `PlotRangeClipping`, `PlotRegion`, ... I'm looking for a chart that illustrates as many of these parameters as possible in one place. What I'm looking for is something in the same spirit as this chart illustrating similar terminology for CSS3: ![enter image description here](http://i.stack.imgur.com/QkkAT.gif)


Find integer values of p such that $(2^p - (2^2)(3^2))/ (3^3)$ is an integer.


How to use MacPorts' gcc with CreateLibrary?

**Short version:** What's the simplest way to use MacPorts' gcc with `CreateLibrary`? **Long version:** `CreateLibrary` uses `/usr/bin/gcc` by default on OS X. I can get it to use `clang` by using the option `"CompilerName" -> "clang++"` or `"CompilerName" -> "c++"` (I'm using C++). However, I would like to use MacPorts' gcc because it boosts the performance significantly for this particular program I need to compile. `"CompilerName" -> "g++-mp-4.7"` tells me that > CreateLibrary::instl: The compiler installation directive > "CompilerInstallation" -> "/usr/bin" does not indicate a usable installation > of "GCC" So I tried `"CompilerInstallation" -> "/opt/local/bin"`, which is the location of `g++-mp-4.7`. This results in the same error: > CreateLibrary::instl: The compiler installation directive > "CompilerInstallation" -> "/opt/local/bin" does not indicate a usable > installation of "GCC" Is there a simpler solution than using GenericCCompiler?


divergent part of a series

I am trying to find a function that gives me the divergent part of series in any case. The method "Series[]" does not work because `Series[42,{n,0,-1}]` gives as result 42 (which is not divergent in n) The method "SeriesCoefficient[]" does not work because I do not know the lowest order, so that `SeriesCoefficient[1/n^2 + 1/n + 2 + n^2,{n,0,-1}]`only gives 1 (from the 1/n-term) but I loose information about the 1/n^2 term. Is there a possibility to combine the advantages (to eliminate the disadvantages) of both approaches? Thanks for your answers.


Table with dynamic iterator

I would like to make a Table whose iterator has a dynamically updated endpoint, i.e.               Table[i,{i,1,Dynamic[n]}]      Is this possible? Here is the context:               n=1     SetterBar[Dynamic@n, Range[1, 10, 1]]     f[x_]:=Module[{y},             y=Table[0,{i,1,Dynamic[n]+4}]             For[i=3,i<=Dynamic[n]+4,i++,                  y[[i]]=y[[i-1]]+2y[[i-2]]               ]            ]     y=f[Dynamic[x]]      I get the error               Iterator {i,1,4+1} does not have appropriate bounds.      As another example of how I'd like to use this, here is fully functional code:               n=1;     Manipulate[Table[ToExpression["x" <> ToString@i], {i, 1,Dynamic@n + 1}], {x1, 1, 10}, {x2, 1, 10}]


Finding all partitions of a set

I'm looking for straightforward way to find all the partitions of a set. `IntegerPartitions` seems to provide a useful start. But then things get a bit complicated. Imagine we want to find all the ways to partition a list:               myList={a,b,c,d,e,f}      `IntegerPartitions` gives the some breakdowns, by numbers of elements in each subset.               breakdowns=IntegerPartitions[Length[myList]]      > > {{6},{5,1},{4,2},{4,1,1},{3,3},{3,2,1},{3,1,1,1},{2,2,2},{2,2,1,1},{2,1,1,1,1},{1,1,1,1,1,1}} The following function, `g`, takes the list and the breakdowns, outputting some useful results (but clearly not all possible results).               g[{},_,out_]:=out     g[in_,breaks_,out_]:=g[Drop[in,First@breaks],Rest@breaks,Append[out,Take[in,First@breaks]]]      So               g[myList,#,{}]&/@IntegerPartitions[Length[myList]]//MatrixForm      > ![matrix output](http://i.stack.imgur.com/jYrzg.png) * * * I suspect that there may be some better alternatives to `g`. Perhaps even a straightforward list-manipulation command. * * * BTW, we would need to use all permutations of `myList` to ensure we have all the partitions. `Permutations[myList]` would be instrumental for that:               Table[g[k,#,{}]&/@IntegerPartitions[Length[myList]],{k,Permutations[myList]}]


Is there a list of Octave functions mapped to the related Mathematica one?

I am just wondering if there is a list of the related Mathematica functions that correspond to Octave functions. For example. `ones(n)` maps to `Array[1 &, n]`


How to limit number of user-defined messages issued per evaluation

I have written code such that if it runs into a particular function, a warning message is issued. However, it is common for the program to call this function several times in a single evaluation, but the warning message need be issued only once. How do you limit the number of times a message is issued per evaluation? Here is an example:                Clear[badness];      ClearAll[badness];      badness::oops = "Watch out!  Result could be misinterpreted.";      badness[0] := CompoundExpression[Message[badness::oops]; 0]           Clear[reduction]      f[0] = 0;      reduction = {f[x_] :> x + f[x - 1] + badness[0]};      So, If the user runs the following:                f[5] //. reduction      we get: ![output of badness](http://i.stack.imgur.com/L4MNP.png) Is there a way to limit the number of times (without also getting the `General::stop`) the message `badness:oops` is given to the user? (In the particular case for my code, I would like to limit it to just one time.)


How to find the roots of an equation which is almost singular everywhere

I'm trying to find the roots of the equation as a variable of `k`:               a = 0.81; b = 1.94;     LegendreP[(-a + Sqrt[8 b + a^2])/(2 a),  k/a, 1] == 0      The problem is that this function is almost divergent everywhere except only a few points, and FindRoot and Reduce seems to fail on this               FindRoot[LegendreP[(-a + Sqrt[8 b + a^2])/(2 a),  k/a, 1] == 0, {k, 0}]      > FindRoot::nlnum: The function value {ComplexInfinity} is not a list of > numbers with dimensions {1} at {k} = {1.49012*10^-8}. >>               Reduce[LegendreP[(-a + Sqrt[8 b + a^2])/(2 a),  k/a, 1] == 0, k]      > Reduce::inex: Reduce was unable to solve the system with inexact > coefficients or the system obtained by direct rationalization of inexact > numbers present in the system. Since many of the methods used by Reduce > require exact input, providing Reduce with an exact version of the system > may help. >>               With[{a = 81/100, b = 194/100},       Reduce[LegendreP[(-a + Sqrt[8 b + a^2])/(2 a),  k/a, 1] == 0, k]]      > Reduce::nsmet: This system cannot be solved with the methods available to > Reduce. >> How would I solve this equation? The roots are `k = n*a`, where n is integer. * * * **Edit** The motivation of this problem is to determine the bound states of a one- dimensional potential well $$ -\frac{\hbar^2}{2m}\frac{d^2\psi}{dx^2}+V(x)\psi=-\frac{\hbar^2k^2}{2m}\psi $$ where $$ V(x)=-\frac{\hbar^2b}{m}sech^2(a x) $$ ,$k$ is a parameter. This equation has solution               ψ[x_]:=A*LegendreP[(-a + Sqrt[8 b + a^2])/(2 a),  k/a, Tanh[a x]] +       B*LegendreQ[(-a + Sqrt[8 b + a^2])/(2 a),  k/a, Tanh[a x]]          V[x_] := -((\[HBar]^2 b)/m) Sech[a x]^2     -(\[HBar]^2/(2 m)) ψ''[x] + V[x] ψ[x] == -((\[HBar]^2 k^2)/(2 m)) ψ[x] // FullSimplify     (*True*)      Quantum mechanics requires the wave function is finite, which gives a constrain on parameter `k` and thus the eigen-energies($\sim k^2$) are some discretized values. And I'm trying to find these eigen-energies. Mathematically, this is equivalent to finding the $k's$ that keep associate Legendre polynomials finite in region `0 <= x <= 1`               A*LegendreP[(-a + Sqrt[8 b + a^2])/(2 a),  k/a, x]+B*LegendreQ[(-a + Sqrt[8 b + a^2])/(2 a),  k/a, x]      . **Edit2** For the wave function must be normalizable and square-integratable, here is the explanation in the Griffiths's Introduction to Quantum Mechanics: > For some solutions to the Schrodinger equation the integral is infinite; in > that case no multiplicative factor is going to make it 1. The same goes for > the trivial solution $\Psi = 0$. Such non-normalizable solutions cannot > represent particles, and must be rejected. Physically realizable states > correspond to the square-integrable solutions to Schrodinger's equation. For the case of free particle, he also explained why it's not normalizable: > In the case of the free particle, then, the separable solutions do not > represent physically realizable states. A free particle cannot exist in a > stationary state; or, to put it another way, there is no such thing as a > free particle with a definite energy.


Is everything in Mathematica ultimately stored as a rule?

My current understanding about Mathematica is that everything, at the lowest level, ends up as replacement rules.   First question: is this true?   Second question: does Mathematica "gloss over" these rules by representing them as functions? ![](http://i.stack.imgur.com/HViEe.png) doesn't seem to be expressed as a rule. Third question: does the by value/by reference question have any when you "pass" a value to a Mathematica function?


FindMinimum [] methods

Which algorithm is used when we do not use the option Method of `FindMinimum[]` function.               FindMinimum[f,{x,x0}]


How to plot the contour of f[x,y]==0 if always f[x,y]>=0

I've been stuck at this problem for weeks and I've asked several related questions here: ContourPlot shows only part of the contours [duplicate] How to plot the contour of the radius part of a complex function a lot of help has been kindly given but I think my problem is still not solved completely. In the first question, Jens pointed out that when a function only touch but not cross 0, `ContourPlot` would have difficulty finding the 0 contour. He then suggested to plot `f[x,y]==0.001` or some small number, instead of `f[x,y]==0.`. This seems works very well for some functions like `Abs[Cos[x]+Cos[y]]`. However it doesn't work on my function, and he also gave an explanation that the reason it doesn't work is because the maximals of my function change a lot in the plot region. Along this direction, I rescaled my function to make the maximals at the same order, but the `f[x,y]==0.001` trick still doesn't work. I've been experimenting with these for a while and found that the reason seem more than just the steep change in the maximals. And I also found some behavior of `ContourPlot` that are very confusing for me. Consider this function, the maximals of it changes quite of lot               f[x_, y_] := (Cos[x] + Cos[y]) Exp[I x y] Exp[x/2]               Plot3D[Abs[f[x, y]] == 0.001, {x, 0, 4 Pi}, {y, 0, 4 Pi},       PlotPoints -> 40, PlotRange -> All]      ![enter image description here](http://i.stack.imgur.com/d8Hfm.png) Now if we plot the 0 contour, using different `PlotPoints` setting, we would get different results. In fact more plot points makes the contour worse. **Why?**               myPlot[sqs__] := Module[{},       Row@{ContourPlot[Sequence[sqs], ImageSize -> 400],          ListPlot[          Reap[ContourPlot[Sequence[sqs],              EvaluationMonitor :> Sow[{x, y}]]][[-1, 1]],           PlotStyle -> PointSize[Tiny], ImageSize -> 400, Axes -> False,           Frame -> True, AspectRatio -> 1]}       ]          myPlot[Abs[f[x, y]] == 0.001, {x, 0, 4 Pi}, {y, 0, 4 Pi}]     myPlot[Abs[f[x, y]] == 0.001, {x, 0, 4 Pi}, {y, 0, 4 Pi}, PlotPoints -> 50]     myPlot[Abs[f[x, y]] == 0.001, {x, 0, 4 Pi}, {y, 0, 4 Pi}, PlotPoints -> 100]      ![enter image description here](http://i.stack.imgur.com/uYbYW.png) If we increase the plot range, the `ContourPlot` just fails to give the result. **Why?** The MaxRecursion seems can help in this case, but the contour is still broken.               myPlot[Abs[f[x, y]] == 0.001, {x, 0, 16 Pi}, {y, 0, 16 Pi}]     myPlot[Abs[f[x, y]] == 0.001, {x, 0, 16 Pi}, {y, 0, 16 Pi}, MaxRecursion -> 3]      ![enter image description here](http://i.stack.imgur.com/XAVgT.png) Now compare with the second function               f[a_, a0_, k_, K0_] :=       a^2 Sech[(a a0)/2]^2 (-2 I (1 + E^(2 I a0 k)) k +           a (-1 + E^(2 I a0 k)) Tanh[(a a0)/2]) +        2 k (I E^(           I a0 k) ((a - k) (a + k) Cos[a0 k] + (a^2 + k^2) Cos[a0 K0]) +           a (-1 + E^(2 I a0 k)) k Tanh[(a a0)/2])          With[{a0 = 10., a = 1.4},      Plot3D[Abs[f[a, a0, k, K0]] == 0.001, {K0, -2 π/a0,         2 π/a0}, {k, 0, 2}, ImageSize -> 400, PlotPoints -> 40]]      We can see that this function behaves well in terms of the changes in the maximals. All the maximals seems in the same order. And ContourPlot seems fails to produce the results, even plotting a very small region with `MaxRecursion->3`. Why? ![enter image description here](http://i.stack.imgur.com/fKTWe.png)               With[{a0 = 10., a = 1.4},      myPlot[Abs[f[a, a0, y, x]] == 0.001, {x, -π/a0, π/a0}, {y, 0,2}]]     With[{a0 = 10., a = 1.4},      myPlot[Abs[f[a, a0, y, x]] == 0.001, {x, -π/a0, π/a0}, {y, 0,2}, MaxRecursion -> 3]]      ![enter image description here](http://i.stack.imgur.com/rjt1J.png) **Summary of the Questions**   1. In the first function, why increase PlotPoints makes things worse, and why increases plot range resulted in almost no contour plotted(when plot range is 16pi)?   2. Why the second function, which seems behave better than the first, shows very poor contour results and how to improve it?


Problem with ContourPlot

I tried these               ContourPlot[ 1 + (1 + x)^3 - 3 (1 + x) y + y^3 == 0, {x, -3, 3}, {y, -3, 3}]     ContourPlot[(x + y + 2) == 0, {x, -3, 3}, {y, -3, 3}]     ContourPlot[(x + y + 2)^2 == 0, {x, -3, 3}, {y, -3, 3}]     ContourPlot[(x + y + 2)^3 == 0, {x, -3, 3}, {y, -3, 3}]      the third and fourth one produce graphs contrary to my mathematical common sense. Especially, the third one does not produce anything. Could someone explain why and how to fix it?


Plotting equipotentials gone wrong

I'm plotting the equipotential of the potential function: $$\phi(x,y,z):=\frac{1+x^{2}+y^{2}+z^{2}}{[\left(1+x^{2}+y^{2}+z^{2}\right)^{2}-4z^{2}]^{1/2}}$$ Mathematica code:               Φ[x_, y_, z_] := (1 + x^2 + y^2 + z^2)/((1 + x^2 + y^2 + z^2)^2 - 4 z^2)^(1/2)      So I write, for example               ContourPlot3D[Φ[x, y, z] == 1, {x, -100, 100}, {y, -100, 100}, {z, -100, 100}]      But, I get this image: ![enter image description here](http://i.stack.imgur.com/ElmCm.jpg) And, sometimes if I change the plot region, I get absolutely nothing. My **question** is, what did I wrong? I think I should obtain smooth 3D curves, but I don't.


Plotting a line segment from the degenerate case of an ellipse

An ellipse degenerates into a line segment when the defining constant distance from the two foci is the actual distance between the two foci. The ellipse closes into a line segment. The following code shows a family of concentric ellipses that should converge to a line segment when the constant is set to 5. However it doesn't plot the line segment even if I increase the MaxRecursion very high.               ContourPlot[Evaluate[Table[Sqrt[(x + 3)^2 + y^2] + Sqrt[x^2 + (y - 4)^2] == n, {n, 5,      6, .01}]], {x, -4, 1}, {y, -1, 5}]      Is there someway to get Mathematica to actually plot the line segment of the degenerate case of an ellipse?


ContourPlot shows only part of the contours

Consider these contour plots:               f[x_,y_]:=Cos[x] + Cos[y]          ContourPlot[f[x, y] == 0, {x, 0, 4 Pi}, {y, 0, 4 Pi}]      ![enter image description here](http://i.stack.imgur.com/bmuys.png)               ContourPlot[f[x, y]*f[x, y] == 0, {x, 0, 4 Pi}, {y, 0, 4 Pi}]      ![enter image description here](http://i.stack.imgur.com/fFQP9.png)               ContourPlot[Abs[f[x, y]] == 0, {x, 0, 4 Pi}, {y, 0, 4 Pi}]      ![enter image description here](http://i.stack.imgur.com/Nq2xe.png) **Question** : Why the second and third contour plot don't work? How to fix them to make them to reproduce the first contour plot? I tried to increase the `MaxRecursion` and it's supper slow and doesn't help much:               ContourPlot[Abs[f[x, y]] == 0, {x, 0, 4 Pi}, {y, 0, 4 Pi}, MaxRecursion -> 15]      ![enter image description here](http://i.stack.imgur.com/dCzko.png) * * * * * * This part is just my context of the problem, you can safely ignore it if you are not interested. Why do I want to plot the contour of `Abs[f[x,y]]==0` or `f[x,y]*Conjugate[f[x,y]]==0` if they are the same of `f[x,y]==0`? Because it would help a lot when `f[x,y]` is a complex function(x and y are real variables but `f[x,y]` maybe complex). For any function `f[x,y]`, it can be written in the form `r[x,y]*Exp[I θ[x,y]]` where `r[x,y]` and `θ[x,y]` are real function. So for `f[x,y]==0` what we really means is `r[x,y]==0`, and instead of contour plotting `f[x,y]==0` I should put `r[x,y]==0`. However, sometimes it would be difficult to get `r[x,y]` given the function `f[x,y]`, but fortunately we can just plot the contour of `f[x,y]*Conjugate[f[x,y]]==0` or `Abs[f[x,y]]==0` since which is mathematically equivalent to `r[x,y]==0`. For example, I have a function               a0 = 10.;a = 1.4;     f[k_,K0_]:=a^2 Sech[(a a0)/2]^2 (-2 I (1 + E^(2 I a0 k)) k + a (-1 + E^(2 I a0 k)) Tanh[(a a0)/2]) + 2 k (I E^(I a0 k) ((a - k) (a + k) Cos[a0 k] + (a^2 + k^2) Cos[a0 K0]) + a (-1 + E^(2 I a0 k)) k Tanh[(a a0)/2])      I know it can be separate into the form `r[k,K0]*Exp[I θ[k,K0]]`, but it's difficult to find what `r` and `θ` is. Since I want to plot the contour of `r[k,K0]==0`, instead I can plot the contour of `Abs[f[k,K0]]==0`, but I encountered the same problem as the simple example above.               ContourPlot[Abs[f[k, K0]] == 0, {K0, -2 π/a0, 2 π/a0}, {k, 0, 4}]      ![enter image description here](http://i.stack.imgur.com/u0KvT.png) However if we plot the real and imaginary part, we can get the correct contour(the diamond shape) but also introduced other artificial contours(horizontal lines) come from `Cos[θ[x,y]]==0` or `Sin[θ[x,y]]==0`.               Row@{ContourPlot[        Re[f[k, K0]] == 0, {K0, -2 π/a0, 2 π/a0}, {k, 0, 4}, PlotLabel -> "Re", PlotPoints -> 60],       ContourPlot[        Im[f[k, K0]] == 0, {K0, -2 π/a0, 2 π/a0}, {k, 0, 4}, PlotLabel -> "Im", PlotPoints -> 60]}      ![enter image description here](http://i.stack.imgur.com/lV3hz.png) Just for comparison, the above function can be separated into               2 I E^(I a0 k) (a^2 Sech[(a a0)/2]^2 (-2 k Cos[a0 k] + a Sin[a0 k] Tanh[(a a0)/2]) + k ((a - k) (a + k) Cos[a0 k] + (a^2 + k^2) Cos[a0 K0] + 2 a k Sin[a0 k] Tanh[(a a0)/2]))      so               r[k_,K0_]:=a^2 Sech[(a a0)/2]^2 (-2 k Cos[a0 k] + a Sin[a0 k] Tanh[(a a0)/2]) +       k ((a - k) (a + k) Cos[a0 k] + (a^2 + k^2) Cos[a0 K0] +          2 a k Sin[a0 k] Tanh[(a a0)/2])      and contour plot of r is               ContourPlot[r[k, K0] == 0, {K0, -2 \[Pi]/a0, 2 \[Pi]/a0}, {k, 0, 4}, PlotPoints -> 60]      ![enter image description here](http://i.stack.imgur.com/IcZfR.png)


Bar Chart Labels Mystery

I have some data which I want to plot in a simple bar chart:               example = {{"Knowledge", 2}, {"Comprehension", 4}, {"Application", 0}, {"Analysis", 1}, {"Synthesis", 0}, {"Evaluation", 2}}      The first element of each pair should be the bar label, and the second should be the height of the bar. I can get the desired result using:               BarChart[Last[#] & /@ example, ChartLabels -> {"Knowledge","Comprehension","Application","Analysis","Synthesis","Evaluation"}]      ![enter image description here](http://i.stack.imgur.com/y6FKi.png) But my real question is this: Though               First[#] &/@ example      Returns               {"Knowledge", "Comprehension", "Application", "Analysis", "Synthesis", "Evaluation"}      When I try:               BarChart[Last[#]&/@example, ChartLabels->First[#]&/@example]      I get a graph without labels: ![enter image description here](http://i.stack.imgur.com/y6ydg.png) This seems like strange behaviour, can anyone shed some light, or suggest a fix?


Numerical contour integrations in the complex plane - contour deformation gives different answer for analytic kernel

I am trying to do a contour integration in _Mathematica_ numerically. In particular, I'm checking the identity: $$ H_m^{(1)}(z) =\frac{i^{-m}}{\pi}\int_{-\pi/2 + i \infty}^{\pi/2 - i \infty} \exp[i m \beta + i z \cos\beta]\mathrm d\beta $$ In Stratton's _Electromagnetic Theory_ (I am a physicist), he claims (p. 368) that you can freely deform the contour since the kernel is an analytic function, assuming the contour stays within a certain region. Here's a diagram (from here): ![admissible region for Hankel function contour](http://i.stack.imgur.com/l0ESD.png) This is all fine, and I have no problem with this; however, when I try to evaluate the contour integration in _Mathematica_ with code that looks like:               Hmz[m_, z_] := Exp[-I m Pi/2]/Pi NIntegrate[Exp[I m B + I z Cos[B]],                      {B, -Pi/2 + I Infinity, -Pi/2 + I Pi/2, Pi/2 - I Pi/2, Pi/2 - I Infinity}]      or alternatively (along a different, but apparently valid, contour):               Hmzother[m_, z_] :=  Exp[-I m Pi/2]/Pi NIntegrate[Exp[I m B + I z Cos[B]],                                       {B,  -Pi/2 + I Infinity, -Pi/2, Pi/2, Pi/2 - I Infinity}]      I get different answers - at least for the imaginary part (particularly for small $z$). For example, evaluating for $m = 3$ and $z = 1$ gives (not actual lines of code):               Hmz[3, 1] == 0.0195634 - 2.72402 I     Hmzother[3, 1] == 0.0195634 - 0.248805 I      For reference, the true value should be `HankelH1[3,1] == 0.0195634 - 5.82152 I`. The only difference between the definition of `Hmz` and `Hmzother` here are the contours, yet they should give the same answer. Ideally, I'd like to use the contour `{B, I Infinity, 0, Pi, -I Infinity}`, but this gives an even worse disagreement. Does anybody know how to get _Mathematica_ to do the contour integral correctly in the complex plane? Thanks all.


Preventing notebook cells from being broken across two pages when printing

Sometimes I create a number of plots together, e.g. by `GraphicsGrid[]`. If it happens that I have to print the notebook, very often the cell is broken, half on one page and the remaining part on the next -- while I'd like _Mathematica_ to print it all in the next page if there is not enough space available. This also happens if I save the notebook as a PDF.


Confidence Regions for NonLinearFit with “complicated” integral model

I have a set of data $y_i (z_i)$ with errors $\Delta y_i$, that can be found here Here Thus first, I call the data               dataSN = Import["Cat3_0mod.txt", "Table"];     sigdata = dataSN[[All, 4]];     lendata = Length[zdata];          fitSN = Table[{dataSN[[i, 2]], dataSN[[i, 3]]}, {i, 1, lendata}];      I want to fit these data to a complicated model $$ Y(z) = 5\log \Bigl((1+z)\int_0^z \frac{dz'}{a+bz'+cz'^2}\Bigr)+25; $$ With help of a previous post NonLinearFit with "complicated" integral model I used 'NonLinerFit'               ModelSN1[z_] =        Simplify[5 Log[10, (1 + z) Integrate[1/(a + b x + c x^2), {x, 0, z}]] + 25,          Assumptions -> {z > 0, -b^2 + 4 a c > 0}];          fit =        NonlinearModelFit[fitSN, {ModelSN1[z], -b^2 + 4 a c > 0},         {{a, 0.000254}, {b, .000016}, {c, .000016}}, z, Weights -> 1/(sigdata)^2];      Even the fit looks fine ![enter image description here](http://i.stack.imgur.com/u0GAe.jpg) The reality is that the fit is complex ![enter image description here](http://i.stack.imgur.com/xxzF9.jpg) I Have some problems making the fit   1. Even I put conditions over the parameters $a,b,c$ the fitted model is complex. I tried to put as condition that the whole term inside $\log$ should be positive, but it does not work.   2. I want to make confidence regions on this fit using               band1SN[z_] = fit["MeanPredictionBands", ConfidenceLevel -> 0.68];       band2SN[z_] = fit["MeanPredictionBands", ConfidenceLevel -> 0.95];      but _Mathematica_ does not make it, an error related with the fact of assuming a constrained model appears. Of course, if the fit is complex, the confidence regions could not be calculated. I appreciate your help.


Displaying Values of Fuction at end of Period by Grid

My intention is to place the values of two function into a small box within my chart. To be more precise I have two vectors. A meanvector which shows the average value of all simulated stochastic processes and an other vector, namely thresholdedmeanvector which represents the average value only of those processes which remain beyond the in the function defined threshold. So I just want a box somewhere in the chart with the titles “mean of all stochastic processes” and below the displayed value of this vector at the end of the period (which is defined as “time” in the code) and the title “mean of all stochastic processes beyond the threshold” next to it, which also displays the value of the average of the stochastic processes which remained beyond the threshold at the end of the period (again defined as “time”) In the first step, I tried just to display the mean value of all stochastic processes somewhere in the chart. Therefore I uses the Grid Function, but I am struggling with it. I think I have placed it somewhere in a wrong position in the function, but I am not sure. Does anyone of you have a suggestion where I should place the Grid Function or an easier alternative? Thanks, and below you can find the underlying code.               Manipulate[SeedRandom[seed]; meanvector := Mean[assets];       assets = Table[RandomFunction[     GeometricBrownianMotionProcess[μ, σ, S0], {0, time, 0.1}]["Path"], {P}];                processes = Transpose[assets[[#]]][[2]] & /@ Range@Length[assets];       processesposition = Flatten[Position[     Min[processes[[#]]] & /@ Range@Length[assets], _?(# > threshold &)]];                      thresholdedassets = assets[[#]] & /@ processesposition;       thresholdedmeanvector = Mean[thresholdedassets];                (*vector of meanvector*)      vmv = TableView[{meanvector, NumberForm[meanvector, {4, 5}]}, {0, time}];            vmv = Prepend[        vmv, {"Mean Value of all Assets and the end of the period"}];           G1 := ListLogPlot[assets, GridLines -> {{}, {threshold}},         GridLinesStyle -> Directive[Green, Thick], Joined -> True,         AxesLabel -> {"Time", "St"},         PlotLabel -> Style["Forecasted Stock Price\n (Brownian Motion)", Bold],         PlotRange -> All, PlotStyle -> Directive[{Thin, Lighter@Gray}]];           G2 := ListLogPlot[{meanvector, thresholdedmeanvector},         Joined -> True,         PlotStyle -> {Directive[{Thick, Darker@Red}],           Directive[{Thick, Darker@Blue}]}];           (*introduction of Grid Box for meanvector*)           Grid[{Text@ Grid[vmv, Alignment -> Left, Frame -> All,ItemStyle -> {Automatic, {Bold}}],                       Show[G1, G2]}],           {{S0, 100, "Initial Stock Value"}, 1, 500, 0.5, Appearance -> "Labeled"},       {{μ, 0.08, "Drift μ"}, 0.01, 0.2, 0.01, Appearance -> "Labeled"},       {{σ, 0.2, "Standard Deviation σ"}, 0.01, 1, 0.05,        Appearance -> "Labeled"},      {{P, 6, "Paths"}, 1, 20, 1,Appearance -> "Labeled"},       {{time, 10, "Time t"}, 1, 20, 1, Appearance -> "Labeled"},        {{threshold, 75, "Debt Level"}, 1, 500, Appearance -> "Labeled"},        Delimiter, {{seed, 0, ""},Button["randomize", seed = RandomInteger[2^64 - 1]] &},             Button["Set Initial Values", {S0 = 100, μ = 0.08, σ =          0.20, P = 6, time = 10, threshold = 75}, ImageSize -> 150],       ControlPlacement -> Left]


Interpreting the interpolating function and saving data to plot with external program

So far I have been solving non-linear pdes with `NDSolve` and then plotting the result with the in-built `Plot3D` and `ContourPlots`. An example file can be found **here**. This is a two part question with part 1 leading in to part 2. ## Part 1 How do I interpret the interpolating function (how do I read it)? For instance, I can "expand" the `InterpolatingFunction` with > `InterpolatingFunctionGrid[hSol]` This obviously has all the points that `Plot3D` plots with. How do I read this, say, row-wise or column-wise to make more sense of whats going on? ## Part 2 How can I save this data to a `.csv` format or just some external file to use, say, gnuplot or some other plotting routine? I have trid `DumpSave` etc . but the resulting huge files are generally not cross platform compatible.


Multiple NIntegral with singularity

I need to compute the following integral `FF[0]`. When evaluating `FF[0]` _Mathematica_ simply takes too much time. The problem may arise due to singularity in the limit 1. I tried specifing different options of `NIntegrate`, but no luck. Any suggestions why the computation of `FF[0]` stalls ? I am working on the code below:               FF[z_] := NIntegrate[f1[v] NIntegrate[f4[u], {u, 1, v}], {v, 1, z}];      It involves the functions below:               f1[z_] := z^2/((1 + z + z^2) Sqrt[1 - z^3]);          f2[z_] := (-2 - 3 z^2 + 5 z^3 + 9/2 z^2 Sqrt[1 - z^3]                 NIntegrate[f1[u], {u, 1, z}])/(-1 + z^3);          f3[z_] := (z^2 (8 - 12 z - 2 z^3 + 6 z^4 + 3 Sqrt[1 - z^3] (-4 + z^3)                 NIntegrate[f1[u], {u, 1, z}]))/(-1 + z^3)^2;          f4[z_] := 1/((1 + z + z^2) Sqrt[1 - z^3]) (16 (-1 + z) (1 + z + z^2) Sqrt[1 - z^3] +                 6 (-4 - 4 z - 4 z^2 + z^3 + z^4 + z^5) NIntegrate[f1[u], {u, 1, z}] +                 Sqrt[1 - z^3] (-4 (-4 + 2 z + 2 z^2 + 3 z^3) +                4 (1 + z + z^2) NIntegrate[f2[v], {v, 1, z}] -                3 (1 + z + z^2) NIntegrate[f3[s], {s, 1, z}]));


Manipulate not showing anything

This works:               Manipulate[Plot[2*x + 3*y, {x, 3, 4}], {y, 3, 4}]      But this doesn't               f=2*x + 3*y     Manipulate[Plot[f, {x, 3, 4}], {y, 3, 4}]      My "f" is a painful long expression so I'd rather be able to get the latter method to work than work with the former.


Simulated Annealing Convergence

I am using _Simulated Annealing_ method for a simulation based optimization of a process that has 3 variables, using `NMinimize`. I print the input/output during every iteration using the `"Evaluation Monitor"`. I have noticed that after about `3000` iterations, _Mathematica_ gives me a convergence result. But checking the results from `"Evaluation Monitor"` shows that the ultimate convergence result is not the global minimal, but the process has visited a better minimal during one of the iterations. Why is this happening? Here is a sample code:               demand[n_,k_]:=Min[k Vf,n capacity];     supply[n_,k_]:=Min[(n Kj-k) w, n capacity];     flo[n_,Ku_,Kd_]:=Min[demand[n,Ku],supply[n,Kd]];     dx=Vf*dt; n=Round[Flen/dx]; m=Round[SimTime/dt];       p=Round[Rlen/dx];   θ=Vf/w; capacity=w*Vf*Kj/(Vf+w); α[a1_]:=1800.; β[a2_]:=0.1; L=3.;      Flen=8.; Rlen=3.; SimTime=30./60.; Kj=150.; w=20.; Vf=100.; dt=12./3600.; d=1.;      RMLocation=Round[(2/3) p]; j=0;          f[a1_,a2_,a3_]:=Module[{b1=a1,b2=a2,b3=a3,TT=0,NtwrkTT=0,j=0},        RM[x_,t_]:=Piecewise[{{100 b1,x<=3},{100 b2,3<x<=6},{100 b3,True}}];         NtwrkTT=0; Clear[k0,kr,k,γ];        k0=ConstantArray[0,n];         kr=Table[Table[0,{k,1,p}],{i,1,n}];         γ=ConstantArray[1,n];        For[i=2, i<n, i++, kr[[i,1]]=α[i dx] d/Vf];         TT=Plus@@(Plus@@kr); NtwrkTT=TT; k=k0;        While[TT>0, TT=0;          For[i=2, i<n, i++, FQin=If[i==2,Min[demand[L,k0[[i-1]]],supply[L,k0[[i]]]],FQout];       dem=demand[L,k0[[i]]]; dem=If[dem==0,0.001,dem];       γ[[i]]=Min[1,supply[L,k0[[i+1]]]/dem];       ϕ=γ[[i]] demand[1,kr[[i,p]]]/d;       Qr=(ϕ-β[i dx] FQin) dx;       FQout=Min[demand[L,k0[[i]]],supply[L,k0[[i+1]]]];       k[[i]]=k0[[i]]+(FQin-FQout+Qr)/Vf;       kr0=kr[[i]];       For[ir=2,ir<=p,ir++,        MR=If[ir==RMLocation+1,RM[i dx,j dt],capacity];        RQin=Min[MR,If[ir==2,flo[1,kr0[[ir-1]],kr0[[ir]]],RQout]];        MR=If[ir==RMLocation,RM[i dx,j dt],capacity];        RQout=Min[MR,If[ir<p,flo[1,kr0[[ir]],kr0[[ir+1]]],ϕ d]];        kr[[i,ir]]=kr0[[ir]]+(RQin-RQout)/Vf];       kr[[i,1]]=If[j<=m,α[i dx] d/Vf,0]];      TT=Plus@@(Plus@@kr);      TT+=Plus@@k;      k0=k;NtwrkTT+=TT;j++];     NtwrkTT dt]     NMinimize[{f[a,b,c],3<=a<=12&&3<=b<=12&&3<=c<=12&&Element[a|b|c,Integers]},{a,b,c},Method->{"SimulatedAnnealing","SearchPoints"->5^5},EvaluationMonitor:>Print["a = ",a," , b = ",b," , c = ",c," , f[a,b,c] = ",f[a,b,c]]]      Hope this helps. Ps. Any suggestions to improve the performance of this code will be greatly appreciated. Thank You. **edit:** As per @@Kuba's suggestion, I split the original question in to two. The second part is at Simulated Annealing Parameters and Results


GraphPlot with black edges no rendering function

Is there any way to make the edges of a GraphPlot black without tediously writing out a long "EdgeRenderingFunction"? I guess you could ask the same kind of question about vertex labeling. For example, if I write `EdgeRenderingFunction -> ({Black, Arrow[#1, 0.1]} &)` I don't even get the standard directed edges, I get "arrows". How do I just turn the standard directed edges black (instead of the default red)?