59
\$\begingroup\$

We have some new sheriffs moderators in town, Mego and DJMcMayhem. We need a challenge to properly honour them for their new positions, so there we go.

Here's something that has caught my attention when hovering over their profiles – their user IDs are \$31716\$ and \$45941\$. If you perform digit-wise subtraction, you'll notice something pretty exciting (of course, taking the absolute differences):

3|1|7|1|6
4|5|9|4|1
-+-+-+-+- (-)
1|4|2|3|5

The number generated by the above algorithm is \$14235\$. There is something special about this integer: It consists of consecutive digits only, sorted in ascending order, but exactly one of the digits is not placed correctly — \$4\$.

We will call a pair of positive integers \$(a, b)\$ a DJMcMego pair if the digit-wise absolute differences are consecutive integers, sorted in ascending order, but exactly one of them is not where it belongs. That is, it is possible to move exactly one digit of the result of digit-wise subtraction to another position, such that the integer obtained only has consecutive digits, sorted in ascending order.

In our example above, the pair \$(31716, 45941)\$ is a DJMcMego pair, because if \$4\$ is moved between \$3\$ and \$5\$, the result is \$12345\$, which fulfils the criteria. Note that the digits of the resulting number do not need to start at \$1\$, they just ought to be consecutive. When one is unsure about what decision they should make, they can always rely on the other's help to sort things out.

Your task is to output a truthy/falsy value depending on whether a pair of positive integers given as input is a DJMcMego pair.

  • You are guaranteed that \$a\$ and \$b\$ will have the same number of digits, always at least 4.

  • You can take the integers in any reasonable format (i.e. native integers, strings, lists of digits, etc.)

  • You can compete in any programming language and can take input and provide output through any standard method, while taking note that these loopholes are forbidden by default. This is , so the shortest submission (in bytes) for every language wins.

Test cases

a, b -> Output

31716, 45941 -> Truthy
12354, 11111 -> Truthy
56798, 22222 -> Truthy
23564, 11111 -> Truthy
1759,  2435  -> Truthy
12345, 11111 -> Falsy
3333,  2101  -> Falsy
22354, 22222 -> Falsy
31717, 45941 -> Falsy
14325, 11111 -> Falsy
89789, 78865 -> Falsy
14954, 61713 -> Falsy
25631, 11114 -> Falsy

Or, in another format.

\$\endgroup\$
15
  • \$\begingroup\$ Can we output truthy for non-DJMcMego pairs and falsy for DJMcMego pairs? Also do the truthy/falsy values need to be consistent? \$\endgroup\$
    – dylnan
    Feb 23, 2018 at 0:20
  • 6
    \$\begingroup\$ @Blacksilver I think I've beaten him to it :P \$\endgroup\$
    – DJMcMayhem
    Feb 23, 2018 at 1:04
  • 2
    \$\begingroup\$ @Mr.Xcoder "Swapping the truthy / falsy values is allowed by default" Is that actually a thing? \$\endgroup\$ Feb 23, 2018 at 8:46
  • 2
    \$\begingroup\$ @Mr.Xcoder Sure, many challenges allow it, but saying "it's allowed by default" implies to me that there's a meta post about it somewhere. \$\endgroup\$ Feb 23, 2018 at 8:51
  • 1
    \$\begingroup\$ Maybe add 25631, 11114 as example. The differences are 14523 which confuses several of the current programs \$\endgroup\$
    – Ton Hospel
    Feb 27, 2018 at 15:27

18 Answers 18

7
\$\begingroup\$

05AB1E, 18 bytes

