Tag Info

New answers tagged

2

Regarding CountTrue: There is generally no need for the empty Module. You can use CompoundExpression if you need several operations in sequence. Here even that is not necessary. There is no need to count all appearances of True in an expression to determine if one is present: instead use MemberQ. That gives us: CountTrue[list_] := MemberQ[list, True] ...


2

I shall not attempt to replicate the exact function of your code but rather to address the problem posed in text of your Question. As a starting point I suggest you build a Dispatch table of the replacements you wish to make and then apply it with Replace. First some sample data: SeedRandom[0] m = RandomInteger[66, {1024, 1024}]; keep = Array[Prime, 18]; ...


2

SelectComponents is pretty fast but it labels the background with 0, not 100. You might be able to work with that. SelectComponents[mat, "Label", MemberQ[keep, #] &] but this is a bit faster: sel = Compile[{{label, _Integer}, {keep, _Integer, 1}}, If[MemberQ[keep, label], label, 0], (* or 100 if necessary *) RuntimeAttributes -> {Listable}, ...


3

In order to apply a function to every element we can use Map with the level specification: Map[If[MemberQ[keep, #], #, 100] &, matrix, {2}] Another option using the Listable attribute: Function[{x}, If[MemberQ[keep, x], x, 100], Listable]@matrix; This turned out to be a lot slower though. I ran these on Michael E2's test case and the Listable ...


1

It looks like you're trying to overlay some plots (up to 500). Are you sure this is what you want to do? Regardless, this code works fine in Mathematica 10.0. somegraphs = Table[Plot[x^ii, {x, 0, ii}], {ii, 1, 100}]; Manipulate[Timing[Show[somegraphs[[1 ;; ii]]]], {ii, 1, 100, 1}] Perhaps you'll need to show more code.


1

In version 10 there is a new function PositionIndex that could be the go-to method for this operation: a = {3, 3, 6, 11, 13, 13, 11, 1, 2, 3, 12, 8, 9, 9, 4, 15, 5, 6, 9, 12}; Values @ PositionIndex @ a {{1, 2, 10}, {3, 18}, {4, 7}, {5, 6}, {8}, {9}, {11, 20}, {12}, {13, 14, 19}, {15}, {16}, {17}} Sadly, as currently implemented its performance is ...


2

ClearAll[f]; f = Transpose@Table[i {##2}/#^{##2} , {i, 1, #}] &; f[3, x] (*{{3^-x x,2 3^-x x,3^(1-x) x}} *) f[3, x, y, z] (* {{3^-x x,2 3^-x x,3^(1-x) x}, {3^-y y,2 3^-y y,3^(1-y) y}, {3^-z z,2 3^-z z,3^(1-z) z}} *)


2

You have several issues here. My oldest Mathematica here is version 8, but when I look at your compiled code: cf = Compile[{{x, _Integer}, {n, _Integer}}, z = (n^x); Binomial[n, #]*StirlingS2[x, #]*(#!)/z & /@ Range[x]]; << CompiledFunctionTools` CompilePrint[cf] I see that there are several callbacks from the compiled code to the ...


2

If your n is a very big integer and your x and y are real values, and you need realy high speed, than you should try Compile: cf = Compile[{{x, _Real, 0}, {n, _Integer, 1}}, n*x/Length[n]^x, RuntimeAttributes -> {Listable}, Parallelization -> True, CompilationTarget -> "C" ] f[n_, x_, y_] := {cf[x, Range[n]], cf[y, Range[n]]} For ...


1

perhaps something like this: function[n_, x_, y_] := ({table1, table2} = Table[i {x/n^x, y/n^y}, {i, n}] // Transpose;) But note your example does not need Table at all: function[n_, x_, y_] := ({table1, table2} = {x/n^x, y/n^y} # & /@ Range[n] // Transpose;) Of course assigning to global variables inside a ...


8

Let me start by saying that this problem is probably best solved with a procedural backtracking algorithm, like the one given here. This makes Mathematica a poor choice for tackling it. In fact, judging from this sci.math topic from 1994 the people who originally derived the complete list of PPDIs did it in C. But since we're here to talk about Mathematica, ...


10

I believe that this is an intentional and beneficial change in v10. Mathematica 9 was not able to correctly detect the number of physical cores, and it launched as many kernels as the number of virtual cores (which is double when using HyperThreading). Mathematica 10 can now detect the number of physical cores correctly and will launch only as many kernels ...


2

I dont know how to solve your question,but I know that just compile it will save some times. Clear["Global`*"] string = {5, 4, 0, 5, 3, 3, 1, 4, 0, 2, 4, 0, 2, 3, 5, 0, 0, 0, 5, 4, 2, 3, 3, 5, 5, 4, 1, 5, 5, 4, 4, 5, 3, 2, 1, 3, 1, 2, 2, 4}; kOmni = Block[{f = Total@BitSet[0, DeleteDuplicates@#1], z, cnt = 0}, Fold[If[(z = BitAnd[f, BitSet[#, #2]]) ...


2

I have experienced that MapThread[f, data] unpacks arrays. Not sure if this is the case generally or just the way I use it. I always try to use Map[f, Transpose[data],{level}] to make sure arrays stay packed. Much faster in general and especially when compiling!


5

It is actually pretty simple. Just make the outmost function, i.e. flo in your case Listable, which you have already done in your first code snippet: dem = Compile[{{p1, _Real, 0}}, Min[100 p1, 2500]]; Nsup = Compile[{{p1, _Real, 0}, {p2, _Real, 0}}, Min[(150 - p1) 100 - p2, 2500]]; flo = Compile[{{p1, _Real, 0}, {p2, _Real, 0}, {p3, _Real, 0}}, ...


2

subsetQ = And @@ Table[MemberQ[#1, i], {i, #2}] &; posF = Function[{a1, a2}, Position[a1, _?(subsetQ[#, a2] &)]] posF2 = Function[{a1, a2}, Join @@ MapIndexed[If[subsetQ[#, a2], #2, ## &[]] &, a1, {2}]] posF[m, {1, 2}] (* {{1,1}, {1,2}, {2,2}} *) posF[m, {1, 2}] == posF2[m, {1, 2}] (* True *) (Note: not to be compared with rasher's method ...


5

I'm interpreting your OP as wanting positions of lists that contain the element(s) in your target list, not the precise sequence only, etc. which is what other answers so far seem to do. If that's not what you're after, please clarify the OP. E.g., given a list {{{1,2,3},{2,1,3}},{{1,4,5},{1,5,2}}}, targets of either {1,2} or {2,1} should return {{1, 1}, ...


1

M = {{{1, 2, 3}, {1, 2, 4}}, {{5, 4, 3}, {1, 2, 1}}}; Drop[#, -1] & /@ Position[M /. {a_ /; a == 1, b_ /; b == 2, c_} :> {{a, b}, c}, {1, 2}] {{1, 1}, {1, 2}, {2, 2}} REVISION To make my answer compatible with the others: FindPosition[m_, a_, b_] := Intersection @@ Map[Most, {Position[m, a], Position[m, b]}, {2}] FindPosition[M, 2, 1] ...


4

EDIT Not fast but short SetAttributes[ul, Orderless]; matches[matrix_, {list__}] := Position[matrix /. List[i__Integer] -> ul[i], ul[list, ___], {2}]; m = {{{1, 2, 3}, {2, 1, 3}}, {{1, 4, 5}, {1, 5, 2}}}; matches[m, {1, 2}] {{1, 1}, {1, 2}, {2, 1}} matches[m, {2, 1}] {{1, 1}, {1, 2}, {2, 1}} m = {{{1, 2, 3}, {2, 1, 3}}, {{1, 4, 5}, {1, ...



Top 50 recent answers are included