Tag Info

Hot answers tagged

12

Culling elements from lists may done several ways, such as with Cases, Select, and Pick. Cases and Select seem quite similar when culling elements from level 1. The documentation for Select shows that the following are equivalent: Select[list, f] Cases[list, x_ /; f[x]] This, too, is equivalent: Cases[list, _?f] The functions Condition (/;) and ...


12

As requested, posting my comment as an answer: UpperTriangularize[arg, 1] + LowerTriangularize[arg, -1] seems to meet all the criteria, quite quick (surprisingly so to me).


9

I'm posting a whole new answer because I don't want to inherit any of the votes I received for my previous wrong answer. In formulating my new answer, I was aiming for correctness, simplicity, and reasonable (but not stellar) performance. Simplicity was achieved by taking a recursive approach, the clarity of which gives me confidence in the correctness of ...


9

Here is a purely functional solution (i.e. not using mutable state), based in FoldList (since the one based on linked lists has been already taken): stepF = Function @ With[{sum = First @ #1 + #2, len = #[[2]], prevsum = #1[[3]]}, If[sum > prevsum, {0, 0, sum, len + 1}, {sum, len + 1, prevsum, 0}] ]; getLengths[lst_List] := DeleteCases[0] @ ...


6

data = {IsotopeData["Thorium226", "ExcitedStateEnergies"], IsotopeData["Thorium226", "ExcitedStateSpins"]} // Transpose; (dataEven = Cases[data, {_, _?EvenQ}]) // Column Some other alternatives dataEven == Select[data, EvenQ[#[[2]]] &] == DeleteCases[data, {_, _?(! EvenQ[#] &)}] == Pick[data, EvenQ[data[[All, 2]]]] == GatherBy[data, ...


6

This problem can be solved with a one-liner. ListLinePlot[Thread[{distance, trial1[[;; -2]]}]] Of course if the data are trimmed before plotting than ListLinePlot[Thread[{distance, trial1}]] will do.


5

A bit more concise, seems at least as fast as those posted so far: setter[list_] := Module[{fs = 0, t = First@list - 1, f, u}, f[x_] := If[(fs += x) > t, t = fs; fs = 0; True, False]; u = Union[Pick[Range@Length@list, f /@ list], {Length@list}]; MapThread[list[[#1 ;; #2]] &, {Prepend[Most@u, 0] + 1, u}]];


5

a = {1, 2, 3, 4, 3, 2, 1, 2, 3, 4, 3, 2}; f = Module[{b, c, d, n}, b = {{First[#]}}; c = Rest[#]; Catch[ While[True, n = 1; While[Total[d = Quiet@Check[Take[c, n], Throw[AppendTo[b, c]]]] <= Total@Last[b], n++]; AppendTo[b, d]; c = Drop[c, n]]]; b] &; f[a] {{1}, {2}, {3}, {4}, {3, 2}, {1, 2, ...


5

Suppose your list is as follows m = {{1, 2}, {3, 4}, {5, 6}, {7, 8}} Dot @@ Transpose[m]/Total[m[[All, 2]]] (* 5 *)


5

Using symbolic values and descriptive names for clarity. Unless the sum of the weights is unity you will have to rescale the weights to get the expected value. n = 4; data = Array[{x[#1], y[#1]} &, n]; {values, weights} = data // Transpose; expValue = values.weights/Total[weights] Equivalently, expValue == Total[Times @@@ data]/Total[weights] ...


5

Just a way. Sorts first and removes identical elements, then elements that are strict subsets of other elements... fun[lst_] := Module[{sort = DeleteDuplicates[Sort[Sort /@ lst]], sa, w}, sa = SparseArray@ Outer[Boole[SubsetQ[#1 /. w -> List, #2 /. w -> List]] &, w @@@ sort, w @@@ sort]; ReplacePart[sort, Thread[(Last /@ ...


5

You can write your own repeat function like this: repeat[m_, n_Integer?Positive] := Sequence @@ ConstantArray[m, n] Then {1, 2, 3, 4, repeat[5, 3], 6, 7} evaluates to {1, 2, 3, 4, 5, 5, 5, 6, 7} The first argument can be anything. {1, 2, 3, 4, repeat["anything", 2], 6, 7} {1, 2, 3, 4, "anything", "anything", 6, 7}


4

The following works for a numeric matrix, should be OK for symbolic ones exmat = {{0, 5, 2, 3, 1, 0}, {4, 3, 2, 5, 1, 3}, {4, 1, 3, 5, 3, 2}, {4, 4, 1, 1, 1, 5}, {3, 4, 4, 5, 3, 3}, {5, 1, 4, 5, 2, 0}}; MatrixForm[ReplacePart[exmat, {i_, i_} -> 0]] (* 0 5 2 3 1 0 4 0 2 5 1 3 4 1 0 5 3 2 4 4 ...


4

A function for data fully-sorted: myDelete[data_] := Block[{revdata = Reverse@data, manip}, manip[l_] /; Length@l == 1 := l; manip[l_] := Block[{rest = Rest@l, subsetq, firstelem = First@l}, subsetq = SubsetQ[firstelem, #] & /@ rest; {firstelem, Sequence @@ manip[Pick[rest, subsetq, False]]}]; Reverse@manip[revdata]]; ...


4

I removed the last element of trail1 as per comment by @march. Lookup this site: http://stackoverflow.com/questions/16513010/how-to-combine-two-lists-to-plot-coordinate-pairs distance = {0, 5, 25, 45, 65, 85, 105, 125, 145, 150}; trial1 = {0, 0.14, 0.49, 0.94, 1.39, 1.85, 2.43, 3.08, 3.61, 4.31}; Partition[Riffle[distance, trial1], 2] (* {{0, 0}, {5, ...


4

There are many ways to do this, e.g.: dat = Transpose@data; Cases[dat, {_, _?EvenQ}] Select[dat, EvenQ[Last@#] &] Pick[dat, EvenQ@Last@# & /@ dat] Extract[dat, Position[dat, {_, _?EvenQ}]] All yield: {Quantity[72.20, "Kiloelectronvolts"], 2}, {Quantity[226.43, "Kiloelectronvolts"], 4}, {Quantity[447.3, "Kiloelectronvolts"], 6}, ...


4

Just based on your text: f[u_] := Module[{a, b}, {a, b} = Transpose@u; Transpose[{a, b - Min@b}]] f/@list yields: {{{0, 0.}, {1, 0.6}, {2, 0.8}, {3, 1.3}, {4, 0.7}, {5, 0.6}, {6, 1.4}}, {{0, 0.}, {1, 0.4}, {2, 0.2}, {3, 0.6}, {4, 0.7}, {5, 1.}, {6, 1.1}}}


4

I assume the multiplicity of group names in your example is not a typo, that is, you might want to name multiple sublists with the same group. Either way, this will do what you want: (* example list and group names *) list = Partition[Range@20, 4]; groups = {"group1", "group1", "group2", "group2", "group3"}; Rule @@@ Transpose[{list, groups}] (* {{1, ...


3

Yet another answer: pos[list_] := Module[{currcounter = 0, currmax = 0}, Map[( currcounter += #; If[currcounter > currmax, currmax = currcounter; currcounter = 0; False, currcounter += #; True]) &, list]] g[list_] := With[{arr = pos[list]}, With[{splitpos = Split[arr, #1 == True &]}, ...


3

Here is another possible solution: mySorting[{}, _] := {}; mySorting[list_, sum_] := Block[{firstelem = First@list, listlength = Length@list,tempsum, poselem = 1}, tempsum = firstelem; While[tempsum <= sum && poselem + 1 <= listlength, tempsum = tempsum + list[[poselem++ + 1]]]; {list[[Range@poselem]], Sequence @@ ...


3

First of all, your code does not return an error on my machine. Second, using "something similar to what you tried", you might want to do Transpose[{#[[All, 1]], #[[All, 2]] - Min[#[[All, 2]]]}] & /@ list


3

partitionBlock[lst_, {a_, b_}] := Module[{row, col, m, n}, {m, n} = Dimensions[lst, 2]; row = Mod[m - 1, a - 1]; col = Mod[n - 1, b - 1]; Which[ row == 0 && col == 0, Partition[lst, {a, b}, {a - 1, b - 1}], row == 0 && col != 0, Drop[Partition[lst, {a, b}, {a - 1, b - 1}, 1, {}], -1], row != 0 && col == 0, ...


3

Many possible approaches. One is Union[Cases[list, _?PrimeQ], Cases[list, i_ /; Mod[i, 3] == 0]] (* {-9, -6, 6, 15, 39, 54, 71, 90, 111} *) Addendum If, instead, you want the elements in order and with their corresponding i values Flatten@Union[Position[list, _?PrimeQ], Position[list, i_ /; Mod[i, 3] == 0]] list[[%]] (* {2, 3, 5, 6, 8, 9, 11, 12, 13, ...


3

Just to play with no great idea to solve all issues... and looking forward to answers. This respects packed arrays but does not deal with Infinity or Indeterminate diagonal entries... mat = RandomReal[1, {100, 100}]; sa = SparseArray[mat]; zr = 1 - SparseArray[IdentityMatrix[100]] res = zr sa


3

Building on march's proposal this may be a bit more robust, though it is still based on guesswork: list = {1, 2, 3, 4, 5, -6, 9, 3, 12, 0, -3} Flatten[{False, True} /. GroupBy[Sort @ list, OddQ], {2, 1}] {-6, -3, 0, 1, 2, 3, 4, 3, 12, 5, 9} That assumes you always want to start with an even number. If not this is shorter: Sort[list] ~GatherBy~ OddQ ...


2

Here is an option using Reap and Sow: splitInc[list_List]:=Block[{i=0,previousTotal=0,current={}}, Last@Reap@Scan[ ( AppendTo[current,#]; If[Total[current] > previousTotal ,Sow[#,i];previousTotal=Total[current];current={};i++ ,Sow[#,i]] )& , list ] ] splitInc[list] ...


2

Using: $posLenIdx = Association@MapIndexed[First@#2-> Length@#&, test]; $revItenIdx = Merge[Identity]@MapIndexed[Association@Thread[#-> First@#2]&, test]; and: testSet[set_List, {pos_}]:=Block[{biggerGroups, len = Length@set}, biggerGroups = Select[Tally@Flatten@Lookup[$revItenIdx, set, {}], ( #[[2(*qtd*)]] >= ...


2

Another way with the hint from @Guess who i is: Select[list, Divisible[#, 3] &]~Union~Select[list, PrimeQ] {-9, -6, 6, 15, 39, 54, 71, 90, 111}


2

If you are just learning about expected value (as I seem to be), the following may seem like a natural way to obtain it. However, as Bob Hanlon notes, it assumes that the weights are positive integers. This is imposed by Constant Array[a, b], which gives b copies of a. Mean[Flatten[ConstantArray @@@ {{1, 2}, {3, 4}, {5, 6}, {7, 8}}]] 5 ConstantArray ...


2

Your expression doesn't actually produce a list of ordered pairs, but rather two lists, one of excited spin energies and the other of excited spin states. Further, some the excited spin state values are missing and marked by Missing["NotAvailable"]. Presuming you not only wish to remove odd spins but missing ones too, I precede like so: data = {ese, ess} = ...



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