αDæIg<ùʒD{Q}gĀ*{¥P

Try it online!

\$\endgroup\$
5
  • \$\begingroup\$ You should probably add a note that 1 is the only truthy number in 05AB1E; had Mr. Xcoder not informed me on this fact, I would have questioned the validity of this solution. Could you add an explanation, as well, when you have time? \$\endgroup\$
    – Shaggy
    Feb 23, 2018 at 16:30
  • \$\begingroup\$ @Shaggy You can take a look at my solution's explanation in the meantime: it's not as efficient as Enigma's but we're mostly using the same functions. \$\endgroup\$ Feb 23, 2018 at 16:36
  • \$\begingroup\$ @Shaggy: Didn't have time to add an explanation when I posted this, buty it's done now :) \$\endgroup\$
    – Emigna
    Feb 23, 2018 at 20:19
  • \$\begingroup\$ This fails for the new test case, 14325, 11111 (falsy). \$\endgroup\$
    – Dennis
    Jun 11, 2018 at 4:38
  • \$\begingroup\$ @Dennis: Thanks, should be fixed for now (at the cost of too many bytes). Will have to try and golf this later. \$\endgroup\$
    – Emigna
    Jun 11, 2018 at 6:04
7
\$\begingroup\$

C (gcc), 259 258 254 253 250 248 233 222 bytes

  • Thanks to Stan Strum for inspring a one byte golf.
  • Saved four bytes by juggling some variable initializations.
  • Saved a byte by golfing for(...;l++)b*=B[l]==-~B[l-1]; to for(...;b*=B[l]==-~B[~-l++]); (most likely relying on undefined behaviour, as it requires first evaluating B[l] followed by -~B[~-l++]).
  • Saved three five bytes.
  • Saved fifteen twenty-six bytes thanks to ceilingcat.
j,k,l,L,r,b;f(char*A,char*B){for(j=r=0;k=A[L=j];)A[j++]=-~abs(A[j]-B[j]);for(;k-L;k++)for(j=~0;L-++j;r|=!b)if(k-j)for(bcopy(B-~l,strcpy(B,A)+l,strlen(A+l)),bcopy(B+j,B-~j,L+~j),B[j]=A[k],l=b=0;B[++l];b|=B[l]+~B[~-l]);A=r;}

Try it online!

Explanation (248 byte version)

j,k,l,L,r,b;                            // global variables
f(char*A,char*B){                       // function takes two strings
 for(j=r=0;A[j];L=j)                    // loop through A, compute array length L
  A[j++]=-~abs(A[j]-B[j]);              // set every entry in A to the absolute
                                        // difference of A and B at that position
                                        /* Test out all possible movements of        *
                                         * characters and see if any one             *
                                         * results in a sorted list => DJMcMego pair */
 for(j=0;j-L;j++)                       // loop through array
  for(k=~0;L-++k;r|=!b)                 // loop through array
   if(j-k){                             // j is not equal to k
    for(l=0;A[l];B[l++]=A[l]);          // copy A to B
    for(l=j;A[l];B[~-l]=B[++l]);        // shift part of B
    for(l=L;l-k;B[-~l]=B[--l]);         // shift part of B
    B[k]=A[j];                          // insert character at correct position
    for(l=b=0;B[++l];b|=B[l]+~B[~-l]);} // test if B is sorted
 A=r;}                                  // return if there was a DJMcMego pair found

Try it online!

