Subject: Re: Q: extract all k-tuple from a list of n elements Needs[DiscreteMath`Combinatorica`]; n=7; k=Random[Integer,{1,n}] KSubsets[Range[n], k] > list of n elements > (without considering permutations of the k-tuple)? > Example: For the special case k=3 one solution would be > Flatten[Table[{i, j, k}, {i, 1, n - 2}, {j, i + 1, n - 1}, {k, j + 1, > n}], 2]; > A generalization of this solution for all k >=1 would involve to create > 'automatically' a table of dimension k, but how can this be implemented? === Subject: Re: Long function defintions f[x_] := Module[{y,z,t,s}, y= Integrate[3s^2,{s,0,x}]; z= Integrate[4s^3,{s,0,x}]; t= Integrate[5s^4,{s,0,x}]; y+z+t]; f[x] x^5 + x^4 + x^3 > a bunch of > intermediate results. For example > f[x_] := > y = (Do some long integration) > z = (solve an ode which depends on the value of y) > t = (do another long integration) > assign (y + z + t) to f!!! > The idea is that a function is best read if it is broken up but the > parts are not important enough to be made into their own functions. === Subject: RE: Q: extract all k-tuple from a list of n elements Klaus, Is this what you are looking for? Needs[DiscreteMath`Combinatorica`]; 2-tuples from a set of 3 elements: KSubsets[{i, j, k}, 2] {{i, j}, {i, k}, {j, k}} 3-tuples from a set of 5 elements: KSubsets[{a, b, c, d, e}, 3] {{a, b, c}, {a, b, d}, {a, b, e}, {a, c, d}, {a, c, e}, {a, d, e}, {b, c, d}, {b, c, e}, {b, d, e}, {c, d, e}} David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ Question: How can I extract all k-tuple from a list of n elements (without considering permutations of the k-tuple)? Example: For the special case k=3 one solution would be Flatten[Table[{i, j, k}, {i, 1, n - 2}, {j, i + 1, n - 1}, {k, j + 1, n}], 2]; A generalization of this solution for all k >=1 would involve to create 'automatically' a table of dimension k, but how can this be implemented? Any help is appreciated. Klaus === Subject: about principal components analysis (PCA) Would any one please recommend some website or other material which talks about PCA? Most basicly, why it's only a linear method? What exactly is this method about? What's the limitation and advantage about it? etc. === Subject: Using Sum (i = 1 ... N) in a function definition I was trying to define a function using the Sum command in the following way (simplified example): MyData = {3,2,4,5,6}; MyFunc[i_] = Sum[MyData[[j]],{j,1,i}]; As you can see, the idea is to use the length of the list (i) as a variable in the function definition, such that MyFunc[1] = 3 MyFunc[2] = 3 + 2 = 5 MyFunc[3] = 3 + 2 + 4 = 9 etc. Mathematica does not like the abobe statements, and prints the following error message: Part specification K$394 is neither an integer nor a list of integers. Does anybody know how to define (correctly) such a function. Should be possible ...? Rainer === Subject: Launching the Mathematica interface via mathlink Is this possible? I have some code that interacts with a Mathematica kernal via mathlink. When it has finished, I'd like to fire up the Mathematica interface to allow my user to poke around in the results, draw graphs and so on. I know I could just invoke a Mathematica session from the command line, but how could I then gain access to this session via Mathlink to set up the appropriate variables? Any advice gratefully received, Peter === Subject: Re: Fibonacci[1,000,000,000] contains 208,987,640 decimal digits (was: Fibonachi[5,000,000] contains 1044938 decimal digits) > >>Several large Fibonacci numbers were calculated using only > >>the well-known explicit formula: > >> Fib (0) = 0, Fib (1) = 1, > >> Fib (n) = Fib (n-1) + Fib (n-2), n >= 2 > >>All the (decimal) digits of these numbers were obtained. > [...] > >>But to get ALL digits of the large Fibonacci number is very > advisable one. > [C++ code, snip] Impoved version of that algorithm can be seen at > Until now, the fastest way to get with Mathematica-alone all digits of > large Fibonacci numbers seems to be that of Roman Maeder: > ******************************************************** > fibmaeder[n_] := > Module[{r11 = 1, r12 = 0, r22 = 1, digits = IntegerDigits[n-1, 2], i, t}, > Do[ If[ digits[[i]] == 1, > {r11, r22} = {r11(r11 + 2r12), r12(r11 + r22)}; > r12 = r11 - r22 > , t = r12(r11 + r22); > {r11, r12} = {r11(r11 + 2r12) - t, t}; > r22 = r11 - r12 > ], > {i, Length[digits]-1} > ]; > If[ digits[[-1]] == 1, > r11(r11 + 2r12), > r11(r11 + r22) - (-1)^((n-1)/2) > ] > ] I would like to measure the comparative performance of my C++ algorithm and Mathematica-alone code above. However I have never worked with Mathematica-alone. How can I compare those algorithms? -- Alex Vinokur http://mathforum.org/library/view/10978.html http://sourceforge.net/users/alexvn === Subject: Re: DeleteCases : several at once, conditions How about if I want to delete repeating cases? Say I want to be left with a list of unique pairs from this list ll={{1, 3}, {1, 4}, {1, 5}, {1, 7}, {1, 8}, {1, 9}, {1, 9}, {1, 9}, { 1, 9}, {2, 3}, {2, 3}, {2, 5}, {2, 6}, {2, 7}, {3, 5}, {3, 6}, { 3, 7}, {3, 8}, {3, 9}, {3, 9}, { 3, 10}, {4, 6}, {4, 8}, {4, 8}, {4, 10}, {5, 7}, {5, 10}, {6, 7}, {6, 7}, {6, 7}, {6, 7}, {6, 8}, {6, 10}, {7, 8}, {7, 9}, {8, 10}, {8, 10}} TIA, again. === Subject: Re: Q: extract all k-tuple from a list of n elements > Question: How can I extract all k-tuple from a list of n elements > (without considering permutations of the k-tuple)? > Example: For the special case k=3 one solution would be > Flatten[Table[{i, j, k}, {i, 1, n - 2}, {j, i + 1, n - 1}, {k, j + 1, > n}], 2]; > A generalization of this solution for all k >=1 would involve to create > 'automatically' a table of dimension k, but how can this be implemented? In[1]:= subsets[n_,k_] := ToExpression[Flatten[Table[ <> ToString[Table[i<>ToString[j],{j,k}]] <> Table[ , {i<>ToString[j] <> If[j==1, ,, ,i<>ToString[j-1]<>+1,] <> ToString[n+j-k] <> }, {j,k}] <> ], <> ToString[k-1] <> ]] In[2]:= subsets[5,3] Out[2]= {{1, 2, 3}, {1, 2, 4}, {1, 2, 5}, {1, 3, 4}, {1, 3, 5}, {1, 4, 5}, {2, 3, 4}, {2, 3, 5}, {2, 4, 5}, {3, 4, 5}} === Subject: Re: extract all k-tuple from a list of n elements Here is an example of what you can do: << DiscreteMath`Combinatorica` With[{n = 4, k = 3}, KSubsets[Range[n], k]] Steve Luttrell > Question: How can I extract all k-tuple from a list of n elements > (without considering permutations of the k-tuple)? > Example: For the special case k=3 one solution would be > Flatten[Table[{i, j, k}, {i, 1, n - 2}, {j, i + 1, n - 1}, {k, j + 1, > n}], 2]; > A generalization of this solution for all k >=1 would involve to create > 'automatically' a table of dimension k, but how can this be implemented? > Any help is appreciated. > Klaus === Subject: Re: Q: extract all k-tuple from a list of n elements > Question: How can I extract all k-tuple from a list of n elements > (without considering permutations of the k-tuple)? > Example: For the special case k=3 one solution would be > Flatten[Table[{i, j, k}, {i, 1, n - 2}, {j, i + 1, n - 1}, {k, j + 1, > n}], 2]; > A generalization of this solution for all k >=1 would involve to create > 'automatically' a table of dimension k, but how can this be implemented? > Any help is appreciated. > Klaus -- A colleague of mine gave me this recursive solution (seems rather cryptic but it works) : tuple[k_Integer /; k>1]:= tuple[k]= Union[Sort /@ ((Function[{x},{Sequence@@First[x],#}& /@ Last[x]] /@ ({#,DeleteCases[tuple[1],Alternatives@@#]}& /@ tuple[k-1])) //Flatten[#,1]&)] test : tuple[1]={a,b,c,d,e}; tuple[3] {{a,b,c},{a,b,d},{a,b,e},{a,c,d},{a,c,e},{a,d,e},{b,c,d},{b,c,e},{b,d,e},{c, d, e}} hth v.a. -- 0% de pub! Que du bonheur et des vrais adh.8erents ! Vous aussi inscrivez-vous sans plus tarder!! Message post.8e .88 partir de http://www.gyptis.org, BBS actif depuis 1995. === Subject: Combinations Hello everyone, Does Mathematica have a built-in function that will generate a simple list all possible combinations of a list of strings? For example, {a,b,c}, where the elements are strings, should give 3x3=27 triplets of aaa, aba, etc. I tried In[4]:=Outer[{a,b,c},{a,b,c},{a,b,c}] but I get {{{a, b, c}[a, a], {a, b, c}[a, b], { a, b, c}[a, c]}, {{a, b, c}[b, a], {a, b, c}[b, b], {a, b, c}[b, c]}, {{a, b, c}[c, a], {a, b, c}[c, b], {a, b, c}[c, c]}} which is going to be difficult to match with my data using BinCounts and the like. Greg === Subject: Odd result from Sum Here is an odd result from Sum. I tried to do the infinite sum below in version 5. Notice the result contains System`HypergeometricDump`k and System`HypergeometricDump`k^2. I get the same answer under both OS X and Windows EXP. Does anyone know what is going on? In[293]:= Sum[(-1)^n*((2*n + 1)/ (z^2 + n*((n + 1)/2))), {n, 0, Infinity}] Out[293]= -(((-1 + Sqrt[1 - 8*z^2])* (1 + Sqrt[1 - 8*z^2]))/ (8*z^2*(System`Hypergeome tricDump`k + System`HypergeometricDu mp`k^2 + 2*z^2))) + (1/Sqrt[1 - 8*z^2])* ((-1 + Sqrt[1 - 8*z^2])* PolyGamma[0, 3/4 - (1/4)*Sqrt[1 - 8*z^2]] - (-1 + Sqrt[1 - 8*z^2])* PolyGamma[0, 5/4 - (1/4)*Sqrt[1 - 8*z^2]] + (1 + Sqrt[1 - 8*z^2])* (PolyGamma[0, (1/4)* (3 + Sqrt[1 - 8*z^2])] - PolyGamma[0, (1/4)* (5 + Sqrt[1 - 8*z^2])])) === Subject: Re: Slow LinearSolve. > Within 24 hours and counting, Mathematica was not able to solve Ax = b for > the following A and the following B. Another system does this in a matter of seconds. > How do me Mathematica do the same? I use LinearSolve[A, b] > A = {{1, -I, -1, I, 1, -I, -1, I, 1, -I, -1, I, 1}, {1, E^(((-5*I)/12)*Pi), > E^(((-5*I)/6)*Pi), > E^(((3*I)/4)*Pi), E^((I/3)*Pi), E^((-I/12)*Pi), -I, E^(((-11*I)/12)*Pi), > E^(((2*I)/3)*Pi), > E^((I/4)*Pi), E^((-I/6)*Pi), E^(((-7*I)/12)*Pi), -1}, > {1, E^((-I/3)*Pi), E^(((-2*I)/3)*Pi), -1, E^(((2*I)/3)*Pi), E^((I/3)*Pi), 1, > E^((-I/3)*Pi), > E^(((-2*I)/3)*Pi), -1, E^(((2*I)/3)*Pi), E^((I/3)*Pi), 1}, > {1, E^((-I/4)*Pi), -I, E^(((-3*I)/4)*Pi), -1, E^(((3*I)/4)*Pi), I, > E^((I/4)*Pi), 1, > E^((-I/4)*Pi), -I, E^(((-3*I)/4)*Pi), -1}, {1, E^((-I/6)*Pi), > E^((-I/3)*Pi), -I, > E^(((-2*I)/3)*Pi), E^(((-5*I)/6)*Pi), -1, E^(((5*I)/6)*Pi), > E^(((2*I)/3)*Pi), I, > E^((I/3)*Pi), E^((I/6)*Pi), 1}, {1, E^((-I/12)*Pi), E^((-I/6)*Pi), > E^((-I/4)*Pi), > E^((-I/3)*Pi), E^(((-5*I)/12)*Pi), -I, E^(((-7*I)/12)*Pi), > E^(((-2*I)/3)*Pi), > E^(((-3*I)/4)*Pi), E^(((-5*I)/6)*Pi), E^(((-11*I)/12)*Pi), -1}, > {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, {1, E^((I/12)*Pi), E^((I/6)*Pi), > E^((I/4)*Pi), > E^((I/3)*Pi), E^(((5*I)/12)*Pi), I, E^(((7*I)/12)*Pi), E^(((2*I)/3)*Pi), > E^(((3*I)/4)*Pi), > E^(((5*I)/6)*Pi), E^(((11*I)/12)*Pi), -1}, {1, E^((I/6)*Pi), E^((I/3)*Pi), > I, > E^(((2*I)/3)*Pi), E^(((5*I)/6)*Pi), -1, E^(((-5*I)/6)*Pi), > E^(((-2*I)/3)*Pi), -I, > E^((-I/3)*Pi), E^((-I/6)*Pi), 1}, {1, E^((I/4)*Pi), I, E^(((3*I)/4)*Pi), -1, > E^(((-3*I)/4)*Pi), -I, E^((-I/4)*Pi), 1, E^((I/4)*Pi), I, > E^(((3*I)/4)*Pi), -1}, > {1, E^((I/3)*Pi), E^(((2*I)/3)*Pi), -1, E^(((-2*I)/3)*Pi), E^((-I/3)*Pi), 1, > E^((I/3)*Pi), > E^(((2*I)/3)*Pi), -1, E^(((-2*I)/3)*Pi), E^((-I/3)*Pi), 1}, > {1, E^(((5*I)/12)*Pi), E^(((5*I)/6)*Pi), E^(((-3*I)/4)*Pi), E^((-I/3)*Pi), > E^((I/12)*Pi), I, > E^(((11*I)/12)*Pi), E^(((-2*I)/3)*Pi), E^((-I/4)*Pi), E^((I/6)*Pi), > E^(((7*I)/12)*Pi), -1}, > {1, I, -1, -I, 1, I, -1, -I, 1, I, -1, -I, 1}} > b = {0, (-2*I)/5, 0, (-2*I)/3, 0, -2*I, Pi, 2*I, 0, (2*I)/3, 0, (2*I)/5, 0} Try it as below. The result is large. Offhand I do not know whether it can or should simplify to a nice small form. Timing[ls = LinearSolve[A, b, Method->OneStepRowReduction];] Daniel Lichtblau Wolfram Research === Subject: Re: Slow LinearSolve. In this case it helps to specify the solution method. LinearSolve[A,b,Method->OneStepRowReduction] solves the system in about 10 seconds on my machine(Mac OS 10.3.4, dual You are asking Mathematica for an exact solution. Is this what you intended? The (unsimplified) output generated a pdf file of more than 1000 pages before I killed the process. This hardly seems useful. If you could be content with machine precision floating point try LinearSolve[N[A],N[b]] Which tes 0.01 seconds on my machine. > Within 24 hours and counting, Mathematica was not able to solve Ax = > b for > the following A and the following B. Another system does this in a > matter of seconds. > How do me Mathematica do the same? I use LinearSolve[A, b] > A = {{1, -I, -1, I, 1, -I, -1, I, 1, -I, -1, I, 1}, {1, > E^(((-5*I)/12)*Pi), > E^(((-5*I)/6)*Pi), > E^(((3*I)/4)*Pi), E^((I/3)*Pi), E^((-I/12)*Pi), -I, > E^(((-11*I)/12)*Pi), > E^(((2*I)/3)*Pi), > E^((I/4)*Pi), E^((-I/6)*Pi), E^(((-7*I)/12)*Pi), -1}, > {1, E^((-I/3)*Pi), E^(((-2*I)/3)*Pi), -1, E^(((2*I)/3)*Pi), > E^((I/3)*Pi), 1, > E^((-I/3)*Pi), > E^(((-2*I)/3)*Pi), -1, E^(((2*I)/3)*Pi), E^((I/3)*Pi), 1}, > {1, E^((-I/4)*Pi), -I, E^(((-3*I)/4)*Pi), -1, E^(((3*I)/4)*Pi), I, > E^((I/4)*Pi), 1, > E^((-I/4)*Pi), -I, E^(((-3*I)/4)*Pi), -1}, {1, E^((-I/6)*Pi), > E^((-I/3)*Pi), -I, > E^(((-2*I)/3)*Pi), E^(((-5*I)/6)*Pi), -1, E^(((5*I)/6)*Pi), > E^(((2*I)/3)*Pi), I, > E^((I/3)*Pi), E^((I/6)*Pi), 1}, {1, E^((-I/12)*Pi), E^((-I/6)*Pi), > E^((-I/4)*Pi), > E^((-I/3)*Pi), E^(((-5*I)/12)*Pi), -I, E^(((-7*I)/12)*Pi), > E^(((-2*I)/3)*Pi), > E^(((-3*I)/4)*Pi), E^(((-5*I)/6)*Pi), E^(((-11*I)/12)*Pi), -1}, > {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, {1, E^((I/12)*Pi), > E^((I/6)*Pi), > E^((I/4)*Pi), > E^((I/3)*Pi), E^(((5*I)/12)*Pi), I, E^(((7*I)/12)*Pi), > E^(((2*I)/3)*Pi), > E^(((3*I)/4)*Pi), > E^(((5*I)/6)*Pi), E^(((11*I)/12)*Pi), -1}, {1, E^((I/6)*Pi), > E^((I/3)*Pi), > I, > E^(((2*I)/3)*Pi), E^(((5*I)/6)*Pi), -1, E^(((-5*I)/6)*Pi), > E^(((-2*I)/3)*Pi), -I, > E^((-I/3)*Pi), E^((-I/6)*Pi), 1}, {1, E^((I/4)*Pi), I, > E^(((3*I)/4)*Pi), -1, > E^(((-3*I)/4)*Pi), -I, E^((-I/4)*Pi), 1, E^((I/4)*Pi), I, > E^(((3*I)/4)*Pi), -1}, > {1, E^((I/3)*Pi), E^(((2*I)/3)*Pi), -1, E^(((-2*I)/3)*Pi), > E^((-I/3)*Pi), 1, > E^((I/3)*Pi), > E^(((2*I)/3)*Pi), -1, E^(((-2*I)/3)*Pi), E^((-I/3)*Pi), 1}, > {1, E^(((5*I)/12)*Pi), E^(((5*I)/6)*Pi), E^(((-3*I)/4)*Pi), > E^((-I/3)*Pi), > E^((I/12)*Pi), I, > E^(((11*I)/12)*Pi), E^(((-2*I)/3)*Pi), E^((-I/4)*Pi), E^((I/6)*Pi), > E^(((7*I)/12)*Pi), -1}, > {1, I, -1, -I, 1, I, -1, -I, 1, I, -1, -I, 1}} > b = {0, (-2*I)/5, 0, (-2*I)/3, 0, -2*I, Pi, 2*I, 0, (2*I)/3, 0, > (2*I)/5, 0} Garry Helzer gah@math.umd.edu === Subject: Re: Slow LinearSolve. Hi , Try entering the problem as LinearSolve[N[A],N[b]]. The reason it tes for ever, is that your matrices consist of exact numbers i.e. e, I, Pi and Mathematica tries to give you an exact i.e. symbolic result. That will te for ever since the symbolic solutions of linear systems is computationally expensive. If you only want numberical answers, simply ask for them by prefacing the matrices with N[]; then they will converted to Floating Point and evaluated numerically FAST as the following shows (Math4.2 XP Pro Intel@3.0GHz HT 4 GB DDR) In[8]:= Timing[Table[LinearSolve[N[A],N[b]],{1000}];] Out[8]= {0.187 Second,Null} The answer btw is: !({((0.0744635081595152`)([InvisibleSpace])) + 3.7253195763747384`*^-14 [ImaginaryI], ((0.42971490576141286`)( [InvisibleSpace])) - 2.4999986347577774`*^-13 [ImaginaryI], (-0.07819866153696708`) + 8.649608688391904`*^-13 [ImaginaryI], ((0.8882136952400588`)([InvisibleSpace])) - 2.0302351108874434`*^-12 [ImaginaryI], (-0.7103217579953505`) + 3.571291726971529`*^-12 [ImaginaryI], ((1.5245842254651043`)([InvisibleSpace])) - 4.937329408163937`*^-12 [ImaginaryI], (-1.1153191765977668`) + 5.485925299100747`*^-12 [ImaginaryI], ((1.5245842254651498`)( [InvisibleSpace])) - 4.932307492121202`*^-12 [ImaginaryI], (-0.7103217579954203`) + 3.562747427805768`*^-12 [ImaginaryI], ((0.8882136952401251`)([InvisibleSpace])) - 2.0202080839356457`*^-12 [ImaginaryI], (-0.07819866153701173`) + 8.564310183614438`*^-13 [ImaginaryI], ((0.4297149057614334`)([InvisibleSpace])) - 2.450344072611743`*^-13 [ImaginaryI], ((0.0744635081595099`)( [InvisibleSpace])) + 3.602152386151295`*^-14 [ImaginaryI]}) The other product probably cannot do symbolic AND numerical stuff. So stick with Mathematica Christos Argyropoulos MD MSc Patras Greeece Sent by Medscape Mail: Free Portable E-mail for Professionals on the Move http://www.medscape.com === Subject: a measure function 3d pentagon parametric I have these functions for a number of polygons: the pentagon was hard to get. (*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 3.0, MathReader 3.0, or any compatible application. The data for the notebook starts with the line of stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. ***********************************************************************) (*CacheID: 232*) (*NotebookFileLineBreTest NotebookFileLineBreTest*) (*NotebookOptionsPosition[ 3049, 99]*) (*NotebookOutlinePosition[ 4106, 133]*) (* CellTagsIndexPosition[ 4062, 129]*) (*WindowFrame->Normal*) Notebook[{ Cell[TextData[ Clear[f,g,h,f1,g1,h1]nf[t_]=Cos[t]/Max[Cos[t], Cos[t+2 Pi/5],Cos[t+4 Pi/5], Cos[t+6 Pi/5] ,Cos[t+8 Pi/5] ];ng[t_]=Cos[t+2 Pi/3]/Max[Cos[t], Cos[t+2 Pi/5],Cos[t+4 Pi/5], Cos[t+6 Pi/5] ,Cos[t+8 Pi/5] ];nh[t_]=Cos[t+4 Pi/3]/Max[Cos[t], Cos[t+2 Pi/5],Cos[t+4 Pi/5], Cos[t+6 Pi/5] ,Cos[t+8 Pi/5] ];], Input, AspectRatioFixed->True], Cell[CellGroupData[{ Cell[TextData[StyleBox[ParametricPlot3D[{f[t],g[t],h[t]},{t,-Pi,Pi}], AspectRatioFixed->True, FontFamily->Hoefler Text]], Input, AspectRatioFixed->True], Cell[OutputFormData[ < The Unformatted text for this cell was not generated. Use options in the Actions Preferences dialog box to control when Unformatted text is generated. >, < -Graphics3D- >], Output, Evaluatable->False, AspectRatioFixed->True] }, Open ]], Cell[CellGroupData[{ Cell[TextData[StyleBox[ ParametricPlot3D[{f[t],g[t],h[t]},{t,-Pi,Pi},ViewPoint->{2.057, 4.316, 7.625}], AspectRatioFixed->True, FontFamily->Hoefler Text]], Input, AspectRatioFixed->True], Cell[OutputFormData[ < The Unformatted text for this cell was not generated. Use options in the Actions Preferences dialog box to control when Unformatted text is generated. >, < -Graphics3D- >], Output, Evaluatable->False, AspectRatioFixed->True] }, Open ]] }, FrontEndVersion->Macintosh 3.0, ScreenRectangle->{{0, 1920}, {0, 1060}}, WindowToolbars->{}, CellGrouping->Manual, WindowSize->{520, 740}, WindowMargins->{{244, Automatic}, {Automatic, 148}}, PrivateNotebookOptions->{ColorPalette->{RGBColor, -1}}, ShowCellLabel->True, ShowCellTags->False, RenderingOptions->{ObjectDithering->True, RasterDithering->False}, MacintoshSystemPageSetup->< 00/0001804P000000_@2@?olonh35@9B7`<5:@?l0040004/0B`000003509H04/ 02d5X5k/02H20@4101P00BL?00400@0000000000000000010000000000000000 0000000000000002000000@210D00000> ] (*********************************************************************** Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. ***********************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[1709, 49, 358, 6, 117, Input], Cell[CellGroupData[{ Cell[2092, 59, 164, 3, 26, Input], Cell[2259, 64, 267, 10, 24, Output, Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[2563, 79, 200, 5, 40, Input], Cell[2766, 86, 267, 10, 24, Output, Evaluatable->False] }, Open ]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************) Respectfully, Roger L. Bagula tftn@earthlink.net, 11759Waterhill Road, Leside,Ca 92040-2905,tel: 619-5610814 : URL : http://home.earthlink.net/~tftn URL : http://victorian.fortunecity.com/carmelita/435/ === Subject: This is a 3d biscuit function for a Gray code type square The Gray code along with the Sierpinski sets is a self similar universal fractal pattern. You can get it from a Pascal's triangle as well. (*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 3.0, MathReader 3.0, or any compatible application. The data for the notebook starts with the line of stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. ***********************************************************************) (*CacheID: 232*) (*NotebookFileLineBreTest NotebookFileLineBreTest*) (*NotebookOptionsPosition[ 3049, 99]*) (*NotebookOutlinePosition[ 4106, 133]*) (* CellTagsIndexPosition[ 4062, 129]*) (*WindowFrame->Normal*) Notebook[{ Cell[TextData[ Clear[f,g,h,f1,g1,h1]nf[t_]=Cos[t]/Max[Cos[t], Cos[t+2 Pi/5],Cos[t+4 Pi/5], Cos[t+6 Pi/5] ,Cos[t+8 Pi/5] ];ng[t_]=Cos[t+2 Pi/3]/Max[Cos[t], Cos[t+2 Pi/5],Cos[t+4 Pi/5], Cos[t+6 Pi/5] ,Cos[t+8 Pi/5] ];nh[t_]=Cos[t+4 Pi/3]/Max[Cos[t], Cos[t+2 Pi/5],Cos[t+4 Pi/5], Cos[t+6 Pi/5] ,Cos[t+8 Pi/5] ];], Input, AspectRatioFixed->True], Cell[CellGroupData[{ Cell[TextData[StyleBox[ParametricPlot3D[{f[t],g[t],h[t]},{t,-Pi,Pi}], AspectRatioFixed->True, FontFamily->Hoefler Text]], Input, AspectRatioFixed->True], Cell[OutputFormData[ < The Unformatted text for this cell was not generated. Use options in the Actions Preferences dialog box to control when Unformatted text is generated. >, < -Graphics3D- >], Output, Evaluatable->False, AspectRatioFixed->True] }, Open ]], Cell[CellGroupData[{ Cell[TextData[StyleBox[ ParametricPlot3D[{f[t],g[t],h[t]},{t,-Pi,Pi},ViewPoint->{2.057, 4.316, 7.625}], AspectRatioFixed->True, FontFamily->Hoefler Text]], Input, AspectRatioFixed->True], Cell[OutputFormData[ < The Unformatted text for this cell was not generated. Use options in the Actions Preferences dialog box to control when Unformatted text is generated. >, < -Graphics3D- >], Output, Evaluatable->False, AspectRatioFixed->True] }, Open ]] }, FrontEndVersion->Macintosh 3.0, ScreenRectangle->{{0, 1920}, {0, 1060}}, WindowToolbars->{}, CellGrouping->Manual, WindowSize->{520, 740}, WindowMargins->{{244, Automatic}, {Automatic, 148}}, PrivateNotebookOptions->{ColorPalette->{RGBColor, -1}}, ShowCellLabel->True, ShowCellTags->False, RenderingOptions->{ObjectDithering->True, RasterDithering->False}, MacintoshSystemPageSetup->< 00/0001804P000000_@2@?olonh35@9B7`<5:@?l0040004/0B`000003509H04/ 02d5X5k/02H20@4101P00BL?00400@0000000000000000010000000000000000 0000000000000002000000@210D00000> ] (*********************************************************************** Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. ***********************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[1709, 49, 358, 6, 117, Input], Cell[CellGroupData[{ Cell[2092, 59, 164, 3, 26, Input], Cell[2259, 64, 267, 10, 24, Output, Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[2563, 79, 200, 5, 40, Input], Cell[2766, 86, 267, 10, 24, Output, Evaluatable->False] }, Open ]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************) Respectfully, Roger L. Bagula tftn@earthlink.net, 11759Waterhill Road, Leside,Ca 92040-2905,tel: 619-5610814 : URL : http://home.earthlink.net/~tftn URL : http://victorian.fortunecity.com/carmelita/435/ === Subject: a 6 star measure 3d surface I did these originally about 1995 in TFTN. I discovered a way to me polygon parametrics of many different kinds. (*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 3.0, MathReader 3.0, or any compatible application. The data for the notebook starts with the line of stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. ***********************************************************************) (*CacheID: 232*) (*NotebookFileLineBreTest NotebookFileLineBreTest*) (*NotebookOptionsPosition[ 6204, 206]*) (*NotebookOutlinePosition[ 7075, 234]*) (* CellTagsIndexPosition[ 7031, 230]*) (*WindowFrame->Normal*) Notebook[{ Cell[BoxData[{ (Clear[f, g, h, k, j, i, e, t]n (* 6 star measure function 3 d Jewish star*) n (* (h[t_] = Abs[Abs[Cos[t]] - Abs[Cos[t + 2*Pi/3]]]; n i[t_] = Abs[Abs[Cos[t + 2*Pi/3]] - Abs[Cos[t - 2*Pi/3]]]; n j[t_] = Abs[Abs[Cos[t - 2*Pi/3]] - Abs[Cos[t]]]; n k[t_] = ((j[t] + h[t] + i[t]))/2; nf[t_] = Cos[t]/ k[t]; n g[t_] = Sin[t]/ k[t]; )}], Input], Cell[BoxData[ RowBox[{ RowBox[{x, =, StyleBox[(f[t] g[p]), AspectRatioFixed->True]}], StyleBox[;, AspectRatioFixed->True]}]], Input], Cell[BoxData[ RowBox[{ RowBox[{y, =, StyleBox[ , AspectRatioFixed->True], StyleBox[(g[t] g[p]), AspectRatioFixed->True]}], StyleBox[;, AspectRatioFixed->True]}]], Input], Cell[BoxData[ RowBox[{ RowBox[{z, =, StyleBox[(f[p]), AspectRatioFixed->True]}], StyleBox[;, AspectRatioFixed->True]}]], Input], Cell[CellGroupData[{ Cell[BoxData[ (ga = ParametricPlot3D[{x, y, (-z)}, {p, (-Pi), Pi}, {t, 0, Pi} , Axes -> False, Boxed -> False, PlotPoints -> 2*66])], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[< selectgraphics3d[graphics3dobj_,bound_,opts___]:= Show[Graphics3D[Select[graphics3dobj, (Abs[#[[1,1,1]]] < bound && Abs[#[[1,1,2]]] < bound && Abs[#[[1,1,3]]] < bound && Abs[#[[1,2,1]]] < bound && Abs[#[[1,2,2]]] < bound && Abs[#[[1,2,3]]] < bound && Abs[#[[1,3,1]]] < bound && Abs[#[[1,3,2]]] < bound && Abs[#[[1,3,3]]] < bound && Abs[#[[1,4,1]]] < bound && Abs[#[[1,4,2]]] < bound && Abs[#[[1,4,2]]] < bound )&]],opts] >, Input, PageWidth->Infinity, InitializationCell->True, ShowSpecialCharacters->False, FormatType->InputForm], Cell[ dip[ins_][g_]:=$DisplayFunction[Insert[g,ins,{1,1}]], Input, PageWidth->Infinity, InitializationCell->True, ShowSpecialCharacters->False, FormatType->InputForm], Cell[CellGroupData[{ Cell[< selectgraphics3d[ga[[1]],8, Boxed->False,ViewPoint->{2.9,-1.4,1.2}, DisplayFunction->dip[EdgeForm[]]] >, Input, PageWidth->Infinity, InitializationCell->True, ShowSpecialCharacters->False, FormatType->InputForm], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (( selectgraphics3d[ga[([1])], 8, n Boxed -> False, ViewPoint -> {(-2.9), 0, 0}, n n DisplayFunction -> dip[EdgeForm[]]]))], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (( selectgraphics3d[ga[([1])], 8, n Boxed -> False, ViewPoint -> {2.9, 0, 0}, n n DisplayFunction -> dip[EdgeForm[]]]))], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (selectgraphics3d[ga[([1])], 8, n Boxed -> False, ViewPoint -> {0.001, 0.045, 3.384}, n n DisplayFunction -> dip[EdgeForm[]]])], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (selectgraphics3d[ga[([1])], 8, n Boxed -> False, ViewPoint -> {0.001, 3.384, 0.045}, n n DisplayFunction -> dip[EdgeForm[]]])], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (selectgraphics3d[ga[([1])], 8, n Boxed -> False, n n DisplayFunction -> dip[EdgeForm[]]])], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]] }, FrontEndVersion->Macintosh 3.0, ScreenRectangle->{{0, 1920}, {0, 1060}}, AutoGeneratedPackage->None, WindowSize->{972, 859}, WindowMargins->{{Automatic, 429}, {Automatic, 55}}, MacintoshSystemPageSetup->< 00/0001804P000000_@2@?olonh35@9B7`<5:@?l0040004/0B`000003509H04/ 02d5X5k/02H20@4101P00BL?00400@0000000000000000010000000000000000 0000000000000002000000@210D00000> ] (*********************************************************************** Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. ***********************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[1709, 49, 476, 8, 155, Input], Cell[2188, 59, 187, 6, 27, Input], Cell[2378, 67, 245, 8, 27, Input], Cell[2626, 77, 181, 6, 27, Input], Cell[CellGroupData[{ Cell[2832, 87, 169, 3, 27, Input], Cell[3004, 92, 132, 3, 26, Output] }, Open ]], Cell[3151, 98, 624, 14, 147, Input, InitializationCell->True], Cell[3778, 114, 179, 4, 27, Input, InitializationCell->True], Cell[CellGroupData[{ Cell[3982, 122, 250, 12, 117, Input, InitializationCell->True], Cell[4235, 136, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[4404, 144, 206, 3, 75, Input], Cell[4613, 149, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[4782, 157, 201, 3, 75, Input], Cell[4986, 162, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[5155, 170, 203, 3, 75, Input], Cell[5361, 175, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[5530, 183, 203, 3, 75, Input], Cell[5736, 188, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[5905, 196, 148, 2, 75, Input], Cell[6056, 200, 132, 3, 26, Output] }, Open ]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************) Respectfully, Roger L. Bagula tftn@earthlink.net, 11759Waterhill Road, Leside,Ca 92040-2905,tel: 619-5610814 : URL : http://home.earthlink.net/~tftn URL : http://victorian.fortunecity.com/carmelita/435/ === Subject: 3d implicit surface based on Dr. Grim's 3d fuzzy logic Dr Grim in the early 90's published a 3d chaotic fuzzy mapping. This is an Implicit surface that gives the convex hull of that surface , I think. I just recently figured out this method. (*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 3.0, MathReader 3.0, or any compatible application. The data for the notebook starts with the line of stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. ***********************************************************************) (*CacheID: 232*) (*NotebookFileLineBreTest NotebookFileLineBreTest*) (*NotebookOptionsPosition[ 8969, 316]*) (*NotebookOutlinePosition[ 9895, 346]*) (* CellTagsIndexPosition[ 9851, 342]*) (*WindowFrame->Normal*) Notebook[{ Cell[< <, Input, PageWidth->Infinity, InitializationCell->True, ShowSpecialCharacters->False, FormatType->InputForm], Cell[BoxData[ (Clear[x, y, z, f, g, fermiplot, p, x1, y1, z1])], Input], Cell[BoxData[ (<< Utilities`DXF`)], Input], Cell[BoxData[ ((a0 = 1 - Abs[(( .5*Abs[y - z] - x))]; ))], Input], Cell[BoxData[ ((a1 = 1 - Abs[ .5*Abs[a0 - z] - y]; ))], Input], Cell[BoxData[ ((a2 = 1 - Abs[ .5*Abs[a0 - a1] - z]; ))], Input], Cell[CellGroupData[{ Cell[BoxData[ ((x = x1*1.5; ))], Input], Cell[BoxData[ RowBox[{ StyleBox[1.5`, StyleBoxAutoDelete->True, PrintPrecision->2], , x1}]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ ((y = y1*1.5; ))], Input], Cell[BoxData[ RowBox[{ StyleBox[1.5`, StyleBoxAutoDelete->True, PrintPrecision->2], , y1}]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ ((z = z1*1.5; ))], Input], Cell[BoxData[ RowBox[{ StyleBox[1.5`, StyleBoxAutoDelete->True, PrintPrecision->2], , z1}]], Output] }, Open ]], Cell[BoxData[ ((f[x1_, y1_, z1_] = a0 + a1 + a2 - 1; ))], Input], Cell[BoxData[ (( (* Grim 3 d fuzzy logic as an implicit surface/ convex hull*) ))], Input], Cell[< FermiPlot[energy_]:= ContourPlot3D[ f[kx,ky,-kz], {kx,-0.001, -Pi/2+0.001},{ky, -0.001, -Pi/2+0.001},{kz, -0.001, -Pi/2+0.001},PlotPoints->6, Contours -> {energy}]; >, Input, PageWidth->Infinity, InitializationCell->True, ShowSpecialCharacters->False, FormatType->InputForm], Cell[CellGroupData[{ Cell[BoxData[ (g1 = FermiPlot[0.000001])], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[< FermiPlot[energy_]:= ContourPlot3D[ f[kx,ky,-kz], {kx,0.001, Pi/2-0.001},{ky, 0.001, Pi/2-0.001},{kz, 0.001, Pi/2-0.001},PlotPoints->6, Contours -> {energy}]; >, Input, PageWidth->Infinity, InitializationCell->True, ShowSpecialCharacters->False, FormatType->InputForm], Cell[CellGroupData[{ Cell[BoxData[ (g2 = FermiPlot[0.000001])], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ ((n FermiPlot[energy_] := n ContourPlot3D[n f[kx, ky, (-kz)], n {kx, 0.001, Pi/2 - 0.001}, {ky, (-0.001), (-Pi)/2 + 0.001}, {kz, (-0.001), (-Pi)/2 + 0.001}, PlotPoints -> 6, n Contours -> {energy}]; ng3 = FermiPlot[0.000001]))], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ ((n FermiPlot[energy_] := n ContourPlot3D[n f[kx, ky, (-kz)], n {kx, 0.001, Pi/2 - 0.001}, {ky, 0.001, Pi/2 - 0.001}, {kz, (-0.001), (-Pi)/2 + 0.001}, PlotPoints -> 6, n Contours -> {energy}]; ng4 = FermiPlot[0.000001]))], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ ((n FermiPlot[energy_] := n ContourPlot3D[n f[kx, ky, (-kz)], n {kx, (-0.001), (-Pi)/2 + 0.001}, {ky, (-0.001), (-Pi)/2 + 0.001}, {kz, 0.001, Pi/2 - 0.001}, PlotPoints -> 6, n Contours -> {energy}]; ng5 = FermiPlot[0.000001]))], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ ((n FermiPlot[energy_] := n ContourPlot3D[n f[kx, ky, (-kz)], n {kx, (-0.001), (-Pi)/2 + 0.001}, {ky, 0.001, Pi/2 - 0.001}, {kz, (-0.001), (-Pi)/2 + 0.001}, PlotPoints -> 6, n Contours -> {energy}]; ng6 = FermiPlot[0.000001]))], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ ((n FermiPlot[energy_] := n ContourPlot3D[n f[kx, ky, (-kz)], n {kx, 0.001, Pi/2 - 0.001}, {ky, (-0.001), (-Pi)/2 + 0.001}, {kz, 0.001, Pi/2 - 0.001}, PlotPoints -> 6, n Contours -> {energy}]; n g7 = FermiPlot[0.000001]))], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (( FermiPlot[energy_] := n ContourPlot3D[n f[kx, ky, (-kz)], n {kx, (-0.001), (-Pi)/2 + 0.001}, {ky, 0.001, Pi/2 - 0.001}, {kz, 0.001, Pi/2 - 0.001}, PlotPoints -> 6, n Contours -> {energy}]; n g8 = FermiPlot[0.000001]))], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (Show[{g1, g2, g3, g4, g5, g6, g7, g8}, Boxed -> False])], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (Show[{g1, g2, g3, g4, g5, g6, g7, g8}, ViewPoint -> {0.000, (-0.045), 3.384}])], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (Show[{g1, g2, g3, g4, g5, g6, g7, g8}, ViewPoint -> {0.009, (-3.331), 0.597}])], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (Show[{g1, g2, g3, g4, g5, g6, g7, g8}, ViewPoint -> {(-3.329), 0.088, 0.597}])], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]] }, FrontEndVersion->Macintosh 3.0, ScreenRectangle->{{0, 1920}, {0, 1060}}, AutoGeneratedPackage->None, WindowSize->{1325, 851}, WindowMargins->{{Automatic, 186}, {Automatic, 79}}, PrintingCopies->1, PrintingPageRange->{1, Automatic}, MacintoshSystemPageSetup->< 00/0004/0B`000003509H?ocokD ] (*********************************************************************** Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. ***********************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[1709, 49, 162, 7, 42, Input, InitializationCell->True], Cell[1874, 58, 79, 1, 27, Input], Cell[1956, 61, 50, 1, 27, Input], Cell[2009, 64, 77, 1, 27, Input], Cell[2089, 67, 72, 1, 27, Input], Cell[2164, 70, 73, 1, 27, Input], Cell[CellGroupData[{ Cell[2262, 75, 49, 1, 27, Input], Cell[2314, 78, 135, 4, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[2486, 87, 49, 1, 27, Input], Cell[2538, 90, 135, 4, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[2710, 99, 49, 1, 27, Input], Cell[2762, 102, 135, 4, 26, Output] }, Open ]], Cell[2912, 109, 74, 1, 27, Input], Cell[2989, 112, 193, 4, 43, Input], Cell[3185, 118, 342, 12, 102, Input, InitializationCell->True], Cell[CellGroupData[{ Cell[3552, 134, 57, 1, 27, Input], Cell[3612, 137, 132, 3, 26, Output] }, Open ]], Cell[3759, 143, 336, 12, 102, Input, InitializationCell->True], Cell[CellGroupData[{ Cell[4120, 159, 57, 1, 27, Input], Cell[4180, 162, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[4349, 170, 418, 7, 123, Input], Cell[4770, 179, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[4939, 187, 408, 7, 123, Input], Cell[5350, 196, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[5519, 204, 418, 7, 123, Input], Cell[5940, 213, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[6109, 221, 418, 7, 123, Input], Cell[6530, 230, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[6699, 238, 404, 7, 123, Input], Cell[7106, 247, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[7275, 255, 395, 6, 107, Input], Cell[7673, 263, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[7842, 271, 91, 1, 27, Input], Cell[7936, 274, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[8105, 282, 123, 2, 27, Input], Cell[8231, 286, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[8400, 294, 123, 2, 27, Input], Cell[8526, 298, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[8695, 306, 123, 2, 27, Input], Cell[8821, 310, 132, 3, 26, Output] }, Open ]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************) Respectfully, Roger L. Bagula tftn@earthlink.net, 11759Waterhill Road, Leside,Ca 92040-2905,tel: 619-5610814 : URL : http://home.earthlink.net/~tftn URL : http://victorian.fortunecity.com/carmelita/435/ === Subject: Kinked tube This surface is a 3d version of a four space of a pseudosphere type where there is a torus shaped kink in the tube which tends to be a time-like loop. This result is a recent experiment of mine based on the ideas of Dr. Sterling in constant mean curvature surfaces. (*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 3.0, MathReader 3.0, or any compatible application. The data for the notebook starts with the line of stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. ***********************************************************************) (*CacheID: 232*) (*NotebookFileLineBreTest NotebookFileLineBreTest*) (*NotebookOptionsPosition[ 5827, 200]*) (*NotebookOutlinePosition[ 6698, 228]*) (* CellTagsIndexPosition[ 6654, 224]*) (*WindowFrame->Normal*) Notebook[{ Cell[BoxData[ (Clear[f, g, h, k, j, i, e, t, p, ss, tt, x, y, z, e1, e2, e3])], Input], Cell[BoxData[ (( (* kinked (tube : modified pseudosphere with a time like torus cycle as a kink)*) n ))], Input], Cell[CellGroupData[{ Cell[BoxData[ ({x, y, z} = {Sech[p] - Cos[t], Sin[t], p/Pi - Tanh[p]})], Input], Cell[BoxData[ ({(-Cos[t]) + Sech[p], Sin[t], p/[Pi] - Tanh[p]})], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (ga = ParametricPlot3D[{y, (-x), z}/4, {t, (-Pi), Pi}, {p, (-3)*Pi/2, 3*Pi/2} , Boxed -> False, PlotPoints [Rule] {80, 80}])], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[< selectgraphics3d[graphics3dobj_,bound_,opts___]:= Show[Graphics3D[Select[graphics3dobj, (Abs[#[[1,1,1]]] < bound && Abs[#[[1,1,2]]] < bound && Abs[#[[1,1,3]]] < bound && Abs[#[[1,2,1]]] < bound && Abs[#[[1,2,2]]] < bound && Abs[#[[1,2,3]]] < bound && Abs[#[[1,3,1]]] < bound && Abs[#[[1,3,2]]] < bound && Abs[#[[1,3,3]]] < bound && Abs[#[[1,4,1]]] < bound && Abs[#[[1,4,2]]] < bound && Abs[#[[1,4,2]]] < bound )&]],opts] >, Input, PageWidth->Infinity, InitializationCell->True, ShowSpecialCharacters->False, FormatType->InputForm], Cell[< >, Input, PageWidth->Infinity, InitializationCell->True, ShowSpecialCharacters->False, FormatType->InputForm], Cell[ dip[ins_][g_]:=$DisplayFunction[Insert[g,ins,{1,1}]], Input, PageWidth->Infinity, InitializationCell->True, ShowSpecialCharacters->False, FormatType->InputForm], Cell[CellGroupData[{ Cell[< g1=selectgraphics3d[ga[[1]],8, Boxed->False,ViewPoint->{2.9,-1.4,1.2}, DisplayFunction->dip[EdgeForm[]]] >, Input, PageWidth->Infinity, InitializationCell->True, ShowSpecialCharacters->False, FormatType->InputForm], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (( selectgraphics3d[ga[([1])], 8, n Boxed -> False, ViewPoint -> {(-2.9), 0, 0}, n n DisplayFunction -> dip[EdgeForm[]]]))], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (( selectgraphics3d[ga[([1])], 8, n Boxed -> False, ViewPoint -> {2.9, 0, 0}, n n DisplayFunction -> dip[EdgeForm[]]]))], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (selectgraphics3d[ga[([1])], 8, n Boxed -> False, ViewPoint -> {0.001, 0.045, 3.384}, n n DisplayFunction -> dip[EdgeForm[]]])], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (selectgraphics3d[ga[([1])], 8, n Boxed -> False, ViewPoint -> {0.001, 3.384, 0.045}, n n DisplayFunction -> dip[EdgeForm[]]])], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (selectgraphics3d[ga[([1])], 8, n Boxed -> False, n n DisplayFunction -> dip[EdgeForm[]]])], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]] }, FrontEndVersion->Macintosh 3.0, ScreenRectangle->{{0, 1920}, {0, 1060}}, AutoGeneratedPackage->None, WindowSize->{841, 769}, WindowMargins->{{318, Automatic}, {Automatic, 50}}, MacintoshSystemPageSetup->< 00/0001804P000000_@2@?olonh35@9B7`<5:@?l0040004/0B`000003509H04/ 02d5X5k/02H20@4101P00BL?00400@0000000000000000010000000000000000 0000000000000002000000@210D00000> ] (*********************************************************************** Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. ***********************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[1709, 49, 97, 2, 27, Input], Cell[1809, 53, 257, 6, 43, Input], Cell[CellGroupData[{ Cell[2091, 63, 87, 1, 27, Input], Cell[2181, 66, 85, 1, 38, Output] }, Open ]], Cell[CellGroupData[{ Cell[2303, 72, 181, 3, 43, Input], Cell[2487, 77, 132, 3, 26, Output] }, Open ]], Cell[2634, 83, 624, 14, 147, Input, InitializationCell->True], Cell[3261, 99, 134, 7, 42, Input, InitializationCell->True], Cell[3398, 108, 179, 4, 27, Input, InitializationCell->True], Cell[CellGroupData[{ Cell[3602, 116, 253, 12, 117, Input, InitializationCell->True], Cell[3858, 130, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[4027, 138, 206, 3, 75, Input], Cell[4236, 143, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[4405, 151, 201, 3, 75, Input], Cell[4609, 156, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[4778, 164, 203, 3, 75, Input], Cell[4984, 169, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[5153, 177, 203, 3, 75, Input], Cell[5359, 182, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[5528, 190, 148, 2, 75, Input], Cell[5679, 194, 132, 3, 26, Output] }, Open ]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************) Respectfully, Roger L. Bagula tftn@earthlink.net, 11759Waterhill Road, Leside,Ca 92040-2905,tel: 619-5610814 : URL : http://home.earthlink.net/~tftn URL : http://victorian.fortunecity.com/carmelita/435/ === Subject: a strange conic based pseudosphere like surface I originally did this on a c64 about 1979 or so when I was studying conic sections. (*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 3.0, MathReader 3.0, or any compatible application. The data for the notebook starts with the line of stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. ***********************************************************************) (*CacheID: 232*) (*NotebookFileLineBreTest NotebookFileLineBreTest*) (*NotebookOptionsPosition[ 6087, 215]*) (*NotebookOutlinePosition[ 6958, 243]*) (* CellTagsIndexPosition[ 6914, 239]*) (*WindowFrame->Normal*) Notebook[{ Cell[BoxData[ (( (* biconic : Pseudosphere like surface with a double singular tail*) n (* Input], Cell[CellGroupData[{ Cell[BoxData[{ (Clear[f, g, h, k, j, i, e, t]), (e = p), (x = Cos[t]/Sqrt[Abs[e/((1 + e*Cos[t])) e/((1 - e*Cos[t]))]]n), (y = Sin[t]/Sqrt[Abs[e/((1 + e*Cos[t])) e/((1 - e*Cos[t]))]])}], Input], Cell[BoxData[ (p)], Output], Cell[BoxData[ (Cos[t]/@Abs[p^2/(((1 - p Cos[t])) ((1 + p Cos[t])))])], Output], Cell[BoxData[ (Sin[t]/@Abs[p^2/(((1 - p Cos[t])) ((1 + p Cos[t])))])], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (z = e)], Input], Cell[BoxData[ (p)], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (ga = ParametricPlot3D[{x, y, (-z)}, {p, (-Pi), Pi}, {t, (-Pi), Pi} , Axes -> False, Boxed -> False, PlotPoints -> 2*66])], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[< selectgraphics3d[graphics3dobj_,bound_,opts___]:= Show[Graphics3D[Select[graphics3dobj, (Abs[#[[1,1,1]]] < bound && Abs[#[[1,1,2]]] < bound && Abs[#[[1,1,3]]] < bound && Abs[#[[1,2,1]]] < bound && Abs[#[[1,2,2]]] < bound && Abs[#[[1,2,3]]] < bound && Abs[#[[1,3,1]]] < bound && Abs[#[[1,3,2]]] < bound && Abs[#[[1,3,3]]] < bound && Abs[#[[1,4,1]]] < bound && Abs[#[[1,4,2]]] < bound && Abs[#[[1,4,2]]] < bound )&]],opts] >, Input, PageWidth->Infinity, InitializationCell->True, ShowSpecialCharacters->False, FormatType->InputForm], Cell[< >, Input, PageWidth->Infinity, InitializationCell->True, ShowSpecialCharacters->False, FormatType->InputForm], Cell[ dip[ins_][g_]:=$DisplayFunction[Insert[g,ins,{1,1}]], Input, PageWidth->Infinity, InitializationCell->True, ShowSpecialCharacters->False, FormatType->InputForm], Cell[CellGroupData[{ Cell[< selectgraphics3d[ga[[1]],8, Boxed->False,ViewPoint->{2.9,-1.4,1.2}, DisplayFunction->dip[EdgeForm[]]] >, Input, PageWidth->Infinity, InitializationCell->True, ShowSpecialCharacters->False, FormatType->InputForm], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (( selectgraphics3d[ga[([1])], 8, n Boxed -> False, ViewPoint -> {(-2.9), 0, 0}, n n DisplayFunction -> dip[EdgeForm[]]]))], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (( selectgraphics3d[ga[([1])], 8, n Boxed -> False, ViewPoint -> {2.9, 0, 0}, n n DisplayFunction -> dip[EdgeForm[]]]))], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (selectgraphics3d[ga[([1])], 8, n Boxed -> False, ViewPoint -> {0.001, 0.045, 3.384}, n n DisplayFunction -> dip[EdgeForm[]]])], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (selectgraphics3d[ga[([1])], 8, n Boxed -> False, ViewPoint -> {0.001, 3.384, 0.045}, n n DisplayFunction -> dip[EdgeForm[]]])], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ (selectgraphics3d[ga[([1])], 8, n Boxed -> False, n n DisplayFunction -> dip[EdgeForm[]]])], Input], Cell[BoxData[ TagBox[([SkeletonIndicator] Graphics3D [SkeletonIndicator]), False, Editable->False]], Output] }, Open ]] }, FrontEndVersion->Macintosh 3.0, ScreenRectangle->{{0, 1920}, {0, 1060}}, AutoGeneratedPackage->None, WindowSize->{972, 859}, WindowMargins->{{Automatic, 399}, {Automatic, 56}}, MacintoshSystemPageSetup->< 00/0001804P000000_@2@?olonh35@9B7`<5:@?l0040004/0B`000003509H04/ 02d5X5k/02H20@4101P00BL?00400@0000000000000000010000000000000000 0000000000000002000000@210D00000> ] (*********************************************************************** Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. ***********************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[1709, 49, 205, 4, 43, Input], Cell[CellGroupData[{ Cell[1939, 57, 235, 5, 91, Input], Cell[2177, 64, 35, 1, 26, Output], Cell[2215, 67, 102, 2, 68, Output], Cell[2320, 71, 102, 2, 68, Output] }, Open ]], Cell[CellGroupData[{ Cell[2459, 78, 38, 1, 27, Input], Cell[2500, 81, 35, 1, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[2572, 87, 175, 3, 27, Input], Cell[2750, 92, 132, 3, 26, Output] }, Open ]], Cell[2897, 98, 624, 14, 147, Input, InitializationCell->True], Cell[3524, 114, 134, 7, 42, Input, InitializationCell->True], Cell[3661, 123, 179, 4, 27, Input, InitializationCell->True], Cell[CellGroupData[{ Cell[3865, 131, 250, 12, 117, Input, InitializationCell->True], Cell[4118, 145, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[4287, 153, 206, 3, 75, Input], Cell[4496, 158, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[4665, 166, 201, 3, 75, Input], Cell[4869, 171, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[5038, 179, 203, 3, 75, Input], Cell[5244, 184, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[5413, 192, 203, 3, 75, Input], Cell[5619, 197, 132, 3, 26, Output] }, Open ]], Cell[CellGroupData[{ Cell[5788, 205, 148, 2, 75, Input], Cell[5939, 209, 132, 3, 26, Output] }, Open ]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************) Respectfully, Roger L. Bagula tftn@earthlink.net, 11759Waterhill Road, Leside,Ca 92040-2905,tel: 619-5610814 : URL : http://home.earthlink.net/~tftn URL : http://victorian.fortunecity.com/carmelita/435/ === Subject: Re: Q: extract all k-tuple from a list of n elements >Question: How can I extract all k-tuple from a list of n elements >(without considering permutations of the k-tuple)? >Example: For the special case k=3 one solution would be >Flatten[Table[{i, j, k}, {i, 1, n - 2}, {j, i + 1, n - 1}, {k, j + >1, n}], 2]; >A generalization of this solution for all k >=1 would involve to >create 'automatically' a table of dimension k, but how can this be >implemented? >Any help is appreciated. Te a look at the function KSubsets in the package DiscreteMath`Combinatorica` For example << DiscreteMath`Combinatorica`; n = 5; Flatten[Table[{i, j, k}, {i, 1, n - 2}, {j, i + 1, n - 1}, {k, j + 1, n}], 2] == KSubsets[Range[5], 3] True -- === Subject: Re: Slow LinearSolve. >Within 24 hours and counting, Mathematica was not able to solve Ax >= b for the following A and the following B. Another system does >this in a matter of seconds. How do me Mathematica do the same? I >use LinearSolve[A, b] Is the other system performing exact aritmetic? Do you really need an exact solution? $Version Timing[Chop[LinearSolve[N[A], N[b]]]] {0.010000000000000009*Second, {0.07446350815950518, 0.42971490576148197, -0.07819866153722022, 0.8882136952406927, -0.7103217579965401, 1.5245842254668558, -1.1153191765998371, 1.5245842254671313, -0.7103217579969479, 0.8882136952410542, -0.07819866153743803, 0.4297149057615676, 0.07446350815948745}} -- === Subject: Re: Slow LinearSolve. > Within 24 hours and counting, Mathematica was not able to solve Ax = b for > the following A and the following B. Another system does this in a matter of > seconds. The other system does it numerically, I assume? Mathematica is trying to compute the answer exactly. If you enter LinearSolve[N[A], b] and you will get an answer immediately. I note that your matrix A is a Vandermonde matrix Table[Exp[I n m Pi/12], {m, -6, 6}, {n, 0, 12}] == A or x[m_] = Exp[I m Pi/12] Table[x[m]^n, {m, -6, 6}, {n, 0, 12}] == A (see http://mathworld.wolfram.com/VandermondeMatrix.html) and the system you want to solve is related to computing the (inverse) discrete Fourier transform of b. Paul > How do me Mathematica do the same? I use LinearSolve[A, b] > A = {{1, -I, -1, I, 1, -I, -1, I, 1, -I, -1, I, 1}, {1, E^(((-5*I)/12)*Pi), > E^(((-5*I)/6)*Pi), > E^(((3*I)/4)*Pi), E^((I/3)*Pi), E^((-I/12)*Pi), -I, E^(((-11*I)/12)*Pi), > E^(((2*I)/3)*Pi), > E^((I/4)*Pi), E^((-I/6)*Pi), E^(((-7*I)/12)*Pi), -1}, > {1, E^((-I/3)*Pi), E^(((-2*I)/3)*Pi), -1, E^(((2*I)/3)*Pi), E^((I/3)*Pi), 1, > E^((-I/3)*Pi), > E^(((-2*I)/3)*Pi), -1, E^(((2*I)/3)*Pi), E^((I/3)*Pi), 1}, > {1, E^((-I/4)*Pi), -I, E^(((-3*I)/4)*Pi), -1, E^(((3*I)/4)*Pi), I, > E^((I/4)*Pi), 1, > E^((-I/4)*Pi), -I, E^(((-3*I)/4)*Pi), -1}, {1, E^((-I/6)*Pi), > E^((-I/3)*Pi), -I, > E^(((-2*I)/3)*Pi), E^(((-5*I)/6)*Pi), -1, E^(((5*I)/6)*Pi), > E^(((2*I)/3)*Pi), I, > E^((I/3)*Pi), E^((I/6)*Pi), 1}, {1, E^((-I/12)*Pi), E^((-I/6)*Pi), > E^((-I/4)*Pi), > E^((-I/3)*Pi), E^(((-5*I)/12)*Pi), -I, E^(((-7*I)/12)*Pi), > E^(((-2*I)/3)*Pi), > E^(((-3*I)/4)*Pi), E^(((-5*I)/6)*Pi), E^(((-11*I)/12)*Pi), -1}, > {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, {1, E^((I/12)*Pi), E^((I/6)*Pi), > E^((I/4)*Pi), > E^((I/3)*Pi), E^(((5*I)/12)*Pi), I, E^(((7*I)/12)*Pi), E^(((2*I)/3)*Pi), > E^(((3*I)/4)*Pi), > E^(((5*I)/6)*Pi), E^(((11*I)/12)*Pi), -1}, {1, E^((I/6)*Pi), E^((I/3)*Pi), > I, > E^(((2*I)/3)*Pi), E^(((5*I)/6)*Pi), -1, E^(((-5*I)/6)*Pi), > E^(((-2*I)/3)*Pi), -I, > E^((-I/3)*Pi), E^((-I/6)*Pi), 1}, {1, E^((I/4)*Pi), I, E^(((3*I)/4)*Pi), -1, > E^(((-3*I)/4)*Pi), -I, E^((-I/4)*Pi), 1, E^((I/4)*Pi), I, > E^(((3*I)/4)*Pi), -1}, > {1, E^((I/3)*Pi), E^(((2*I)/3)*Pi), -1, E^(((-2*I)/3)*Pi), E^((-I/3)*Pi), 1, > E^((I/3)*Pi), > E^(((2*I)/3)*Pi), -1, E^(((-2*I)/3)*Pi), E^((-I/3)*Pi), 1}, > {1, E^(((5*I)/12)*Pi), E^(((5*I)/6)*Pi), E^(((-3*I)/4)*Pi), E^((-I/3)*Pi), > E^((I/12)*Pi), I, > E^(((11*I)/12)*Pi), E^(((-2*I)/3)*Pi), E^((-I/4)*Pi), E^((I/6)*Pi), > E^(((7*I)/12)*Pi), -1}, > {1, I, -1, -I, 1, I, -1, -I, 1, I, -1, -I, 1}} > b = {0, (-2*I)/5, 0, (-2*I)/3, 0, -2*I, Pi, 2*I, 0, (2*I)/3, 0, (2*I)/5, 0} -- 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: Slow LinearSolve. > Within 24 hours and counting, Mathematica was not able to solve Ax = b > for the following A and the following B. Another system does this in a > matter of seconds. How do me Mathematica do the same? I use > LinearSolve[A, b] I guess this is because you request a symbolic solution. LineaeSolve[N[A], N[b]] comes in seconds. === Subject: Any ways to recover a broken file? I just found out that my Mathematica 5.1 notebook (size 40MB, WinXP) cannot be opened. Every time I try to open it, Mathematica is shut down. As you can guess from it's size, it has all the data I have been working with recently. Unfortunately, I have no backup file of it since the end of May. Does anyone know some way to recover or open the notebook? Toshi === Subject: Re: Long function defintions Aaron Read the documentation and help files for Module[] and Block[]. That should get you started. Westwood > How do you define a function with a very long body and a bunch of > intermediate results. For example > f[x_] := > y = (Do some long integration) > z = (solve an ode which depends on the value of y) > t = (do another long integration) > assign (y + z + t) to f!!! > The idea is that a function is best read if it is broken up but the > parts are not important enough to be made into their own functions. > Aaron === Subject: RE: Long function defintions Aaron, Something like this? f[x_] := Module[ {y, zsol, z, t}, y = (Do some long integration); zsol = (solve an ode which depends on the value of y); z = z /. zsol; t = (do another long integration); (y + z + t)] David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ How do you define a function with a very long body and a bunch of intermediate results. For example f[x_] := y = (Do some long integration) z = (solve an ode which depends on the value of y) t = (do another long integration) assign (y + z + t) to f!!! The idea is that a function is best read if it is broken up but the parts are not important enough to be made into their own functions. Aaron