Subject: Re: Package and options you must show a and b because otherwise a and b are in the private context and you don't want to write fexample1[x,Test`Test1`Prtivate`a->something] You should give a and b individual usage messages (*Title : Package for testing options*) BeginPackage[Test`Test1`] fexample1::usage = Help example; a::usage=a is an option for fexample1[] b::usage=b is an option for fexample1[] Begin[`Private`] Options[fexample1] = {a -> A, b -> B} fexample1[x_, opts___Rule] := (a + b) x /. {opts} /. Options[fexample1] End[] EndPackage[] But now fexample1[x] return (Test`Test`Private`A+Test`Test`Private`B)*x and I don't expect that you like this. So you should place a usage message for every symbol you what to use outside the package and for every symbol that can be seen by the user in some cases. Jens > Here is a example package: > (*Title : Package for testing options*) > BeginPackage[Test`Test1`] > fexample1::usage = Help example; > Options[fexample1] = {a -> A, b -> B} > Begin[`Private`] > fexample1[x_, opts___Rule] := > (a + b) x /. {opts} /. Options[fexample1] > End[] > EndPackage[] > (*Now I request the package Help*) > ?Test`Test1`* > (*They are shown not only the fexample1 help but the symbols used in > Options are also shown. How can I prevend that these symbols (a, A, b, > B} be shown. > Other general question: > When Options should be place inside of the private context? > Guillermo*) === Subject: Re: Use of large memory > -----Original Message----- === > Subject: Use of large memory > I was running into memory limits for a large numerical problem in V5.0. The > Pentium 4 machine running XP, with 4GB of memory. I built a test function > that progressively uses more memory and prints MemoryUsed[]. > Every time I get to just under 2GB of memory, I get the out-of-memory > error from the kernal. There's nothing else running, and task manager says > there's plenty left. Has anyone found some Windows XP tweak that allows > Mathematica to use what's available? Would this all work better in Linux? > Gerry Flanagan Hi Gerry, Investigate the XP boot-time switches '/3gb' and '/userva'. *** N.B. They are dangerous; see http://support.microsoft.com/default.aspx?scid=kb;en-us;328269 Even if they work safely for you, the *per-process* memory limit might only increase to ~ 2.75 GB. Vince Virgilio ************************************ This e-mail and any files transmitted with it are proprietary and intended solely for the use of the individual or entity to whom they are addressed. If you have received this e-mail in error please notify the sender. Please note that any views or opinions presented in this e-mail are solely those of the author and do not necessarily represent those of ITT Industries, Inc. The recipient should check this e-mail and any attachments for the presence of viruses. ITT Industries accepts no liability for any damage caused by any virus transmitted by this e-mail. ************************************ === Subject: Cases Given: x = {a,b,c,d,d}; Applying Cases[x,d] gives an output of {a,b,c}...... However, Cases[x,Not[d]] gives as output an empty list { }... I expected {a,b,c}..... Why didnt I get that? This issue came up when using Thread on vectors...and in some cases the Thread resulted in 0 == 0 so it's output in the list was True....and I wanted to remove them.... === Subject: RE: Package and options Guillermo, If it was part of a notebook, I would write your package something like the following. BeginPackage[Test1`] fexample1::usage = fexample[x, opts] calculates (a + b) x where a and b are set by options.; a::usage = a is an option for fexample that sets its value.; b::usage = b is an option for fexample that sets its value.; Begin[`Private`] Options[fexample1] = {a -> Global` A, b -> Global` B}; fexample1[x_, opts___Rule] := (a + b) x /. {opts} /. Options[fexample1] End[] EndPackage[] Then ?Test1`* gives usage messges for a, b and fexample1 and fexample1[x] (A + B) x Notice that I moved the Options statement to the Private section and I used Global`A and Global`B to set the default values of a and b. Also you want to start the usage message with the function name and arguments to get automatic command completion when desired. David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ Here is a example package: (*Title : Package for testing options*) BeginPackage[Test`Test1`] fexample1::usage = Help example; Options[fexample1] = {a -> A, b -> B} Begin[`Private`] fexample1[x_, opts___Rule] := (a + b) x /. {opts} /. Options[fexample1] End[] EndPackage[] (*Now I request the package Help*) ?Test`Test1`* (*They are shown not only the fexample1 help but the symbols used in Options are also shown. How can I prevend that these symbols (a, A, b, B} be shown. Other general question: When Options should be place inside of the private context? Guillermo*) === Subject: definite and indefinite Integrate This is a question from a beginner: ff[z_] = 1/z + z^3 Integrate[ff[z], {z, y, y0}] intff[z_] = Integrate[ff[z], z] intff[y] - intff[y0] I expected to get same results from line 2 and line 4. However, the output from line 2 is very complicated, with an If which has Im(y) and Im(y0) involved. The result I want is that from line 4. How can I modify line 2 so that it produces the same output as from line 4? Jun === Subject: Re: definite and indefinite Integrate > This is a question from a beginner: > ff[z_] = 1/z + z^3 > Integrate[ff[z], {z, y, y0}] > intff[z_] = Integrate[ff[z], z] > intff[y] - intff[y0] > I expected to get same results from line 2 and line 4. However, the > output from line 2 is very complicated, with an If which has Im(y) and > Im(y0) involved. The result I want is that from line 4. How can I modify > line 2 so that it produces the same output as from line 4? Change the order of integration and add appropriate assumptions: Integrate[ff[z], {z, y0, y}, Assumptions -> 0 < y0 < y] (1/4)*(y^4 - y0^4) + Log[y/y0] which I hope you'll agree is even a bit nicer than the output from your line 4. David Cantrell === Subject: Re: Use of large memory So the stork has just delivered a new bouncing baby Pentium (CONGRATULATIONS!) and its memory diapers are full (treasure these moments). If you haven't already tried this, then click on Control Panel, Click on System, Advanced, Page File Size Virtual Memory, and increase BOTH the Minimum Allowed AND the Maximum Allowed to the same amount = 4095 megabytes, this can eliminate some memory errors and also eliminates waiting around while the operating system thrashes between the minimum and maximum. For new computers if you installed the applications yourself and have all of the CDs, you can remove and reinstall applications in such a way that the virtual memory is as close to the front of the drive as possible. When you reinstall, first install the barest part of the operating system, then, as described above, reset Minimum and Maximum memory, then reinstall all the other bells and whistles and other applications. If you have two physical drives (not logical drives where one physical drive is partitioned into two drives), these two physical drives have two IDE controller slots on the motherboard. It is best if the virtual memory - the page file system is handled by one disk controller on one physical drive and data files are handled by the other on the second physical drive. You mitigate memory flatulence if data crunches on a separate physical drive location from the virtual memory pagefile.sys. A word of caution though, if you need to listen to the new Beastie Boys CD or books on CD while running an application and if that application shares the same IDE controller as the CD, when the CD runs it will slow down the application. That's why some prefer one IDE controller for two physical hard drives and the other controller for the CD ROM. Sylvia Hobbs -----Original Message----- === Subject: Use of large memory I was running into memory limits for a large numerical problem in V5.0. The Pentium 4 machine running XP, with 4GB of memory. I built a test function that progressively uses more memory and prints MemoryUsed[]. Every time I get to just under 2GB of memory, I get the out-of-memory error from the kernal. There's nothing else running, and task manager says there's plenty left. Has anyone found some Windows XP tweak that allows Mathematica to use what's available? Would this all work better in Linux? Gerry Flanagan === Subject: Re: Use of large memory This post is completely irrelevant, sorry to say. The question was how to increase the per process memory limit past 2 GB. The answer (already given by Vincent Virgilio) is use the the /3GB switch in Boot.ini (or the You confused that with the pagefile, which is something else. (It's been used in a while. Setting that to min. 4 GB is way overkill, there is no reason to do that. In fact, if you have enough memory you can probably get away with disabling the pagefile entirely, though I wouldn't recommend it.) If you use a 64-bit operating system with 64 bit chips, the per process limit is 4GB automatically for 32 bit apps, (and of course much larger for months though, but you can get 64 bit Linux already from SUSE and perhaps others. You can download a preview of 64 bit XP here if you're curious. For more information about the /3GB switch than you will ever want to know, check this out --Urijah Kaplan > So the stork has just delivered a new bouncing baby Pentium > (CONGRATULATIONS!) and its memory diapers are full (treasure these moments). > If you haven't already tried this, then click on Control Panel, Click on > System, Advanced, Page File Size Virtual Memory, and increase BOTH the > Minimum Allowed AND the Maximum Allowed to the same amount = 4095 megabytes, > this can eliminate some memory errors and also eliminates waiting around > while the operating system thrashes between the minimum and maximum. For > new computers if you installed the applications yourself and have all of the > CDs, you can remove and reinstall applications in such a way that the > virtual memory is as close to the front of the drive as possible. When you > reinstall, first install the barest part of the operating system, then, as > described above, reset Minimum and Maximum memory, then reinstall all the > other bells and whistles and other applications. If you have two physical > drives (not logical drives where one physical drive is partitioned into two > drives), these two physical drives have two IDE controller slots on the > motherboard. It is best if the virtual memory - the page file system is > handled by one disk controller on one physical drive and data files are > handled by the other on the second physical drive. You mitigate memory > flatulence if data crunches on a separate physical drive location from the > virtual memory pagefile.sys. A word of caution though, if you need to listen > to the new Beastie Boys CD or books on CD while running an application and > if that application shares the same IDE controller as the CD, when the CD > runs it will slow down the application. That's why some prefer one IDE > controller for two physical hard drives and the other controller for the CD > ROM. > Sylvia Hobbs > -----Original Message----- === > Subject: Use of large memory > I was running into memory limits for a large numerical problem in V5.0. The > Pentium 4 machine running XP, with 4GB of memory. I built a test function > that progressively uses more memory and prints MemoryUsed[]. Every time I > get to just under 2GB of memory, I get the out-of-memory error from the > kernal. There's nothing else running, and task manager says there's plenty > left. Has anyone found some Windows XP tweak that allows Mathematica to use > what's available? Would this all work better in Linux? > Gerry Flanagan === Subject: ExpandAll Problem with Rules The ExpandAll Help says... ExpandAll[expr] expands out all products and integer powers in any part of expr. The following works... a(b + c) == d(e + f) // ExpandAll a b + a c == d e + d f The following appears to work, but gives a strange error message. a(b + c) -> d(e + f) // ExpandAll General::argt: ExpandAll called with 0 arguments; 1 or 2 arguments are expected a b + a c -> d e + d f David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ === Subject: Re: ExpandAll Problem with Rules That is strange, but this avoids the problem: ExpandAll /@ (a(b + c) -> d(e + f)) a b + a c -> d e + d f Bobby > The ExpandAll Help says... > ExpandAll[expr] expands out all products and integer powers in any part of expr. > The following works... > a(b + c) == d(e + f) // ExpandAll > a b + a c == d e + d f > The following appears to work, but gives a strange error message. > a(b + c) -> d(e + f) // ExpandAll > General::argt: ExpandAll called with 0 arguments; 1 or 2 arguments are > expected > a b + a c -> d e + d f > David Park > djmp@earthlink.net > http://home.earthlink.net/~djmp/ === Subject: Re: ExpandAll Problem with Rules a(b + c) -> d(e + f) // InputForm // ExpandAll works. Try Trace[a(b + c) -> d(e + f) // ExpandAll ] for about ten pages of interesting output. Howard Fink > The ExpandAll Help says... > ExpandAll[expr] expands out all products and integer powers in any part of expr. > The following works... > a(b + c) == d(e + f) // ExpandAll > a b + a c == d e + d f > The following appears to work, but gives a strange error message. > a(b + c) -> d(e + f) // ExpandAll > General::argt: ExpandAll called with 0 arguments; 1 or 2 arguments are > expected > a b + a c -> d e + d f > David Park > djmp@earthlink.net > http://home.earthlink.net/~djmp/ === Subject: Re: Re: Beware of NSolve - nastier example I was iterating to 50 digit answers with starting points from 1/3 to 4 times the correct root. You're getting a machine precision answer with a start that's already correct to 13 places. The difference between the converged answer and your starting value, in fact, was -3.189115638235762*^-14 It's not surprising you could get convergence starting there. If you say the convergence interval is +/-10^-1, OK, but that's awfully close for an initial guess!! However, I was very far off in my post. I should have had g[x_]:=x - f[x]/f'[x] This is exactly what you were doing, and what I thought I was doing, but wasn't! Now, the derivative at the machine precision and 50-digit solutions are: g'@single g'@fifty 8.942337077226623*^-7 0``39.84918837339986 And that's very nice! But at other nearby points: g'/@Range[.005,.015,.001]; Norm/@% {0.611662,0.832022,1.05746,1.32013,1.6874,2.63267,2.89968,2.80032,2.70822,2. 62331,2.54518} If that norm is greater than one anywhere on the interval between the desired root and the starting point, then g isn't a contraction, and convergence of the basic NR is very iffy. Bobby >> Oops, in my last paragraph I claimed convergence for a wider range of starting values than I actually get. (I had a typo when doing some of the tests.) 0.003`n to 0.04`n looks fine. At least it converges for SOME input, which is more than the raw Newton iteration can do. >> Of course, I used Solve to get the h function--the same Solve routine that solved the original problem already! > No problem whatsoever for conventional NR in 16-digits > (double precision) if you are sufficiently near a root. Just run this > NR iteration, which is at the level of the homeworks I assign to > engineering sophomores: > ClearAll[f,x]; > f=(5/432-11/(27*Sqrt[70]*Sqrt[19-1890*x])+x/(2*Sqrt[38/35-(108+1/10000000)*x] )); > fprime=D[f,x]; > Print[N[Solve[f==0,x]]//InputForm]; (* gives 3 correct roots *) > SetPrecision[{xn,xnext,r,f,fprime,fp},16]; > xn=0.0100529100415; (* the slippery root *) > n=10; (* actually n=3 is enough to get limit accuracy *) > For [i=1,i<=n,i++, r=N[f/.x->xn]; fp=N[fprime/.x->xn]; > dx=-r/fp; xnext=xn+dx; > Print[{i,r,fp,dx,xn,xnext}//InputForm]; xn=xnext]; > The derivative f' is large, O(10^13) whereas the residual goes down to > O(10^(-4)). The interval where NR converges to that root is tiny, of > O(10^(-10), but finite. If one tries single precision (~ 6-7 digits) > NR fails, as noted by Daniel Lichtblau, since the convergence > interval falls in the noise. > What is a bit surprising to me is that NSolve applied directly to f, > (not as N[Solve][..]]) needs 128-digit working precision to resolve > that root. -- DrBob@bigfoot.com www.eclecticdreams.net === Subject: Re: Re: Beware of NSolve - nastier example > [...] > No problem whatsoever for conventional NR in 16-digits > (double precision) if you are sufficiently near a root. Just run this > NR iteration, which is at the level of the homeworks I assign to > engineering sophomores: > ClearAll[f,x]; > f=(5/432-11/(27*Sqrt[70]*Sqrt[19-1890*x])+x/(2*Sqrt[38/35-(108+1/10000000)*x] )); > fprime=D[f,x]; > Print[N[Solve[f==0,x]]//InputForm]; (* gives 3 correct roots *) > SetPrecision[{xn,xnext,r,f,fprime,fp},16]; > xn=0.0100529100415; (* the slippery root *) > n=10; (* actually n=3 is enough to get limit accuracy *) > For [i=1,i<=n,i++, r=N[f/.x->xn]; fp=N[fprime/.x->xn]; > dx=-r/fp; xnext=xn+dx; > Print[{i,r,fp,dx,xn,xnext}//InputForm]; xn=xnext]; > The derivative f' is large, O(10^13) whereas the residual goes down to > O(10^(-4)). The interval where NR converges to that root is tiny, of > O(10^(-10), but finite. If one tries single precision (~ 6-7 digits) > NR fails, as noted by Daniel Lichtblau, since the convergence > interval falls in the noise. > What is a bit surprising to me is that NSolve applied directly to f, > (not as N[Solve][..]]) needs 128-digit working precision to resolve > that root. I can address this last part. It is a consequence of mathematical issues that arise in working with multiple or near multiple roots of algebraic systems. First note that NSolve will augment with new variables (for radicals and denominators) and new equations (to record the algebraic dependencies between these variables). It arrives at a polynomial system, one that may have parasite roots it will later need to remove. Second, I'll point out that for a root of multiplicity k, the eigencode that approximates the root values to n digits will typically have only n/k or so correct digits. So we must compromise in deciding whether a set of nearby values is actually a multiple root, because the methods used to find them will tend to smear out the multiple ones (to recover them, the usual rule is to average the values). Recall that this particular algebraic system has a parasite root quite close to an actual root. NSolve needs to have enough precision to recognize that that root is distinct from the actual root. As they agree to 14 or so digits, and as there must be slop built into the code in order to recognize multiple roots at all, it requires far more than 14 digits in order to make the determination that they are in fact distinct roots. Generally speaking, as the putative multiplicity is 2, roughly 30 digits should suffice. But in practice we give it a larger multiplier. In this example 80 or so digits suffices. So what goes wrong? First, so long as NSolve thinks it has a multiple root, the multiplicity reported would be incorrect. But, as I mentioned, the values will also be averaged as a correction step, and in the unfortunate situation where we do NOT have a multiple root that takes us away from the actual root. We then look at the residual. In this case it is not sufficiently small, at the precision utilized, for NSolve to retain it. So it is discarded as a parasite. A possible way to address this in NSolve would be to first polish the root using e.g. FindRoot or FindMinimum. I have been reluctant to take that step because experimentation has shown it to be difficult to make reliable. One problem arises in your example. Suppose we take the approximated roots and use iterations to refine them. What if both approximations to the difficult root are in the attraction basin of the parasite instead of the actual root? What if both go to the actual root? Either way we get an incorrect result. It is only with sufficiently high precision approximations that we can reliably distinguish them, and it is not obvious to me how to get such precision from low precision approximations given the question of where they might converge in such refinement steps. The overall picture is this. We have a global method for finding roots to algebraic systems. It works well but requires precision overestimates in order to handle parasite roots. In principle one might like it to apply local methods in the later stages. In practice I've been unable to make that work out. Daniel Lichtblau Wolfram Research === Subject: Re: Publicon problems converting sample document to LaTeX > That's VERY helpful. And it points out several deviciencies in the > first non-beta release of Publicon: > - inadequate documentation > - no Palettes command on the File menu > - applying a style sheet from the Format command does NOT open > the corresponding palette. > So in 1.0, and without hacking, we would seem to be left with knowing > ahead of time the ultimate destination of a Publicon-created notebook > intended for export -- to LaTeX, etc. -- and jumping through the hoop of > first creating a New notebook of that kind (to bring up the appropriate > palette), then opening (or creating) the actual Publicon notebook we are > interested in exporting eventually. > This design (?) does not seem too clearly thought out! Actually, this is precisely what the design is thought out to be, and is also why we set up the menus to help direct users towards making a document format choice before beginning. This is documented in slide three of the tour. It's a useful suggestion that we reinforce this idea throughout the documentation. Mismatching document formats/templates to their export target is a similar problem to that of exporting arbitrary Mathematica notebooks successfully: the structure has to be precise and recognized by our conversion algorithms. The idea of opening a palette after applying a style sheet is on our list of suggestions for future features, one of many user interface suggestions that have to be implemented in Mathematica before Publicon can exploit it. We have not yet completed setting up a LaTeX class for Publicon's default formats. We are forced to punt on parts of the current LaTeX output produced by the default sample (or anything composed in the default style), because there is no obvious LaTeX analog matching everything in our default format. A clearer indication of that fact would be useful, perhaps a warning in the status message. Documentation covering the customization of LaTeX output can be found here: http://documents.wolfram.com/publicon/UserGuide/AdvancedFeatures/Customizing LaTeXOutput/index.html and the equivalent location in the help browser. We're working on a white paper to describe the process, stepping through a real world example, which should be a useful addition. AK ---------------------------------- Andre Kuzniarek Document Technology Manager Wolfram Research http://www.publicon.com === Subject: Re: Sorting (again!), but with multiple columns Here's a sampling routine: sample[n_]:=RandomArray[BinomialDistribution[12,.23],{n,3}] sample[10] {{2,3,3},{1,4,1},{1,4,7},{2,4,4},{2,2,4},{1,4,3},{2,5,4},{1,1,1},{ 4,3,2},{2,3,2}} For your first sort: Clear@sort sort[{_, a_, c_}, {_, b_, d_}] := a < b || a == b && c >= d data = sample[10] Sort[data, sort] {{2,2,0},{2,3,2},{3,2,5},{2,1,4},{2,4,2},{2,2,3},{1,1,3},{2,2,4},{ 1,4,3},{0,3,1}} {{2,1,4},{1,1,3},{3,2,5},{2,2,4},{2,2,3},{2,2,0},{2,3,2},{0,3,1},{ 1,4,3},{2,4,2}} For your second sort: Clear@sort sort[{_, a_, c_}, {_, b_, d_}] := a < b || a == b && (EvenQ[a] && c <= d || OddQ[a] && c >= d) data = sample[10] Sort[data, sort] {{4,2,3},{4,2,1},{4,2,4},{4,4,3},{4,5,2},{5,4,2},{3,1,1},{2,2,3},{ 3,3,4},{2,2,1}} {{3,1,1},{4,2,1},{2,2,1},{4,2,3},{2,2,3},{4,2,4},{3,3,4},{5,4,2},{ 4,4,3},{4,5,2}} If all second column numbers are Integers (as in my example), or if you want to treat non-Integers the same as odds, the sort function could be Clear@sort sort[{_, a_, c_}, {_, b_, d_}] := a < b || a == b && (EvenQ[a] && c <= d || c >= d) If the second column has any non-Integer values, the result may be strange, since then neither EvenQ nor OddQ will test true. But you could flip a coin in that case: Clear@sort sort[{_, a_, c_}, {_, b_, d_}] := a < b || a == b && (EvenQ[a] && c <= d || OddQ[a] && c >= d || Random[] <= 1/2) Bobby > I have read the long 2002 posting on sorting a matrix by column, and I am > also familiar with Ted Erseks very fast method using Rotate ... but I still > can find quite what I want. I have two related sorting problems ... related > in that they both require sorting by multiple columns, and the second > problems is a kind of subset of the first. > First, I want to sort a (100000 x 3) matrix so that it is sorted firstly on > column 2 (ascending order) and then subsorted on column 3 (decending order). > I had thought incorrectly, that the evaluation order of And[] would lead the > following to work ... I've written the predicate out separately just to make > it clearer. > tQ23[t1_, t2_] := > OrderedQ[{t1[[2]], t2[[2]]}] [And] OrderedQ[{t2[[3]], t1[[3]]}] > t = Table[{i, j, k}, {i, 2}, {j, 2}, {k, 2}]; > Sort[t, tQ23] > {{1, 1, 2}, {2, 1, 2}, {1, 2, 2}, {2, 2, 2}, {1, 1, 1}, {2, 1, 1}, {1, 2, > 1}, {2, 2, 1}} > Second, I want to sort a (100000 x 3) matrix so that it is soted first on > column 2 (ascending order), then *conditionally* subsorted on column 3, with > ascending order if column 2 is Even, and decending if column 2 is Odd. I > have no idea how to approach this, except by sorting on column 2, stripping > out blocks of rows, and resorting them before appending them to a new list. > This is horribly slow. Any suggestions? Any speed-up, or flash of insight > would be most appreciated. > On a different note, given the ubiquity of sorting, I would have thought > that this is an area where a Wolfram time-investment would really pay off. > In the late 70s I used to use a CDC-6600 machine that had a superb sorting > utility where the sort order, sub-order, and various conditionals were easy > to specify and was blindingly fast, at least on straight numeric or > character data. > -- > Mark R. Diamond -- DrBob@bigfoot.com www.eclecticdreams.net === Subject: Re: Sorting (again!), but with multiple columns > First, I want to sort a (100000 x 3) matrix so that it is sorted > firstly on > column 2 (ascending order) and then subsorted on column 3 (decending > order). > I had thought incorrectly, that the evaluation order of And[] would > lead the > following to work ... I've written the predicate out separately just > to make > it clearer. > tQ23[t1_, t2_] := > OrderedQ[{t1[[2]], t2[[2]]}] [And] OrderedQ[{t2[[3]], t1[[3]]}] > t = Table[{i, j, k}, {i, 2}, {j, 2}, {k, 2}]; > Sort[t, tQ23] > {{1, 1, 2}, {2, 1, 2}, {1, 2, 2}, {2, 2, 2}, {1, 1, 1}, {2, 1, 1}, {1, > 2, > 1}, {2, 2, 1}} Your table expression does not result in a matrix, it results in a list 4 levels deep, but the following expression does what you want Sort[Flatten[Table[{i, j, k}, {i, 2}, {j, 2}, {k, 2}], 2], #[[2]] == #2[[2]] == #[[3]] <= #2[[3]] &] > Second, I want to sort a (100000 x 3) matrix so that it is soted first > on > column 2 (ascending order), then *conditionally* subsorted on column > 3, with > ascending order if column 2 is Even, and decending if column 2 is Odd. > have no idea how to approach this, except by sorting on column 2, > stripping > out blocks of rows, and resorting them before appending them to a new > list. > This is horribly slow. Any suggestions? Any speed-up, or flash of > insight > would be most appreciated. You could split the list on the second element after sorting, then use Map to do the sorts on the third element, then flatten to restore the structure Flatten[If[EvenQ[#[[1, 2]]], Sort[#, #[[3]] == #2[[3]] &], Sort[#, #[[3]] == #2[[3]] &]] & /@ Split[Sort[Flatten[ Table[{i, j, k}, { i, 2}, {j, 2}, {k, 2}], 2], #[[2]] == #2[[2]] &], #[[2]] == #2[[2]] &], 1] I haven't optimized for speed, the second expression take 287 seconds on a 1 million row array of integers on my machine a 1GHz G4 PowerMac. Ssezi === Subject: Re: newbie is looking foracustomDistributionfunction No question, a different mapping into the reals gives a different distribution function. But if you've chosen a mapping, you know it both ways, so you know the order you speak of. Anyway, my solution doesn't depend on any of that. Since the OP wanted to sample from a list based on frequency in the list, this works: random[a:{__}]:=a[[Random[Integer,{1,Length@a} ]]] Bobby > Quite right. However, implicit in the mapping of a List into the real line > is the problem of order. If the mapping takes, say, the element {a, a} to 0, > {a, b} to 1, and {a, c} to 2, etc., what would be the meaning of the > probability that the result of the experiment takes a value less than or > equal to 2? (Yes, I realize that once you define a fixed order in twocombs, > such as that produced by Distribute, this would be interpreted as the > probability of {{a, a}, {a, b}, {a,c}}. But this goes well above my head). > Tomas Garza > ----- Original Message ----- === > Subject: Re: newbie is looking for > acustomDistributionfunction >> More generally, any mapping of a finite measure space into the extended > real line implies a measure on the Borel sets, giving rise to a distribution > function. It isn't difficult to map the values of a List into the reals--to > Range[Length[theList]], for instance. Given such an embedding, any > probability measure on the original set implies a distribution function, and > vice-versa. >> Anyway, the OP apparently wanted a sampling function, like Random[], which > doesn't require computing a distribution function at all. He already knew > (and described in his post) how to calculate relative frequencies. >> Bobby >> reals. You can't, therefore, define it on lists of two, three, or more >> symbols. A frequency function, on the other hand, may be defined on any > set >> of events. But, then, it is rather trivial for your problem: once you > have >> your list distpro, just divide each value in the list by the sum of all > the >> values, and that's it. Or, maybe, I misunderstood your question? >> >> Tomas Garza >> Mexico City >> ----- Original Message ----- === >> Subject: newbie is looking for a customDistribution > function >> >> >>> >>> I looked for it in the archives, but found none. I am looking for ways >>> to create a custom distribution, which I can call as a function. Here >>> is an example for illustration. Let's say I have a list created from a >>> 4 elements alphabet {a,b,c,d}: >>> >>> In[1]:= >>> lst={a,a,b,c,a,d,a,c,c,a} >>> >>> Out[1]= >>> {a,a,b,c,a,d,a,c,c,a} >>> >>> combinations of {a,b,c,d} >>> >>> In[11]:= >>> twocombs=Distribute[Table[{a,b,c,d},{2}],List] >>> >>> Out[11]= >>> > {{a,a},{a,b},{a,c},{a,d},{b,a},{b,b},{b,c},{b,d},{c,a},{c,b},{c,c},{c,d} >>> ,{ >>> d,a},{d,b},{d,c},{d,d}} >>> >>> I can count the occurrence of an element of twocombs in lst with the >>> following function: >>> >>> occuranceCount[x_List] := Count[Partition[lst, 2, 1], x] >>> >>> Mapping this function over twocombs gives me the number of occurances >>> of elements of twocombs in lst: >>> >>> In[12]:= >>> distro=Map[occuranceCount,twocombs] >>> >>> Out[12]= >>> {1,1,1,1,0,0,1,0,2,0,1,0,1,0,0,0} >>> >>> It shows that for example {c,a} occurs twice, {d,a} occurs once and >>> {d,c} or {d,d} never occur. >>> >>> Now, I would like to create a distribution function called >>> twocombsLstDistribution which I could call and it would give me back >>> elements of twocombs with the probability as they occur in distro, that >>> is for on average I would get twice as much {c,a}s as {d,a}s and never >>> get {d.c} or {d,d}. >>> >>> How can I craft that ? >>> >>> /Of course I need it for an arbitrary but finite length string lst over >>> a fixed length alphabet {a,b,c,d,....} for k-length elements of kcombs, >>> and it has to be super fast :). My real lst is between 30,000 and >>> 70,000 element long over a four element alphabet and I am looking for k >>> between 5 and a few hundred. / >>> >>> J.87nos >>> ------------------------------------------------- >>> People never lie so much as after a >>> hunt, during a war or before an election >>> - Otto von Bismarck - >>> >>> >> >> >> >> >> -- >> DrBob@bigfoot.com >> www.eclecticdreams.net -- DrBob@bigfoot.com www.eclecticdreams.net === Subject: Re: newbie is looking Quite right. However, implicit in the mapping of a List into the real line is the problem of order. If the mapping takes, say, the element {a, a} to 0, {a, b} to 1, and {a, c} to 2, etc., what would be the meaning of the probability that the result of the experiment takes a value less than or equal to 2? (Yes, I realize that once you define a fixed order in twocombs, such as that produced by Distribute, this would be interpreted as the probability of {{a, a}, {a, b}, {a,c}}. But this goes well above my head). Tomas Garza ----- Original Message ----- === Subject: Re: newbie is looking for acustomDistributionfunction > More generally, any mapping of a finite measure space into the extended real line implies a measure on the Borel sets, giving rise to a distribution function. It isn't difficult to map the values of a List into the reals--to Range[Length[theList]], for instance. Given such an embedding, any probability measure on the original set implies a distribution function, and vice-versa. > Anyway, the OP apparently wanted a sampling function, like Random[], which doesn't require computing a distribution function at all. He already knew (and described in his post) how to calculate relative frequencies. > Bobby > reals. You can't, therefore, define it on lists of two, three, or more > symbols. A frequency function, on the other hand, may be defined on any set > of events. But, then, it is rather trivial for your problem: once you have > your list distpro, just divide each value in the list by the sum of all the > values, and that's it. Or, maybe, I misunderstood your question? > Tomas Garza > Mexico City > ----- Original Message ----- === > Subject: newbie is looking for a customDistribution function >> >> I looked for it in the archives, but found none. I am looking for ways >> to create a custom distribution, which I can call as a function. Here >> is an example for illustration. Let's say I have a list created from a >> 4 elements alphabet {a,b,c,d}: >> >> In[1]:= >> lst={a,a,b,c,a,d,a,c,c,a} >> >> Out[1]= >> {a,a,b,c,a,d,a,c,c,a} >> >> combinations of {a,b,c,d} >> >> In[11]:= >> twocombs=Distribute[Table[{a,b,c,d},{2}],List] >> >> Out[11]= >> {{a,a},{a,b},{a,c},{a,d},{b,a},{b,b},{b,c},{b,d},{c,a},{c,b},{c,c},{c,d} >> ,{ >> d,a},{d,b},{d,c},{d,d}} >> >> I can count the occurrence of an element of twocombs in lst with the >> following function: >> >> occuranceCount[x_List] := Count[Partition[lst, 2, 1], x] >> >> Mapping this function over twocombs gives me the number of occurances >> of elements of twocombs in lst: >> >> In[12]:= >> distro=Map[occuranceCount,twocombs] >> >> Out[12]= >> {1,1,1,1,0,0,1,0,2,0,1,0,1,0,0,0} >> >> It shows that for example {c,a} occurs twice, {d,a} occurs once and >> {d,c} or {d,d} never occur. >> >> Now, I would like to create a distribution function called >> twocombsLstDistribution which I could call and it would give me back >> elements of twocombs with the probability as they occur in distro, that >> is for on average I would get twice as much {c,a}s as {d,a}s and never >> get {d.c} or {d,d}. >> >> How can I craft that ? >> >> /Of course I need it for an arbitrary but finite length string lst over >> a fixed length alphabet {a,b,c,d,....} for k-length elements of kcombs, >> and it has to be super fast :). My real lst is between 30,000 and >> 70,000 element long over a four element alphabet and I am looking for k >> between 5 and a few hundred. / >> >> J.87nos >> ------------------------------------------------- >> People never lie so much as after a >> hunt, during a war or before an election >> - Otto von Bismarck - >> >> > -- > DrBob@bigfoot.com > www.eclecticdreams.net === Subject: Re: newbie is looking for a customDistribution function More generally, any mapping of a finite measure space into the extended real line implies a measure on the Borel sets, giving rise to a distribution function. It isn't difficult to map the values of a List into the reals--to Range[Length[theList]], for instance. Given such an embedding, any probability measure on the original set implies a distribution function, and vice-versa. Anyway, the OP apparently wanted a sampling function, like Random[], which doesn't require computing a distribution function at all. He already knew (and described in his post) how to calculate relative frequencies. Bobby > reals. You can't, therefore, define it on lists of two, three, or more > symbols. A frequency function, on the other hand, may be defined on any set > of events. But, then, it is rather trivial for your problem: once you have > your list distpro, just divide each value in the list by the sum of all the > values, and that's it. Or, maybe, I misunderstood your question? > Tomas Garza > Mexico City > ----- Original Message ----- === > Subject: newbie is looking for a customDistribution function >> I looked for it in the archives, but found none. I am looking for ways >> to create a custom distribution, which I can call as a function. Here >> is an example for illustration. Let's say I have a list created from a >> 4 elements alphabet {a,b,c,d}: >> In[1]:= >> lst={a,a,b,c,a,d,a,c,c,a} >> Out[1]= >> {a,a,b,c,a,d,a,c,c,a} >> combinations of {a,b,c,d} >> In[11]:= >> twocombs=Distribute[Table[{a,b,c,d},{2}],List] >> Out[11]= >> {{a,a},{a,b},{a,c},{a,d},{b,a},{b,b},{b,c},{b,d},{c,a},{c,b},{c,c},{c,d} >> ,{ >> d,a},{d,b},{d,c},{d,d}} >> I can count the occurrence of an element of twocombs in lst with the >> following function: >> occuranceCount[x_List] := Count[Partition[lst, 2, 1], x] >> Mapping this function over twocombs gives me the number of occurances >> of elements of twocombs in lst: >> In[12]:= >> distro=Map[occuranceCount,twocombs] >> Out[12]= >> {1,1,1,1,0,0,1,0,2,0,1,0,1,0,0,0} >> It shows that for example {c,a} occurs twice, {d,a} occurs once and >> {d,c} or {d,d} never occur. >> Now, I would like to create a distribution function called >> twocombsLstDistribution which I could call and it would give me back >> elements of twocombs with the probability as they occur in distro, that >> is for on average I would get twice as much {c,a}s as {d,a}s and never >> get {d.c} or {d,d}. >> How can I craft that ? >> /Of course I need it for an arbitrary but finite length string lst over >> a fixed length alphabet {a,b,c,d,....} for k-length elements of kcombs, >> and it has to be super fast :). My real lst is between 30,000 and >> 70,000 element long over a four element alphabet and I am looking for k >> between 5 and a few hundred. / >> J.87nos >> ------------------------------------------------- >> People never lie so much as after a >> hunt, during a war or before an election >> - Otto von Bismarck - -- DrBob@bigfoot.com www.eclecticdreams.net === Subject: Re: Use of large memory I have been running Mathematica on HP tru64 unix, linux + Xeon, linux + Itanium2 and SunOS machines, all with more than 4 GB of memory, but mathematica cannot handle any matrix larger than 2GB. When one allocates several smaller matrices with total memory > 2GB, MemoryUsed[] is negative. This is quite disappointing. Could any person from Wolfram explain what is happening? Fei > I was running into memory limits for a large numerical problem in V5.0. The > Pentium 4 machine running XP, with 4GB of memory. I built a test function > that progressively uses more memory and prints MemoryUsed[]. Every time I > get to just under 2GB of memory, I get the out-of-memory error from the > kernal. There's nothing else running, and task manager says there's plenty > left. Has anyone found some Windows XP tweak that allows Mathematica to use > what's available? Would this all work better in Linux? > Gerry Flanagan === Subject: Re: Use of large memory with Windows XP your application has *not* the full 4 GByte address space of a 32 Bit pointer. Because the operating system use some bits of the pointer to manage the tables for virtual memory. Only a 64 Bit Operatingsystem and a 64 Bit Mathematica can help you out. For Intel the only available combination is a 64 Bit Linux and a 64 Bit Mathematica for Linux. Jens > I was running into memory limits for a large numerical problem in V5.0. The > Pentium 4 machine running XP, with 4GB of memory. I built a test function > that progressively uses more memory and prints MemoryUsed[]. Every time I > get to just under 2GB of memory, I get the out-of-memory error from the > kernal. There's nothing else running, and task manager says there's plenty > left. Has anyone found some Windows XP tweak that allows Mathematica to use > what's available? Would this all work better in Linux? > Gerry Flanagan === Subject: Re: Cases *This message was transferred with a trial version of CommuniGate(tm) Pro* > *This message was transferred with a trial version of CommuniGate(tm) > Pro* > Given: x = {a,b,c,d,d}; > Applying Cases[x,d] gives an output of {a,b,c}...... > However, Cases[x,Not[d]] gives as output an empty list { }... I > expected {a,b,c}..... > Why didnt I get that? > This issue came up when using Thread on vectors...and in some cases the > Thread resulted in 0 == 0 so it's output in the list was > True....and I > wanted to remove them.... This is because Not[d] is not a pattern matched by something that is not d. There are several ways to construct what is effectively such a pattern, e.g. Cases[x,_?(#=!=d&)] {a,b,c} Cases[x,_?(Not[MatchQ[#,d]]&)] {a,b,c} but I don't think there is any way that does not use PatternTest. That means that this is a situation you can make your program simpler if you use Select, e.g. Select[x,#=!=d&] {a,b,c} Andrzej Kozlowski Chiba, Japan http://www.mimuw.edu.pl/~akoz/ === Subject: Re: Cases Jerry, I think Not[d] is only defined if d is True or False, and it is not a pattern. Moreover, if a, b, c and d are undefined, Mathematica does not know if they are equal or not. You might test if these symbols are identical: Cases[x, y_ /; UnsameQ[y, d]] gives you {a, b, c} Ingolf Dahl Sweden -----Original Message----- === Subject: Cases Given: x = {a,b,c,d,d}; Applying Cases[x,d] gives an output of {a,b,c}...... However, Cases[x,Not[d]] gives as output an empty list { }... I expected {a,b,c}..... Why didnt I get that? This issue came up when using Thread on vectors...and in some cases the Thread resulted in 0 == 0 so it's output in the list was True....and I wanted to remove them.... === Subject: Re: definite and indefinite Integrate *This message was transferred with a trial version of CommuniGate(tm) Pro* > *This message was transferred with a trial version of CommuniGate(tm) > Pro* > This is a question from a beginner: > ff[z_] = 1/z + z^3 > Integrate[ff[z], {z, y, y0}] > intff[z_] = Integrate[ff[z], z] > intff[y] - intff[y0] > I expected to get same results from line 2 and line 4. However, the > output > from line 2 is very complicated, with an If which has Im(y) and Im(y0) > involved. The result I want is that from line 4. How can I modify line > so that it produces the same output as from line 4? > Jun Use Integrate[ff[z], {z, y, y0}, GenerateConditions -> False] Andrzej Kozlowski Chiba, Japan http://www.mimuw.edu.pl/~akoz/ === Subject: Re : definite and indefinite Integrate They are not equal, but opposite! Read the Newton-Leibnitz formula... But you have to tell Mathematica what you seem to assume, that your y and y0 are positive (so they are real...) In[51]:= ff[z_] = 1/z + z^3; In[52]:= a = Integrate[ff[z], {z, y, y0}, Assumptions -> {y > 0, y0 > 0}] Out[52]= (1/4)*(-y^4 + y0^4) + Log[y0/y] In[53]:= intff[z_] = Integrate[ff[z], z] Out[53]= z^4/4 + Log[z] In[54]:= b = intff[y] - intff[y0] Out[54]= y^4/4 - y0^4/4 + Log[y] - Log[y0] In[55]:= Simplify[a == -b, {y > 0, y0 > 0}] Out[55]= True F.Jaccard -----Message d'origine----- DeÊ: Jun Yan [mailto:jyan@stat.wisc.edu] ËÊ: mathgroup@smc.vnet.net ObjetÊ: definite and indefinite Integrate This is a question from a beginner: ff[z_] = 1/z + z^3 Integrate[ff[z], {z, y, y0}] intff[z_] = Integrate[ff[z], z] intff[y] - intff[y0] I expected to get same results from line 2 and line 4. However, the output from line 2 is very complicated, with an If which has Im(y) and Im(y0) involved. The result I want is that from line 4. How can I modify line 2 so that it produces the same output as from line 4? Jun === And yes ... I had forgotten to copy the Flatten into the original posting, even though I had it there in my original code. -- Mark R. Diamond === Subject: Re: Parallel Toolkit Example >> I am looking for an efficient example of using the Parallel Toolkit. >> Many other people on this forum seem to have noted what I have also >> found to be the case, that the ParallelMap and ParallelTable commands >> aren't terribly efficient. The example code in ParEval.nb, for >> instance >> ParallelMap[FactorInteger, (10^Range[20, 40] )/9] >> only seems to run about 20% faster on a six-node cluster vs my >> laptop. Does anyone have an example of how to solve this same >> problem using an efficient parallel technique? I am fairly new to >> Mathematica, so please be explicit. >> -geoff >> Geoff Hulette >> MIT Academic Computing >> ghulette@mit.edu > Not that I know anything about it, but you are probably looking at a > latency issue with this example. Generally speaking for ParallelMap et > al to be of use the time to process the individual elements needs to > be large compared to the overhead time of shipping back and forth over > (they all factor quite quickly). > If they did not you could run into a different problem. For some sets > of integers the overall factorization speed will be dominated by the > time needed to factor one particular element. In such cases again a > parallelized version would not be of much help. But for sets where two > or more of the inputs are slow to factor it would of course give a > considerable boost. > Daniel Lichtblau > Wolfram Research Well, that is certainly true. But, if I am not mistaken (and I could be, since I am new to Mathmatica), the problem I am trying out factors a large range of integers, and the computation for any one element in the set to be factored can be computed independently of the others. So, I suspect that the ParallelMap command is inefficient in that it first computes the range (20 integers, in this case), and sends each one (20 problems total) out over the network. A far more efficient solution would be break the problem up over the number of processors available, and let each node handle its part of the range. In this case each processor would only have to handle one (somewhat more difficult) problem, reducing the latency. This would also allow the process to scale better, as the range increases, since each processor would always only be tackling one problem (with only one associated overhead cost), while the time spent in computation would increase according to the complexity of the problem. Does anybody have a way to do this? Or, as a matter of fact, does anyone have any examples at all of efficient Parallel Toolkit routines? geoff === Subject: Parallel Toolkit Example I am looking for an efficient example of using the Parallel Toolkit. Many other people on this forum seem to have noted what I have also found to be the case, that the ParallelMap and ParallelTable commands aren't terribly efficient. The example code in ParEval.nb, for instance ParallelMap[FactorInteger, (10^Range[20, 40] )/9] only seems to run about 20% faster on a six-node cluster vs my laptop. Does anyone have an example of how to solve this same problem using an efficient parallel technique? I am fairly new to Mathematica, so please be explicit. -geoff Geoff Hulette MIT Academic Computing ghulette@mit.edu === Subject: Re: Parallel Toolkit Example > I am looking for an efficient example of using the Parallel Toolkit. > Many other people on this forum seem to have noted what I have also > found to be the case, that the ParallelMap and ParallelTable commands > aren't terribly efficient. The example code in ParEval.nb, for > instance > ParallelMap[FactorInteger, (10^Range[20, 40] )/9] > only seems to run about 20% faster on a six-node cluster vs my laptop. > Does anyone have an example of how to solve this same problem using an > efficient parallel technique? I am fairly new to Mathematica, so > please be explicit. Here's a copy of a couple of my posts from way back when... ************* I am starting to use the parallel programming toolbox, and I've found the ParallelMap[ ] function to be essentially broken, most likely due to some sort of comm glitch. I was curious if anyone else has experienced a similar problem, or if it is just my network. If I run the following commands (listtt is a 5 element list of real numbers), with one remote server active... x1=SessionTime[]; ParallelMap[Sin,listtt] SessionTime[]-x1 It takes 5-7 seconds. This is to connect with a slave computer that is sharing a hub with the master. Obviously something is wrong. By contrast, if I define the function on the slave maparoni[x_]:=Map[Sin,x] and do the following... Do[ With[{x=listtt},RemoteEvaluate[maparoni[x]] ] , {20} ] SessionTime[]-x1 It only takes 5 seconds. Note the difference. I am executing the Sin[ ] function twenty times more, I am passing discrete hunks of data twenty times more, and I am passing twenty times the total amount of data, yet it takes less time to complete. So the basic linking between computers appears to work OK. Anybody else have experience with the ParallelMap[ ] function? I see similar performance with ParallelTable[ ] ************* I've traded email with the Mathematica support folks since, and here is the nugget of my point. Make a list of 100 elements. list = {0, ...., 100}; Start one remote processor. Compare these calls... ParallelMap[Sin, list]; Map[RemoteEvaluate[Sin[#]] &, list]; Both calls do the same thing, and theoretically have the exact same amount of communication and computation. Yet you see a six-fold difference in the time spent other than calculating, between these two. The first call takes 200 seconds. The second call takes 30 seconds. With two processors, it is still better to Map[ ] it across a single remote than it is to ParallelMap[ ] it across two remote. And so on up to six or so remote processors. These processors are on PCs communicating across a 10 MB ethernet hub. An even faster call is: RemoteEvaluate[Map[Sin,list]]] Which is almost instantaneous. This points out that it is much better to split a list up into N segments for N processors and farm them out, than it is to let ParallelMap[ ] handle the comms for you. The advantages for using ParallelMap[ ] are that it handles the admin details, and it will handle cases where the task time for each element differs. === Subject: Re: Cases If d is a Symbol, Not[d] is not a boolean Not[d] Âd x={a,b,c,d,d}; {a, b, c} {a, b, c} Bob Hanlon === > Subject: Cases > Given: x = {a,b,c,d,d}; > Applying Cases[x,d] gives an output of {a,b,c}...... > However, Cases[x,Not[d]] gives as output an empty list { }... I > expected {a,b,c}..... > Why didnt I get that? > This issue came up when using Thread on vectors...and in some cases the > Thread resulted in 0 == 0 so it's output in the list was > True....and I > wanted to remove them.... === Subject: Re: Cases >-----Original Message----- === >Subject: Cases >Given: x = {a,b,c,d,d}; >Applying Cases[x,d] gives an output of {a,b,c}...... >However, Cases[x,Not[d]] gives as output an empty list { }... I >expected {a,b,c}..... >Why didnt I get that? >This issue came up when using Thread on vectors...and in some cases the >Thread resulted in 0 == 0 so it's output in the list was >True....and I >wanted to remove them.... Jerry, Not[d] ist not the right pattern (or form as referred in Help) to match elements of x which don't match d, instead In[6]:= Cases[x, d] Out[6]= {d, d} In[8]:= Cases[x, _?(Not[MatchQ[#, d]] &)] Out[8]= {a, b, c} But for the better way to do it, use DeleteCases: In[7]:= DeleteCases[x, d] Out[7]= {a, b, c} -- Hartmut Wolf === Subject: Re: definite and indefinite Integrate ff[z_]=1/z+z^3; Use GenerateConditions -> False and reverse the order of your limits. Integrate[ff[z],{z,y0,y}, GenerateConditions->False] y^4/4 - y0^4/4 + Log[y] - Log[y0] Bob Hanlon === > Subject: definite and indefinite Integrate > This is a question from a beginner: > ff[z_] = 1/z + z^3 > Integrate[ff[z], {z, y, y0}] > intff[z_] = Integrate[ff[z], z] > intff[y] - intff[y0] > I expected to get same results from line 2 and line 4. However, the output > from line 2 is very complicated, with an If which has Im(y) and Im(y0) > involved. The result I want is that from line 4. How can I modify line 2 > so that it produces the same output as from line 4? > Jun === Subject: Re: ExpandAll Problem with Rules Put parentheses around the argument to ExpandAll (a(b+c)==d(e+f)) // ExpandAll or use ExpandAll[a(b+c)==d(e+f)] Bob Hanlon === > Subject: ExpandAll Problem with Rules > The ExpandAll Help says... > ExpandAll[expr] expands out all products and integer powers in any part of expr. > The following works... > a(b + c) == d(e + f) // ExpandAll > a b + a c == d e + d f > The following appears to work, but gives a strange error message. > a(b + c) -> d(e + f) // ExpandAll > General::argt: ExpandAll called with 0 arguments; 1 or 2 arguments are > expected > a b + a c -> d e + d f > David Park > djmp@earthlink.net > http://home.earthlink.net/~djmp/ === Subject: Conditional Plots ê«m trying to produce a 3D plot with a 2D ploygon (within unit circle) as its base. Equivalently, I want my 3D surface to sit inside (be bounded by) a cylinder with n-gon cross section. How can I trim off the edges? I«ve tried to use If[ (condition), Plot, Blah] but it doesn«t seem to work..... === Subject: Re: Conditional Plots something like Clear[BlendSplit] BlendSplit[{{p1_, f1_}, {_, f2_}}, _] /; Sign[f1] == Sign[f2] := {p1, f1} If[$VersionNumber < 5.0, BlendSplit[{{p1_, f1_}, {p2_, f2_}}, blend_] := Module[{func, t, sol, crossp}, func = blend @@ (p1*(1 - t) + p2*t); sol = t /. FindRoot[Evaluate[func], {t, {0, 1}}]; crossp = p1*(1 - sol) + p2*sol; Sequence @@ {{p1, f1}, {crossp, 0}, {p2, f2}} ], (* Else *) BlendSplit[{{p1_, f1_}, {p2_, f2_}}, blend_] := Module[{func, t, sol, crossp}, func = blend @@ (p1*(1 - t) + p2*t); sol = First[t /. FindRoot[Evaluate[func], {t, {0, 1}}]]; crossp = p1*(1 - sol) + p2*sol; Sequence @@ {{p1, f1}, {crossp, 0}, {p2, f2}} ] ] BlendPoly[Polygon[pnts_], blend_] := Module[{feval, p1, p2, addp1, i, n}, feval = {#, blend @@ #} & /@ pnts; feval = BlendSplit[##, blend] & /@ Transpose[{feval, RotateLeft[feval]}]; If[And @@ (Last[#] > 0 & /@ feval), Return[Polygon[pnts]], ]; p1 = First /@ Select[feval, Last[#] >= 0 &]; Polygon[p1] ] gg = Graphics3D[ Plot3D[Sin[(x + y)*y], {x, -2Pi, 2Pi}, {y, -2Pi, 2Pi}, PlotPoints -> 60]]; Show[Graphics3D[ Cases[gg, _Polygon, Infinity] /. p_Polygon :> BlendPoly[p, Function[{x, y, z}, - ( x^2 + y^2 - 4)]], PlotRange -> All] ] ?? Jens > ê«m trying to produce a 3D plot with a 2D ploygon (within unit circle) > as its base. Equivalently, I want my 3D surface to sit inside (be > bounded by) a cylinder with n-gon cross section. > How can I trim off the edges? > I«ve tried to use > If[ (condition), Plot, Blah] but it doesn«t seem to work..... === Subject: Re: Cases Jerry, x = {a, b, c, d, d}; Not[d] // FullForm Not[d] I don't see any of those in the list. Cases[x, a_ /; a =!= d] {a, b, c} This method might be easier. Clear[x] {a, 0, b, 0, d} == {x, 0, y, 0, z} // Thread % /. True -> Sequence[] {a == x, True, b == y, True, d == z} {a == x, b == y, d == z} David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ Given: x = {a,b,c,d,d}; Applying Cases[x,d] gives an output of {a,b,c}...... However, Cases[x,Not[d]] gives as output an empty list { }... I expected {a,b,c}..... Why didnt I get that? This issue came up when using Thread on vectors...and in some cases the Thread resulted in 0 == 0 so it's output in the list was True....and I wanted to remove them.... === Subject: Re: ExpandAll Problem with Rules (a(b + c) -> d(e + f)) // ExpandAll still gives the error message. It is the use of ExpandAll on Rules that is the problem. David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ Put parentheses around the argument to ExpandAll (a(b+c)==d(e+f)) // ExpandAll or use ExpandAll[a(b+c)==d(e+f)] Bob Hanlon === > Subject: ExpandAll Problem with Rules > The ExpandAll Help says... > ExpandAll[expr] expands out all products and integer powers in any part of expr. > The following works... > a(b + c) == d(e + f) // ExpandAll > a b + a c == d e + d f > The following appears to work, but gives a strange error message. > a(b + c) -> d(e + f) // ExpandAll > General::argt: ExpandAll called with 0 arguments; 1 or 2 arguments are > expected > a b + a c -> d e + d f > David Park > djmp@earthlink.net > http://home.earthlink.net/~djmp/ === Subject: Re: RE: ExpandAll Problem with Rules Must be version/OS related. With the overall paren it works fine on v5.0.1.0 with Mac OS X. Bob Hanlon > === > Subject: RE: ExpandAll Problem with Rules > (a(b + c) -> d(e + f)) // ExpandAll > still gives the error message. It is the use of ExpandAll on Rules that is > the problem. > David Park > djmp@earthlink.net > http://home.earthlink.net/~djmp/ > Put parentheses around the argument to ExpandAll > (a(b+c)==d(e+f)) // ExpandAll > or use > ExpandAll[a(b+c)==d(e+f)] > Bob Hanlon === > Subject: ExpandAll Problem with Rules > The ExpandAll Help says... > ExpandAll[expr] expands out all products and integer powers in any part of > expr. > The following works... > a(b + c) == d(e + f) // ExpandAll > a b + a c == d e + d f > The following appears to work, but gives a strange error message. > a(b + c) -> d(e + f) // ExpandAll > General::argt: ExpandAll called with 0 arguments; 1 or 2 arguments are > expected > a b + a c -> d e + d f > David Park > djmp@earthlink.net > http://home.earthlink.net/~djmp/ Bob Hanlon Chantilly, VA === Subject: Re: Cases >Given: x = {a,b,c,d,d}; >Applying Cases[x,d] gives an output of {a,b,c}...... I assume you really meant Cases[x,d] gives an output of {d,d} since that is what it is documented to to and does on my system. >However, Cases[x,Not[d]] gives as output an empty list { }... I >expected {a,b,c}..... >Why didnt I get that? Because none of the elements of your list x have a Head of Not. Cases returns all of the elements that match the specified pattern. When none of the elements have the same head as the specified pattern, Cases correctly returns an empty list. If you want to output a list of everything in the list different from a specified pattern, use DeleteCases, i.e., DeleteCases[x, d] {a, b, c} And note x==DeleteCases[x,Not[d]] True since there is no matching element to Not[d] -- To reply via email subtract one hundred and four === Subject: Re: Re: newbie is looking for a customDistribution function I'm sure the Alias Method is brilliant, but I'd like to see an implementation. Here's a decent method---NOT for the OP's original problem, but for a more general case where discrete probabilities are known. n is the number of discrete values and p is the vector of their probabilities. inverse is the inverse CDF. n = 300; p = (#1/Tr[#1] &)[(Random[] &) /@ Range[n]]; inverse = Interpolation[Transpose@{FoldList[Plus, 0, p], Range[0, Length@p]}, InterpolationOrder -> 0]; random2[] := inverse@Random[] samples = 1000000; result = Replace[MapAt[Frequencies, Timing@Array[random2[] &, samples], 2], {a_, b_} :> {N[ a/samples], b}, 2]; First@result 4.343 Second result[[-1, All, 1]] - p // Abs // Max 0.000186455 The last number is the maximum absolute difference between observed frequencies and the corresponding p values. (That statement fails if not all discrete values are represented in the sample.) Timings on my machine for a million samples at n=3, 30, and 300 (the number of discrete values) are between 4.3 and 4.4 seconds for all three values of n. Bobby > However, if you really want to use the distribution instead of the data > that gave rise to it then you should look into the Alias Method of > generating random observations from an arbitary discrete distribution. >> How would we look into that? Is that in the Mathematica help files, >> math books, what? > and got ~191 references. I assumed everyone would do something similar. > In retrospect, I should have just pointed to > http://cgm.cs.mcgill.ca/~luc/rnbookindex.html > which is a source that everyone who uses anything more complicated than > simple Uniform random numbers should know about. > Ray -- DrBob@bigfoot.com www.eclecticdreams.net === Subject: Re: newbie is looking for a customDistribution function > I'm sure the Alias Method is brilliant, > but I'd like to see an implementation. This sets up for generating by the Alias method. p is the vector of probabilities, which must be > 0 and add to 1. In[1]:= setal[p_] := Block[{n = Length[p],a,b,c,i,j,tol}, a = Range[n]; b = n*p - 1; c = Table[1,{n}]; tol = 2n*$MachineEpsilon (* or some such value *); While[{i,j} = Ordering[b][[{1,-1}]]; b[[j]] > b[[i]] + tol, a[[i]] = j; c[[i]] = 1 + b[[i]]; b[[j]] += b[[i]]; b[[i]] = 0]; {n,a,N[c]}] n is the number of terms in p. a is the vector of aliases. c is the vector of comparands that are used to determine whether or not to use an alias. This will get a random observation 1...n with the probabilities specified in p: (If[Random[] > c[[#]], a[[#]], #]&)[Random[Integer,{1,n}]] This creates a random p and sets up to generate from it by both the Alias and zero-order-interpolation methods. In[2]:= p = #/Tr@#&[Table[Log[Random[]],{30}]]; {n,a,c} = setal[p]; inverse = Interpolation[Transpose@{FoldList[Plus,0,p], Range[0,n]}, InterpolationOrder -> 0]; This generates a million observations twice: first using the Alias method, then using zero-order interpolation. In[4]:= samples = 1*^6; {First@Timing[x = Table[(If[Random[] > c[[#]], a[[#]],#]&)[Random[Integer,{1,n}]],{samples}]], Max@Abs[Count[x,#]&/@Range@n/samples-p]} {First@Timing[y = Table[inverse@Random[],{samples}]], Max@Abs[Count[y,#]&/@N@Range@n/samples-p]} Out[5]= {2.25 Second, 0.000504687} Out[6]= {6.35 Second, 0.000454016} The Alias method slows some when n is large, but only because Random[Integer,{1,n}] slows down. In[7]:= p = #/Tr@#&[Table[Log[Random[]],{300}]]; {n,a,c} = setal[p]; inverse = Interpolation[Transpose@{FoldList[Plus,0,p], Range[0,n]}, InterpolationOrder -> 0]; In[9]:= samples = 1*^6; {First@Timing[x = Table[(If[Random[] > c[[#]], a[[#]],#]&)[Random[Integer,{1,n}]],{samples}]], Max@Abs[Count[x,#]&/@Range@n/samples-p]} {First@Timing[y = Table[inverse@Random[],{samples}]], Max@Abs[Count[y,#]&/@N@Range@n/samples-p]} Out[10]= {3.62 Second, 0.000231153} Out[11]= {6.4 Second, 0.000240492} In both cases, the Alias times are overstated by ~.10 seconds; see my Aug 28 post Timing anomaly. === Subject: Re: Re: newbie is looking for a customDistribution function >> However, if you really want to use the distribution instead of the data >> that gave rise to it then you should look into the Alias Method of >> generating random observations from an arbitary discrete distribution. How would we look into that? Is that in the Mathematica help files, math books, what? Bobby >> [...] > Now, I would like to create a distribution function called > twocombsLstDistribution which I could call and it would give me back > elements of twocombs with the probability as they occur in distro, that > is for on average I would get twice as much {c,a}s as {d,a}s and never > get {d.c} or {d,d}. > How can I craft that ? > /Of course I need it for an arbitrary but finite length string lst over > a fixed length alphabet {a,b,c,d,....} for k-length elements of kcombs, > and it has to be super fast :). My real lst is between 30,000 and > 70,000 element long over a four element alphabet and I am looking for k > between 5 and a few hundred. / >> For a 4-element alphabet, kcombs will have 4^k terms. >> If k = a few hundred, kcombs will be too big. >> Why not just sort and count the k-sequences in the data? >> In[1]:= data = Table[Random[Integer,{1,4}],{100}] >> Out[1]= {2,4,3,3,3,4,3,2,3,3,1,3,2,2,4,1,4,4,4,1,2,3,3,4,1, >> 2,1,4,1,1,2,2,4,3,3,1,2,4,2,3,4,2,2,2,3,4,3,4,3,2, >> 2,3,3,3,1,3,3,1,3,1,1,1,1,4,2,2,3,4,2,4,3,4,3,1,4, >> 4,3,4,4,1,3,2,1,2,4,2,4,1,1,2,3,2,4,3,1,4,3,4,4,1} >> In[2]:= With[{k = 3}, Reverse /@ Reverse@Sort@Map[{Length[#],#[[1]]}&, >> Out[2]= {{434, 4}, {343, 4}, {331, 4}, {243, 4}, {441, 3}, {313, 3}, >> {234, 3}, {233, 3}, {223, 3}, {433, 2}, {432, 2}, {431, 2}, >> {424, 2}, {422, 2}, {412, 2}, {411, 2}, {344, 2}, {342, 2}, >> {334, 2}, {333, 2}, {322, 2}, {314, 2}, {242, 2}, {241, 2}, >> {224, 2}, {144, 2}, {132, 2}, {124, 2}, {123, 2}, {112, 2}, >> {111, 2}, {444, 1}, {443, 1}, {423, 1}, {414, 1}, {413, 1}, >> {341, 1}, {324, 1}, {323, 1}, {321, 1}, {312, 1}, {311, 1}, >> {232, 1}, {222, 1}, {214, 1}, {212, 1}, {143, 1}, {142, 1}, >> {141, 1}, {133, 1}, {131, 1}, {122, 1}, {121, 1}, {114, 1}} > Having read the other replies, I see that I missed your question, > which is how to generate a random observation from the distribution > of k-tuples in the observed data. By far the easiest way is to take > a random k-tuple from the original data: > Take[data,{1,k}+Random[Integer,Length@data-k]] > However, if you really want to use the distribution instead of the data > that gave rise to it then you should look into the Alias Method of > generating random observations from an arbitary discrete distribution. -- DrBob@bigfoot.com www.eclecticdreams.net === Subject: Re: newbie is looking for a customDistribution function > [...] >> Now, I would like to create a distribution function called >> twocombsLstDistribution which I could call and it would give me back >> elements of twocombs with the probability as they occur in distro, that >> is for on average I would get twice as much {c,a}s as {d,a}s and never >> get {d.c} or {d,d}. >> How can I craft that ? >> /Of course I need it for an arbitrary but finite length string lst over >> a fixed length alphabet {a,b,c,d,....} for k-length elements of kcombs, >> and it has to be super fast :). My real lst is between 30,000 and >> 70,000 element long over a four element alphabet and I am looking for k >> between 5 and a few hundred. / > For a 4-element alphabet, kcombs will have 4^k terms. > If k = a few hundred, kcombs will be too big. > Why not just sort and count the k-sequences in the data? > In[1]:= data = Table[Random[Integer,{1,4}],{100}] > Out[1]= {2,4,3,3,3,4,3,2,3,3,1,3,2,2,4,1,4,4,4,1,2,3,3,4,1, > 2,1,4,1,1,2,2,4,3,3,1,2,4,2,3,4,2,2,2,3,4,3,4,3,2, > 2,3,3,3,1,3,3,1,3,1,1,1,1,4,2,2,3,4,2,4,3,4,3,1,4, > 4,3,4,4,1,3,2,1,2,4,2,4,1,1,2,3,2,4,3,1,4,3,4,4,1} > In[2]:= With[{k = 3}, Reverse /@ Reverse@Sort@Map[{Length[#],#[[1]]}&, > Out[2]= {{434, 4}, {343, 4}, {331, 4}, {243, 4}, {441, 3}, {313, 3}, > {234, 3}, {233, 3}, {223, 3}, {433, 2}, {432, 2}, {431, 2}, > {424, 2}, {422, 2}, {412, 2}, {411, 2}, {344, 2}, {342, 2}, > {334, 2}, {333, 2}, {322, 2}, {314, 2}, {242, 2}, {241, 2}, > {224, 2}, {144, 2}, {132, 2}, {124, 2}, {123, 2}, {112, 2}, > {111, 2}, {444, 1}, {443, 1}, {423, 1}, {414, 1}, {413, 1}, > {341, 1}, {324, 1}, {323, 1}, {321, 1}, {312, 1}, {311, 1}, > {232, 1}, {222, 1}, {214, 1}, {212, 1}, {143, 1}, {142, 1}, > {141, 1}, {133, 1}, {131, 1}, {122, 1}, {121, 1}, {114, 1}} Having read the other replies, I see that I missed your question, which is how to generate a random observation from the distribution of k-tuples in the observed data. By far the easiest way is to take a random k-tuple from the original data: Take[data,{1,k}+Random[Integer,Length@data-k]] However, if you really want to use the distribution instead of the data that gave rise to it then you should look into the Alias Method of generating random observations from an arbitary discrete distribution. === Subject: Re: Re: newbie is looking for a customDistribution function amount of information by looking at the referenced material. It is amazing to see how much knowledge has been accumulated via this list. I will try all suggestions on the weekend. J.87nos >> I looked for it in the archives, but found none. > It is there at > Also see The Mathematica Journal 1(3): 57, which is referenced at this > link. Further comments are given below. >> I am looking for ways >> to create a custom distribution, which I can call as a function. Here >> is an example for illustration. Let's say I have a list created from >> a >> 4 elements alphabet {a,b,c,d}: >> In[1]:= >> lst={a,a,b,c,a,d,a,c,c,a} >> Out[1]= >> {a,a,b,c,a,d,a,c,c,a} >> combinations of {a,b,c,d} >> In[11]:= >> twocombs=Distribute[Table[{a,b,c,d},{2}],List] >> Out[11]= >> {{a,a},{a,b},{a,c},{a,d},{b,a},{b,b},{b,c},{b,d},{c,a},{c,b},{c,c},{c, >> d} >> ,{ >> d,a},{d,b},{d,c},{d,d}} >> I can count the occurrence of an element of twocombs in lst with the >> following function: >> occuranceCount[x_List] := Count[Partition[lst, 2, 1], x] >> Mapping this function over twocombs gives me the number of occurances >> of elements of twocombs in lst: >> In[12]:= >> distro=Map[occuranceCount,twocombs] >> Out[12]= >> {1,1,1,1,0,0,1,0,2,0,1,0,1,0,0,0} >> It shows that for example {c,a} occurs twice, {d,a} occurs once and >> {d,c} or {d,d} never occur. >> Now, I would like to create a distribution function called >> twocombsLstDistribution which I could call and it would give me back >> elements of twocombs with the probability as they occur in distro, >> that >> is for on average I would get twice as much {c,a}s as {d,a}s and never >> get {d.c} or {d,d}. >> How can I craft that ? > The idea of the code below is to count for how many symbols the > cumulative frequencies > cumfreq[x_List] := FoldList[Plus, First[x], Rest[x]]/Tr[x]; > are less than a fixed random number t in the range [0,1], and use the > number of hits as the index into the alphabet. > index[f_, r_] := Length[Select[f, r >= #1 & ]] + 1; > rand[x_List, cf_List] := x[[index[cf, Random[]]]] > For your distribution, > cf = cumfreq[distro] > here is a randome set of elements in twocombs with the probability as > they occur in distro. > Table[rand[twocombs, cf], {2000}]; > As a check we see that > Count[%, #] & /@ twocombs > looks fine. >> /Of course I need it for an arbitrary but finite length string lst >> over >> a fixed length alphabet {a,b,c,d,....} for k-length elements of >> kcombs, >> and it has to be super fast :). My real lst is between 30,000 and >> 70,000 element long over a four element alphabet and I am looking for >> k >> between 5 and a few hundred. / > Indexing using zeroth-order Interpolation is considerably faster (See > e.g., > int[distro_] := int[distro] = Interpolation[Transpose[ > { > Range[0, 1, 1/Tr[distro]], > Join[{1}, Flatten[MapIndexed[Table[First[#2], {#1}] & , distro]]] > } > ], InterpolationOrder -> 0] > If you compare > SeedRandom[1]; > Timing[test1 = Table[rand[twocombs, cf], {100000}];] > to > SeedRandom[1]; > Timing[test2 =Table[twocombs[[int[distro][Random[]]]],{100000}];] > you should find that test1 == test2 and that using int[distro] is about > 4 times faster. > Paul > -- > Paul Abbott Phone: +61 8 9380 2734 > School of Physics, M013 Fax: +61 8 9380 1014 > The University of Western Australia (CRICOS Provider No 00126G) > 35 Stirling Highway > Crawley WA 6009 mailto:paul@physics.uwa.edu.au > AUSTRALIA http://physics.uwa.edu.au/~paul ------------------------------------------------------------------- J.87nos L.9abb Yale University School of Medicine Department of Pathology Phone: 203-737-5204 Fax: 203-785-7303 E-mail: janos.lobb@yale.edu === Subject: Re: 5 variables Guass isnt working, matrix solution {5a - c - d - e == 0.5, 4b - c - e == 1, 6c - a - b - d - e == 1, 4d - a - c == 1, 5e - a - b - c == 1.5} // Solve {{a -> 0.413043, c -> 0.5, d -> 0.478261, b -> 0.521739, e -> 0.586957}} or {5a - c - d - e == 1/2, 4b - c - e == 1, 6c - a - b - d - e == 1, 4d - a - c == 1, 5e - a - b - c == 3/2} // Solve {{a -> 19/46, c -> 1/2, d -> 11/23, e -> 27/46, b -> 12/23}} Bobby > 5a-c-d-e =0.5 > 4b-c-e =1 > 6c-a-b-d-e=1 > 4d-a-c =1 > 5e-a-b-c =1.5 > Solve for a,b,c,d, and e. Guass inversion isnt working. > Maybe a matrix solution. -- DrBob@bigfoot.com www.eclecticdreams.net === Subject: 5 variables Guass isnt working, matrix solution 5a-c-d-e =0.5 4b-c-e =1 6c-a-b-d-e=1 4d-a-c =1 5e-a-b-c =1.5 Solve for a,b,c,d, and e. Guass inversion isnt working. Maybe a matrix solution. === Subject: Re: 5 variables Guass isnt working, matrix solution Roger, things normally don't work if you're not using correct Mathematica syntax. Using it there's no problem solving your set of equations with standard methods. Here we go 1) Your equations (notice: the * can be replaced by a space) In[10]:= eq1 = 5*a - c - d - e == 0.5; eq2 = 4*b - c - e == 1; eq3 = 6*c - a - b - d - e == 1; eq4 = 4*d - a - c == 1; eq5 = 5*e - a - b - c == 1.5; 2) more conveniently written as a list In[15]:= eq = {eq1, eq2, eq3, eq4, eq5} Out[15]= {5*a - c - d - e == 0.5, 4*b - c - e == 1, -a - b + 6*c - d - e == 1, -a - c + 4*d == 1, -a - b - c + 5*e == 1.5} 3) Now solving (and taking the first solution, btw. there is only one) In[16]:= s = First[Solve[eq]] Out[16]= {a -> 0.41304347826086957, c -> 0.5, d -> 0.47826086956521746, b -> 0.5217391304347826, e -> 0.5869565217391304} 4) Test if solution is correct eq /. s {True, True, True, True, True} ok. 5) The solution must also be rational. Here we go to get this representation In[21]:= Rationalize[s] Out[21]= {a -> 19/46, c -> 1/2, d -> 297089030890994/ 621186155499351, b -> 12/23, e -> 27/46} Wolfgang > 5a-c-d-e =0.5 > 4b-c-e =1 > 6c-a-b-d-e=1 > 4d-a-c =1 > 5e-a-b-c =1.5 > Solve for a,b,c,d, and e. Guass inversion isnt working. > Maybe a matrix solution. === Subject: Re: 5 variables Guass isnt working, matrix solution This does what you want: eqns = {5*a - c - d - e == 1/2, 4*b - c - e == 1, 6*c - a - b - d - e == 1, 4*d - a - c == 1, 5*e - a - b - c == 3/2} Solve[eqns, {a, b, c, d, e}] {{a -> 19/46, b -> 12/23, c -> 1/2, d -> 11/23, e -> 27/46}} Steve Luttrell > 5a-c-d-e =0.5 > 4b-c-e =1 > 6c-a-b-d-e=1 > 4d-a-c =1 > 5e-a-b-c =1.5 > Solve for a,b,c,d, and e. Guass inversion isnt working. > Maybe a matrix solution. === Subject: Re: 5 variables Guass isnt working, matrix solution eqns={ 5a-c-d-e==1/2, 4b-c-e==1, 6c-a-b-d-e==1, 4d-a-c==1, 5e-a-b-c==3/2}; soln = Solve[eqns, {a,b,c,d,e}]//Flatten {a -> 19/46, b -> 12/23, c -> 1/2, d -> 11/23, e -> 27/46} And @@ (eqns /. soln) True Bob Hanlon === > Subject: 5 variables Guass isnt working, matrix solution > 5a-c-d-e =0.5 > 4b-c-e =1 > 6c-a-b-d-e=1 > 4d-a-c =1 > 5e-a-b-c =1.5 > Solve for a,b,c,d, and e. Guass inversion isnt working. > Maybe a matrix solution. Bob Hanlon Chantilly, VA === Subject: Re: 5 variables Guass isnt working, matrix solution >5a-c-d-e =0.5 >4b-c-e =1 >6c-a-b-d-e=1 >4d-a-c =1 >5e-a-b-c =1.5 >Solve for a,b,c,d, and e. Guass inversion isnt working. Solve[{5*a - c - d - e == 0.5, 4*b - c - e == 1, 6*c - a - b - d - e == 1, 4*d - a - c == 1, 5*e - a - b - c == 1.5}, {a, b, c, d, e}] {{a -> 0.4130434782608696, b -> 0.5217391304347826, c -> 0.5000000000000001, d -> 0.4782608695652175, e -> 0.5869565217391305}} Works fine here. But note the use of Equal, == rather than Set, = -- To reply via email subtract one hundred and four === Subject: Re: 5 variables Guass isnt working, matrix solution Here's another solution: Clear[a, b, c, d, e] m = {5a - c - d - e == 1/2, 4b - c - e == 1, 6c - a - b - d - e == 1, 4d - a - c == 1, 5e - a - b - c == 3/2}; variables = Variables /@ m[[All, 1]] // Flatten // Union {a, b, c, d, e} MatrixForm[matrix = Outer[Coefficient, m[[All, 1]], variables]] MatrixForm[{{5, 0, -1, -1, -1}, {0, 4, -1, 0, -1}, {-1, -1, 6, -1, -1}, {-1, 0, -1, 4, 0}, {-1, -1, -1, 0, 5}}] MatrixForm[inverse = Inverse@matrix] MatrixForm[{{393/1610, 57/1610, 1/14, 127/1610, 113/1610}, {57/1610, 463/1610, 1/14, 43/1610, 127/1610}, {1/14, 1/14, 3/14, 1/14, 1/14}, {127/1610, 43/1610, 1/14, 463/1610, 57/1610}, {113/1610, 127/1610, 1/14, 57/1610, 393/1610}}] rhs = m[[All, -1]] {1/2, 1, 1, 1, 3/2} inverse.rhs {19/46, 12/23, 1/2, 11/23, 27/46} Bobby > How did you get 46 in the denominator? > Roger V. > 5a - c - d - e == 0.5, > 4b - c - e == 1, > 6c - a - b - d - e == 1, > 4d - a - c == 1, > 5e - a - b - c == 1.5} // Solve > {{a -> 0.413043, c -> 0.5, d -> 0.478261, b -> 0.521739, e -> 0.586957}} > or > {5a - c - d - e == 1/2, > 4b - c - e == 1, > 6c - a - b - d - e == 1, > 4d - a - c == 1, > 5e - a - b - c == 3/2} // Solve > {{a -> 19/46, c -> 1/2, > d -> 11/23, e -> 27/46, > b -> 12/23}} > Bobby >> 5a-c-d-e =0.5 >> 4b-c-e =1 >> 6c-a-b-d-e=1 >> 4d-a-c =1 >> 5e-a-b-c =1.5 >> Solve for a,b,c,d, and e. Guass inversion isnt working. >> Maybe a matrix solution. -- DrBob@bigfoot.com www.eclecticdreams.net === Subject: Re: 5 variables Guass isnt working, matrix solution As you can see, I hope, I didn't get anything in the denominator. Mathematica's Solve function did. Bobby > How did you get 46 in the denominator? > Roger V. > 5a - c - d - e == 0.5, > 4b - c - e == 1, > 6c - a - b - d - e == 1, > 4d - a - c == 1, > 5e - a - b - c == 1.5} // Solve > {{a -> 0.413043, c -> 0.5, d -> 0.478261, b -> 0.521739, e -> 0.586957}} > or > {5a - c - d - e == 1/2, > 4b - c - e == 1, > 6c - a - b - d - e == 1, > 4d - a - c == 1, > 5e - a - b - c == 3/2} // Solve > {{a -> 19/46, c -> 1/2, > d -> 11/23, e -> 27/46, > b -> 12/23}} > Bobby >> 5a-c-d-e =0.5 >> 4b-c-e =1 >> 6c-a-b-d-e=1 >> 4d-a-c =1 >> 5e-a-b-c =1.5 >> Solve for a,b,c,d, and e. Guass inversion isnt working. >> Maybe a matrix solution. -- DrBob@bigfoot.com www.eclecticdreams.net === Subject: RE: 5 variables Guass isnt working, matrix solution What's the problem? eqns = {5*a - c - d - e == 1/2, 4*b - c - e == 1, 6*c - a - b - d - e == 1, 4*d - a - c == 1, 5*e - a - b - c == 3/2}; Solve[eqns] {{a -> 19/46, c -> 1/2, d -> 11/23, e -> 27/46, b -> 12/23}} David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ 5a-c-d-e =0.5 4b-c-e =1 6c-a-b-d-e=1 4d-a-c =1 5e-a-b-c =1.5 Solve for a,b,c,d, and e. Guass inversion isnt working. Maybe a matrix solution. === Subject: Install Fix for Mathematica 5.0.1 Font on Linux Xorg/Fedora Core2 I've recently installed Mathematica 5.0.1 on a linux machine - RedHat Fedora Core 2 (with all updates) to be precise. It appears that the installation does not correctly work with the new linux font server which is based on Xorg rather than X11R86. This means certain cell types do not render their text at all making the help notebook almost unusable. For example, the section text How To Type ... in 2D Expression Input>Entering 2D expressions>Overview are not rendered as white spaces (though copy-paste works). - See the fonts section at: http://fedora.redhat.com/docs/release-notes/ My fix / hack for this was to add the following lines to the new linux font server configuration file: /etc/X11/fs/config /usr/local/Wolfram/Mathematica/5.0/SystemFiles/Fonts/Type1, /usr/local/Wolfram/Mathematica/5.0/SystemFiles/Fonts/Common/Type1:unscaled, /usr/local/Wolfram/Mathematica/5.0/SystemFiles/Fonts/AFM:unscaled, /usr/local/Wolfram/Mathematica/5.0/SystemFiles/Fonts/BDF:unscaled, ... and restart X windows ( you'll notice that /etc/init.d/xfs script does all the font re-hashing etc) If you open this as an install bug please CC me the correct solution that you find. For example - which of the above entries should be tagged with 'unscaled'? Lawrence Angrave. === Subject: expresion with variables from a list hello, I have what is probably a very easy question. I want to define an expression which has as as variables the elements of some previously defined list. like for example, if you have lists: list1 = {a, b} and list2 ={a, b, c} then I want to define an expression that can evaluate both the variables in list one and in list two that is: f[list_] := ..., which evaluates f[list1] = f[a_, b_] and f[list2] = f[x_,y_,z_]. this must be pausible in some way, not? thanx === Subject: Re: Inflight magazine puzzle I do get the gist of the algorithm, but the code isn't divided up into easily understood pieces as much as one might like. Nonetheless, I want to look at it more closely, eventually. At that point, I'll probably move the sub-squares condition up front to see what difference it makes, as you've suggested. Bobby > *This message was transferred with a trial version of CommuniGate(tm) Pro* > Bobby, > My algorithm is basically this: I begin by finding, by backtracking, > all ways of legally inserting 1 into the original puzzle. Legally > at this point means just respecting the Latin Square condition, > disregarding the sub-squares one. I then form all matrices that can > be obtained form the original matrix by inserting 1 s. Only at this > point I test for the sub-squares condition and select only those > matrices that satisfy it. I then proceed to apply the above procedure > to all these matrices, but with 2 instead of 1. > Clearly the most obvious source of inefficiency is that the sub-squares > condition is not tested immediately but only after the matrices > satisfying only the Latin square condition have been constructed. I > suspect a substantial speed up would be achieved by changing this. > However, there were two reasons why I decided not to do it. First, I > could not find an elegant way to test for the sub-squares condition > during the backtracking stage, an secondly I wanted t be able to > construct easily Latin squares without the rather artificial > sub-squares condition. I think my program should be a pretty > efficient Latin square constructor, or Latin Square completer. > I have been tempted to try to re-write my program to test for the > sub-squares condition during the backtracking stage, to see if doing > that will make it much faster (looking at the large number of > completions one gets without the sub-squares condition I think the > difference would be very substantial), but I really should be spending > my time doing something else so I will leave it at that. But if someone > else decided to re-write this algorithm along these lines I would be > very interested to know how it performed. > Andrzej >> Andrzej, >> That's interesting, but very hard to fathom! (For me, anyway.) >> On my machine, that method takes 0.359 seconds. >> I have a variation on my earlier naive solution that solves the >> problem in 0.016 seconds, but it can find only one solution at most >> and depends on some cell being fully determined at each stage. >> The following recursive solution has neither of those flaws and solves >> the original problem in 0.141 seconds. >> puzzle = {{Null, >> 3, Null, 9, Null, Null, Null, 8, Null}, {Null, Null, 6, 2, Null, 3, >> 7, 9, >> Null}, {Null, Null, >> Null, 1, Null, Null, Null, Null, Null}, {Null, 2, Null, 3, Null, >> Null, >> Null, 7, Null}, {Null, Null, Null, Null, 7, Null, Null, 6, 4}, >> {1, >> Null, Null, Null, Null, Null, Null, Null, Null}, { >> Null, 5, Null, Null, Null, 4, 9, Null, Null}, {Null, 7, 2, Null, >> Null, Null, Null, Null, Null}, { >> Null, 9, Null, Null, 5, Null, 8, 3, Null}} >> Clear[dependent, legal, step] >> subStart = 3Quotient[# - 1, 3] + 1 &; >> dependent computes (and saves) a list of the cells that cell {i,j} >> depends on--the matrix positions (not values) in the same row, column, >> or 3x3 subcell as {i,j}. >> dependent[{i_, j_}] := dependent[{i, j}] = Module[{row = subStart@i, >> col = subStart@j}, >> DeleteCases[Union@Join[Flatten[Table[{ii, jj}, {ii, row, >> row + 2}, {jj, col, col + 2}], 1], Distribute[{{i}, Range@9}, >> List], >> Distribute[{Range@9, {j}}, List]], {i, j}] >> ] >> legal[p] computes the values that currently are conceivable for a >> cell. It will be used only for Null cells. >> legal[p_]@{a_, b_} := >> Complement[Range@9, Flatten[p[[Sequence @@ #]] & /@ dependent@{a, >> b}]] >> step chooses a Null cell with the fewest legal choices, then calls >> itself for each choice. When it finds a solution, it uses Sow to give >> it to an enclosing Reap. >> step[p_?MatrixQ] := Module[{nulls = Position[p, Null, >> 2], legals, o, first, v}, >> If[nulls == {}, Sow@p, >> legals = legal[p]@# & /@ nulls; >> o = First@Ordering[Length /@ legals, 1]; >> first = nulls[[o]]; v = legals[[o]]; >> Scan[step@ReplacePart[p, #, first] &, v] >> ] >> ] >> Timing[result = First@Last@Reap[step@puzzle]] >> {0.141 Second, {{{2, 3, 5, 9, >> 6, 7, 4, 8, 1}, {8, 1, 6, 2, 4, 3, 7, 9, 5}, {7, 4, 9, 1, 8, >> 5, 6, 2, 3}, {5, 2, 4, 3, 9, 6, 1, 7, 8}, {9, 8, 3, 5, 7, >> 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {6, 5, 8, 7, 3, >> 4, 9, 1, 2}, {3, 7, 2, 8, 1, 9, 5, 4, 6}, {4, 9, 1, 6, 5, 2, 8, >> 3, 7}}}} >> For the original problem, there's only one choice at each call, but >> step will call itself 56 levels deep, nonetheless. Another solver >> could step in to save a lot of time when legals in the step function >> is a list of single choices (or contains several singletons). >> If I change 3 and 9 in the first row of the original problem to Nulls, >> here is the result (14 solutions): >> {3.719 Second, {{{2, 3, 5, 9, >> 6, 7, 4, 8, 1}, {8, 1, 6, 2, 4, 3, 7, 9, 5}, {7, 4, 9, 1, 8, >> 5, 6, 2, 3}, {5, 2, 4, 3, 9, 6, 1, 7, 8}, {9, 8, 3, 5, 7, >> 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {6, 5, 8, 7, 3, >> 4, 9, 1, 2}, {3, 7, 2, 8, 1, 9, 5, 4, 6}, {4, 9, 1, 6, 5, >> 2, 8, 3, 7}}, {{2, 1, 3, 5, 9, 7, 4, 8, 6}, {5, 8, 6, 2, 4, >> 3, 7, 9, 1}, {7, 4, 9, 1, 8, 6, 5, 2, 3}, {8, 2, 4, 3, 6, >> 5, 1, 7, 9}, {9, 3, 5, 8, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, >> 9, 3, 5, 8}, {6, 5, 8, 7, 3, 4, 9, 1, 2}, {3, 7, 2, 9, 1, >> 8, 6, 4, 5}, {4, 9, 1, 6, 5, 2, 8, 3, 7}}, {{2, 1, 3, 5, 9, >> 7, 4, 8, 6}, {5, 8, 6, 2, 4, 3, 7, 9, 1}, {7, 4, 9, 1, 8, >> 6, 5, 2, 3}, {9, 2, 4, 3, 6, 5, 1, 7, 8}, {8, 3, 5, 9, 7, >> 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {6, 5, 8, 7, 3, >> 4, 9, 1, 2}, {3, 7, 2, 8, 1, 9, 6, 4, 5}, {4, 9, 1, 6, 5, >> 2, 8, 3, 7}}, {{2, 1, 9, 5, 4, 7, 6, 8, 3}, {5, 4, 6, 2, 8, >> 3, 7, 9, 1}, {7, 3, 8, 1, 9, 6, 5, 4, 2}, {9, 2, 4, 3, 6, >> 5, 1, 7, 8}, {3, 8, 5, 9, 7, 1, 2, 6, 4}, {1, 6, 7, 4, >> 2, 8, 3, 5, 9}, {6, 5, 3, 8, 1, 4, 9, 2, 7}, {8, 7, 2, 6, >> 3, 9, 4, 1, 5}, {4, 9, 1, 7, >> 5, 2, 8, 3, 6}}, {{2, 1, 9, 5, 4, 7, 6, 8, 3}, {5, 4, 6, 2, >> 8, 3, 7, 9, 1}, {7, 3, 8, 1, 9, 6, 5, 4, 2}, {9, 2, 4, 3, 6, >> 5, 1, 7, 8}, {3, 8, 5, 9, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, >> 8, 3, 5, 9}, {8, 5, 3, 6, 1, 4, 9, 2, 7}, {6, 7, 2, 8, 3, >> 9, 4, 1, 5}, {4, 9, 1, 7, 5, 2, 8, 3, 6}}, {{2, 1, 9, 5, >> 4, 7, 6, 8, 3}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 3, 8, 1, >> 9, 6, 5, 4, 2}, {9, 2, 4, 3, 6, 5, 1, 7, 8}, {3, 8, 5, 9, >> 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {8, 5, 3, 7, >> 1, 4, 9, 2, 6}, {6, 7, 2, 8, 3, 9, 4, 1, 5}, {4, 9, 1, 6, >> 5, 2, 8, 3, 7}}, {{2, 1, 3, 5, 9, 7, 4, 8, 6}, {5, 4, 6, 2, >> 8, 3, 7, 9, 1}, {7, 8, 9, 1, 4, 6, 5, 2, 3}, {9, 2, 4, 3, 6, >> 5, 1, 7, 8}, {8, 3, 5, 9, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, >> 8, 3, 5, 9}, {6, 5, 8, 7, 3, 4, 9, 1, 2}, {3, 7, 2, 8, 1, >> 9, 6, 4, 5}, {4, 9, 1, 6, 5, 2, 8, 3, 7}}, {{2, 1, 9, 5, >> 4, 7, 6, 8, 3}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 8, 3, 1, >> 9, 6, 4, 2, 5}, {9, 2, 4, 3, 6, 5, 1, 7, 8}, {8, 3, 5, 9, >> 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {6, 5, 8, 7, >> 3, 4, 9, 1, 2}, {3, 7, 2, 8, >> 1, 9, 5, 4, 6}, {4, 9, 1, 6, 5, 2, 8, 3, 7}}, {{2, 1, 9, >> 5, 4, 7, 6, 8, 3}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 8, 3, 1, >> 9, 6, 5, 4, 2}, {9, 2, 4, 3, 6, 5, 1, 7, 8}, {8, 3, 5, 9, 7, >> 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {3, 5, 8, 6, 1, >> 4, 9, 2, 7}, {6, 7, 2, 8, 3, 9, 4, 1, 5}, {4, 9, 1, 7, 5, >> 2, 8, 3, 6}}, {{2, 1, 9, 5, 4, 7, 6, 8, 3}, {5, 4, 6, 2, >> 8, 3, 7, 9, 1}, {7, 8, 3, 1, 9, 6, 5, 4, 2}, {9, 2, 4, 3, >> 6, 5, 1, 7, 8}, {8, 3, 5, 9, 7, 1, 2, 6, 4}, {1, 6, 7, 4, >> 2, 8, 3, 5, 9}, {3, 5, 8, 7, 1, 4, 9, 2, 6}, {6, 7, 2, 8, >> 3, 9, 4, 1, 5}, {4, 9, 1, 6, 5, 2, 8, 3, 7}}, {{2, 1, 3, >> 5, 9, 7, 4, 8, 6}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 8, 9, 1, >> 4, 6, 5, 2, 3}, {8, 2, 4, 3, 6, 5, 1, 7, 9}, {9, 3, 5, >> 8, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 9, 3, 5, 8}, {6, 5, 8, 7, >> 3, 4, 9, 1, 2}, {3, 7, 2, 9, 1, 8, 6, 4, 5}, {4, 9, 1, 6, >> 5, 2, 8, 3, 7}}, {{2, 1, 9, 5, 4, 7, 6, 8, 3}, {5, 4, 6, >> 2, 8, 3, 7, 9, 1}, {7, 8, 3, 1, 9, 6, 4, 2, 5}, {8, 2, 4, >> 3, 6, 5, 1, 7, 9}, {9, 3, 5, 8, 7, 1, 2, 6, 4}, {1, 6, 7, >> 4, 2, 9, 3, 5, 8}, {6, 5, 8, 7, >> 3, 4, 9, 1, 2}, {3, 7, 2, 9, 1, 8, 5, 4, 6}, {4, 9, 1, 6, >> 5, 2, 8, 3, 7}}, {{2, 1, 9, 5, 4, 7, 6, 8, 3}, {5, 4, 6, >> 2, 8, 3, 7, 9, 1}, {7, 8, 3, 1, 9, 6, 5, 4, 2}, {8, 2, 4, 3, >> 6, 5, 1, 7, 9}, {9, 3, 5, 8, 7, 1, 2, 6, 4}, {1, 6, 7, 4, >> 2, 9, 3, 5, 8}, {3, 5, 8, 6, 1, 4, 9, 2, 7}, {6, 7, 2, 9, >> 3, 8, 4, 1, 5}, {4, 9, 1, 7, 5, 2, 8, 3, 6}}, {{2, 1, 9, 5, >> 4, 7, 6, 8, 3}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 8, 3, 1, >> 9, 6, 5, 4, 2}, {8, 2, 4, 3, 6, 5, 1, 7, 9}, {9, 3, 5, 8, >> 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 9, 3, 5, 8}, {3, 5, 8, 7, >> 1, 4, 9, 2, 6}, {6, 7, 2, 9, 3, 8, 4, 1, 5}, {4, 9, 1, 6, >> 5, 2, 8, 3, 7}}}} >> Bobby > Here is, I think, a complete solution. > In[1]:= > puzzle = {{Null, 3, Null, 9, Null, Null, Null, 8, Null}, > {Null, Null, 6, 2, Null, 3, 7, 9, Null}, > {Null, Null, Null, 1, Null, Null, Null, Null, Null}, > {Null, 2, Null, 3, Null, Null, Null, 7, Null}, > {Null, Null, Null, Null, 7, Null, Null, 6, 4}, > {1, Null, Null, Null, Null, Null, Null, Null, Null}, > {Null, 5, Null, Null, Null, 4, 9, Null, Null}, > {Null, 7, 2, Null, Null, Null, Null, Null, Null}, > {Null, 9, Null, Null, 5, Null, 8, 3, Null}}; > In[2]:= > f[0][(puzzle_)?MatrixQ, i_] := {{}}; > f[j_][(puzzle_)?MatrixQ, i_] := f[j][puzzle, i] = > Module[{ls = f[j - 1][puzzle, i], p}, > If[ !FreeQ[puzzle[[j,All]], i], > ls = (Append[#1, Null] & ) /@ ls, > FreeQ[puzzle[[All,k]], i], > p[k] = (Append[#1, k] & ) /@ Select[ls, > FreeQ[#1, k] & ], p[k] = Sequence[]], > {k, 1, 9}]; Flatten[Table[p[k], {k, 1, 9}], 1]]] > In[4]:= > g[(puzzle_)?MatrixQ, l_List, m_Integer] := > ReplacePart[puzzle, m, DeleteCases[ > Transpose[{Range[9], l}], {_, Null}]] > In[5]:= > TestPuzzle[puzzle_] := > And @@ (Length[Union[#1]] == Length[#1] & ) /@ > (Select[#1, NumericQ] & ) /@ Flatten /@ > Flatten[Partition[puzzle, {3, 3}], 1] > In[6]:= > GG[l_List, i_] := Select[Flatten[ > Apply[Function[x, g[#1, x, i]] /@ #2 & , > Transpose[{l, (f[9][#1, i] & ) /@ l}], {1}], 1], > TestPuzzle] > In[7]:= > MatrixForm /@ (sols = Fold[GG, {puzzle}, Range[9]]) > Out[7]= > {MatrixForm[{{2, 3, 5, 9, 6, 7, 4, 8, 1}, > {8, 1, 6, 2, 4, 3, 7, 9, 5}, {7, 4, 9, 1, 8, 5, 6, 2, > 3}, {5, 2, 4, 3, 9, 6, 1, 7, 8}, > {9, 8, 3, 5, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, > 9}, {6, 5, 8, 7, 3, 4, 9, 1, 2}, > {3, 7, 2, 8, 1, 9, 5, 4, 6}, {4, 9, 1, 6, 5, 2, 8, 3, > 7}}]} > It will solve any puzzle of this kind, that is with any partially > filled Latin square as a starting point. I don't think I can spend the > time on constructing an animation, but instead here is a brief > explanation of the code. > The function > f[j][puzzle, i] = > does the main work, that is essentially backtracking. Here puzzle > represents the starting matrix and i the number we are inserting into > puzzle. So the output of this will consists of all lists of j-elements > (l1,l2,...,lj) meaning that the number i should be inserted into > positions (1,l1), (2,l2) .... in the matrix as part of building of a > latin square, except when li is Null, which means that the number i is > not inserted into the row i, because it is already there in the > original matrix. > At this stage I ignore the sub-squares condition, although it might > be more efficient to use it already at the backtracking stage. > However, > I preferred to to apply it later (the function TestPuzzle). The > function f is used only with the first parameter 9, that is f[9][..], > this parameter only plays a role during backtracking. > The function > g[(puzzle, l, m] > takes as an argument a starting matrix, a list of the kind returned > above and and integer m, and it inserts the integer m into all the > positions in the matrix puzzle encoded in the list l. > the function TestPuzzle tests a solution for the sub-squares > condition. > The function GG combines all the above into a single function. The > answer is found by running > Fold[GG, {puzzle}, Range[9]] > Note also that if we remove the TestPuzzle condition we will find a > much larger set of all LatinSquares which extend the starting matrix. > I am sure the program can be improved in various ways and in > particular > written in a more elegant form, but I think I have already spent as > much time on this as I can afford. > It was another interesting exercise in backtracking. This time I > decided not to use the backtrack function from the Combinatorica > package although I am pretty sure a solution that uses this function > can be written, though probably would be slower. > Andrzej Kozlowski > Chiba, Japan > http://www.mimuw.edu.pl/~akoz/ >> *This message was transferred with a trial version of CommuniGate(tm) >> Pro* >> The following puzzle appeared in an AirCanada inflight magazine. It's >> not too hard to solve by hand, but I'd be interested to hear about >> clever solutions using Mathematica. What would be particularly nice >> would be to see an animation showing the steps (and possible >> back-tracking) towards the unique solution. I'd like to include the >> best >> solution(s) in an issue of The Mathematica Journal. >> >> Paul >> >> _____________________________________________________________________ >> __ >> _ >> In the diagram below (copy the Cell[...] below and paste into a >> Notebook, answering yes when it asks you if you want Mathematica to >> interpret it), place the numbers 1 through 9 so that each row, >> column, >> and 3 x 3 subsquare (separated by thick black lines) contains each >> number exactly once. >> >> Cell[BoxData[FormBox[RowBox[{RowBox[{puzzle, =, >> GridBox[{ >> { , 3, , 9, , , , 8, }, >> { , , 6, 2, , 3, 7, 9, }, >> { , , , 1, , , , , }, >> { , 2, , 3, , , , 7, }, >> { , , , , 7, , , 6, 4}, >> {1, , , , , , , , }, >> { , 5, , , , 4, 9, , }, >> { , 7, 2, , , , , , }, >> { , 9, , , 5, , 8, 3, }}]}], ;}], >> StandardForm]], Input, >> GridBoxOptions->{ >> GridFrame->True, >> RowLines->{0.25, 0.25, True, 0.25, 0.25, True, 0.25}, >> ColumnLines->{0.25, 0.25, True, 0.25, 0.25, True, 0.25} >> } >> ] >> >> -- >> Paul Abbott Phone: +61 8 9380 2734 >> School of Physics, M013 Fax: +61 8 9380 1014 >> The University of Western Australia (CRICOS Provider No 00126G) >> 35 Stirling Highway >> Crawley WA 6009 mailto:paul@physics.uwa.edu.au >> AUSTRALIA http://physics.uwa.edu.au/~paul >> >> >> -- >> DrBob@bigfoot.com >> www.eclecticdreams.net -- DrBob@bigfoot.com www.eclecticdreams.net === Subject: Re: Inflight magazine puzzle Bobby, My algorithm is basically this: I begin by finding, by backtracking, all ways of legally inserting 1 into the original puzzle. Legally at this point means just respecting the Latin Square condition, disregarding the sub-squares one. I then form all matrices that can be obtained form the original matrix by inserting 1 s. Only at this point I test for the sub-squares condition and select only those matrices that satisfy it. I then proceed to apply the above procedure to all these matrices, but with 2 instead of 1. Clearly the most obvious source of inefficiency is that the sub-squares condition is not tested immediately but only after the matrices satisfying only the Latin square condition have been constructed. I suspect a substantial speed up would be achieved by changing this. However, there were two reasons why I decided not to do it. First, I could not find an elegant way to test for the sub-squares condition during the backtracking stage, an secondly I wanted t be able to construct easily Latin squares without the rather artificial sub-squares condition. I think my program should be a pretty efficient Latin square constructor, or Latin Square completer. I have been tempted to try to re-write my program to test for the sub-squares condition during the backtracking stage, to see if doing that will make it much faster (looking at the large number of completions one gets without the sub-squares condition I think the difference would be very substantial), but I really should be spending my time doing something else so I will leave it at that. But if someone else decided to re-write this algorithm along these lines I would be very interested to know how it performed. Andrzej > Andrzej, > That's interesting, but very hard to fathom! (For me, anyway.) > On my machine, that method takes 0.359 seconds. > I have a variation on my earlier naive solution that solves the > problem in 0.016 seconds, but it can find only one solution at most > and depends on some cell being fully determined at each stage. > The following recursive solution has neither of those flaws and solves > the original problem in 0.141 seconds. > puzzle = {{Null, > 3, Null, 9, Null, Null, Null, 8, Null}, {Null, Null, 6, 2, Null, 3, > 7, 9, > Null}, {Null, Null, > Null, 1, Null, Null, Null, Null, Null}, {Null, 2, Null, 3, Null, > Null, > Null, 7, Null}, {Null, Null, Null, Null, 7, Null, Null, 6, 4}, > {1, > Null, Null, Null, Null, Null, Null, Null, Null}, { > Null, 5, Null, Null, Null, 4, 9, Null, Null}, {Null, 7, 2, Null, > Null, Null, Null, Null, Null}, { > Null, 9, Null, Null, 5, Null, 8, 3, Null}} > Clear[dependent, legal, step] > subStart = 3Quotient[# - 1, 3] + 1 &; > dependent computes (and saves) a list of the cells that cell {i,j} > depends on--the matrix positions (not values) in the same row, column, > or 3x3 subcell as {i,j}. > dependent[{i_, j_}] := dependent[{i, j}] = Module[{row = subStart@i, > col = subStart@j}, > DeleteCases[Union@Join[Flatten[Table[{ii, jj}, {ii, row, > row + 2}, {jj, col, col + 2}], 1], Distribute[{{i}, Range@9}, > List], > Distribute[{Range@9, {j}}, List]], {i, j}] > ] > legal[p] computes the values that currently are conceivable for a > cell. It will be used only for Null cells. > legal[p_]@{a_, b_} := > Complement[Range@9, Flatten[p[[Sequence @@ #]] & /@ dependent@{a, > b}]] > step chooses a Null cell with the fewest legal choices, then calls > itself for each choice. When it finds a solution, it uses Sow to give > it to an enclosing Reap. > step[p_?MatrixQ] := Module[{nulls = Position[p, Null, > 2], legals, o, first, v}, > If[nulls == {}, Sow@p, > legals = legal[p]@# & /@ nulls; > o = First@Ordering[Length /@ legals, 1]; > first = nulls[[o]]; v = legals[[o]]; > Scan[step@ReplacePart[p, #, first] &, v] > ] > ] > Timing[result = First@Last@Reap[step@puzzle]] > {0.141 Second, {{{2, 3, 5, 9, > 6, 7, 4, 8, 1}, {8, 1, 6, 2, 4, 3, 7, 9, 5}, {7, 4, 9, 1, 8, > 5, 6, 2, 3}, {5, 2, 4, 3, 9, 6, 1, 7, 8}, {9, 8, 3, 5, 7, > 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {6, 5, 8, 7, 3, > 4, 9, 1, 2}, {3, 7, 2, 8, 1, 9, 5, 4, 6}, {4, 9, 1, 6, 5, 2, 8, > 3, 7}}}} > For the original problem, there's only one choice at each call, but > step will call itself 56 levels deep, nonetheless. Another solver > could step in to save a lot of time when legals in the step function > is a list of single choices (or contains several singletons). > If I change 3 and 9 in the first row of the original problem to Nulls, > here is the result (14 solutions): > {3.719 Second, {{{2, 3, 5, 9, > 6, 7, 4, 8, 1}, {8, 1, 6, 2, 4, 3, 7, 9, 5}, {7, 4, 9, 1, 8, > 5, 6, 2, 3}, {5, 2, 4, 3, 9, 6, 1, 7, 8}, {9, 8, 3, 5, 7, > 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {6, 5, 8, 7, 3, > 4, 9, 1, 2}, {3, 7, 2, 8, 1, 9, 5, 4, 6}, {4, 9, 1, 6, 5, > 2, 8, 3, 7}}, {{2, 1, 3, 5, 9, 7, 4, 8, 6}, {5, 8, 6, 2, 4, > 3, 7, 9, 1}, {7, 4, 9, 1, 8, 6, 5, 2, 3}, {8, 2, 4, 3, 6, > 5, 1, 7, 9}, {9, 3, 5, 8, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, > 9, 3, 5, 8}, {6, 5, 8, 7, 3, 4, 9, 1, 2}, {3, 7, 2, 9, 1, > 8, 6, 4, 5}, {4, 9, 1, 6, 5, 2, 8, 3, 7}}, {{2, 1, 3, 5, 9, > 7, 4, 8, 6}, {5, 8, 6, 2, 4, 3, 7, 9, 1}, {7, 4, 9, 1, 8, > 6, 5, 2, 3}, {9, 2, 4, 3, 6, 5, 1, 7, 8}, {8, 3, 5, 9, 7, > 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {6, 5, 8, 7, 3, > 4, 9, 1, 2}, {3, 7, 2, 8, 1, 9, 6, 4, 5}, {4, 9, 1, 6, 5, > 2, 8, 3, 7}}, {{2, 1, 9, 5, 4, 7, 6, 8, 3}, {5, 4, 6, 2, 8, > 3, 7, 9, 1}, {7, 3, 8, 1, 9, 6, 5, 4, 2}, {9, 2, 4, 3, 6, > 5, 1, 7, 8}, {3, 8, 5, 9, 7, 1, 2, 6, 4}, {1, 6, 7, 4, > 2, 8, 3, 5, 9}, {6, 5, 3, 8, 1, 4, 9, 2, 7}, {8, 7, 2, 6, > 3, 9, 4, 1, 5}, {4, 9, 1, 7, > 5, 2, 8, 3, 6}}, {{2, 1, 9, 5, 4, 7, 6, 8, 3}, {5, 4, 6, 2, > 8, 3, 7, 9, 1}, {7, 3, 8, 1, 9, 6, 5, 4, 2}, {9, 2, 4, 3, 6, > 5, 1, 7, 8}, {3, 8, 5, 9, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, > 8, 3, 5, 9}, {8, 5, 3, 6, 1, 4, 9, 2, 7}, {6, 7, 2, 8, 3, > 9, 4, 1, 5}, {4, 9, 1, 7, 5, 2, 8, 3, 6}}, {{2, 1, 9, 5, > 4, 7, 6, 8, 3}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 3, 8, 1, > 9, 6, 5, 4, 2}, {9, 2, 4, 3, 6, 5, 1, 7, 8}, {3, 8, 5, 9, > 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {8, 5, 3, 7, > 1, 4, 9, 2, 6}, {6, 7, 2, 8, 3, 9, 4, 1, 5}, {4, 9, 1, 6, > 5, 2, 8, 3, 7}}, {{2, 1, 3, 5, 9, 7, 4, 8, 6}, {5, 4, 6, 2, > 8, 3, 7, 9, 1}, {7, 8, 9, 1, 4, 6, 5, 2, 3}, {9, 2, 4, 3, 6, > 5, 1, 7, 8}, {8, 3, 5, 9, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, > 8, 3, 5, 9}, {6, 5, 8, 7, 3, 4, 9, 1, 2}, {3, 7, 2, 8, 1, > 9, 6, 4, 5}, {4, 9, 1, 6, 5, 2, 8, 3, 7}}, {{2, 1, 9, 5, > 4, 7, 6, 8, 3}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 8, 3, 1, > 9, 6, 4, 2, 5}, {9, 2, 4, 3, 6, 5, 1, 7, 8}, {8, 3, 5, 9, > 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {6, 5, 8, 7, > 3, 4, 9, 1, 2}, {3, 7, 2, 8, > 1, 9, 5, 4, 6}, {4, 9, 1, 6, 5, 2, 8, 3, 7}}, {{2, 1, 9, > 5, 4, 7, 6, 8, 3}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 8, 3, 1, > 9, 6, 5, 4, 2}, {9, 2, 4, 3, 6, 5, 1, 7, 8}, {8, 3, 5, 9, 7, > 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {3, 5, 8, 6, 1, > 4, 9, 2, 7}, {6, 7, 2, 8, 3, 9, 4, 1, 5}, {4, 9, 1, 7, 5, > 2, 8, 3, 6}}, {{2, 1, 9, 5, 4, 7, 6, 8, 3}, {5, 4, 6, 2, > 8, 3, 7, 9, 1}, {7, 8, 3, 1, 9, 6, 5, 4, 2}, {9, 2, 4, 3, > 6, 5, 1, 7, 8}, {8, 3, 5, 9, 7, 1, 2, 6, 4}, {1, 6, 7, 4, > 2, 8, 3, 5, 9}, {3, 5, 8, 7, 1, 4, 9, 2, 6}, {6, 7, 2, 8, > 3, 9, 4, 1, 5}, {4, 9, 1, 6, 5, 2, 8, 3, 7}}, {{2, 1, 3, > 5, 9, 7, 4, 8, 6}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 8, 9, 1, > 4, 6, 5, 2, 3}, {8, 2, 4, 3, 6, 5, 1, 7, 9}, {9, 3, 5, > 8, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 9, 3, 5, 8}, {6, 5, 8, 7, > 3, 4, 9, 1, 2}, {3, 7, 2, 9, 1, 8, 6, 4, 5}, {4, 9, 1, 6, > 5, 2, 8, 3, 7}}, {{2, 1, 9, 5, 4, 7, 6, 8, 3}, {5, 4, 6, > 2, 8, 3, 7, 9, 1}, {7, 8, 3, 1, 9, 6, 4, 2, 5}, {8, 2, 4, > 3, 6, 5, 1, 7, 9}, {9, 3, 5, 8, 7, 1, 2, 6, 4}, {1, 6, 7, > 4, 2, 9, 3, 5, 8}, {6, 5, 8, 7, > 3, 4, 9, 1, 2}, {3, 7, 2, 9, 1, 8, 5, 4, 6}, {4, 9, 1, 6, > 5, 2, 8, 3, 7}}, {{2, 1, 9, 5, 4, 7, 6, 8, 3}, {5, 4, 6, > 2, 8, 3, 7, 9, 1}, {7, 8, 3, 1, 9, 6, 5, 4, 2}, {8, 2, 4, 3, > 6, 5, 1, 7, 9}, {9, 3, 5, 8, 7, 1, 2, 6, 4}, {1, 6, 7, 4, > 2, 9, 3, 5, 8}, {3, 5, 8, 6, 1, 4, 9, 2, 7}, {6, 7, 2, 9, > 3, 8, 4, 1, 5}, {4, 9, 1, 7, 5, 2, 8, 3, 6}}, {{2, 1, 9, 5, > 4, 7, 6, 8, 3}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 8, 3, 1, > 9, 6, 5, 4, 2}, {8, 2, 4, 3, 6, 5, 1, 7, 9}, {9, 3, 5, 8, > 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 9, 3, 5, 8}, {3, 5, 8, 7, > 1, 4, 9, 2, 6}, {6, 7, 2, 9, 3, 8, 4, 1, 5}, {4, 9, 1, 6, > 5, 2, 8, 3, 7}}}} > Bobby >> Here is, I think, a complete solution. >> In[1]:= >> puzzle = {{Null, 3, Null, 9, Null, Null, Null, 8, Null}, >> {Null, Null, 6, 2, Null, 3, 7, 9, Null}, >> {Null, Null, Null, 1, Null, Null, Null, Null, Null}, >> {Null, 2, Null, 3, Null, Null, Null, 7, Null}, >> {Null, Null, Null, Null, 7, Null, Null, 6, 4}, >> {1, Null, Null, Null, Null, Null, Null, Null, Null}, >> {Null, 5, Null, Null, Null, 4, 9, Null, Null}, >> {Null, 7, 2, Null, Null, Null, Null, Null, Null}, >> {Null, 9, Null, Null, 5, Null, 8, 3, Null}}; >> In[2]:= >> f[0][(puzzle_)?MatrixQ, i_] := {{}}; >> f[j_][(puzzle_)?MatrixQ, i_] := f[j][puzzle, i] = >> Module[{ls = f[j - 1][puzzle, i], p}, >> If[ !FreeQ[puzzle[[j,All]], i], >> ls = (Append[#1, Null] & ) /@ ls, >> FreeQ[puzzle[[All,k]], i], >> p[k] = (Append[#1, k] & ) /@ Select[ls, >> FreeQ[#1, k] & ], p[k] = Sequence[]], >> {k, 1, 9}]; Flatten[Table[p[k], {k, 1, 9}], 1]]] >> In[4]:= >> g[(puzzle_)?MatrixQ, l_List, m_Integer] := >> ReplacePart[puzzle, m, DeleteCases[ >> Transpose[{Range[9], l}], {_, Null}]] >> In[5]:= >> TestPuzzle[puzzle_] := >> And @@ (Length[Union[#1]] == Length[#1] & ) /@ >> (Select[#1, NumericQ] & ) /@ Flatten /@ >> Flatten[Partition[puzzle, {3, 3}], 1] >> In[6]:= >> GG[l_List, i_] := Select[Flatten[ >> Apply[Function[x, g[#1, x, i]] /@ #2 & , >> Transpose[{l, (f[9][#1, i] & ) /@ l}], {1}], 1], >> TestPuzzle] >> In[7]:= >> MatrixForm /@ (sols = Fold[GG, {puzzle}, Range[9]]) >> Out[7]= >> {MatrixForm[{{2, 3, 5, 9, 6, 7, 4, 8, 1}, >> {8, 1, 6, 2, 4, 3, 7, 9, 5}, {7, 4, 9, 1, 8, 5, 6, 2, >> 3}, {5, 2, 4, 3, 9, 6, 1, 7, 8}, >> {9, 8, 3, 5, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, >> 9}, {6, 5, 8, 7, 3, 4, 9, 1, 2}, >> {3, 7, 2, 8, 1, 9, 5, 4, 6}, {4, 9, 1, 6, 5, 2, 8, 3, >> 7}}]} >> It will solve any puzzle of this kind, that is with any partially >> filled Latin square as a starting point. I don't think I can spend the >> time on constructing an animation, but instead here is a brief >> explanation of the code. >> The function >> f[j][puzzle, i] = >> does the main work, that is essentially backtracking. Here puzzle >> represents the starting matrix and i the number we are inserting into >> puzzle. So the output of this will consists of all lists of j-elements >> (l1,l2,...,lj) meaning that the number i should be inserted into >> positions (1,l1), (2,l2) .... in the matrix as part of building of a >> latin square, except when li is Null, which means that the number i is >> not inserted into the row i, because it is already there in the >> original matrix. >> At this stage I ignore the sub-squares condition, although it might >> be more efficient to use it already at the backtracking stage. >> However, >> I preferred to to apply it later (the function TestPuzzle). The >> function f is used only with the first parameter 9, that is f[9][..], >> this parameter only plays a role during backtracking. >> The function >> g[(puzzle, l, m] >> takes as an argument a starting matrix, a list of the kind returned >> above and and integer m, and it inserts the integer m into all the >> positions in the matrix puzzle encoded in the list l. >> the function TestPuzzle tests a solution for the sub-squares >> condition. >> The function GG combines all the above into a single function. The >> answer is found by running >> Fold[GG, {puzzle}, Range[9]] >> Note also that if we remove the TestPuzzle condition we will find a >> much larger set of all LatinSquares which extend the starting matrix. >> I am sure the program can be improved in various ways and in >> particular >> written in a more elegant form, but I think I have already spent as >> much time on this as I can afford. >> It was another interesting exercise in backtracking. This time I >> decided not to use the backtrack function from the Combinatorica >> package although I am pretty sure a solution that uses this function >> can be written, though probably would be slower. >> Andrzej Kozlowski >> Chiba, Japan >> http://www.mimuw.edu.pl/~akoz/ > *This message was transferred with a trial version of CommuniGate(tm) > Pro* > The following puzzle appeared in an AirCanada inflight magazine. It's > not too hard to solve by hand, but I'd be interested to hear about > clever solutions using Mathematica. What would be particularly nice > would be to see an animation showing the steps (and possible > back-tracking) towards the unique solution. I'd like to include the > best > solution(s) in an issue of The Mathematica Journal. > Paul > _____________________________________________________________________ > __ > _ > In the diagram below (copy the Cell[...] below and paste into a > Notebook, answering yes when it asks you if you want Mathematica to > interpret it), place the numbers 1 through 9 so that each row, > column, > and 3 x 3 subsquare (separated by thick black lines) contains each > number exactly once. > Cell[BoxData[FormBox[RowBox[{RowBox[{puzzle, =, > GridBox[{ > { , 3, , 9, , , , 8, }, > { , , 6, 2, , 3, 7, 9, }, > { , , , 1, , , , , }, > { , 2, , 3, , , , 7, }, > { , , , , 7, , , 6, 4}, > {1, , , , , , , , }, > { , 5, , , , 4, 9, , }, > { , 7, 2, , , , , , }, > { , 9, , , 5, , 8, 3, }}]}], ;}], > StandardForm]], Input, > GridBoxOptions->{ > GridFrame->True, > RowLines->{0.25, 0.25, True, 0.25, 0.25, True, 0.25}, > ColumnLines->{0.25, 0.25, True, 0.25, 0.25, True, 0.25} > } > ] > -- > Paul Abbott Phone: +61 8 9380 2734 > School of Physics, M013 Fax: +61 8 9380 1014 > The University of Western Australia (CRICOS Provider No 00126G) > 35 Stirling Highway > Crawley WA 6009 mailto:paul@physics.uwa.edu.au > AUSTRALIA http://physics.uwa.edu.au/~paul > -- > DrBob@bigfoot.com > www.eclecticdreams.net === Subject: Re: Inflight magazine puzzle Andrzej, That's interesting, but very hard to fathom! (For me, anyway.) On my machine, that method takes 0.359 seconds. I have a variation on my earlier naive solution that solves the problem in 0.016 seconds, but it can find only one solution at most and depends on some cell being fully determined at each stage. The following recursive solution has neither of those flaws and solves the original problem in 0.141 seconds. puzzle = {{Null, 3, Null, 9, Null, Null, Null, 8, Null}, {Null, Null, 6, 2, Null, 3, 7, 9, Null}, {Null, Null, Null, 1, Null, Null, Null, Null, Null}, {Null, 2, Null, 3, Null, Null, Null, 7, Null}, {Null, Null, Null, Null, 7, Null, Null, 6, 4}, {1, Null, Null, Null, Null, Null, Null, Null, Null}, { Null, 5, Null, Null, Null, 4, 9, Null, Null}, {Null, 7, 2, Null, Null, Null, Null, Null, Null}, { Null, 9, Null, Null, 5, Null, 8, 3, Null}} Clear[dependent, legal, step] subStart = 3Quotient[# - 1, 3] + 1 &; dependent computes (and saves) a list of the cells that cell {i,j} depends on--the matrix positions (not values) in the same row, column, or 3x3 subcell as {i,j}. dependent[{i_, j_}] := dependent[{i, j}] = Module[{row = subStart@i, col = subStart@j}, DeleteCases[Union@Join[Flatten[Table[{ii, jj}, {ii, row, row + 2}, {jj, col, col + 2}], 1], Distribute[{{i}, Range@9}, List], Distribute[{Range@9, {j}}, List]], {i, j}] ] legal[p] computes the values that currently are conceivable for a cell. It will be used only for Null cells. legal[p_]@{a_, b_} := Complement[Range@9, Flatten[p[[Sequence @@ #]] & /@ dependent@{a, b}]] step chooses a Null cell with the fewest legal choices, then calls itself for each choice. When it finds a solution, it uses Sow to give it to an enclosing Reap. step[p_?MatrixQ] := Module[{nulls = Position[p, Null, 2], legals, o, first, v}, If[nulls == {}, Sow@p, legals = legal[p]@# & /@ nulls; o = First@Ordering[Length /@ legals, 1]; first = nulls[[o]]; v = legals[[o]]; Scan[step@ReplacePart[p, #, first] &, v] ] ] Timing[result = First@Last@Reap[step@puzzle]] {0.141 Second, {{{2, 3, 5, 9, 6, 7, 4, 8, 1}, {8, 1, 6, 2, 4, 3, 7, 9, 5}, {7, 4, 9, 1, 8, 5, 6, 2, 3}, {5, 2, 4, 3, 9, 6, 1, 7, 8}, {9, 8, 3, 5, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {6, 5, 8, 7, 3, 4, 9, 1, 2}, {3, 7, 2, 8, 1, 9, 5, 4, 6}, {4, 9, 1, 6, 5, 2, 8, 3, 7}}}} For the original problem, there's only one choice at each call, but step will call itself 56 levels deep, nonetheless. Another solver could step in to save a lot of time when legals in the step function is a list of single choices (or contains several singletons). If I change 3 and 9 in the first row of the original problem to Nulls, here is the result (14 solutions): {3.719 Second, {{{2, 3, 5, 9, 6, 7, 4, 8, 1}, {8, 1, 6, 2, 4, 3, 7, 9, 5}, {7, 4, 9, 1, 8, 5, 6, 2, 3}, {5, 2, 4, 3, 9, 6, 1, 7, 8}, {9, 8, 3, 5, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {6, 5, 8, 7, 3, 4, 9, 1, 2}, {3, 7, 2, 8, 1, 9, 5, 4, 6}, {4, 9, 1, 6, 5, 2, 8, 3, 7}}, {{2, 1, 3, 5, 9, 7, 4, 8, 6}, {5, 8, 6, 2, 4, 3, 7, 9, 1}, {7, 4, 9, 1, 8, 6, 5, 2, 3}, {8, 2, 4, 3, 6, 5, 1, 7, 9}, {9, 3, 5, 8, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 9, 3, 5, 8}, {6, 5, 8, 7, 3, 4, 9, 1, 2}, {3, 7, 2, 9, 1, 8, 6, 4, 5}, {4, 9, 1, 6, 5, 2, 8, 3, 7}}, {{2, 1, 3, 5, 9, 7, 4, 8, 6}, {5, 8, 6, 2, 4, 3, 7, 9, 1}, {7, 4, 9, 1, 8, 6, 5, 2, 3}, {9, 2, 4, 3, 6, 5, 1, 7, 8}, {8, 3, 5, 9, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {6, 5, 8, 7, 3, 4, 9, 1, 2}, {3, 7, 2, 8, 1, 9, 6, 4, 5}, {4, 9, 1, 6, 5, 2, 8, 3, 7}}, {{2, 1, 9, 5, 4, 7, 6, 8, 3}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 3, 8, 1, 9, 6, 5, 4, 2}, {9, 2, 4, 3, 6, 5, 1, 7, 8}, {3, 8, 5, 9, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {6, 5, 3, 8, 1, 4, 9, 2, 7}, {8, 7, 2, 6, 3, 9, 4, 1, 5}, {4, 9, 1, 7, 5, 2, 8, 3, 6}}, {{2, 1, 9, 5, 4, 7, 6, 8, 3}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 3, 8, 1, 9, 6, 5, 4, 2}, {9, 2, 4, 3, 6, 5, 1, 7, 8}, {3, 8, 5, 9, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {8, 5, 3, 6, 1, 4, 9, 2, 7}, {6, 7, 2, 8, 3, 9, 4, 1, 5}, {4, 9, 1, 7, 5, 2, 8, 3, 6}}, {{2, 1, 9, 5, 4, 7, 6, 8, 3}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 3, 8, 1, 9, 6, 5, 4, 2}, {9, 2, 4, 3, 6, 5, 1, 7, 8}, {3, 8, 5, 9, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {8, 5, 3, 7, 1, 4, 9, 2, 6}, {6, 7, 2, 8, 3, 9, 4, 1, 5}, {4, 9, 1, 6, 5, 2, 8, 3, 7}}, {{2, 1, 3, 5, 9, 7, 4, 8, 6}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 8, 9, 1, 4, 6, 5, 2, 3}, {9, 2, 4, 3, 6, 5, 1, 7, 8}, {8, 3, 5, 9, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {6, 5, 8, 7, 3, 4, 9, 1, 2}, {3, 7, 2, 8, 1, 9, 6, 4, 5}, {4, 9, 1, 6, 5, 2, 8, 3, 7}}, {{2, 1, 9, 5, 4, 7, 6, 8, 3}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 8, 3, 1, 9, 6, 4, 2, 5}, {9, 2, 4, 3, 6, 5, 1, 7, 8}, {8, 3, 5, 9, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {6, 5, 8, 7, 3, 4, 9, 1, 2}, {3, 7, 2, 8, 1, 9, 5, 4, 6}, {4, 9, 1, 6, 5, 2, 8, 3, 7}}, {{2, 1, 9, 5, 4, 7, 6, 8, 3}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 8, 3, 1, 9, 6, 5, 4, 2}, {9, 2, 4, 3, 6, 5, 1, 7, 8}, {8, 3, 5, 9, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {3, 5, 8, 6, 1, 4, 9, 2, 7}, {6, 7, 2, 8, 3, 9, 4, 1, 5}, {4, 9, 1, 7, 5, 2, 8, 3, 6}}, {{2, 1, 9, 5, 4, 7, 6, 8, 3}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 8, 3, 1, 9, 6, 5, 4, 2}, {9, 2, 4, 3, 6, 5, 1, 7, 8}, {8, 3, 5, 9, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {3, 5, 8, 7, 1, 4, 9, 2, 6}, {6, 7, 2, 8, 3, 9, 4, 1, 5}, {4, 9, 1, 6, 5, 2, 8, 3, 7}}, {{2, 1, 3, 5, 9, 7, 4, 8, 6}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 8, 9, 1, 4, 6, 5, 2, 3}, {8, 2, 4, 3, 6, 5, 1, 7, 9}, {9, 3, 5, 8, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 9, 3, 5, 8}, {6, 5, 8, 7, 3, 4, 9, 1, 2}, {3, 7, 2, 9, 1, 8, 6, 4, 5}, {4, 9, 1, 6, 5, 2, 8, 3, 7}}, {{2, 1, 9, 5, 4, 7, 6, 8, 3}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 8, 3, 1, 9, 6, 4, 2, 5}, {8, 2, 4, 3, 6, 5, 1, 7, 9}, {9, 3, 5, 8, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 9, 3, 5, 8}, {6, 5, 8, 7, 3, 4, 9, 1, 2}, {3, 7, 2, 9, 1, 8, 5, 4, 6}, {4, 9, 1, 6, 5, 2, 8, 3, 7}}, {{2, 1, 9, 5, 4, 7, 6, 8, 3}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 8, 3, 1, 9, 6, 5, 4, 2}, {8, 2, 4, 3, 6, 5, 1, 7, 9}, {9, 3, 5, 8, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 9, 3, 5, 8}, {3, 5, 8, 6, 1, 4, 9, 2, 7}, {6, 7, 2, 9, 3, 8, 4, 1, 5}, {4, 9, 1, 7, 5, 2, 8, 3, 6}}, {{2, 1, 9, 5, 4, 7, 6, 8, 3}, {5, 4, 6, 2, 8, 3, 7, 9, 1}, {7, 8, 3, 1, 9, 6, 5, 4, 2}, {8, 2, 4, 3, 6, 5, 1, 7, 9}, {9, 3, 5, 8, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 9, 3, 5, 8}, {3, 5, 8, 7, 1, 4, 9, 2, 6}, {6, 7, 2, 9, 3, 8, 4, 1, 5}, {4, 9, 1, 6, 5, 2, 8, 3, 7}}}} Bobby > Here is, I think, a complete solution. > In[1]:= > puzzle = {{Null, 3, Null, 9, Null, Null, Null, 8, Null}, > {Null, Null, 6, 2, Null, 3, 7, 9, Null}, > {Null, Null, Null, 1, Null, Null, Null, Null, Null}, > {Null, 2, Null, 3, Null, Null, Null, 7, Null}, > {Null, Null, Null, Null, 7, Null, Null, 6, 4}, > {1, Null, Null, Null, Null, Null, Null, Null, Null}, > {Null, 5, Null, Null, Null, 4, 9, Null, Null}, > {Null, 7, 2, Null, Null, Null, Null, Null, Null}, > {Null, 9, Null, Null, 5, Null, 8, 3, Null}}; > In[2]:= > f[0][(puzzle_)?MatrixQ, i_] := {{}}; > f[j_][(puzzle_)?MatrixQ, i_] := f[j][puzzle, i] = > Module[{ls = f[j - 1][puzzle, i], p}, > If[ !FreeQ[puzzle[[j,All]], i], > ls = (Append[#1, Null] & ) /@ ls, > FreeQ[puzzle[[All,k]], i], > p[k] = (Append[#1, k] & ) /@ Select[ls, > FreeQ[#1, k] & ], p[k] = Sequence[]], > {k, 1, 9}]; Flatten[Table[p[k], {k, 1, 9}], 1]]] > In[4]:= > g[(puzzle_)?MatrixQ, l_List, m_Integer] := > ReplacePart[puzzle, m, DeleteCases[ > Transpose[{Range[9], l}], {_, Null}]] > In[5]:= > TestPuzzle[puzzle_] := > And @@ (Length[Union[#1]] == Length[#1] & ) /@ > (Select[#1, NumericQ] & ) /@ Flatten /@ > Flatten[Partition[puzzle, {3, 3}], 1] > In[6]:= > GG[l_List, i_] := Select[Flatten[ > Apply[Function[x, g[#1, x, i]] /@ #2 & , > Transpose[{l, (f[9][#1, i] & ) /@ l}], {1}], 1], > TestPuzzle] > In[7]:= > MatrixForm /@ (sols = Fold[GG, {puzzle}, Range[9]]) > Out[7]= > {MatrixForm[{{2, 3, 5, 9, 6, 7, 4, 8, 1}, > {8, 1, 6, 2, 4, 3, 7, 9, 5}, {7, 4, 9, 1, 8, 5, 6, 2, > 3}, {5, 2, 4, 3, 9, 6, 1, 7, 8}, > {9, 8, 3, 5, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, > 9}, {6, 5, 8, 7, 3, 4, 9, 1, 2}, > {3, 7, 2, 8, 1, 9, 5, 4, 6}, {4, 9, 1, 6, 5, 2, 8, 3, > 7}}]} > It will solve any puzzle of this kind, that is with any partially > filled Latin square as a starting point. I don't think I can spend the > time on constructing an animation, but instead here is a brief > explanation of the code. > The function > f[j][puzzle, i] = > does the main work, that is essentially backtracking. Here puzzle > represents the starting matrix and i the number we are inserting into > puzzle. So the output of this will consists of all lists of j-elements > (l1,l2,...,lj) meaning that the number i should be inserted into > positions (1,l1), (2,l2) .... in the matrix as part of building of a > latin square, except when li is Null, which means that the number i is > not inserted into the row i, because it is already there in the > original matrix. > At this stage I ignore the sub-squares condition, although it might > be more efficient to use it already at the backtracking stage. However, > I preferred to to apply it later (the function TestPuzzle). The > function f is used only with the first parameter 9, that is f[9][..], > this parameter only plays a role during backtracking. > The function > g[(puzzle, l, m] > takes as an argument a starting matrix, a list of the kind returned > above and and integer m, and it inserts the integer m into all the > positions in the matrix puzzle encoded in the list l. > the function TestPuzzle tests a solution for the sub-squares > condition. > The function GG combines all the above into a single function. The > answer is found by running > Fold[GG, {puzzle}, Range[9]] > Note also that if we remove the TestPuzzle condition we will find a > much larger set of all LatinSquares which extend the starting matrix. > I am sure the program can be improved in various ways and in particular > written in a more elegant form, but I think I have already spent as > much time on this as I can afford. > It was another interesting exercise in backtracking. This time I > decided not to use the backtrack function from the Combinatorica > package although I am pretty sure a solution that uses this function > can be written, though probably would be slower. > Andrzej Kozlowski > Chiba, Japan > http://www.mimuw.edu.pl/~akoz/ >> *This message was transferred with a trial version of CommuniGate(tm) >> Pro* >> The following puzzle appeared in an AirCanada inflight magazine. It's >> not too hard to solve by hand, but I'd be interested to hear about >> clever solutions using Mathematica. What would be particularly nice >> would be to see an animation showing the steps (and possible >> back-tracking) towards the unique solution. I'd like to include the >> best >> solution(s) in an issue of The Mathematica Journal. >> Paul >> _______________________________________________________________________ >> _ >> In the diagram below (copy the Cell[...] below and paste into a >> Notebook, answering yes when it asks you if you want Mathematica to >> interpret it), place the numbers 1 through 9 so that each row, column, >> and 3 x 3 subsquare (separated by thick black lines) contains each >> number exactly once. >> Cell[BoxData[FormBox[RowBox[{RowBox[{puzzle, =, >> GridBox[{ >> { , 3, , 9, , , , 8, }, >> { , , 6, 2, , 3, 7, 9, }, >> { , , , 1, , , , , }, >> { , 2, , 3, , , , 7, }, >> { , , , , 7, , , 6, 4}, >> {1, , , , , , , , }, >> { , 5, , , , 4, 9, , }, >> { , 7, 2, , , , , , }, >> { , 9, , , 5, , 8, 3, }}]}], ;}], >> StandardForm]], Input, >> GridBoxOptions->{ >> GridFrame->True, >> RowLines->{0.25, 0.25, True, 0.25, 0.25, True, 0.25}, >> ColumnLines->{0.25, 0.25, True, 0.25, 0.25, True, 0.25} >> } >> ] >> -- >> Paul Abbott Phone: +61 8 9380 2734 >> School of Physics, M013 Fax: +61 8 9380 1014 >> The University of Western Australia (CRICOS Provider No 00126G) >> 35 Stirling Highway >> Crawley WA 6009 mailto:paul@physics.uwa.edu.au >> AUSTRALIA http://physics.uwa.edu.au/~paul -- DrBob@bigfoot.com www.eclecticdreams.net === Subject: Re: Inflight magazine puzzle Here is, I think, a complete solution. In[1]:= puzzle = {{Null, 3, Null, 9, Null, Null, Null, 8, Null}, {Null, Null, 6, 2, Null, 3, 7, 9, Null}, {Null, Null, Null, 1, Null, Null, Null, Null, Null}, {Null, 2, Null, 3, Null, Null, Null, 7, Null}, {Null, Null, Null, Null, 7, Null, Null, 6, 4}, {1, Null, Null, Null, Null, Null, Null, Null, Null}, {Null, 5, Null, Null, Null, 4, 9, Null, Null}, {Null, 7, 2, Null, Null, Null, Null, Null, Null}, {Null, 9, Null, Null, 5, Null, 8, 3, Null}}; In[2]:= f[0][(puzzle_)?MatrixQ, i_] := {{}}; f[j_][(puzzle_)?MatrixQ, i_] := f[j][puzzle, i] = Module[{ls = f[j - 1][puzzle, i], p}, If[ !FreeQ[puzzle[[j,All]], i], ls = (Append[#1, Null] & ) /@ ls, FreeQ[puzzle[[All,k]], i], p[k] = (Append[#1, k] & ) /@ Select[ls, FreeQ[#1, k] & ], p[k] = Sequence[]], {k, 1, 9}]; Flatten[Table[p[k], {k, 1, 9}], 1]]] In[4]:= g[(puzzle_)?MatrixQ, l_List, m_Integer] := ReplacePart[puzzle, m, DeleteCases[ Transpose[{Range[9], l}], {_, Null}]] In[5]:= TestPuzzle[puzzle_] := And @@ (Length[Union[#1]] == Length[#1] & ) /@ (Select[#1, NumericQ] & ) /@ Flatten /@ Flatten[Partition[puzzle, {3, 3}], 1] In[6]:= GG[l_List, i_] := Select[Flatten[ Apply[Function[x, g[#1, x, i]] /@ #2 & , Transpose[{l, (f[9][#1, i] & ) /@ l}], {1}], 1], TestPuzzle] In[7]:= MatrixForm /@ (sols = Fold[GG, {puzzle}, Range[9]]) Out[7]= {MatrixForm[{{2, 3, 5, 9, 6, 7, 4, 8, 1}, {8, 1, 6, 2, 4, 3, 7, 9, 5}, {7, 4, 9, 1, 8, 5, 6, 2, 3}, {5, 2, 4, 3, 9, 6, 1, 7, 8}, {9, 8, 3, 5, 7, 1, 2, 6, 4}, {1, 6, 7, 4, 2, 8, 3, 5, 9}, {6, 5, 8, 7, 3, 4, 9, 1, 2}, {3, 7, 2, 8, 1, 9, 5, 4, 6}, {4, 9, 1, 6, 5, 2, 8, 3, 7}}]} It will solve any puzzle of this kind, that is with any partially filled Latin square as a starting point. I don't think I can spend the time on constructing an animation, but instead here is a brief explanation of the code. The function f[j][puzzle, i] = does the main work, that is essentially backtracking. Here puzzle represents the starting matrix and i the number we are inserting into puzzle. So the output of this will consists of all lists of j-elements (l1,l2,...,lj) meaning that the number i should be inserted into positions (1,l1), (2,l2) .... in the matrix as part of building of a latin square, except when li is Null, which means that the number i is not inserted into the row i, because it is already there in the original matrix. At this stage I ignore the sub-squares condition, although it might be more efficient to use it already at the backtracking stage. However, I preferred to to apply it later (the function TestPuzzle). The function f is used only with the first parameter 9, that is f[9][..], this parameter only plays a role during backtracking. The function g[(puzzle, l, m] takes as an argument a starting matrix, a list of the kind returned above and and integer m, and it inserts the integer m into all the positions in the matrix puzzle encoded in the list l. the function TestPuzzle tests a solution for the sub-squares condition. The function GG combines all the above into a single function. The answer is found by running Fold[GG, {puzzle}, Range[9]] Note also that if we remove the TestPuzzle condition we will find a much larger set of all LatinSquares which extend the starting matrix. I am sure the program can be improved in various ways and in particular written in a more elegant form, but I think I have already spent as much time on this as I can afford. It was another interesting exercise in backtracking. This time I decided not to use the backtrack function from the Combinatorica package although I am pretty sure a solution that uses this function can be written, though probably would be slower. Andrzej Kozlowski Chiba, Japan http://www.mimuw.edu.pl/~akoz/ > *This message was transferred with a trial version of CommuniGate(tm) > Pro* > The following puzzle appeared in an AirCanada inflight magazine. It's > not too hard to solve by hand, but I'd be interested to hear about > clever solutions using Mathematica. What would be particularly nice > would be to see an animation showing the steps (and possible > back-tracking) towards the unique solution. I'd like to include the > best > solution(s) in an issue of The Mathematica Journal. > Paul > _______________________________________________________________________ > In the diagram below (copy the Cell[...] below and paste into a > Notebook, answering yes when it asks you if you want Mathematica to > interpret it), place the numbers 1 through 9 so that each row, column, > and 3 x 3 subsquare (separated by thick black lines) contains each > number exactly once. > Cell[BoxData[FormBox[RowBox[{RowBox[{puzzle, =, > GridBox[{ > { , 3, , 9, , , , 8, }, > { , , 6, 2, , 3, 7, 9, }, > { , , , 1, , , , , }, > { , 2, , 3, , , , 7, }, > { , , , , 7, , , 6, 4}, > {1, , , , , , , , }, > { , 5, , , , 4, 9, , }, > { , 7, 2, , , , , , }, > { , 9, , , 5, , 8, 3, }}]}], ;}], > StandardForm]], Input, > GridBoxOptions->{ > GridFrame->True, > RowLines->{0.25, 0.25, True, 0.25, 0.25, True, 0.25}, > ColumnLines->{0.25, 0.25, True, 0.25, 0.25, True, 0.25} > } > ] > -- > Paul Abbott Phone: +61 8 9380 2734 > School of Physics, M013 Fax: +61 8 9380 1014 > The University of Western Australia (CRICOS Provider No 00126G) > 35 Stirling Highway > Crawley WA 6009 mailto:paul@physics.uwa.edu.au > AUSTRALIA http://physics.uwa.edu.au/~paul === Subject: Re: HoldPattern & Pattern Matching > I don't understand the following behavior of Mathematica 4.2: > In[1]:= $Version > Out[1]= 4.2 for Linux (August 23, 2002) > In[2]:= mysum = h[a] - 7h[b] > Out[2]= h[a] - 7 h[b] > In[3]:= mysum /. HoldPattern[Plus[aaa : (_.*h[_]) ..]] :> aaa > Out[3]= h[a] - 7 h[b] > In[4]:= mysum /. HoldPattern[Plus[aaa : (_.*h[_]) ..]] :> aaa // Trace > Out[4]= {{mysum, h[a] - 7 h[b]}, >> h[a] - 7 h[b] /. HoldPattern[Plus[aaa:((_.) h[_]..)]] :> aaa, >> Plus[Sequence[h[a], -7 h[b]]], h[a] - 7 h[b]} > The pattern matching should work for an arbitrary number of terms, > that's why I used Repeated[...], i.e. the ... > I hoped to get Sequence[ h[a], -7 h[b] ]. I dont understand why > Sequence[...] is wrapped by Plus[...]. What did I miss? > Paul. This works: Replace[mysum,HoldPattern[Plus[aaa : (_.*h[_]) ..]] :> aaa] Sequence[h[a],-7 h[b]] The whole point lies inthe difference between Replace and ReplaceAll. Here is the documentation for ReplaceALl: ReplaceAll looks at each part of expr, tries all the rules on it, and then goes on to the next part of expr. The first rule that applies to a particular part is used; no further rules are tried on that part, or on any of its subparts. I hope this makes it clear. Andrzej Kozlowski Chiba, Japan http://www.mimuw.edu.pl/~akoz/ === Subject: HoldPattern & Pattern Matching I don't understand the following behavior of Mathematica 4.2: In[1]:= $Version Out[1]= 4.2 for Linux (August 23, 2002) In[2]:= mysum = h[a] - 7h[b] Out[2]= h[a] - 7 h[b] In[3]:= mysum /. HoldPattern[Plus[aaa : (_.*h[_]) ..]] :> aaa Out[3]= h[a] - 7 h[b] In[4]:= mysum /. HoldPattern[Plus[aaa : (_.*h[_]) ..]] :> aaa // Trace Out[4]= {{mysum, h[a] - 7 h[b]}, > h[a] - 7 h[b] /. HoldPattern[Plus[aaa:((_.) h[_]..)]] :> aaa, > Plus[Sequence[h[a], -7 h[b]]], h[a] - 7 h[b]} The pattern matching should work for an arbitrary number of terms, that's why I used Repeated[...], i.e. the ... I hoped to get Sequence[ h[a], -7 h[b] ]. I dont understand why Sequence[...] is wrapped by Plus[...]. What did I miss? Paul. === Subject: expresion with variables from a list hello, I have what is probably a very easy question. I want to define an expression which has as as variables the elements of some previously defined list. like for example, if you have lists: list1 = {a, b} and list2 ={a, b, c} then I want to define an expression that can evaluate both the variables in list one and in list two that is: f[list_] := ..., which evaluates f[list1] = f[a_, b_] and f[list2] = f[x_,y_,z_]. this must be pausible in some way, not? thanx === Subject: Re: expresion with variables from a list Just use the Apply command. list = {a, b, c}; f @@ list f[a, b, c] You could define f as a Function. f = Function[{x, y, z}, x Sin[y - z]]; f @@ list a Sin[b - c] David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ hello, I have what is probably a very easy question. I want to define an expression which has as as variables the elements of some previously defined list. like for example, if you have lists: list1 = {a, b} and list2 ={a, b, c} then I want to define an expression that can evaluate both the variables in list one and in list two that is: f[list_] := ..., which evaluates f[list1] = f[a_, b_] and f[list2] = f[x_,y_,z_]. this must be pausible in some way, not? thanx === Subject: Re: expresion with variables from a list f[x_List] := f[Sequence@@x]; list1 = {a, b}; list2 = {a, b, c}; f[list1] f(a,b) f[list2] f(a,b,c) Bob Hanlon === > Subject: expresion with variables from a list > hello, I have what is probably a very easy question. I want to define > an expression which has as as variables the elements of some > previously defined list. like for example, if you have lists: > list1 = {a, b} > and > list2 ={a, b, c} > then I want to define an expression that can evaluate both the > variables in list one and in list two that is: > f[list_] := ..., > which evaluates f[list1] = f[a_, b_] and f[list2] = f[x_,y_,z_]. > this must be pausible in some way, not? > thanx Bob Hanlon Chantilly, VA === Subject: MathML and WebMathematica Hi All, I haven't yet spent time on this, but am about to. A few questions: 1. Saving mathematica notebooks as html/mathml ... how good is it? 2. Is it better to produce web graphics from notebooks or expressions in another way? 3. Can someone give me a quick and dirty on webMathematica? How hard is it to talk to a kernel over a web connection? What is involved. Sorry for throwing these out, but sometimes it greatly helps to get ideas from others that have been down the path prior to jumping off the cliff yourself. Flip flip.(((((...at.)))))...nethere,,,,,,,,,,......com Take out all the weird symbols to email mail. === Subject: not a floating number , gptn complains... Hello group, I have a list that I import using list1 = Import[list1.txt, List] The text file just has numbers at own lines without any pucntuation marks. importing liek above forms a list. I wanted to then plot using Listplot and look at varuous stats such as variance std dev, mean, cv. etc etc. It works fine for some, except others I'm getting the following errors. Graphics::gptn: Coordinate 6.0562273076786985*^-6 in {174, 6.0562273076786985*^-6} is not a floating-point number. Graphics::gptn: Coordinate 2.863757626397791*^-6 in {209, 2.863757626397791*^-6} is not a floating-point number. Graphics::gptn: Coordinate 7.261053272010106*^-6 in {351, 7.261053272010106*^-6} is not a floating-point number. the lists are generated from evaluating NDSolve interpolating function at a time point. solve routien is repoeated over 5000 random values of a given parameters. Exact same method worked just fine last night. now it's seems to giving errors. what's going on here ? any thoughts will be thoroughly appreciated. sean === Subject: Re: expresion with variables from a list Hi You should define your function first, f = ........ Then f@@list1 f@@list2 Tun Myint Aung -----Original Message----- === Subject: expresion with variables from a list hello, I have what is probably a very easy question. I want to define an expression which has as as variables the elements of some previously defined list. like for example, if you have lists: list1 = {a, b} and list2 ={a, b, c} then I want to define an expression that can evaluate both the variables in list one and in list two that is: f[list_] := ..., which evaluates f[list1] = f[a_, b_] and f[list2] = f[x_,y_,z_]. this must be pausible in some way, not? thanx === Subject: Postscript Graphics in Header - Mathematica 5.0 Hello everybody, With Mathematica 4.1, I used PageHeaders to insert the logo of my company into my document printouts. I placed the logo as Postscript in an appropriate cell, like this: g = Graphics[{{RGBColor[0, 0, 1], Rectangle[{0, 0}, {0.9, 0.9}]}, RGBColor[1, 0, 0], Rectangle[{0.5, 0.5}, {1, 1}]}, ImageSize -> 72]; f = DisplayString[g]; SetOptions[EvaluationNotebook[], PageHeaders -> {{None, Cell[GraphicsData[PostScript, f], Graphics], None}, {None, Cell[GraphicsData[PostScript, f], Graphics], None}}] After Upgrading to Mathematica 5.0, this no longer works: Mathematica is crashing with an unknown software exception when I try to print the notebook. I'm using Mathematica 5.0 under Windows XP(German). Does anybody has a clue why this happens? Can anybody reproduce this bug? Peter === Subject: ParametricPlot and legends Hello. I am trying to put legends onto my ParametricPlot,but the PlotLegend option from the Legends package does not work. Is there any way of assigning Legendes without manually putting text and accompanying colored lines on the plot(similar to Plot and PlotLegend option)? Christopher Grinde === Subject: ColorFunctions again (making z=0 be different from z=1) The simple ColorFunction->Hue option in Plot3D, ContourPlot, and DensityPlot, makes z = 0 appear the same as z = 1 (i.e., both bright red), a situation which seems to me to make these plots confusing and more difficult to interpret, given that high peaks and sea level valleys may be the most interesting features of such a plot. Do others have any favorite, not too messy ColorFunctions that make values near z = 0 tend toward white, or grey, or less bright, or something so that there's a clearly unidirectional visual effect going from values of z near 0 to those near z = 1? [And as a side question, a simple Prolog or Epilog code to put one of those scaled and labelled vertical color bars alongside a ContourPlot or DensityPlot, perhaps with the same vertical height as the plot itself?] === Subject: plot thousands(?) of trajectories in single graph. hello group, I have a routein that solves a system of odes over a parameter space thousands of times while randomly varying the values. What I would like to do is take a variable and the resulting solutions(however many routine has generated over the course of evaluation) and plot them on single graph. So you will get rather messy graph, but nonetheless shows possible trajectories given system can yield. How do I go about doing this? I thought i could save the interpolating functions and then evaluate thousands at the end of a routine and show together. But How do I save the interpolating function? or do I plot with inside the module with DisplayFunction-> Identity and then save the plot and DisplayTogether the thousands of graphs at the end of the routine. if doing thousands isn't possible, is it possible to show hundreds of trajectories? sean code below is a example skeletal code for running hundred random solutions of an ode system. Do[ Module[{}, k1 = Random[Real, {1/10, 5/10}]; k2 = Random[Real, {1/20, 5/20}]; ndsolution = NDSolve[{a'[t] == -k1 a[t] x[t], b'[t] == -k2 b[t] y[t], x'[t] == -k1 a[t] x[t] + k2 b[t] y[t], y'[t] == k1 a[t] x[t] - k2 b[t] y[t], a[0] == 1, b[0] == 1, x[0] == 1, y[0] == 0},{a, b, x, y}, {t, 0, 250}][[1]]; Plot[Evaluate[{a[t], b[t], x[t], y[t]} /. ndsolution], {t, 0, 250}, PlotRange -> All, PlotStyle -> {{AbsoluteThickness[2], RGBColor[0, 0, 0]}, {AbsoluteThickness[2], RGBColor[.7, 0, 0]}, {AbsoluteThickness[2], RGBColor[0, .7, 0]}, {AbsoluteThickness[2], RGBColor[0, 0, .7]}}, Axes -> False, Frame -> True, PlotLabel -> StyleForm[A StyleForm[ B, FontColor -> RGBColor[.7, 0, 0]] StyleForm[ X, FontColor -> RGBColor[0, .7, 0]]StyleForm[ Y, FontColor -> RGBColor[0, 0, .7]], FontFamily -> Helvetica, FontWeight -> Bold]]; ] ,{i, 100}] _______________________________ Do you Yahoo!? Win 1 of 4,000 free domain names from Yahoo! Enter now. http://promotions.yahoo.com/goldrush === Subject: Re: Re: mathlink newbie q hi jens yes, there are c and cc files in the folder named src. there are 31 files total in that folder then there is also cvs and parsers folder. I have no workign knowledge of c/c++ maybe it;s not a good idea... I'm getting frustrated even before I begin. lol the files I recieved as directory tree does stochastic simulation of chemical networks. ( similar to gillespie's exact stochastic simulation algorithm) do you guys want to see it? I coudl email them to anyoen who wants to see it. as I have now more than on versions. --- Jens-Peer Kuska > get the free windows compilers form Borland or the > Watcom compiler > suite. The Borland Compilers are command line tools > and > Watcom has some kind of IDE. > AFAIK MathLink is not working with LCC-win32 > beside the header files *.h you need some c-files > *.c. *.cpp or > *.C (on unix machines) and you have to write a > Mathematica > Template and a C-function wrapper that take the > parameter > from Mathematica and send the results back (only in > very > simple cases the template is sufficient) > Jens > > hello group, > > I have some codes written in C and C++. > > Obviously, I do not understand them as I have > never taken C class. > But, since Mathematica is able to call programs > written in other languages, I > thought this may be the way I should use the > codes. ( even though I > don't understand the code in C/C++ ...) > > The codes were sent to me as a directory tree has > 22 h files in a > folder named Include > > Does this sound like something Mathematica can > handle using Mathlink, or do > you need more info to answer that? > > Do I need working installations of c/c++ compilers > etc etc? > > I have c(got it free from LCC-win32 website), but > I don't have c++. > > If I do need both compilers, does anyone know of > good free c++ install > files for windows? ( maybe with nice gui) > > sorry for newbie q. > > any insights will be thoroughly appreciated. > > sean __________________________________ Do you Yahoo!? New and Improved Yahoo! Mail - Send 10MB messages! http://promotions.yahoo.com/new_mail === Subject: Re: making contents and index Florian, A problem shared is a problem halved as they say. But, sadly, not a problem solved. If I crack it I'll let you know, but right now it looks as if I'll be spending Thursday night writing the Table of Contents by hand for a deadline on Friday. Mark Westwood > I noticed the possibility of using Author Tools for making the table of > contents and the index. > I have the following problems: > 1) In the table of contents, there are no numbering of titles, subtitles, > etc.., and I don't manage to have them... > 2) In the table of contents and in the index, the page numbers written > don't correspond to the real page-numbers of the print-out version of the > notebook. > If somebody has already encountered the problem and has found the solution, > I would be very thankful for any tips... > F.Jaccard