Tag Info

New answers tagged

2

A slightly simpler code: The presence of the "1" in UpperTriangularize[] grabs the strictly upper triangular components. This way you don't need to define the diag portion for the sum. (* Generate symmetric n x m matrix with component values as random reals in (0,K) *) RM = RandomReal[K, {n, m}]; SM = UpperTriangularize[RM] + ...


1

Here are 3 other approaches. I'll first test their output with very basic input: n = 10; o1 = {3, 7, 9}; o2 = {2.2, 3.3, 4.4} It is not clear what the OP exactly needs at the extremities of the new list: for example here do the values for time steps 1 and 2 have to be 0 or 2.2 ? Same question for time step 10 ? The different approaches below show some ...


3

I would use the new associations functions. letters = {a, b, c, d, e, f, g}; groups = {{a, b, c, d}, {e, f, g, h}}; asc = Counts[letters] (* <|a -> 1, b -> 1, c -> 1, d -> 1, e -> 1, f -> 1, g -> 1|> *) Total /@ DeleteMissing /@ Map[asc, groups, {2}] This should be fast assuming that letters is large and groups is small ...


2

bins = {{a, b, c, d}, {e, f, g, h}}; vals = {1, 2}; ruls = Flatten@MapThread[Thread[Rule@##] &, {bins, vals}]; set = {a, b, e, e, f}; BinCounts[set /. ruls, {0, 6, 1}] (* {0, 2, 3, 0, 0, 0}*) If you always want vals going from 1 to Length@bins, then you can do instead: fun = Function[{r}, Position[bins, r][[1, 1]], Listable]; BinCounts[fun@set, {0, ...


6

To summarize the comments into an answer: The second element is a list of lists because there may be several different tags sown. For example, Reap[Sow[1, x]; Sow[2, y]; result] (* {result, {{1}, {2}}} *) Another example by belisarius, Reap[Sow[1, {x, y}]; Sow[2, y]; Sow[3, x], _, tag] (* {3, {tag[x, {1, 3}], tag[y, {1, 2}]}} *) See also this ...


2

My interpretation of this question is that the OP is asking for a zero-order interpolation of his data. There for I propose the following solution. First a proof of concept using about 50 points based on belisarius' data model. SeedRandom[42]; Module[{interp, n, n1, o1, o2}, n = 50; n1 = 15; o1 = {1, Sequence @@ Union@RandomInteger[{2, n - ...


2

Expanding @ciao's comment above: n = 3 10^6; n1 = 10000; v1 = Range[n]; o1 = Union@RandomInteger[{1, n}, n1]; o2 = Reverse[ o1/1000 // N]; (*Anything*) getV2[v1_, o1_, o2_] := Module[{f, v2}, v2 = 0 v1; v2[[o1]] = o1; (f[#1] = #2) & @@@ Transpose[{o1, o2}]; f[0] = o2[[1]]; v2 = f /@ FoldList[Max, v2] ] getV2[v1, o1, o2]; // Timing


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 ...


0

There is one important method missing in the previous answers and which consists in replacing subparts of a list with (replacement) rules (see for example this official doc). By the way, you can also retrieve your data with this shorter syntax: data=IsotopeData["Thorium226"][{"ExcitedStateEnergies", "ExcitedStateSpins"}] Then (for versions<10.2 ...


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, ...


2

SeedRandom[1];list = RandomInteger[100, {6, 4}]; i = 1; j = 1; Sequence @@@ ({# -> "group" <> ToString[i++], #2 -> "group" <> ToString[j++]} & @@@ Partition[list, {2}]) (*{{80, 14, 0, 67} -> "group1", {3, 65, 100, 23} -> "group1", {97, 68, 74, 15} -> "group2", {24, 4, 100, 90} -> "group2", {83, 70, 1, 30} ...


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}


1

Just for curiosity, this is another way using higher level built-in "stats" functions : Given for example your data: xw = {{x1, w1}, {x2, w2}, {x3, w3}}; the corresponding probability distribution is: myDist = EmpiricalDistribution[xw[[All, 2]] -> xw[[All, 1]]]; then you can compute Expectation[hello, Distributed[hello, myDist]] which is ...


2

I have uploaded your table.txt to a code sharing server. This is exactly like the data should look on your disk. As already mentioned in several comments, you just have to import it as "Table" and everything is fine: data = Import["http://hastebin.com/raw/cudesisezu", "Table"]; data[[2]] (* {0, 0.997046, -4.00611*10^-6, -0.00442103, 0.299956, 0, ...


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


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).


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 ...


10

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 ...


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] ...


5

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]]; ...


6

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 /@ ...


3

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*)]] >= ...


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 ...


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}


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, ...


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] ...


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 ...


