26
lst={a,b,c,d};
ReplaceList[lst,{x__, ___} :> {x}]
Speaking of "common operation":
Table[lst[[;; i]], {i, Length@lst}]
18
A variant using Take.
list~Take~# & /@ Range@Length@list
{{a}, {a, b}, {a, b, c}, {a, b, c, d}}
One using NestList:
NestList[Most, list, Length@list - 1]
{{a, b, c, d}, {a, b, c}, {a, b}, {a}}
17
Subsets takes an optional 3rd argument as Subsets[list, {n}, k] that gives you the kth sublist of length n. Since your sublists are in sequence, you'll always need k = 1. You can then use this as:
MapIndexed[First@Subsets[list, #2, 1] &, list]
(* {{a}, {a, b}, {a, b, c}, {a, b, c, d}} *)
Another alternative would be:
Reverse@Most@NestWhileList[Most, ...
14
You can use ReplaceList with a helper function which has the Orderless attribute:
ClearAll[f]; SetAttributes[f, Orderless];
ReplaceList[f[a, b, c], f[a___, b___, c___] :> {{a}, {b}, {c}}] //
DeleteCases[#, {}, -1] & // Union // Column
The DeleteCases and Union are required because the output from ReplaceList includes the empty list {} as a ...
14
This question may be a duplicate but for the time being:
list = Range[300];
The number of subsets length 25:
n = Binomial[300, 25]
1953265141442868389822364184842211512
Five samples:
samp = RandomInteger[{1, n}, 5]
{1097179597483122074395819626389736050,
1278400886908268917844987164926797363,
1855898035549513136165016617586671669,
...
12
I am not sure this wins any speed contests, but it is a purely functional solution:
FoldList[#1~Join~{#2} &, {First@#}, Rest@#]& @ {a, b, c, d, e}
(* {{a}, {a, b}, {a, b, c}, {a, b, c, d}, {a, b, c, d, e}} *)
12
I think RandomSample already does exactly what you need:
RandomSample:
RandomSample[Range[300], 25]
(* {292, 257, 36, 83, 259, 245, 280, 270, 24, 236, 186, 100, 300, 240,
176, 295, 42, 105, 97, 106, 60, 114, 63, 25, 253} *)
Table[RandomSample[Range[300], 25], {5}]
{{221, 54, 124, 64, 168, 91, 149, 25, 142, 87, 184, 288, 93, 105, 95, 195, 264, 180, ...
11
Ad. I
These should be the most efficient and tersest
Ceiling[ Range @ 27 / 3 ]
or
Array[ Ceiling[#/3] &, 27]
yield
{1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 6, 6, 6, 7, 7, 7, 8, 8, 8, 9, 9, 9}
they both can be tersely written in the Front End (see details of Ceiling) as:
or
Ad.II
For the second problem there are many approaches, here is ...
11
mat = ConstantArray[1, {4, 4}] - IdentityMatrix[4];
LinearSolve[mat, {-1, 3, 5, 8}]
{6, 2, 0, -3}
11
I get a decent looking result with:
RegionPlot[
Evaluate[DiscretizeRegion[
RegionDifference[BooleanRegion[And, #],
BooleanRegion[Or, Complement[{b, c, EmptyRegion[2]}, #]]],
MaxCellMeasure -> {"Length" -> 0.1}] & /@ subsets],
PlotLabels ->
Callout[{"Vive", "Linux", "Vive\n\[Intersection]\nLinux"}, Center],
Sequence[...
10
Try the following. Note I assumed from OP that elements are non-zero integers. This could of course be adapted to other cases with appropriate mapping.
getmasks[listarg_] :=
Reverse[Transpose[
IntegerDigits[Fold[BitSet[#1, #2] &, 0, #] & /@ listarg, 2,
Max[listarg] + 1]]][[Min[listarg] + 1 ;; Max[listarg] + 1]];
getneighbors[listarg_,...
10
I don't pretend this is the most efficient or pretty, but here's a go at what I think you're after (see latter part of post for faster and simpler realizations):
a = {1, 1, 2, 1, 1, 3};
b = {1, 5, 5, 1};
result = Join[
Flatten[ConstantArray @@@
Flatten[Replace[Cases[GatherBy[Join[Tally[#1], Tally[#2]], First],
{{Alternatives @@ a, ...
10
This is a solution that reorders elements.
a = {1, 2, 1, 3, 1, 3, 4, 5};
b = {6, 1, 3, 1, 5};
CountingComplement[a_, b_] := Module[{ca, cb},
ca = Counts[a];
cb = Counts[b];
Do[ca[i] = Ramp[ca[i] - cb[i]], {i, Intersection[Keys[ca], Keys[cb]]}];
Join @@ ConstantArray @@@ Normal[ca]
]
CountingComplement[a, b]
{1, 2, 3, 4}
10
Select+ ContainsNone
Select[Apply[ContainsNone]]@lis
{{{a}, {b, c, d}}, {{b}, {d}}, {{a, b}, {c, d}}}
Pick + ContainsNone:
Pick[#, ContainsNone @@@ #] & @ lis
{{{a}, {b, c, d}}, {{b}, {d}}, {{a, b}, {c, d}}}
Cases + ContainsNone
Cases[{a_, b_} /; ContainsNone[a, b]]@lis
{{{a}, {b, c, d}}, {{b}, {d}}, {{a, b}, {c, d}}}
DeleteCases + ContainsAny
...
9
What about Accumulate:
Function[lst, {{lst[[1]]}}~Join~Rest[Accumulate[lst] /. Plus -> List]]@{a, b, c, d, e}
Unfortunately it doesn't accept a custom function other than Plus and will not work for numerical list...
9
There is an adequate function: Complement, e.g.:
Complement[{a, b, c, d, e}, {a, c, d}]
{b, e}
It works also with more sets, lists or with any heads, e.g.:
Complement[{a, b, c, d, e}, {a}, {c, e}, {d}]
{b}
9
If I'm not mistaken you can do this: (I will replace [EmptySet] with ES because I have troubles formatting it here)
a = { ES, {ES}, {{ES}, ES}};
b = {#, {#, #2}} & @@@ Tuples[a, {2}];
% // Column
{ES, {ES, ES}}
{ES, {ES, {ES}}}
{ES, {ES, {{ES}, ES}}}
{{ES}, {{ES}, ES}}
{{ES}, {{ES}, {ES}}}
{{ES}, {{ES}, {{ES}, ES}}}
{{{ES}, ES}, {{{ES}, ES}, ES}}
{{{...
9
Okay, I'll go first. This is not an answer per se to the post, but more an invitation to write a fast sorting code for machine reals. That way we can get some sense of what might be feasible (showing timings of existing implementations would also be useful; I leave that for others). In Mathematica. Using Compile, of course. The point is to illustrate a few ...
9
More a comment than an answer, (but I have not enough reputation):
This is a well known problem, although by far not solved. (One might not expect, but is of very practical relevance in software testing.) You find a lot of interesting stuff (theory and algorithms) by googling "orthogonal array" or - even better - "mixed orthogonal array". Also the book "...
9
There is probably a build-in command for this, but with over 6,000 commands, hard to search now. But you could try
inter=Intersection[list1,list2];
Complement[Union[list1,list2],inter]
9
I am sure there are many ways to do this. One possible way is to take the union of both sublists, and check if its length is same as sum of length of both sublists. Since when making union, duplicates are automatically removed.
lis = {{{a}, {b,c,d}}, {{a,b}, {b,c}}, {{b,c},{a,b,c}}, {{b},{d}}, {{a,b}, {c,d}}};
Cases[lis, {x_, y_} /; Length@Union[x, y] == (...
9
Another method with DuplicateFreeQ, where @* is shorthand/infix notation for Composition.
Select[lis, DuplicateFreeQ@*Flatten]
{{{a}, {b, c, d}}, {{b}, {d}}, {{a, b}, {c, d}}}
Another way of really doing the exact same thing is with Pick.
Pick[lis, DuplicateFreeQ@*Flatten /@ lis]
Basically, either method picks out the elements of lis such that ...
8
A main idea of a pattern-based solution
I don't know why we should make life so complicated, since you can always use things like Intersection and Complement to test whether a given set is a subset of another set. But if you want to use the pattern-matcher, here is one option:
ClearAll[set];
SetAttributes[set, {Orderless, Flat, OneIdentity}];
ClearAll[...
8
Michael E2 is correct in that Max is remarkably capable with functions as well as values.
Defining
f1[x_] := -2 x + 2
f2[x_] := -x + 1.5
f3[x_] := x - 0.5
f4[x_] := 2 x - 2
funcs = {f1[x], f2[x], f3[x], f4[x]};
We can use Max to get the function of the envelope:
m[x_] = PiecewiseExpand@Max[f1[x], f2[x], f3[x], f4[x]]
Plot[funcs, {x, 0, 2}, Epilog ->...
8
Why not use Quotient to figure out what row each element belongs to, and then make sure there are no duplicates? For example:
fQ[part_, n_] := AllTrue[Quotient[part, n, 1], DuplicateFreeQ]
Comparison:
rand = RandomSample[par, 10000];
r1 = pickflat[rand, 4]; //AbsoluteTiming
r2 = Select[rand, fQ[#, 4]&]; //AbsoluteTiming
r1 === r2
{0.71157, Null}
...
8
Graphics[{
Opacity[0.5],
Red, Disk[{-0.66, 0}],
Blue, Disk[{0.66, 0}],
Opacity[1], White,
Text[Style["Vive Users", 18], {-0.8, 0}],
Text[Style["Linux Users", 18], {0.85, 0}],
Text[Style["Vive\n⋂\nLinux", 18], {0, 0}]}]
7
Time from another necro badge, courtesy of the related questions sidebar...
My take:
minsets[sets_] := Module[{ut = Union@sets, jut, gb, jj,pw},
jut = Join @@ ut;
pw = 2^Range[Length@ut - 1, 0, -1];
gb = GatherBy[Range@Length@jut, jut[[#]] &];
jj = Join @@ MapThread[ConstantArray, {pw, Length /@ ut}];
Pick[ut,
IntegerDigits[BitOr @@ ...
7
Since @DanielLichtblau used Internal`ListMin in an answer to a recent question, I will use it in an answer to this question. Given the following partial order on lists of vectors:
$$v \leq w \leftrightarrow v_i \leq w_i \text{ for all }i$$
Internal`ListMin will return the maximal subset of a set of vectors, where each member of the maximal subset is not ...
7
A brute force solution is to check all possible values of this function.
num = {1/10, 1/2, 4/7, 3/5, 2/3};
pow = {0, 1, 2, 3, 4};
To obtain value for one combination use the Inner function
Inner[Power, num, pow, Plus]
(* => 2222701/992250 *)
Then we apply function Inner[Power, num, #, Plus]& on all permutations
prm = Permutations[pow];
val = ...
Only top voted, non community-wiki answers of a minimum length are eligible