\$\endgroup\$
7
  • \$\begingroup\$ For loops that only run 1 time, you can skip j=0 as in the 41st char \$\endgroup\$
    – Stan Strum
    Feb 23, 2018 at 1:12
  • \$\begingroup\$ @StanStrum I am fairly certain that you then rely on j having the value 0 which is not necessarily the case after several calls. A function, however, should be arbitrarily often callable and still solve the challenge (relevant meta post). \$\endgroup\$ Feb 23, 2018 at 1:18
  • \$\begingroup\$ @StanStrum You can, however, define j to be zero before the loop and thus save a byte. \$\endgroup\$ Feb 23, 2018 at 12:41
  • \$\begingroup\$ You can shave a byte with f(char*A,char*B){ -> f(A,B)char*A,*B;{. \$\endgroup\$
    – LambdaBeta
    Jun 11, 2018 at 18:54
  • \$\begingroup\$ @LambdaBeta Those two snippets are of equal length. \$\endgroup\$ Jun 11, 2018 at 18:57
4
\$\begingroup\$

JavaScript (ES6), 130 bytes

Takes input as two arrays of digits in currying syntax (a)(b). Returns a boolean.

a=>b=>a.some((_,i)=>a.some((_,j)=>i-j&&!(A=a.map((v,i)=>Math.abs(v-b[i]))).some(v=>v-A[~k--]-1,A.splice(i,0,A.splice(j,1)[k=0]))))

Try it online!

\$\endgroup\$
4
\$\begingroup\$

SWI-Prolog, 157 bytes

Not very short but the problem seemed particularly well-suited for declarative predicates, variable binding and recursion, i.e., Prolog :)

n(T,Y):-s(T,Q,I,J),s(Y,W,I,J),m(Q,W).
s(T,Q,I,J):-nth0(I,T,X,R),nth0(J,Q,X,R),I\=J.
m([A,B|T],[C,D|Y]):-1 is abs(B-D)-abs(A-C),m([B|T],[D|Y]).
m([_],[_]).

Call with, e.g., n([3,1,7,1,6],[4,5,9,4,1]).

Explanation: move an element in both lists to a new position (using the SWI-Prolog nth0 built-in) and check if the difference of the new lists is consecutive.

s(T,Q,I,J)    % switch (yet unbounded) index I and J in list T, store in Q
s(Y,W,I,J)    % switch (now bounded) I and J in list Y
m(Q,W)        % check new lists
s(T,Q,I,J) :- nth0(I,T,X,R) % X (unbounded) is the I-th (unbounded) element 
                            % of list T with rest R (=prefix+postfix) 
nth0(J,Q,X,R) % the same X is the J-th element in list Q with the same rest R
I\=J          % I and J are unequal
m([A,B|T],[C,D|Y]) :-  % consider first two elements of both lists
1 is abs(B-D)-abs(A-C) % check if differences are consecutive                          
m([B|T],[D|Y])         % recursion starting with the second element
m([_],[_]).            % stop recursion at last element in the list
\$\endgroup\$
4
\$\begingroup\$

J, 27 bytes

−8 bytes thanks to FrownyFrog

1"0(-:(2-/\|\:|),1#.2>/\|)-

Try it online!

Initial solution:

J, 35 bytes

[:((1=[:*/2-/\\:~)*1=1#.0<2-/\])|@-

Try it online!

Explanation

Takes lists of digits as input

|@- finds the absolute difference between the digits of the lists

1=1#.0<2-/\] Checks if only one digits is out of its place. First I find the differences between all pairs of adjacent digits and check to see if only one of them is positive.

* Multiply the result from the above test (1 or 0) with the following test:

1=[:*/2-/\\:~ Are all digits consecutive? I sort the list down, take the differences for all pairs of adjacent digits, multiply them and check if it equals 1

\$\endgroup\$
4
  • \$\begingroup\$ Fails for 25634 11111 (as do many other submissions) \$\endgroup\$
    – Ton Hospel
    Feb 27, 2018 at 16:09
  • \$\begingroup\$ @ Ton Hospel - Yes, you are right. I'll check how ti fix it. \$\endgroup\$ Feb 28, 2018 at 18:31
  • \$\begingroup\$ I didn’t fix it, just golfed. \$\endgroup\$
    – FrownyFrog
    Jun 10, 2018 at 19:34
  • \$\begingroup\$ @FrownyFrog Thank you! I have forgotten this problem. \$\endgroup\$ Jun 11, 2018 at 6:15
4
\$\begingroup\$

Jelly, 14 bytes

ạµṢ_JEċ@Œ¿-Ƥ%L

Try it online!

How it works

ạµṢ_JEċ@Œ¿-Ƥ%L  Main link. Arguments: A, B (digit arrays)

ạ               Take the elementwise absolute difference. Call the result R.
 µ              New chain. Argument: R
  Ṣ             Sort R.
    J           Indices; yield [1, ..., len(R)].
   _            Take the elementwise difference.
     E          Test if all differences are equal.
                The result is 1 if R consists of consecutive digits, 0 otherwise.
          -Ƥ    For all outfixes of R, generated by dropping one of its elements:
        Œ¿        Get its permutation index (1 if sorted, higher if not).
      ċ@        Count the number of times the Boolean from the left appears in the
                array to the right. If the Boolean is 1, the count represents the
                number of ways a single digit can be deleted to yield a sorted
                array. The count has to be positive for a DJMcMego pair, but less
                than the length of R, since R may not be sorted.
            %L  Take the result modulo len(R), mapping len(R) to 0.
\$\endgroup\$
0
3
\$\begingroup\$

Japt, 18 bytes

Been debating whether I should post this or not for a couple of hours. Came up with it quickly late last night but didn't have time to test it properly (and I thought it might be too long!). Oliver has since posted a similar solution (which was, when this one was originally posted, invalid) so if he, or the community, feels this is too similar, I'll happily delete it.

Takes input as 2 digit arrays, outputs 0 for true or any other number for false.

íaV
ä> x*Un än × É

Try it or check all test cases


Explanation

                   :Implicit input of digit arrays U and V               :[3,1,7,1,6],[4,5,9,4,1]
í V                :Interleave V with U                                  :[[3,4],[1,5],[7,9],[1,4],[6,1]]
 a                 :Get the absolute difference of each pair             :[1,4,2,3,5]
\n                 :Assign that new array to variable U
ä>                 :Is each element greater than the next?               :[false,true,false,false]
     Un            :Sort U                                               :[1,2,3,4,5]
        än         :Get the deltas                                       :[1,1,1,1]
           ×       :Reduce by multiplication                             :1
    *              :Multiply each element in the boolean array by that   :[0,1,0,0]
   x               :Reduce by addition                                   :1
             É     :Subtract 1                                           :0

And, to walk through that process on a few more test cases:

---------------------------------------------------------------
| U   | [2,3,5,6,4] | [1,2,3,4,5] | [3,1,7,1,7] | [1,4,9,5,4] |
| V   | [1,1,1,1,1] | [1,1,1,1,1] | [4,5,9,4,1] | [6,1,7,1,3] |
|-----|-------------|-------------|-------------|-------------|
| íaV | [1,2,4,5,3] | [0,1,2,3,4] | [1,4,2,3,6] | [5,3,2,4,1] |
|-----|-------------|-------------|-------------|-------------|
| ä>  | [F,F,F,T]   | [F,F,F,F]   | [F,T,F,F]   | [T,T,F,T]   |
|-----|-------------|-------------|-------------|-------------|
| Un  | [1,2,3,4,5] | [0,1,2,3,4] | [1,2,3,4,6] | [1,2,3,4,5] |
| än  | [1,1,1,1]   | [1,1,1,1]   | [1,1,1,2]   | [1,1,1,1]   |
| ×   | 1           | 1           | 2           | 1           |
|-----|-------------|-------------|-------------|-------------|
| *   | [0,0,0,1]   | [0,0,0,0]   | [0,2,0,0]   | [1,1,0,1]   |
| x   | 1           | 0           | 2           | 3           |
| É   | 0           | -1          | 1           | 2           |
---------------------------------------------------------------
\$\endgroup\$
1
  • 2
    \$\begingroup\$ Fails for 25634 11111 (as do many other submissions) \$\endgroup\$
    – Ton Hospel
    Feb 27, 2018 at 16:08
2
\$\begingroup\$

Perl, 121 118 bytes

($a,$b)=map[split//],@ARGV;
$s+=$l>$_,$l=$_ for@c=map abs($$a[$i]-$$b[$i++]),@$a;
@c=sort@c;
say$s==1&&$c[-1]-$c[0]==$#$a

Test in bash:

function golf {
   perl -E'($a,$b)=map[split//],@ARGV;$s+=$l>$_,$l=$_ for@c=map abs($$a[$i]-$$b[$i++]),@$a;@c=sort@c;say$s==1&&$c[-1]-$c[0]==$#$a' $1 $2
}
golf 31716 45941       #says 1, true
golf 12354 11111       #says 1, true
golf 56798 22222       #says 1, true
golf 46798 22222       #says nothing, false
golf 22354 22222       #says nothing, false
golf 1759 2435         #says 1, true
golf 12345 11111       #says nothing, false
golf 89789 78865       #says nothing, false
golf 14954 61713       #says nothing, false
\$\endgroup\$
1
  • \$\begingroup\$ Fails for 25634 11111 (as do many other submissions) \$\endgroup\$
    – Ton Hospel
    Feb 27, 2018 at 16:13
2
\$\begingroup\$

Java 8, 245 227 223 194 188 Bytes

Thanks to Kevin for saving ~29 bytes

Thanks to Kevin again for another 6 bytes

 z->{int l=z.length/2,c[]=new int[l],i=0,j=0;for(;i<l;)c[i]=Math.abs(z[i]-z[i+++l]);java.util.Arrays.sort(z=c.clone());for(i=0;i<l-1;j+=z[i]-z[i-1]!=1?1:0)j+=c[i]-c[++i]>0?1:0;return j==1;}

Followed the same pattern Galen came up with for his J answer.

Try it online!

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

Retina, 102 bytes

+`(.)(.*¶)(.)(.*)
$2$4;$1,$3
\d
*
(_*),\1
_
L$w`(;_+\b)(.*)(;_+\b)
$%`$2$3$1$%"$3$1$2$'
m`(^;_+|\1_)+$

Try it online! Link includes test cases. Returns the number of ways digits can be moved to achieve an ascending sequence, which is 2 for a straight swap since either digit can be moved past the other in that case. Explanation:

+`(.)(.*¶)(.)(.*)
$2$4;$1,$3

Pair up the digits.

\d
*

Convert to unary.

(_*),\1
_

Take the difference, but then add 1 because working with zero in Retina is hard™.

L$w`(;_+\b)(.*)(;_+\b)
$%`$2$3$1$%"$3$1$2$'

List all the sequences of digits obtained by moving exactly one digit.

m`(^;_+|\1_)+$

Check for consecutive digits.

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

Perl 5, -F 87 84 83 bytes

Old style counting: 86 bytes (+3 for -F)

Give he numbers as 2 lines on STDIN, the last line without a trailing newline.

Prints the difference string up to 2 times for true, nothing for false

The long A0123456789 string is really annoying.

#!/usr/bin/perl -F
$_=<>;s%.%abs$&-$F[pos]%eg;s%%"'$`$''=~s:|:A0123456789=~/\$`$&\$'/>//&&say:reg"%eeg

Try it online!

I'm usure if this 79 counts as valid:

$_=<>;s%.%abs$&-$F[pos]%eg;s,,$a=$&;"$`$'"=~s:|:A0123456789=~/$`$a$'/%//:reg,eg

It crashes for a valid pair, so you get a non zero exit code. It does nothing if not a pair and exits with exit code 0. I know returning the result via exit code is allowed, but are they properly truthy and falsy or in fact reversed (for the shell 0 is true) ?

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

Ruby, 124 113 99 95 bytes

->l,b,d=-1{m=l.map!{|i|(i-b[d+=1]).abs}.sort;l.any?{|*i|m-i==l-i}&&m!=l&&/#{m*''}/=~[*0..9]*''}

Try it online!

\$\endgroup\$
3
  • \$\begingroup\$ Fails for 25634 11111 (as do many other submissions) \$\endgroup\$
    – Ton Hospel
    Feb 27, 2018 at 15:37
  • \$\begingroup\$ @TonHospel fixed it, thanks \$\endgroup\$ Feb 27, 2018 at 17:41
  • \$\begingroup\$ Awesome rebound. Have a +1 :-) \$\endgroup\$
    – Ton Hospel
    Feb 27, 2018 at 19:40
1
\$\begingroup\$

Pyt, 20 18 bytes

ą←ą-ÅĐʁ>Ʃ1=⇹ş₋Π1=∧

Try it online!

Explanation:

       Implicitly get the first number
ą      Convert to list of digits
←      Get the second number
ą      Convert to list of digits
-Å     Take the absolute value of the differences of the lists element-wise
Đ      Duplicate the list of differences
ʁ>     Reduce by greater than
Ʃ1=    Is the sum of that array equal to 1
⇹      Swap the top two items on the stack
ş      Sort the top of the stack ascending
₋      Reduce by subtraction (from the right)
Π1=    Is the product of the array equal to 1
∧      bitwise-AND (in this case, also logical AND) the top two items on the stack
       Implicit print
\$\endgroup\$
1
  • 2
    \$\begingroup\$ Fails for 25634 11111 (as do many other submissions) \$\endgroup\$
    – Ton Hospel
    Feb 27, 2018 at 15:50
1
\$\begingroup\$

Add++, 105 bytes

D,w,@~,Ñ_€|BSVcGbU1b]2b]+º=
D,k,@,BPB*
L,BcB_€|B]dBkbUBSVcGbU£>sVcGB]VBKB#BKBcB_0º>b]GBK{w}b]++b*1=BK{k}*

Try it online!

Defines a lambda function that takes two lists of digits as input. Outputs a positive integer divisible by 241 for DJMcMego pairs, 0 otherwise.

1: If this is too restrictive, it also outputs a positive integer for DJMcMego pairs, and 0 otherwise

How it works

Here we perform 4 checks to determine if the input is valid. The parts of the code that do those checks are

BcB_€|B]dBkbUBSVcGbU£>sVcGB]V

Here, we take the list of absolute digit differences, then count the number of overlapping pairs which are sorted in descending order. Every DJMcMego pair produces a result of 1, but they are not unique in this aspect. We also store the inputs' absolute digit differences, to save bytes later. This array will be referred to as A throughout.

BKB#BKBcB_0º>b]

Next, we take the elementwise differences between A and A sorted, before asserting that at least one of those differences is negative.

D,w,@~,Ñ_€|BSVcGbU1b]2b]+º=
GBK{w}b]

Third, we check if the pair [1, 2] is contained in the forward increments of A. This checks that, in at least one position of A, it is sorted, which is a criterion for DJMcMego pairs.

D,k,@,BPB*
BK{k}

As our last check, we assert that the second element of A is never 0. In order for a pair, X and Y, to be a DJMcMego pair, we can assume that their A is always unique, as an array with duplicates in it can never be made consecutive by swapping a single value with another.

Finally, we check that the first three of these tests returned 1, and that the fourth returned a value x such that x ≠ 0

A step for step walk through of the code is as follows

D,w,		; Define a function w;
		;   This takes an array of integers
		;   Returns whether the pair [1, 2] appears in the absolute forward differences
		;
	@	; Take one argument
	~,	; Splat that argument to the stack
		;   Example argument:		[1 4 2 3 5]
		;
	Ñ_	; Increments;		STACK = [3 -2 1 2]
	€|	; Magnitudes;		STACK = [3 2 1 2]
	BSVcGbU	; Overlapping pairs;	STACK = [[3 2] [2 1] [1 2]]
	1b]2b]+	; Push [1 2];		STACK = [[3 2] [2 1] [1 2] [1 2]]
	º=	; Any equal [1 2];	STACK = [1]

; ============= ;

D,k,		; Define a function k;
		;   This function takes an array of integers
		;   Returns whether the second element is 0;
		;
	@,	; Take one argument and push to the stack
		;   Example argument:		[[1 4 2 3 5]]
		;
	BP	; Behead;		STACK = [[4 2 3 5]] 
	B*	; Product;		STACK = [120]
		;
		; In DJMcMego pairs, A may begin with a 0
		; For example, 12354 and 11111, so we need to remove the first element
		; Taking the product yields 0 if any element is 0
		; However, in order to be a DJMcMego pair, two digits at the same index
		;   cannot be the same, otherwise their digit-wise difference will be 0

; ============= ;

L,		; Define a lambda function
		;
		; This lambda function takes two arrays of digits as input
		; Returns an integer to determine if those digits represent a DJMcMego pair
		;
		; A lambda function is shorter to define than a normal function
		; However, when called inside functions with the ] command,
		;   they consume the entire stack as arguments, meaning that using functions
		;   allows us to preserve important values
		;
		; Example arguments:		[[3 1 7 1 6] [4 5 9 4 1]]
		;
		; First check:
		;
	BcB_	; Digit differences;	STACK = [-1 -4 -2 -3 5]
	€|	; Magnitudes;		STACK = [1 4 2 3 5]
	B]dBkbU	; Save a copy, A	STACK = [1 4 2 3 5]			A: [1 4 2 3 5]
	BSVcGbU	; Overlapping pairs;	STACK = [[1 4] [4 2] [2 3] [3 5]]
	£>	; Sorted descendingly?	STACK = [0 1 0 0]
	sVcG	; How many?		STACK = [1]
	B]V	; Save a copy;		STACK = []				Register: [1]
		;
		; Second check:
		;
	BK	; Retrieve A;		STACK = [[1 4 2 3 5]]
	B#	; Sort;			STACK = [[1 2 3 4 5]]
	BK	; Retrieve A;		STACK = [[1 2 3 4 5] [1 4 2 3 5]]
	BcB_	; Element differences;	STACK = [0 -2 1 1 0]
	0º>b]	; Any negatives;	STACk = [[1]]
		;
		; Third and fourth checks:
		;
	G	; Retrieve register;	STACK = [[1] [1]]
	BK	; Retreive A;		STACK = [[1] [1] [1 4 2 3 5]]
	{w}b]	; Run w;		STACK = [[1] [1] [1]]
	++	; Concatenate;		STACK = [[1 1 1]]
	b*1=	; Product = 1;		STACK = [1]
	BK{k}	; Run k;		STACK = [1 120]
	*	; Multiply;		STACK = [120]

		; To force output as 1 and 0 values,
		;   append a ? to the end, to output the sign (forces boolean conversion)
\$\endgroup\$
1
\$\begingroup\$

R, 110 106 84 bytes

function(x,y,z=abs(x-y),w=z-min(z)+1)adist(p(1:max(w)),p(w),c("s"=9))==2
p=intToUtf8

Try it online!

@JayCe with a ridiculous 22 byte save!

The workhorse here is adist, which gives a "generalized Levenshtein edit distance" between two strings. By default the distance is the count of the minimal number of insertions, deletions, and substitutions required to transform one string into another. But adist allows you to weight things how you like - so I've weighted each substitution to add 9 to the distance rather than 1. This effectively forces the algorithm to look for insertions and deletions only.

This code accepts vectors of integers, computes the absolute elementwise differences, and translates the result to begin at 1, calling it w.

Then the custom weighted Levenshtein distance is computed between w pasted together to make a string and the string "1234..." (actually utf-8 "\001\002\003\004..." but adist doesn't care.) with the same number of characters as w.

The only way the string can have exactly one digit out of place is if you make one deletion and one insertion, giving a distance of 2.

\$\endgroup\$
9
  • \$\begingroup\$ This fails for the new test case, 14325, 11111 (falsy). \$\endgroup\$
    – Dennis
    Jun 11, 2018 at 18:06
  • \$\begingroup\$ I think paste0 can be just paste since there's only one input. \$\endgroup\$
    – Giuseppe
    Jun 11, 2018 at 18:59
  • \$\begingroup\$ p=intToUtf8 ? \$\endgroup\$
    – JayCe
    Jun 11, 2018 at 21:46
  • \$\begingroup\$ I thought I had a golf replacing w=z-min(z)+1)adist(p(1:max(w)) with w=z-min(z))adist(p(0:max(w)) but it doesn't work since intToUtf8(\000) is NULL. \$\endgroup\$
    – JayCe
    Jun 13, 2018 at 15:02
  • \$\begingroup\$ This is an interesting solution that deserves more upvotes.... I think predicting the upvotes in Codegolf is the next frontier for AI :) \$\endgroup\$
    – JayCe
    Jun 13, 2018 at 15:08
0
\$\begingroup\$

JavaScript, 137 136 135 134 132 123 bytes

Takes input as two arrays of digits in currying syntax, outputs 0 for true and any other number for false.

a=>b=>(c=a.map((x,y)=>(x-=b[y])<0?-x:x)).map(x=>t+=x>c[++j]&(d=[...c].sort()).slice(i=0,-1).every(x=>d[++i]-x&1),t=j=0)|t^1

Test Cases

f=
a=>b=>(c=a.map((x,y)=>(x-=b[y])<0?-x:x)).map(x=>t+=x>c[++j]&(d=[...c].sort()).slice(i=0,-1).every(x=>d[++i]-x&1),t=j=0)|t^1
o.innerText=`${l=`-`.repeat(21)}\n|   #1  |   #2  | f |${m=`\n|${`|`.padStart(8,`-`).repeat(2)}---|\n`}${[[31716,45941],[12354,11111],[56798,22222],[23564,11111],[1759,2435],[12345,11111],[3333,2101],[22354,22222],[31717,45941],[89789,78865],[14954,61713]].map(([x,y])=>`| ${JSON.stringify(x).padEnd(6)}| ${JSON.stringify(y).padEnd(6)}| ${f([...``+x])([...``+y])} |`).join(m)}\n`+l
<pre id=o></pre>

\$\endgroup\$
3
  • 1
    \$\begingroup\$ [...u].sort(y=0) is invalid javascript, the argument for the sort must be a function \$\endgroup\$
    – edc65
    Feb 23, 2018 at 15:01
  • \$\begingroup\$ @edc65, that's long since been edited out. Invalid as it may be, though, it worked! ;) \$\endgroup\$
    – Shaggy
    Feb 23, 2018 at 15:08
  • 2
    \$\begingroup\$ "Fails for 25634 11111 (as do many other submissions)" - Ton Hospel \$\endgroup\$ Feb 27, 2018 at 18:55
0
\$\begingroup\$

Python 2, 116 119 106 bytes

Thanks Mr. Xcoder for the 116->84 cut, but I found I have missed the "consecutive number" criteria, so 26 bytes are added for that purpose :(

After that, -1 more Thanks Mr. Xcoder, and -13 Thanks ovs

def m(a,b):l=[abs(x-y)for x,y in zip(a,b)];print sum(e>f for e,f in zip(l,l[1:]))==1==len(l)-max(l)+min(l)

Try it online!

That one below fixes 25634 - 11111 problem but with double length (211 206 145 142B)... Golfing...

def m(a,b):l=[abs(x-y)for x,y in zip(a,b)];r=[l[i]-i-min(l)for i in range(len(l))];print(sum(r)==0)&(len([x for x in r if abs(x)>1])<2)&any(r)

Try it online!

And congratulations to new moderators :)

Explanation:

l=[abs(x-y)for x,y in zip(a,b)]

Generates the list of absolute differences of the digits.

r=[l[i]-i-min(l)for i in range(len(l))]

Calculates the offset from the proper position.

sum(r)==0

If the sequence is not continuous, then offset sum will "usually" not be 0. But even if it equals 0, the next ones will block them out.

len([x for x in r if abs(x)>1])<2

Only 0 or 1 item will have absolute offset larger than 1 (the one with wrong position, and 0 is in the case like 1,2,3,5,4)

any(r)

Blocks the case when the numbers are all in correct positions

\$\endgroup\$
4
  • \$\begingroup\$ It seems to fail for m([3,3,3,3],[2,1,0,1]) (returns True) Tio \$\endgroup\$ Feb 26, 2018 at 0:01
  • \$\begingroup\$ @AsoneTuhid I have fixed the problem based on his golf because when I submitted the answer and he golfed my answer I forgot that case. \$\endgroup\$ Feb 26, 2018 at 0:32
  • 2
    \$\begingroup\$ Fails for 25634 11111 (as do many other submissions) \$\endgroup\$
    – Ton Hospel
    Feb 27, 2018 at 15:38
  • \$\begingroup\$ @TonHospel Oh, that's tricky. I'm thinking of methods to fix it but seems it will add quite a bunch of bytes to the answer \$\endgroup\$ Feb 27, 2018 at 23:57
0
\$\begingroup\$

Haskell, 182 163 162 132 bytes

(#)=zipWith(-)
a&b|s<-abs<$>a#b=or[all(==1)$tail a#a|(x,h:y)<-p s,(q,r)<-p$x++y,a<-[q++h:r],a/=s]
p l=[splitAt k l|k<-[0..length l]]

Takes input as a list of digits. Helper function p that gives all possible ways to split a list into two parts is used to take an element out and again to insert it elsewhere.

Try it online!

\$\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.