5

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


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.


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, ...


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}, ...


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, ...


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} = ...


2

I also thought immediatly about the Fold function using the #1 and #2 arguments of it. Here is my try: Given the OP list: mylist = {1, 2, 3, 4, 3, 2, 1, 2, 3, 4, 3, 2} then: (for versions<10.2 replace Nothing with Sequence[]): foo = (If[(sn = #2 + Tr@Last@#1) > s, s = sn; lst = {}, lst = Nothing]; {Sequence @@ Most@#1, Join[Last@#1, {#2}], ...


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] @ ...


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}]];


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 @@ ...


2

I've made a very rough-and-ready one which uses linked lists: toLinkedList = Fold[{#2, #1} &, {}, Reverse@#]&; r[list_, currval_, currans_, curransval_] := r[list[[2]], currval, {list[[1]], currans}, curransval + list[[1]]] r[{}, c_, a_, v_] := a r[list_, currval_, currans_, curransval_] /; curransval > currval := {currans, r[list, ...


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, ...


2

By using Leonid's makeTree from here: makeTree[wrds_] := Reap[If[# =!= {}, Sow[Rest[#], First@#]] & /@ wrds, _, #1 -> makeTree[#2] &][[2]] usage fn = {"Folder1\\file1.txt", "Folder2\\file3.dat", "Folder3\\file4.nb", "Folder3\\file5.m", "Folder3\\file6.m", ...


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


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}}}


2

Here's a version allowing MaxFilter to work with windows of even length k. It runs MaxFilter with window radius k/2-1, then corrects the output. MovingMaxEven is slower than Andrew's MovingMax, for example, 1.01 s versus his 0.78 s on 10 million points. MovingMaxEven[s_List, k_?EvenQ] := Block[{r = k/2 - 1, f}, f = MaxFilter[s, r][[r + 1 ;; -r - ...


2

This is a very wrong way to do it, but hopefully it might provide insight. First of all, your approach with slightly corrected syntax: lists = {{a,b,c},{d,e,f}} Map[(#[[2]] = #[[3]]) &, lists] The Set (=) operation has the attribute HoldFirst, therefore it attemps to set the entire {a, b, c}[[2]] construct to c. That doesn't make any sense, so it ...


6

Here's a rundown of some methods: Map[ReplacePart[#, 2 -> #[[3]]] &, lists] lists[[All, 2]] = lists[[All, 3]] (* Changes `lists` *) lists /. {a_, _, b_} :> {a, b, b} lists[[All, {1, 3, 3}]] MapThread[{#, #3, #3} &, Transpose[lists]] {#, #3, #3} & @@@ lists A rather exotic way of addressing a particular part of an expression: lists = { ...


3

Do you want to swap positions 2 and 3, or just duplicate position 3? For the first, #[[{1, 3, 2}]] & /@ lists returns (*{{a, c, b}, {d, f, e}}*) For the second, #[[{1, 3, 3}]] & /@ lists returns (* {{a, c, c}, {d, f, f}} *)


2

Works if dates aren't sequential days: Data2 = Thread[{t + QuantityMagnitude@DateDifference[Data[[1, 1]], #] & /@ Data[[All, 1]], Data[[All, 2]]}] (Not sure if that's what you were going for, if not...) Data2 = Thread[{t + Range[0, Length@Data - 1], Data[[All, 2]]}]


2

Data2=MapThread[{t + #1, Last@#2} &, {Range[0, Length@Data - 1], Data}] {{t, 49.9061}, {1 + t, 50.3395}, {2 + t, 50.7569}, {3 + t, 50.7649}, {4 + t, 50.2432}, {5 + t, 49.256}, {6 + t, 49.2801}, {7 + t, 49.4486}, {8 + t, 49.264}, {9 + t, 49.4647}, {10 + t, 49.561}, {11 + t, 49.9944}}



Top 50 recent answers are included