Tag Info

New answers tagged

2

While highly inefficient you asked about FreeQ and you could do this: f0 = FreeQ[#, Alternatives @@ #2] &; More practically here is a condensed version of rasher/ciao's method: f1 = DuplicateFreeQ[Join @@ DeleteDuplicates /@ {##}] &


3

I'd expect this might be faster than intersection on larger lists: With[{j = Join[DeleteDuplicates@#1, DeleteDuplicates@#2]}, DeleteDuplicates@j == j] &[l1, l2] Addendum - a little testing, does seem to have advantage when both lists large, otherwise a bit of a wash between this and using intersection... perhaps others can test on non-loungbook ...


1

\[GothicCapitalR] = {{{1, 0, 0}, {0, 1, 0}, {0, 0, 1}}, {{0, 1, 0}, {0, 0, 1}, {1, 0, 0}}, {{0, 0, 1}, {1, 0, 0}, {0, 1, 0}}, {{1, 0, 0}, {0, 0, 1}, {0, 1, 0}}, {{0, 0, 1}, {0, 1, 0}, {1, 0, 0}}, {{0, 1, 0}, {1, 0, 0}, {0, 0, 1}}}; i = 1; j = 1; det = 1; a = Subsets[Range[6], {3}]; v = {x, y, z}; k = \[GothicCapitalR].v; PolynomialLCM @@ ...


4

Instead of While[i<21,...], use Table[...,{i,20}]. The ... part can be reduced to r = k[[a[[i]]]]; Factor[Det[r]] To find the PolynomialLCM, simply replace the head ( List) of the table with PolynomialLCM using Apply, or @@ for short: PolynomialLCM @@ Table[...,{i,20}]


2

Replace the Print[det] in the print with: Paste[det]


8

In version 10 you have DisjointQ (and conversely IntersectingQ) to test this. For earlier versions you could build this yourself: ClearAll[disjointQ] disjointQ[a_List, b_List] := Intersection[a, b] === {} disjointQ[{1, 2, 3}, {6, 4, 5}] (* True *) disjointQ[{1, 2, 3}, {1, 4, 5}] (* False *)


2

ArrayPad does precisely what you want, nevertheless I'd suggest one more solution without calling a special function, which I think a little clearer than the original with Drop and PadRight: Join[list[[m + 1 ;;]], Table[list[[-1]], {m}]]


3

Here is a solution, based on pattern matching in the list of rules of the association: acs //. x_Association :> Normal[x] DeleteCases[ %, (key_->val_String) /; StringMatchQ[val, " "..], Infinity] DeleteCases[ %, _->{}] % /. List->Association (* {A->{a-> ,aa->asd},B->{bb-> }} {A->{aa->asd},B->{}} {A->{aa->asd}} ...


3

DeleteCases[Association@KeyValueMap[#1->DeleteCases[#2,_?(StringMatchQ[ToString@#,Whitespace..]&)]&,acs],_?(#==<||>&)]


5

I may be back to using gedanken Mathematica, but I'm confident this works: m = 2; ArrayPad[{3, 8, 2, 7, 1, 6}, {-m, m}, "Fixed"] {2, 7, 1, 6, 6, 6}


2

Following ubpdqn comment, this is the solution that worked for my problem: Peaks = Transpose@ FindPeaks[Take[Delete[Abs[Fourier[CoM]], 1], RunTime/2], 0, 0]; Find the position in Peaks of the two highest values (two greatest local peaks) MaxTwoPosition = Ordering[Peaks[[2]], -2]; Find the corresponding position in my list of data: locationofbothpeaks ...


2

You can also do it explicitly, as follows, findTwoMaxima[list_List] := Block[{l, p1, p2}, l = list; (* find position of maximum:*) p1 = Flatten[Position[l, Max[l]]][[1]]; (* Replace this entry by a very negative number:*) l[[p1]] = -Infinity; (* now find maximum again:*) p2 = Flatten[Position[l, Max[l]]][[1]]; {p1, p2} ] I always prefer ...


2

These s/b considerably faster on large lists than solutions posted so far: For integer lists: UnitStep[Subtract[list, 1]] For real lists: UnitStep[Subtract[Sign@list, 1]] And I'd venture this will be quickest: Clip[list, {0, 0}, {0, 1}]


0

list = {-1, -2, 1, 2, 0} Floor[(1 + Sign[#])/2]&/@list Note that 0 is replaced by 0. If you prefer to replace 0 by 1, you must use: Ceiling[(1 + Sign[#])/2]&/@list


0

Once you select the nearest element for list2[[1]] then other elements from list2 are practically directly assigned. There is one element from list2 not well assigned and it is -1067.4. Its partner -1115.6 is further than -1054.7. When you first reverse the order of initial lists, the desired solution is obtained. This minimize the Total value of ...


3

I'm not sure I correctly interpreted what you really are looking for, because you mention MapThread that works on elements on the same position in the two lists, whereas in the description you say that for each element of list2 you want the closest from list1. Moreover, this means that once you selected an element from list1, it cannot be considered for ...


6

There a number of approaches. The desired behaviour of zero has not been specified. Examples: UnitStep[list] Boole[# > 0] & /@ list list /. {x_?Negative -> 0, x_?Positive -> 1} HeavisideTheta[list] (Unitize@# + Sign@#)/2 &@list UnitStep[0] yields 1 The Boole approach will also yield zero but could be modified as desired. The ...


4

I am going to demonstrate this with a smaller matrix to enable us to more readily view the results. A0 = Table[Subscript[a, i, j], {i, 8}, {j, 8}]; A0//MatrixForm Step 1. Partition A0 into 4x4 blocks A0byBlock = Partition[A0, {4, 4}]; A0byBlock // MatrixForm Step 2. Map f onto A0 at level 2 A0out = Map[f, A0byBlock, {2}]; A0out // MatrixForm ...


3

The introduction of Assocation brings a powerful new way to handle this problem. (* archive data *) ad = {"accept_rate" -> 75, "account_id" -> 395497, "age" -> 41, "badge_counts" -> {"bronze" -> 35, "gold" -> 0, "silver" -> 11}, "creation_date" -> 1326833982, "display_name" -> "Verbeia", "is_employee" -> False, ...


6

After all these ingenious and interesting solutions only some simple remarks. Jacob Akkerboom's solution shows that totally readable is a subjective concept. It took me some time before I really understood it (but it is very hot here today). In fact, his solution is an ingenious implementation of what could be done with Fold as well, thereby producing ...


3

Your problem is the Set. Set means you're assigning something to a variable (=), x2 Sin[x2] is not a variable. Try Equal[] instead, this is equivalent to ==. Vars = {{(x1) Cos[x2], Sin[x2], 0, (x3) (Sin[x2])}, {(Cos[x2]) (Sin[x4]), (x3) Cos[x4], 1, x1}}; Const = {{1, 0, 0, 1}, {0, 1, 1, 2}}; MapThread[Equal, {Vars, Const}, 2] yields the output: {{x1 ...


3

Not very fast, but totally readable clusterFu[list_] := Module[ {d = 0, bool = True}, Unevaluated[ Set[bool, True]@If[bool, bool = False; d++] ][[list]]; d ]


9

I am late to the party but here is my terse contribution: f1 = Tr @ Split[#][[All, 1]] & This is quite a bit faster than Leonid's oneseqs: x = RandomInteger[1, 500000]; oneseqs[x] // RepeatedTiming f1[x] // RepeatedTiming {0.2992, 125166} {0.0697, 125166} For speed I propose: f2 = Length@# - Tr@# & @ UnitStep @ Differences[# ...


2

Untested, but this is effectively the same strategy as Michael's: Count[ListCorrelate[{-1, 1}, list, {-1, 1}, 0], 1]


1

Another way: f[list_] := Plus @@@ ImageData@ HitMissTransform[Image@{list}, {{-1, 1}}, Padding -> 0]


14

This s/b quite quick (particularly with long lists): MorphologicalEulerNumber[Image@{list}] And this is even faster... Length[With[{d = Differences@Prepend[list, 0]}, Pick[d, d, 1]]] This seems quite quick: f = Compile[{{z, _Integer, 1}}, Module[{c = True, cnt = 0}, Do[ If[c && x == 1, cnt++; c = False; Continue[]]; If[x == 0, c = ...


2

Using StringCount: StringJoin[ToString /@ list3] // StringCount[#, "1"..] & 3


4

for any number you can use: count[list_, n_] := Total@Cases[Split[list], {n,n ..} :> 1] count[list1, 1] (*1*) count[list1, 0] (*2*)


9

Another method: oneseqs[list_] := Count[Append[list, 0] - Prepend[list, 0], 1] Technically, this counts the number of times the sequence shifts from 0 to 1, but that's effectively the same as the number of blocks of 1's. EDIT: Here are some performance figures for the four methods proposed thus far: @Leonard Shifrin: randlist = RandomInteger[1, ...


16

Here is one way: oneseqs[lst_] := Total @ Unitize @ Total[Split[lst], {2}]


2

Join is a peculiar function. It interprets its last argument, if and only if that argument is an integer, as a level specification. That is why Join[a, b, Transpose[c], d] complains about level 5 when d = 5. Further, all the arguments except other than that optional last integer must have the same head. So Join[a, d, b, Transpose[c]] won't work either ...


1

You can replace your r with r = Join[{a}, {b}, {Transpose[c]}, {d}] ~Flatten~ 1 With this definition the output is {{x1, y1}, {x2, y2}, {x3, y3}, {u1, v1}, {u2, v2}, {u3, v3}, {z1, t1}, {z2, t2}, {z3, t3}, 5} both for d = {5}; and d = 5;. By adding the extra {} you ensure that each parameter of Join is a List. These extra {} are than remove by ...


1

This should produce the desired dialog loop pdGUIstyled[func_, outputList_: {}] := Setting@DynamicModule[{variable}, Module[{symboles = Cases[func, _Symbol, Infinity] // DeleteDuplicates, lastRes}, lastRes = DialogInput[ Column[{ Row[{"the function is: ", Panel[func, Background -> White]}], "", Row[{"the current list of ...


1

This is not an answer but rather a comment/example on @Dr.WolfgangHintze and @halirutan posts, concerning the "weird" behaviour that was observed with NIntegrate, that is localization and symbolic evaluation of the variables which may actually lead to unwanted results: Edit I'll take an even more simple example which concerns both NIntegrate and Integrate: ...


3

My comment in Manipulate form: func = {x^2 + x y + y^2}; Manipulate[ D[func, variable], {variable, {x, y}} ] The control that Manipulate uses is the SetterBar[Dynamic[variable], {x, y}] of my comment.


3

Pardon me if I misunderstand but is this all you want? ListPlot[Transpose /@ {{x1, y1}, {x2, y2}}] Or maybe you are looking for the single function form: Transpose[{{x1, y1}, {x2, y2}}, {1, 3, 2}] (* thanks for the correction belisarius *) {{{1, 0}, {3, 2}, {5, 4}, {7, 6}}, {{10, 8}, {12, 10}, {14, 12}, {16, 14}}}


2

As mentioned by kglr and ilian in the comments, you can do one of two things. We can define a function that you can map over the function, i.e. #["ParameterTable"] & is the pure function that will accept the Head of a function, and we map this over the list of function as #["ParameterTable"] & /@ Messungfit Alternatively, we can use Through, ...


3

My version of Bob Hanlon's comment solution: list1 = {a, b, c, d}; FoldList[Times, list1] % // Column {a, a b, a b c, a b c d} a a b a b c a b c d Reference: Shorter syntax for Fold and FoldList?


3

You can also use Accumulate list1 = {a, b, c, d}; Times @@@ Accumulate[list1] (* or Accumulate[list1] /. Plus -> Times *) {a, a b, a b c, a b c d} ... or ReplaceList: ReplaceList[list1, {x__, ___} :> Times[x]] {a, a b, a b c, a b c d}


5

list1 = {a, b, c, d}; Rest[FoldList[Times, 1, list1]] Scan[Print, %] a a b a b c a b c d


1

A For-loop is a poor choice for your calculation in Mathematica. Better, because it's simpler and faster, is sets = Table[Complement[Range[10], {i, i + 1}], {i, 9}]; which has the additional advantage that the results are available for further calculations. To get the results printed out nicely, use Column Column @ sets


3

You For syntax is just wrong. Try r = Range[10] For[i = 1, i <= 9, i++, k = Complement[r, {i, i + 1}]; Print[k]] and avoid capital letters for your symbol names. K has a build-in meaning Information[K] K is a default generic name for a summation index in a symbolic sum.


2

Map[(f[# - 1] := #) &, Range[3]]; f[n_] := f[n] = f[n-1] + f[n-2] + f[n-3]; Or alternatively: (f[#-1]:= #)&/@Range[3]; f[n_] := f[n] = f[n-1] + f[n-2] + f[n-3]; Just in one line: f[n_] := If[MemberQ[Range[0, 2], n], n + 1, f[n - 1] + f[n - 2] + f[n - 3]];


7

Some version of the following might be useful: ClearAll[f]; Evaluate@Thread[f[{0, 1, 2}]] := {1, 2, 3}; In this case you could also use Set instead of SetDelayed (:=), because the arguments are "atomic", not patterns. Both = and := hold their first argument unevaluated by default, so that a construct like Thread as I am using it above will only work in ...


2

This is very fast : n=20; A={{4, 5, 9, 19}, {3, 7, 8, 11}, {3, 7, 9, 18}, {1, 3, 10, 17}, {5, 6, 10, 19}, {3, 7, 13, 20}, {3, 8, 15, 19}, {2, 7, 15, 20}, {11, 14, 15, 17}, {1, 3, 12, 20}}; f = Compile[{{n, _Integer}, {Ax, _Integer, 1}}, Module[{tab}, tab = Array[0 &, {n}]; (tab[[#]] = 1) & /@ Ax; tab ], RuntimeAttributes ...


0

If you want to use AppendTo, you could just make list a shared variable and change your ParallelTable to a ParallelDo: list = {}; SetSharedVariable[list]; ParallelDo[Block[{x = x2, y}, y = 2 x^2; AppendTo[list, {x, y}];];, {x2, 1, 4}]


0

I propose: Array[Boole@MemberQ[a[[#1]], #2] &, {w, n}] ...Short, but slow. Well, after that first feeble attempt, I present this faster version... Module[{m = ConstantArray[0, {w, n}]}, Set[m[[##]], 1] & @@@ (Join @@ Inner[List, Range[w], a, List]); m];


5

This s/b quite quick: IntegerDigits[Total@Transpose@(2^Subtract[n, a]), 2, n] N.b. - I changed A to a - it's almost always a bad idea to use uppercase initials for you own symbols... And this is wicked fast: Module[{ca = ConstantArray[0, n w]}, ca[[Flatten[a + Range[0, w n - 1, n]]]] = 1; Partition[ca, n]] Of the answers so far, for n = 20; k = 4; ...


2

Untested: SparseArray[Thread[Flatten[Inner[List, Range[w], A, List], 1] -> 1], {w, n}]


1

I don't know if this is what you are after, but this is how I always import / export long lists: Export Export["C:\\Directory\\list.txt", list] Import list = ToExpression[Import["C:\\Directory\\list.txt", "List"]];



Top 50 recent answers are included