80
\$\begingroup\$

Assume we want to shift an array like it is done in the 2048 game: if we have two equal consecutive elements in array, merge them into twice the value element. Shift must return a new array, where every pair of consecutive equal elements is replaced with their sum, and pairs should not intersect. Shifting is performed only once, so we don't need to merge resulting values again. Notice that if we have 3 consecutive equal elements, we have to sum rightmost ones, so for example, [2, 2, 2] should become [2, 4], not [4, 2].

The task is to write shortest function which takes an array and returns a shifted array.

You may assume that all integers will be strictly positive.

Examples:

[] -> []
[2, 2, 4, 4] -> [4, 8]
[2, 2, 2, 4, 4, 8] -> [2, 4, 8, 8]
[2, 2, 2, 2] -> [4, 4]
[4, 4, 2, 8, 8, 2] -> [8, 2, 16, 2]
[1024, 1024, 512, 512, 256, 256] -> [2048, 1024, 512]
[3, 3, 3, 1, 1, 7, 5, 5, 5, 5] -> [3, 6, 2, 7, 10, 10]

I am also very interested in solution using reduce :)

\$\endgroup\$
  • 11
    \$\begingroup\$ This is a very nice first challenge. Welcome to the site! \$\endgroup\$ – DJMcMayhem Oct 5 '16 at 20:12
  • 1
    \$\begingroup\$ Input is not necessarily sorted and numbers are greater than zero, that is the only restriction on numbers. We may let largest value fit in standard int32 bounds i think. Empty array gives empty array as a result. Thanks for the participation, appreciate that :) \$\endgroup\$ – greenwolf Oct 6 '16 at 1:52
  • 3
    \$\begingroup\$ To those still voting to close as unclear, the challenge essentially boils down to this: Assume you have an array of positive integers. Walk through it from end to start. If the current element is equal to the next, replace it with the sum of both and move to the element after the replacement, then perform this check again for that element and the next. Repeat until the beginning of the array is reached. \$\endgroup\$ – user2428118 Oct 6 '16 at 9:49
  • 1
    \$\begingroup\$ @Titus "Notice that if we have 3 consecutive equal elements, we have to sum rightmost ones, so for example, [2, 2, 2] should become [2, 4], not [4, 2]." \$\endgroup\$ – Martin Ender Oct 6 '16 at 10:38
  • 1
    \$\begingroup\$ The ruling on empty arrays is unfortunate; it has invalidated a few answers, including my own. \$\endgroup\$ – Dennis Oct 6 '16 at 14:31

42 Answers 42

21
\$\begingroup\$

Jelly, 10 9 8 bytes

Œg+2/€UF

TryItOnline or run all test cases

How?

Œg+2/€UF - Main link: a                 e.g. [2,2,2,4,4,8]
Œg       - group runs of equal elements      [[2,2,2],[4,4],[8]]
   2/€   - pairwise reduce for each with
  +      -     addition                      [[4,2],[8],[8]]
      U  - reverse (vectorises)              [[2,4],[8],[8]]
       F - flatten list                      [2,4,8,8]
\$\endgroup\$
19
\$\begingroup\$

Haskell, 47 57 50 bytes

