4
$\begingroup$

I have a list

{{1, 4, 1, -3}, {1, 4, 1, -1}, {1, 4, 2, -2}, {1, 5, 2, -4}, {1, 5, 
  2, -1}, {1, 5, 4, -3}, {1, 5, 4, -2}, {1, 6, 3, -5}, {1, 6, 
  3, -1}, {1, 7, 4, -6}, {1, 7, 4, -1}, {1, 8, 5, -7}, {1, 8, 
  5, -1}, {2, 5, 1, -1}, {2, 7, 1, -3}, {2, 7, 3, -1}, {2, 7, 
  4, -2}, {2, 9, 2, -4}, {2, 9, 5, -1}, {3, 6, 1, -1}, {3, 7, 
  2, -1}, {3, 8, 2, -2}, {3, 8, 3, -1}, {3, 9, 4, -2}, {3, 9, 
  4, -1}, {3, 10, 1, -3}, {3, 10, 5, -1}, {4, 7, 1, -1}, {4, 9, 
  3, -1}, {5, 8, 1, -1}, {5, 9, 2, -1}, {5, 10, 3, -1}, {6, 9, 
  1, -1}, {7, 10, 1, -1}}

In the list there are some sets have first three elements equal. For exmaple, {1, 4, 1, -3} and {1, 4, 1, -1}. With two this sets, I want to have {1, 4, 1, -3, -1}. How can I get like that for all sets in list? After that, remove the sets have four elements.

$\endgroup$
8
  • $\begingroup$ With[{gb = GatherBy[#, #[[;; 3]] &]}, Flatten /@ Transpose[{gb[[All, 1, ;; 3]], Flatten /@ gb[[All, All, 4 ;;]]}]] &@list $\endgroup$
    – ciao
    Aug 25, 2016 at 4:40
  • $\begingroup$ Join[#[[1, ;; 3]], Flatten@#[[All, 4 ;;]]] & /@ GatherBy[list, #[[;; 3]] &] $\endgroup$ Aug 25, 2016 at 4:40
  • $\begingroup$ Does your list have sets of length 4 only? $\endgroup$ Aug 25, 2016 at 4:43
  • $\begingroup$ @ciao and JHM Please see update. $\endgroup$ Aug 25, 2016 at 4:44
  • $\begingroup$ Join[#[[1, ;; 3]], Flatten@#[[All, 4 ;;]]] & /@ DeleteCases[GatherBy[list, #[[;; 3]] &], {_List}] $\endgroup$ Aug 25, 2016 at 4:45

3 Answers 3

4
$\begingroup$

Where list is your list,

Join[#[[1, ;; 3]], Flatten@#[[All, 4 ;;]]] & /@ 
 DeleteCases[GatherBy[list, #[[;; 3]] &], {_List}]

(* {{1, 4, 1, -3, -1}, {1, 5, 2, -4, -1}, {1, 5, 4, -3, -2}, {1, 6, 
  3, -5, -1}, {1, 7, 4, -6, -1}, {1, 8, 5, -7, -1}, {3, 9, 4, -2, -1}} *)

Modifying @ciao 's code:

With[{gb = DeleteCases[GatherBy[#, #[[;; 3]] &], {_List}]}, 
   Flatten /@ 
    Transpose[{gb[[All, 1, ;; 3]], 
      Flatten /@ gb[[All, All, 4 ;;]]}]] &@list

(* {{1, 4, 1, -3, -1}, {1, 5, 2, -4, -1}, {1, 5, 4, -3, -2}, {1, 6, 
  3, -5, -1}, {1, 7, 4, -6, -1}, {1, 8, 5, -7, -1}, {3, 9, 4, -2, -1}} *)
$\endgroup$
6
$\begingroup$
KeyValueMap[
   If[Length[#2] == 1, Nothing, Join[##]] &
] @  GroupBy[data, Most -> Last]
 {{1, 4, 1, -3, -1}, {1, 5, 2, -4, -1}, {1, 5, 4, -3, -2}, {1, 6, 
   3, -5, -1}, {1, 7, 4, -6, -1}, {1, 8, 5, -7, -1}, {3, 9, 4, -2, -1}}
$\endgroup$
1
  • $\begingroup$ Nothing seems like something I will use (pun intended) +1 :) $\endgroup$
    – ubpdqn
    Aug 25, 2016 at 11:01
2
$\begingroup$
list =
  {{1, 4, 1, -3}, {1, 4, 1, -1}, {1, 4, 2, -2}, {1, 5, 2, -4}, 
   {1, 5, 2, -1}, {1, 5, 4, -3}, {1, 5, 4, -2}, {1, 6, 3, -5}, 
   {1, 6, 3, -1}, {1, 7, 4, -6}, {1, 7, 4, -1}, {1, 8, 5, -7}, 
   {1, 8, 5, -1}, {2, 5, 1, -1}, {2, 7, 1, -3}, {2, 7, 3, -1}, 
   {2, 7, 4, -2}, {2, 9, 2, -4}, {2, 9, 5, -1}, {3, 6, 1, -1}, 
   {3, 7, 2, -1}, {3, 8, 2, -2}, {3, 8, 3, -1}, {3, 9, 4, -2}, 
   {3, 9, 4, -1}, {3, 10, 1, -3}, {3, 10, 5, -1}, {4, 7, 1, -1}, 
   {4, 9, 3, -1}, {5, 8, 1, -1}, {5, 9, 2, -1}, {5, 10, 3, -1}, 
   {6, 9, 1, -1}, {7, 10, 1, -1}};

Using SequenceCases

SequenceCases[list, {{a__, x_}, {a__, y_}} :> {a, x, y}]

{{1, 4, 1, -3, -1}, {1, 5, 2, -4, -1}, {1, 5, 4, -3, -2},
{1, 6, 3, -5, -1}, {1, 7, 4, -6, -1}, {1, 8, 5, -7, -1},
{3, 9, 4, -2, -1}}

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.