NDSolve seems to have difficulties with solving integral equation. n = 5; NDSolve[{D[[Sigma]norm[z, t], t] == 3*z*Integrate[[Sigma]norm[z, > t]^n*z, {z, 0, 1}] - [Sigma]norm[z, t]^n, > [Sigma]norm[z, 0] == 1.5*z, [Sigma]norm[0, t] == 0}*[Sigma]norm[z, > t], {z, 0.01, 1}, {t, 0.01, 2}] Mathematica returns a message NDSolve::deql: The first argument must have both an equation and an > initial condition. which I cannot understand. > Can anybody tell what's wrong with my attempt? I am not really sure that your question isn't a joke. NDSolve solves differential equations, not integral equations. Although there are relations between these topics, they are certainly not the same. ==== evaluating the following gives you a sample x=x+1 button: NotebookPut@Notebook[{Cell[BoxData[ ButtonBox[(x = (x + 1)), RuleDelayed[ButtonFunction, CompoundExpression[If[Not[ ValueQ[x]], Set[x, 0]], Set[x, Plus[x, 1]]]], Rule[ButtonEvaluator, Automatic]] ], NotebookDefault, PageBreakAbove -> True, CellTags -> GeneratedButtonBoxx=x+1]}, ClosingAutoSave -> True, Editable -> False, WindowToolbars -> {}, PageWidth -> 299.5, WindowSize -> {89., 29.}, WindowMargins -> {{92., Automatic}, {Automatic, 56.}}, WindowFrame -> Palette, WindowElements -> {}, WindowFrameElements -> CloseBox, WindowClickSelect -> False, ScrollingOptions -> {PagewiseScrolling -> True}, ShowCellBracket -> False, CellMargins -> {{0., 0.}, {Inherited, 0.}}, Active -> True, CellOpen -> True, ShowCellLabel -> False, ShowCellTags -> False, ImageMargins -> {{0., Inherited}, {Inherited, 0.}}, Magnification -> 1.5] (* ********************************* *) Now, how do you create such a button in less than a minute? ... : One way is to just create a section cell and the underlying ButtonFunction code as input cells, i.e., type interactively such that you get something like: NotebookPut[Notebook[ {Cell[CellGroupData[ {Cell[x=x+1, Section], Cell[If[!ValueQ[x], x=0], Input], Cell[x=x+1, Input]}, Open]]}]] Then hit the F2B (function to Button) button in ButtonTools.nb ( my freeware button tools from http://www.mertig.com/mathdepot ) and you get the button. With the HP and VP you can easily and quickly generate (horizontally or verically) palettes. Check out the Help button, or also the source code. It basically is all straightforward and there is actually documentation about all those ButtonFunction features somewhere. I agree that the whole Button-design could have been made better, but up to a point is quite useful. Of course the world is used to better GUI's these days but if you really need nice GUI's and buttons, use Java and JLink ( and there are also simple examples in the JLink manual of how to do this ). If you don't like Java, go with VBA and use the nice Mahematica for Active X product from http://www.episoft.com Rolf Mertig Mertig Consulting http://www.mertig.com ==== try In[1]:=Clear[a,b,c,d,x,y] x= {{0,0,0,1},{1,0,0,1},{0,1,0,1},{1,1,1,1}}; y = {a,b,c,d}; LinearSolve[x,y] s01= LinearSolve[x,y][[1]] Out[4]={-a+b,-a+c,a-b-c+d,a} Out[5]=-a+b In[6]:=g[a_,b_] =s01 Out[6]=-a+b In[7]:=g[1,3] Out[7]=2 *NEVER* use capital letters at the beginning of a variable's name! Never! Why? Here's a piece of a conversion I had with Mathematica. Why is a[A_,B_] := LinearSolve[X,Y][[1]] not giving me the function I expect? In[261]:= X = {{0,0,0,1},{1,0,0,1},{0,1,0,1},{1,1,1,1}}; In[262]:= Y = {A,B,C,D}; In[263]:= LinearSolve[X,Y] Out[263]= {-A+B,-A+C,A-B-C+D,A} In[264]:= LinearSolve[X,Y][[1]] Out[264]= -A+B In[265]:= a[A_,B_] := LinearSolve[X,Y][[1]] In[266]:= a[1,3] Out[266]= -A+B The output above is not what I want. I want 2. Here's what I expect: In[267]:= a[A_,B_] := -A+B; In[268]:= a[1,3] Out[268]= 2 This output is what I expect. What is the difference between the two? ==== First of all, just look at your own posting below. You clearly have a *(Times) where a , (comma) should be. Presumably your input ought to be: n = 5; NDSolve[{D[[Sigma]norm[z, t], t] == 3*z*Integrate[[Sigma]norm[z, t]^n*z, {z, 0, 1}] - [Sigma]norm[z, t]^n, [Sigma]norm[z, 0] == 1.5*z, [Sigma]norm[0, t] == 0},[Sigma]norm[z, t], {z, 0.01, 1}, {t, 0.01, 2}] However, even in the corrected version the equation can't be solved. First of all you will get the complaint: NDSolve::bcedge: Boundary conditions must be specified at the edge of the spatial domain. In other words Mathematica wants a boundary condition for [Sigma]norm[z, 0.1] or alternatively you should use {z,0,1} in NDSolve. But actually I do not think this equation is solvable by any numerical scheme even if you could provide the initial conditions at the edge of the boundary that Mathematica requests. To evaluate the integral in your equation NDSolve needs to know the values of [Sigma]norm[z, t] for all z between 0 and 1 and a given t, but this knowledge is not available at any stage of the evaluation. I am not really an expert, but this seems to me a clear example of an equation that is not solvable by any numerical means. By the way, the fact that you know a solution to a differential equation, and even the fact that the solution is very simple does not imply that the equation can be solved by any known method, except of course guessing, which computer programs generally do not use. NDSolve seems to have difficulties with solving integral equation. n = 5; NDSolve[{D[[Sigma]norm[z, t], t] == > 3*z*Integrate[[Sigma]norm[z, > t]^n*z, {z, 0, 1}] - [Sigma]norm[z, t]^n, > [Sigma]norm[z, 0] == 1.5*z, [Sigma]norm[0, t] == > 0}*[Sigma]norm[z, > t], {z, 0.01, 1}, {t, 0.01, 2}] Mathematica returns a message NDSolve::deql: The first argument must have both an equation and an > initial condition. which I cannot understand. > Can anybody tell what's wrong with my attempt? ==== >Here's a piece of a conversion I had with Mathematica. >Why is a[A_,B_] := LinearSolve[X,Y][[1]] not giving >me the function I expect? In[261]:= X = {{0,0,0,1},{1,0,0,1},{0,1,0,1},{1,1,1,1}}; >In[262]:= Y = {A,B,C,D}; >In[263]:= LinearSolve[X,Y] >Out[263]= {-A+B,-A+C,A-B-C+D,A} >In[264]:= LinearSolve[X,Y][[1]] >Out[264]= -A+B >In[265]:= a[A_,B_] := LinearSolve[X,Y][[1]] >In[266]:= a[1,3] >Out[266]= -A+B The output above is not what I want. I want 2. Here's >what I expect: In[267]:= a[A_,B_] := -A+B; >In[268]:= a[1,3] >Out[268]= 2 This output is what I expect. What is the difference between >the two? X={{0,0,0,1},{1,0,0,1}, {0,1,0,1},{1,1,1,1}}; Y={A,B,C,D}; a[A_,B_]:= LinearSolve[X,Y][[1]]; ?a Global`a a[A_, B_] := LinearSolve[X,Y][[1]] Note that the RHS of the stored definition is not a function of the arguments. Now add Evaluate to RHS a[A_,B_]:= Evaluate[LinearSolve[X,Y][[1]]]; ?a Global`a a[A_, B_] := -A + B a[1,3] 2 ==== All of this looks like a mistake to me because it seems far too easy. But anyway, here is the solution that makes almost no use of Mathematica. First of all, your equation is not a differential equation so there is no point using DSolve. Secondly the use of z in Integrate[[Sigma]norm[z]^n*z, {z, 0, d}] is deceptive, since you are integrating over z, so let's replace it by something else, say s. So your equation is: (3*z)/d^3)*Integrate[[Sigma]norm[s]^n*s, {s, 0, d}] ==[Sigma]norm[z]^n which is supposed to hold true for every z>0. Re-write it as Integrate[[Sigma]norm[s]^n*s, {s, 0, d}]/d^3 =[Sigma]norm[z]^n/3z for all z. However, the left hand side is a function of d, independent of z, so we can write: [Sigma]norm[z_]:=(3z*g[d])^(1/n) Let's take this as a definition and substitute in the original equation In[2]:= Simplify[((3*z)*Integrate[[Sigma]norm[s]^n*s, {s, 0, d}])/d^3 == [Sigma]norm[z]^n, {d > 0, n > 0, z > 0}] Out[2]= True That means you can take g to be an arbitrary function of d. Andrzej Kozlowski Toyama International University JAPAN On Friday, August 23, 2002, at 05:25 AM, Toshiyuki ((Toshi)) Meshii > How can I solve the following integral equation? > Mathematica seems not to work. > Is there any way? DSolve[((3*z)/d^3)*Integrate[[Sigma]norm[z]^n*z, {z, 0, d}] == > [Sigma]norm[z]^n, [Sigma]norm[z], z] note: z>0 & n>1 I know that the answer is simple and > $B&R(Bnorm[z_] = (1 + 1/(2*n))*(z/d)^(1/n) ==== But suddenly the following Errormessage appears: /usr/bin/local/mathematica: file or directory not found Mandrake-updates ... but so far everything except of Mathematica seems to work fine.) Of course I checked for the File (it is indeed there) and (a hint from a Unix-usegroup) the needed libs libc.so.5, libm.so.5 are in /lib/ too. Had anyone had, ore better solved, a similar problem? ==== How can I create a Mathematica thing (function? program?) that would automatically open a browser page, and give my username and pwd to log me into a https:.... site? The server's login page has a script resetting fields: and the relevant input cells are ==== Howdy, I'm trying to figure out the correct syntax to do the following. I have some function with three arguments, and I want to syntactically describe the single-argument function that holds two of those arguments constant (i.e. without creating that single-argument function). More specifically, I have defined Machine[radix_,multiplier_,state_] := Module [{c,s}, c = Floor[state/base]; s = Mod[state,base]; multiplier*s + c ] where I have a generalize 'machine', defined by the radix and multiplier, which converts one state into another state. So I'd like to be able to do something like this: NestList[Machine[10,7,#], 3, 22] to get the series of states that the radix-10 multiplier-7 machine runs through (starting with state 3). However, this syntax doesn't seem to do what I want. I hope that description makes sense. It seems like there must be a syntax to describe the function Machine[10,7,#]. Anyone have any ideas? Bob H ==== There is a following problem with Mathematica 4.2: >when i try to load Help Browser, i get a message: >building help browser index (first time only) >scanning index file >and Mathematica stops responding: you have to >kill process. There was no such a problem with >version 4.1. Is there is a solution to that? I'd start with the following FAQ. http://support.wolfram.com/mathematica/interface/helpbrowser/howrebuildindex .html ==== There is a following problem with Mathematica 4.2: > when i try to load Help Browser, i get a message: > building help browser index (first time only) > scanning index file > and Mathematica stops responding: you have to > kill process. There was no such a problem with > version 4.1. Is there is a solution to that? > I have the exact same problem with 4.2 (on Win2K) :( ==== >I'd start with the following FAQ. http://support.wolfram.com/mathematica/interface/helpbrowser/howrebuildinde x.html -Dale Sorry that i failed say it immediately in a first place, but of course i did try it FAQ at first, and both tried to delete cache and rebuild index, but results where the same - whenever i try to invoke help browser (or rebuild index, for that matter), mathematica stops responding (i did read your answer to the same question asked a week ago before - actually that is why i turned to the FAQ). ==== People encounter this all the time. It is because SelectionEvaluate does not do what you think. It does not work like ToExpression, which causes immediate kernel evaluation. Instead it works like when you press Shift-Enter, which selects a cell for evaluation after all current evaluations have finished. See http://support.wolfram.com/mathematica/kernel/interface/selectionevaluate.ht ml -Dale Trying to manipulate notebooks from the kernel I found >an unexpected bahavior with Mathematica. First I tried the following commands one by one (they are not int >the same cell, and they are not selected at same time >for evaluation) nb = NotebookCreate[]; >i = 0; >(* Purpose is a Do loop here *) >NotebookDelete[nb] (*1*) >NotebookWrite[nb, ++i, All] (*2*) >SelectionEvaluate[nb] (*3*) >SelectionMove[nb, All, Cell] (*4*) If I repeat evaluating coomands (*1,2,3,4*) one by one >what is shown in the created notebook is an animation >of the index i in the same cell. >Naturally a loop must do the job. However when I >intent to collect (*1,2,3,4*) in the same cell the >result is not the same even whitout the Do loop (I >mean just evaluating this cell several times) I would be grateful if some can explain what's going >on here or if there is something wrong with my >machine. Cesar >__________________________________________________ >Do You Yahoo!? >Yahoo! Finance - Get real-time stock quotes >http://finance.yahoo.com ==== >Here's a piece of a conversion I had with Mathematica. >Why is a[A_,B_] := LinearSolve[X,Y][[1]] not giving >me the function I expect? In[261]:= X = {{0,0,0,1},{1,0,0,1},{0,1,0,1},{1,1,1,1}}; >In[262]:= Y = {A,B,C,D}; >In[263]:= LinearSolve[X,Y] >Out[263]= {-A+B,-A+C,A-B-C+D,A} >In[264]:= LinearSolve[X,Y][[1]] >Out[264]= -A+B >In[265]:= a[A_,B_] := LinearSolve[X,Y][[1]] >In[266]:= a[1,3] >Out[266]= -A+B The output above is not what I want. I want 2. Here's >what I expect: In[267]:= a[A_,B_] := -A+B; >In[268]:= a[1,3] >Out[268]= 2 This output is what I expect. What is the difference between >the two? This is a common misconception about what := does. What it does is set up a variable replacement for the unevaluated expression, not the evaluated expression. So a[A_,B_] := LinearSolve[X,Y][[1]] a[1,3] is similar to doing ReleaseHold[ Hold[ LinearSolve[X,Y][[1]] ] /. {A->1, B->3} ] which means that only explicit instances of A and B are replaced. What you are attempting is done with =. This assigns the function to the evaluated expression. In[5]:=a[A_,B_] = LinearSolve[X,Y][[1]] Out[5]=-A+B In[6]:=a[1,3] Out[6]=2 There are certain situations where you get a different result if you evaluate with the values or replace the values in the symbolic evaluation. (This example is not one of them.) Using = does the later. If you want to do the former, you should use := and have the right hand side use A and B explicitly or you could use a Block. In[7]:=a[b_,c_] := Block[{A=b, B=c}, LinearSolve[X,Y][[1]] ] In[8]:=a[1,3] Out[8]=2 -------------------------------------------------------------- Omega Consulting The final answer to your Mathematica needs Spend less time searching and more time finding. http://www.wz.com/internet/Mathematica.html ==== >Normally I don't feel so stupid, but I'm trying to create an interactive >Mathematica notebook, and I'm stuck at square one. Specifically, how do I do something like create a button to add a number (or >perform other mathematical functions) and then display or otherwise >manipulate the result (eventually I want to be able to click a button that >increments/decrements an angle and animate the resulting transformation of a >vector, with an eye to finally simulating a simple robotic arm complete with >simple controls to manipulate the arm). I want to have a variable (or matrix or whatever) defined as a global >variable x, and then perform x = x+1 when a button is clicked. I've been >using and programming computers for almost 25 years and I can't follow >Wolfram's documentation. Is it just me, or is he always this obtuse when >explaining things? I mean, given the amazing power of the Mathematica >system, a sample list of buttons in a notebook that you could select and >examine how they were implemented, would have been nice. I can't find such a >list, and this seems to be par for the course for the rest of the >documentation as well. Button programming can be very confusing at first. It has a whole series of quirks that make it in many ways unique to Mathematica and programming in general. This causes a lot of head-scratching, but once you understand what's going on things get easier. The key is to create a button that uses the kernel (by default it only uses the front end). Here's a simple example to help you get started. In[1]:= x=1; In[2]:=ButtonBox[Increment x,Active->True, ButtonEvaluator->Automatic, ButtonFunction:>Print[x = ,++x] ]//DisplayForm Some random things to note: - ButtonEvaluator->Automatic. This says use the kernel to implement the ButtonFunction. - Buttons only create side-effects. They generate no output. What you see when you press the button is the result of 2 side effects. One from ++, which changes the value of x. The other from Print, which creates a cell. - Print is, in general, a poor side-effect to use in a button. It's difficult to control where the Print cell is placed. It is worth your while to learn how to use other front end side-effect functions (such as NotebookRead and NotebookWrite) when using buttons. Here are some further resources you might find helpful: http://support.wolfram.com/mathematica/interface/buttons/ http://library.wolfram.com/conferences/devconf99/hinton/Buttons19991022.nb http://library.wolfram.com/conferences/devconf2001/horton2/horton2.nb ==== How do I change format used for tick mark labels in a 2D plot? I would like to use DigitBlock->3 option of NumberForm to format large numbers appearing as tick mark labels on a histogram. Alexander ==== As Daniel Lichtblau pointed out, the statement below about vertices is nonsense. Consider two overlapping rectangles arranged as a cross. You need to compute intersections and test them instead of vertices. Begin forwarded message: Begin forwarded message: Dear colleagues, any hints on how to implement a very fast routine in Mathematica for > testing if two rectangles have an intersection area? > Here is one approach. Given three points {x1,y1},{x2,y2},{x3,y3}, switch to homogenous > coordinates a={1,x1,y1}, b={1,x2,y2}, c={1,x3,y3}. Then > Sign[Det[{a,b,c}]] is +1 if and only if the point a lies on your left as > you walk along the line though b and c in the direction from b to c. > ( If the result is zero, then a lies on the line.) The value of the determinant is x2y3-x3y2-x1y3+x3y1+x1y2-x2y1, and the > speed of the algorithm depends essentially on how fast this quantity can > be computed. Suppose we write a function LeftSide[a,{b,c}] that computes > the sign of the determinant. Now let {p1,p2, . . ., pn} be a list of vertices (pi={xi,yi}) of a > convex polygon traced counterclockwise. Then a lies within or on the > boundary of the polygon if and only if none of the numbers > LeftSide[a,{pi,p(i+1)}] are -1. That is, if -1 does not appear in the > list LeftSide[a,#]&/@Partition[{p1,p2,. . .,pn,p1},2,1]. Now use the fact that if two convex polynomials overlap, then some > vertex of one of them must lie inside or on the boundary of the other. If an overlap of positive area is required, then the check is that only > +1 appears--not that -1 does not appear. For two rectangles ( or parallelograms) this approach requires the > evaluation of 16 determinants, so it may be a bit expensive. If the > points have rational coordinates, then (positive) denominators may be > cleared in the homogeneous coordinates and the computations can be done > in integer arithmetic, at the cost of at least three more > multiplications per determinant. Garry Helzer Department of Mathematics University of Maryland College Park, MD 20742 301-405-5176 gah@math.umd.edu ==== While playing arounf with patterns and substitutions, I came across the following behavior which I didn't expect: z := SomeHead[{{1, 2}, {3, 4}}] z /. {SomeHead[q_] -> Flatten[q]} While this _does_ yield the desired result {1,2,3,4}, Mathematica complains: Flatten::normal: Nonatomic expression expected at position 1 in Flatten[q]. ........as if it is trying to evaluate Flatten[q], with q not bound to {{1,2},{3,4}}. Could anybody explain why this happens? Sidney Cadot ==== > While playing arounf with patterns and substitutions, I came across the > following behavior which I didn't expect: z := SomeHead[{{1, 2}, {3, 4}}] > z /. {SomeHead[q_] -> Flatten[q]} While this _does_ yield the desired result {1,2,3,4}, Mathematica complains: Flatten::normal: Nonatomic expression expected at position 1 in > Flatten[q]. ........as if it is trying to evaluate Flatten[q], with q not bound to > {{1,2},{3,4}}. Could anybody explain why this happens? > Sidney Cadot during the Replaceall (/.) Mathematica first evaluate the rule SomeHead[q_] -> Flatten[q] . q is stilla symbol then and will be replaces when /. is used. You can avoid this Problem by using a delayed rule SomeHead[q_] :> Flatten[q] or using thr Rule Somehead->Flatten. Yours, Alexander -- / Alexander Dreyer, Dipl.-Math. - Abteilung Adaptive Systeme / Fraunhofer Institut fuer Techno- und Wirtschaftsmathematik (ITWM) Gottlieb-Daimler-Strasse, Geb. 7^2=49/313 D-67663 Kaiserslautern / ==== > ............... I came across the > following behavior which I didn't expect: z := SomeHead[{{1, 2}, {3, 4}}] > z /. {SomeHead[q_] -> Flatten[q]} While this _does_ yield the desired result {1,2,3,4}, Mathematica complains: Flatten::normal: Nonatomic expression expected at position 1 in > Flatten[q]. >............ > Could anybody explain why this happens? Sidney, The clue is that, before any replacing is done, z is evaluated to SomeHead[{{1, 2}, {3, 4}}]; SomeHead[q_] is evaluated to SomeHead[q_] Flatten[q] is evaluated to Flatten[q] and the message is generated saying essentially nothing to flatten. *Then* the replacement SomeHead[{{1, 2}, {3, 4}}] /. {SomeHead[q_] -> Flatten[q]} is performed. It would be better here to use RuleDelayed, :>, instead of Rule, ->, since Flatten[q] would not then be evaluated. z:=SomeHead[{{1,2},{3,4}}] z/.{SomeHead[q_]:>Flatten[q]} {1,2,3,4} ==== Never mind my question, I should have used a delayed rule there (:> instead of ->). Bit silly of me. ==== Suppose f is a function of n real variables, and returns a vector of n real variables. What is the correct syntax to find a root of f using FindRoot? For instance, the following works with n=7, but I would need to change the code if I changed the value of n: f[p_] := Table[fk[p, k], {k,n}]; pn = {p1,p2,p3,p4,p5,p6,p7}; f1 := f[pn] [[1]]; f2 := f[pn] [[2]]; f3 := f[pn] [[3]]; f4 := f[pn] [[4]]; f5 := f[pn] [[5]]; f6 := f[pn] [[6]]; f7 := f[pn] [[7]]; theRoot = FindRoot[{f1==0,f2==0,f3==0,f4==0,f5==0,f6==0,f7==0}, {p1, 1/n},{p2, 1/n},{p3, 1/n},{p4, 1/n},{p5, 1/n}, {p6, 1/n},{p7, 1/n}]; -- John MacCormick Systems Research Center, HP Labs, 1501 Page Mill Road, ==== >I'm trying to figure out the correct syntax to do the following. I have >some function with three arguments, and I want to syntactically describe >the >single-argument function that holds two of those arguments constant (i.e. >without creating that single-argument function). More specifically, I have defined Machine[radix_,multiplier_,state_] := Module [{c,s}, > c = Floor[state/base]; s = Mod[state,base]; > multiplier*s + c > ] where I have a generalize 'machine', defined by the radix and multiplier, >which converts one state into another state. So I'd like to be able to >do >something like this: NestList[Machine[10,7,#], 3, 22] to get the series of states that the radix-10 multiplier-7 machine runs >through (starting with state 3). However, this syntax doesn't seem to >do >what I want. I hope that description makes sense. It seems like there must be a syntax >to describe the function Machine[10,7,#]. > I assume that you want base rather than radix in the definition (or vice versa). Machine[base_, multiplier_, state_]:= Module[{c, s}, c=Floor[state/base]; s=Mod[state, base]; multiplier*s+c]; NestList[Function[Machine[10,7,#]],3,22] {3, 21, 9, 63, 27, 51, 12, 15, 36, 45, 39, 66, 48, 60, 6, 42, 18, 57, 54, 33, 24, 30, 3} The abbreviation for Function[body] is body& %==NestList[Machine[10, 7, #]&, 3, 22] True ==== >While playing arounf with patterns and substitutions, I came across the >following behavior which I didn't expect: z := SomeHead[{{1, 2}, {3, 4}}] >z /. {SomeHead[q_] -> Flatten[q]} While this _does_ yield the desired result {1,2,3,4}, Mathematica complains: Flatten::normal: Nonatomic expression expected at position 1 in >Flatten[q]. ........as if it is trying to evaluate Flatten[q], with q not bound to >{{1,2},{3,4}}. Could anybody explain why this happens? z:=SomeHead[{{1,2},{3,4}}] The error is associated with defining the Rule not executing it. Note that you get the error with {SomeHead[q_]->Flatten[q]}; Use RuleDelayed z/.{SomeHead[q_]:>Flatten[q]} {1, 2, 3, 4} ==== Can anyone help me with this problem. If I have an n-element list, (say where each element is itself a list), such as {{a,b}, {a,b}, {a,b}} is there a way to strip off the outermost nesting of the list to obtain just a sequence of of these n elements, that is {a,b},{a,b},{a,b} so that I can use this for input for some function. I would like to do something like Outer[SomeFunction, Table[{a,b},{N} ]] where I can enter N dynamically. The problem, of course, is that the output of the Table command is one big list and Outer is expecting a sequence of N separate lists after SomeFunction. ==== Bob, Apply[Sequence,{{a,b},{c,d}}] Sequence[{a,b},{c,d}] Outer[F,Apply[Sequence,Table[{a,b},{3}]]] {{{F[a,a,a],F[a,a,b]},{F[a,b,a],F[a,b,b]}},{{F[b,a,a],F[b,a,b]}, {F [b,b,a],F[b,b,b]}}} --- > Can anyone help me with this problem. If I have an n-element list, (say where each element is itself a > list), such as {{a,b}, {a,b}, {a,b}} > is there a way to strip off the outermost nesting of the list to > obtain just a sequence of of these n elements, that is > {a,b},{a,b},{a,b} so that I can use this for input for some function. I would like to do something like > Outer[SomeFunction, Table[{a,b},{N} ]] where I can enter N > dynamically. > The problem, of course, is that the output of the Table command is one > big list > and Outer is expecting a sequence of N separate lists after > SomeFunction. ==== Can anyone help me with this problem. If I have an n-element list, (say where each element is itself a > list), such as {{a,b}, {a,b}, {a,b}} > is there a way to strip off the outermost nesting of the list to > obtain just a sequence of of these n elements, that is > {a,b},{a,b},{a,b} so that I can use this for input for some function. I would like to do something like > Outer[SomeFunction, Table[{a,b},{N} ]] where I can enter N > dynamically. > The problem, of course, is that the output of the Table command is one > big list > and Outer is expecting a sequence of N separate lists after > SomeFunction. > Sequence@@{{a,b}, {a,b}, {a,b}} resp. Apply[Sequence, {{a,b}, {a,b}, {a,b}}] will do it. -- / Alexander Dreyer, Dipl.-Math. - Abteilung Adaptive Systeme / Fraunhofer Institut fuer Techno- und Wirtschaftsmathematik (ITWM) Gottlieb-Daimler-Strasse, Geb. 7^2=49/313 D-67663 Kaiserslautern / ==== some function with three arguments, and I want to syntactically describe the single-argument function that holds two of those arguments constant (i.e. without creating that single-argument function). More specifically, I have defined Machine[radix_,multiplier_,state_] := Module [{c,s}, c = Floor[state/base]; s = Mod[state,base]; multiplier*s + c ] where I have a generalize 'machine', defined by the radix and multiplier, which converts one state into another state. So I'd like to be able to do something like this: NestList[Machine[10,7,#], 3, 22] to get the series of states that the radix-10 multiplier-7 machine runs through (starting with state 3). However, this syntax doesn't seem to do what I want. I hope that description makes sense. It seems like there must be a syntax to describe the function Machine[10,7,#]. Anyone have any ideas? Bob H ==== Sidney, With a direct rule Mathematica tries to Flatten the symbol q immediately. You want a delayed rule to avoid the error message. z /. SomeHead[q_] :> Flatten[q] {{1,2},{3,4}}. Could anybody explain why this happens? ==== You are quite right, Mathematica does evaluate Flatten[q] before substituting {{1, 2}, {3, 4}}. It then issues the error message and returns Flatten[q]. Only now {{1, 2}, {3, 4}} is substituted for q, Flatten[{{1, 2}, {3, 4}}] is evaluated and you get the right answer. To avoid all this just use RuleDelayed instead of Rule: In[1]:= z := SomeHead[{{1, 2}, {3, 4}}]; In[2]:= z /. {SomeHead[q_] :> Flatten[q]} Out[2]= {1,2,3,4} Andrzej Kozlowski Toyama International University JAPAN While playing arounf with patterns and substitutions, I came across the > following behavior which I didn't expect: z := SomeHead[{{1, 2}, {3, 4}}] > z /. {SomeHead[q_] -> Flatten[q]} While this _does_ yield the desired result {1,2,3,4}, Mathematica > complains: Flatten::normal: Nonatomic expression expected at position 1 in > Flatten[q]. ........as if it is trying to evaluate Flatten[q], with q not bound to > {{1,2},{3,4}}. Could anybody explain why this happens? ==== > [...] Y = {A,B,C,D}; [...] > In[265]:= a[A_,B_] := LinearSolve[X,Y][[1]] > In[266]:= a[1,3] > Out[266]= -A+B The output above is not what I want. I want 2. [...] You are mixing the (global (*)) symbols A and B with the (local (*)) patterns A_ and B_. If you want to replace the (global) solution with local values you should write In[4]:= a[AA_, BB_] := LinearSolve[X, Y][[1]] /. {A -> AA, B -> BB}; a[1, 3] Out[5]= 2 ________________ (*) as far we can say that in Mathematica -- Rainer Gruber ==== NestList[Machine[10,7,#], 3, 22] You almost have it: NestList[Machine[10,7,#]&, 3, 22] More elegantly, you can defined Machine this way: Machine[radix_,multiplier_][state_] := ... Then you can write NestList[Machine[10,7], 3, 22] ==== > z := SomeHead[{{1, 2}, {3, 4}}] > z /. {SomeHead[q_] -> Flatten[q]} While this _does_ yield the desired result {1,2,3,4}, Mathematica complains: Flatten::normal: Nonatomic expression expected at position 1 in > Flatten[q]. The -> operator is prompt: It permits evaluation of the RHS Flatten[q] immediately, before it is used in the substitution. Evidently, q was undefined before you tried this, so Flatten[q]'s evaluation yielded itself. Later, in the process of substitution, with q set as you intended, Flatten evaluated again, this time yielding the desired result. Try it again after setting q to something. Then you get not only the complaint but also the wrong answer. To avoid these issues, use the delayed operator :> instead of the prompt operator ->. A rule of thumb is: Use delayed operators := and :> when the LHS (SomeHead[q_] in your case) contains a blank (_). ==== Mark: In: ?K Out: K is a default generic name for a summation index in a symbolic sum. Turns out that there are seven single-letter symbols. In: ClearAll[Global`*]; Select[Names[*], (StringLength[#] == 1) &] Out: {C, D, E, I, K, N, O} K is a little weird, because it's not Protected. In: Attributes[{C, D, E, I, K, N, O}] Out: {{NHoldAll, Protected}, {Protected, ReadProtected}, {Constant, Protected, ReadProtected}, {Locked, Protected, ReadProtected}, {}, {Protected}, {Protected, ReadProtected}} ---- Selwyn Hollis > I just learned that K is a System` Symbol: > Information[K] > Context[K] > I learned this due to an error message: > Block[{K = 1}, Sum[j, {j, i}]] > The same message can be generated by the following: > K := 1 > Sum[j, {j, i}] > The message can be eliminated by Removing K: > Remove[K] > Block[{K = 1}, Sum[j, {j, i}]] > K := 1 > Sum[j, {j, i}] > Surely, this is not intentional. > --Mark. > ==== I have convert pde to ode like this du_i/dt = 1-4 u_i + .02 (u_i-1 ö 2 u_i + u i+1)/(delta (x))^3 + (u_i)^3 v_i dv_i /dt = 3 u_i + .02 (v_i-1 ö 2 v_i + u i+1)/(delta (x))^3 - (u_I)^3 v_i delta(x)=(i)/(N+1) x_i= (i)/(N+1) Boundary condition u_0 (t) = 1 = u_N+1(t) v_0(t) = 3 = v_N+1(t), Initial conditio u_i(0) = 1+sin (2 pi x_i ) v_i = 3 For i = 1,·., N Time Interval =[t_o, t_end] = [0,10] Could i get code in Mathematica (by using Euler of 4 Runge - Kutta..)to solve this ordinary differential equation. ==== > I have convert pde to ode like this du_i/dt = 1-4 u_i + .02 (u_i-1 ? 2 u_i + u i+1)/(delta (x))^3 + (u_i)^3 > v_i dv_i /dt = 3 u_i + .02 (v_i-1 ? 2 v_i + u i+1)/(delta (x))^3 - (u_I)^3 > v_i delta(x)=(i)/(N+1) x_i= (i)/(N+1) Boundary condition > u_0 (t) = 1 = u_N+1(t) > v_0(t) = 3 = v_N+1(t), Initial conditio > u_i(0) = 1+sin (2 pi x_i ) > v_i = 3 > For i = 1,?., N > Time Interval =[t_o, t_end] = [0,10] Since this is 1+1 dimensional initial value problem, Mathematica can do the discretization for you automatically. Just use NDSolve[{ D[u[t, x], t] == 1 - 4 u[t, x] + 0.02 D[u[t, x], x, x] + u[t, x]^3 v[t, x], D[v[t, x], t] == 3u[t, x] + 0.02 D[v[t, x], x, x] + u[t, x] ^3v[t, x], u[t, 0] == u[t, 1] == 1, u[0, x] == 1 + Sin[2 Pi x], v[t, 0] == v[t, 1] == 3, v[0, x] == 3}, {u, v}, {t, 0, 10}, {x, 0, 1}] Mathematica by default uses fourth order differences instead of the second order you specified above. If you really want second order spatial differences with the exact spacing you defined, you can use NDSolve[{D[u[t, x], t] == 1 - 4 u[t, x] + 0.02 D[u[t, x], x, x] + u[t, x]^3 v[t, x], D[v[t, x], t] == 3u[t, x] + 0.02 D[v[t, x], x, x] + u[t, x] ^3v[t, x], u[t, 0] == u[t, 1] == 1, u[0, x] == 1 + Sin[2 Pi x], v[t, 0] == v[t, 1] == 3, v[0, x] == 3}, {u, v}, {t, 0, 10}, {x, 0, 1}, StartingStepSize -> 1./206, MaxSteps -> {1000, 300}, DifferenceOrder -> 2] Interestingly enough, either way you do it, Mathematica is only able to carry out the solution out to about t == 0.035 or so. This appears to be because the nonlinearity is causing the solution to form a nonsingularity which appears as a cusp with rapidly rising height. is because of the (delta (x))^3 in .02 (u_i-1 ? 2 u_i + u i+1)/(delta (x))^3 Any finite difference formula for the second derivative on a uniform grid will involve (delta (x))^2 -- i.e. squared, not cubed. At a fixed grid space, the extra power will have the effect of making the diffusion coefficient larger by a factor of n (which for your range of interest effectively removes to formation of the discontinuity). Presumably the (delta (x))^3 was a typo as was the u_i+1 instead of v_i+1 in .02 (v_i-1 ? 2 v_i + u i+1) However, if you really wanted the cubed power, here is how you could manually do the discretization with Mathematica: n = 205; X = N[Range[1, n]/(n + 1)]; U[t_] = Map[u[#][t] &, Range[1, n]]; V[t_] = Map[v[#][t] &, Range[1, n]]; eqns = Join[ Thread[D[U[t], t] == 1 - 4 U[t] + 0.02 ListCorrelate[N[{1, -2, 1} n^3], U[t], {2, 2}, 1] + U[t]^3 V[t]], Thread[ D[V[t], t] == 3 U[t] + 0.02 ListCorrelate[N[{1, -2, 1} n^3], V[t], {2, 2}, 3] + U[t]^3 V[t]], Thread[U[0] == 1 + Sin[X]], Thread[V[0] == 3 + 0. X]]; NDSolve[eqns, Join[U[t], V[t]], {t, 0, 10}] > Could i get code in Mathematica (by using Euler of 4 Runge - Kutta..)to > solve this ordinary differential equation. I do not recommend solving this with either an Euler method or a RungeKutta method for the reason that the potential formation of discontinuities could make the ODEs stiff. The default method Mathematica uses automatically switches to methods appropriate for stiff ODEs when needed. If you want to use a RungeKutta method, you can use NDSolve[eqns, Join[U[t], V[t]], {t, 0, 10}, Method->RungeKutta] This uses the Runge-Kutta-Fehlberg 4(5) method. ==== I am a newbie to mathematica. I have a 14 functions which are the function of r,theta and phi. I want to do some mathematical operation over them. How can I do? Can it be possible to call them in Do or For loop with some index? Please suggest. Raj ==== Is there an easy (elegant?) way to generate the set of all k-tuples taking values from some set (list) S? I want the arguments of the function to be k (the length of the tuples) and the set S. That is, KTuples[3,{a,b}] should produce {{a,a,a},{a,a,b},{a,b,a},{a,b,b},{b,a,a},{b,a,b},{b,b,a},{b,b,b}}. ==== KTuples[n_,lst_]:= Distribute[Table[{a,b},{n}],List] KTuples[3,{a,b}] {{a,a,a},{a,a,b},{a,b,a},{a,b,b},{b,a,a},{b,a,b},{b,b,a},{b,b,b}} -- Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 > Is there an easy (elegant?) way to generate the set of all k-tuples > taking values from some set (list) S? I want the arguments of the > function to be k (the length of the tuples) and the set S. That is, > KTuples[3,{a,b}] should produce > {{a,a,a},{a,a,b},{a,b,a},{a,b,b},{b,a,a},{b,a,b},{b,b,a},{b,b,b}}. > ==== Here's my contestant: < Is there an easy (elegant?) way to generate the set of all k-tuples > taking values from some set (list) S? I want the arguments of the > function to be k (the length of the tuples) and the set S. That is, > KTuples[3,{a,b}] should produce > {{a,a,a},{a,a,b},{a,b,a},{a,b,b},{b,a,a},{b,a,b},{b,b,a},{b,b,b}}. > ==== > Is there an easy (elegant?) way to generate the set of all k-tuples > taking values from some set (list) S? I want the arguments of the > function to be k (the length of the tuples) and the set S. That is, > KTuples[3,{a,b}] should produce > {{a,a,a},{a,a,b},{a,b,a},{a,b,b},{b,a,a},{b,a,b},{b,b,a},{b,b,b}}. Here's a first implementation: ktuples[k_, set_List] := Map[ set[[#]] &, Flatten[ Array[ List, Table[ Length[set], {k}]], k - 1]] In[31]:= ktuples[3,{a,b}] Out[31]= {{a,a,a},{a,a,b},{a,b,a},{a,b,b},{b,a,a},{b,a,b},{b,b,a},{b,b,b}} ==== Does anyone know if there are any publications that describe the integration of above? In particular I am working with a 4 gaussian process with joint pdf p(x1,y1,x2,y2) transformed to-> p(r1,r2,theta1,theta2), the processes have non-zero mean and I would like to integrate the joint pdf twice (over r1 and r2) and obtain an expression for the pdf of the phase angles between p(theta1,theta2). I could assume that the means are the same (to make life easier). Has anyone come accross this - it doesn't seem that unusual to me. I am asking because the integrals are becoming 'interesting'. thankyou for any tips. ==== Start Excel and go to Tools -> Macro -> Security..., then on the Security Level tab click on Medium and then click OK. ----- Original Message ----- > My original version of MathLink for Excel (MLX.xla) was for Excel 97, and > It worked fine. Then I upgraded the package to Excel 2000 by unloading the > macro from the Wolfram site. It continued working perfectly on my old > environment (Windows 98 + Mathematica 4.1). > But I recently upgraded to Mathematica 4.2 under Windows 2000; and when > trying to load the macro (MLX.xla) for Excel2000, I got (in Excel 2000) > the > following message: This workbook contains a type of macro (Microsoft > Excel > version 4.0 macro) that cannot be disable nor signed. Therefore, this > workbook cannot be opened under high security level. > Does any one have any experience on this? > > Emilio Martin-Serrano > > ==== Download the newest patch from wolfram research - this should theoretically help. > Group, My original version of MathLink for Excel (MLX.xla) was for Excel 97, and > It worked fine. Then I upgraded the package to Excel 2000 by unloading the > macro from the Wolfram site. It continued working perfectly on my old > environment (Windows 98 + Mathematica 4.1). But I recently upgraded to Mathematica 4.2 under Windows 2000; and when > trying to load the macro (MLX.xla) for Excel2000, I got (in Excel 2000) the > following message: This workbook contains a type of macro (Microsoft Excel > version 4.0 macro) that cannot be disable nor signed. Therefore, this > workbook cannot be opened under high security level. Does any one have any experience on this? > Emilio Martin-Serrano > ==== Find the link and instructions on this page: http://support.wolfram.com/applicationpacks/excel_link/excelxp.html > Download the newest patch from wolfram research - this should theoretically > help. > Group, > My original version of MathLink for Excel (MLX.xla) was for Excel 97, and > It worked fine. Then I upgraded the package to Excel 2000 by unloading the > macro from the Wolfram site. It continued working perfectly on my old > environment (Windows 98 + Mathematica 4.1). > But I recently upgraded to Mathematica 4.2 under Windows 2000; and when > trying to load the macro (MLX.xla) for Excel2000, I got (in Excel 2000) > the > following message: This workbook contains a type of macro (Microsoft > Excel > version 4.0 macro) that cannot be disable nor signed. Therefore, this > workbook cannot be opened under high security level. > Does any one have any experience on this? > > Emilio Martin-Serrano > > ==== >I'm sorry for that my question is not clear,I have correct below. > I have a very interesting math problem:If I have a scales,and I >> have 40 things that their mass range from 1~40 which each is a nature >> number,and now I can only make 4 counterweights to measure out each >> mass of those things.Question:What mass should the counterweights >> be??? >> The answer is that 1,3,9,27 and I wnat to use mathematica to solve >> this problem. >> In fact,I think that this physical problem has various >> answer,ex.2,4,10,28 >> this way also work,because if I have a thing which weight 3 , and I >> can measure out by comparing 2<3<4 . But,If I want to solve this math >> problem: >> {x|x=k1*a+k2*b+k3*c+k4*d}={1,2,3,4,,,,,,40} where a,b,c,d is nature numbers. >> and {k1,k2,k3,k4}={1,0,-1} >> How to solve it ?? >> mathematica solving method. appreciate any idea sharing Just use brute force. Needs[DiscreteMath`Combinatorica`]; var = {a, b, c, d}; n = Length[var]; s = Outer[Times, var, {-1, 0, 1} ]; f = Flatten[Outer[Plus, Sequence@@s]]; Since the length of f is just 3^n then the range of numbers to be covered should be {-(3^n-1)/2, (3^n-1)/2}. Consequently, the largest of the weights can not exceed (3^n-1)/2 - (1+2+...+(n-1)) or ((3^n-1) - n(n-1))/2 34 Thread[var->#]& /@ (First /@ Select[{var,f} /. Thread[var->#]& /@ KSubsets[Range[((3^n-1) - n(n-1))/2], n], Sort[#[[2]]] == Range[-(3^n-1)/2,(3^n-1)/2]&]) {{a -> 1, b -> 3, c -> 9, d -> 27}} ==== Can we please get a response from WRI? i.e. regarding: In[1]:= Limit[ (Log[x]^Log[Log[x]])/ x , x->Infinity] Out[2]:= Infinity It should be 0 ==== I'm finding that the ImageSize option in Export has no effect when exporting Cell or Notebook objects. For instance, the following two commands produce precisely the same graphic: Export[image1.jpg, Cell[Some cell contents, Text, FontSize -> 100]] Export[image2.jpg, Cell[Some cell contents, Text, FontSize -> 100], ImageSize -> {576, 288}] Has anyone encountered this problem before? (This is with Mathematica 4.1.5 and Mac OS X.) ==== Does anyone know how to get the JavaPlot window (or any windows of this type) which can be seen at http://www.wolfram.com/products/mathematica/newin42/java.html that WRI advertises comes with 4.2? Jonathan mtheory@msn.com ==== How can I get mathematica to display the inverse of functions like: f(x) = x^2 - 7*x + 10 or f(x) = cos(3*x + 1/2*pi) or f(x) = (x - 3) / (x + 2) I'm having trouble getting the syntax right. ==== Looks like you forgot to define base in your Machine function and when using pure functions, don't forget the ampersand. Thus NestList[Machine[10,7,#]&, 3, 22] returns {3, 8, 4, 2, 1, 7, 10, 5, 9, 11, 12, 6, 3, 8, 4, 2, 1, 7, 10, 5, 9, 11, 12} with base = 2. Yas > Howdy, I'm trying to figure out the correct syntax to do the following. I have > some function with three arguments, and I want to syntactically describe the > single-argument function that holds two of those arguments constant (i.e. > without creating that single-argument function). More specifically, I have defined Machine[radix_,multiplier_,state_] := Module [{c,s}, > c = Floor[state/base]; s = Mod[state,base]; > multiplier*s + c > ] where I have a generalize 'machine', defined by the radix and multiplier, > which converts one state into another state. So I'd like to be able to do > something like this: NestList[Machine[10,7,#], 3, 22] to get the series of states that the radix-10 multiplier-7 machine runs > through (starting with state 3). However, this syntax doesn't seem to do > what I want. I hope that description makes sense. It seems like there must be a syntax > to describe the function Machine[10,7,#]. ==== Some functions with vector arguments work as expected and some give errors. I would appreciate if someone can clarify why. First an example of a function definition that works fine : f[u_,v_] := u.v Calling it with f[{x1,y1},{x2,y2}] gives the expected result x1 x2 + y1 y2. Now an example that does not work : g[u_,v_] := u-v Calling it with g[{x1,y1},{x2,y2}] one would expect the answer {x1-x2, y1-y2} but instead one gets error messages. Why ? And how do I fix g (i.e write a function that outputs the difference of 2 vectors). ==== I do not know why you are getting a message, using your own code I get the result you expect. > Some functions with vector arguments work as expected and some give > errors. I would appreciate if someone can clarify why. First an example of a function definition that works fine : > f[u_,v_] := u.v > Calling it with f[{x1,y1},{x2,y2}] gives the expected result x1 x2 + > y1 y2. Now an example that does not work : > g[u_,v_] := u-v > Calling it with g[{x1,y1},{x2,y2}] one would expect the answer {x1-x2, > y1-y2} but instead one gets error messages. Why ? And how do I fix g (i.e write a function that outputs the > difference of 2 vectors). ==== > Now an example that does not work : > g[u_,v_] := u-v > Calling it with g[{x1,y1},{x2,y2}] one would expect the answer {x1-x2, > y1-y2} but instead one gets error messages Works fine for me. Please check that you have no existing definitions for the symbols used. Clear[g,x1,x2,y1,y2]; g[u_,v_]:=u-v g[{x1,y1},{x2,y2}] {x1-x2,y1-y2} --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 > Some functions with vector arguments work as expected and some give > errors. I would appreciate if someone can clarify why. First an example of a function definition that works fine : > f[u_,v_] := u.v > Calling it with f[{x1,y1},{x2,y2}] gives the expected result x1 x2 + > y1 y2. Now an example that does not work : > g[u_,v_] := u-v > Calling it with g[{x1,y1},{x2,y2}] one would expect the answer {x1-x2, > y1-y2} but instead one gets error messages. Why ? And how do I fix g (i.e write a function that outputs the > difference of 2 vectors). ==== Some functions with vector arguments work as expected and some give > errors. I would appreciate if someone can clarify why. First an example of a function definition that works fine : > f[u_,v_] := u.v > Calling it with f[{x1,y1},{x2,y2}] gives the expected result x1 x2 + > y1 y2. Now an example that does not work : > g[u_,v_] := u-v > Calling it with g[{x1,y1},{x2,y2}] one would expect the answer {x1-x2, > y1-y2} but instead one gets error messages. Why ? And how do I fix g (i.e write a function that outputs the > difference of 2 vectors). > in fact this call works fine on my Mathematicas (3.0 up to 4.1). Did You really use the minus character? Maybe some erroneous code was assigned to g before. Restart Mathematica or use Remove[g] to really start up from the beginning. ==== Here's a solution using your LeftSide concept; it works perfectly but takes twice as much time as my solution. Both solutions look at every vertex of both rectangles, but mine uses two sides from each and yours requires looking at all four sides of each rectangle. I'd think yours should be a trifle faster than this, though. There may be efficiencies I'm missing (in both solutions). ClearAll[cis, rect, pickRect, extent, cannotIntersect, intersects, daveRect] cis[t_] := {Cos@t, Sin@t} rect[{pt : {_, _}, angle_, {len1_, len2_}}] := Module[{pt2}, {pt, pt2 = pt + len1 cis[angle], pt2 - len2 cis[angle - Pi/2], pt - len2 cis[angle - Pi/2]}] daveRect := {{Random[], Random[]}, Random[] + Pi/2, {Random[], Random[]}} pickRect := rect@daveRect extent[r1_, r2_] := {Min@#, Max@#} & /@ ((Take[r1, 2] - r1[[{2, 3}]]).Transpose@r2) cannotIntersect[{{min1_, max1_}, {min2_, max2_}}] := max2 < min1 || min2 > max1 intersects[r1_, r2_] := Catch[ If[cannotIntersect[#], Throw[False]] & /@ Flatten[Transpose[Outer[extent, {r1}, {r1, r2}, 1]~Join~Outer[extent, {r2}, {r2, r1}, 1], {1, 3, 2}], 1]; Throw[True]] ClearAll[leftSide,leftIntersects,sides] sides[a_List]:=Partition[Join[a,{First@a}],2,1] leftSide[{a_,b_},{{c_,d_},{e_,f_}}]:=-b c+a d+b e-d e-a f+c f>0 leftSide[a:{{_,_}..},b:{{_,_},{_,_}}]:=leftSide[#,b]&/@a leftSide[a_List,b:{{{_,_},{_,_}}..}]:=leftSide[a,#]&/@b leftIntersects[a_,b_]:=!Or@@(And@@#&/@leftSide[a,sides@b])&&! Or@@(And@@#&/@leftSide[b,sides@a]) davePairs={daveRect,daveRect}&/@Range[10000]; rectanglePairs=Map[Reverse@rect[#]&,davePairs,{2}]; Timing[right=intersects[Sequence@@#]&/@rectanglePairs;] Timing[test=leftIntersects[Sequence@@#]&/@rectanglePairs;] right[Equal]test {3.187999999999999*Second, Null} {6.765000000000001*Second, Null} True any hints on how to implement a very fast routine in Mathematica for > testing if two rectangles have an intersection area? > Here is one approach. Given three points {x1,y1},{x2,y2},{x3,y3}, switch to homogenous > coordinates a={1,x1,y1}, b={1,x2,y2}, c={1,x3,y3}. Then > Sign[Det[{a,b,c}]] is +1 if and only if the point a lies on your left as > you walk along the line though b and c in the direction from b to c. > ( If the result is zero, then a lies on the line.) The value of the determinant is x2y3-x3y2-x1y3+x3y1+x1y2-x2y1, and the > speed of the algorithm depends essentially on how fast this quantity can > be computed. Suppose we write a function LeftSide[a,{b,c}] that computes > the sign of the determinant. Now let {p1,p2, . . ., pn} be a list of vertices (pi={xi,yi}) of a > convex polygon traced counterclockwise. Then a lies within or on the > boundary of the polygon if and only if none of the numbers > LeftSide[a,{pi,p(i+1)}] are -1. That is, if -1 does not appear in the > list LeftSide[a,#]&/@Partition[{p1,p2,. . .,pn,p1},2,1]. Now use the fact that if two convex polynomials overlap, then some > vertex of one of them must lie inside or on the boundary of the other. If an overlap of positive area is required, then the check is that only > +1 appears--not that -1 does not appear. For two rectangles ( or parallelograms) this approach requires the > evaluation of 16 determinants, so it may be a bit expensive. If the > points have rational coordinates, then (positive) denominators may be > cleared in the homogeneous coordinates and the computations can be done > in integer arithmetic, at the cost of at least three more > multiplications per determinant. Garry Helzer Department of Mathematics University of Maryland College Park, MD 20742 301-405-5176 gah@math.umd.edu ==== I would like to have a list of all the directives that can be used for command in the Windows Start Menu). I am especially interested in a directive with which you can appoint a file which has to be evaluated by the kernel after it has been launched. I imagine that such a directive looks like -f filename, but I can not find a list of the correct directives. The Mathematica version I have is 4.1 on a Windows NT system. Rene Klaver ==== > 1) Get data from excel into a coordinate > list {x,y,z} > e.g. Node 1, {x1,y1,z1} > Node 2, {x2,y2,z2} > etc... Why not just use data = ReadList[filename, Table[Number, {4}]]; Alternatively, data = ReadList[filename, Number, RecordLists->True]; data = Partition[data, 4]; cord = {#[[1]], #[[2]], #[[3]]}& /@ data; > 2) Convert from Rectangular to > Cylindrical (maybe) Coordinate tranforms live in Calculus`VectorAnalysis`. It's straightforward to write a function that uses > 3) Plot3D the data This will be tricky -- ListSurfacePlot3D plots f[x, y]. ListContourPlot3D which plots f[x, y, z] can be quite slow. > > 4) Generate a harmonic bessel function for that > plot3D/graph 5) Find the equation(s) that spits out > these harmonic > bessel functions (which I think might be in the general form > of Hankel > Function solutions to the Helmholtz equation which shows > cylinder harmonics > of order v) Maybe I misunderstand ... isn't this the same as fitting a bessel function to your data? For this, you can use Statistics`NonlinearFit`. > I can figure out step 5 if I can get steps 1 through 4 > figured out. If > anyone can write a recipe for me to follow that would be > great, or even some > tips and clues...Anything!!! ==== You've gotten some very helpful responses so I'm just going to add a couple of comments. The following is an example of yet another type of button that you can use as a model. Copy and paste the following code into a notebook. When you evaluate it, it will create a button within the same notebook which when pressed evaluates the entire notebook. Sort of like selecting from the menu is something in the notebook already to evaluate. So input 1+2 (and don't hit enter) somewhere in the notebook so that you can see what the effect of the button is. DisplayForm[Button[Evaluate*Notebook,ButtonFunction:>FrontEndExecute [FrontEndToken[EvaluateNotebook]],ButtonEvaluator->None,Active->True]] It has the nice feature that it doesn't get stuck in a loop creating the button over and over again. However, with some enthusiasm you can make this happen too. Personally, I am fascinated by the Java integration in version 4.2. But I wouldn't recommend it to anyone who is just starting to program in Mathematica. Further, there is hardly enough material contained in the Help Browser to make sense of much of it. It is always a good idea to have several basic constructs of efficient, useful programs that can serve as models when programming. If you look at some of the MathGroup archived threads you will find similar complaints that the Mathematica documentation is confusing. Jonathan Rockmann mtheory@msn.com ----- Original Message ----- I want to have a variable (or matrix or whatever) defined as a global variable x, and then perform x = x+1 when a button is clicked. I've bee n using and programming computers for almost 25 years and I can't follow Wolfram's documentation. Is it just me, or is he always this obtuse when explaining things? I mean, given the amazing power of the Mathematica system, a sample list of buttons in a notebook that you could select and examine how they were implemented, would have been nice. I can't find such a list, and this seems to be par for the course for the rest of the documentation as well. ==== This was REALLY interesting. Here's a solution that looks only at the 7,560 relevant combinations. It first chooses three numerators. Then it chooses two denominators for the first fraction. Then two denominators for the second fraction. The last fraction is determined at that point. << DiscreteMath`Combinatorica` ClearAll[f, g, h, j] r = Range[1, 9]; f = KSubsets[#1, #2] &; g[r_List, n_Integer, {}] := f[r, n] g[r_List, n_Integer, e_?VectorQ] := Join[e, #] & /@ f[Complement[r, e], n] g[r_List, n_Integer, e : {__?VectorQ}] := Flatten[g[r, n, #] & /@ e, 1] h[r_List, e : {__?VectorQ}] := Join[#, Complement[r, #]] & /@ e j[{a_, b_, c_, d_, e_, f_, g_, h_, i_}] := a/(d e) + b/(f g) + c/(h i) Timing[Select[h[r, Fold[g[r, #2, #1] &, {}, {3, 2, 2}]], j@# == 1 &]] {0.532 Second, {{1, 5, 7, 3, 6, 8, 9, 2, 4}}} Hence the only solution is 1/(3*6)+5/(8*9)+7/(2*4) -----Original Message----- University Professor of Philanthropy and the Law Director, National Center on Philanthropy and the Law New York University School of Law Room 206A 110 West 3rd Street New York, N.Y. 10012-1074 -----Original Message----- byran ________________________________________________________________________ service. For more information on a proactive anti-virus service working around the clock, around the globe, visit http://www.messagelabs.com ________________________________________________________________________ ==== Garry, Here's a solution using your LeftSide concept; it works perfectly but takes twice as much time as my solution. Both solutions look at every vertex of both rectangles, but mine uses two sides from each and yours requires looking at all four sides of each rectangle. I'd think yours should be a trifle faster than this, though. There may be efficiencies I'm missing (in both solutions). ClearAll[cis, rect, pickRect, extent, cannotIntersect, intersects, daveRect] cis[t_] := {Cos@t, Sin@t} rect[{pt : {_, _}, angle_, {len1_, len2_}}] := Module[{pt2}, {pt, pt2 = pt + len1 cis[angle], pt2 - len2 cis[angle - Pi/2], pt - len2 cis[angle - Pi/2]}] daveRect := {{Random[], Random[]}, Random[] + Pi/2, {Random[], Random[]}} pickRect := rect@daveRect extent[r1_, r2_] := {Min@#, Max@#} & /@ ((Take[r1, 2] - r1[[{2, 3}]]).Transpose@r2) cannotIntersect[{{min1_, max1_}, {min2_, max2_}}] := max2 < min1 || min2 > max1 intersects[r1_, r2_] := Catch[ If[cannotIntersect[#], Throw[False]] & /@ Flatten[Transpose[Outer[extent, {r1}, {r1, r2}, 1]~Join~Outer[extent, {r2}, {r2, r1}, 1], {1, 3, 2}], 1]; Throw[True]] ClearAll[leftSide,leftIntersects,sides] sides[a_List]:=Partition[Join[a,{First@a}],2,1] leftSide[{a_,b_},{{c_,d_},{e_,f_}}]:=-b c+a d+b e-d e-a f+c f>0 leftSide[a:{{_,_}..},b:{{_,_},{_,_}}]:=leftSide[#,b]&/@a leftSide[a_List,b:{{{_,_},{_,_}}..}]:=leftSide[a,#]&/@b leftIntersects[a_,b_]:=!Or@@(And@@#&/@leftSide[a,sides@b])&&! Or@@(And@@#&/@leftSide[b,sides@a]) davePairs={daveRect,daveRect}&/@Range[10000]; rectanglePairs=Map[Reverse@rect[#]&,davePairs,{2}]; Timing[right=intersects[Sequence@@#]&/@rectanglePairs;] Timing[test=leftIntersects[Sequence@@#]&/@rectanglePairs;] right[Equal]test {3.187999999999999*Second, Null} {6.765000000000001*Second, Null} True -----Original Message----- intersection Begin forwarded message: Dear colleagues, any hints on how to implement a very fast routine in Mathematica for > testing if two rectangles have an intersection area? > Frank Brand > Here is one approach. Given three points {x1,y1},{x2,y2},{x3,y3}, switch to homogenous > coordinates a={1,x1,y1}, b={1,x2,y2}, c={1,x3,y3}. Then > Sign[Det[{a,b,c}]] is +1 if and only if the point a lies on your left as > you walk along the line though b and c in the direction from b to c. > ( If the result is zero, then a lies on the line.) The value of the determinant is x2y3-x3y2-x1y3+x3y1+x1y2-x2y1, and the > speed of the algorithm depends essentially on how fast this quantity can > be computed. Suppose we write a function LeftSide[a,{b,c}] that computes > the sign of the determinant. Now let {p1,p2, . . ., pn} be a list of vertices (pi={xi,yi}) of a > convex polygon traced counterclockwise. Then a lies within or on the > boundary of the polygon if and only if none of the numbers > LeftSide[a,{pi,p(i+1)}] are -1. That is, if -1 does not appear in the > list LeftSide[a,#]&/@Partition[{p1,p2,. . .,pn,p1},2,1]. Now use the fact that if two convex polynomials overlap, then some > vertex of one of them must lie inside or on the boundary of the other. If an overlap of positive area is required, then the check is that only > +1 appears--not that -1 does not appear. For two rectangles ( or parallelograms) this approach requires the > evaluation of 16 determinants, so it may be a bit expensive. If the > points have rational coordinates, then (positive) denominators may be > cleared in the homogeneous coordinates and the computations can be done > in integer arithmetic, at the cost of at least three more > multiplications per determinant. Garry Helzer Department of Mathematics University of Maryland College Park, MD 20742 301-405-5176 gah@math.umd.edu ==== Garry, Also note your solution requires rectangle points to be in clockwise order (mine doesn't), but yours works for arbitrary convex polygons as written. Bobby -----Original Message----- ClearAll[cis, rect, pickRect, extent, cannotIntersect, intersects, daveRect] cis[t_] := {Cos@t, Sin@t} rect[{pt : {_, _}, angle_, {len1_, len2_}}] := Module[{pt2}, {pt, pt2 = pt + len1 cis[angle], pt2 - len2 cis[angle - Pi/2], pt - len2 cis[angle - Pi/2]}] daveRect := {{Random[], Random[]}, Random[] + Pi/2, {Random[], Random[]}} pickRect := rect@daveRect extent[r1_, r2_] := {Min@#, Max@#} & /@ ((Take[r1, 2] - r1[[{2, 3}]]).Transpose@r2) cannotIntersect[{{min1_, max1_}, {min2_, max2_}}] := max2 < min1 || min2 > max1 intersects[r1_, r2_] := Catch[ If[cannotIntersect[#], Throw[False]] & /@ Flatten[Transpose[Outer[extent, {r1}, {r1, r2}, 1]~Join~Outer[extent, {r2}, {r2, r1}, 1], {1, 3, 2}], 1]; Throw[True]] ClearAll[leftSide,leftIntersects,sides] sides[a_List]:=Partition[Join[a,{First@a}],2,1] leftSide[{a_,b_},{{c_,d_},{e_,f_}}]:=-b c+a d+b e-d e-a f+c f>0 leftSide[a:{{_,_}..},b:{{_,_},{_,_}}]:=leftSide[#,b]&/@a leftSide[a_List,b:{{{_,_},{_,_}}..}]:=leftSide[a,#]&/@b leftIntersects[a_,b_]:=!Or@@(And@@#&/@leftSide[a,sides@b])&&! Or@@(And@@#&/@leftSide[b,sides@a]) davePairs={daveRect,daveRect}&/@Range[10000]; rectanglePairs=Map[Reverse@rect[#]&,davePairs,{2}]; Timing[right=intersects[Sequence@@#]&/@rectanglePairs;] Timing[test=leftIntersects[Sequence@@#]&/@rectanglePairs;] right[Equal]test {3.187999999999999*Second, Null} {6.765000000000001*Second, Null} True -----Original Message----- intersection Begin forwarded message: Dear colleagues, any hints on how to implement a very fast routine in Mathematica for > testing if two rectangles have an intersection area? > Frank Brand > Here is one approach. Given three points {x1,y1},{x2,y2},{x3,y3}, switch to homogenous > coordinates a={1,x1,y1}, b={1,x2,y2}, c={1,x3,y3}. Then > Sign[Det[{a,b,c}]] is +1 if and only if the point a lies on your left as > you walk along the line though b and c in the direction from b to c. > ( If the result is zero, then a lies on the line.) The value of the determinant is x2y3-x3y2-x1y3+x3y1+x1y2-x2y1, and the > speed of the algorithm depends essentially on how fast this quantity can > be computed. Suppose we write a function LeftSide[a,{b,c}] that computes > the sign of the determinant. Now let {p1,p2, . . ., pn} be a list of vertices (pi={xi,yi}) of a > convex polygon traced counterclockwise. Then a lies within or on the > boundary of the polygon if and only if none of the numbers > LeftSide[a,{pi,p(i+1)}] are -1. That is, if -1 does not appear in the > list LeftSide[a,#]&/@Partition[{p1,p2,. . .,pn,p1},2,1]. Now use the fact that if two convex polynomials overlap, then some > vertex of one of them must lie inside or on the boundary of the other. If an overlap of positive area is required, then the check is that only > +1 appears--not that -1 does not appear. For two rectangles ( or parallelograms) this approach requires the > evaluation of 16 determinants, so it may be a bit expensive. If the > points have rational coordinates, then (positive) denominators may be > cleared in the homogeneous coordinates and the computations can be done > in integer arithmetic, at the cost of at least three more > multiplications per determinant. Garry Helzer Department of Mathematics University of Maryland College Park, MD 20742 301-405-5176 gah@math.umd.edu ==== Try this: Off[Remove::rmnsm] Remove[Global`p@, Global`p@@] n = 7; pn = Unique[p] & /@ Range[10] f[p_] = Array[fk[p, #] &, n] f[p] fEq[p_] = MapThread[Equal, {f[p], Array[0 &, n]}] -----Original Message----- f2 := f[pn] [[2]]; f3 := f[pn] [[3]]; f4 := f[pn] [[4]]; f5 := f[pn] [[5]]; f6 := f[pn] [[6]]; f7 := f[pn] [[7]]; theRoot = FindRoot[{f1==0,f2==0,f3==0,f4==0,f5==0,f6==0,f7==0}, {p1, 1/n},{p2, 1/n},{p3, 1/n},{p4, 1/n},{p5, 1/n}, {p6, 1/n},{p7, 1/n}]; -- John MacCormick Systems Research Center, HP Labs, 1501 Page Mill Road, ==== the problem, but I duplicated it just now, so I'm puzzled. I'm using Windows XP Home, and System`Private`$BuildNumber is 168634. 4.2 for Microsoft Windows (June 5, 2002) f[n_] := Log[n]^Log[Log[n]] Limit[f[n]/n, n -> Infinity] Infinity -----Original Message----- By the way, Mathematica gets the following limit wrong: f[n_] := Log[n]^Log[Log[n]] Limit[f[n]/n, n -> Infinity] Infinity That limit is zero. For the Sieve to be polynomial, we only need the sequence to be BOUNDED (for some power of n in the denominator). ==== Garry, No, you don't have to compute intersections, and yes, you can test vertices only. I haven't coded it yet, but the LeftSide idea seems like a good one. It is sufficient to test whether all vertices of one convex polygon are on the left (out) side of some side of the second polygon (both polygons in clockwise order). If that happens for any side of either polygon, the polygons don't intersect. In the cross example, some vertices are to the right for every side you try. -----Original Message----- intersection Begin forwarded message: Dear colleagues, any hints on how to implement a very fast routine in Mathematica for > testing if two rectangles have an intersection area? > Frank Brand > Here is one approach. Given three points {x1,y1},{x2,y2},{x3,y3}, switch to homogenous > coordinates a={1,x1,y1}, b={1,x2,y2}, c={1,x3,y3}. Then > Sign[Det[{a,b,c}]] is +1 if and only if the point a lies on your left as > you walk along the line though b and c in the direction from b to c. > ( If the result is zero, then a lies on the line.) The value of the determinant is x2y3-x3y2-x1y3+x3y1+x1y2-x2y1, and the > speed of the algorithm depends essentially on how fast this quantity can > be computed. Suppose we write a function LeftSide[a,{b,c}] that computes > the sign of the determinant. Now let {p1,p2, . . ., pn} be a list of vertices (pi={xi,yi}) of a > convex polygon traced counterclockwise. Then a lies within or on the > boundary of the polygon if and only if none of the numbers > LeftSide[a,{pi,p(i+1)}] are -1. That is, if -1 does not appear in the > list LeftSide[a,#]&/@Partition[{p1,p2,. . .,pn,p1},2,1]. Now use the fact that if two convex polynomials overlap, then some > vertex of one of them must lie inside or on the boundary of the other. If an overlap of positive area is required, then the check is that only > +1 appears--not that -1 does not appear. For two rectangles ( or parallelograms) this approach requires the > evaluation of 16 determinants, so it may be a bit expensive. If the > points have rational coordinates, then (positive) denominators may be > cleared in the homogeneous coordinates and the computations can be done > in integer arithmetic, at the cost of at least three more > multiplications per determinant. Garry Helzer Department of Mathematics University of Maryland College Park, MD 20742 301-405-5176 gah@math.umd.edu ==== > Dear All: > I want to make an animation that simulate the Doppler Effect, just 2D > circles travel out one by one, and at the same time,the origin of the > wave also moves toward one direction. I have no idea to make the speed > of the wave origin and the speed of traveling wave independent.Is > sincerely bryan circles, but the second one includes two lines which approximate the shock waves, I believe. The arguments of the functions are vx & vy (velocities in x & y directions) and tstart, tend, tstep which determine how many circles to draw and the spacing of the circles. I just used the Do loop to make the pictures, & then you can select the cells & pick Animate. dopp[vx_,vy_,tstart_,tend_,tstep_]:=Show[Graphics[Table[{Hue[t/tend],Circle[ {vx*t,vy*t},tend-t]},{t,tstart,tend,tstep}]],AspectRatio->Automatic,Axes->Tru e,PlotLabel->Mach Sqrt(vx^2+vy^2)]; doppcone[vx_,vy_,tend_,tstep_]:=Show[Graphics[Table[{Hue[t/tend],Circle [{vx*t,vy*t},tend-t]},{t,0,tend,tstep}]],Graphics[Line[{{-tend*Sin[If[vx==0, 0,ArcTan[vy/vx]]],tend*Cos[If[vx==0,0,ArcTan[vy/vx]]]},{Sign[vx]*Cos[If[vx==0 ,0,ArcTan[vy/vx]]]*(tend-tstep)*sqrt[vx^2+vy^2] - tstep*Sin[If[vx==0,0,ArcTan[vy/vx]]],Sin[If[vx==0,0,ArcTan[vy/vx]]]*Sign[vx]* (tend-tstep)*sqrt[vx^2+vy^2]+tstep*Cos[If[vx==0,0,ArcTan[vy/vx]]]}}]],Graphic s[Line[{{tend*Sin[If[vx==0,0,ArcTan[vy/vx]]],-tend*Cos[If[vx==0,0,ArcTan[vy/v x]]]},{Sign[vx]*Cos[If[vx==0,0,ArcTan[vy/vx]]]*(tend-tstep)*sqrt[vx^2+vy^2]+t step*Sin[If[vx==0,0,ArcTan[vy/vx]]],Sign[vx]*Sin[If[vx==0,0,ArcTan[vy/vx]]]*( tend-tstep)*s rt[vx^2+vy^2]-tstep*Cos[If[vx==0,0,ArcTan[vy/vx]]]}}]],AspectRatio->Automati c,Axes->True]; Do[dopp[i,0,0,10,1],{i,0,1.4,0.2}]; Hope I did that without typos - I can't see how to post the notebook ==== Neat! The animation was jagged, though, so I fixed the text position and the image size; it won't work for large vertical velocities: margin=.8; dopp[vx_,vy_,tend_,tstep_]:=Show[Graphics[ {Table[{Hue[t/tend],Circle[{vx*t,vy*t},tend-t]}, {t,0,tend,tstep}], Text[Mach <>ToString@Sqrt[vx^2+vy^2] ,{0,.5+tend},{-1,0}] }],AspectRatio->Automatic,Axes->True, PlotRange-> {{-tend-margin,margin+Max[tend,(vx tend)+.5]}, {-tend-margin,2margin+Max[tend,(vy tend)]}}, Ticks->{{-10,-5,0,5,10},Automatic}, ImageSize->{10 2 margin+10 (tend+Max[tend,(vx tend)+.5]), 10 3 margin+10(tend +Max[tend,(vy tend)])}]; Do[dopp[i,0,10,1],{i,0,1.4,0.2}]; By the way to avoid the slashes, CopyAs/TextOnly. > Dear All: > I want to make an animation that simulate the Doppler Effect, just 2D > circles travel out one by one, and at the same time,the origin of the > wave also moves toward one direction. I have no idea to make the speed > of the wave origin and the speed of traveling wave independent.Is > sincerely bryan circles, but the second one includes two lines which approximate the > shock waves, I believe. The arguments of the functions are vx & vy > (velocities in x & y directions) and tstart, tend, tstep which > determine how many circles to draw and the spacing of the circles. I > just used the Do loop to make the pictures, & then you can select the > cells & pick Animate. dopp[vx_,vy_,tstart_,tend_,tstep_]:=Show[Graphics[Table[{Hue[t/tend],Circle[ {vx*t,vy*t},tend-t]},{t,tstart,tend,tstep}]],AspectRatio->Automatic,Axes->Tr ue,PlotLabel->Mach > Sqrt(vx^2+vy^2)]; doppcone[vx_,vy_,tend_,tstep_]:=Show[Graphics[Table[{Hue[t/tend],Circle > [{vx*t,vy*t},tend-t]},{t,0,tend,tstep}]],Graphics[Line[{{-tend*Sin[If[vx==0, 0,ArcTan[vy/vx]]],tend*Cos[If[vx==0,0,ArcTan[vy/vx]]]},{Sign[vx]*Cos[If[vx== 0,0,ArcTan[vy/vx]]]*(tend-tstep)*sqrt[vx^2+vy^2] > - tstep*Sin[If[vx==0,0,ArcTan[vy/vx]]],Sin[If[vx==0,0,ArcTan[vy/vx]]]*Sign[vx] *(tend-tstep)*sqrt[vx^2+vy^2]+tstep*Cos[If[vx==0,0,ArcTan[vy/vx]]]}}]],Graph ics[Line[{{tend*Sin[If[vx==0,0,ArcTan[vy/vx]]],-tend*Cos[If[vx==0,0,ArcTan[v y/vx]]]},{Sign[vx]*Cos[If[vx==0,0,ArcTan[vy/vx]]]*(tend-tstep)*sqrt[vx^2+vy^ 2]+tstep*Sin[If[vx==0,0,ArcTan[vy/vx]]],Sign[vx]*Sin[If[vx==0,0,ArcTan[vy/vx ]]]*(tend-tstep)*s > rt[vx^2+vy^2]-tstep*Cos[If[vx==0,0,ArcTan[vy/vx]]]}}]],AspectRatio->Automati c,Axes->True]; > Do[dopp[i,0,0,10,1],{i,0,1.4,0.2}]; Hope I did that without typos - I can't see how to post the notebook > ==== It would take me a lot of time to understand how functions like SelectionEvaluate works... Cesar. > People encounter this all the time. It is because > SelectionEvaluate does > not do what you think. It does not work like > ToExpression, which causes > immediate kernel evaluation. Instead it works like > when you press > Shift-Enter, which selects a cell for evaluation > after all current > evaluations have finished. See > http://support.wolfram.com/mathematica/kernel/interface/selectionevaluate.ht ml -Dale > __________________________________________________ Do You Yahoo!? Yahoo! Finance - Get real-time stock quotes http://finance.yahoo.com ==== > How can I get mathematica to display the inverse of functions like: f(x) = x^2 - 7*x + 10 or f(x) = cos(3*x + 1/2*pi) or f(x) = (x - 3) / (x + 2) I'm having trouble getting the syntax right. > Solve[y==x^2-7*x+10, x] {{x -> (1/2)*(7 - Sqrt[9 + 4*y])}, {x -> (1/2)*(7 + Sqrt[9 + 4*y])}} x^2-7*x+10 /. % // ExpandAll {y, y} Solve[y == Cos[3*x+1/2*Pi], x] {{x -> -(ArcSin[y]/3)}} Cos[3*x+1/2*Pi] /. % {y} Solve[y == (x-3)/(x+2), x] {{x -> (-3 - 2*y)/(-1 + y)}} (x-3)/(x+2) /. % // Simplify {y} ==== > I am a newbie to mathematica. I have a 14 functions which are the > function of r,theta and phi. I want to do some mathematical operation > over them. How can I do? Can it be possible to call them in Do or For > loop with some index? > As a general rule avoid Do and For loops and just operate on Lists or Map (/@) onto lists. g /@ {f1[r,theta,phi], f2[r,theta,phi], f3[r,theta,phi]} {g[f1[r, theta, phi]], g[f2[r, theta, phi]], g[f3[r, theta, phi]]} This can be written more compactly as g /@ (#[r,theta,phi]& /@ {f1,f2,f3}) {g[f1[r, theta, phi]], g[f2[r, theta, phi]], g[f3[r, theta, phi]]} ==== > Is there an easy (elegant?) way to generate the set of all k-tuples > taking values from some set (list) S? I want the arguments of the > function to be k (the length of the tuples) and the set S. That is, > KTuples[3,{a,b}] should produce > {{a,a,a},{a,a,b},{a,b,a},{a,b,b},{b,a,a},{b,a,b},{b,b,a},{b,b,b}}. > kTuples[n_Integer?Positive, s_List] := Flatten[Outer[List, Sequence@@Table[s,{n}]],n-1]; s = {a,b}; kTuples[3, {a,b}] {{a, a, a}, {a, a, b}, {a, b, a}, {a, b, b}, {b, a, a}, {b, a, b}, {b, b, a}, {b, b, b}} Length[kTuples[10, {a,b}]] 1024 ==== > If I have an n-element list, (say where each element is itself a > list), such as {{a,b}, {a,b}, {a,b}} > is there a way to strip off the outermost nesting of the list to > obtain just a sequence of of these n elements, that is > {a,b},{a,b},{a,b} so that I can use this for input for some function. I would like to do something like > Outer[SomeFunction, Table[{a,b},{N} ]] where I can enter N > dynamically. > The problem, of course, is that the output of the Table command is one > big list > and Outer is expecting a sequence of N separate lists after > SomeFunction. > Use Sequence kTuples[n_Integer?Positive,s_List]:= Flatten[Outer[List,Sequence@@Table[s,{n}]],n-1]; s = {a,b,c,d,e}; n =3; Length[kTuples[n,s]] == Length[s]^n True ==== f[Sequence@@{{a,b}, {a,b}, {a,b}}] f[{a, b}, {a, b}, {a, b}] -----Original Message----- dynamically. The problem, of course, is that the output of the Table command is one big list and Outer is expecting a sequence of N separate lists after SomeFunction. ==== f[x_] = x^2 - 7*x + 10 g[x_] = Cos[3*x + 1/2*Pi] h[x_] = (x - 3)/(x + 2) Off[Solve::ifun] Solve[f[x] == y, x] Solve[g[x] == y, x] Solve[h[x] == y, x] -----Original Message----- ==== f[x_] = x^2 - 7*x + 10; g[x_] = Cos[3*x + 1/2*Pi]; h[x_] = (x - 3)/(x + 2); #[x] & /@ {f, g, h} {10 - 7*x + x^2, -Sin[3*x], (-3 + x)/(2 + x)} -----Original Message----- ==== I get the expected results. I suspect g was already defined at the time. For instance you might have set g={a,b} previously. ClearAll[g] goes before defining the function g. -----Original Message----- Calling it with g[{x1,y1},{x2,y2}] one would expect the answer {x1-x2, y1-y2} but instead one gets error messages. Why ? And how do I fix g (i.e write a function that outputs the difference of 2 vectors). ==== In[1]:= ktuples[n_Integer, d_List] := Flatten[Outer[List, Sequence @@ Table[d, {n}]], 2] In[2]:= ktuples[3, {a, b}] Out[2]= {{a, a, a}, {a, a, b}, {a, b, a}, {a, b, b}, {b, a, a}, {b, a, b}, {b, b, a}, {b, b, b}} ----- Original Message ----- ==== kTuples[k_Integer?Positive, s_List] := Partition[Flatten@Outer[List, Sequence @@ (s & /@ Range[k])], k] kTuples[3, {a, b}] -----Original Message----- Sender: steve@smc.vnet.net Approved: Steven M. Christensen , Moderator ==== The trick is to use the Sequence Function. Try the following code and you will see how it works. abcd = CharacterRange[a, d] abcd1 = Flatten[Outer[{#1, #2} &, abcd, abcd], 1] abcd2 = Outer[First[#]*Last[#] &, Sequence[abcd1], 1] abcd2 uses the list of lists you have created to load as a sequence of arguments to outer. You need the third argument to operate on the parts of the list if this is your goal. Read the description of Sequence. It also works in contexts other than Outer. Richard Palmer > Can anyone help me with this problem. If I have an n-element list, (say where each element is itself a > list), such as {{a,b}, {a,b}, {a,b}} > is there a way to strip off the outermost nesting of the list to > obtain just a sequence of of these n elements, that is > {a,b},{a,b},{a,b} so that I can use this for input for some function. I would like to do something like > Outer[SomeFunction, Table[{a,b},{N} ]] where I can enter N > dynamically. > The problem, of course, is that the output of the Table command is one > big list > and Outer is expecting a sequence of N separate lists after > SomeFunction. ==== Dear Group I would like to know, if is possible to solve Integrate[(exp[-a/x])/(x^2-b^2),{x,0,infinity}] with a and b constant ( Real ) using Mathematica. Valdeci Mariano ********************************************************************* Valdeci Mariano de Souza Master«s Degree of Applied Physics - Unesp/Rio Claro - State of S.8bo Paulo - Brazil Laboratory of Electrical Measurements phone : ( 0XX19 ) 526 - 2237 ********************************************************************* ==== > Is there an easy (elegant?) way to generate the set of all k-tuples > taking values from some set (list) S? I want the arguments of the > function to be k (the length of the tuples) and the set S. That is, > KTuples[3,{a,b}] should produce > {{a,a,a},{a,a,b},{a,b,a},{a,b,b},{b,a,a},{b,a,b},{b,b,a},{b,b,b}}. Method 1: Distribute[Table[{a,b},{3}],List] Method 2: Needs[DiscreteMath`Combinatorica`]; Strings[{a,b},3] Rob Pratt Department of Operations Research http://www.unc.edu/~rpratt/ ==== > Does anyone know how to get the JavaPlot window (or any windows of this type) > which can be seen at > http://www.wolfram.com/products/mathematica/newin42/java.html > that WRI advertises comes with 4.2? Well, I don't know if any tools (like that Window/Palette) written in Java are in the M_4.2 box, but if you know a little Java Programming, you can easily write something like that yourself; eg. using the MathGraphicsJPanel which allows you to display Mathematica Graphics Expressions in a Java Component, simply by calling its setCommand() Method (I hope that's correct, I am writing that from memory); eg. a simple JFrame with a MathGraphicsJPanel would be programmed like this: (* This code is necessary for setting up J/Link *) < {NumberPoint -> ,}] ; However, Import is not the function I'd like to use, because it is realy slow over large files. I wonder if someone knows a way to use something faster than Import (I namely think of ReadList) with coma-numbers? ==== I'm a poor physicist trying to figure out how to sort out the physical from the non-physical solutions to a problem. To do that, I need to be able to look at an expression and pick out a subexpression, the part under the radical. For example, say I've got the expression a b x^2 + 5 x^3 + 5 Sqrt[4 - x^2] I'd like to pick out 4 - x^2, which would then tell me that x is between +/- 2. I know there has got to be an easy way to do it, but I can't find it. Any help would be appreciated. Steve Beach asb4@psu.edu http://www.thebeachfamily.org ==== I had looked at using Cases, but had gotten tripped up by forgettting to use Infinity to tell it to look at all subexpressions. The tip from about how to use Algebra`InequalitySolve` package helped too. > I'm a poor physicist trying to figure out how to sort out the > physical from the non-physical solutions to a problem. To do > that, I need to be able to look at an expression and pick out a > subexpression, the part under the radical. For example, say I've got the expression a b x^2 + 5 x^3 + 5 Sqrt[4 - x^2] I'd like to pick out 4 - x^2, which would then tell me that x is > between +/- 2. I know there has got to be an easy way to do it, but I > can't find it. Any help would be appreciated. > Steve Beach > asb4@psu.edu > http://www.thebeachfamily.org ==== expr=a b x^2+5 x^3+5 Sqrt[4-x^2]; First note that Mathematica interprets Sqrt[u] as u^(1/2) FullForm[Sqrt[u]] Power[u,Rational[1,2]] Now we can find the list of all u from subexpressions the form Sqrt[u_]: Cases[expr, u_^(1/2) ->u,{0, Infinity}] {4 - x^2} Here {0, Infinity} causes the search to be over subexpressions at all levels including level 0, which is the whole expression. The search will not go inside heads unless we specify this: Cases[expr[y], u_^(1/2) -> u, {0, Infinity}] {} Cases[expr[y], u_^(1/2) -> u, {0, Infinity}, Heads -> True] {4 - x^2} -- Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 > I'm a poor physicist trying to figure out how to sort out the > physical from the non-physical solutions to a problem. To do > that, I need to be able to look at an expression and pick out a > subexpression, the part under the radical. For example, say I've got the expression a b x^2 + 5 x^3 + 5 Sqrt[4 - x^2] I'd like to pick out 4 - x^2, which would then tell me that x is > between +/- 2. I know there has got to be an easy way to do it, but I > can't find it. Any help would be appreciated. > Steve Beach > asb4@psu.edu > http://www.thebeachfamily.org > ==== Bob, Mathematica has commands to do exactly what you wish and their use is fairly common. The first command is Apply (@@ in prefix form) and the second command is Sequence. If you have a list of arguments such as... arglist = {{a, b}, c, {d, e}, 3, Report -> True}; you can insert them into a function, f, simply by applying f to the list. f @@ arglist f[{a, b}, c, {d, e}, 3, Report -> True] If you want to insert them into another function, h, that also has other arguments, then you can use Sequence and Apply. h[firstarg, Sequence @@ arglist, Compile -> False] h[firstarg, {a, b}, c, {d, e}, 3, Report -> True, Compile -> False] The problem, of course, is that the output of the Table command is one big list and Outer is expecting a sequence of N separate lists after SomeFunction. ==== Bob, KTuples[n_Integer?Positive, elements_List] := Flatten[Outer[List, Sequence @@ Table[elements, {n}]], n - 1] KTuples[3, {a, b}] {{a, a, a}, {a, a, b}, {a, b, a}, {a, b, b}, {b, a, a}, {b, a, b}, {b, b, a}, {b, b, b}} Outer produces an array of all the elements but we have to flatten it to get it down to a two-level array. Sender: steve@smc.vnet.net Approved: Steven M. Christensen , Moderator ==== Raj, You could include an index for the function in the argument list, or make a clear separation between parameters and variables as follows (I just use two functions). f[1][r_, t_, p_] := 2r Sin[t] f[2][r_, t_, p_] := r Cos[t]Sin[p] You could then sum them, for example, by Sum[f[i][r, t, p], {i, 1, 2}] r Cos[t] Sin[p] + 2 r Sin[t] Or perhaps you wish to sum the derivatives of the functions with respect to the second argument, t. Sum[Derivative[0, 1, 0][f[i]][r, t, p], {i, 1, 2}] 2 r Cos[t] - r Sin[p] Sin[t] Perhaps you can define all your functions in terms of integer parameters. g[n_, m_][r_, t_, p_] := r^(m - n)Sin[m t]Cos[n p] You could then sum as follows. Sum[g[n, m][r, t, p], {m, 1, 3}, {n, 1, 3}] Cos[p]*Sin[t] + (Cos[2*p]*Sin[t])/r + (Cos[3*p]*Sin[t])/r^2 + r*Cos[p]*Sin[2*t] + Cos[2*p]*Sin[2*t] + (Cos[3*p]*Sin[2*t])/r + r^2*Cos[p]*Sin[3*t] + r*Cos[2*p]*Sin[3*t] + Cos[3*p]*Sin[3*t] Or perhaps you want to take the square of the derivatives of the functions with respect to the first argument, r... Sum[(Derivative[1, 0, 0][g[n, m]][r, t, p])^2, {m, 1, 3}, {n, 1, 3}] (Cos[2*p]^2*Sin[t]^2)/r^4 + (4*Cos[3*p]^2*Sin[t]^2)/ r^6 + Cos[p]^2*Sin[2*t]^2 + (Cos[3*p]^2*Sin[2*t]^2)/ r^4 + 4*r^2*Cos[p]^2*Sin[3*t]^2 + Cos[2*p]^2*Sin[3*t]^2 If possible, try to steer away from For and Do loops and use functional programming as much as you can. At first it may seem strange, but it is much more powerful and easier once you get used to it. Ask further questions to MathGroup with SPECIFIC examples and you will get a lot of help on how to use functional programming. Sender: steve@smc.vnet.net Approved: Steven M. Christensen , Moderator Except in a few cases, Mathematica will not automatically generate the inverse function for you. You will have to Solve the equations and construct the inverse function yourself. In two of your three cases there are actually multiple inverse functions. Taking the easy one first. Clear[x]; Solve[f[x] == f, x][[1, 1]] // Simplify x[f_] = x /. % x -> (3 + 2*f)/(1 - f) (3 + 2*f)/(1 - f) So we now have the inverse function. x[f] (3 + 2*f)/(1 - f) For the quadratic equation there are two solution. Clear[x] sols = Solve[f[x] == f, x] {{x -> (1/2)*(7 - Sqrt[9 + 4*f])}, {x -> (1/2)*(7 + Sqrt[9 + 4*f])}} We define the two solutions and identify them by an index. x[1][f_] = x /. sols[[1, 1]] x[2][f_] = x /. sols[[2, 1]] (1/2)*(7 - Sqrt[9 + 4*f]) (1/2)*(7 + Sqrt[9 + 4*f]) For the third example there is a double infinity of solutions. Clear[x] sols = Solve[f[x] == f, x] Solve::ifun: Inverse functions are being used by !(Solve), so some solutions may not be found. {{x -> -(ArcSin[f]/3)}} Using some trigonometry we can define the solutions as (I hope I got this right) Clear[x]; x[1, n_][f_] = (-ArcSin[f] + 2 Pi n)/3 x[2, n_][f_] = (-Pi + ArcSin[f] + 2Pi n)/3 Here are some of the solutions for f = 1/2. Table[x[1, n][1/2], {n, -5, 5}]~Join~Table[x[1, n][1/2], {n, -5, 5}] // Sort f /@ % {-((61*Pi)/18), -((61*Pi)/18), -((49*Pi)/18), -((49*Pi)/18), -((37*Pi)/18), -((37*Pi)/18), -((25*Pi)/18), -((25*Pi)/18), -((13*Pi)/18), -((13*Pi)/18), -(Pi/18), -(Pi/18), (11*Pi)/18, (11*Pi)/18, (23*Pi)/18, (23*Pi)/18, (35*Pi)/18, (35*Pi)/18, (47*Pi)/18, (47*Pi)/18, (59*Pi)/18, (59*Pi)/18} {1/2, 1/2, 1/2, 1/2, 1/2, 1/2, 1/2, 1/2, 1/2, 1/2, 1/2, 1/2, 1/2, 1/2, 1/2, 1/2, 1/2, 1/2, 1/2, 1/2, 1/2, 1/2} Generally, when you want inverse functions you are going have to do some work. Sender: steve@smc.vnet.net Approved: Steven M. Christensen , Moderator ==== g[u_, v_] := u - v g[{x1, y1}, {x2, y2}] {x1 - x2, y1 - y2} y1-y2} but instead one gets error messages. Why ? And how do I fix g (i.e write a function that outputs the difference of 2 vectors). ==== >If I have an n-element list, (say where each element is itself a >list), such as {{a,b}, {a,b}, {a,b}} is there a way to strip off the >outermost nesting of the list to obtain just a sequence of of these n >elements, that is {a,b},{a,b},{a,b} so that I can use this for input >for some function. Try Sequence@@ as in the following: In[1]:= x={{a,b},{a,b},{a,b}}; In[2]:= g[x_,y_,z_]:=x(y.z) In[3]:= g[Sequence@@x] Out[3]= !({a ((a^2 + b^2)), b ((a^2 + b^2))}) ==== Why is it that when I type, say, Table[ Plot[ Sin[n x],{x,0,Pi}], {n, 1,5}] my output is marked in the righthand column with 3 cell ``markers, with the middle marker encompassing the output (and *only* the output). However, when I try something like Table[Show[Graphics[ etc., etc]], {n, 1,5}] the middle cell marker on the righthand side of the notebook also includes the input command? The reason that this is important for me is that I am doing an animation; and after the animation I would like to delete all the graphic images; but when I use Show[Graphics[ this would mean deleting the input command as well. Could someone explain this to me and also make a suggestion so how I could use Show[Graphics[ ] and have the middle cell marker *only* encompass the output. ==== Bobby, here my solution(s) as promised. As you stated, my published solution was only for rectangles oriented parallel to the X and Y axis, as this is perhaps the predominant application. The idea was, to decide whether all vertices of a rectangle lie to one side of the other. This idea expands to the general case. And effectively it is the same idea as of your suggestion, as well as of the improved version after Garry Helzer, i.e. the constructive solutions, as opposed to those involving more abstract mathematical reasoning as of David Park and Andrzej Kozlowski. And these, esp. Andrzej's, are very interesting, as they show how to derive a solution just from this kind of reasoning. First some preliminaries: random rectangles I had chosen to describe the rectangles as a list of counterclockwise vertices. To generate them, I had used a similar description as David Park: toRectangle[corner_, [Theta]_, base_, side_] := Module[{vb = {Cos[[Theta]], Sin[[Theta]]}* base, vs = {-Sin[[Theta]], Cos[[Theta]]}* side}, {corner, corner + vb, corner + vb + vs, corner + vs}] makeRect[] := toRectangle[{Random[], Random[]}, [Pi]/2 Random[], Random[], Random[]] rectLine[{pFirst_, pRest__}] := Line[{pFirst, pRest, pFirst}] ShowRects[r1_, r2_] := Show[Graphics[{PointSize[0.05], Hue[.5], rectLine[r1], MapIndexed[{Point[#1], GrayLevel[0], Text[First[#2], #1]} &, r1], Hue[0], rectLine[r2], MapIndexed[{Point[#1], GrayLevel[0], Text[First[#2], #1]} &, r2]}], Background -> GrayLevel[.8], AspectRatio -> Automatic, PlotRange -> All] test cases: rect[1] = toRectangle[{0, 0}, 0, 1, 1]; (* from David *) rect[2] = toRectangle[{1, 1}*0.9, [Pi]/4, 2, 1]; ShowRects[rect[1], rect[2]] rx = rect[2] /. {x_?NumericQ, y_} :> {x, y} + {-0.1, 0.15}; ShowRects[rect[1], rx] rxx = {{-.5, .2}, {1.5, .2}, {1.5, .8}, {-.5, .8}}; ShowRects[rect[1], rxx] test data: recs1000 = Table[makeRect[],{1000}]; Now here my solution. It is written such as to communicate the idea, call it elegant: offSide[r2_][{p1_, p2_}] := And @@ ((p2 - p1).(# - p1) <= 0 &) /@ r2 rectOverlap[r1_, r2_] := =AC (Or @@ offSide[r2] /@ Partition[r1, 2, 1, {1, 1}] [Or] Or @@ offSide[r1] /@ Partition[r2, 2, 1, {1, 1}]) I came to this, when I tried to expand my solution for evenly oriented rectangles to the general case. I first tried oblique coordinates, sighting along the sides of the rectangles, then saw that giving them in the dual base is computationally simpler, to recognize i.e. just the distance of a point from the side's (straight line). Correctness: rectOverlap[rect[1], rect[2]] True rectOverlap[rect[1], rx] False rectOverlap[rect[1], rxx] True Performance: (testr1 = MapThread[ rectOverlap, {recs1000, RotateLeft[recs1000, 1]}]); // Timing {3.635 Second, Null} The costs for RotateLeft are negligable in Timing. Garry Helzer had proposed a solution which wasn't correct (e.g. for rect[1}, rxx) as he noted himself. however noticed that it can be fixed. Here my version thereof. (You can see how similar it is, starting from different reasoning.) rightSide[a_, {b_, c_}] := Det[Prepend[#, 1] & /@ {a, b, c}] < 0 vertexExcluded[r1_, r2_] := =AC (Or @@ And @@@ Outer[rightSide[#2, #1] &, Partition[r2, 2, 1, {1, 1}], r1, 1] [Or] Or @@ And @@@ Outer[rightSide[#2, #1] &, Partition[r1, 2, 1, {1, 1}], r2, 1]) (testr4 = MapThread[ vertexExcluded, {recs1000, RotateLeft[recs1000, 1]}]); // Timing {3.646 Second, Null} testr1 === testr4 True of quite similar performance. gave a different implementation of this (as seen below) which is marginally faster. Now here Bobby's solution, rewritten in my style (which makes it slightly faster): extent[r1_, r2_] := {Min[#], Max[#]} & /@ ((r1[[{1, 2}]] - r1[[{2, 3}]]).Transpose[r2]) cannotIntersect[{{min1_, max1_}, {min2_, max2_}}] := max2 < min1 || max1 < min2 intersects[r1_, r2_] := Catch[If[cannotIntersect[#], Throw[False]] & /@ Flatten[Transpose[ Join[Outer[extent, {r1}, {r1, r2}, 1], Outer[extent, {r2}, {r2, r1}, 1]], {1, 3, 2}], 1]; True] (testr5 = MapThread[intersects, {recs1000, RotateLeft[recs1000, 1]}]); // Timing {1.502 Second, Null} testr5 === testr1 True the tests for all sides. Such we come to use of the non-strict evaluation of And[ ] and Or[ ]. This effectively corresponds to a Catch and Throw. rectOverlap2[r1 : {p1_, p2_, p3_, p4_}, r2 : {q1_, q2_, q3_, q4_}] := ! Or[ ((p2 - p1).(# - p1) <= 0 &) /@ And @@ r2, ((p3 - p2).(# - p2) <= 0 &) /@ And @@ r2, ((p4 - p3).(# - p3) <= 0 &) /@ And @@ r2, ((p1 - p4).(# - p4) <= 0 &) /@ And @@ r2, ((q2 - q1).(# - q1) <= 0 &) /@ And @@ r1, ((q3 - q2).(# - q2) <= 0 &) /@ And @@ r1, ((q4 - q3).(# - q3) <= 0 &) /@ And @@ r1, ((q1 - q4).(# - q4) <= 0 &) /@ And @@ r1] (testr2 = MapThread[ rectOverlap2, {recs1000, RotateLeft[recs1000, 1]}]); // Timing {1.502 Second, Null} testr2 === testr1 True Equal in performance to Bobby's solution. The use of And with ((p2 - p1).(# - p1) <= 0 &) /@ And @@ r2, etc. is a bit tricky: it effectively prevents the evaluation of (p2 - p1).(q1 - p1) <= 0 etc., such that this is evaluated within And (non-standard evaluation) after mapping. And @@ ((p2 - p1).(# - p1) <= 0 &) /@ r2 to the contrary is less performant. (You can see here how clever the language is designed, to allow use of And as a container, until the time comes to execute!) This solution can be improved a little bit; we replace mapping by threading and delay execution of the pure functions' body to the application of And now by a different method (since we don't Map): rectOverlap3[r1 : {p1_, p2_, p3_, p4_}, r2 : {q1_, q2_, q3_, q4_}] := ! Or[ Block[{v = p2 - p1}, Or[And @@ Thread[Unevaluated[(Unevaluated[v.(# - p1) <= 0] &)[r2]]], And @@ Thread[Unevaluated[(Unevaluated[v.(# - p2) >= 0] &)[r2]]]]], Block[{v = p4 - p1}, Or[And @@ Thread[Unevaluated[(Unevaluated[v.(# - p1) <= 0] &)[r2]]], And @@ Thread[Unevaluated[(Unevaluated[v.(# - p4) >= 0] &)[r2]]]]], Block[{v = q2 - q1}, Or[And @@ Thread[Unevaluated[(Unevaluated[v.(# - q1) <= 0] &)[r1]]], And @@ Thread[Unevaluated[(Unevaluated[v.(# - q2) >= 0] &)[r1]]]]], Block[{v = q4 - q1}, Or[And @@ Thread[Unevaluated[(Unevaluated[v.(# - q1) <= 0] &)[r1]]], And @@ Thread[Unevaluated[(Unevaluated[v.(# - q4) >= 0] &)[r1]]]]]] (testr3 = MapThread[ rectOverlap3, {recs1000, RotateLeft[recs1000, 1]}]); // Timing {1.442 Second, Null} testr3 === testr1 True So this is fastest by a small margin, but has lost almost all elegance. The outer Unevaluated is necessary to prevent evaluation within Thread, the inner does the essential trick noted above. Hope this was of some interest, >-----Original Message----- >Sent: Monday, August 26, 2002 10:16 AM > rectangle intersection >Garry, Also note your solution requires rectangle points to be in clockwise >order (mine doesn't), but yours works for arbitrary convex polygons as >written. Bobby -----Original Message----- >RE: >rectangle intersection Garry, Here's a solution using your LeftSide concept; it works perfectly but >takes twice as much time as my solution. Both solutions look at every >vertex of both rectangles, but mine uses two sides from each and yours >requires looking at all four sides of each rectangle. I'd think yours >should be a trifle faster than this, though. There may be efficiencies >I'm missing (in both solutions). ClearAll[cis, rect, pickRect, extent, cannotIntersect, intersects, >daveRect] >cis[t_] := {Cos@t, Sin@t} >rect[{pt : {_, _}, angle_, {len1_, len2_}}] := Module[{pt2}, > {pt, pt2 = > pt + len1 cis[angle], > pt2 - len2 cis[angle - Pi/2], pt - len2 cis[angle - Pi/2]}] >daveRect := {{Random[], Random[]}, Random[] + Pi/2, {Random[], >Random[]}} >pickRect := rect@daveRect >extent[r1_, > r2_] := {Min@#, Max@#} & /@ ((Take[r1, 2] - r1[[{2, >3}]]).Transpose@r2) >cannotIntersect[{{min1_, max1_}, {min2_, > max2_}}] := max2 < min1 || min2 > max1 >intersects[r1_, r2_] := Catch[ > If[cannotIntersect[#], Throw[False]] & /@ >Flatten[Transpose[Outer[extent, >{r1}, {r1, r2}, 1]~Join~Outer[extent, {r2}, {r2, r1}, 1], {1, 3, 2}], >1]; > Throw[True]] ClearAll[leftSide,leftIntersects,sides] >sides[a_List]:=Partition[Join[a,{First@a}],2,1] >leftSide[{a_,b_},{{c_,d_},{e_,f_}}]:=-b c+a d+b e-d e-a f+c f>0 >leftSide[a:{{_,_}..},b:{{_,_},{_,_}}]:=leftSide[#,b]&/@a >leftSide[a_List,b:{{{_,_},{_,_}}..}]:=leftSide[a,#]&/@b >leftIntersects[a_,b_]:=!Or@@(And@@#&/@leftSide[a,sides@b])&&! > Or@@(And@@#&/@leftSide[b,sides@a]) davePairs={daveRect,daveRect}&/@Range[10000]; >rectanglePairs=Map[Reverse@rect[#]&,davePairs,{2}]; >Timing[right=intersects[Sequence@@#]&/@rectanglePairs;] >Timing[test=leftIntersects[Sequence@@#]&/@rectanglePairs;] >right[Equal]test {3.187999999999999*Second, Null} >{6.765000000000001*Second, Null} >True -----Original Message----- > rectangle >intersection As Daniel Lichtblau pointed out, the statement below about vertices is >nonsense. Consider two overlapping rectangles arranged as a cross. You >need to compute intersections and test them instead of vertices. Begin forwarded message: rectangle >intersection >> Begin forwarded message: >> Dear colleagues, >> any hints on how to implement a very fast routine in Mathematica for >> testing if two rectangles have an intersection area? >> Frank Brand >> Here is one approach. >> Given three points {x1,y1},{x2,y2},{x3,y3}, switch to homogenous >> coordinates a={1,x1,y1}, b={1,x2,y2}, c={1,x3,y3}. Then >> Sign[Det[{a,b,c}]] is +1 if and only if the point a lies on your left >as >> you walk along the line though b and c in the direction from b to c. >> ( If the result is zero, then a lies on the line.) >> The value of the determinant is >x2y3-x3y2-x1y3+x3y1+x1y2-x2y1, and the >> speed of the algorithm depends essentially on how fast this quantity >can >> be computed. Suppose we write a function LeftSide[a,{b,c}] that >computes >> the sign of the determinant. >> Now let {p1,p2, . . ., pn} be a list of vertices (pi={xi,yi}) of a >> convex polygon traced counterclockwise. Then a lies within or on the >> boundary of the polygon if and only if none of the numbers >> LeftSide[a,{pi,p(i+1)}] are -1. That is, if -1 does not appear in the >> list LeftSide[a,#]&/@Partition[{p1,p2,. . .,pn,p1},2,1]. >> Now use the fact that if two convex polynomials overlap, then some >> vertex of one of them must lie inside or on the boundary of >the other. >> If an overlap of positive area is required, then the check is that >only >> +1 appears--not that -1 does not appear. >> For two rectangles ( or parallelograms) this approach requires the >> evaluation of 16 determinants, so it may be a bit expensive. If the >> points have rational coordinates, then (positive) denominators may be >> cleared in the homogeneous coordinates and the computations can be >done >> in integer arithmetic, at the cost of at least three more >> multiplications per determinant. >Garry Helzer >Department of Mathematics >University of Maryland >College Park, MD 20742 >301-405-5176 >gah@math.umd.edu > ==== I'm looking for a way of finding the approximation for partitial binomial sum. I'll be pleasant for any hint.. Constantine. Constantine Elster Computer Science Dept. Technion I.I.T. Office: Taub 411 ==== > Here's my contestant: < Union[KSubsets[PadRight[vals, k*Length[vals], vals], k]] Here is another solution; probably less elegant, but I found it much faster (DiscreteMath's Subsets and KSubsets are too slow. Besides, it produces each tuple only once): KTuples2[n_Integer, L_List] := Flatten[Outer[Append, KTuples2[n-1, L], L, 1], 1] /; n > 1; KTuples2[1, L_List] := Transpose[{L}] (Both function yields the tuples in lexicographic order.) Sz. Szikla ==== Here a easy way : In[4]:= expr=a b x^2 + 5 x^3 + 5 Sqrt[4 - x^2] In[5]:= FullForm[expr] Out[5]//FullForm= Plus[Times[a,b,Power[x,2]],Times[5,Power[x,3]], Times[5,Power[Plus[4,Times[-1,Power[x,2]]],Rational[1,2]]]] In[9]:= expr[[3,2,1]] Out[9]= 4 - x^2 Meilleures salutations Florian Jaccard professeur de Math.8ematiques EICN-HES -----Message d'origine----- Envoy.8e : mar., 27. ao.9et 2002 08:08 Ë : mathgroup@smc.vnet.net Objet : How do I pick out the expression under a radical? I'm a poor physicist trying to figure out how to sort out the physical from the non-physical solutions to a problem. To do that, I need to be able to look at an expression and pick out a subexpression, the part under the radical. For example, say I've got the expression a b x^2 + 5 x^3 + 5 Sqrt[4 - x^2] I'd like to pick out 4 - x^2, which would then tell me that x is between +/- 2. I know there has got to be an easy way to do it, but I can't find it. Any help would be appreciated. Steve Beach asb4@psu.edu http://www.thebeachfamily.org ==== > I'm a poor physicist trying to figure out how to sort out the > physical from the non-physical solutions to a problem. To do > that, I need to be able to look at an expression and pick out a > subexpression, the part under the radical. For example, say I've got the expression a b x^2 + 5 x^3 + 5 Sqrt[4 - x^2] I'd like to pick out 4 - x^2, which would then tell me that x is > between +/- 2. I know there has got to be an easy way to do it, but I > can't find it. > Needs[Algebra`InequalitySolve`]; expr = a b x^2+5 x^3+5 Sqrt[4-x^2]; InequalitySolve[#>=0, x]& /@ Cases[expr, Sqrt[x_] -> x, Infinity] {-2 <= x <= 2} ==== > I would like to know, if is possible to solve Integrate[(exp[-a/x])/(x^2-b^2),{x,0,infinity}] with a and b constant ( Real ) using Mathematica. > Integrate[(Exp[-a/x])/(x^2-b^2),{x,0,Infinity}, GenerateConditions->False]//FullSimplify Sqrt[-(1/b^2)]*((1/2)*Pi*Cosh[a/b] + CosIntegral[a*Sqrt[-(1/b^2)]]*Sin[a*Sqrt[-(1/b^2)]]) + (Cosh[a/b]*SinhIntegral[a/b])/b FullSimplify[%, Element[{a,b}, Reals]] (1/(2*b*Abs[b]))*(-2*b*CosIntegral[(I*a)/Abs[b]]* Sinh[a/Abs[b]] + Cosh[a/b]*(I*b*Pi + 2*Abs[b]*SinhIntegral[a/b])) ==== Bob, Table[ Plot[ Sin[n x], {x, 0, Pi}], {n, 1, 5}] and Table[ Show[Graphics[Line[{{0, 0}, {5, n}}]], PlotRange -> {{0, 6}, {0, 6}}], {n, 1, 5}] They both have the graphics output cells grouped in the middle and separate from the Input cell. The reason that this is important for me is that I am doing an animation; and after the animation I would like to delete all the graphic images; but when I use Show[Graphics[ this would mean deleting the input command as well. Could someone explain this to me and also make a suggestion so how I could use Show[Graphics[ ] and have the middle cell marker *only* encompass the output. ==== Steve, Here is a slightly more complicated case. expr = a b x^2 + 5 x^3 + 5 Sqrt[4 - x^2] - 1/Sqrt[5 - 2x^2] The following picks out the expressions under square roots. Square roots are represented as Power[a,1/2] and if they are in the denominator they are a -1/2 power. We use an Alternative in the pattern to pick out both. rexprs = Cases[expr, Power[a_, 1/2 | -1/2] -> a, Infinity] {5 - 2*x^2, 4 - x^2} The following Standard Package is useful. Needs[Algebra`InequalitySolve`] And @@ (# >= 0 & /@ rexprs) InequalitySolve[%, x] 5 - 2*x^2 >= 0 && 4 - x^2 >= 0 -Sqrt[5/2] <= x <= Sqrt[5/2] Steve Beach asb4@psu.edu http://www.thebeachfamily.org ==== Valdeci, It appears that the integral will not converge if b is real. Mathematica gives... Integrate[Exp[-a/x]/(x^2 - b^2), {x, 0, Infinity}] If[Re[a] > 0 && Arg[b^2] != 0, (1/2)*Sqrt[-(1/b^2)]* (2*CosIntegral[a*Sqrt[-(1/b^2)]]* Sin[a*Sqrt[-(1/b^2)]] + Cos[a*Sqrt[-(1/b^2)]]* (Pi - 2*SinIntegral[a*Sqrt[-(1/b^2)]])), Integrate[1/(E^(a/x)*(-b^2 + x^2)), {x, 0, Infinity}]] If b is Real then Arg[b^2]==0 and Mathematica doesn't solve it. Let's define a function that allows us to test specific values of a and b. f[a_, b_][x_] = Exp[-a/x]/(x^2 - b^2); Integrate[f[2, 3][x], {x, 0, Infinity}] Integrate::idiv : Integral of 1/(E^(2/x)*(-9 + x^2)) does not converge on {0, Infinity}. But if we use an imaginary value for b... Integrate[f[2, 3I][x], {x, 0, Infinity}] %//N (1/6)*(2*CosIntegral[2/3]*Sin[2/3] + Cos[2/3]*(Pi - 2*SinIntegral[2/3])) 0.254022 Master«s Degree of Applied Physics - Unesp/Rio Claro - State of S.8bo Paulo - Brazil Laboratory of Electrical Measurements phone : ( 0XX19 ) 526 - 2237 ********************************************************************* ==== I am having a strange problem with a function giving a complex number as a result. I did the following: - define a function: denom[x_, p_, d_] := Sqrt[1 + (x*Tan[p]/d)^2] Integrate and simplify it with the assumption that d is larger than 0: FullSimplify[Integrate[denom[x, p, d], {x, 0, d}], d > 0] The result of the above line is d/2*(1+i*Sqrt[2]*d*Cos[p]^2)*Sqrt[Sec[p]^2] where i is Sqrt[-1] I assing it to a function called peter in the following way: peter[p_, d_] := FullSimplify[Integrate[denom[x, p, d], {x, 0, d}], d>0] and check the value of the function at [0,1] peter[0,1] and the result is 1. How is it possible that the result doesn't have an imaginary part??? I would expect the result to be 0.5+Sqrt[2]/2*i Peter ==== Lucas, One way to change the precedence of CirclePlus is to change the file UnicodeCharacters.tr. On my machine the file is located under ../4.1/SystemFiles/FrontEnd/TextResources Open up the file, search for CirclePlus, change the precedence from 450 to 420, and then save. Of course, it would be wise to make a backup copy of the file before you make any changes. Also, 420 is low enough to get the behavior you desire, but you may want to experiment with other precedences. Then, start mathematica and you will get the behavior you want. Carl Woll Physics Dept U of Washington I'm attempting to implement an abstract mathematica package in > mathematica that utilized the [CirclePlus] operator in an unusual > way. Specifically, the [CirclePlus] has a precidence lower than + > and introduces barriers in the computation. So, an expression such as a + b [CirclePlus] c + d --> (a+b) [CirclePlus] (c+d) The mathematica ouput of a + d + (b [CirclePlus] c) is incorrect. I've tried playing with the > PrecedenceForm[] function, but that does not seem able to produce the > desired effect. Also, I would like to introduce a notation like N > [BigCirclePlus] x[[i]] --> x[[1]] [CirclePlus] x[[2]] [CirclePlus] > .... > i=0 analagous to summation, but mathematica does not appear to offer the > CirclePlus in a large format. to relate this to the case above, x[1] > = (a + b) and > x[2] = (c + d), so each indexed element is a subexpression. Finally, I would like to be able to set up the CirclePlus operator > such that the following algebraic relations hold: > Sum BigCirclePlus E = BigCirclePlus Sum E > i j ij j i ij d d > -- BigCirclePlus E = BigCirclePlus -- E > dx j j j dx j -Lucas Scharenbroich > -MLS Group / JPL > ==== Lucas, I hope that your question will provoke a number of replies because I think it is an interesting topic. First, it would be nice if Mathematica had a ShowPrecedence statement to quickly retrieve a precedence number for any command. It is a bit time consuming to search through the table in Section A.2.7. Next, it would be nice if the user could set the precedence for operators that don't have built-in definitions. Since it appears that you can't do that, is it possible to switch the meanings of Plus and CirclePlus in your theory? Are you depending on the numerical behavior of Plus? Go with the precedence that Mathematica gives you. Or you could use something like VerticalBar or RightTee which have lower precedence than Plus, but perhaps don't have the look that you want. You could try to use the Notation package for your CirclePlus sum. But I always find the Notation package difficult to use and like to use StandardForm as much as possible. One possibility is... !((([Sum]+(i = 1)%5 x[i])) /. Plus -> CirclePlus) These are weak answers to your question, but maybe they will bring in more discussion. desired effect. Also, I would like to introduce a notation like N [BigCirclePlus] x[[i]] --> x[[1]] [CirclePlus] x[[2]] [CirclePlus] .... i=0 analagous to summation, but mathematica does not appear to offer the CirclePlus in a large format. to relate this to the case above, x[1] = (a + b) and x[2] = (c + d), so each indexed element is a subexpression. Finally, I would like to be able to set up the CirclePlus operator such that the following algebraic relations hold: Sum BigCirclePlus E = BigCirclePlus Sum E i j ij j i ij d d -- BigCirclePlus E = BigCirclePlus -- E dx j j j dx j -Lucas Scharenbroich -MLS Group / JPL ==== I need some help with using FindRoot. I want to solve a system of nonlinear equations numerically. Each equation in the system is an equation with vector variables. The equations are such that it is difficult to convert them to equations involving only the components of the vector variables. I have tried the following two possibilities without success. In what follows I am using a MADE UP EXAMPLE. In this example it is easy to write the equations in terms of only the components. Furthermore the correct solution is obvious. But I made up the example for illustration only. ----------------------------Try 1-------------------------------------------- q = {{x[1], y[1]}, {x[2], y[2]}}; FindRoot[{q[[1]] + q[[2]] Sqrt[q[[2]].q[[2]]] == {0, 0}, q[[1]] + q[[2]] == {0, 0}}, {q[[1]], {0, 0}}, {q[[2]], {0, 0}}] This results in the error message : FindRoot::fddis: Start specification {q[[1]],{0,0}} does not contain distinct starting values. ----------------------------Try 2--------------------------------------------- FindRoot[{q[[1]] + q[[2]] Sqrt[q[[2]].q[[2]]] == {0, 0}, q[[1]] + q[[2]] == {0, 0}}, {x[1], 0}, {x[2], 0}, {y[1], 0}, {y[2], 0}] This results in the error message : FindRoot::frnum: Function {0.,0.},{0.,0.}} is not a length 4 list of numbers at {x[1],x[2],y[1],y[2]} = {0., 0., 0., 0.} Questions 1) How do I fix these two methods ? 2) What do the error messages mean ? Please keep in mind that this example is made up and trivial to solve without Mathematica. It is being used for illustration purpose only. ==== > I need some help with using FindRoot. I want to solve a system of > nonlinear equations numerically. Each equation in the system is an > equation with vector variables. The equations are such that it is > difficult to convert them to equations involving only the components > of the vector variables. I have tried the following two possibilities without success. In what > follows I am using a MADE UP EXAMPLE. In this example it is easy to > write the equations in terms of only the components. Furthermore the > correct solution is obvious. But I made up the example for > illustration only. ----------------------------Try > 1-------------------------------------------- q = {{x[1], y[1]}, {x[2], y[2]}}; > FindRoot[{q[[1]] + q[[2]] Sqrt[q[[2]].q[[2]]] == {0, 0}, > q[[1]] + q[[2]] == {0, 0}}, {q[[1]], {0, 0}}, {q[[2]], {0, 0}}] This results in the error message : FindRoot::fddis: Start specification {q[[1]],{0,0}} does not contain > distinct > starting values. > ----------------------------Try > 2--------------------------------------------- FindRoot[{q[[1]] + q[[2]] Sqrt[q[[2]].q[[2]]] == {0, 0}, > q[[1]] + q[[2]] == {0, 0}}, {x[1], 0}, {x[2], 0}, {y[1], 0}, > {y[2], 0}] This results in the error message : FindRoot::frnum: Function {0.,0.},{0.,0.}} is not a length 4 list > of numbers at {x[1],x[2],y[1],y[2]} = {0., 0., 0., 0.} Questions 1) How do I fix these two methods ? For the second, you can ... o Make sure the first argument is evaluated (use Evaluate[]) o Get rid of the Equal (==) o Flatten the vectors. In[1]:= q={{x[1],y[1]},{x[2],y[2]}}; FindRoot[Evaluate[ Flatten[{q[[1]]+q[[2]] Sqrt[q[[2]].q[[2]]],q[[1]]+q[[2]]}]],{x[1], 0},{x[2],0},{y[1],0},{y[2],0}] Out[2]= {x[1] -> 0., x[2] -> 0., y[1] -> 0., y[2] -> 0.} For the first, you will have to wait until a future version of Mathematica (this works in a development version now as shown below) which will support vector variables. It will still not support variables with head Part (like q[[1]]), so you can do FindRoot[{q1 + q2 Sqrt[q2.q2], q1 + q2},{q1,{0,0}},{q2,{0,0}}] which returns In[1]:= FindRoot[{q1 + q2 Sqrt[q2.q2], q1 + q2},{q1,{0,0}},{q2,{0,0}}] Out[4]= Note that the Evaluate[] will no longer be necessary > 2) What do the error messages mean ? FindRoot::fddis: means FindRoot is looking for numbers as starting values. FindRoot has a syntax which accepts two starting values for using derivative FindRoot::frnum: If FindRoot cannot resolve a list of equalities, it looks for a list of something which evaluates to numbers when the variables take on numerical values. Please keep in mind that this example is made up and trivial to solve > without Mathematica. It is being used for illustration purpose only. ==== If I want to protect the Mathematica Program, what can I do? Is there any method to avoid other people's reading my program but it is still able to run fluently? Gory ==== You could try obfuscating it, i.e., scrambling the symbol names except for those you wish to export. Check out obfuscation tools under http://www.semdesigns.com/Products/Formatters/index.html. We don't have an obfuscator at this moment for Mathematica, but our base technology can build obfuscators for langauges for which we have definitions, ... and we happen to have a definition of Mathematica. -- Ira Baxter, Ph.D. CTO Semantic Designs www.semdesigns.com 512-250-1018 > If I want to protect the Mathematica Program, what can I do? Is there any method to avoid other people's reading my program but > it is still able to run fluently? > Gory > ==== Mathematica version 4.2 has no problem with this one. All you have to do is spell things correctly. Integrate[Exp[-a/x]/(x^2 - b^2), {x, 0, Infinity}] If[Re[a] > 0 && Arg[b^2] != 0, (1/2)*Sqrt[-(1/b^2)]* (2*CosIntegral[ a*Sqrt[-(1/b^2)]]* Sin[a*Sqrt[-(1/b^2)]] + Cos[a*Sqrt[-(1/b^2)]]* (Pi - 2*SinIntegral[ a*Sqrt[-(1/b^2)]])), Integrate[1/(E^(a/x)* (-b^2 + x^2)), {x, 0, Infinity}]] -----Original Message----- ********************************************************************* Valdeci Mariano de Souza Master«s Degree of Applied Physics - Unesp/Rio Claro - State of S.8bo Paulo - Brazil Laboratory of Electrical Measurements phone : ( 0XX19 ) 526 - 2237 ********************************************************************* ==== FullForm[expr] Plus[Times[a,b,Power[x,2]],Times[5,Power[x,3]], Times[5,Power[Plus[4,Times[-1,Power[x,2]]],Rational[1,2]]]] What you want is the third argument of Plus, the second argument of Times, and the first argument of Power. expr = a b x^2 + 5 x^3 + 5 Sqrt[4 - x^2]; expr[[3]] expr[[3, 2]] expr[[3, 2, 1]] 5*Sqrt[4 - x^2] Sqrt[4 - x^2] 4 - x^2 -----Original Message----- can't find it. Any help would be appreciated. Steve Beach asb4@psu.edu http://www.thebeachfamily.org ==== I try to do the simple task of transposing a matrix. X = {{a,b},{c,d},{e,f}} whereas Transpose[{{a,b},{c,d},{e,f}}] works well. What is wrong with writing Transpose[X] ? Terje Johnsen ==== >-----Original Message----- >Sent: Monday, August 26, 2002 10:16 AM >Lucas, I hope that your question will provoke a number of replies >because I think >it is an interesting topic. First, it would be nice if Mathematica had a ShowPrecedence >statement to >quickly retrieve a precedence number for any command. It is a bit time >consuming to search through the table in Section A.2.7. Next, it would be nice if the user could set the precedence >for operators >that don't have built-in definitions. Since it appears that you can't do that, is it possible to switch the >meanings of Plus and CirclePlus in your theory? Are you >depending on the >numerical behavior of Plus? Go with the precedence that >Mathematica gives >you. Or you could use something like VerticalBar or RightTee which have >lower precedence than Plus, but perhaps don't have the look >that you want. You could try to use the Notation package for your CirclePlus >sum. But I >always find the Notation package difficult to use and like to use >StandardForm as much as possible. One possibility is... !((([Sum]+(i = 1)%5 x[i])) /. Plus -> CirclePlus) These are weak answers to your question, but maybe they will >bring in more >discussion. David Park >djmp@earthlink.net >http://home.earthlink.net/~djmp/ I'm attempting to implement an abstract mathematica package in >mathematica that utilized the [CirclePlus] operator in an unusual >way. Specifically, the [CirclePlus] has a precidence lower than + >and introduces barriers in the computation. So, an expression such as a + b [CirclePlus] c + d --> (a+b) [CirclePlus] (c+d) The mathematica ouput of a + d + (b [CirclePlus] c) is incorrect. I've tried playing with the >PrecedenceForm[] function, but that does not seem able to produce the >desired effect. Also, I would like to introduce a notation like N >[BigCirclePlus] x[[i]] --> x[[1]] [CirclePlus] x[[2]] [CirclePlus] >.... > i=0 analagous to summation, but mathematica does not appear to offer the >CirclePlus in a large format. to relate this to the case above, x[1] >= (a + b) and >x[2] = (c + d), so each indexed element is a subexpression. Finally, I would like to be able to set up the CirclePlus operator >such that the following algebraic relations hold: >Sum BigCirclePlus E = BigCirclePlus Sum E > i j ij j i ij d d >-- BigCirclePlus E = BigCirclePlus -- E >dx j j j dx j -Lucas Scharenbroich >-MLS Group / JPL > Lucas, I'm certainly not competent to give you any answer, and me too, I'd be eager to hear such -- hoped Wolfram's to react; anyway, here is my opinion. PrecedenceForm is only for parenthesizing at output. Although we have MakeExpressions to add semantic actions to the Mathematica compiler (if we may call such the transformation from input string, i.e. language, to the internal representation as indicated by FullForm i.e. code), we cannot influence the Mathematica syntax proper, i.e. parsing. The operator precedence rules however are part of that (esp. needed for box formation). So I can't see a way to reach your goal. Now, I don't know what your ordinary Plus shall designate. If it's only abstract, i.e. you don't use it for numeric calculation, you possibly might interchange the roles of Plus and CirclePlus In[6]:= a [CirclePlus] b + c [CirclePlus] d Out[6]= a[CirclePlus]b + c[CirclePlus]d As for BigCirclePlus (if you still need it after the reassigned meanings) I'd try to define a palette, but perhaps this is not possible to the extend you desire. I never tried. Another approach would be to use Union and Intersection for low precedence plus and low precedence times (or [Subset]; [Superset] or [And]; [Or] or [Therefore];[Because] or ...). The ultima ratio is to write a new front end. But, if I were you, I'd ignore these kind of problems at first and set up the package fully functioning (with 1D input), apply it to your problems and investigations, and finally, when time comes to publishing, at output formatting you have quite a lot of choices. I'm sorry, just wanted to keep the discussion alive, since anyway, this is of much interest. -- ==== > Lucas, I'm certainly not competent to give you any answer, and me too, I'd be eager > to hear such -- hoped Wolfram's to react; anyway, here is my opinion. PrecedenceForm is only for parenthesizing at output. Although we have MakeExpressions to add semantic actions to the Mathematica > compiler (if we may call such the transformation from input string, i.e. > language, to the internal representation as indicated by FullForm i.e. > code), we cannot influence the Mathematica syntax proper, i.e. parsing. > The operator precedence rules however are part of that (esp. needed for box > formation). So I can't see a way to reach your goal. Now, I don't know what your ordinary Plus shall designate. If it's only > abstract, i.e. you don't use it for numeric calculation, you possibly might > interchange the roles of Plus and CirclePlus In[6]:= a [CirclePlus] b + c [CirclePlus] d > Out[6]= a[CirclePlus]b + c[CirclePlus]d As for BigCirclePlus (if you still need it after the reassigned meanings) > I'd try to define a palette, but perhaps this is not possible to the extend > you desire. I never tried. Another approach would be to use Union and Intersection for low precedence > plus and low precedence times (or [Subset]; [Superset] or [And]; [Or] > or [Therefore];[Because] or ...). The ultima ratio is to write a new front end. But, if I were you, I'd ignore these kind of problems at first and set up > the package fully functioning (with 1D input), apply it to your problems and > investigations, and finally, when time comes to publishing, at output > formatting you have quite a lot of choices. I'm sorry, just wanted to keep the discussion alive, since anyway, this is > of much interest. is actually quite simple -- just a list of expressions. If I had an appropriate OutputForm written then the effect would be: {expr1, expr2, ..., exprN} --> expr1 [CirclePlus] expr2 [CirclePlus] ... So certainly I cn get a functional package, but the final product should be notationally similar to the pure mathematical reference. I'm sure this is a goal shared by many. If anyone is curious about what exactly I'm up to, I'm attempting to implement a Clocked Objective Function package based (primarily) on these publications: A Lagrangian Formulation of Neural Networks I: Theory and Analog Dynamics A Lagrangian Formulation of Neural Networks II: Clocked Objective Functions and Applications Both are found in Neural, Parallel and Scientific Computations 6 (1998) 297-372, authors are Eric Mjolsness and Willard L. Miranker -Lucas Scharenbroich -JPL / MLS Group ==== > I am writing a Java application that displays Mathematica output using > MathCanvas. I am having difficulty in that the internal frames > (JInternalFrame)in my application are covered by the MathCanvas when > the internal frames are moved into the MathCanvas area. I tried > setting the frame's layer to 0, but that didn't work. Can anyone help > me out? I suppose the problem is, that MathCanvas is an AWT Component, which causes problem with the other Swing JComponents; 2 possible solutions: - get J/Link 2.0, which comes with a Swing version of MathCanvas (MathGraphicsJPanel if memory serves); - if you can't do that, write a Swing replacement for MathCanvas using Swing; this is pretty simple: you can use the evaluateToImage methods, which return a byte array containg a GIF Image; if you want to make it very simple, you just make your control a JPanel that contains a JLabel, and when you want to set a M_-GraphicsExpression (from a Plot,...) you just set the GIF Image as the JLabels Icon; something like this (jlPlot being the JLabel): StdLink.requestTransaction();^M byte [] bGifData = kl.evaluateToImage(sExpression, width,height); if (bGifData == null || bGifData.length <= 1){ System.out.println(bGifData empty); } Image iPlot = Toolkit.getDefaultToolkit().createImage(bGifData); iiPlot.setImage(iPlot); jlPlot.setIcon(iiPlot); jlPlot.repaint(); murphee ==== > I am writing a Java application that displays Mathematica output using > MathCanvas. I am having difficulty in that the internal frames > (JInternalFrame)in my application are covered by the MathCanvas when > the internal frames are moved into the MathCanvas area. I tried > setting the frame's layer to 0, but that didn't work. Can anyone help > me out? I suppose the problem is, that MathCanvas is an AWT Component, which causes problem with the other Swing JComponents; 2 possible solutions: - get J/Link 2.0, which comes with a Swing version of MathCanvas (MathGraphicsJPanel if memory serves); - if you can't do that, write a Swing replacement for MathCanvas using Swing; this is pretty simple: you can use the evaluateToImage methods, which return a byte array containg a GIF Image; if you want to make it very simple, you just make your control a JPanel that contains a JLabel, and when you want to set a M_-GraphicsExpression (from a Plot,...) you just set the GIF Image as the JLabels Icon; something like this (jlPlot being the JLabel): StdLink.requestTransaction();^M byte [] bGifData = kl.evaluateToImage(sExpression, width,height); if (bGifData == null || bGifData.length <= 1){ System.out.println(bGifData empty); } Image iPlot = Toolkit.getDefaultToolkit().createImage(bGifData); iiPlot.setImage(iPlot); jlPlot.setIcon(iiPlot); jlPlot.repaint(); murphee ==== I am writing a Java application that displays Mathematica output using MathCanvas. I am having difficulty in that the internal frames (JInternalFrame)in my application are covered by the MathCanvas when the internal frames are moved into the MathCanvas area. I tried setting the frame's layer to 0, but that didn't work. Can anyone help me out? ==== I wonder if someone knows a fast way to import data from a tab-separated file when numbers use coma (instead of point) as a decimal separator. I know how to do this using: Import[MyFile.txt,Table,ConversionOptions ->{NumberPoint->,}] However I got to noticed that Import is far much time and memory consiming than ReadList[]. Anyone as an idea? TIA ==== > I am having a strange problem with a function giving a complex number as > a result. I did the following: > - define a function: > denom[x_, p_, d_] := Sqrt[1 + (x*Tan[p]/d)^2] Integrate and simplify it with the assumption that d is larger than 0: > FullSimplify[Integrate[denom[x, p, d], {x, 0, d}], d > 0] The result of the above line is > d/2*(1+i*Sqrt[2]*d*Cos[p]^2)*Sqrt[Sec[p]^2] where i is Sqrt[-1] I assing it to a function called peter in the following way: > peter[p_, d_] := FullSimplify[Integrate[denom[x, p, d], {x, 0, d}], d>0] and check the value of the function at [0,1] > peter[0,1] and the result is 1. > How is it possible that the result doesn't have an imaginary part??? > I would expect the result to be 0.5+Sqrt[2]/2*i > You are evaluating the integral each time that you call peter. When you call it with p=0 denom is evaluated to 1 before the integration. Define peter with Evaluate or else don't use a delayed set. denom[x_,p_,d_]:=Sqrt[1+(x*Tan[p]/d)^2]; peter[p_,d_]:=Evaluate[FullSimplify[Integrate[denom[x,p,d],{x,0,d}],d>0]]; peter2[p_,d_]:=FullSimplify[Integrate[denom[x,p,d],{x,0,d}],d>0]; peter[0,1] (1/2)*(1 + I*Sqrt[2]) peter2[0,1] 1 peter2[10^-6,1]//N 0.5 + 0.707107*I peter2[-10^-6,1]//N 0.5 + 0.707107*I ==== (1) To discourage alteration of the program file, save it as a binary file. Look up DumpSave in Help. (2) To discourage alteration of symbols within a Mathematica session, use the Locked attributed. (3) To finally answer your question, use the ReadProtected attribute on symbols you would like viewers not to see. ==== > I am having a strange problem with a function giving a complex number as > a result... You should perhaps examine the integral of denom. Do you really expect a complex result? The integral involves multibranched functions (a fact masked a bit by the form Tan[p] in the integrand; try replacing Tan[p] by p to see what is going on). Is your result on the branch you want? I suspect not; you are probably after a real result. The following modification produces a real result: Integrate[denom[x, p, d], {x, 0, d}, PrincipalValue -> True, GenerateConditions -> False] But you'll need to take the limit p->0. Hope this helps, ==== The integral doesn't converge when b is real, because of the second order singularity at Abs[b] in that case. Arg[b^2]!=0 is used to express this because the issue is whether that singularity is on the positive x-axis. Behavior at 0 and Infinity are fine if Re[a]>0, but otherwise those are problems too, so Mathematica has the right answer in those terms. I can't vouch for the formula it comes up with when the conditions are met, but it's not closed-form in the usual sense anyway; but it's closed-form in terms of functions MATHEMATICA is comfortable with! -----Original Message----- (Pi - 2*SinIntegral[a*Sqrt[-(1/b^2)]])), Integrate[1/(E^(a/x)*(-b^2 + x^2)), {x, 0, Infinity}]] If b is Real then Arg[b^2]==0 and Mathematica doesn't solve it. Let's define a function that allows us to test specific values of a and b. f[a_, b_][x_] = Exp[-a/x]/(x^2 - b^2); Integrate[f[2, 3][x], {x, 0, Infinity}] Integrate::idiv : Integral of 1/(E^(2/x)*(-9 + x^2)) does not converge on {0, Infinity}. But if we use an imaginary value for b... Integrate[f[2, 3I][x], {x, 0, Infinity}] %//N (1/6)*(2*CosIntegral[2/3]*Sin[2/3] + Cos[2/3]*(Pi - 2*SinIntegral[2/3])) 0.254022 ********************************************************************* ==== > I solved the epidemic SIR ODE System > ( i«[t]==a s[t] i[t] - b i[t], > r«[t]==b i[t], s[0]==700, i[0]==1, r[0]==0}, {i[t], s[t], r[t]}, {t,0,20}]; and this for fixed values of a and b. Now I want to fit the solution for variable a and b to a list of given > points (fitting using the least squares method and the mathematica fonction > findminimum). My questions are > 1- Is it possible to solve the ODE (with mathematica) for not fixed values > of a and b (so to get a parametric solution that depends on a and b)? > 2- Is it possible in mathematica to use the fonction findminimum with the > (not explicit) solutions of the ODE, if not are there some other > alternatives? In advance, thank you very much Majid There was a discussion on this topic three years ago. The URL below will take you to a reply in that thread that includes remarks and code from Carl Woll and myself. I'll also show some code for your specific example, in order to indicate potential problems. http://library.wolfram.com/mathgroup/archive/1999/Oct/msg00104.html Below is some mildly clumsy code tailored to your example. It will do the DE solving given parameter values, form an objective function (sum-of-squares type) given actual data and solutions for specific parameters, and to do the minimization. I did everything at machine precision but this is not necessarily a good idea. Also I do no error checking e.g. for cases where the numeric DE solver fails to solve over the full range. A related issue is that, depending on roughly where the correct parameter values live, and how close you are in your initial guess, this might not be at all a well-behaved problem. machsoln[a_?NumericQ,b_?NumericQ] := First[NDSolve[{ D[ss[t],t]==-a*ss[t]*ii[t], D[ii[t],t]==a*ss[t]*ii[t]-b*ii[t], D[rr[t],t]==b*ii[t], ss[0]==700, ii[0]==1, rr[0]==0}, {ii[t], ss[t], rr[t]}, {t,0,20}]]; machsol = machsoln[1/100,1]; We'll generate some data for parameter values a=1/100, b=1. machdata = Table[{t,ii[t],ss[t],rr[t]} /. machsol, {t,0,20,5}] For the objective function, given numeric values for {a,b}, we'll solve the system, evaluate at the same 't' values as are used for our data, subtract resulting vectors from corresponding data vectors, take norm squares, and sum. objfunc[data_,{a_?NumericQ,b_?NumericQ}] := Module[ {iii, sss, rrr, newdata, vals}, {iii,sss,rrr} = {ii[t],ss[t],rr[t]} /. machsoln[a,b]; newdata = Map[{iii,sss,rrr} /. t-># &, Map[First,data]]; vals = Map[#.#&, Map[Rest,data]-newdata]; Apply[Plus, vals] ] For example, we will get 0 if we use {a,b} = {.01,1}, and something nonzero if we increase both modestly, say by 10%. In[85]:= objfunc[machdata, {.01,1.}] Out[85]= 0. In[86]:= objfunc[machdata, {.011,1.1}] Out[86]= 72.5289 With the above objective function we can call FindMinimum. For this we will use two starting values for each parameter so that FIndMinimum can use a secant method. An alternative to this, wherein one passes along a gradient black box evaluator, is presented by Carl Woll in his note at the URL above. findParams[data_, inits:{a1_,b1_}] := Module[ {vals,a,b}, FindMinimum[objfunc[data,{a,b}], {a,a1,a1+.1*a1}, {b,b1,b1+.1*b1}] ] For example, if I give {a,b} = {.011,1.1} as initial values, I get a result reasonably fast and quite accurate, albeit with many warnings indicated. They basically indicate In[87]:= findParams[data, {.011,1.1}] InterpolatingFunction::dmval: Input value {20} lies outside the range of data in the interpolating function. Extrapolation will be used. InterpolatingFunction::dmval: Input value {20} lies outside the range of data in the interpolating function. Extrapolation will be used. InterpolatingFunction::dmval: Input value {20} lies outside the range of data in the interpolating function. Extrapolation will be used. General::stop: Further output of InterpolatingFunction::dmval will be suppressed during this calculation. -11 Out[87]= {8.46495 10 , {a$4965 -> 0.01, b$4965 -> 1.}} It still does reasonably well when I perturb by 50% from the correct parameter values. This time the warning message indicates that we might be closer to trouble. In[89]:= findParams[data, {.015,1.5}] FindMinimum::fmcv: Failed to converge to the requested accuracy or precision within 30 iterations. -10 Out[89]= {6.48159 10 , {a$8747 -> 0.01, b$8747 -> 1.}} You might want to play with various options in FindMinimum such as MaxIterations. You might also need to use NDSolve options e.g. WorkingPrecision in order to improve the quality of the result. ==== I solved the epidemic SIR ODE System ( ) numerically using NDSolve: approxsolutions=NDSolve[{ s«[t]==-a s[t] i[t], i«[t]==a s[t] i[t] - b i[t], r«[t]==b i[t], s[0]==700, i[0]==1, r[0]==0}, {i[t], s[t], r[t]}, {t,0,20}]; and this for fixed values of a and b. Now I want to fit the solution for variable a and b to a list of given points (fitting using the least squares method and the mathematica fonction findminimum). My questions are 1- Is it possible to solve the ODE (with mathematica) for not fixed values of a and b (so to get a parametric solution that depends on a and b)? 2- Is it possible in mathematica to use the fonction findminimum with the (not explicit) solutions of the ODE, if not are there some other alternatives? In advance, thank you very much Majid Reply-To: kjm@KevinMcCann.com ==== Majid, I separately sent you a nb that addresses the numerical curve fit of an NDSolve result. I have had this and have used the technique for a long time; the example, however, did not originate with me. Apologies to the original author - lost in the mists of mind and time. Kevin I solved the epidemic SIR ODE System > ( i«[t]==a s[t] i[t] - b i[t], > r«[t]==b i[t], s[0]==700, i[0]==1, r[0]==0}, {i[t], s[t], r[t]}, {t,0,20}]; and this for fixed values of a and b. Now I want to fit the solution for variable a and b to a list of given > points (fitting using the least squares method and the mathematica > fonction findminimum). My questions are > 1- Is it possible to solve the ODE (with mathematica) for not fixed values > of a and b (so to get a parametric solution that depends on a and b)? > 2- Is it possible in mathematica to use the fonction findminimum with the > (not explicit) solutions of the ODE, if not are there some other > alternatives? In advance, thank you very much Majid ==== Let say you have your data in an array like so: data = {{5, {685, 12, 4}}, {10, {550, 105, 50}}, {15, {207, 250, 244}}, {20, {69, 169, 463}}} where 5, 10, 15, 20 are the observation times. (These numbers are perturbed slightly from an actual solution.) The following defines the least squares error as a function of a and b: LSE[a_, b_] := Module[ {diff, sir = {s[t],i[t],r[t]} /. NDSolve[{s'[t]== -a*s[t]*i[t], i'[t]== a*s[t]*i[t] - b*i[t], r'[t]== b*i[t], s[0]== 700, i[0]== 1, r[0]== 0}, {s[t],i[t],r[t]}, {t, 0, 20}]//First }, diff:=(sir/.t->data[[i,1]]) - data[[i,2]]; Sum[diff.diff, {i, Length[data]}] ] Now... In: FindMinimum[ LSE[a, b], {a, 0, .1}, {b, 0, 1}]//Timing Out: {5.7 sec, {14.1967, {a -> 0.000999599, b -> 0.200351}}} --- Selwyn Hollis I solved the epidemic SIR ODE System > ( i«[t]==a s[t] i[t] - b i[t], > r«[t]==b i[t], s[0]==700, i[0]==1, r[0]==0}, {i[t], s[t], r[t]}, {t,0,20}]; and this for fixed values of a and b. Now I want to fit the solution for variable a and b to a list of given > points (fitting using the least squares method and the mathematica fonction > findminimum). My questions are > 1- Is it possible to solve the ODE (with mathematica) for not fixed values > of a and b (so to get a parametric solution that depends on a and b)? > 2- Is it possible in mathematica to use the fonction findminimum with the > (not explicit) solutions of the ODE, if not are there some other > alternatives? In advance, thank you very much Majid ==== In order to do some transformations on a tree I need to be able to replace an expression with head hdA if and if only its parent has head hdB and its grandparent had head hdC. Furthermore, the item itself and its parent may have any number sibling elements. What I do now is the following. Give the expression: ttexpr = grandparent[ parent1[grandchild2[], grandchild1[], grandchild4[], grandchild1[]], grandchild1[], parent2[grandchild2[], grandchild1[], grandchild4[], grandchild1[]]]; I apply a rule: ttexpr /. { grandparent[left1___, parent1[left2___, grandchild1[], right2___], right1___] -> grandparent[left1, parent1[left2, MATCHED[], right2], right1]} which gives the desired expression: grandparent[parent1[grandchild2[], MATCHED[], grandchild4[], grandchild1[]], grandchild1[], parent2[grandchild2[], grandchild1[], grandchild4[], grandchild1[]]] But I have the feeling that it should be possible to do this more elegantly. Does anybody have an idea in this respect? Sidney Cadot ==== Perhaps you could use ReadList with the option Word, which will read your data in as strings. Then you may substitute commas with periods and convert to numbers with ToExpression? ----- Original Message ----- > 2,234 2,567 2,89 > 3,234 3,567 3,89 > I know how to do this using Import: Import[MyFile.txt, Table, > ConversionOptions -> {NumberPoint -> ,}] ; However, Import is not the function I'd like to use, because it is realy > slow over large files. I wonder if someone knows a way to use something faster than Import (I > namely think of ReadList) with coma-numbers? > ==== Yes, Import is slow, I suppose because of it's generality. Your particular case seems to be close to one that ReadList can handle efficiently. Therefore I would recommend the following sequence of steps: (1) Use ReadList to read into Words instead of Numbers. (2) Use StringReplace to replace , with . within words. (3) Convert the words to expressions with ToExpression. This should be easy provided that you do not encounter scientific notation (1,3e6). ==== > If I want to protect the Mathematica Program, what can I do? > Is there any method to avoid other people's reading my program but > it is still able to run fluently? Encode does what you're after .... I try to solve a three equation linear ODE system with constant When I try the same thing on Mathematica 4.0 (Solaris) I get a very strange result containing things like E^x#1 OR #1^2. Am I doing something wrong, or is there a bug/problem with Mathematica. Neil -- Solving a Three Equation ODE system (Linear with Constant Coefficients) with Mathematica 3.0 ---- INPUT: DSolve[{y1'[x] + c11*y1[x] + c12*y2[x] +c13*y3[x] +c1==0, y2'[x]+c21*y1[x]+c22*y2[x]+c23*y3[x]+c2==0, y3'[x]+c31*y1[x]+c32*y2[x]+c33*y3[x]+c3==0, y1[0]==y1i, y2[0]==y2i, y3[0]==y3i}, {y1[x], y2[x], y3[x]}, x] OUTPUT: Eigensystem::eivec: Unable to find eigenvector for eigenvalue !(Root[((((c13 c22 c31) - (c12 c23 c31) - (c13 c21 c32) + (c11 c23 c32) + ([LeftSkeleton] 20 [RightSkeleton])) &), 1)]). Eigensystem::eivec: Unable to find eigenvector for eigenvalue !(Root[((((c13 c22 c31) - (c12 c23 c31) - (c13 c21 c32) + (c11 c23 c32) + ([LeftSkeleton] 20 [RightSkeleton])) &), 2)]). Eigensystem::eivec: Unable to find eigenvector for eigenvalue !(Root[((((c13 c22 c31) - (c12 c23 c31) - (c13 c21 c32) + (c11 c23 c32) + ([LeftSkeleton] 20 [RightSkeleton])) &), 3)]). General::stop: Further output of !(Eigensystem :: eivec) will be suppressed during this calculation. ==== They are not a general analitical solution for a system of ODE with 3 or more variables where all coffs. are parameters. I have a package for solving SODE. Perhaps you can find it useful. Guillermo Sanchez > I try to solve a three equation linear ODE system with constant When I try the same thing on Mathematica 4.0 (Solaris) I get a very > strange result containing things like E^x#1 OR #1^2. Am I doing something wrong, or is there a bug/problem with Mathematica. Neil -- Solving a Three Equation ODE system (Linear with Constant > Coefficients) with Mathematica 3.0 ---- INPUT: DSolve[{y1'[x] + c11*y1[x] + c12*y2[x] +c13*y3[x] +c1==0, > y2'[x]+c21*y1[x]+c22*y2[x]+c23*y3[x]+c2==0, > y3'[x]+c31*y1[x]+c32*y2[x]+c33*y3[x]+c3==0, > y1[0]==y1i, y2[0]==y2i, y3[0]==y3i}, > {y1[x], y2[x], y3[x]}, x] OUTPUT: Eigensystem::eivec: > Unable to find eigenvector for eigenvalue !(Root[((((c13 > c22 > c31) - (c12 c23 c31) - (c13 c21 c32) + (c11 c23 c32) + > ([LeftSkeleton] 20 [RightSkeleton])) &), 1)]). > Eigensystem::eivec: > Unable to find eigenvector for eigenvalue !(Root[((((c13 > c22 > c31) - (c12 c23 c31) - (c13 c21 c32) + (c11 c23 c32) + > ([LeftSkeleton] 20 [RightSkeleton])) &), 2)]). > Eigensystem::eivec: > Unable to find eigenvector for eigenvalue !(Root[((((c13 > c22 > c31) - (c12 c23 c31) - (c13 c21 c32) + (c11 c23 c32) + > ([LeftSkeleton] 20 [RightSkeleton])) &), 3)]). > General::stop: > Further output of !(Eigensystem :: eivec) will be suppressed > during this calculation. ==== Guillermo, indoor air exposure to particulate matter. Does your package use Runge-Kutta or some other numerical algorithm? I'm thinking of something like that, but with a fixed (non-adaptive) step size. Neil > Neil, They are not a general analitical solution for a system of ODE with 3 > or more variables where all coffs. are parameters. I have a package > for solving SODE. Perhaps you can find it useful. > Guillermo Sanchez >>I try to solve a three equation linear ODE system with constant >>When I try the same thing on Mathematica 4.0 (Solaris) I get a very >>strange result containing things like E^x#1 OR #1^2. >>Am I doing something wrong, or is there a bug/problem with Mathematica. >>Neil >>-- Solving a Three Equation ODE system (Linear with Constant >>Coefficients) with Mathematica 3.0 ---- >>INPUT: >>DSolve[{y1'[x] + c11*y1[x] + c12*y2[x] +c13*y3[x] +c1==0, >> y2'[x]+c21*y1[x]+c22*y2[x]+c23*y3[x]+c2==0, >> y3'[x]+c31*y1[x]+c32*y2[x]+c33*y3[x]+c3==0, >> y1[0]==y1i, y2[0]==y2i, y3[0]==y3i}, >> {y1[x], y2[x], y3[x]}, x] >>OUTPUT: >>Eigensystem::eivec: >> Unable to find eigenvector for eigenvalue !(Root[((((c13 >>c22 >>c31) - (c12 c23 c31) - (c13 c21 c32) + (c11 c23 c32) + >>([LeftSkeleton] 20 [RightSkeleton])) &), 1)]). >>Eigensystem::eivec: >> Unable to find eigenvector for eigenvalue !(Root[((((c13 >>c22 >>c31) - (c12 c23 c31) - (c13 c21 c32) + (c11 c23 c32) + >>([LeftSkeleton] 20 [RightSkeleton])) &), 2)]). >>Eigensystem::eivec: >> Unable to find eigenvector for eigenvalue !(Root[((((c13 >>c22 >>c31) - (c12 c23 c31) - (c13 c21 c32) + (c11 c23 c32) + >>([LeftSkeleton] 20 [RightSkeleton])) &), 3)]). >>General::stop: >> Further output of !(Eigensystem :: eivec) will be suppressed >>during this calculation. ==== , In[104]:= LaplaceTransform[D[f[t],t],t,s] Out[104]= -f[0] + s LaplaceTransform[f[t],t,s] In[105]:= LaplaceTransform[Integrate[f[t],t],t,s] Out[105]= LaplaceTransform[Integrate[f[t] ,t], t, s] Item 104 is correct, but item 105 is not. The correct 105 should be: -f[0]/s + LaplaceTransform[f[t],t,s]/s . If Mathematica can get 104 right, then it should also produce a correct 105. This looks like a bug. Any thoughts on this? (Note: Number 105 does not look like that on the notebook page. It shows the indefinite integral with an integral symbol followed by f[t] dt instead of the function Integrate[ ]. I've spelled it out because the Vista Research, Inc. ==== I would like to match a named pattern in an expression and then square the result. But my attempt fails. Clear[f, g, x, y, a] expr = 3*f[x]*g[y] + 2 + x^2; expr /. a:(f[_]*g[_]) :> a^2 2 + x^2 + 3*f[x]*g[y] If I drop the name on the pattern, it matches - but it doesn't do what I want. expr /. f[_]*g[_] :> a^2 2 + 3*a^2 + x^2 How can I name such a pattern and use it on the rhs of a rule? ==== > I would like to match a named pattern in an expression and then square the > result. But my attempt fails. [...] I simplified your example to see whats the problem. I only take the multiplication of three symbols a, b, c. In[1]:= Clear[a, b, c, p, x, y] If you use the unnamed pattern 'a c' in Replace you get In[2]:= a b c /. a c :> x Out[2]= b x the replacement will be done because all possibilites of the multiplication are tested and the right one will be found. But if you take a named pattern 'p : a c' your are searching for a multiplication of exactly two variables called 'a' and 'c' and you are not successful with the replacement: In[3]:= a b c /. p : a c :> x Out[3]= a b c In this case you have to take into account that the multiplication can consist of more than two terms, e. g. In[4]:= a b c /. p : a c z___ :> x z Out[4]= b x¬ Hope that will help you, -- Rainer Gruber ==== I want to get the coefficient of the Legendre-Gauss Quadrature, I find this method is fast, but when the integration result is big, then the result is not accurate enough, I think it is because I only use 5 coefficient to compute it. Do you think it will be accurater when I use more coefficients to compute? Is possible to get 16 coefficients to compute? The 6 coefficients I use are from: http://mathworld.wolfram.com/Legendre-GaussQuadrature.html I need more coefficients to get accurater result. How about the method of the Integration function built-in Mathematica? Chen ==== The package NumericalMath`GaussianQuadrature` has what you want. --- Selwyn Hollis > I want to get the coefficient of the Legendre-Gauss Quadrature, > I find this method is fast, but when the integration result is big, then the result is > not accurate enough, I think it is because I only use 5 coefficient to compute it. > Do you think it will be accurater when I use more coefficients to compute? > Is possible to get 16 coefficients to compute? > The 6 coefficients I use are from: > http://mathworld.wolfram.com/Legendre-GaussQuadrature.html I need more coefficients to get accurater result. > How about the method of the Integration function built-in Mathematica? Chen > ==== The presence of 3* in your formula prevents the match pattern you want form taking place since: In[11]:= FullForm[3*f[x]*g[y]] Out[11]//FullForm= Times[3,f[x],g[y]] use instead: In[12]:= expr=3*f[x]*g[y]+2+x^2; In[13]:= expr /. a:((p_.)*f[_]*g[_]) :> p*a^2 Out[13]= 2 + x^2 + 27*f[x]^2*g[y]^2 Andrzej Kozlowski Toyama International University JAPAN > I would like to match a named pattern in an expression and then square > the > result. But my attempt fails. Clear[f, g, x, y, a] > expr = 3*f[x]*g[y] + 2 + x^2; expr /. a:(f[_]*g[_]) :> a^2 > 2 + x^2 + 3*f[x]*g[y] If I drop the name on the pattern, it matches - but it doesn't do what > I > want. expr /. f[_]*g[_] :> a^2 > 2 + 3*a^2 + x^2 How can I name such a pattern and use it on the rhs of a rule? David Park > djmp@earthlink.net > http://home.earthlink.net/~djmp/ ==== I need FrameLabels of the kind of H^s_z / H^p_Z and tried something like FrameLabel->{FontForm{HSuperscript[s]Subscript[z] ...}} but s is too far away from z. How can I manage it that s is directly above z ? Are there some backspace-characters to be used? Harry ==== Try Power[Subscript[H, z], s] I need FrameLabels of the kind of H^s_z / H^p_Z and tried something > like FrameLabel->{FontForm{HSuperscript[s]Subscript[z] ...}} but s is too far away from z. How can I manage it that s is > directly above z ? Are there some backspace-characters to be used? Harry ==== Try Power[Subscript[H, z], s] I need FrameLabels of the kind of H^s_z / H^p_Z and tried something > like FrameLabel->{FontForm{HSuperscript[s]Subscript[z] ...}} but s is too far away from z. How can I manage it that s is > directly above z ? Are there some backspace-characters to be used? ==== >-----Original Message----- >I would like to match a named pattern in an expression and >then square the >result. But my attempt fails. Clear[f, g, x, y, a] >expr = 3*f[x]*g[y] + 2 + x^2; expr /. a:(f[_]*g[_]) :> a^2 >2 + x^2 + 3*f[x]*g[y] If I drop the name on the pattern, it matches - but it doesn't >do what I >want. expr /. f[_]*g[_] :> a^2 >2 + 3*a^2 + x^2 How can I name such a pattern and use it on the rhs of a rule? David Park >djmp@earthlink.net >http://home.earthlink.net/~djmp/ Dear David, just don't insist on a single name! In[17]:= expr /. (a : f[_])*(b : g[_]) :> (a*b)^2 Out[17]= 2 + x^2 + 3*f[x]^2*g[y]^2 In[29]:= 3*ff[z]*f[x]*g[y] + 2 + x^2 /. (a : f[_])*(b : g[_]) :> (a*b)^2 Out[29]= 2 + x^2 + 3*f[x]^2*ff[z]*g[y]^2 We might tend to understand this behaviour of the pattern matcher. As Times has the Flat, Orderless attributes, the components of the pattern have to be taken apart to match separated subexpressions at the lhs, what should the pattern variable then designate in the course of this procedure? Look at the FullForm In[31]:= (a : f[_])*(b : g[_]) // FullForm Out[31]//FullForm= Times[Pattern[a, f[Blank[]]], Pattern[b, g[Blank[]]]] compared to In[12]:= a : f[_]*g[_] // FullForm Out[12]//FullForm= Pattern[a, Times[f[Blank[]], g[Blank[]]]] Depending on your real problem... In[43]:= expr /. a_?NumericQ *b_ :> a*Times[b]^2 Out[43]= 2 + x^2 + 3*f[x]^2*g[y]^2 ...might be a more elegant (but risky) solution (?), or perhaps else (more robust if you know the names f,g)... In[79]:= expr /. a:(f | g)[___] :> a^2 Out[79]= 2 + x^2 + 3*f[x]^2*g[y]^2 In[139]:= expr /. a : h_[___] /; MemberQ[{f, g}, h] :> a^2 Out[139]= 2 + x^2 + 3*f[x]^2*g[y]^2 Perhaps a fine way would be In[74]:= 2 + x^2 + 3 f[x]*g[y] /. HoldPattern[Times[a:(_[___]..)]] :> Times[a]^2 Out[74]= 2 + x^2 + 3*f[x]^2*g[y]^2 but of course this only works if you have at least two factors f[] and g[] (and no mixed powers of x and y!) In that case come back to something like In[103]:= 2 + x^2*y^2 + 3*x*y^3*f[x]*g[y] + f[x] /. a : (_[___]) :> a^2 /; FreeQ[a, Power | Times] Out[103]= 2 + x^2*y^2 + f[x]^2 + 3*x*y^3*f[x]^2*g[y]^2 ==== version 4.1.5.0 I try to do the simple task of transposing a matrix. X = {{a,b},{c,d},{e,f}} > whereas Transpose[{{a,b},{c,d},{e,f}}] works well. What is wrong with writing Transpose[X] ? Terje Johnsen ==== That doesn't work because I don't want to square the 3. Of course, I could divide by p but not in my actual example. In my actual example I am not squaring but doing a MetricSimplify tensor operation and the whole purpose is to operate on only two of four factors. I can do it by giving a specific pattern but not by using a general pattern. Here is a better example. expr = f[a]g[b]h[c]; This works... expr /. g[b]h[c] :> op[g[a]h[c]] f[a] op[g[a] h[c]] This even works with a more general pattern but is a silly way to do it... expr /. g[_]h[_] :> op[g[a]h[c]] f[a] op[g[a] h[c]] This is what I want to do, but again it doesn't work: expr /. p_. (sub : g[_]h[_]) :> p op[sub] f[a] g[b] h[c] I have to be able to obtain a name for the match to the g[_]h[_] pattern. In[13]:= expr /. a:((p_.)*f[_]*g[_]) :> p*a^2 Out[13]= 2 + x^2 + 27*f[x]^2*g[y]^2 Andrzej Kozlowski Toyama International University JAPAN > I would like to match a named pattern in an expression and then square > the > result. But my attempt fails. Clear[f, g, x, y, a] > expr = 3*f[x]*g[y] + 2 + x^2; expr /. a:(f[_]*g[_]) :> a^2 > 2 + x^2 + 3*f[x]*g[y] If I drop the name on the pattern, it matches - but it doesn't do what > I > want. expr /. f[_]*g[_] :> a^2 > 2 + 3*a^2 + x^2 How can I name such a pattern and use it on the rhs of a rule? David Park > djmp@earthlink.net > http://home.earthlink.net/~djmp/ ==== > I would like to match a named pattern in an expression and then square the > result. But my attempt fails. Clear[f, g, x, y, a] > expr = 3*f[x]*g[y] + 2 + x^2; expr /. a:(f[_]*g[_]) :> a^2 > 2 + x^2 + 3*f[x]*g[y] ... Well, I see that expr /. a:Times[f[_],g[_],h___]:> a^2 works, and I think I understand why your form above does not work (examine FullForm of expr--your form does not account for 3), but I don't understand why eliminating a: from your form allows the pattern to match. ==== I would expect that Plot[Sin[x]/Sin[x], {x, -2.5, -1.5}] would produce a horizontal line at y=1. However, on my Windows XP computer it produces a graph where the y value is less than 1 at several points. Most notibly between x=-1.6 and x=-1.8 Is this just an isolated case? Or does it happen to others? If so - why? Ken. ==== This results from: a) the fact that Mathematica implements division as multiplication and reciprocation b) the use of machine precision for plotting the graph c) the default scaling of the y axis revealing the resultant inaccuracies Although Sin[x]/Sin[x] gives 1 when evaluated symbolically (x undefined), substituting a floating-point value for x results in composite division being performed numerically, with consequent inaccuracy. This can be verified by the following: In[1]:= FullForm[HoldForm[Sin[x]/Sin[x]] Out[1]//FullForm= HoldForm[Times[Sin[x], Power[Sin[x], -1]]] By default, Mathematica scales the y axis such that the small discrepancies are visible. The PlotRange option may be given to explicitly specify the range for the y axis (for example PlotRange->{0, 2}). Ian McInnes. > I would expect that Plot[Sin[x]/Sin[x], {x, -2.5, -1.5}] would produce a horizontal line at y=1. However, on my Windows XP computer it produces a graph where the y value is > less than 1 at several points. Most notibly between x=-1.6 and x=-1.8 Is this just an isolated case? Or does it happen to others? If so - why? Ken. > ==== I get very small dips (vees?) at the same spots using 4.1. What is your experience with the presentation feature of version 4.2 ? That is what is attracting me to upgrade and I want to hear experiences. > I would expect that Plot[Sin[x]/Sin[x], {x, -2.5, -1.5}] would produce a horizontal line at y=1. However, on my Windows XP computer it produces a graph where the y value is > less than 1 at several points. Most notibly between x=-1.6 and x=-1.8 Is this just an isolated case? Or does it happen to others? If so - why? ==== I eventually figured this one out: (1) change the default font to smaller (10 pts vs 12). This solves the problem, but makes the help text illegibly small. This is cured by step 2: (2) go into preferences and change the default zoom to larger (1.25 from 1). > The Windows, the Mathematica Help browser has a categories section, where > the headings and subheadings of each help file appear. In version 3.x, those > fonts (by default) appear nice and small (smaller than the text on the > menu). In 4.1, the font is so large I cannot read the entire heading. How > can I revert to the proper display? ==== I am fairly new to Mathematica and once before asked a question and received some very helpful responses. This time the problem seems very odd and I may be making a very elementary error. Here is the context: I define a function of the form: f[...,listA_, newEntry_,...]:= Which[...] Here Which has the form of a set of logically exclusive and exhausive tests, each test with its own action that modifies the concrete list subsituted for listA_. For instance, if there were only two tests the rhs above would be one that puts the newEntry at the start of listA and the other that puts it at the end: Which[ test1, listA = Insert[listA, newEntry, 1], test2, listA = Insert[listA, newEntry, -1] ] Then I try to use the function, substituting values for the arguments: f[..., listA, newEntry, ...]. The output should be the appropriately modified list. But my actual output reproduces the input form, i.e., it is simply f[...listA,newEntry,...]. Yet, the program does do something, as the use of evaluate in placeshows: Suppose that test1 is satisfied by the particular values of the arguments. Then when I apply evaluate in place to the lhs of the action that is supposed to occur when test1 is true, in fact the value of Insert[listA,newEntry,1] is correct, but the rhs gives only the initial value of listA and not the modified value that is on the rhs. Concretely, suppose that in the function argument listA is {121} and newEntry is 200. Then after evaluation of the function (input to the kernel), that line reads, according to evaluate in place: true, {121} = {200, 121} So it seems that only part of the correct action was taken: 200 was put at the start of listA. But the assignment of this value -- the extended list -- to be the new value of listA did not take place. I then tried using a new name for the modified list, substituting this program line for test1: test1, newListA = Insert[listA, newEntry, 1] What I get here, applying evaluate in place after evaluating the function with concrete values as above is: true, newListA = {200, 121} Trace doesn't help because all I get back is the function name with its concrete arguments. Any thoughts? Tom ==== > In order to do some transformations on a tree I need to be able to replace > an expression with head hdA if and if only its parent has head hdB and its > grandparent had head hdC. Furthermore, the item itself and its parent may > have any number sibling elements. What I do now is the following. Give the expression: ttexpr = grandparent[ > parent1[grandchild2[], grandchild1[], grandchild4[], grandchild1[]], > grandchild1[], > parent2[grandchild2[], grandchild1[], grandchild4[], grandchild1[]]]; I apply a rule: ttexpr /. { > grandparent[left1___, parent1[left2___, grandchild1[], right2___], > right1___] - grandparent[left1, parent1[left2, MATCHED[], right2], right1]} which gives the desired expression: grandparent[parent1[grandchild2[], MATCHED[], grandchild4[], grandchild1[]], > grandchild1[], > parent2[grandchild2[], grandchild1[], grandchild4[], grandchild1[]]] But I have the feeling that it should be possible to do this more elegantly. > Does anybody have an idea in this respect? I think your technique is fine for small to medium size trees. For large ones it might be very slow due to all the work of patten matching. If you anticipate large inputs you might thus want to code a simple tree-walk using old-fashioned procedural code. Any time you match a grandparent head, put that subtree onto a stack that enters the next state, looking for parent nodes, etc. Daniel Lichtblau Wolfram Research ==== with the output your own solution is giving you. I would have thought not, since only one grandchild1[] with parent parent1 and grandparent grandparent. is being matched. You can get a complete match by using ReplaceRepeated instead of ReplaceAll: In[33]:= ttexpr// .{grandparent[left1___,parent1[left2___,grandchild1[],right2___], right1___]-> grandparent[left1,parent1[left2,MATCHED[],right2],right1]} Out[33]= grandparent[parent1[grandchild2[],MATCHED[],grandchild4[],MATCHED[]], grandchild1[], parent2[grandchild2[],grandchild1[],grandchild4[],grandchild1[]]] exactly the same result can be achieved in a rather different way, which may perhaps be seen as more elegant. In[34]:= ttexpr /. expr_grandparent :> (expr /. expr1_parent1 :> (expr1 /. expr2_grandchild1 :> Matched[])) Out[34]= grandparent[parent1[grandchild2[], Matched[], grandchild4[], Matched[]], grandchild1[], parent2[grandchild2[], grandchild1[], grandchild4[], grandchild1[]]] Andrzej Kozlowski Toyama International University JAPAN In order to do some transformations on a tree I need to be able to > replace > an expression with head hdA if and if only its parent has head hdB and > its > grandparent had head hdC. Furthermore, the item itself and its parent > may > have any number sibling elements. What I do now is the following. Give the expression: ttexpr = grandparent[ > parent1[grandchild2[], grandchild1[], grandchild4[], > grandchild1[]], > grandchild1[], > parent2[grandchild2[], grandchild1[], grandchild4[], > grandchild1[]]]; I apply a rule: ttexpr /. { > grandparent[left1___, parent1[left2___, grandchild1[], right2___], > right1___] - grandparent[left1, parent1[left2, MATCHED[], right2], right1]} which gives the desired expression: grandparent[parent1[grandchild2[], MATCHED[], grandchild4[], > grandchild1[]], > grandchild1[], > parent2[grandchild2[], grandchild1[], grandchild4[], grandchild1[]]] > But I have the feeling that it should be possible to do this more > elegantly. > Does anybody have an idea in this respect? > Sidney Cadot ==== >I'm finding that the ImageSize option in Export has no effect when >exporting Cell or Notebook objects. For instance, the following two >commands produce precisely the same graphic: Export[image1.jpg, Cell[Some cell contents, Text, FontSize -> 100]] Export[image2.jpg, Cell[Some cell contents, Text, FontSize -100], ImageSize -> {576, 288}] Has anyone encountered this problem before? (This is with Mathematica 4.1.5 and Mac OS X.) ---- Export takes two options that control the size of a graphic, ImageSize and ImageResolution. The difference is sometimes subtle. ImageSize changes the coordinates while ImageResolution changes the size of objects. This may sound like the same thing, but they're actually different. If I have a plot with a line. Changing ImageSize changes the location of the points in the line, which may make the line shorter or longer, but the thickness is unchanged (if it is an AbsoluteThichness). ImageResolution draws the image with a different number of pixels, so lengths and thicknesses are changed. The same is true with fonts. Why does it matter? Because there is no equivalent to ImageSize for cells or notebooks. However, Magnification is a good equivalent of ImageResolution. So ImageSize does nothing, but ImageResolution does. In[1]:= cont=Cell[Some cell contents, Text, FontSize -> 100] In[2]:= Show@ImportString[ExportString[cont, JPEG], JPEG] In[3]:= Show@ImportString[ExportString[cont, JPEG, ImageResolution ->72*3/2], JPEG] ==== I was wondering if there is a method for resizing Raster graphics (resizing the actual matrix of pixels, not just the display size). I am processing a large number of JPEG images, and we sometimes need to reduce the image size to allow data processing algorithms to function without running out of memory. In the past we simply used a program such as Photoshop to resize them before importing them into Mathematica. Due to the number of images we are processing now this is very inconvenient and it would be very useful if there was a method for accomplishing it in Mathematica, but I can't find one. I also thought about doing something simple like sampling every few pixels or averaging, but I thought there might be a method with more efficacy than this. I also tried exporting the graphics with the Export command as new JPEGs and manipulating the ImageResolution and ImageSize options but this seemed to have no effect. Any help would be much appreciated. Aaron Urbas Reply-To: kuska@informatik.uni-leipzig.de ==== take the matrix of gray values or the matrix of the color channels, apply ListInterpolation[] and generate a resampled table with the interpolated function. Jens I was wondering if there is a method for resizing Raster graphics > (resizing the actual matrix of pixels, not just the display size). I > am processing a large number of JPEG images, and we sometimes need to > reduce the image size to allow data processing algorithms to function > without running out of memory. In the past we simply used a program > such as Photoshop to resize them before importing them into > Mathematica. Due to the number of images we are processing now this > is very inconvenient and it would be very useful if there was a method > for accomplishing it in Mathematica, but I can't find one. I also > thought about doing something simple like sampling every few pixels or > averaging, but I thought there might be a method with more efficacy > than this. I also tried exporting the graphics with the Export command > as new JPEGs and manipulating the ImageResolution and ImageSize > options but this seemed to have no effect. Any help would be much > appreciated. Aaron, with the Digital Image Processing package see Downsample, Decimate or Resize. Else, the simplest method is to take every k'th sample, which can be done with the Take command. This imports the image and returns the raw data. img = Import[somefile.jpg][[1,1]]; For an image with dimensions nr x nc, and if you want to take every other sample use: small = Take[img, {1, nr, 2}, {1, nc, 2}]; You can also perform smoothing using ListConvolve prior to downsampling to eliminate some of the visual artifacts of downsampling. Done. -- ==== Yesterday I posted a question on using named patterns in a rule. I received a number of useful replies and thank all those who responded. Today I have a question that actually generated yesterday's question. I am using a new subject heading to reflect the actual nature of the question. What is the best way in Mathematica to operate on some, but not all, level parts of an expression or subexpression? Suppose I have the following expression... expr = f1[a]f2[b]f3[c]f4[d]; and I want to do an operation, op, separately on f1[a]f3[c] and f2[b]f4[d]. The operation must be done on the given pairs and not on all four factors at once. One method is to use explicit exact substitution rules. expr /. f1[a]f3[c] :> op[f1[a]f3[c]] /. f2[b]f4[d] :> op[f2[b]f4[d]] op[f1[a] f3[c]] op[f2[b] f4[d]] If a,b,c,d were long expressions, we might not want to type or copy them in. This raised my question of using named patterns. Wolf pointed out that each factor must be named to create a match with flat expressions. So we could use... expr /. (a : f1[_])(b : f3[_])(c : f2[_])(d : f4[_]) :> op[a b]op[c d] op[f1[a] f3[c]] op[f2[b] f4[d]] Andrzej Kozlowski suggested a method using Take, but using Part works better here, so we could use... expr /. a_ :> op[a[[{1, 3}]]]*op[a[[{2, 4}]]] op[f1[a] f3[c]] op[f2[b] f4[d]] All of the above methods use rules. Is it possible to do it with ReplacePart? I don't think so, but maybe somebody knows how to do it. How about using MapAt? I don't think that works either in regular Mathematica. Ted Ersek and I did a package, Algebra`ExpressionManipulation` at my web site, that implements extended positions. An extended position gives the position of an expression and a list of the desired subparts and is packaged in a header eP. So the extended position of a + c in f[a + b + c + d] is eP[{1},{1,3}]. The package modifies MapAt to accept extended positions. Then we can use... MapAt[op, expr, {eP[{}, {1, 3}], eP[{}, {2, 4}]}] op[f1[a] f3[c]] op[f2[b] f4[d]] However, I don't always like to drag in the package just to do that. I think that operating on selected level parts of a subexpression is not all that uncommon. Here is another example. 1 - Cos[x]^2 % // TrigFactor 1 - Cos[x]^2 Sin[x]^2 But... 1 - a - Cos[x]^2 % // TrigFactor 1 - a - Cos[x]^2 (1/2)*(1 - 2*a - Cos[2*x]) I was hoping for -a + Sin[x]^2. What are the best methods for handling this kind of problem in regular Mathematica? ==== and from kde2 to kde3 my Mathematica 3.0 doesn't work as usual any more: All the characters have become little rectangles, I can't read even the error message at the beginning. I followed the wolfram support page How do I resolve certain font-related error message when very carefully, but the error remains. ==== I look for an operator, which has a higher precedence than @ and can be oberloaded with a new definition. According to the table in A.2, only PatternTest (?) could be a candidate. But according to my tests, PartitionTest cannot be overloaded with an new definition. What is your opinion? Hermann Schmitt ==== I have been trying to get emmathfnt to work for the past few hours but whatever I do the output file is slightly smaller than the input so I guess it isn't working and emmathfnt cannot find the font files. I also set FONTDIR. I am using the dos command emmathfnt -d C:Progra~1Wolfra~1Mathem~14.2System~1FontsType1 -o c:output.eps c:input.eps and the following is output C:WINDOWS>dir c:*put.eps Volume in drive C has no label Volume Serial Number is 0508-1ED9 Directory of C: OUTPUT EPS 26,324 08-30-02 9:57a output.eps INPUT EPS 26,324 08-30-02 10:21a input.eps 2 file(s) 52,648 bytes 0 dir(s) 4,896.69 MB free and if i run dir C:Progra~1Wolfra~1Mathem~14.2System~1FontsType1 I see the font files OK. input.eps was produced using the following Mathematica gr = Plot[Sin[[Alpha]], {[Alpha], -[Pi], [Pi]}, AxesLabel -> {[Alpha], Sin([Alpha])}] Export[c:input.eps, gr, EPS] both input and output set to StandardForm I wonder what I am doing wrong. C:WINDOWS>SET TMP=C:WINDOWSTEMP TEMP=C:WINDOWSTEMP PROMPT=$p$g winbootdir=C:WINDOWS COMSPEC=C:WINDOWSCOMMAND.COM PATH=C:DOWNLOADFONTZEMMATH~1;C:UTILSGHOSTGHOSTGUMGSVIEW;C:TE XMFMIKTEXB IN;C:WINDOWS;C:WINDOWSCOMMAND;C:MATLAB_SV12BINWIN32 FONTDIR=C:Program FilesWolfram ResearchMathematica4.2SystemFilesFontsType 1 windir=C:WINDOWS BLASTER=A220 I5 D3 T4 CMDLINE=emmathfnt -d C:Progra~1Wolfra~1Mathem~14.2System~1FontsType1 -o c:output.eps c:input.eps thankyou ==== > I would expect that Plot[Sin[x]/Sin[x], {x, -2.5, -1.5}] would produce a horizontal line at y=1. However, on my Windows XP computer it produces a graph where the y value is > less than 1 at several points. Most notibly between x=-1.6 and x=-1.8 Is this just an isolated case? Or does it happen to others? If so - why? > 4.1 for Mac OS X (November 5, 2001) p = Plot[Sin[x]/Sin[x],{x,-2.5,-1.5}]; Note that the Ticks on the y-axis are all 1, that is, in trying to find something of interest the adaptive range has zoomed in and is looking at the machine precision representations of 1. (First /@(Ticks /. AbsoluteOptions[p])[[2]])//InputForm Zoom out using the PlotRange Plot[Sin[x]/Sin[x],{x,-2.5,-1.5}, PlotRange->{-0.1,2.1}]; Or as stated in the on-line help for Plot: You should use Evaluate to evaluate the function to be plotted if this can safely be done before specific numerical values are supplied. Plot[Evaluate[Sin[x]/Sin[x]],{x,-2.5,-1.5}]; ==== I am trying to implement the inner product in the space of complex-valued, square integrable functions over [-1/2,1/2], which can be expressed in Mathematica code as inner[f_Function,g_function]:=Integrate[Conjugate[f[x]]*g[x],{x,-1/2,1/2}] This is simple enough. Problem is, Mathematica seamingly cannot evaluate the Integral for even the simplest of functions: In[10]:=inner[#&,#&] Out[10]:=!([Integral]_(-(1/2))%(1/2)(x Conjugate[ x]) [DifferentialD]x) As you see, the Integrate returns unevaluated. It works fine if I remove the Conjugate. Unfortunately the Conjugate is needed for positive definiteness. Various variants with Composition, Re and Im etc. don't work either. This should be a So how do I get Integrate to work with Conjugate? I am trying to implement the inner product in the space of > complex-valued, square integrable functions over [-1/2,1/2], which can > be expressed in Mathematica code as inner[f_Function,g_function]:=Integrate[Conjugate[f[x]]*g[x],{x,-1/2,1/2}] This is simple enough. Problem is, Mathematica seamingly cannot > evaluate the Integral for even the simplest of functions: > In[10]:=inner[#&,#&] Out[10]:=!([Integral]_(-(1/2))%(1/2)(x Conjugate[ > x]) [DifferentialD]x) > Conjugate does not evaluate the expression, if the variables aren't known to be real. Your example (inner[#&,#&]) works if you define your function using ComplexExpand: inner[f_,g_]:=Integrate[ComplexExpand[Conjugate[f[x]]]g[x], ...] You may also use a home-made Conjugate, I'll call it Konjugiert, eg: ruKonjugiert={Complex[re_,im_]:>Complex[re,-im]}; Konjugiert[ausdr__]:=ausdr /. ruKonjugiert; Replacing Conjugate with Konjugiert in your Definition works for your simple Example, but more komplex functions will need a ComplexExpand to get the wanted real result. here...). I am sending it pretty much in the same way as last time, with cc to mathgroup@smc.vnet.net (only this time with the intent that it not appear there). Daniel ------------------------------------------- > NDSolve seems to have difficulties with solving integral equation. n = 5; NDSolve[{D[[Sigma]norm[z, t], t] == 3*z*Integrate[[Sigma]norm[z, > t]^n*z, {z, 0, 1}] - [Sigma]norm[z, t]^n, > [Sigma]norm[z, 0] == 1.5*z, [Sigma]norm[0, t] == 0}*[Sigma]norm[z, > t], {z, 0.01, 1}, {t, 0.01, 2}] Mathematica returns a message NDSolve::deql: The first argument must have both an equation and an > initial condition. which I cannot understand. > Can anybody tell what's wrong with my attempt? -Toshi I'll show a couple of approaches to this sort of problem. The first is to iteratively solve for sn[k][z,t] in terms of sn[k-1][z,t], with sn[0][z,t] initialized to something appropriate (I used 3/2*z). The sn's are computed as interpolating functions based on results from solving ODEs in t for many fixed values of z. The code below does this for n=2. The plots at first appear to flip between two states but eventually stabilize. Note that this takes many minutes to run to completion. n = 2; sn[0][z_,t_] := 3/2*z; Do [ Do [ sn[k][z,t_] = sn[k][z,t] /. First[NDSolve[{D[sn[k][z,t], t] == 3*z*NIntegrate[sn[k-1][w,t]^n*w, {w,0,1}] - sn[k-1][z,t]^n, sn[k][z,0] == 3/2*z}, sn[k][z,t], {t,0,2}]], {z,0,1,1/100} ]; snew = Interpolation[Flatten[Table[{z,t,sn[k][z,t]}, {z,0,1,1/100}, {t,0,2,1/100}], 1], InterpolationOrder->7]; sn[k] = snew; Print[iteration , k]; Plot3D[sn[k][z,t], {z,0,1}, {t,0,2}], {k, 1, 15} ] One can test for convergence as below; it is apparently quite good. NIntegrate[Abs[sn[15][z,t]-sn[14][z,t]], {z,0,1}, {t,0,2}] A drawback to this method is that it appears to break down beyond n = 2. Possibly one simply needs a much better starting function for sn[0], I'm not sure. Below is another method that Michael Trott showed me. We expand in a set of basis functions in z, set up a system of ODEs in t, and solve them. I tried this using monomials in z for basis functions and ran into some trouble with the ODE solving, so I will show Michael's attempt using trig functions for the basis. Note that we now handle the desired case n=5; another advantage is that this is alot faster than the method above, though still not exactly blinding in speed. Michael used the interval {0,2} for z so as to achieve pointwise (not just L^2) convergence; otherwise there would be a sharp drop-off just before z=1 as all the trigs vanish there. In other words, the basis functions are of the form Sin[k/2*Pi] rather than Sin[k*Pi] for 1<=k<=deg. Cosines are excluded due to the vanishing condition at z=0. integrate[p_Plus, {z_, 0, 1}] := Integrate[#, {z, 0, 1}]& /@ p; integrate[p_, {z_, 0, 1}] := Integrate[p, {z, 0, 1}]; n = 5; deg = 6; vars[t_] = Map[#[t]&,Array[a,deg]]; zFuns = Sin[Range[deg] Pi/2 z]; sn[z_,t_] = vars[t].zFuns; eqs1 = 3*z*integrate[Expand[sn[w,t]^n*w],{w,0,1}] - sn[z,t]^n - D[sn[z,t],t]; eqs2 = integrate[Expand[eqs1 #], {z, 0, 1}]& /@ zFuns; iCs = integrate[Expand[(sn[z,0] - 3/2*z) #], {z, 0, 1}]& /@ zFuns; fulleqns = # == 0& /@ Join[eqs2, iCs]; nsd = NDSolve[fulleqns, vars[t], {t,0,2}, SolveDelayed->True]; Plot3D[Evaluate[sn[z,t] /. nsd[[1]]],{z,0,1},{t,0,2}]; an initializer for the iteration/interpolation method above in an attempt to refine the solution. Daniel Lichtblau Wolfram Research ==== > NDSolve seems to have difficulties with solving integral equation. n = 5; NDSolve[{D[[Sigma]norm[z, t], t] == 3*z*Integrate[[Sigma]norm[z, > t]^n*z, {z, 0, 1}] - [Sigma]norm[z, t]^n, > [Sigma]norm[z, 0] == 1.5*z, [Sigma]norm[0, t] == 0}*[Sigma]norm[z, > t], {z, 0.01, 1}, {t, 0.01, 2}] Mathematica returns a message NDSolve::deql: The first argument must have both an equation and an > initial condition. which I cannot understand. > Can anybody tell what's wrong with my attempt? -Toshi I'll show a couple of approaches to this sort of problem. The first is to iteratively solve for sn[k][z,t] in terms of sn[k-1][z,t], with sn[0][z,t] initialized to something appropriate (I used 3/2*z). The sn's are computed as interpolating functions based on results from solving ODEs in t for many fixed values of z. The code below does this for n=2. The plots at first appear to flip between two states but eventually stabilize. Note that this takes many minutes to run to completion. n = 2; sn[0][z_,t_] := 3/2*z; Do [ Do [ sn[k][z,t_] = sn[k][z,t] /. First[NDSolve[{D[sn[k][z,t], t] == 3*z*NIntegrate[sn[k-1][w,t]^n*w, {w,0,1}] - sn[k-1][z,t]^n, sn[k][z,0] == 3/2*z}, sn[k][z,t], {t,0,2}]], {z,0,1,1/100} ]; snew = Interpolation[Flatten[Table[{z,t,sn[k][z,t]}, {z,0,1,1/100}, {t,0,2,1/100}], 1], InterpolationOrder->7]; sn[k] = snew; Print[iteration , k]; Plot3D[sn[k][z,t], {z,0,1}, {t,0,2}], {k, 1, 15} ] One can test for convergence as below; it is apparently quite good. NIntegrate[Abs[sn[15][z,t]-sn[14][z,t]], {z,0,1}, {t,0,2}] A drawback to this method is that it appears to break down beyond n = 2. Possibly one simply needs a much better starting function for sn[0], I'm not sure. Below is another method that Michael Trott showed me. We expand in a set of basis functions in z, set up a system of ODEs in t, and solve them. I tried this using monomials in z for basis functions and ran into some trouble with the ODE solving, so I will show Michael's attempt using trig functions for the basis. Note that we now handle the desired case n=5; another advantage is that this is alot faster than the method above, though still not exactly blinding in speed. Michael used the interval {0,2} for z so as to achieve pointwise (not just L^2) convergence; otherwise there would be a sharp drop-off just before z=1 as all the trigs vanish there. In other words, the basis functions are of the form Sin[k/2*Pi] rather than Sin[k*Pi] for 1<=k<=deg. Cosines are excluded due to the vanishing condition at z=0. integrate[p_Plus, {z_, 0, 1}] := Integrate[#, {z, 0, 1}]& /@ p; integrate[p_, {z_, 0, 1}] := Integrate[p, {z, 0, 1}]; n = 5; deg = 6; vars[t_] = Map[#[t]&,Array[a,deg]]; zFuns = Sin[Range[deg] Pi/2 z]; sn[z_,t_] = vars[t].zFuns; eqs1 = 3*z*integrate[Expand[sn[w,t]^n*w],{w,0,1}] - sn[z,t]^n - D[sn[z,t],t]; eqs2 = integrate[Expand[eqs1 #], {z, 0, 1}]& /@ zFuns; iCs = integrate[Expand[(sn[z,0] - 3/2*z) #], {z, 0, 1}]& /@ zFuns; fulleqns = # == 0& /@ Join[eqs2, iCs]; nsd = NDSolve[fulleqns, vars[t], {t,0,2}, SolveDelayed->True]; Plot3D[Evaluate[sn[z,t] /. nsd[[1]]],{z,0,1},{t,0,2}]; an initializer for the iteration/interpolation method above in an attempt to refine the solution. Daniel Lichtblau Wolfram Research ==== On 8/23/02 at 12:25 AM, meshii@mech.fukui-u.ac.jp (Toshiyuki (Toshi) >NDSolve seems to have difficulties with solving integral equation. >n = 5; NDSolve[{D[[Sigma]norm[z, t], t] == >3*z*Integrate[[Sigma]norm[z, t]^n*z, {z, 0, 1}] - [Sigma]norm[z, >t]^n, [Sigma]norm[z, 0] == 1.5*z, [Sigma]norm[0, t] == >0}*[Sigma]norm[z, t], {z, 0.01, 1}, {t, 0.01, 2}] >Mathematica returns a message NDSolve::deql: The first argument must have both an equation and an > initial condition. A general solution to a differential equation includes a constant of integration. It isn't possible to arrive a numerical solution without providing sufficient information to determine this constant. Specifying the initial condition provides this information. Look at the examples using the help browser to see what NDSolve needs. ==== -----Original Message----- >a number of useful replies and thank all those who responded. >Today I have a >question that actually generated yesterday's question. I am using a new >subject heading to reflect the actual nature of the question. What is the best way in Mathematica to operate on some, but >not all, level >parts of an expression or subexpression? Suppose I have the following expression... expr = f1[a]f2[b]f3[c]f4[d]; and I want to do an operation, op, separately on f1[a]f3[c] >and f2[b]f4[d]. >The operation must be done on the given pairs and not on all >four factors at >once. One method is to use explicit exact substitution rules. expr /. f1[a]f3[c] :> op[f1[a]f3[c]] /. f2[b]f4[d] :> op[f2[b]f4[d]] >op[f1[a] f3[c]] op[f2[b] f4[d]] If a,b,c,d were long expressions, we might not want to type or >copy them in. >This raised my question of using named patterns. Wolf >pointed out >that each factor must be named to create a match with flat >expressions. So >we could use... expr /. (a : f1[_])(b : f3[_])(c : f2[_])(d : f4[_]) :> op[a b]op[c d] >op[f1[a] f3[c]] op[f2[b] f4[d]] Andrzej Kozlowski suggested a method using Take, but using >Part works better >here, so we could use... expr /. a_ :> op[a[[{1, 3}]]]*op[a[[{2, 4}]]] >op[f1[a] f3[c]] op[f2[b] f4[d]] All of the above methods use rules. Is it possible to do it with >ReplacePart? I don't think so, but maybe somebody knows how to >do it. How >about using MapAt? I don't think that works either in regular >Mathematica. >Ted Ersek and I did a package, Algebra`ExpressionManipulation` >at my web >site, that implements extended positions. An extended position >gives the >position of an expression and a list of the desired subparts >and is packaged >in a header eP. So the extended position of a + c in >f[a + b + c + d] is eP[{1},{1,3}]. The package modifies MapAt to accept >extended positions. Then we can use... MapAt[op, expr, {eP[{}, {1, 3}], eP[{}, {2, 4}]}] >op[f1[a] f3[c]] op[f2[b] f4[d]] However, I don't always like to drag in the package just to do >that. I think >that operating on selected level parts of a subexpression is >not all that >uncommon. Here is another example. 1 - Cos[x]^2 >% // TrigFactor >1 - Cos[x]^2 >Sin[x]^2 But... 1 - a - Cos[x]^2 >% // TrigFactor >1 - a - Cos[x]^2 >(1/2)*(1 - 2*a - Cos[2*x]) I was hoping for -a + Sin[x]^2. What are the best methods for >handling this >kind of problem in regular Mathematica? it's possible that I miss something..., but look at In[6]:= 1 - a - Cos[x]^2 /. {1 - Cos[x_]^2 :> Sin[x]^2} Out[6]= -a + Sin[x]^2 I don't know what TrigFactor is doing exactly (or intended to do), its answer might well be consistent with that. if... In[7]:= expr = f1[a]f2[b]f3[c]f4[d] ...whats wrong with.. In[8]:= op[#[[{1, 3}]]]op[#[[{2, 4}]]]Take[expr, {5, -1}] &[expr] Out[8]= op[f1[a] f3[c]] op[f2[b] f4[d]] ...? The problem with this of course is, that you must know the Sequence of the elements of the expression in advance (at programming time). The following needs not, uses extract and rebuilds the expression (it is assumed the f are at level {1}, this must be checked, not well done here, just to pass the idea): In[7]:= betteropat[ee : head_[__], {e1_, e3_}, {e2_, e4_}, op_] /; (len = Length[ee]) >= 4 := Module[{pos13 = Position[ee, e1[___] | e3[___], {1}], pos24 = Position[ee, e2[___] | e4[___], {1}], posr}, posr = List /@ Complement[Range[len], Flatten[{pos13, pos24}]]; head @@ Join[{op[head @@ Extract[ee, pos13]]}, {op[ head @@ Extract[ee, pos24]]}, Extract[ee, posr]] ] In[8]:= betteropat[expr, {f1, f3}, {f2, f4}, ox] Out[8]= ox[f1[a] f3[c]] ox[f2[b] f4[d]] In[9]:= betteropat[[Alpha] f1[a]f4[b][Beta] f2[c]f3[d], {f1, f3}, {f2, f4}, ox] Out[9]= [Alpha] [Beta] ox[f1[a] f3[d]] ox[f2[c] f4[b]] If you don't need all of this functionality, just reduce. ___________________ Addendum: Here two other solutions, one using Part, the other ReplacePart + Replace: is not possible, since you _must_ reorder your data, not applying a function at parts of it). Here now another, simpler opat version (using Part, instead of Extract): In[19]:= mapopat[ee : head_[__], {e1_, e3_}, {e2_, e4_}, op_] /; (len = Length[ee]) >= 4 := Block[{pos13 = Flatten[Position[ee, e1[___] | e3[___], {1}]], pos24 = Flatten[Position[ee, e2[___] | e4[___], {1}]], posr}, posr = Complement[Range[len], pos13, pos24]; head[op[ee[[pos13]]], op[ee[[pos24]]], ee[[posr]]] ] Of course this all is most senseful only for heads with Flat attribute. In[20]:= mapopat[expr, {f4, f2}, {f1, f3}, ox] Out[20]= ox[f1[a] f3[c]] ox[f2[b] f4[d]] In[23]:= mapopat[[Alpha] f1[a]f4[b][Beta] f2[c]f3[d], {f1, f3}, {f2, f4}, ox] Out[23]= [Alpha] [Beta] ox[f1[a] f3[d]] ox[f2[c] f4[b]] In[22]:= mapopat[h[f1[a], f4[b], f2[c], f3[d]], {f1, f3}, {f2, f4}, ox] Out[22]= h[ox[h[f1[a], f3[d]]], ox[h[f4[b], f2[c]]], h[]] finally another version using ReplacePart; not all ReplacePart though, but in that spirit: In[99]:= expr = f1[a]f2[b]f3[c]f4[d] In[100]:= rplopat[ee : head_[__], {e1_, e3_}, {e2_, e4_}, op_] /; (len = Length[ee]) >= 4 := Block[{head}, Module[{ pos = Join @@ (Position[ee, #, {1}] &) /@ Through[{e1, e3, e2, e4}[___]], posr, allpos = List /@ Range[len], rr}, posr = Complement[allpos, pos]; rr = ReplacePart[ee, ee, allpos, Join[pos, posr]]; Replace[rr, head[a_, b_, c_, d_, r___] :> head[op[head[a, b]], op[head[c, d]], head[r]]] ]] Blocking head prevents reordering (of rr) in case head has the Orderless attribute. In[101]:= rplopat[expr, {f4, f2}, {f1, f3}, ox] Out[101]= ox[f1[a] f3[c]] ox[f2[b] f4[d]] In[103]:= rplopat[[Alpha] f1[a]f4[b][Beta] f2[c]f3[d], {f1, f3}, {f2, f4}, ox] Out[103]= [Alpha] [Beta] ox[f1[a] f3[d]] ox[f2[c] f4[b]] In[104]:= rplopat[h[f1[a], f4[b], f2[c], f3[d]], {f1, f3}, {f2, f4}, ox] Out[104]= h[ox[h[f1[a], f3[d]]], ox[h[f2[c], f4[b]]], h[]] -- ==== I need FrameLabels of the kind of H^s_z / H^p_Z and tried something >like FrameLabel->{FontForm{HSuperscript[s]Subscript[z] ...}} but s is too far away from z. How can I manage it that s is >directly above z ? Are there some backspace-characters to be used? Harry Subsuperscript[H, s, z] -Dale ==== >I would expect that Plot[Sin[x]/Sin[x], {x, -2.5, -1.5}] would produce a horizontal line at y=1. However, on my Windows XP computer it produces a graph where the y value is >less than 1 at several points. Most notibly between x=-1.6 and x=-1.8 Is this just an isolated case? Or does it happen to others? If so - why? Ken. The y axis has a very narrow range. The differences are very small. To see that, you can pull out the tick marks. In[13]:= yticks=FullOptions[gr,Ticks][[2]] In[15]:= InputForm[First/@yticks] Out[15]//InputForm= {0.9999999999999981, 0.9999999999999991, 1., 1.000000000000001, 1.000000000000002, 0.9999999999999983, 0.9999999999999986, 0.9999999999999987, 0.9999999999999989, 0.9999999999999993, 0.9999999999999996, 0.9999999999999997, 0.9999999999999999, 1.0000000000000002, 1.0000000000000004, 1.0000000000000007, 1.0000000000000009, 1.0000000000000013, 1.0000000000000016, 1.0000000000000018, 1.000000000000002, 0.9999999999999979, 0.9999999999999977, 1.0000000000000022} The ragged shape is caused by roundoff error, if you increase the PlotRange of the y-axis you see what you expect. gr = Plot[Sin[x]/Sin[x], {x, -2.5, -1.5}, PlotRange -> {0, 2}] ==== You could try something like this... Plot[x, {x, 0, 1}, Frame -> True, FrameLabel -> {z, DisplayForm[ StyleBox[ RowBox[{SubsuperscriptBox[H, z, s], /, SubsuperscriptBox[H, z, p]}], FontSize -> 16]]}, ImageSize -> 500]; where I enlarged the font size to make the label more legible. FontForm is an obsolete function and probably shouldn't be used. ==== Lucas, An addendum to my previous post (by the way, did you try to change precedences as I recommended?). If you are interested in using something like the normal summation notation, the summation symbol can't be CirclePlus, as CirclePlus is not an extensible character. I don't know all of the extensible characters, but one possibility is [UnionPlus], which looks a bit like CirclePlus, with an opening on top. Of course, the usual syntax for [UnionPlus] is as a binary operator, and this is not what we want for our summation notation. So, we need to incorporate new syntactical rules. There are three rules needed here. A rule to convert 2 dimensional input into a mathematica internal expression, a rule to convert the internal expression into a box structure, and a rule to convert the internal expression into a regular CirclePlus expression. I give these three rules below: Clear[MakeExpression] MakeExpression[ RowBox[{UnderoverscriptBox[[UnionPlus],RowBox[{i_,=,k_}],n_],y_}], StandardForm]:= MakeExpression[RowBox[{BigCirclePlus[,y,,{,i,,,k,,,n,}]} ],Standard Form] Clear[MakeBoxes] MakeBoxes[BigCirclePlus[y_, {i_, k_, n_}], f_] := RowBox[{UnderoverscriptBox[[UnionPlus], RowBox[{MakeBoxes[i, f], =, MakeBoxes[k, f]}], MakeBoxes[n, f]], MakeBoxes[y, f]}] BigCirclePlus[y_, {i_, k_Integer, n_Integer}] := CirclePlus @@ Table[y, {i, k, n}] As you can see, BigCirclePlus is used in the Mathematica internal representation. If BigCirclePlus can be converted into a CirclePlus expression (when the summation indices are integers), then the BigCirclePlus rule acts. Here are a couple of examples: !(([UnionPlus]+(i = 1)%M g[i])) !(([UnionPlus]+(i = 1)%5 g[i]/(1 + h[i]/5))) Just copy each of the above expressions into Mathematica and evaluate after evaluating the above rules. Of course, if [UnionPlus] is not an acceptable substitute for an extensible CirclePlus, then you will just need to petition Mathematica to include such a feature in the future. Carl Woll Physics Dept U of Washington ----- Original Message ----- Open up the file, search for CirclePlus, change the precedence from 450 to > 420, and then save. Of course, it would be wise to make a backup copy of the > file before you make any changes. Also, 420 is low enough to get the > behavior you desire, but you may want to experiment with other precedences. > Then, start mathematica and you will get the behavior you want. Carl Woll > Physics Dept > U of Washington > I'm attempting to implement an abstract mathematica package in > mathematica that utilized the [CirclePlus] operator in an unusual > way. Specifically, the [CirclePlus] has a precidence lower than + > and introduces barriers in the computation. So, an expression such as > a + b [CirclePlus] c + d --> (a+b) [CirclePlus] (c+d) > The mathematica ouput of > a + d + (b [CirclePlus] c) is incorrect. I've tried playing with the > PrecedenceForm[] function, but that does not seem able to produce the > desired effect. > Also, I would like to introduce a notation like > N > [BigCirclePlus] x[[i]] --> x[[1]] [CirclePlus] x[[2]] [CirclePlus] > .... > i=0 > analagous to summation, but mathematica does not appear to offer the > CirclePlus in a large format. to relate this to the case above, x[1] > = (a + b) and > x[2] = (c + d), so each indexed element is a subexpression. > Finally, I would like to be able to set up the CirclePlus operator > such that the following algebraic relations hold: > > Sum BigCirclePlus E = BigCirclePlus Sum E > i j ij j i ij > d d > -- BigCirclePlus E = BigCirclePlus -- E > dx j j j dx j > > -Lucas Scharenbroich > -MLS Group / JPL > ==== I plot several curve depending on a parameter p and I want the PlotLabel to show the value of p. What is wrong with the following ? pl[p_]:=Plot[Sin[x^p],{x,0,Pi},PlotLabel[Rule] p = p, DisplayFunction[Rule]Identity] Table[Show[pl[k],DisplayFunction[Rule]$DisplayFunction],{k,3}] ==== What is your operating system? How much memory do you have in your machine? Also, how big is your pagefile? Sounds to me like the rebuild ran out of room to do its thing in. I just installed Mathematica 4.2, and had no problem rebuilding the help index. Subsequently, I ahd no problem using the Help browser either. Hope that helps! ....Terry >I'd start with the following FAQ. > >http://support.wolfram.com/mathematica/interface/helpbrowser/howrebuildindex .html Sorry that i failed say it immediately in a first place, but of course > i did try it FAQ at first, and both tried to delete cache and rebuild > index, but results where the same - whenever i try to invoke help > browser (or rebuild index, for that matter), mathematica stops > responding (i did read your answer to the same question asked > a week ago before - actually that is why i turned to the FAQ). ==== I too have been unable to get the help browser functioning. I have exactly the same problem. When trying to open the help browser it gets to the point where it says scanning index file and freezes. I tried all the suggestions in the faq and the links provided here to no avail. I'm running Winows 2000 with service pack 3. I have 512mb of memory with a 768mb pagefile on a separate drive, so I don't think that's an issue. Mathematica 4.1 ran just fine on this setup, so judging by the number of other people affected by this, I'd say it's some kind of bug with 4.2. Hopefully Wolfram will address this with either a link that will provide a fix that actually works, or a patch. >What is your operating system? How much memory do you have in your machine? >Also, how big is your pagefile? Sounds to me like the rebuild ran out >of room to do its thing in. I just installed Mathematica 4.2, and had no problem rebuilding the help index. >Subsequently, I ahd no problem using the Help browser either. >Hope that helps! >....Terry >>I'd start with the following FAQ. >> >http://support.wolfram.com/mathematica/interface/helpbrowser/howrebuildindex .html > >> Sorry that i failed say it immediately in a first place, but of course >> i did try it FAQ at first, and both tried to delete cache and rebuild >> index, but results where the same - whenever i try to invoke help >> browser (or rebuild index, for that matter), mathematica stops >> responding (i did read your answer to the same question asked >> a week ago before - actually that is why i turned to the FAQ). > ==== >What is your operating system? How much memory do you have in your machine? >Also, how big is your pagefile? Sounds to me like the rebuild ran out >of room to do its thing in. I use W2k Pro + SP2, Athlon 1.33, 260MB RAM (DDR) + 630MB swap file - doesn't seems to me like a memory problem... ==== does anyone know whether there is an effective way of simulating paths of Brownian motion (Wiener process) in dimensions 1, 2, 3? I could you a random walk approach, but this seems to be computationally not very efficient and I am not sure whether it is even a good approximation to the 3-D BM. Any help on Mathematica coding and in the forms of algorithms will be greatly appreciated. Janusz Kawczak. ==== What is the problem with this integration. Its keep on running and not coming out. [CapitalPsi][r_, [Theta]_, [Phi]_][4] := r Exp[-r/2]Sin[[Theta]]Cos[[Phi]]; [CapitalPsi][r_, [Theta]_, [Phi]_][11] := r^2 Exp[-r/2]Sin[[Theta]]Cos[[Theta]]Cos[[Phi]]; [ScriptCapitalH][ r_, [Theta]_, [Phi]_] := (-[HBar]/ 2 m (1/(r^2 Sin[[Theta]]))(Sin[[Theta]]D[r^2 D[#, r], r] + D[Sin[[Theta]] D[#, [Theta]], [Theta]] + 1/(Sin[[Theta]])(D[D[#, [Phi]], [Phi]])) + e V &)«_b ho = Sum[ Sum[ Integrate[[CapitalPsi][r, [Theta], [Phi]][ j]([ScriptCapitalH][r, [Theta], [Phi]])[[CapitalPsi][ r, [Theta], [Phi]][i]], {r, 0, h}, {[Theta], 0, Pi}, {[Phi], 0, 2 Pi}], {i, 11, 11}], {j, 4, 4}] Raj Kumar Gupta ==== I know its not a good idea to run programs as root on a Unix machine and don't normally do so. However, can anyone tell me what is happening here? A mathematical program 'Mathematica' has been installed in /usr/local on this Sun Ultra 60. The correct password was entered and it all runs fine with my normal login (davek), which has a shell of /bin/tcsh. If I switch user to root, which has the normal /sbin/sh shell, Mathematica runs fine. However, if I switch user to 'roottcsh', which as a uid of 0, but a shell of /bin/tcsh, Mathematica fails to run, saying the password file is invalid. I can't understand while executing a program that works fine as root, fine as a normal user, yet does not when run when execution is attempted as another user with root privileges. *** Runs fine as a formal user 'davek'****** wren /export/home/davek % math Mathematica 4.0 for Solaris Copyright 1988-1999 Wolfram Research, Inc. -- Motif graphics initialized -- In[1]:= Quit ***Mathematica is run from /usr/local/bin/math, which is a symbolic link**** wren /export/home/davek % which math /usr/local/bin/math wren /export/home/davek % ls -l /usr/local/bin/math lrwxrwxrwx 1 root other 53 Jun 16 08:18 /usr/local/bin/math -> /usr/local/mathematica-4.0.2/Executables/Solaris/math ***Mathematica runs fine as root**** wren /export/home/davek % su Password: # /usr/local/bin/math Mathematica 4.0 for Solaris Copyright 1988-1999 Wolfram Research, Inc. -- Motif graphics initialized -- In[1]:= Quit ***Switch to a user with uid=0, shell =/bin/tcsh *** wren /export/home/davek % su - roottcsh Password: Sun Microsystems Inc. SunOS 5.9 Generic May 2002 ***Now Mathematica does not run*** wren / # /usr/local/bin/math Mathematica 4.0 for Solaris Copyright 1988-1999 Wolfram Research, Inc. /usr/local/mathematica-4.0.2/Configuration/Licensing/mathpass:1: Incomplete password entry. No valid single-machine password entry for Mathematica found. Machine name: wren MathID: [deleted by moderator] You will need a valid license ID and password in order to proceed. Go to http://register.wolfram.com or consult your Getting Started documentation. Enter the name of your organization: ***Here are the contents of the password files**** ***with the contents of /etc/shadow changed for security resons*** wren / # cat /etc/passwd | grep root root:x:0:1:Super-User:/:/sbin/sh roottcsh:x:0:1:Dr. David Kirkby:/:/bin/tcsh wren / # cat /etc/shadow | grep root root:TA9addfsfsdsdfdddMTxHU:11266:::::: roottcsh:dgddsdfsdffsdnSw:11198:::::: ==== I managed to post this on alt.math.recreational by mistake, and confuse everyone! I am having a bit of trouble with showing the shapes of pentominoes. The list of pentominoes is 12 x 5 x 2, for 12 pentominoes x 5 squares x {X,Y} coordinate of the square on a zero-origin basis. Just for completeness ... pentominoes = { {{0, 0}, {1, 0}, {1, 1}, {1, 2}, {2, 1}}, (*F*) {{0, 0}, {1, 0}, {2, 0}, {3, 0}, {4, 0}}, (*I*) {{0, 0}, {1, 0}, {2, 0}, {3, 0}, {0, 1}}, (*L*) {{0, 0}, {1, 0}, {2, 0}, {2, 1}, {3, 1}}, (*N*) {{0, 0}, {1, 0}, {2, 0}, {0, 1}, {1, 1}}, (*P*) {{0, 0}, {1, 0}, {2, 0}, {1, 1}, {1, 2}}, (*T*) {{0, 0}, {1, 0}, {2, 0}, {0, 1}, {2, 1}}, (*U*) {{0, 0}, {1, 0}, {2, 0}, {0, 1}, {0, 2}}, (*V*) {{0, 0}, {1, 0}, {1, 1}, {2, 1}, {2, 2}}, (*W*) {{1, 0}, {0, 1}, {1, 1}, {2, 1}, {1, 2}}, (*X*) {{0, 0}, {1, 0}, {2, 0}, {3, 0}, {1, 1}}, (*Y*) {{0, 0}, {1, 0}, {1, 1}, {1, 2}, {2, 2}} (*Z*) } When I display them with the code below, the aspect ratio is correct *within each pentomino* but they are not scaled equivalently. I would appreciate a pointer to what I have done wrong. The only solution I have been able to develop so far effectively places each of the 12 pentominoes at a different location in the plane, and then draws the whole region in one go. Show[ GraphicsArray[ Partition[ Table[ Graphics[ Map[Rectangle[#, (# + {1, 1})] &, pentominoes[[i]]], AspectRatio -> Automatic ], {i, 12}], 6] ] ] -- Mark R. Diamond ==== > I plot several curve depending on a parameter p and I want the PlotLabel to > show the value of p. > What is wrong with the following ? pl[p_]:=Plot[Sin[x^p],{x,0,Pi},PlotLabel[Rule] p = p, > DisplayFunction[Rule]Identity] Table[Show[pl[k],DisplayFunction[Rule]$DisplayFunction],{k,3}] > Use ToString and StringJoin pl[p_]:=Plot[Sin[x^p],{x,0,Pi}, PlotLabel->p = <> ToString[p], DisplayFunction->Identity]; Alternatively, you could use StringForm pl[p_]:=Plot[Sin[x^p],{x,0,Pi}, PlotLabel->StringForm[p = `` , p], DisplayFunction->Identity]; ==== In a message dated 8/31/02 1:58:36 AM, berlusconi_pagliusi@fis.unical.it > I'd like to use Mathematica 4.0 to write a function having different > expressions in different domain's intervals. > Let's say: F[x_]= x^2 if 0 x+1 if x>=6 I know It's a stupid syntax problem, but I really do not know how/where to > search the solution on the Mathematica Book > Just for grins here are several methods: f1[x_/;x<=0] := 0 ; f1[x_/;0=6] := x+1; f2[x_] := x^2*UnitStep[x]+(x+1-x^2)*UnitStep[x-6]; f3[x_] := Which[ x<=0, 0, 0=6, x+1]; f4[x_] := If[0=6, x+1,0]]; f5[x_] := Switch[x, _?(#<=0&), 0, _?(0<#<6&), x^2, _?(#>=6&), x+1 ] f6[x_?NumericQ] := {0,x^2,x+1}[[Position[ {x<=0,0=6}, True][[1,1]]]]; Needs[Calculus`Integration`]; (* needed for definition of Boole *) f7a[x_?NumericQ] := Evaluate[ (Boole /@ {0=6}). {x^2,x+1}]; Off[Part::pspec]; f7b[x_?NumericQ] := Evaluate[ {0,x^2,x+1}[[1+Tr[Boole /@ {x>0, x>=6}]]]]; f8[x_?NumericQ] := Cases[ {{x<=0, 0}, {0=6, x+1}}, {True, z_} :>z][[1]]; f9[x_?NumericQ] := DeleteCases[ {{x<=0, 0}, {0=6, x+1}}, {False, z_}][[1,2]]; f10[x_?NumericQ] := Select[ {{x<=0, 0}, {0=6, x+1}}, First[#]&][[1,2]]; f11[x_?NumericQ] := Last[Sort[ {{x<=0, 0}, {0=6, x+1}}]][[2]]; f12[x_?NumericQ] := Module[{n=1}, While[{x<6,x<0, False}[[n]], n++]; {x+1,x^2,0}[[n]]]; Generating some test points: ts = {Random[Real,{-5,0}],0, Random[Real,{0,6}],6,Random[Real,{6,15}]}; Checking the different representations Equal[(# /@ pts)& /@ {f1,f2,f3,f4,f5,f6,f7a,f7b,f8,f9,f10,f11,f12}] True To pick a favorite, look at how the different definitions behave. Of the definitions that evaluate with symbolic input, only f2 and f4 simplify with assumptions . For example, FullSimplify[#[x]& /@ {f2,f4}, 1 I am trying to implement the inner product in the space of > complex-valued, square integrable functions over [-1/2,1/2], which can > be expressed in Mathematica code as inner[f_Function,g_function]:=Integrate[Conjugate[f[x]]*g[x],{x,-1/2,1/2}] This is simple enough. Problem is, Mathematica seamingly cannot > evaluate the Integral for even the simplest of functions: > In[10]:=inner[#&,#&] Out[10]:=!([Integral]_(-(1/2))%(1/2)(x Conjugate[ > x]) [DifferentialD]x) As you see, the Integrate returns unevaluated. It works fine if I > remove the Conjugate. Unfortunately the Conjugate is needed for > positive definiteness. Various variants with Composition, Re and Im etc. don't work either. This should be a So how do I get Integrate to work with Conjugate? Would including Simplify or FullSimplify provide the results that youn want? inner[f_Function,g_Function]:= Integrate[Simplify[Conjugate[f[x]]*g[x], Element[x, Reals]], {x, -1/2, 1/2}]; inner[#&,#&] 1/12 ==== I was wondering if there are any scripts/functions out there to allow me to do decision tree classification with Mathematica, similar to S+ type analysis? --j -- Jonathan Greenberg Graduate Group in Ecology, U.C. Davis http://www.cstars.ucdavis.edu/~jongreen http://www.cstars.ucdavis.edu AIM: jgrn307 or jgrn3007 MSN: jgrn307@msn.com or jgrn3007@msn.com ==== PasKo, You could look up piecewise functions in the Master Index in Help. Unfortunately, the book does not have a unified discussion of methods for defining piecewise functions. The first method is to use a set of conditional definitions. For completeness I made f[x] = 0 if one of the conditional definitions is not met. f[x_] /; 0 < x < 6 := x^2 f[x_] /; x >= 6 := x + 1 f[x_] := 0 Plot[f[x], {x, 0, 10}]; The second method is to use a Which statement. Clear[f]; f[x_] := Which[ 0 < x < 6, x^2, x >= 6, x + 1, True, 0] Plot[f[x], {x, 0, 10}]; The above methods are fine in many cases, but if you want to perform functions on f, such as differentiation or integration, you should use the UnitStep function. So our third method is... Clear[f] f[x_] := x^2(UnitStep[x] - UnitStep[x - 6]) + (x + 1)UnitStep[x - 6] Plot[f'[x], {x, 0, 10}]; Plot[Integrate[f[y], {y, 0, x}] // Evaluate, {x, 0, 10}]; ==== > I am trying to implement the inner product in the space of > complex-valued, square integrable functions over [-1/2,1/2], which can > be expressed in Mathematica code as inner[f_Function,g_function]:=Integrate[Conjugate[f[x]]*g[x],{x,-1/2,1/2}] This is simple enough. Problem is, Mathematica seamingly cannot > evaluate the Integral for even the simplest of functions: > In[10]:=inner[#&,#&] Out[10]:=!([Integral]_(-(1/2))%(1/2)(x Conjugate[ > x]) [DifferentialD]x) As you see, the Integrate returns unevaluated. It works fine if I > remove the Conjugate. Unfortunately the Conjugate is needed for > positive definiteness. Various variants with Composition, Re and Im etc. don't work either. This should be a So how do I get Integrate to work with Conjugate? > Andreas -- > True Pleasure in this society is more dangerous than bank robbery. The deficiency has been addressed in our development version, at least to the extent that it works on the simple example given above. For a work-around in version 4 one might do as below. inner2[f_Function, g_Function] := Integrate[(Re[f[x]] - I*Im[f[x]])*g[x], {x, -1/2, 1/2}] In[2]:= inner2[# &, # &] 1 Out[2]= -- 12 Daniel Lichtblau Wolfram Research ==== Andreas, inner[f_Function, g_Function] := Integrate[ComplexExpand[Conjugate[f[x]]]*g[x], {x, -1/2, 1/2}] inner[# &, # &] 1/12 I'm not too knowledgable about using complex functions in Mathematica but sometimes I think that ComplexExpand should be renamed ComplexSimplify. One very often needs it. x]) [DifferentialD]x) As you see, the Integrate returns unevaluated. It works fine if I remove the Conjugate. Unfortunately the Conjugate is needed for positive definiteness. Various variants with Composition, Re and Im etc. don't work either. This should be a So how do I get Integrate to work with Conjugate? Andreas -- True Pleasure in this society is more dangerous than bank robbery. ==== I work for Gould Academy and am trying to make it really easy for the scripts which I thought did that really well. But, the science teachers said it was too hard. So, I have been making it so that Input boxes prompt the students for the filename type, regression type, etc. I now have been thinking that it would be great if there could be an Input box which asks the student what they want to name there graph, function, data, and have them simply call that variable when they want to use the graph, function, data. this is Instead of typing VariableName = FilePlot[] which the science teachers think is forcing the students to become mathematica programmers. Charles ==== Use Condition (/;): In[1]:= f[x_] := x^2 /; 0 < x < 6; f[x_] := x + 1 /; 6 <= x; Plot[f[x], {x, 0, 10}]; Avoid using capital initial letters for your definitions: they are usually reserved for in-built functions in Mathematica. ----- Original Message ----- > I know It's a stupid syntax problem, but I really do not know how/where to > search the solution on the Mathematica Book ==== try something like this: foo[x_] := Block[{y}, If[x > 0 && x < 6, y = x^2, If[x >= 6, y = x + 1]] ] for details look at: ?And ?If ?Block ----- Original Message ----- > I know It's a stupid syntax problem, but I really do not know how/where to > search the solution on the Mathematica Book > ==== You can use If, Which, Condition f[x_] := If[0 <= x && x <= 6, x^2, x + 1]; g[x_] := 2*x^2 /; 0 <= x <= 6; g[x_] := 2*x + 1 /; x > 6; h[x_] := Which[0 <= x <= 6, 3*x^2, 6 < x, 3*x + 1] Plot[{f[x], g[x], h[x]}, {x, 0, 10}] > I'd like to use Mathematica 4.0 to write a function having different > expressions in different domain's intervals. > Let's say: F[x_]= x^2 if 0 x+1 if x>=6 I know It's a stupid syntax problem, but I really do not know how/where to > search the solution on the Mathematica Book ******************* milkcart milkcart@m17.alpha-net.ne.jp *********************** ==== I'd like to use Mathematica 4.0 to write a function having different expressions in different domain's intervals. Let's say: F[x_]= x^2 if 0=6 I know It's a stupid syntax problem, but I really do not know how/where to search the solution on the Mathematica Book ==== > > I'd like to use Mathematica 4.0 to write a function having different > expressions in different domain's intervals. > Let's say: F[x_]= x^2 if 0 x+1 if x>=6 I'd like to thank everyone. :-) In the meantime I've found an answer to my problem using Which statement, but as far as you suggest I'm going to use the more versatile UnitStep function. . ==== One simple approach is to write: F[x_]:= x^2 /; 0=6 Hope this helps. You want want to look up /; in the Help Browser. Mark Westwood > I'd like to use Mathematica 4.0 to write a function having different > expressions in different domain's intervals. > Let's say: F[x_]= x^2 if 0 x+1 if x>=6 I know It's a stupid syntax problem, but I really do not know how/where to > search the solution on the Mathematica Book . ==== Try the following (I'm quoting from Tom Wickham-Jones' book on Mathematica Graphics, p. 41): In[1]:= pl[p_] := Plot[Sin[x^p], {x, 0, Pi}, PlotLabel -> StringForm[p = `1`, p], DisplayFunction -> Identity] In[12]:= Table[Show[pl[k], DisplayFunction -> $DisplayFunction], {k, 3}] ----- Original Message ----- Table[Show[pl[k],DisplayFunction[Rule]$DisplayFunction],{k,3}] ==== You should use SequenceForm in your definition (instead of multiplication which reorders the items) . pl[p_] := Plot[Sin[x^p], {x, 0, Pi}, PlotLabel -> SequenceForm[p = , p], DisplayFunction -> Identity] David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ ==== > I am trying to implement the inner product in the space of > complex-valued, square integrable functions over [-1/2,1/2], which can > be expressed in Mathematica code as inner[f_Function,g_function]:=Integrate[Conjugate[f[x]]*g[x],{x,-1/2,1/2}] > ... Mathematica cannot Integrate through Conjugate in general. I suspect, however, that most or all specific cases where you cannot expand Conjugate are not integrable in closed form anyway. So I suggest that you attempt to expand the Conjugate before integrating: inner[f_Function, g_Function] := Integrate[ComplexExpand[f[x] Conjugate[g[x]]], {x, -1/2, 1/2}] Although the above function works for the few simple cases I tried just now, my experience tells me that the following, more cumbersome form might be more robust: inner[f_Function, g_Function] := Integrate[Simplify[ComplexExpand[ f[x] Conjugate[g[x]], TargetFunctions -> {Re, Im}]], {x, -1/2, 1/2}] Hope this helps, ==== > I'd like to use Mathematica 4.0 to write a function having different > expressions in different domain's intervals. > Let's say: F[x_]= x^2 if 0 x+1 if x>=6 I know It's a stupid syntax problem, but I really do not know how/where to > search the solution on the Mathematica Book > Several choices exist. An advantage of the following choice, F[x_] := If[ x<6, x^2, x+1 ] is that Mathematica can integrate and different this form analytically. Reply-To: Peltio ==== Sergio Milo ha scritto nel messaggio ... > Dear Math Group. > Anybody can explain me what this it means. > Out[22]=!(Null^49) It seems that Mathematica has produced 49 times in a row a Null result and interpreted it as a variable in a multiplication. As far as I know Mathematica shouldn't compute the powers of Null, though. And most importantly, it should not output a Null, at least in standard conditions. Could it be that you inadvertently redefined Null, after unprotecting it? (yes I know, it woldn't be much of an inadvertent behaviour...) Does this happen in a fresh new Mathematica session? ==== I am trying to figure out how I can do multi-dimensional kernel density estimation with Mathematica. I know how I can do it with one variable, but I was wondering if Mathematica supports kernel density estimation with 3 variables. ==== I liked this very much. For n=4 there are 3^n=81 possible combinations, but only 40 positive ones - the rest would be 0 and each of the positive ones multiplied by -1. As Bob stated, this is obtained by: (3^n-1)/2=40 For these 40 positive integers to match 1 to 40 correspondingly, the biggest should be 40 (also, the smallest should be 1). So we have: a+b+c+d=40 or 1+b+c+d=40 (we state that a I have a very interesting math problem:If I have a scales,and I > have 40 things that their mass range from 1~40 which each is a nature > number,and now I can only make 4 counterweights to measure out each > mass of those things.Question:What mass should the counterweights > be??? > The answer is that 1,3,9,27 and I wnat to use mathematica to solve > this problem. > In fact,I think that this physical problem has various > answer,ex.2,4,10,28 > this way also work,because if I have a thing which weight 3 , and I > can measure out by comparing 2<3<4 . But,If I want to solve this math > problem: > {x|x=k1*a+k2*b+k3*c+k4*d}={1,2,3,4,,,,,,40} where a,b,c,d is nature > numbers. > and {k1,k2,k3,k4}={1,0,-1} > How to solve it ?? > mathematica solving method. appreciate any idea sharing > sincerely > Just use brute force. Needs[DiscreteMath`Combinatorica`]; var = {a, b, c, d}; n = Length[var]; s = Outer[Times, var, {-1, 0, 1} ]; f = Flatten[Outer[Plus, Sequence@@s]]; Since the length of f is just 3^n then the range of numbers > to be covered should be {-(3^n-1)/2, (3^n-1)/2}. > Consequently, the largest of the weights can not exceed > (3^n-1)/2 - (1+2+...+(n-1)) or ((3^n-1) - n(n-1))/2 34 Thread[var->#]& /@ (First /@ Select[{var,f} /. Thread[var->#]& /@ KSubsets[Range[((3^n-1) - n(n-1))/2], n], Sort[#[[2]]] == Range[-(3^n-1)/2,(3^n-1)/2]&]) {{a -> 1, b -> 3, c -> 9, d -> 27}} ==== >I'm sorry for that my question is not clear,I have correct below. >> ajvp7h$ibk$1@smc.vnet.net>... > I have a very interesting math problem:If I have a scales,and I > have 40 things that their mass range from 1~40 which each is a nature > number,and now I can only make 4 counterweights to measure out each > mass of those things.Question:What mass should the counterweights > be??? > The answer is that 1,3,9,27 and I wnat to use mathematica to solve > this problem. > In fact,I think that this physical problem has various > answer,ex.2,4,10,28 > this way also work,because if I have a thing which weight 3 , and I > can measure out by comparing 2<3<4 . But,If I want to solve this math > problem: > {x|x=k1*a+k2*b+k3*c+k4*d}={1,2,3,4,,,,,,40} where a,b,c,d is nature >numbers. > and {k1,k2,k3,k4}={1,0,-1} > How to solve it ?? > mathematica solving method. appreciate any idea sharing >Just use brute force. Needs[DiscreteMath`Combinatorica`]; >var = {a, b, c, d}; n = Length[var]; >s = Outer[Times, var, {-1, 0, 1} ]; >f = Flatten[Outer[Plus, Sequence@@s]]; >Since the length of f is just 3^n then the range of numbers >to be covered should be {-(3^n-1)/2, (3^n-1)/2}. >Consequently, the largest of the weights can not exceed >(3^n-1)/2 - (1+2+...+(n-1)) or ((3^n-1) - n(n-1))/2 >34 >Thread[var->#]& /@ (First /@ Select[{var,f} /. Thread[var->#]& /@ KSubsets[Range[((3^n-1) - n(n-1))/2], n], Sort[#[[2]]] == Range[-(3^n-1)/2,(3^n-1)/2]&]) >{{a -> 1, b -> 3, c -> 9, d -> 27}} > A modification to my earlier response. Since you are try to cover all of the values up to (3^n-1)/2 then you can speed up the brute force method by requiring that a+b+c+d == (3^n-1)/2 Needs[DiscreteMath`Combinatorica`]; var = {a,b,c,d}; n = Length[var]; m = (3^n-1)/2; s = Outer[Times, var, {-1,0,1} ]; f = Flatten[Outer[Plus, Sequence@@s]]; k= Select[KSubsets[Range[m - n(n-1)/2], n], (Plus @@ #) == m&]; Thread[var->#]& /@ (First /@ Select[{var,f} /. Thread[var->#]& /@ k, Sort[#[[2]]] == Range[-m,m]&]) {{a -> 1, b -> 3, c -> 9, d -> 27}} ==== On 8/31/02 at 1:25 AM, berlusconi_pagliusi@fis.unical.it (Paskoski) > I'd like to use Mathematica 4.0 to write a function >having different expressions in different domain's intervals. Let's >say: F[x_]= x^2 if 0=6 Try f[x_]:= x^2 /; 0=6 The /; specfies a conditional rule. You can define a fuction with as many pieces as you like in this manner ==== help,urgent how do you put the numbers in the circles ==== There are many cases in graphics, and otherwise, where it is useful to obtain two orthogonal unit vectors to a given vector. I know a number of ways to do it, but they all seem to be slightly inelegant. I thought I would pose the problem to MathGroup. Who has the most elegant Mathematica routine... OrthogonalUnitVectors::usage = OrthogonalUnitVectors[v:{_,_,_}] will return two unit vectors orthogonal to each other and to v. You can assume that v is nonzero. ==== My 2 cents' worth: OrthogonalUnitVectors[v:{_, _, _}] := With[{u = Which[ (w = {0,v[[3]],-v[[2]]}).w != 0, w, (w = {v[[3]],0,-v[[1]]}).w != 0, w, (w = {v[[2]],-v[[1]],0}).w != 0, w ] }, #/Sqrt[#.#]& /@ {u, Cross[u,v]}] --- Selwyn Hollis > There are many cases in graphics, and otherwise, where it is useful to > obtain two orthogonal unit vectors to a given vector. I know a number of > ways to do it, but they all seem to be slightly inelegant. I thought I would > pose the problem to MathGroup. Who has the most elegant Mathematica > routine... OrthogonalUnitVectors::usage = OrthogonalUnitVectors[v:{_,_,_}] will return > two unit vectors orthogonal to each other and to v. You can assume that v is nonzero. David Park > djmp@earthlink.net > http://home.earthlink.net/~djmp/ ==== The following behavior seems to have gone undetected through several revisions of Mathematica: When a SeriesData object is multiplied by 0, Mathematica (versions 3.0, 4.02, 4.1 for Mac, and 4.0 for Windows) does not give 0. For example, 0*Series[f[x], {x,0,3}] gives O[x]^4, even though 0*x_SeriesData gives 0! Because of this, the following incorrect result is obtained in version 4: DiagonalMatrix[{a,b}].{{x^2 + O[x]^3, O[x]^2}, {O[x]^2, x^2 + O[x]^3}} gives {{O[x]^2, O[x]^2}, {O[x]^2, O[x]^2}} !! In this example version 3 gives the correct result, even though, a*(x^2 + O[x]^3) + 0*O[x]^2 gives O[x]^2 - same as in version 4. (Apparently, Dot in version 3 does not include in the sum terms multiplied by 0). The easiest way to correct this bug, without altering Times, is to use UpSet: Unprotect[SeriesData]; Times[0,x_SeriesData]^= 0; Protect[SeriesData]; (ignore the UpSet::write message) I wonder how many people have obtained incorrect results because of this bug... Sotirios Bonanos http://www.inp.demokritos.gr/~sbonano/SB.html ==== In[4]:= f[x_ /; 0 < x < 6] := x^2 In[5]:=f[x_/; x >= 6]:=x+1 -----Message d'origine----- Objet : How to ...? I'd like to use Mathematica 4.0 to write a function having different expressions in different domain's intervals. Let's say: F[x_]= x^2 if 0=6 I know It's a stupid syntax problem, but I really do not know how/where to search the solution on the Mathematica Book . ==== This works : pl[p_] := Plot[Sin[x^p], {x, 0, Pi}, DisplayFunction -> Identity] lab[p_] := Graphics[{Text[p = , {1.5, 1.2}], Text[p, {1.7, 1.2}]}] Table[Show[{pl[k], lab[k]}, DisplayFunction -> $DisplayFunction], {k, 3}] Meilleures salutations Florian Jaccard EICN-HES -----Message d'origine----- Envoy.8e : sam., 31. ao.9et 2002 07:26 Ë : mathgroup@smc.vnet.net Objet : PlotLabel I plot several curve depending on a parameter p and I want the PlotLabel to show the value of p. What is wrong with the following ? pl[p_]:=Plot[Sin[x^p],{x,0,Pi},PlotLabel[Rule] p = p, DisplayFunction[Rule]Identity] Table[Show[pl[k],DisplayFunction[Rule]$DisplayFunction],{k,3}] Here is my solution, using NullSpace: OrthogonalUnitVectors[v:{_,_,_}]:=(Needs[LinearAlgebra`Orthogonalization` ] ; Map[LinearAlgebra`Orthogonalization`Normalize, NullSpace[{v,{0,0,0},{0,0,0}}]]) One problem with any solution is that it should never be possible to obtain the two output vectors as continuous functions of the input vector, since that would be equivalent to the combing of a hedgehog in a vortexfree way. ==== Adding my two cents to: > There are many cases in graphics, and otherwise, where it is useful to > obtain two orthogonal unit vectors to a given vector. I know a number of > ways to do it, but they all seem to be slightly inelegant. I thought I would > pose the problem to MathGroup. Who has the most elegant Mathematica > routine... To this I would like to add a criterion of smoothness. Armed with a second vector b not parallel to the given vector a, it's a trivial matter to orthogonalize b WRT a by Gram-Schmidt and then form the third vector c = a x b. (Normalize as needed.) I don't need more elegance that this, but I would like a scheme to select the vector b that results in a triad {a,b,c} that various smoothly as a varies over all possible directions. Each of my attempts to date involve a branched algorithm and jumps in the resulting triad for certain small changes in a. ==== Just add a PlotRange option and that each pentomino will be plotted to the same scale. Show[ GraphicsArray[ Partition[ Table[ Graphics[ Map[Rectangle[#, (# + {1, 1})] &, pentominoes[[i]]], AspectRatio -> Automatic, PlotRange -> {{0, 5}, {0, 5}} ], {i, 12}], 6] ] ] {{0, 0}, {1, 0}, {2, 0}, {3, 0}, {4, 0}}, (*I*) {{0, 0}, {1, 0}, {2, 0}, {3, 0}, {0, 1}}, (*L*) {{0, 0}, {1, 0}, {2, 0}, {2, 1}, {3, 1}}, (*N*) {{0, 0}, {1, 0}, {2, 0}, {0, 1}, {1, 1}}, (*P*) {{0, 0}, {1, 0}, {2, 0}, {1, 1}, {1, 2}}, (*T*) {{0, 0}, {1, 0}, {2, 0}, {0, 1}, {2, 1}}, (*U*) {{0, 0}, {1, 0}, {2, 0}, {0, 1}, {0, 2}}, (*V*) {{0, 0}, {1, 0}, {1, 1}, {2, 1}, {2, 2}}, (*W*) {{1, 0}, {0, 1}, {1, 1}, {2, 1}, {1, 2}}, (*X*) {{0, 0}, {1, 0}, {2, 0}, {3, 0}, {1, 1}}, (*Y*) {{0, 0}, {1, 0}, {1, 1}, {1, 2}, {2, 2}} (*Z*) } When I display them with the code below, the aspect ratio is correct *within each pentomino* but they are not scaled equivalently. I would appreciate a pointer to what I have done wrong. The only solution I have been able to develop so far effectively places each of the 12 pentominoes at a different location in the plane, and then draws the whole region in one go. Show[ GraphicsArray[ Partition[ Table[ Graphics[ Map[Rectangle[#, (# + {1, 1})] &, pentominoes[[i]]], AspectRatio -> Automatic ], {i, 12}], 6] ] ] -- ==== Does anybody have Benchmarks for Mathematica 4.2 to share? If possible the same or similar machine and different OSes. to the Windows version. I tried http://www2.staff.fh-vorarlberg.ac.at/~ku/karl/timings40.html value of 6.4. ---more details-- Times = [InvisibleSpace]{1.18, 1.14, 1.08, 0.55, 1.18, 2.48, 0.74, 0.79, 0.41, 0.11, 0.38, 0.96, 0.97, 1.26, 1.11} Time = [InvisibleSpace]17. Benchmark = [InvisibleSpace]6.40784 ------------------------------------------------ I would like to see how Mathematica 4.2 improved in speed compared to Mathematica 4 or 3. Armin ==== Can I use Mathematica to find out the volumn of this 3 dimensional object from the equations : z=x^2 +4, y=4-x^2, y=3x Shz Shz ==== Use Text statements. Click of a coordinate point on the plot, copy it and paste it into the Text statement. Here is an example. Show[Graphics[ {Circle[{1, 1}, 2], Text[A, {1.75659, 2.03292}], Circle[{0, 0}, 2], Text[B, {-1.38818, -0.0197372}], Circle[{1, -1}, 2], Text[C, {1.57238, -1.99344}]}], AspectRatio -> Automatic, ImageSize -> 400]; To click off a coordinate: 1) Select the plot by putting the cursor in it and clicking. 2) Press and hold Ctrl. When you move the cursor you will obtain cross hairs. 3) Move the cursor to where you want to put the text and left click. 4) Right click and use Copy. (Or use Ctrl-C or the menu). 5) Paste the copied coordinate as the second argument in the Text statement. ==== On 8/31/02 at 1:25 AM, berlusconi_pagliusi@fis.unical.it (Paskoski) > I'd like to use Mathematica 4.0 to write a function >having different expressions in different domain's intervals. Let's >say: F[x_]= x^2 if 0=6 Try In[4]:= F[x_]:=Which[0=6,x+1] you can plot the function with In[5]:= Plot[F[x],{x,0,8}] Sincerely yours, Dr. Juan E. Fuentes Betancourt Facultad de Fisica Universidad de la Habana ==== I have spent an enormous amount of time (far too much) on this question. Indeed, I have just completed a program that handles all sorts of piecewise defined functions. I am in the process of writing it up to offer it to all of you. In my opinion the best, cleansest method is to invoke the UnitStep function as illustrated in David Park's solutions. To make everything cleaner, define a characteristic function Chi[x_,a_,b_] := UnitStep[x-a]-UnitStep[x-b] This function is continuous on the right, vanishes outside of [a,b) and is one in the half-open interval [a,b). Now your answer is x^2 Chi[x,0,6] + (x+1) Chi[x,6,Infinity] The integrator handles UnitSteps easily and smoothly. My program handles these cases easily and many more, including such oddities as Integrate[Abs[x],x] and (for amusement sake only) UnitStep[ Abs[x]-Sign[x]+3] Another virtue of this approach (also handled in my program) is the peculiar error messages and poor answers given by NIntegrate for simple piecewise continuous functions at jump discontinuites. The limit function also fails dismally on some examples where it really shouldn't I am rather naive about how to transmit programs to interested users, so if you would like a copy of my program and about 100 worked examples, I will be glad to send them to you IF YOU TELL ME HOW TO DO IT! Jack Goldberg > In a message dated 8/31/02 1:58:36 AM, berlusconi_pagliusi@fis.unical.it > I'd like to use Mathematica 4.0 to write a function having different > expressions in different domain's intervals. > Let's say: > F[x_]= x^2 if 0 x+1 if x>=6 > I know It's a stupid syntax problem, but I really do not know how/where to > search the solution on the Mathematica Book > > Just for grins here are several methods: f1[x_/;x<=0] := 0 ; f1[x_/;0=6] := x+1; > f2[x_] := x^2*UnitStep[x]+(x+1-x^2)*UnitStep[x-6]; > f3[x_] := Which[ x<=0, 0, 0=6, x+1]; > f4[x_] := If[0=6, x+1,0]]; > f5[x_] := Switch[x, _?(#<=0&), 0, _?(0<#<6&), x^2, _?(#>=6&), x+1 ] > f6[x_?NumericQ] := {0,x^2,x+1}[[Position[ {x<=0,0=6}, True][[1,1]]]]; > Needs[Calculus`Integration`]; (* needed for definition of Boole *) > f7a[x_?NumericQ] := Evaluate[ (Boole /@ {0=6}). {x^2,x+1}]; > Off[Part::pspec]; f7b[x_?NumericQ] := Evaluate[ {0,x^2,x+1}[[1+Tr[Boole /@ {x>0, x>=6}]]]]; > f8[x_?NumericQ] := Cases[ {{x<=0, 0}, {0=6, x+1}}, {True, z_} :>z][[1]]; > f9[x_?NumericQ] := DeleteCases[ {{x<=0, 0}, {0=6, x+1}}, {False, z_}][[1,2]]; > f10[x_?NumericQ] := Select[ {{x<=0, 0}, {0=6, x+1}}, First[#]&][[1,2]]; > f11[x_?NumericQ] := Last[Sort[ {{x<=0, 0}, {0=6, x+1}}]][[2]]; > f12[x_?NumericQ] := Module[{n=1}, While[{x<6,x<0, False}[[n]], n++]; {x+1,x^2,0}[[n]]]; > Generating some test points: ts = {Random[Real,{-5,0}],0, Random[Real,{0,6}],6,Random[Real,{6,15}]}; > Checking the different representations Equal[(# /@ pts)& /@ {f1,f2,f3,f4,f5,f6,f7a,f7b,f8,f9,f10,f11,f12}] > True To pick a favorite, look at how the different definitions behave. > Of the definitions that evaluate with symbolic input, only f2 and f4 > simplify with assumptions > . For example, FullSimplify[#[x]& /@ {f2,f4}, 1 f2 through f5 respond immediately to differentiation > #'[x]& /@ {f2,f3,f4,f5} // Simplify //ColumnForm > Only f2 responds immediately to integration > Integrate[f2[x],x]//Simplify Consequently, f2 (UnitStep) appears to be the most versatile. ==== > There are many cases in graphics, and otherwise, where it is useful to > obtain two orthogonal unit vectors to a given vector. I know a number of > ways to do it, but they all seem to be slightly inelegant. I thought I would > pose the problem to MathGroup. Who has the most elegant Mathematica > routine... OrthogonalUnitVectors::usage = OrthogonalUnitVectors[v:{_,_,_}] will return > two unit vectors orthogonal to each other and to v. You can assume that v is nonzero. David, here is a solution generating two random vectors: OrthogonalUnitVectors[v : {_, _, _}] := Module[{r, v1, v2}, r = {Random[], Random[], Random[]}; v1 = Cross[v, r]; v2 = Cross[v1, v]; {v1/Sqrt[Dot[v1, v1]], v2/Sqrt[Dot[v2, v2]]}] Test: v = {Random[], Random[], Random[]} {0.864587, 0.727747, 0.669729} {A,B} = OrthogonalUnitVectors[v] {{0.279985, -0.808701, 0.517311}, {-0.698881, 0.19773, 0.687363}} Chop[{A.v, B.v, A.B, A.A, B.B}] {0, 0, 0, 1., 1.} ==== In my previous post, I proposed OrthogonalUnitVectors[v:{_, _, _}] := With[{u = Which[ (w = {0,v[[3]],-v[[2]]}).w != 0, w, (w = {v[[3]],0,-v[[1]]}).w != 0, w, (w = {v[[2]],-v[[1]],0}).w != 0, w ] }, #/Sqrt[#.#]& /@ {u, Cross[u,v]}] The trouble with this is that w ends up being a global variable. The only way I see around that is to use Module instead of With. (May as well put in a Return[$Failed] too.) OrthogonalUnitVectors[v:{_, _, _}] := Module[{u, w}, u = Which[(w = {0,v[[3]],-v[[2]]}).w != 0, w, (w = {v[[3]],0,-v[[1]]}).w != 0, w, (w = {v[[2]],-v[[1]],0}).w != 0, w, True, Return[$Failed]]; #/Sqrt[#.#]& /@ {u, Cross[u, v]} ]