e#l|a:b<-l,e==a= -2*a:b|1<2=e:l
map abs.foldr(#)[]

Uses reduce (or fold as it is called in Haskell, here a right-fold foldr). Usage example: map abs.foldr(#)[] $ [2,2,2,4,4,8] -> [2,4,8,8].

Edit: +10 bytes to make it work for unsorted arrays, too. Merged numbers are inserted as negative values to prevent a second merge. They are corrected by a final map abs.

\$\endgroup\$
  • \$\begingroup\$ The trick with negatives is really nice! \$\endgroup\$ – xnor Oct 6 '16 at 17:19
14
\$\begingroup\$

Brain-Flak, 158 96

{({}<>)<>}<>{(({}<>)<><(({})<<>({}<>)>)>)({}[{}]<(())>){((<{}{}>))}{}{{}(<({}{})>)}{}({}<>)<>}<>

Try it online!

Explanation:

1 Reverse the list (moving everything to the other stack, but that doesn't matter)

{({}<>)<>}<>
{        }   #keep moving numbers until you hit the 0s from an empty stack
 ({}<>)      #pop a number and push it on the other stack
       <>    #go back to the original stack
          <> #after everything has moved, switch stacks

2 Do steps 3-6 until there is nothing left on this stack:

{                                                                                         }

3 Duplicate the top two elements (2 3 -> 2 3 2 3)

(({}<>)<><(({})<<>({}<>)>)>)

(({}<>)<>                   #put the top number on the other stack and back on the very top
         <(({})             #put the next number on top after:
               <<>({}<>)>   #copying the original top number back to the first stack
                         )>)

4 Put a 1 on top if the top two are equal, a 0 otherwise (from the wiki)

({}[{}]<(())>){((<{}{}>))}{}

5 If the top two were equal (non-zero on the top) add the next two and push the result

{{}(<({}{})>)}{}
{            }   #skip this if there is a 0 on top
 {}              #pop the 1
   (<      >)    #push a 0 after:
     ({}{})      #pop 2 numbers, add them together and push them back on 
              {} #pop off the 0

6 Move the top element to the other stack

({}<>)<>

7 Switch to the other stack and print implicitly

<>
\$\endgroup\$
  • \$\begingroup\$ pls add comma after language name, otherwise it breaks leaderboard ty :P \$\endgroup\$ – ASCII-only May 29 '18 at 7:04
9
\$\begingroup\$

PHP, 116 Bytes

<?$r=[];for($c=count($a=$_GET[a]);$c-=$x;)array_unshift($r,(1+($x=$a[--$c]==$a[$c-1]))*$a[$c]);echo json_encode($r);

or

<?$r=[];for($c=count($a=$_GET[a]);$c--;)$r[]=$a[$c]==$a[$c-1]?2*$a[$c--]:$a[$c];echo json_encode(array_reverse($r));

-4 Bytes if the output can be an array print_r instead of 'json_encode`

176 Bytes to solve this with a Regex

echo preg_replace_callback("#(\d+)(,\\1)+#",function($m){if(($c=substr_count($m[0],$m[1]))%2)$r=$m[1];$r.=str_repeat(",".$m[1]*2,$c/2);return trim($r,",");},join(",",$_GET[a]));
\$\endgroup\$
  • 1
    \$\begingroup\$ You cannot use sort as the result is not always sorted : [4, 4, 2, 8, 8, 2] -> [8, 2, 16, 2] \$\endgroup\$ – Crypto Oct 6 '16 at 9:36
  • \$\begingroup\$ @Crypto You are right after the new test cases has been added. Before the use of sort was okay \$\endgroup\$ – Jörg Hülsermann Oct 6 '16 at 10:02
  • \$\begingroup\$ for($i=count($a=$argv);--$i;)$b[]=($a[$i]==$a[$i-1])?2*$a[$i--]:$a[$i];print_r(array_reverse($b)); same idea but shorter \$\endgroup\$ – Crypto Oct 6 '16 at 12:10
  • \$\begingroup\$ @Crypto I'm not sure about the output as string representation or an array. for the testcase [] I need $r=[]; Thank You for your help \$\endgroup\$ – Jörg Hülsermann Oct 6 '16 at 14:17
9
\$\begingroup\$

GNU sed, 41 38 37

Includes +1 for -r
-3 Thanks to Digital Trauma
-1 Thanks to seshoumara

:
s,(.*)(1+) \2\b,\1!\2\2!,
t
y,!, ,

Input and output are space separated strings in unary (based on this consensus).

Try it online!

\$\endgroup\$
  • \$\begingroup\$ Use y,!, , to save 1 byte. \$\endgroup\$ – seshoumara Oct 7 '16 at 22:54
  • \$\begingroup\$ @seshoumara Duh... Why didn't I think of that. Thanks! \$\endgroup\$ – Riley Oct 7 '16 at 22:56
8
\$\begingroup\$

Retina, 32

\d+
$*
r`\b\1 (1+)\b
$1$1
1+
$.&

r on line 3 activates right-to-left regex matching. And this means that the \1 reference needs to come before the (1+) capturing group that it references.

Try it online.

\$\endgroup\$
  • \$\begingroup\$ Nice.. That right-to-left option to match is quite handy! Is it part of .Net regex or a Retina feature? \$\endgroup\$ – Dada Oct 5 '16 at 20:53
  • \$\begingroup\$ I was just about to post mine at 26, using linefeed-separation as the input format: retina.tryitonline.net/… the main savings come from that and using transliteration to get rid of the second substitution. \$\endgroup\$ – Martin Ender Oct 5 '16 at 20:53
  • \$\begingroup\$ @Dada It's a .NET feature (and it's used under the hood to enable arbitrary-length lookbehinds). Retina has no unique regex features yet (although it has some unique substitution features). \$\endgroup\$ – Martin Ender Oct 5 '16 at 20:54
  • 1
    \$\begingroup\$ @MartinEnder Ok thanks! .NET regex's are really great! jealous perl coder spotted \$\endgroup\$ – Dada Oct 5 '16 at 21:00
  • \$\begingroup\$ @MartinEnder I your solution is different enough to warrant another answer \$\endgroup\$ – Digital Trauma Oct 5 '16 at 21:00
8
\$\begingroup\$

Perl, 41 bytes

Includes +1 for -p

Give input sequence on STDIN:

shift2048.pl <<< "2 2 2 4 4 8 2"

shift2048.pl:

#!/usr/bin/perl -p
s/.*\K\b(\d+) \1\b/2*$1.A/e&&redo;y/A//d
\$\endgroup\$
8
\$\begingroup\$

Python, 61 bytes

def f(l):b=l[-2:-1]==l[-1:];return l and f(l[:~b])+[l[-1]<<b]

The Boolean b checks whether the last two elements should collapse by checking that they are equal in a way that's safe for lists of length 1 or 0. The last element if then appended with a multiplier of 1 for equal or 2 for unequal. It's appended to the recursive result on the list with that many elements chopped off the end. Thanks to Dennis for 1 byte!

\$\endgroup\$
  • \$\begingroup\$ [l[-1]<<b] saves a byte. \$\endgroup\$ – Dennis Oct 6 '16 at 14:34
  • \$\begingroup\$ l[-2:-1] is [l[-2]] \$\endgroup\$ – mbomb007 Oct 6 '16 at 19:21
  • 2
    \$\begingroup\$ I need it to work for lists of size 0 and 1. \$\endgroup\$ – xnor Oct 7 '16 at 1:12
7
\$\begingroup\$

Perl, 43 + 1 (-p) = 44 bytes

Ton Hospel came up with 41 bytes answer, check it out!

-4 thanks to @Ton Hospel!

Edit : added \b, as without it it was failing on input like 24 4 on which the output would have been 28.

$_=reverse reverse=~s/(\b\d+) \1\b/$1*2/rge

Run with -p flag :

perl -pe '$_=reverse reverse=~s/(\b\d+) \1\b/$1*2/rge' <<< "2 2 2 4 4"


I don't see another way than using reverse twice to right-fold (as just s/(\d+) \1/$1*2/ge would left-fold, i.e 2 2 2 would become 4 2 instead of 2 4). So 14 bytes lost thanks to reverse... Still I think there must be another (better) way (it's perl after all!), let me know if you find it!

\$\endgroup\$
  • \$\begingroup\$ reverse reverse seems a bit lengthy. I'm no expert in Perl, but is there a way you can make a shortcut to reverse (if nothing else, [ab]using eval)? \$\endgroup\$ – Cyoce Oct 6 '16 at 4:37
  • \$\begingroup\$ Nice sexeger. Notice you can just leave out the ($_) \$\endgroup\$ – Ton Hospel Oct 6 '16 at 7:32
  • \$\begingroup\$ @TonHospel thanks. Indeed, the doc of reverse looks like reverse can't be called without argument (well the examples show it can be, but there is only one prototype : reverse LIST), so I forgot about $_ being the default argument ;) \$\endgroup\$ – Dada Oct 6 '16 at 7:59
  • \$\begingroup\$ A LIST can be empty... \$\endgroup\$ – Ton Hospel Oct 6 '16 at 8:51
  • \$\begingroup\$ @TonHospel indeed, but usually when an operator uses $_ as default argument, the doc specifies a prototype with no parameters (like print or lenght...). Or maybe that's just an wrong impression I have. \$\endgroup\$ – Dada Oct 6 '16 at 11:31
7
\$\begingroup\$

JavaScript (ES6), 68 bytes

f=a=>a.reduceRight((p,c)=>(t=p[0],p.splice(0,c==t,c==t?c+t:c),p),[])
    
console.log([
  [],
  [2, 2, 4, 4],
  [2, 2, 2, 4, 4, 8],
  [2, 2, 2, 2],
  [4, 4, 2, 8, 8, 2],
  [1024, 1024, 512, 512, 256, 256],
  [3, 3, 3, 1, 1, 7, 5, 5, 5, 5],
].map(f))

\$\endgroup\$
  • 2
    \$\begingroup\$ Not bad, but according to the executed snippet: [1024, 1024, 512, 512, 256, 256] is resolving as [2048, 512, 1024] and not [2048, 1024, 512]...? \$\endgroup\$ – WallyWest Oct 6 '16 at 22:01
7
\$\begingroup\$

Perl 5.10, 61 50 bytes (49 + 1 for flag)

Thanks to Ton Hospel for saving 11 bytes!

Regex-free solution, with -a flag:

@a=($F[-1]-$b?$b:2*pop@F,@a)while$b=pop@F;say"@a"

Try here!

\$\endgroup\$
  • \$\begingroup\$ Nice alternative method. A pity arrays almost always lose to strings in perl. Still, you can get a bit closer by golfing your code to @a=($F[-1]-$b?$b:2*pop@F,@a)while$b=pop@F;say"@a" (50 bytes) \$\endgroup\$ – Ton Hospel Oct 6 '16 at 9:28
  • \$\begingroup\$ @TonHospel Indeed, I tend to avoid string-based solutions (just to show that Perl can do more than that!). I don't play to win anyway :D Thanks for the golfing tips! \$\endgroup\$ – Paul Picard Oct 7 '16 at 9:02
7
\$\begingroup\$

JavaScript (ES6), 68 65 58 57 65 64 bytes

Saved 1 byte thanks to @l4m2

Fixed for unsorted arrays now that it has been clarified that such inputs are to be expected.

f=(a,l=[],m)=>(x=a.pop())*!m-l?f(a,x).concat(l):x?f(a,2*x,1):[l]

console.log(f([2, 2, 4, 4]));
console.log(f([2, 2, 2, 4, 4, 8]));
console.log(f([2, 2, 2, 2]));
console.log(f([4, 2, 2]));

\$\endgroup\$
  • 1
    \$\begingroup\$ I was about to suggest the edit you just made :) \$\endgroup\$ – ETHproductions Oct 5 '16 at 22:13
  • \$\begingroup\$ a=>(a.reverse()+'').replace(/(.),\1/g,(c,i)=>i*2).split`,`.reverse()? \$\endgroup\$ – l4m2 May 29 '18 at 1:37
  • \$\begingroup\$ @l4m2 That does work for single-digit inputs, but would fail on [1024, 1024, 512, 512, 256, 256] (I think this test case may have been added later). \$\endgroup\$ – Arnauld May 29 '18 at 1:52
  • \$\begingroup\$ @Arnauld Well yours also fail ... \$\endgroup\$ – l4m2 May 29 '18 at 2:01
  • \$\begingroup\$ f=(a,l=[],m)=>(x=a.pop())*!m-l?f(a,x).concat(l):x?f(a,2*x,1):[l]? \$\endgroup\$ – l4m2 May 29 '18 at 2:03
6
\$\begingroup\$

05AB1E, 26 bytes

D¥__X¸«DgL*ê¥X¸«£vy2ôO})í˜

Try it online!

Generalized steps

  1. Reduce by subtraction to find where consecutive elements differ
  2. Reduce by subtraction over the indices of those places to find the length of consecutive elements
  3. Split input into chunks of those lengths
  4. Split chunks into pairs
  5. Sum each pair
  6. Reverse each summed chunk
  7. Flatten to 1-dimensional list
\$\endgroup\$
5
\$\begingroup\$

Mathematica, 53 bytes

Join@@(Reverse[Plus@@@#~Partition~UpTo@2]&/@Split@#)&

Explanation

Split@#

Split the input into sublists consisting of runs of identical elements. i.e. {2, 2, 2, 4, 8, 8} becomes {{2, 2, 2}, {4}, {8, 8}}.

#~Partition~UpTo@2

Partition each of the sublist into partitions length at most 2. i.e. {{2, 2, 2}, {4}, {8, 8}} becomes {{{2, 2}, {2}}, {{4}}, {{8, 8}}}.

Plus@@@

Total each partition. i.e. {{{2, 2}, {2}}, {{4}}, {{8, 8}}} becomes {{4, 2}, {4}, {16}}.

Reverse

Reverse the results because Mathematica's Partition command goes from left to right, but we want the partitions to be in other direction. i.e. {{4, 2}, {4}, {16}} becomes {{2, 4}, {4}, {16}}.

Join@@

Flatten the result. i.e. {{2, 4}, {4}, {16}} becomes {2, 4, 4, 16}.

\$\endgroup\$
  • \$\begingroup\$ Hi JHM! Thanks for the answer. I don't understand Mathematica very well, so could you add a bit of explanation as to what's going on? \$\endgroup\$ – isaacg Oct 6 '16 at 5:21
  • \$\begingroup\$ Plus@@@ is Tr/@ and I think you can avoid the parentheses and Join@@ if you use ##&@@ on the result of Reverse (haven't tested it though). \$\endgroup\$ – Martin Ender Oct 6 '16 at 7:27
5
\$\begingroup\$

Java 7, 133 bytes

Object f(java.util.ArrayList<Long>a){for(int i=a.size();i-->1;)if(a.get(i)==a.get(i-1)){a.remove(i--);a.set(i,a.get(i)*2);}return a;}

Input is an ArrayList, and it just loops backwards, removing and doubling where necessary.

Object f(java.util.ArrayList<Long>a){
    for(int i=a.size();i-->1;)
        if(a.get(i)==a.get(i-1)){
            a.remove(i--);
            a.set(i,a.get(i)*2);
        }
    return a;
}
\$\endgroup\$
  • \$\begingroup\$ You're comparing Long references on line 3 with ==. Consider a.get(i)-a.get(i-1)==0. \$\endgroup\$ – Jakob May 29 '18 at 0:17
4
\$\begingroup\$

Perl, 37 bytes

Includes +4 for -0n

Run with the input as separate lines on STDIN:

perl -M5.010 shift2048.pl
2
2
2
4
4
8
2
^D

shift2048.pl:

#!/usr/bin/perl -0n
s/\b(\d+
)(\1|)$//&&do$0|say$1+$2
\$\endgroup\$
4
\$\begingroup\$

Haskell, 56 bytes

g(a:b:r)|a==b=a+b:g r|l<-b:r=a:g l
g x=x
r=reverse
r.g.r
\$\endgroup\$
4
\$\begingroup\$

PHP, 86 100 99 94 bytes

for($r=[];$v=+($p=array_pop)($a=&$argv);)array_unshift($r,end($a)-$v?$v:2*$p($a));print_r($r);

requires PHP 7.0; takes values from command line arguments.

Run with -nr or try it online.

\$\endgroup\$
  • 2
    \$\begingroup\$ [2, 2, 2] returns [4,2] instead of [2,4] \$\endgroup\$ – Crypto Oct 6 '16 at 9:45
  • \$\begingroup\$ for($r=[];$v=($p=array_pop)($a=&$_GET[a]);)array_unshift($r,end($a)-$v?$v:2*$p($a));print_r($r); is 1 Byte shorter \$\endgroup\$ – Jörg Hülsermann Oct 6 '16 at 11:03
3
\$\begingroup\$

Julia 205 bytes

t(x)=Val{x}
s(x)=t(x)()
f^::t(1)=f
^{y}(f,::t(y))=x->f(((f^s(y-1))(x)))
g()=[]
g{a}(::t(a))=[a]
g{a}(::t(a),B...)=[a;g(B...)]
g{a}(::t(a),::t(a),B...)=[2a;g(B...)]
K(A)=g(s.(A)...)
H(A)=(K^s(length(A)))(A)

Function to be called is H

eg H([1,2,2,4,8,2,])

This is in no way the shortest way do this in julia. But it is so cool, that I wanted to share it anyway.

  • t(a) is a value-type, representing the value (a).
  • s(a) is an instance of that value type
  • g is a function that dispatches on the difference values (using the value types) and numbers of its parameters. And that is cool
  • K just wraps g so that

Extra cool part:

f^::t(1)=f
^{y}(f,::t(y))=x->f(((f^s(y-1))(x)))

This defines the ^ operator to apply to functions. So that K^s(2)(X) is same as K(K(X)) so H is just calling K on K a bunch of times -- enough times to certainly collapse any nested case

This can be done much much shorter, but this way is just so fun.

\$\endgroup\$
3
\$\begingroup\$

PowerShell v2+, 81 bytes

param($n)($b=$n[$n.count..0]-join','-replace'(\d+),\1','($1*2)'|iex)[$b.count..0]

Takes input as an explicit array $n, reverses it $n[$n.count..0], -joins the elements together with a comma, then regex -replaces a matching digit pair with the first element, a *2, and surrounded in parens. Pipes that result (which for input @(2,2,4,4) will look like (4*2),(2*2)) over to iex (short for Invoke-Expression and similar to eval), which converts the multiplication into actual numbers. Stores the resulting array into $b, encapsulates that in parens to place it on the pipeline, then reverses $b with [$b.count..0]. Leaves the resulting elements on the pipeline, and output is implicit.


Test Cases

NB-- In PowerShell, the concept of "returning" an empty array is meaningless -- it's converted to $null as soon as it leaves scope -- and so it is the equivalent of returning nothing, which is what is done here in the first example (after some wickedly verbose errors). Additionally, the output here is space-separated, as that's the default separator for stringified arrays.

PS C:\Tools\Scripts\golfing> @(),@(2,2,4,4),@(2,2,2,4,4,8),@(2,2,2,2),@(4,4,2,8,8,2),@(1024,1024,512,512,256,256),@(3,3,3,1,1,7,5,5,5,5)|%{"$_ --> "+(.\2048-like-array-shift.ps1 $_)}
Invoke-Expression : Cannot bind argument to parameter 'Command' because it is an empty string.
At C:\Tools\Scripts\golfing\2048-like-array-shift.ps1:7 char:67
+   param($n)($b=$n[$n.count..0]-join','-replace'(\d+),\1','($1*2)'|iex)[$b.count. ...
+                                                                   ~~~
    + CategoryInfo          : InvalidData: (:String) [Invoke-Expression], ParameterBindingValidationException
    + FullyQualifiedErrorId : ParameterArgumentValidationErrorEmptyStringNotAllowed,Microsoft.PowerShell.Commands.InvokeExpressionCommand

Cannot index into a null array.
At C:\Tools\Scripts\golfing\2048-like-array-shift.ps1:7 char:13
+   param($n)($b=$n[$n.count..0]-join','-replace'(\d+),\1','($1*2)'|iex)[$b.count. ...
+             ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    + CategoryInfo          : InvalidOperation: (:) [], RuntimeException
    + FullyQualifiedErrorId : NullArray

 --> 
2 2 4 4 --> 4 8
2 2 2 4 4 8 --> 2 4 8 8
2 2 2 2 --> 4 4
4 4 2 8 8 2 --> 8 2 16 2
1024 1024 512 512 256 256 --> 2048 1024 512
3 3 3 1 1 7 5 5 5 5 --> 3 6 2 7 10 10
\$\endgroup\$
3
\$\begingroup\$

Javascript - 103 bytes

v=a=>{l=a.length-1;for(i=0;i<l;i++)a[l-i]==a[l-1-i]?(a[l-i-1]=a[l-i]*2,a.splice(l-i,1)):a=a;return a}
\$\endgroup\$
  • \$\begingroup\$ Saved 16 bytes thanks to @MayorMonty tips on this page \$\endgroup\$ – Alexis_A Oct 9 '16 at 13:52
  • \$\begingroup\$ This doesn't work. Testing with [2,2,4,4] yields [2,2,4,4]. \$\endgroup\$ – Conor O'Brien Oct 10 '16 at 2:03
  • 1
    \$\begingroup\$ yup. Node v6.2.1 \$\endgroup\$ – Conor O'Brien Oct 10 '16 at 2:23
  • \$\begingroup\$ My bad .. I was running it with another JS code in the same file and the global variables got mixed up. \$\endgroup\$ – Alexis_A Oct 10 '16 at 2:28
3
\$\begingroup\$

Brain-Flak, 60 bytes

{({}<>)<>}<>{(({}<>)<>[({})]){((<{}>))}{}{({}<>{})(<>)}{}}<>

Try it online!

Explanation:

{({}<>)<>}<>   Reverse stack

{   While input exists
  (
    ({}<>)   Push copy of last element to the other stack
    <>[({})] And subtract a copy of the next element
  )   Push the difference
  {   If the difference is not 0
    ((<{}>)) Push two zeroes
  }{}  Pop a zero
  {   If the next element is not zero, i.e the identical element
    ({}<>{})  Add the element to the copy of the previous element
    (<>)      Push a zero
  }{}    Pop the zero
}<>  End loop and switch to output stack
\$\endgroup\$
2
\$\begingroup\$

Python 2, 94 bytes

def f(a,r=[]):
 while a:
    if len(a)>1and a[-1]==a[-2]:a.pop();a[-1]*=2
    r=[a.pop()]+r
 print r

Try it online

\$\endgroup\$
2
\$\begingroup\$

Julia, 73 82 Bytes

f(l)=l==[]?[]:foldr((x,y)->y[]==x?vcat(2x,y[2:end]):vcat(x,y),[l[end]],l[1:end-1])

Use right fold to build list from back to front (one could also use fold left and reverse the list at the beginning and end).

If the head of the current list is not equal to the next element to prepend, then just prepend it.

Else remove the head of the list (sounds kind of cruel) and prepend the element times 2.

Example

f([3,3,3,1,1,7,5,5,5,5]) 
returns a new list:
[3,6,2,7,10,10]
\$\endgroup\$
2
\$\begingroup\$

Racket 166 bytes

(λ(l)(let g((l(reverse l))(o '()))(cond[(null? l)o][(=(length l)1)(cons(car l)o)]
[(=(car l)(second l))(g(drop l 2)(cons(* 2(car l))o))][(g(cdr l)(cons(car l)o))])))

Ungolfed:

(define f
  (λ (lst)
    (let loop ((lst (reverse lst)) 
               (nl '()))
      (cond                            ; conditions: 
        [(null? lst)                   ; original list empty, return new list;
               nl]
        [(= (length lst) 1)            ; single item left, add it to new list
              (cons (first lst) nl)]
        [(= (first lst) (second lst))  ; first & second items equal, add double to new list
              (loop (drop lst 2) 
                    (cons (* 2 (first lst)) nl))]
        [else                          ; else just move first item to new list
              (loop (drop lst 1) 
                    (cons (first lst) nl))]  
        ))))

Testing:

(f '[])
(f '[2 2 4 4]) 
(f '[2 2 2 4 4 8]) 
(f '[2 2 2 2]) 
(f '[4 4 2 8 8 2])
(f '[1024 1024 512 512 256 256]) 
(f '[3 3 3 1 1 7 5 5 5 5])
(f '[3 3 3 1 1 7 5 5 5 5 5])

Output:

'()
'(4 8)
'(2 4 8 8)
'(4 4)
'(8 2 16 2)
'(2048 1024 512)
'(3 6 2 7 10 10)
'(3 6 2 7 5 10 10)
\$\endgroup\$
1
\$\begingroup\$

Japt, 12 bytes

ò¦ ®ò2n)mxÃc

Try it online!

Unpacked & How it works

Uò!= mZ{Zò2n)mx} c

Uò!=    Partition the input array where two adjacent values are different
        i.e. Split into arrays of equal values
mZ{     Map the following function...
Zò2n)     Split into arrays of length 2, counting from the end
          e.g. [2,2,2,2,2] => [[2], [2,2], [2,2]]
mx        Map `Array.sum` over it
}
c       Flatten the result

Got some idea from Jonathan Allan's Jelly solution.

\$\endgroup\$
0
\$\begingroup\$

Mathematica, 51 bytes

Abs[#//.{Longest@a___,x_/;x>0,x_,b___}:>{a,-2x,b}]&

{Longest@a___,x_/;x>0,x_,b___} matches a list containing two consecutive identical positive numbers and transform these two numbers into -2x. Longest forces the matches to happen as late as possible.

The process is illustrated step by step:

   {3, 3, 3, 1, 1, 7, 5, 5, 5, 5}
-> {3, 3, 3, 1, 1, 7, 5, 5, -10}
-> {3, 3, 3, 1, 1, 7, -10, -10}
-> {3, 3, 3, -2, 7, -10, -10}
-> {3, -6, -2, 7, -10, -10}
-> {3, 6, 2, 7, 10, 10}
\$\endgroup\$
0
\$\begingroup\$

Vim, 28 bytes

G@='?\v(\d+)\n\1<C-@>DJ@"<C-A>-@=<C-@>'<CR>

A macro that regex searches backward for matching consecutive numbers, and adds them together.

The input array needs to be one number per line. This format saves me strokes, which is nice, but the real reason is to work around overlapping regex matches. Given the string 222, if you /22 you'll match only the first pair, not the overlapping second pair. The overlap rules are different when the two pairs start on different lines. In this challenge [2, 2, 2] becomes [2, 4], so matching the overlapping pair is critical.

NOTE: The challenge asked for only a single pass. For that reason, you need to have :set nowrapscan. With :set wrapscan I could make a version that finishes the job on multiple passes, though this solution as written won't always do that.

  • <C-@>: Normally, in a command line, to type a literal <CR> without running the command you'd have to escape it with <C-V>. But you can type <C-@> unescaped and it will be treated as a <C-J>/<NL>, which will be like <CR> when you run the macro but not when you're typing. Try reading :help NL-used-for-Nul.
  • @=: I can't use a recorded macro easily this time because there's a possibility the input might have no matching pairs. If that happens while running a macro, the unsuccessful search will fail the macro. But if it happens during the (implicit first) recording pass, the rest of the normal mode commands will run, damaging the file. The downside of @= is I lose a byte on the recursive call; sometimes you can use @@ as a recursive call, but that would run @" from 4 bytes earlier in this case.
  • DJ@"<C-A>-: DJ deletes the line and puts the number (no newline) in a register, so I can run it as a macro for a number argument to <C-A>. I have to - afterward so I don't get a second match in cases like [4, 2, 2].
\$\endgroup\$
0
\$\begingroup\$

Perl6, 92 bytes

{my @b;loop ($_=@^a-1;$_>=0;--$_) {@b.unshift($_&&@a[$_]==@a[$_-1]??2*@a[$_--]!!@a[$_])};@b}
\$\endgroup\$
0
\$\begingroup\$

Prolog (SWI), 97 87 bytes

[N,N|T]+[O|Q]:-O is N*2,T+Q.
[N|T]+[N|Q]:-T+Q.
R+R.
L-R:-reverse(L,M),M+Q,reverse(Q,R).

Try it online!

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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