Tag Info

Hot answers tagged

16

You could do this: GatherBy[list, Last][[All, 1]] ~SortBy~ Last (* {{d, 3}, {b, 3.04}, {a, 3.1}} *)


15

I believe that the difference is that the Hash in v7 was hashing the quotation marks around the string, but the Hash in v8 does not. For example, in M7: In[1]:= Hash["test", "MD5"] Out[1]= 64111166190477440563271147919838643147 and in M8: In[1]:= Hash["\"test\"", "MD5"] Out[1]= 64111166190477440563271147919838643147 Therefore, I'd say that the M8 ...


13

Ordering[t, -1] which is orders of magnitude faster than Position[t,Max[t]]


11

You don't := constant colors. Color1 = RGBColor[0.99, 0.2, 0.2, 0.5]; This space curve for example: curve = KnotData["Trefoil", "SpaceCurve"] (* {Sin[#1] + 2 Sin[2 #1], Cos[#1] - 2 Cos[2 #1], -Sin[3 #1]} & *) ParametricPlot3D[curve[t], {t, 0, 2 Pi}, PlotStyle -> AbsoluteThickness[10], ColorFunction -> (CurveColor[#4] &), ...


11

I realise that this doesn't fully answer the question, but for the special case of square matrices, there's already a suitable function: Image`MorphologicalOperationsDump`SquareMatrixRotate (which, no doubt, is how Sjoerd's suggestion works internally). This is undocumented, of course! The implementation is the following (modulo some bugs I've fixed--i and ...


11

The trick is to place some random non-overlapping Disks in your square area, then use the DistanceTransform to find a point in your square area that is the farthest from its nearest disk. (Such a point will be equidistant from at least two disks--generally three or more disks.) Place a new disk centered at this point, with its radius equal to the distance ...


9

As a starting point I'll write up what I found about these functions before. I'm hoping someone will take a better look at them and will write a more complete answer. Spelunking in version 8, Internal`AddPeriodical[Print["boo!"], 3] Now you get a boo! every 3 seconds. Internal`Periodicals[] (* ==> {Print["boo!"]} *) Now do ...


8

Just in case somebody else needs it, here is a compiled answer. Thanks go out to 0x4A4D (for the actual solution), Michael Pilat (for the JLink part) and everybody else in here for the swift responses. Since this is apparently a bug of sorts in Mathematica 8, percent encoding the Greek letters in the URL will have to do. Reciting Michael Pilat's code ...


8

You can try System`Private`$InputFileName Seems to work on M7, not sure about M6.


8

You could do something like this. It's an adaptation of the first example in the documentation for VertexLabelingFunction where I used an If statement to determine whether a vertex should be labeled or not. The function offset is just a helper function to determine by what amount the arrows should be shortened based on whether they end or start at a labeled ...


8

As an alternative to the solution by @VLC / Mark Fisher, the following JLink code will compute the correct MD5 hash (as returned by V8 or Unix md5sum): Needs["JLink`"] LoadJavaClass["java.security.MessageDigest"]; md5[s_String] := JavaBlock @ Module[{d, b} , d = java`security`MessageDigest`getInstance["MD5"] ; d@update[JavaNew["java.lang.String", ...


8

Older Mathematica versions were including the enclosing quotes "" when generating the hash. To get rid of the quotation marks you can use the function below instead of the standard Hash function. The credit for the function goes to Mark Fisher. StringHash[string_String, type_: "MD5"] := Module[{stream, file, hash}, stream = OpenWrite[]; ...


8

This appears to be a bug in version 8 that was fixed in version 9. Sum[a[n] x^n, {n, 0, Infinity}] gives (-x - Log[1 - x])/x^2 in both. In version 8.0.4, GeneratingFunction[a[n], n, x] gives PolyLog[2, x]/x, which is incorrect. In version 9.0.1, GeneratingFunction[a[n], n, x] gives (-1 - Log[1 - x]/x)/x which is equivalent to the result from Sum.


7

I'm answering mainly to show solidarity with the idea, although my own efforts at finding a systematic upgrade path with graceful degradation to older versions have ultimately been overtaken by the amount of new and different functionality introduced starting with version 6. Particularly version 6 was a real nuisance because it was so different from both: ...


7

Since you only want the numbers, you can get them by using Apply: CurveColor[phi_] = List@@Blend[{Color1, Color2, Color3}, Rescale[phi, {phimin, phimax}]] which will ensure that you always use the same blending functionality that Blend uses. Note, the use of Rescale.


7

The plots are misaligned because plot b doesn't have the exact same options as a, which causes it to be drawn slightly different. If you give the same options to plot b (PlotRange, AxesOrigin, and AxesLabel) b = Plot[-2 f'[z], {z, 0, 5}, PlotLegend -> "Theory", PlotRange -> {{0, 5}, {0, 1}}, LegendPosition -> {1.1, -0.4}, AxesOrigin -> {0, ...


7

FindClusters might give you a starting point. For simplicity, let's start with your definition for Ball: Ball[num_] := Table[{#1 Sqrt[1 - #2^2] Cos[#3], #1 Sqrt[ 1 - #2^2] Sin[#3], #1 #2} &[ RandomReal[NormalDistribution[1, 0.5]], Random[Real, {-1, 1}], Random[Real, {0, 2 Pi}]], {num}] By using the function FindClusters with the ...


6

m = {"computer", "экзамен", "elephant", "стол", "bread", "телефон", "exception", "desktop", "best", "колонка", "zoom", "saphire", "ярость"}; First Sort it: sortedm = SortBy[m, First@ToCharacterCode@# &] {"best", "bread", "computer", "desktop", "elephant", "exception", "saphire", "zoom", "колонка", "стол", "телефон", "экзамен", "ярость"} ...


5

With Combinatorica, you should usually use MakeGraph rather than Graph directly. Here are some expressions that create the graph you want and which can be easily adapted for use with any graph that you've defined appropriate vertices and edges symbols for: Needs["Combinatorica`"] crds = {{1, 10}, {2, 4}, {10, 5}, {20, 10}}; vertices = Range[Length[crds]]; ...


5

You can turn this then into a package, and change the lower-case to uppercase... Hope it works well enough for your goals. If not, we'll improve it in time AppendTo[$ContextPath, "Internal`"]; ClearAll["`private`*"]; SetAttributes[`private`count, HoldRest]; `private`count[_, expr_, count_Symbol][id_, ___] /; Block[{$scheduledTask = `private`getST[id]}, ...


5

This will display a list that's updated as long as the calculation runs, and vanishes afterwards: (* Pattern that translates the kernel's ID to a number from 1 to $KernelCount *) kernels = ParallelTable[$KernelID -> i, {i, $KernelCount}]; SetSharedVariable[kernels]; (* for Mathematica 7 *) (* This is the list that will display each kernel's current ...


5

FindPermutation may be useful as part of a yet-to-be-found general method as follows (using your examples as templates for the three rotations): a = {{1, 2, 3}, {4, 5, 6}, {7, 8, 9}}; b = (Reverse[a, {2}] // Transpose ); c = (Reverse[a // Transpose, {2}]); d = Reverse[a, {1, 2}]; cntrclckws = FindPermutation[Flatten@a, Flatten@b]; clckws = ...


5

The specification RFC1738 : "Uniform Resource Locators" states that: The characters ";", "/", "?", ":", "@", "=" and "&" are the characters which may be reserved for special meaning within a scheme. No other characters may be reserved within a scheme. [...] only alphanumerics, the special characters "$-_.+!*'(),", and reserved ...


5

Simon Woods already gave what is arguably the canonical answer, but I always like seeing and sharing alternatives. Since one of the operations here is a duplicate-removal we can adapt some of the methods described in Delete duplicate elements from a list. SeedRandom[3] a = RandomInteger[5, {9, 2}]; (* {{3, 5}, {0, 1}, {2, 0}, {0, 4}, {5, 2}, {2, 2}, {1, ...


5

I'll work with a built-in for the random point generation. If this is not in version 7 you can still use RandomReal. ball[n_] := RandomVariate[NormalDistribution[], {n, 3}] bl = ball[10^4]; Graphics3D[{AbsolutePointSize[2], Point[bb]}, Boxed -> True, BoxRatios -> {1, 1, 1}, SphericalRegion -> True] Now we can erode clumps of points at ...


5

To visualize the deleting process. (* generate random data*) data = RandomVariate[NormalDistribution[1, 3], {5000, 3}]; (* generate random delete centers*) pt = RandomChoice[data, 30]; (* generate random outer delete centers say at least away from mean by 10 *) ptouter =RandomChoice[Complement[data, Nearest[data, Mean@data, {Infinity, 10}]], 30]; f = ...


5

There are two ways: Calculate the density analytically. For the distribution you use this is difficult but since this for producing something pretty, and not for accuracy, you can consider using a different distribution. Approximate the distribution numerically. I'm going to do no. 2. below. I don't have version 7, so it is just a guess that these ...


5

I believe you're looking for the option PlotRangeClipping -> False


4

I don't think of this as rotating in the sense of an angle, rather, the sequence of positions around the matrix. So I came up with a rather different solution. First let's create the simple case: test[3, 3] = Array[a, {3, 3}] {{a[1, 1], a[1, 2], a[1, 3]}, {a[2, 1], a[2, 2], a[2, 3]}, {a[3, 1], a[3, 2], a[3, 3]}} This is the list of positions ...


4

This answer by Jens gives your problem a working solution. bc = BarChart[{1, 2, 3}]; barchart = First@ImportString[ExportString[bc, "PDF"]]; Export["demo.png", barchart, ImageResolution -> 300]; Import["demo.png", ImageSize -> 600] I have no idea why the two "ears" of the first and third bars appear though.



Only top voted, non community-wiki answers of a minimum length are eligible