Re: 1-liner wanted

• To: mathgroup at smc.vnet.net
• Subject: [mg121661] Re: 1-liner wanted
• From: Peter Pein <petsie at dordos.net>
• Date: Sat, 24 Sep 2011 22:33:51 -0400 (EDT)
• Delivered-to: l-mathgroup@mail-archive0.wolfram.com
• References: <j5hdfe\$7j5\$1@smc.vnet.net>

```Am 23.09.2011 09:45, schrieb Kent Holing:
> Let's assume we have a list of elements of the type {x,y,z} for x, y and z integers. And, if needed we assume x<  y<  z. We also assume that the list contains at least 3 such triples.
>
> Can Mathematica easily solve the following problem? To detect at least three elements from the list of the type {a,b,.}, {b,c,.} and {a,c,.}? I am more intereseted in an elegant 1-liner than computational efficient solutions.
>
> Example:
> Givenlist ={1,2,3},{2,4,5],{6,7,8},{1,4,6},{7,8,9},{11,12,13}};
> should return
> {{1,2,3},{2,4,5},{1,4,6}}
>
> Kent Holing,
> Norway
>

This looks like some kind of homework, but my proposal is far from being
elegant - so what...

In[1]:= Givenlist = {{1, 2, 3}, {2, 4, 5}, {6, 7, 8}, {6, 8, new},
{1, 4, 6}, {7, 8, 9}, {11, 12, 13}};

In[2]:= With[{pat = Permutations[{{a, b, x}, {b, c, y}, {a, c, z}}]},
Flatten[(ReplaceList[Givenlist,
Insert[Map[Pattern[#1, _] & , #1, {2}], ___, Transpose[{Range[4]}]]
:> pat[[1]]] & ) /@ pat, 1]]
Out[2]= {{{1, 2, 3}, {2, 4, 5}, {1, 4, 6}},
{{6, 7, 8}, {7, 8, 9}, {6, 8, new}}}

or - to keep elements in order - a small change immediately after ":>"

In[3]:= With[{pat = Permutations[{{a, b, x}, {b, c, y}, {a, c, z}}]},
Flatten[(ReplaceList[Givenlist,
Insert[Map[Pattern[#1, _] & , #1, {2}], ___, Transpose[{Range[4]}]]
:> #] & ) /@ pat, 1]]
Out[3]= {{{1, 2, 3}, {2, 4, 5}, {1, 4, 6}},
{{6, 7, 8}, {6, 8, new}, {7,8,9}}}

Peter Pein,
Germany

```

• Prev by Date: Re: 1-liner wanted
• Next by Date: Re: Error Message on Magnification
• Previous by thread: Re: 1-liner wanted
• Next by thread: Re: 1-liner wanted