text:
Levenshtein distance & OEIS (Cops)
This is the Cop post. The Robber post is here.

Your task is to take an integer input N and output the Nth digit in the sequence OEIS A002942.
The sequence consists of the square numbers written backwards:
1, 4, 9, 61, 52, 63, 94, 46, 18, 1, 121, 441, ...

Note that leading zeros are trimmed away (100 becomes 1, not 001). Concatenating this into a string (or one long number gives):
1496152639446181121441

You shall output the Nth digit in this string/number. You may choose to take N as 0-indexed or 1-indexed (please state which one you choose).
Test cases (1-indexed):
N = 1,      ==> 1
N = 5,      ==> 1
N = 17,     ==> 1   <- Important test case! It's not zero.
N = 20,     ==> 4
N = 78,     ==> 0
N = 100,    ==> 4

Your code should work for numbers up to N = 2^15 (unless your language can't handles 32 bit integers by default, in which case N can be lower).

Cops:
You must write two functions/programs, in the same language, that do the same thing. You have to post one of the functions/programs, as well as the Levenshtein distance between the two functions/programs you have written. The Levenshtein distance is measured in characters (so addition of a two byte character will give a LD = 1).
The unrevealed code can not be longer than the original solution (but it can be the same size). The robbers will attempt to write a code with the exact Levenshtein distance you gave (it can be different from your unrevealed code, as long as it works).
The winner will be the uncracked submission that has the lowest Levenshtein distance.
You may check the Levenshtein distance here!

If your submission goes uncracked for 7 days then you may reveal the alternative code you have written and mark your submission as safe.

Yes, I'll add that to the rules. :)

You talk about scripts, but I assume this is the default program or function?

Yes, default everything :)

How are you handling comments and whitespace, I see some weird stuff.

Handing comments and whitespace is part of the cops' challenge.

"Your code should work for numbers up to N = 2^15" -> but one of the test cases is larger than that. Is the 274164 case necessary?

@TomCarpenter what do you gain? I think you need 32bit integers for the squares with N=2^15 already?

Characters rather than bytes: how does that work with RPL? A command is stored using 2.5 bytes, whether it's + or CONVERT, and that 20-bit number has nothing to do with '+' or letters in the word 'convert'. Is it nevertheless the case that DUP 2 (2.5 byte command and 2.5 byte number) differs from DUP2 (another 2.5 byte command) by just 1 (+space) while + and CONVERT (each 2.5 byte command) differ by 7 (change '+' into one letter and add 6 letters)? Even stranger, CONVERT and CONVERTS: a 2.5 byte command and a variable name, 11.5 bytes: distance 1 despite longer by 9 bytes?

Just to clarify, to edit a program, the program is converted into characters, you edit them, then it's parsed and converted back into its binary representation.

How about Spectrum BASIC - does PRINT count as 1 character or 5? It's stored as 1 byte and edited (entered/deleted) like a character, that's you can't just delete R to get PINT... It has its own code (8-bit extension of ASCII). A string " PRINT " has LEN 1.

@Heimdall I don't know! Feel free to post an answer and explain in detail how you calculate the Levenshtein distance. It won't be eligible for the win, sorry... But the fun is in playing :)

Yes, fun is in the playing. But I can't help being competitive. I guess what makes the most sense is how it's edited. So with Spectrum BASIC I'll assume keywords are single character and with RPL on HP48 I'll assume the commands are made out of individual characters. You asked the question, you decide on interpretation of rules, so I guess it's up to you whether entries in those languages are eligible...

Haskell, LD = 13, cracked
((snd.span(<'1').reverse.show.(^2)=<<[1..])!!)

Try it online!
I double-checked that leading zeros are trimmed ;)
Explanation:
                    [1..]     -- for each element in [1,2,3,4,5,...]
                 =<<          -- apply the following functions
             (^2)             -- square [1,4,9,16,25,...]
           show.              -- convert to string ["1","4","9","16","25",...]
       reverse.               -- reverse ["1","4","9","61","52",...,"001",...]
   span(<'1').                -- split into leading zeros and remainder [("","1"),("","4"),...,("00","1"),...]
  snd.                        -- only keep remainder ["1","4","9","61","52",...,"1",...]
                              -- and concatenate the result "1496152..."
((                       )!!) -- index into the sequence

Cracked!

JavaScript (ES6), LD = 103 (cracked)
Using such a high Levenshtein distance is probably not the best strategy, but let's try it anyway.
n => { for(i = 0, str = ''; i <= n; i++) { str += +[...i * i + ''].reverse().join(''); } return str[n]; }

Test cases

let f =

n => { for(i = 0, str = ''; i <= n; i++) { str += +[...i * i + ''].reverse().join(''); } return str[n]; }

console.log(f(5))      // 1
console.log(f(17))     // 1
console.log(f(20))     // 4
console.log(f(78))     // 0
console.log(f(100))    // 4
console.log(f(274164)) // 1

Intended solution
$=>eval(atob`Wy4uLkFycmF5KCQrMSldLm1hcCgoXyxpKT0+K1suLi5pKmkrJyddLnJldmVyc2UoKS5qb2luYGApLmpvaW5gYFskXQ`)

Encoded part:
[...Array($+1)].map((_,i)=>+[...i*i+''].reverse().join``).join``[$]

Does this strip leading 0s after reversing?

@EriktheOutgolfer Yes. The unary + ensures that the reversed string is coerced to a Number.

Ohhhh... wow, that's harder than I thought.

Cracked!

cQuents 0, LD = 1, Cracked
":\r$*$

Try it online!
I thought this didn't work for leading zeroes, but it actually does - the reverse function in cQuents is coded as int(reversed(str(n))).
Explanation
"         Concatenate sequence together, get nth term in the string instead of the sequence
 :        Mode: Sequence: given input n, output the nth term, 1-indexed
          Each term in the sequences equals:
  \r      reverse(
    $*$           the index * the index
                  or
    $$            the index * the index
                   ) (implicit)

cracked?

@Laikoni yep, cQuents does implicit multiplication like, kinda like Mathematica, but you don't need the spaces. Adding an explanation.

Python 2, 104 bytes, LD=21 Invalid AND Cracked
d=lambda y:y if'0'!=str(y)[-1]else d(y/10)
lambda n:''.join([str(d(x*x))[::-1]for x in range(1,n)])[n-1]

P.S. Is an unlimited amount of whitespace and commenting allowed? If so this will not be hard to crack.

"The unrevealed code can not be longer than the original solution."

@Scrooble I saw that but I don't think it will be hard to make a program that is much shorter than this one. Already been done in python 3 in another answer and it works in python 2 so all they need to add is a bunch of \ns (about 50)

Wouldn't 50 newlines exceed a Levenshtein distance of 21?

@Scrooble You are very right I got confused and was thinking about the problem incorrectly. Thanks

This seems to error on inputs lower than 5

Anyway, cracked

@Leo Oops. Should I delete the post since it's not valid? I guess you're a super robber. Not sure how I missed that, I remember trying those cases

I'd say don't delete it: you're "cracked" anyways and the robber deserves credit :)

6502 machine code (C64), LD = 1 (cracked)
00 C0 20 FD AE A0 00 99 5B 00 C8 20 73 00 90 F7 99 5B 00 A2 0B CA 88 30 09 B9
5B 00 29 0F 95 5B 10 F3 A9 00 95 5B CA 10 F9 A9 00 A0 03 99 69 00 88 10 FA A0
20 A2 76 18 B5 E6 90 02 09 10 4A 95 E6 E8 10 F4 A2 03 76 69 CA 10 FB 88 F0 11
A2 09 B5 5C C9 08 30 04 E9 03 95 5C CA 10 F3 30 D6 A2 03 B5 69 95 57 CA 10 F9
A9 01 85 FB A2 03 A9 00 95 FB CA D0 FB A2 03 B5 FB 95 22 95 26 CA 10 F7 A9 00
A2 03 95 69 CA 10 FB A0 20 A2 02 46 25 76 22 CA 10 FB 90 0C A2 7C 18 B5 AA 75
ED 95 ED E8 10 F7 A2 7D 06 26 36 AA E8 10 FB 88 10 DD A0 0B A9 00 99 5A 00 88
D0 FA A0 20 A2 09 B5 5C C9 05 30 04 69 02 95 5C CA 10 F3 06 69 A2 FD 36 6D E8
D0 FB A2 09 B5 5C 2A C9 10 29 0F 95 5C CA 10 F4 88 D0 D7 E0 0A F0 05 E8 B5 5B
F0 F7 09 30 99 5B 00 C8 E8 E0 0B F0 04 B5 5B 90 F1 88 B9 5B 00 C9 30 F0 F8 A2
7C 18 B5 DB E9 00 95 DB E8 10 F7 90 14 88 30 05 B9 5B 00 D0 EA A2 7C F6 7F D0
03 E8 10 F9 4C 73 C0 B9 5B 00 4C D2 FF

Online demo, usage: sys49152,n where n is the 0-indexed input.

For the last test case, you need a bit of patience, as this poor machine has to do millions of bit-shifts and additions to present you the result ;)
The language here is the machine code, so LD is measured in this format -- nevertheless, to give something to start with, here's the program in ca65 assembler source:
NUMSIZE         = 4     ; 32 bit integers ...
NUMSTRSIZE      = 11    ; need up to 11 characters for 0-terminated string

.segment "ZPUSR": zeropage
v_x:            .res    NUMSIZE         ; next number to be squared

.segment "ZPFAC": zeropage
v_n:            .res    NUMSIZE         ; input index (0-based), counts down
nc_string:      .res    NUMSTRSIZE      ; string buffer for numbers

.segment "ZPTMP": zeropage
mpm_arg1:       .res    NUMSIZE         ; arg1 for multiplication
mpm_arg2:       .res    NUMSIZE         ; arg2 for multiplication

.segment "ZPFAC2": zeropage
mpm_res:        .res    NUMSIZE         ; numeric result (mult and str convert)

; load address for creating a C64 .PRG file:

.segment "LDADDR"
                .word   $c000

.code

; first read number from command argument and convert to unsigned
; integer in little-endian:

                jsr     $aefd
                ldy     #$00
rn_loop:        sta     nc_string,y
                iny
                jsr     $73
                bcc     rn_loop
                sta     nc_string,y
                ldx     #NUMSTRSIZE
stn_copybcd:    dex
                dey
                bmi     stn_fillzero
                lda     nc_string,y
                and     #$f
                sta     nc_string,x
                bpl     stn_copybcd
stn_fillzero:   lda     #$0
                sta     nc_string,x
                dex
                bpl     stn_fillzero
                lda     #$0
                ldy     #(NUMSIZE-1)
stn_znumloop:   sta     mpm_res,y
                dey
                bpl     stn_znumloop
                ldy     #(NUMSIZE*8)
stn_loop:       ldx     #($81-NUMSTRSIZE)
                clc
stn_rorloop:    lda     nc_string+NUMSTRSIZE+$80,x
                bcc     stn_skipbit
                ora     #$10
stn_skipbit:    lsr     a
                sta     nc_string+NUMSTRSIZE+$80,x
                inx
                bpl     stn_rorloop
                ldx     #(NUMSIZE-1)
stn_ror:        ror     mpm_res,x
                dex
                bpl     stn_ror
                dey
                beq     main
stn_sub:        ldx     #(NUMSTRSIZE-2)
stn_subloop:    lda     nc_string+1,x
                cmp     #$8
                bmi     stn_nosub
                sbc     #$3
                sta     nc_string+1,x
stn_nosub:      dex
                bpl     stn_subloop
                bmi     stn_loop

main:
                ldx     #(NUMSIZE-1)
argloop:        lda     mpm_res,x
                sta     v_n,x
                dex
                bpl     argloop
                lda     #$01
                sta     v_x
                ldx     #(NUMSIZE-1)
                lda     #$00
initxloop:      sta     v_x,x
                dex
                bne     initxloop

mainloop:

; prepare arguments for multiplication:

                ldx     #(NUMSIZE-1)
sqrargloop:     lda     v_x,x
                sta     mpm_arg1,x
                sta     mpm_arg2,x
                dex
                bpl     sqrargloop

; do multiplication:

                lda     #$00
                ldx     #(NUMSIZE-1)
mul_clearloop:  sta     mpm_res,x
                dex
                bpl     mul_clearloop
                ldy     #(NUMSIZE*8)
mul_loop:       ldx     #(NUMSIZE-2)
                lsr     mpm_arg1+NUMSIZE-1
mul_rorloop:    ror     mpm_arg1,x
                dex
                bpl     mul_rorloop
                bcc     mul_noadd
                ldx     #($80-NUMSIZE)
                clc
mul_addloop:    lda     mpm_arg2+NUMSIZE+$80,x
                adc     mpm_res+NUMSIZE+$80,x
                sta     mpm_res+NUMSIZE+$80,x
                inx
                bpl     mul_addloop
mul_noadd:      ldx     #($81-NUMSIZE)
                asl     mpm_arg2
mul_rolloop:    rol     mpm_arg2+NUMSIZE+$80,x
                inx
                bpl     mul_rolloop
                dey
                bpl     mul_loop

; convert result to string:

                ldy     #NUMSTRSIZE
                lda     #$0
nts_fillzero:   sta     nc_string-1,y
                dey
                bne     nts_fillzero
                ldy     #(NUMSIZE*8)
nts_bcdloop:    ldx     #(NUMSTRSIZE-2)
nts_addloop:    lda     nc_string+1,x
                cmp     #$5
                bmi     nts_noadd
                adc     #$2
                sta     nc_string+1,x
nts_noadd:      dex
                bpl     nts_addloop
                asl     mpm_res
                ldx     #($ff-NUMSIZE+2)
nts_rol:        rol     mpm_res+NUMSIZE,x       ; + $100 w/o zp wraparound
                inx
                bne     nts_rol
                ldx     #(NUMSTRSIZE-2)
nts_rolloop:    lda     nc_string+1,x
                rol     a
                cmp     #$10
                and     #$f
                sta     nc_string+1,x
nts_rolnext:    dex
                bpl     nts_rolloop
                dey
                bne     nts_bcdloop
nts_scan:       cpx     #(NUMSTRSIZE-1)
                beq     nts_copydigits
                inx
                lda     nc_string,x
                beq     nts_scan
nts_copydigits: ora     #$30
                sta     nc_string,y
                iny
                inx
                cpx     #(NUMSTRSIZE)
                beq     strip0loop
                lda     nc_string,x
                bcc     nts_copydigits

; search for first non-0 character from the end of the string:

strip0loop:     dey
                lda     nc_string,y
                cmp     #$30
                beq     strip0loop

; decrement n for each digit:

founddigit:
                ldx     #($80-NUMSIZE)
                clc
decnloop:       lda     v_n+NUMSIZE+$80,x
                sbc     #$00
                sta     v_n+NUMSIZE+$80,x
                inx
                bpl     decnloop
                bcc     foundresult

                dey
                bmi     next_x
                lda     nc_string,y
                bne     founddigit

; increment x to calculate next square number:

next_x:
                ldx     #($80-NUMSIZE)
incxloop:       inc     v_x+NUMSIZE-$80,x
                bne     incxdone
                inx
                bpl     incxloop
incxdone:       jmp     mainloop

foundresult:    lda     nc_string,y
                jmp     $ffd2

... and here's the linker script for ld65:
MEMORY {
  LDADDR: start = $bffe, size = 2;
  CODE: start = $c000, size = $1000;
  ZPTMP: start = $0022, size = $0008;
  ZPFAC: start = $0057, size = $000f;
  ZPFAC2: start = $0069, size = $0004;
  ZPUSR: start = $00fb, size = $0004;
}

SEGMENTS {
  LDADDR: load = LDADDR;
  CODE: load = CODE;
  ZPTMP: load = ZPTMP, type = zp;
  ZPFAC: load = ZPFAC, type = zp;
  ZPFAC2: load = ZPFAC2, type = zp;
  ZPUSR: load = ZPUSR, type = zp;
}

cracked (I believe)

@Jo. yes, edited.

Perl 5, 59 + 1 (-a) = 60 bytes, LD=55
$j.=int reverse$_**2for 1..$_;$_--;say$j=~s/.{$_}(.).*/$1/r

Try it online!

maybe cracked, I'm not sure of my entry https://codegolf.stackexchange.com/questions/146927/levenshtein-distance-oeis-robbers/147045#147045

Java 8, (177 bytes) LD = 92 (Cracked by @Arnauld)
(Ive used this online LD-calculator.)
n->{String r="",t=r;for(int i=1,j;r.length()<=n+1;i++)if(Math.sqrt(i)%1==0){for(t="",j=(i+"").length();j>0;t+=(i+"").charAt(--j));r+=t.replaceAll("^0+","");}return r.charAt(n);}

This is probably not too hard if you simply golf this. :)
Explanation:
Try it here.
n->{                             // Method with integer parameter and character return-type
  String r="",                   //  Result-String, starting empty
         t=r;                    //  Temp-String, starting empty
  for(int i=1,j;                 //  Index-integers
      r.length()<=n+1;i++)       //  Loop (1) as long as the length is at least n+1
    if(Math.sqrt(i)%1==0){       //   If the current number `i` is a perfect square:
      for(t="",                  //    Reset the temp-String to empty
          j=(i+"").length();     //    Set `j` to the length of the current number
          j>0;                   //    Inner loop (2) as long as `j` is larger than 0
        t+=                      //     Append the temp-String with:
           (i+"").charAt(--j)    //     The digit of integer `i` at index `j-1`
                                 //     (by first decrease `j` with 1 with `--j`)
      );                         //    End of inner loop (2)
      r+=t                       //    And then append the temp-String to the result-String
          .replaceAll("^0+","");}//    after we've removed any leading zeroes
                                 //  End of loop (1) (implicit / single-line body)
  return r.charAt(n);            //  Return the `n`'th character of the result-String
}                                // End of method

Cracked

Intended solution: n->{String r="";for(int i=1;r.length()<=n+1;r+=new Long(new StringBuffer(i*i+++"").reverse()+""));return r.charAt(n);} (118 bytes, 92 LD)

Octave, LD = 63, Cracked
@(t)[arrayfun(@(t)num2str(str2num(flip(num2str(t)))),(1:t).^2,'uni',0){:}](t)

Try it online!
The submission is 77 bytes, so you need to substitute quite a bit =)

cracked.

6502 machine code (C64), LD = 1, safe
00 C0 20 FD AE A0 00 99 5B 00 C8 20 73 00 90 F7 99 5B 00 A2 0B CA 98 88 30 09
B9 5B 00 29 0F 95 5B 10 F2 95 5B CA 10 FB A0 20 A2 76 18 B5 E6 90 02 09 10 4A
95 E6 E8 10 F4 A2 03 76 69 CA 10 FB 88 F0 11 A2 09 B5 5C C9 08 30 04 E9 03 95
5C CA 10 F3 30 D6 A2 03 B5 69 95 57 CA 10 F9 A9 01 85 FB A2 03 A9 00 95 FB CA
D0 FB A2 03 B5 FB 95 22 95 26 CA 10 F7 A9 00 A2 03 95 69 CA 10 FB A0 20 A2 02
46 25 76 22 CA 10 FB 90 0C A2 7C 18 B5 AA 75 ED 95 ED E8 10 F7 A2 7D 06 26 36
AA E8 10 FB 88 10 DD A2 0B A9 00 95 5A CA D0 FB A0 20 A2 09 B5 5C C9 05 30 04
69 02 95 5C CA 10 F3 06 69 A2 FD 36 6D E8 D0 FB A2 09 B5 5C 2A C9 10 29 0F 95
5C CA 10 F4 88 D0 D7 E8 B5 5B F0 FB 09 30 99 5B 00 C8 E8 E0 0B F0 04 B5 5B 90
F1 88 B9 5B 00 C9 30 F0 F8 A2 7C 18 B5 DB E9 00 95 DB E8 10 F7 90 14 88 30 05
B9 5B 00 D0 EA A2 7C F6 7F D0 03 E8 10 F9 4C 68 C0 B9 5B 00 4C D2 FF

Online demo, usage: sys49152,n where n is the 0-indexed input.

Intended solution: (diff)
 B9 5B 00 29 0F 95 5B 10 F2 95 5B CA 10 FB A0 20 A2 76 18 B5 E6 90 02 09 10 4A
-95 E6 E8 10 F4 A2 03 76 69 CA 10 FB 88 F0 11 A2 09 B5 5C C9 08 30 04 E9 03 95
+95 E6 E8 10 F4 A2 03 76 69 CA 10 FB 88 F0 11 A2 09 B5 5C C9 08 90 04 E9 03 95
 5C CA 10 F3 30 D6 A2 03 B5 69 95 57 CA 10 F9 A9 01 85 FB A2 03 A9 00 95 FB CA

The 30 (opcode bmi) is replaced by 90 (opcode bcc). This corresponds to the following part in the assembler source:
stn_subloop:    lda     nc_string+1,x
                cmp     #$8
                bmi     stn_nosub       ; use bcc here for same result
                sbc     #$3
                sta     nc_string+1,x

It works because this code checks whether a number is smaller than 8. The cmp instruction performs a subtraction for that, setting the flags accordingly. So, if the accumulator holds a number smaller than 8, this underflows, clearing the carry flag, therefore the correct branch instruction is indeed bcc. bmi (branching when negative), as in the original code, just happens to work here as well, because the compared numbers are small enough, so the result of the subtraction ends up in the negative range ($80-$ff) when an underflow occurs.
Online demo

This is an improved/compacted version of my previous submission. Among some other tricks to reduce the size, it removes the useless code that was contained and allowed a kind of "simple"*) crack. All in all, the size is reduced by 16 bytes. This time, it should be a bit harder to find the equivalent program with LD 1 :)
*) probably still quite some work to find, of course :)
Again, here's the ca65 assembler source, to help getting started with the code:
NUMSIZE         = 4     ; 32 bit integers ...
NUMSTRSIZE      = 11    ; need up to 11 characters for 0-terminated string

.segment "ZPUSR": zeropage
v_x:            .res    NUMSIZE         ; next number to be squared

.segment "ZPFAC": zeropage
v_n:            .res    NUMSIZE         ; input index (0-based), counts down
nc_string:      .res    NUMSTRSIZE      ; string buffer for numbers

.segment "ZPTMP": zeropage
mpm_arg1:       .res    NUMSIZE         ; arg1 for multiplication
mpm_arg2:       .res    NUMSIZE         ; arg2 for multiplication

.segment "ZPFAC2": zeropage
mpm_res:        .res    NUMSIZE         ; numeric result (mult and str convert)

; load address for creating a C64 .PRG file:

.segment "LDADDR"
                .word   $c000

.code

; first read number from command argument and convert to unsigned
; integer in little-endian:

                jsr     $aefd
                ldy     #$00
rn_loop:        sta     nc_string,y
                iny
                jsr     $73
                bcc     rn_loop
                sta     nc_string,y
                ldx     #NUMSTRSIZE
stn_copybcd:    dex
                tya
                dey
                bmi     stn_fillzero
                lda     nc_string,y
                and     #$f
                sta     nc_string,x
                bpl     stn_copybcd
stn_fillzero:   sta     nc_string,x
                dex
                bpl     stn_fillzero
                ldy     #(NUMSIZE*8)
stn_loop:       ldx     #($81-NUMSTRSIZE)
                clc
stn_rorloop:    lda     nc_string+NUMSTRSIZE+$80,x
                bcc     stn_skipbit
                ora     #$10
stn_skipbit:    lsr     a
                sta     nc_string+NUMSTRSIZE+$80,x
                inx
                bpl     stn_rorloop
                ldx     #(NUMSIZE-1)
stn_ror:        ror     mpm_res,x
                dex
                bpl     stn_ror
                dey
                beq     main
stn_sub:        ldx     #(NUMSTRSIZE-2)
stn_subloop:    lda     nc_string+1,x
                cmp     #$8
                bmi     stn_nosub
                sbc     #$3
                sta     nc_string+1,x
stn_nosub:      dex
                bpl     stn_subloop
                bmi     stn_loop

main:
                ldx     #(NUMSIZE-1)
argloop:        lda     mpm_res,x
                sta     v_n,x
                dex
                bpl     argloop
                lda     #$01
                sta     v_x
                ldx     #(NUMSIZE-1)
                lda     #$00
initxloop:      sta     v_x,x
                dex
                bne     initxloop

mainloop:

; prepare arguments for multiplication:

                ldx     #(NUMSIZE-1)
sqrargloop:     lda     v_x,x
                sta     mpm_arg1,x
                sta     mpm_arg2,x
                dex
                bpl     sqrargloop

; do multiplication:

                lda     #$00
                ldx     #(NUMSIZE-1)
mul_clearloop:  sta     mpm_res,x
                dex
                bpl     mul_clearloop
                ldy     #(NUMSIZE*8)
mul_loop:       ldx     #(NUMSIZE-2)
                lsr     mpm_arg1+NUMSIZE-1
mul_rorloop:    ror     mpm_arg1,x
                dex
                bpl     mul_rorloop
                bcc     mul_noadd
                ldx     #($80-NUMSIZE)
                clc
mul_addloop:    lda     mpm_arg2+NUMSIZE+$80,x
                adc     mpm_res+NUMSIZE+$80,x
                sta     mpm_res+NUMSIZE+$80,x
                inx
                bpl     mul_addloop
mul_noadd:      ldx     #($81-NUMSIZE)
                asl     mpm_arg2
mul_rolloop:    rol     mpm_arg2+NUMSIZE+$80,x
                inx
                bpl     mul_rolloop
                dey
                bpl     mul_loop

; convert result to string:

                ldx     #NUMSTRSIZE
                lda     #$0
nts_fillzero:   sta     nc_string-1,x
                dex
                bne     nts_fillzero
                ldy     #(NUMSIZE*8)
nts_bcdloop:    ldx     #(NUMSTRSIZE-2)
nts_addloop:    lda     nc_string+1,x
                cmp     #$5
                bmi     nts_noadd
                adc     #$2
                sta     nc_string+1,x
nts_noadd:      dex
                bpl     nts_addloop
                asl     mpm_res
                ldx     #($ff-NUMSIZE+2)
nts_rol:        rol     mpm_res+NUMSIZE,x       ; + $100 w/o zp wraparound
                inx
                bne     nts_rol
                ldx     #(NUMSTRSIZE-2)
nts_rolloop:    lda     nc_string+1,x
                rol     a
                cmp     #$10
                and     #$f
                sta     nc_string+1,x
nts_rolnext:    dex
                bpl     nts_rolloop
                dey
                bne     nts_bcdloop
nts_scan:       inx
                lda     nc_string,x
                beq     nts_scan
nts_copydigits: ora     #$30
                sta     nc_string,y
                iny
                inx
                cpx     #(NUMSTRSIZE)
                beq     strip0loop
                lda     nc_string,x
                bcc     nts_copydigits

; search for first non-0 character from the end of the string:

strip0loop:     dey
                lda     nc_string,y
                cmp     #$30
                beq     strip0loop

; decrement n for each digit:

founddigit:
                ldx     #($80-NUMSIZE)
                clc
decnloop:       lda     v_n+NUMSIZE+$80,x
                sbc     #$00
                sta     v_n+NUMSIZE+$80,x
                inx
                bpl     decnloop
                bcc     foundresult

                dey
                bmi     next_x
                lda     nc_string,y
                bne     founddigit

; increment x to calculate next square number:

next_x:
                ldx     #($80-NUMSIZE)
incxloop:       inc     v_x+NUMSIZE-$80,x
                bne     incxdone
                inx
                bpl     incxloop
incxdone:       jmp     mainloop

foundresult:    lda     nc_string,y
                jmp     $ffd2

... and here's the linker script for ld65:
MEMORY {
  LDADDR: start = $bffe, size = 2;
  CODE: start = $c000, size = $1000;
  ZPTMP: start = $0022, size = $0008;
  ZPFAC: start = $0057, size = $000f;
  ZPFAC2: start = $0069, size = $0004;
  ZPUSR: start = $00fb, size = $0004;
}

SEGMENTS {
  LDADDR: load = LDADDR;
  CODE: load = CODE;
  ZPTMP: load = ZPTMP, type = zp;
  ZPFAC: load = ZPFAC, type = zp;
  ZPFAC2: load = ZPFAC2, type = zp;
  ZPUSR: load = ZPUSR, type = zp;
}

Consider it un-cracked :)

@Jo. well if you insist -- thanks a lot, I edited it.

PHP, LD = 35 (Cracked)
1-indexed
<?while(strlen($s)<$argv[1])$s.=(int)strrev(++$i*$i);echo substr($s,$argv[1]-1,1);

Try it online!

Lua : LD=1, cracked
i=1s=""while(#s<...+0)do s=s..((i*i)..""):reverse():gsub("(0+)(%d+)$","%2")i=i+1 end print(s:sub(...,...))

No fancy tricks here :)

cracked

Mathematica, LD=43 cracked
Flatten[Table[(k=IntegerDigits)@FromDigits@Reverse@k[i^2],{i,10^4}]][[#]]&

Try it online!

Cracked.

Python 3: LD = 9 | Cracked
lambda i:"".join(str(k*k+2*k+1)[::-1].lstrip("0")for k in range(i+1))[i]

This one should be fairly (very) easy to get :P

Cracked.

I deleted my Crack because the original answer is invalid.

@Mr.Xcoder You can undelete now; LD is the same because the .lstrip("0") part can just be copied over.

Done

Groovy, 61 bytes (LD = 23)
{(1..it).collect{0.valueOf("${it**2}".reverse())}.join()[it]}

Try it online!

How is this safe >_>...

C++, LD = 159
0-indexed, input in argv[1], compiled on GCC 7.2.0
#import<bits/stdc++.h>
char*h,b[1<<17],*q=b;int x,y;main(int,char**j){sscanf(j[1],"%d",&y);do{x++;q+=sprintf(h=q,"%d",x*x);while(*--q==48);std::reverse(h,++q);}while(q-b<=y);b[y+1]=0,printf(b+y);}


text:
Levenshtein distance & OEIS (Robbers)
This is the Robber post. The Cop post is here.

Your task is to take an integer input N and output the Nth digit in the sequence OEIS A002942.
The sequence consists of the square numbers written backwards:
1, 4, 9, 61, 52, 63, 94, 46, 18, 1, 121, 441, ...

Note that leading zeros are trimmed away (100 becomes 1, not 001). Concatenating this into a string (or one long number gives):
1496152639446181121441

You shall output the Nth digit in this string/number. You may choose to take N as 0-indexed or 1-indexed (please state which one you choose).
Test cases (1-indexed):
N = 5,      ==> 1
N = 17,     ==> 1   <- Important test case! It's not zero.
N = 20,     ==> 4
N = 78,     ==> 0
N = 100,    ==> 4
N = 274164, ==> 1

Your code should work for numbers up to N = 2^15 (unless your language can't handles 32 bit integers by default, in which case N can be lower).

Robbers:
You should try to crack the Cops' posts.
Your code must be in the same language as the Cop post, and have a Levenshtein distance exactly equal to the distance given by the cop. Your code cannot be longer than the original solution (but it can be the same size).
You may check the Levenshtein distance here!
The winner will be the robber that cracked the most posts.

Wait... so if the robber's result doesn't have to be the same as the original intended program... Can't the cop just write one program and make up a distance...?

Well, the cops must provide the alternative code in order to mark the submission as safe and be eligible for the win. I've clarified in the cop post. :)

I've never tried a cop-and-robber challenge. All of this was very confusing to me hah!

Haskell, Laikoni
((show.(*1).read.reverse.show.(^2)=<<[1..])!!)

Try it online!
The (*1) was necessary  for type checking.

JavaScript, Arnauld
/*ZZ*/m=>[...Array(m+1).keys()].map(eval(atob("eD0+K1suLi4iIit4KnhdLnJldmVyc2VgYC5qb2luYGA="))).join``[m]

@Arnauld OK, I think Array(m+1) fixed it.

It does. FWIW, I've added the intended solution to my post.

cQuents 0, Stephen
":\r$$

Try it online! I have no idea how this code works, but it still worked after removing the *.

Wolfram Language (Mathematica), Jenny_mathy
(Join@@Table[k@FromDigits@Reverse@(k=IntegerDigits)[i*i],{i,10^4}])[[#]]&

Try it online!
Alternative version also at distance 43:
(Join@@IntegerDigits@IntegerReverse[Range@#^2])[[1#]]&

Try it online!

6502 Machine Code (C64), Felix Palmen
I tested this with all the questions test cases and quite a few extras (like 2^15... that took awhile), and it appears to work the same as the original with LD = 1.
00 C0 20 FD AE A0 00 99 5B 00 C8 20 73 00 90 F7 99 5B 00 A2 0B CA 88 30 09 B9
5B 00 29 0F 95 5B 10 F3 A9 00 95 5B CA 10 F9 A9 01 A0 03 99 69 00 88 10 FA A0
20 A2 76 18 B5 E6 90 02 09 10 4A 95 E6 E8 10 F4 A2 03 76 69 CA 10 FB 88 F0 11
A2 09 B5 5C C9 08 30 04 E9 03 95 5C CA 10 F3 30 D6 A2 03 B5 69 95 57 CA 10 F9
A9 01 85 FB A2 03 A9 00 95 FB CA D0 FB A2 03 B5 FB 95 22 95 26 CA 10 F7 A9 00
A2 03 95 69 CA 10 FB A0 20 A2 02 46 25 76 22 CA 10 FB 90 0C A2 7C 18 B5 AA 75
ED 95 ED E8 10 F7 A2 7D 06 26 36 AA E8 10 FB 88 10 DD A0 0B A9 00 99 5A 00 88
D0 FA A0 20 A2 09 B5 5C C9 05 30 04 69 02 95 5C CA 10 F3 06 69 A2 FD 36 6D E8
D0 FB A2 09 B5 5C 2A C9 10 29 0F 95 5C CA 10 F4 88 D0 D7 E0 0A F0 05 E8 B5 5B
F0 F7 09 30 99 5B 00 C8 E8 E0 0B F0 04 B5 5B 90 F1 88 B9 5B 00 C9 30 F0 F8 A2
7C 18 B5 DB E9 00 95 DB E8 10 F7 90 14 88 30 05 B9 5B 00 D0 EA A2 7C F6 7F D0
03 E8 10 F9 4C 73 C0 B9 5B 00 4C D2 FF

Online demo, usage: sys49152,n where n is the 0-indexed input.

This is correct because you found some utterly useless code I wasn't aware of and the change is in this code :o

Perl 5, (-p) Xcali
Updated after comment, Levenshtein Distance between
a$j.=int reverse$_**2for 1..$_;$_--;say$j=~s/.{$_}(.).*/$1/r

and
p$_=substr w.(join"",map{whyddwzz;0|reverse$_**2}1..$_),$_,1

is 55
Try it online

Given that M5.010 is "free", I don't think it should count here.  I'm not really sure how to count the -a versus -p flags.  The two solutions I came up with both used the same flags.  I would think the flag would just be tacked onto the front without a space, but I'm willing to be swayed by others on that.

updated my answer

Java 8, Kevin Cruijssen
/*!FooBarFooBarFoo!*/N->{String R="",T=R;for(int I=1,J;N+2>R.length();I++){for(T="",J=(I*I+"").length();0<J;T+=(I*I+"").charAt(--J));R+=new Long(T)+"";}return R.charAt(N);}

Try it online!
Change log

Replaced .replaceAll() with new Long().
Removed the test for perfect squares. Now using perfect squares directly.
Updated all variable names to upper-case.
Rewritten the inequalities.
And finally added a 21-byte leading comment to reach the correct LD.

Oh nice. That's completely different than I had in mind, but nice that you got to 92 LD anyway. The solution I had in mind was: n->{String r="";for(int i=1;r.length()<=n+1;r+=new Long(new StringBuffer(i*i+++"").reverse()+""));return r.charAt(n);} (118 bytes, 92 LD compared to my other answer.)

Octave, Stewie Griffin
@(n)regexprep(fliplr(num2str((1:n)'.^2))'(:)',' +0*','')(n)%abcdefghijk

Try it online!
I was actually attempting my own Octave answer and spotted the existing one. Mine was already significantly shorter so adding a comment at the end was sufficient to get to the required distance of 63.

Well done :-) I had a loop with input() and everything that goes with it...

Python 3, HyperNeutrino
lambda o:"".join(str(p*p+2*p+1)[::~0].lstrip("0")for p in range(o+1))[o]

Try it online!

Ninja'd in 9 sec :P

huh interesting, was not the one I had but nice :)

You could also do '' instead of ""

@Uriel Yeah, I know a ton of alternatives.

An alternative crack would be lambda i:"".join(str( (-~k)**2)[::-1]for k in range(i+1))[i].

For reference, my solution was lambda i:"".join(str(k**2)[::-1]for k in range(1,i+2))[i]

@HyperNeutrino I was too lazy to not abuse the rules :)

I'm afraid this is invalid. It doesn't trim away leading zeros. Try f(16) for instance.

@StewieGriffin Then... The initial answer is wrong too I think

Yes, I'm about to comment on it.

Lua, Katenkyo
i=1s=""while(#s<...+0)do s=s..((i*i)..""):reverse():gsub("(0+)(%d+)$","%2")i=i+1 end
print(s:sub(...,...))

Try it online!
I don't know Lua, but this was a simple one, just replaced a space with a newline.

Hum, didn't think about that, the original was about replacing (0+)(%d+)$ with (0+)(%d+), so it was about regex ^^'

Python 2, dylnan
d=lambda y:y if y%10>0 else d(y/10)
lambda n:''.join([str(d(x*x))[::-1]for x in range(1,n+1)])[n-1]#fix

Try it online!
Note: this cop submission was bugged and didn't work for inputs lower than 5. While I was at it I built this solution which has the correct Levenshtein distance AND fixes the bug.

PHP, Jo.
<?for($j++;strlen($p)<$argv[1];$j++)$p.=(int)strrev($j**2);echo($p[$argv[1]+2-3]);

Try it online!
(I was planning to switch the inequality in order to get even larger LD...)

6502 Machine Code (C64), Felix Palmen
May also be a "simple" crack, but it appears to work as the original.
Having the LD = 1 is just so tempting to try to crack it (sorry, Felix). :)
00 C0 20 FD AE A0 00 99 5B 00 C8 20 73 00 90 F7 99 5B 00 A2 0B CA 98 88 30 09
B9 5B 00 29 0F 95 5B 10 F2 95 5B CA 10 FB A0 20 A2 76 18 B5 E6 90 02 09 10 4A
95 E6 E8 10 F4 A2 03 76 69 CA 10 FB 88 F0 11 A2 09 B5 5C C9 08 30 04 EB 03 95
5C CA 10 F3 30 D6 A2 03 B5 69 95 57 CA 10 F9 A9 01 85 FB A2 03 A9 00 95 FB CA
D0 FB A2 03 B5 FB 95 22 95 26 CA 10 F7 A9 00 A2 03 95 69 CA 10 FB A0 20 A2 02
46 25 76 22 CA 10 FB 90 0C A2 7C 18 B5 AA 75 ED 95 ED E8 10 F7 A2 7D 06 26 36
AA E8 10 FB 88 10 DD A2 0B A9 00 95 5A CA D0 FB A0 20 A2 09 B5 5C C9 05 30 04
69 02 95 5C CA 10 F3 06 69 A2 FD 36 6D E8 D0 FB A2 09 B5 5C 2A C9 10 29 0F 95
5C CA 10 F4 88 D0 D7 E8 B5 5B F0 FB 09 30 99 5B 00 C8 E8 E0 0B F0 04 B5 5B 90
F1 88 B9 5B 00 C9 30 F0 F8 A2 7C 18 B5 DB E9 00 95 DB E8 10 F7 90 14 88 30 05
B9 5B 00 D0 EA A2 7C F6 7F D0 03 E8 10 F9 4C 68 C0 B9 5B 00 4C D2 FF

Online demo, usage: sys49152,n where n is the 0-indexed input.

I'm not sure whether I have to accept this. It replaces E9 (a subtract command) by EB which is undefined in 6502 machine code, but happens to do the same on NMOS 6502 and 6510 chips. This program would for example crash on the C64 DTV1. But it's unlikely to find a real C64 that doesn't execute it correctly, so it could be considered a valid crack? I might ask for opinions on meta....

I'd be interested in input here on meta.

@FelixPalmen I'll take this answer down soon.

keep it, see also my comment on meta. The community clearly expressed the opinion that it's valid. It's my fault not to require only documented 6502 code, and I'll keep that in mind for the future.

source: Stack Exchange

license: Creative Commons - Attribution Share-Alike - https://creativecommons.org/licenses/by-sa/3.0/

sort: votes


text:
How many Latin Squares?
A Latin Square is a square of size n × n containing numbers 1 to n inclusive. Each number occurs once in each row and column.
An example of a 3 × 3 Latin Square is:
[[1, 2, 3],
 [3, 1, 2],
 [2, 3, 1]]

Another is:
[[3, 1, 2],
 [2, 3, 1],
 [1, 2, 3]]

Given an integer input n where n > 0, determine how many Latin Squares there are with a size n  × n, where the possible values are anything from 1 to n inclusive.
Examples:
1 -> 1
2 -> 2
3 -> 12
4 -> 576
5 -> 161280
6 -> 812851200
7 -> 61479419904000
11 -> 776966836171770144107444346734230682311065600000

This is OEIS sequence A002860. It has a Wikipedia article here.
Answers are only required to support inputs up to 6, due to anything above that being greater than 232. However, while this is not strictly enforceable, your algorithm must work for all inputs.

Related.

Are you sure counting Latin squares is NP complete? Can you please give a reference?

@xnor Actually, I'm not sure that this problem specifically is NP complete, but I know something else related to Latin Squares is. As I don't have any proof for this problem specifically, I've removed it.

Maybe you're thinking of completing a partially filled Latin square?

@xnor Yes, that's it.

Wolfram Language (Mathematica), 67 56 50 48 bytes
D[Permanent@a^n,##]&@@Join@@(a=x~Array~{n=#,#})&

Try it online!
Uses Theorem 5.1 in this article: if X is an n by n matrix whose entries are distinct variables, then the number of n by n Latin squares is equal to the coefficient of the product of all these variables in per(X)n, where per(X) is the permanent of X. Here, we obtain that coefficient by differentiating with respect to all of the variables, once each (which leaves a constant).
Regarding running time: TIO was happy to deal with inputs 1 through 6, and my laptop can handle 7 in a bit over 6 minutes. I didn't try 8.
Choice quotations included in the article about this formula's practicality:

The use of MacMahon's result by mere mortals seems doomed.
  – Riordan
One should not wish to actually perform, even in a computer algebra package like Maple, MacMahon's counting method.
  – Van Leijenhorst

Another Mathematica solution, 52 bytes
LineGraph@CompleteGraph@{#,#}~ChromaticPolynomial~#&

Much less efficient (only inputs 1 through 4 are viable) but somewhat more readable.
Uses the fact that Latin squares of size n are precisely the n-colorings of the n by n rook's graph, which is the line graph of the complete bipartite graph Kn,n, and is an excellent example of Mathematica's occasional tendency to look like a natural-language explanation of the algorithm with prepositions replaced by random symbols.
In practice, GraphData@{"Rook",{#,#}}~ChromaticPolynomial~#& is only 47 bytes and works for all feasible inputs, but it fails to satisfy the criterion of being a general algorithm (since GraphData hardcodes small rook graphs, but does not generate arbitrarily large ones).

Jelly, 8 bytes
Œ!ṗµfZ€L

Brute force solution. Inputs 5 and higher will time out on TIO.
Try it online!
How it works
Œ!ṗµfZ€L  Main link. Argument: n

Œ!        Generate all permutations of R := [1, ..., n].
  ṗ       Take the n-th Cartesian power, yielding the array A of all n×n matrices
          whose rows are permutations of R.
   µ      New chain. Argument: A
     Z€   Zip each; transpose each matrix in A, yielding the array B of all n×n
          matrices whose columns are permutations of R.
    f     Filter; keep only matrices that appear in A and B.
       L  Compute the length, counting the kept matrices.

Pyth, 11 bytes
l@K^.pQQCMK

Try it here!
How it works

l@K^.pQQCMK   - Full program.

    .pQ       - All permutations of the range [0, input).
   ^   Q      - To the Cartesian power of the input.
  K           - Assign to a variable K.
 @            - The intersection of K.
        CMK   - With the list of all elements in K transposed.
l             - Length.

As this is brute force, anything higher than 4 will Memory Error on Herokuapp or time out on TiO.

You can shave two bytes by avoiding K: l@FCMB^.p

Python 2, 91 bytes
f=lambda n,k=0,s={''},x=0:k<n*n>x and f(n,k+1,s|{x+k/n,~x-k%n})+f(n,k,s,x+n)or len(s)>n*n*2

Try it online!

Python 2, 102 bytes
lambda n:sum(all(len({(k/r%n,i/n**k%n)for k in range(n*n)})/n/n for r in(1,n))for i in range(n**n**2))

Try it online!

Python 2, 138 134 124 bytes
from itertools import*
def f(n):r=range(n);print sum(map(set,zip(*m))==n*[set(r)]for m in product(permutations(r),repeat=n))

Try it online!
Brute forces, very slow. Works for n=1..4 on tio

Mathematica, 102 bytes
Length@Select[Subsets[Permutations@Range@#,{s=#}],Union[Sort/@Table[#[[i]]&/@#,{i,s}]]=={Range@s}&]s!&

Try it online!

Ruby, 90 bytes
Brute force!
->n{x=[*1..n]
y=*x.permutation
y.product(*[y]*~-n).count{|a|a.transpose.all?{|b|x-b==[]}}}

Try it online!

all_licenses: Creative Commons - Attribution Share-Alike - https://creativecommons.org/licenses/by-sa/3.0/


text:
Find the unique twins
You will be given two Arrays / Lists / Vectors of non-negative integers A and B. Your task is to output the highest integer N that appears in both A and B, and is also unique in both A and B.

You may assume that there is at least one such number.
Any reasonable Input and Output method / format is allowed.
These Loopholes are forbidden.
This is code-golf, so the shortest code in every programming language wins!

Test Cases:

A, B -> Output

[6], [1, 6] -> 6
[1, 2, 3, 4], [4, 5, 6, 7] -> 4
[0, 73, 38, 29], [38, 29, 73, 0] -> 73
[1, 3, 4, 6, 6, 9], [8, 7, 6, 3, 4, 3] -> 4
[2, 2, 2, 6, 3, 5, 8, 2], [8, 7, 5, 8] -> 5
[12, 19, 18, 289, 19, 17], [12, 19, 18, 17, 17, 289] -> 289
[17, 29, 39, 29, 29, 39, 18], [19, 19, 18, 20, 17, 18] -> 17
[17, 29, 39, 29, 29, 39, 18, 18], [19, 19, 18, 20, 17, 18] -> 17

Bash + coreutils, 49 bytes
U()(sort -rn|uniq -u$1)
(U<<<$1;U<<<$2)|U D|sed q

Thanks to @seshoumara for golfing off 1 byte!
Try it online!
How it works
uniq takes sorted input and performs one or several actions, depending on the command-line flags.
U<<<$1 and U<<<$2 call the function U with the first and second command-line argument as input. For each one, sort -rn|uniq -u is executed, sorting the input numerically (-n) and in descending order (-r) for uniq, which will print only unique lines (-u).
The output of both (unique elements of each array) is concatenated and piped to U D, i.e.,
sort -rn|uniq -uD. This time, uniq will only print duplicate lines (-D), and only the first repetition of each.
While the man page says it will print all repetitions, the added -u causes -D to print only the first occurrence of duplicated lines. This behavior is normally achieved with uniq -d.
Finally, sed q quits immediately, reducing its input (unique elements of both arrays) to its first line. Since the output was sorted in descending order, this is the maximum.

Python 3, 61 56 54 bytes
Saved 7 bytes thanks to @Mr.Xcoder, @pizzapants184 and @ovs
lambda a,b:max(f*(a.count(f)==b.count(f)<2)for f in a)

Try it online!

Beat me by a minute!

57 bytes

56 bytes

54 bytes

Jelly, 7 bytes
fċ@ÐṂ;Ṁ

Try it online!
How it works
fċ@ÐṂ;Ṁ  Main link. Left argument: A. Right argument: B

f        Filter; keep those elements of A that appear in B.
   ÐṂ    Yield all elements of the result for which the link to left yields a
         minimal value (2).
 ċ@        Count the occurrences of the element...
     ;     in the concatenation of A and B.
      Ṁ  Take the maximum.

Pyth, 12 9 bytes
Try it
eS@Fm.m/d

Saved 3 bytes thanks to Mr. Xcoder.
Explanation
eS@Fm.m/d
    m  /d   Count the occurrences of each element.
     .m     Take only those that appear the minimum number of times.
  @F        Apply the above to A and B and take the intersection.
eS          Take the largest.

Nice! My solution was also 12 bytes.

Golfing my solution down a bit, 9 bytes (using eS@Fm.m/d) and taking input as a list of two lists.

@Mr.Xcoder That seems different enough to be its own answer.

Since I am the OP of the challenge, I am reluctant about posting it. You can just use it and give credit, mentioning your current approach as an alternative (if want to of course)

05AB1E, 9 8 bytes
-1 byte thanks to Erik the Outgolfer
εÐ¢Ï}`Ãà

Try it online!
ε   }    # For each input
 Ð¢Ï     #   Get the unique elements
     `Ã  # Keep only the elements that appear in both lists
       à # Keep the greatest element
         # Implicit print

Husk, 7 bytes
→►≠OfEΠ

Takes input as a list of two lists, works for any number of lists as well (returning the highest number that occurs exactly once in each, if possible).
Try it online!
Explanation
This is the first Husk answer to (ab)use the new "maximum by" function ►.
→►≠OfEΠ  Implicit input, say [[3,2,1,3],[1,2,3,4]]
      Π  Cartesian product: [[3,1],[2,1],[3,2],[2,2],[1,1],[3,3],[1,2],[3,1],[3,4],[2,3],[1,3],[3,2],[2,4],[3,3],[1,4],[3,4]]
    fE   Keep those that have equal elements: [[2,2],[1,1],[3,3],[3,3]]
   O     Sort: [[1,1],[2,2],[3,3],[3,3]]
 ►≠      Find rightmost element that maximizes number of other elements that are not equal to it: [2,2]
→        Take last element: 2

Bash + coreutils, 60 bytes
f()(sort -rn<<<"$1"|uniq -u);grep -m1 -wf<(f "$1") <(f "$2")

Try It Online
Bash, 89 bytes
c()(for e;{((e^$1||r++,2^r));});for x in $1 $2;{((x<r))||c $x $1||c $x $2||r=$x;};echo $r

TIO

Use sort -rn with sed q at the end instead of tail -1 to shave 1 byte. Great find with grep -wf btw. +1

@seshoumara, thank you for the tip, in fact i could shave 3 bytes with -m1 grep option.

Jelly, 11 bytes
ċ@Ị¥Ðf`€f/Ṁ

Try it online!

Clever usage of ```!

J, 23 bytes
>./@([-.-.)&(-.-.@~:#])

(-.-.@~:#]) removes from a list any repeated elements
& do this to both args
([-.-.) We want A intersect B.  This is the equivalent phrase: "A minus (A minus B)"
>./ Take the max
Try it online!

Equivalently, you can replace the intersection part with e.~#]. Golfing this has proven to be tough... I tried using /.-key to no success (((1=#)/.~#~.) for the first part which is 2 bytes longer by my count)

@cole, yeah, I tried a key approach as well, and also one with self-classify.  I wasn't able to beat my submission above with any other approach though.

Haskell, 57 53 bytes
x?y|let v!x=filter(==v)x==[v]=maximum[a|a<-x,a!x,a!y]

Try it online!
UPD: Thanks @Laikoni

Welcome to PPCG and Haskell golfing in particular! This is a nice first answer! Two small things: You can also declare f as infix operator and write [1|...]==[1] instead of sum[1|...]==1 to save some bytes.

In case you haven't seen them already, here are some links which might be interesting: Our collection of golfing tips in Haskell, the guide to golfing rules in Haskell and Of Monads and Men, our Haskell chat room.

In-lining ! with and saves two more bytes: Try it online!

C# (.NET Core), 85 84 bytes
x=>y=>x.Where(a=>x.Count(b=>b==a)<2).Intersect(y.Where(a=>y.Count(b=>b==a)<2)).Max()

Try it online!
Naive solution with LINQ (using System;using System.Linq; +31chars so 116 bytes with header)
84! I forgot currying!

F# (.NET Core), 117 115 114 111 108 bytes
115 114 bytes
Another solution with countBy this time:
let u x=x|>Seq.countBy id|>Seq.filter(fun a->snd a=1)|>Seq.map fst|>set
let f x y=Set.intersect(u x)(u y)|>Seq.max

Try it online!
117 111 bytes
let u x=x|>Seq.filter(fun a->x|>Seq.filter((=)a)|>Seq.length=1)|>set
let f x y=Set.intersect(u x)(u y)|>Seq.max

Try it online!
100% F#! Any help is welcome!
6 byte won thanks to prefix notation!
108 bytes
let f a b=Set.intersect(set a)(set b)|>Seq.filter(fun x->a@b|>Seq.filter(fun y->y=x)|>Seq.length<3)|>Seq.max

@ is the concat function! Thank you @Ayb4btu for this algorithm.
Try it online!

Wolfram Language (Mathematica), 40 bytes
Max@Cases[Tally@#⋂Tally@#2,{x_,1}:>x]&

Try it online!
How it works
Tally@# gives a list of the unique elements of the first input, together with their counts: e.g., Tally[{2,2,2,6,3,5,8,2}] yields {{2,4},{6,1},{3,1},{5,1},{8,1}}.
Tally@#2 does the same for the second list, and ⋂ finds pairs present in both. Then we pick out (with Cases) pairs ending in 1, taking the first element of each result, which gives us a list of all the unique twins. Finally, Max returns the largest unique twin.

SQLite, 118 bytes
SELECT MAX(x)FROM(SELECT X FROM A GROUP BY X HAVING COUNT(X)=1
INTERSECT
SELECT X FROM B GROUP BY X HAVING COUNT(X)=1)

Try it online!
First time in SQL, any help is welcome!

Röda, 48 bytes
{m={|n|sort|count|[_]if[_=n]};[_()|m 1]|m 2|max}

Try it online!
Inspired by jq170727's jq answer.
Explanation:
{ /* Anonymous function, takes input from the stream */
  m={|n|        /* Local function m with parameter n: */
    sort|count| /*   Count unique values in the stream */
    [_]if[_=n]  /*   For each value, push it to the stream if its count is n */
  };
  [      /* For each list in the stream: */
    _()| /*   Flat it (push its values to the stream) */
    m 1  /*   Push values that appear only once to the stream */
  ]|
  m 2|   /* Push values that appear twice to the stream */
  max    /* Find the max value in the stream */
}

PowerShell, 94 bytes
param($a,$b)filter f($x){$x|group|?{$_.count-eq1}}
(f($a|sort|?{$_-in((f $b).Name)}))[-1].Name

Try it online!
Takes input $a and $b as arrays. Constructs a filter that groups the input array elements together and pulls out only those with a count -equal to 1 (i.e., only those that are unique in the input array).
The next line then constructs the algorithm. First we sort $a, then pull out those that are -in the unique items of $b. Those are then themselves unique-ified, the largest [-1] is chosen, and we take the .Name thereof. That's left on the pipeline and output is implicit.

Javascript (ES6), 102 86 75 71 bytes
a=>b=>Math.max(...a.map(e=>(g=x=>x.map(y=>y-e||x--,x=1)|!x)(a)*g(b)*e))

Thanks @justinMariner for getting from 102 to 86
Thanks @tsh for getting from 86 to 75
Thanks @Arnauld for getting from 75 to 71
Try it online!

Welcome to PPCG! As far as I can tell this doesn't make sure that e shows up only once in a and b.

@MartinEnder Thanks! Edited the answer to reflect the details I missed!

Hm, wouldn't this now return 3 for f([1,2,3,3], [2,4])? It seems you only check that the value appears exactly twice in the concatenation of a and b, but not that those two occurrences weren't from the same original array.

Yeah, you're right. I would propose a test case for that.

@MartinEnder Thanks for the help. This passes all the test cases including one you added

I never thought of using lastIndexOf like that, that's pretty clever. You can get this down to 86 bytes: Try it online!. Check out the JS tips for more.

It seems that using (g=x=>x.filter(y=>y==e).length==1) is shorter.

a=>b=>Math.max(...a.map(e=>(g=x=>x.filter(y=>y==e).length==1)(a)*g(b)*e)) should work. (There's an edge case with 0, but if the resulting array contains only zeros, then zero must be the correct answer.)

@Arnauld Since the rules indicate there will be one such unique integer, this case is ok.(But it's same number of bytes as above)

It's 73 bytes, but Stack Exchange inserted two ghost characters after length==1.

I think this one is also passing all edge cases (71 bytes).

x-=y==e is actually one byte shorter.

Java 8, 133 bytes
a->b->{long r;for(java.util.Collections c=null;;a.remove(r))if(b.contains(r=c.max(a))&c.frequency(a,r)*c.frequency(b,r)==1)return r;}

Explanation:
Try it here.
a->b->{                  // Method with two ArrayList<Long> parameters and long return-type
  long r;                //  Result-long
  for(java.util.Collections c=null;
                         //  Create a java.util.Collections to save bytes
      ;                  //  Loop indefinitely
       a.remove(r))      //    After every iteration, remove the current item
    if(b.contains(r=c.max(a))
                         //   If the maximum value in `a` is present in `b`,
       &c.frequency(a,r)*c.frequency(b,r)==1)
                         //   and this maximum value is unique in both Lists:
      return r;          //    Return this value
                         //  End of loop (implicit / single-line body)
}                        // End of method

APL (Dyalog), 18 chars = 23 bytes*
A full program body. Prompts for list of lists from STDIN. Works with any number of lists. Outputs to STDOUT.
⌈/∊∩/{⊂⍺⍴⍨1=≢⍵}⌸¨⎕

Try it online!
⎕ prompt for evaluated input from STDIN
{…}⌸¨ for each list, call the following function for each unique element in that list, using the unique element as left argument (⍺) and the list of indices of its occurrence as right argument (⍵):
 ≢⍵ the tally of indices (i.e. the number of occurrences)
 1= equal to 1
 ⍺⍴⍨ use that to reshape the specific element (i.e. gives empty list if non-unique)
Now we have two lists of unique elements for each input list (although each element is a list, and there are empty lists as residue from the non-unique elements).
∩/ intersection (reduction)
∊ ϵnlist (flatten)
⌈/ max (reduction)

* in Classic, counting ⌸ as ⎕U2338.

Pip, 17 16 bytes
MX{_Na=_Nb=1FIa}

This is a function that takes two lists as arguments. Try it online!
Explanation
  {            }  Define function, args are a & b:
            FIa    Filter elements of a on this function:
   _Na              Count of element in a
      =_Nb          equals count of element in b
          =1        equals 1
                  This gives a function that returns a list of unique twins
MX                Modify it to take the max and return that instead

R, 73 bytes
function(A,B)max(setdiff(intersect(A,B),c(A[(d=duplicated)(A)],B[d(B)])))

Try it online!
Computes A intersect B, then the maximum of the difference between that and the duplicated elements of A and B.

JavaScript ES5, 122 121 114 bytes
function f(a,b){for(i=a.sort().length;--i+1;)if(a[i]!=a[i+1]&&a[i]!=a[i-1]&&!(b.split(a[i]).length-2))return a[i]}

I'm new here, so I don't really know if I can remove the function definition and just put its contents (which would save me 17 bytes)
Here's the working example: 122 121 114
122 to 121 bytes: Wrapping initialization in a for
121 to 114 bytes: b has to be a string

Welcome to PPCG! You cannot remove the function definition, but you might be able to use a lambda function instead (I don't know JS so I cannot help you with that).

Thanks for clearing that out. I don't think lambda functions can save any characters, but I'll try. Also, since you say "Any reasonable Input and Output method / format is allowed", could I accept an string as b and save b=''+b,?

I did manage to get to 115 bytes although I don't know JavaScript: f=(a,b)=>{for(b=''+b,i=a.sort().length;--i+1;)if(a[i]!=a[i+1]&&a[i]!=a[i-1]&&!(b.split(a[i]).length-2))return a[i]}.

Yeah sure a string input would be fine

But that JavaScript you came up with would be ES5, not ES6. An ES6 answer is already posted, which is why I posted the ES5. And thanks for answering the second question hehe

As I said above, I don't know Javascript at all, so I don't know the appropriate versions. Anyway it would be 112 bytes with lambdas taking input via currying, but IDK if that would work in ES5 too.

Yes, I understand that, I was just telling you why that wouldn't work hehe The function definition in ES5 doesn't support the arrow: https://medium.com/@manojsinghnegi/es5-vs-es6-with-example-code-9901fa0136fc#702a I reduced it to 114, though, thanks to your clarification

C# (.NET Core), 66+31=97 65+31=96 bytes
a=>b=>a.Intersect(b).Where(x=>a.Concat(b).Count(y=>y==x)<3).Max()

Try it online!
+31 bytes for using System;using System.Linq;
I took inspiration from @aloisdg's answer. However, instead of searching for unique values in both arrays, I inverted the order of operations so that intersect is first, and then find the max value of the items that occur twice when the arrays are concatenated and are in their intersect. I can use <3 as Count will be at least 2 for any value, as it will be in both arrays.
Acknowledgements
-1 byte thanks to @aloisdg and his suggestion to use Func currying.

Nice idea! I really like it

3 bytes won in F# :) https://codegolf.stackexchange.com/a/147073/15214

With currying you can win 1 byte! Try it online!

Jq 1.5, 76 bytes
def m(n):[.[indices(.[])|select(length==n)[]]]|unique[];[map(m(1))|m(2)]|max

Expanded
def m(n): # function to emit elements of multiplicity n
  [
    .[                         # select elements with
         indices(.[])          # number of indices in the array
       | select(length==n)[]   # equal to specified multiplicity
    ]
  ] | unique[]                 # emit deduped values
;

[
    map(m(1))   # collect multiplicity 1 elements from each array
  | m(2)        # collect multiplicity 2 elements
] | max         # choose largest of these elements

Try it online!
Here is another solution which is the same length:
def u:[keys[]as$k|[.[$k]]-(.[:$k]+.[$k+1:])]|add;map(u)|.[0]-(.[0]-.[1])|max

Expanded
def u: # compute unique elements of input array
  [
      keys[] as $k                   # for each index k
    | [.[$k]] - (.[:$k]+.[$k+1:])    # subtract other elements from [ .[k] ]
  ]                                  # resulting in [] if .[k] is a duplicate
  | add                              # collect remaining [ .[k] ] arrays
;
  map(u)                             # discard duplicates from each input array
| .[0]-(.[0]-.[1])                   # find common elements using set difference
| max                                # kepp largest element

Try it online!

MATL, 13 bytes
,iSY'1=)]X&X>

Try it online! Or Verify all test cases.
Explanation
,      % Do twice
  i    %   Take input: array
  S    %   Sort array
  Y'   %   Run-length encode: pushes array of values and array of run lengths
  1=   %   Compare each run length with 1
  )    %   Use as logical index. This keeps only values that have appeared once
]      % End
X&     % Intersection of the two arrays
X>     % Maximum of array. Implicitly display

PHP, 98 bytes
<?foreach(($c=array_count_values)($_GET[a])as$a=>$n)$n-1||$c($_GET[b])[$a]-1||$a<$r||$r=$a;echo$r;

Provide arrays as GET parameters a and b.

Think you could swap those GET params for constants.

@Progrock That´s no valid input method.

The question phrases that A and B are given as arrays.  And says any reasonable input and output method.... not that I can follow that link easily.  Really like your recipe.  (Chokes in obsolete Php 5.6 though.)

APL, 47 bytes
{1↑R[⍒R←((1={+/⍵=A}¨A)/A←⍺)∩(1={+/⍵=B}¨B)/B←⍵]}

Declares an anonymous function that takes two vectors, eliminates duplicate elements, then finds the biggest element in the intersection of the results.
A←⍺ and B←⍵ store the arguments passed to the function in A and B.
a=b returns a vector with 1 in each index in which a is equal to b. If a is a scalar (i.e. single quantity and not a vector) this returns a vector with 1 wherever the element in b is a and 0 when it is not. For example:
Input: 1=1 2 3
Output: 1 0 0

{+/⍵=A}: nested anonymous function; find the occurrences of the argument in vector A and add them up i.e. find the number of occurrences of the argument in A
1={+/⍵=A}¨A: apply the nested anonymous function to each element in A and find the ones that equal 1 i.e. unique elements
((1={+/⍵=A}¨A)/A←⍺): having found the location of the unique elements, select just these elements in the original vector (/ selects from the right argument elements whose locations correspond to 1 in the left argument)
R←((1={+/⍵=A}¨A)/A←⍺)∩(1={+/⍵=B}¨B)/B←⍵: repeat the process for the second argument; now that we have just the unique elements, find the intersection i.e. common elements and store this in vector R
R[⍒R]: access the elements of R in decreasing order
1↑R[⍒R]: take the first element of R when it's sorted in decreasing order
Test case:
Input: 17 29 39 29 29 39 18 18 {1↑R[⍒R←((1={+/⍵=A}¨A)/A←⍺)∩(1={+/⍵=B}¨B)/B←⍵]} 19 19 18 20 17 18
Output: 17

J, 30 bytes
[:>./@,[*([*+/"1(1=*/)+/)@(=/)

How it works:
I start with testing where the two list overlap by =/ (inserts equality test between all the members of the lists:
   a =. 1 3 4 6 6 9
   b =. 8 7 6 3 4 3
   ]c=. a =/ b
0 0 0 0 0 0
0 0 0 1 0 1
0 0 0 0 1 0
0 0 1 0 0 0
0 0 1 0 0 0
0 0 0 0 0 0

More than one 1 in the same column means that the number is not unique for the left argument (6 in this case); in the row - for the right argument (3)
Then I sum up all rows and all columns to find where are the duplicates:
   +/ c
0 0 2 1 1 1
   +/"1 c
0 2 1 1 1 0

I find the cartesian product of the above lists and set the members greater than 1 to 0.
    m =. (+/"1 c) (1=*/) +/c
0 0 0 0 0 0
0 0 0 0 0 0
0 0 0 1 1 1
0 0 0 1 1 1
0 0 0 1 1 1
0 0 0 0 0 0

I mask the equality matrix c with m to find the unique elements that are common to both lists and multiply the left argument by this.
]l =. a * m * c
0 0 0 0 0 0
0 0 0 0 0 0
0 0 0 0 4 0
0 0 0 0 0 0
0 0 0 0 0 0
0 0 0 0 0 0

Then I flatten the list and find the max element:
 >./,l
4

Try it online!

Java 8, 134 132 bytes
Both args are List<Integer>
a->b->a.stream().filter(i->b.stream().filter(j->i-j==0).count()*a.stream().filter(j->i-j==0).count()==1).max(Integer::compare).get()

Axiom,126 74 68 58 bytes
q(a,b)==reduce(max,[x for x in a|count(x,a)*count(x,b)=1])

And with this I have less characters of JavaScript solutions and in general easier to read too (at last now...)
In mathematical words it would "find the max element of the list of the x in a, that are present 1 time only in a and 1 time only in b".
This suppose that exist one element of the List [x for x in a|count(x,a)=1 and count(x,b)=1]
as the question require. The other solution of 126 bytes
f(a,b)==(c:=reverse(sort(setIntersection(a,b)));for i in 1..#c repeat if count(c.i,a)=1 and count(c.i,b)=1 then return c.i;-1)

Results:
(6) -> q([1,2,3], [1,2,2,3])
   (6)  3
                                                    Type: PositiveInteger
(7) -> q([6], [1,6])
   (7)  6
                                                    Type: PositiveInteger
(8) -> q([1,2,3,4], [4,5,6,7])
   (8)  4
                                                    Type: PositiveInteger
(9) -> q([0,73,38,29], [38,29,73,0])
   (9)  73
                                                    Type: PositiveInteger
(10) -> q([1,3,4,6,6,9], [8,7,6,3,4,3])
   (10)  4
                                                    Type: PositiveInteger

Ruby, 56 49 bytes
->a,b{((r=a+b).select{|e|r.count(e)==2}&a&b).max}

Try it online!

Octave, 57 56 bytes
@(x)max(intersect(cellfun(@(x){x(sum(x'==x)==1)},x){:}))

Anonymous function that takes as input a cell array of two numerical arrays.
Try it online!
Explanation
For each (cellfun(@(x)...)) of the two input arrays, this creates a matrix of pairwise equality comparisons between its entries (x.'==x); keeps (x(...)) only the entries for which the column sum is 1 (sum(...)==1); and packs the result in a cell ({...}). The intersection (intersect) of the two results ({:}) is computed, and the maximum (max(...)) is taken.

Wolfram Language (Mathematica), 49 bytes
Last@Select[a=Join@##;Sort[#⋂#2],a~Count~#<3&]&

Try it online!

Perl 5, 71 +2 (-ap) bytes
$F{$_}++for@F;map$\=$F{$_}^1||$L{$_}>1||$_<$\?$\:$_,keys%L;(%L,%F)=%F}{

Try It Online

PHP, 95 bytes
<?=max(array_intersect(e(A),e(B)));function e($a){return array_keys(array_count_values($a),1);}

Given A and B are defined constants holding each array.

APL NARS 40  28 chars
{⌈/g⍺∩(g←{⍵/⍨⊃1=+/(⊂⍵)=⍵})⍵}

g(⍵) return one list of elments of list ⍵ that appear in ⍵ 1 time only.
To the function for the question is assigned the name 'f' as (⍺)f(⍵) see below.
  f←{⌈/g⍺∩(g←{⍵/⍨⊃1=+/(⊂⍵)=⍵})⍵}
  1 2 3 f 1 2 2 3
3
  6 f 1 6
6
  1 2 3 4 f 4 5 6 7
4
  0 73 38 29 f 38 29 73 0
73
  1 3 4 6 6 9 f 8 7 6 3 4 3
4


text:
Demonstrate a lower bound for the Ramsey number R(4,4)
A special case of Ramsey's theorem says the following: whenever we color the edges of the complete graph on 18 vertices red and blue, there is a monochromatic clique of size 4.
In language that avoids graph theory: suppose we place 18 points around a circle and draw all possible line segments connecting them in one of two colors: either red or blue. No matter how this is done, it's always possible to choose 4 of the points such that all 6 line segments between them are the same color: either all 6 are red or all 6 are blue.
Moreover, 18 is the least number for which this will work. For 17 points, we can color the line segments so that it's impossible to choose 4 points in this way.
Your goal is to print one such coloring. Your output must be a 17 by 17 adjacency matrix in which the (i,j) entry gives the color of the line segment joining points i and j. It must be in a format such as the one below:
  R R B R B B B R R B B B R B R R
R   R R B R B B B R R B B B R B R
R R   R R B R B B B R R B B B R B
B R R   R R B R B B B R R B B B R
R B R R   R R B R B B B R R B B B
B R B R R   R R B R B B B R R B B
B B R B R R   R R B R B B B R R B
B B B R B R R   R R B R B B B R R
R B B B R B R R   R R B R B B B R
R R B B B R B R R   R R B R B B B
B R R B B B R B R R   R R B R B B
B B R R B B B R B R R   R R B R B
B B B R R B B B R B R R   R R B R
R B B B R R B B B R B R R   R R B
B R B B B R R B B B R B R R   R R
R B R B B B R R B B B R B R R   R
R R B R B B B R R B B B R B R R

The exact output above represents a valid coloring, so it is perfectly acceptable. But you have the following additional freedom to do something else:

You may print the adjacency matrix for any graph that satisfies the Ramsey condition, not just this one. (For example, any permutation of the rows with a corresponding permutation of the columns gives another acceptable output. I haven't checked if any non-isomorphic colorings exist.)
You may use any two distinct, non-whitespace characters in place of R and B to represent the two colors.

However, the spacing must appear exactly as in the example above: a space between cells in the same row, spaces in the diagonal entries, and newlines after each row. Leading and trailing spaces and newlines are allowed (but the entries of the adjacency matrix should be aligned with each other).
This is code-golf, so the shortest code in bytes wins. Because this is kolmogorov-complexity, hardcoding the output is allowed. Otherwise,
 standard loopholes apply.

Did I do it right?

Sure looks like it to me.

Jelly, 12 bytes
“ḍ⁾’B⁶;ṙJ$ṚG

Try it online!
How it works
“ḍ⁾’B⁶;ṙJ$UG  Main link. No arguments.

“ḍ⁾’          Set the return value to 53643.
    B         Binary; yield [1,1,0,1,0,0,0,1,1,0,0,0,1,0,1,1].
     ⁶;       Prepend a space, yielding [' ',1,1,0,1,0,0,0,1,1,0,0,0,1,0,1,1].
         $    Monadic chain:
        J       Yield all indices of the array, i.e., [1, ..., 17].
       ṙ        Rotate the array 1, ..., 17 units to the left, yielding a matrix.
          Ṛ   Reverse the order of the rows.
           G  Format the matrix as a grid.

Python 3, 56 bytes
s=' '+bin(53643)[2:]
for _ in s:print(*s);s=s[-1]+s[:-1]

Try it online!

Python 3, 56 bytes
s=' 1101000110001011'*16
while s:print(*s[:17]);s=s[16:]

Try it online!

Python 2, 64 bytes
for k in range(289):print'\n'[k%17:]+' ab'[(k/17-k%17)**8%17%7],

Try it online!

Ruby, 53 bytes
17.times{|i|puts (" %b"%53643*99).chars[i*16,17]*' '}

Try it online!
Ruby, 58 bytes
289.times{|i|$><<(" %b"%53643)[-i*16/17%17]+"
"[i%17/16]}

05AB1E, 18 bytes
18G•Ó₆•bð«NFÁ}Sðý=

Try it online!

Uses 1 for R and 0 for B.

J, 30 bytes
(-+:i.17)|."0 1'   ',":#:53643

Explanation

                          #: - converts the number to a list of binary digits
                       ":    - converts the list to a string
                '   ',       - prepends 3 spaces in front of the string
         |."0 1              - rotates the list (rank 0 1)
(-+:i.17)                    - offset for the 0, 2, 4... 32 rotations

Try it online!

Shouldn't the input of 53643 be included in the byte count?

@Misha Lavrov My first solution had the number integrated. OK, I'll revert to it.


text:
Bijective function ℤ → ℤⁿ
It is trivially possible to create a bijective function from \$\mathbb{Z}\$ (the set of all integers) to \$\mathbb{Z}\$ (e.g. the identity function).
It is also possible to create a bijective function from \$\mathbb{Z}\$ to \$\mathbb{Z}^2\$ (the set of all pairs of 2 integers; the cartesian product of \$\mathbb{Z}\$ and \$\mathbb{Z}\$). For example, we could take the lattice representing integer points on a 2D plane, draw a spiral from 0 outwards, and then encode pairs of integers as the distance along the spiral when it intersects that point.

(A function which does this with natural numbers is known as a pairing function.)
In fact, there exists a family of these bijective functions:
$$f_k(x) : \mathbb{Z} \to \mathbb{Z}^k$$
The Challenge
Define a family of functions \$f_k(x)\$ (where \$k\$ is a positive integer) with the property that \$f_k(x)\$ bijectively maps integers to \$k\$-tuples of integers.
Your submission should, given inputs \$k\$ and \$x\$, return \$f_k(x)\$.
This is code-golf, so the shortest valid answer (measured in bytes) wins.
Specifications

Any family \$f_k(x)\$  can be used as long as it fulfills the above criteria.
You are encouraged to add a description of how your function family works, as well as a snippet to compute the inverse of the function (this is not included in your byte count).
It is fine if the inverse function is uncomputable, as long as you can prove it the function is bijective.
You can use any suitable representation for signed integers and lists of signed integers for your language, but you must allow inputs to your function to be unbounded.
You only need to support values of \$k\$ up to 127.

Is it okay to take a string versions of k and x instead of integers?

@JungHwanMin Strings representing the input numbers are fine.

Alice, 14 12 bytes
/O
\i@/t&Yd&

Try it online!
Inverse function (not golfed):
/o     Q
\i@/~~\ /dt&Z

Try it online!
Explanation
Alice has a built-in bijection between ℤ and ℤ2, which can be computed with Y (unpack) and its inverse Z  (pack). Here is an excerpt from the docs explaining the bijection:

The details of the bijection are likely irrelevant for most use cases. The main point is that it lets the user encode two integers in one and extract the two integers again later on. By applying the pack command repeatedly, entire lists or trees of integers can be stored in a single number (although not in a particularly memory-efficient way). The mapping computed by the pack operation is a bijective function ℤ2 → ℤ (i.e. a one-to-one mapping). First, the integers {..., -2, -1, 0, 1, 2, ...} are mapped to the natural numbers (including zero) like {..., 3, 1, 0, 2, 4, ...} (in other words, negative integers are mapped to odd naturals and non-negative integers are mapped to even naturals). The two natural numbers are then mapped to one via the Cantor pairing function, which writes the naturals along the diagonals of the first quadrant of the integer grid. Specifically, {(0,0), (1,0), (0,1), (2,0), (1,1), (0,2), (3,0), ...} are mapped to {0, 1, 2, 3, 4, 5, 6, ...}. The resulting natural number is then mapped back to the integers using the inverse of the earlier bijection. The unpack command computes exactly the inverse of this mapping.

As alluded to above, we can use this unpack operation to map ℤ to ℤk as well. After applying it to the initial integer, we can unpack the second integer of the result again, which gives us a list of three integers. So k-1 applications of Y give us k integers as the result.
We can compute the inverse by packing the list up with Z from the end.
So the program itself has this structure:
/O
\i@/...d&

This is just a basic template for a program which reads a variable number of decimal integers as input and prints a variable number as the result. So the actual code is really just:
t   Decrement k.
&   Repeat the next command k-1 times.
Y   Unpack.

One thing I'd like to address is "why would Alice have a built-in for a ℤ → ℤ2 bijection, isn't that golfing language territory"? As with most of Alice's weirder built-ins, the main reason is Alice's design principle that every command has two meanings, one for Cardinal (integer) mode and one for Ordinal (string) mode, and these two meanings should be somehow related to give Cardinal and Ordinal mode the feeling that they are mirror universes where things are sort of the same but also different. And quite often I had a command for one of the two modes I wanted to add, and then had to figure out what other command to pair it with.
In the case of Y and Z Ordinal mode came first: I wanted to have a function to interleave two strings (zip) and separate them again (unzip). The quality of this that I wanted to capture in Cardinal mode was to form one integer from two and be able to extract the two integers again later, which makes such a bijection the natural choice.
I also figured that this would actually be very useful outside of golfing, because it lets you store an entire list or even tree of integers in a single unit of memory (stack element, tape cell or grid cell).

Great explanation as always

Finding Y and Z in the Alice docs is actually what prompted me to post this challenge (I had been thinking about it for a while, but this reminded me).

Python, 96 93 bytes
def f(k,x):
 c=[0]*k;i=0
 while x:v=(x+1)%3-1;x=x//3+(v<0);c[i%k]+=v*3**(i//k);i+=1
 return c

This works in principle by converting the input number x to balanced ternary, and then distributing the trits (ternary digits) least-significant first between the different coordinates in a round-robin fashion. So for k=2 for example, every even positioned trit would contribute to the x coordinate, and every odd positioned trit would contribute to the y coordinate. For k=3 you'd have the first, fourth and seventh trits (etc...) contributing to x, while the second, fifth and eighth contribute to y, and the third, sixth and ninth contribute to z.
For example, with k=2, lets look at x=35. In balanced ternary, 35 is 110T (using the Wikipedia article's notation where T represents a -1 digit). Dividing the trits up gives 1T (the first and third trits, counting from the right) for the x coordinate and 10 (second and fourth trits) for the y coordinate. Converting each coordinate back to decimal, we get 2, 3.
Of course, I'm not actually converting the whole number to balanced ternary at once in the golfed code. I'm just computing one trit at a time (in the v variable), and adding its value directly to the appropriate coordinate.
Here's an ungolfed inverse function that takes a list of coordinates and returns a number:
def inverse_f(coords):
    x = 0
    i = 0
    while any(coords):
        v = (coords[i%3]+1) % 3 - 1
        coords[i%3] = coords[i%3] // 3 + (v==-1)
        x += v * 3**i
        i += 1
    return x

My f function is perhaps notable for its performance. It uses only O(k) memory and takes O(k) + O(log(x)) time to find the results, so it can work with very large input values. Try f(10000, 10**10000) for instance, and you'll get an answer pretty much instantly (adding an extra zero to the exponent so x is 10**100000 makes it take 30 seconds or so on my old PC). The inverse function is not as fast, mostly because it's hard for it to tell when it's done (it scans all the coordinates after each change, so it takes something like O(k*log(x)) time). It could probably be optimized to be faster, but it's probably fast enough for normal parameters already.

You can remove the spaces (newlines) inside the while loop

Thanks, I'd mistakenly thought that there was some sort of conflict between a loop and using ; to chain statements on a single line.

Husk, 10 bytes
§~!oΠR€Θİ±

Try it online!
The inverse function is also 10 bytes.
§o!ȯ€ΠRΘİ±

Try it online!
Explanation
Forward direction:
§~!oΠR€Θİ±  Implicit inputs, say k=3 and x=-48
        İ±  The infinite list [1,-1,2,-2,3,-3,4,-4,..
       Θ    Prepend 0: [0,1,-1,2,-2,3,-3,4,-4,..
 ~    €     Index of x in this sequence: 97
§    R      Repeat the sequence k times: [[0,1,-1,..],[0,1,-1,..],[0,1,-1,..]]
   oΠ       Cartesian product: [[0,0,0],[1,0,0],[0,1,0],[1,1,0],[-1,0,0],[0,0,1],..
  !         Index into this list using the index computed from x: [-6,1,0]

Reverse direction:
§o!ȯ€ΠRΘİ±  Implicit inputs, say k=3 and y=[-6,1,0]
     ΠRΘİ±  As above, k-wise Cartesian product of [0,1,-1,2,-2,..
   ȯ€       Index of y in this sequence: 97
§o!         Index into the sequence [0,1,-1,2,-2,.. : -48

The Cartesian product built-in Π behaves nicely for infinite lists, enumerating each k-tuple exactly once.

[[0,1,-1,..],[[0,1,-1,..],[[0,1,-1,..]] is this part supposed to be [[0,1,-1,..],[0,1,-1,..],[0,1,-1,..]]?

@EriktheOutgolfer Umm yeah, fixed now.

This is beautiful. As a J programmer, do you know if there's a good way to convert a lazy list solution like this into J, which doesn't support them?  ^:^:_ type solutions usually end up much more cumbersome...

@Jonah I'm not sure. You could try to compute the array of all k-tuples with entries from i: x and sort it by the sum of absolute values, then index into that. The idea is that these arrays are prefixes of one "infinite array" that contains all k-tuples.

Wolfram Language (Mathematica), 61 bytes
SortBy[Range[-(x=2Abs@#+Boole[#>=0]),x]~Tuples~#2,#.#&][[x]]&

Try it online!
(Takes the integer and then the length of the tuple as input.)
Inverse:
If[OddQ[#],#-1,-#]/2&@Tr@Position[SortBy[Range[-(x=Ceiling@Norm@#),x]~Tuples~Length@#,#.#&],#]&

Try it online!
How it works
The idea is straightforward: we turn the integer input into a positive integer (by mapping 0,1,2,3,... to 1,3,5,7,... and -1,-2,-3,... to 2,4,6,...) and then index into all the k-tuples, sorted by distance from the origin and then by Mathematica's default tie-breaking.
But we can't use an infinite list, so when we're looking for the nth k-tuple, we only generate k-tuples of integers in the range {-n,...,n}. This is guaranteed to be enough, because the nth smallest k-tuple by norm has norm less than n, and all tuples of norm n or less are included in this list.
For the inverse, we just generate a long enough list of k-tuples, find the position of the given k-tuple in that list, and then invert the "fold into a positive integer" operation.

Running with inputs [15, 5] crashed my PC...

That'll happen. In principle, the algorithm works for anything, but in your case it works by generating all 5-tuples from the range {-31,..,31} and then taking the 31st one, so it's rather memory-intensive.

J, 7 Bytes
#.,|:#:
The J code to do this embarrassingly simple
A very simple pairing function (or, tupling function) is to simply interleave the digits of the binary expansion of each of the numbers. So, for instance (47, 79) would be paired as such:
1_0_0_1_1_1_1
 1_0_1_1_1_1
-------------
1100011111111

or, 6399. Obviously, we can trivially generalize to any n-tuple.
Let's examine how this works verb by verb.
#: is anti-base two, when used monadically it returns the binary expansion of a number. #: 47 79 gives the result:
0 1 0 1 1 1 1
1 0 0 1 1 1 1

|: is the transpose operator, which simply rotates an array. Rotating the result of #: 47 79 gives:
0 1
1 0
0 0
1 1
1 1
1 1
1 1

When used monadically, , is the ravel operator, it produces a 1-dimensional list from an table:
0 1 1 0 0 0 1 1 1 1 1 1 1 1

Finally, #. converts the binary expansion back, giving us the result 6339.
This solution will work for any string of integers.

How does this work for negative numbers?

Wolfram Language (Mathematica), 107 bytes
(-1)^#⌈#/2⌉&@Nest[{w=⌊(√(8#+1)-1)/2⌋;x=#-w(w+1)/2,w-x}~Join~{##2}&@@#&,{2Abs@#-Boole[#<0]},#2-1]&

Try it online!
Inverse, 60 bytes
(-1)^#⌈#/2⌉&@Fold[+##(1+##)/2+#&,2Abs@#-Boole[#<0]&/@#]&

Try it online!
Explanation:
Z -> N0 via f(n) = 2n if n>=0 and -2n-1 if n<0
N0 -> N0^2 via inverse of the pairing function
N0 -> N0^k Repeatedly apply the above to the leftmost number until we get length k
N0^k -> Z^k via f(n) = (-1)^n * ceil(n/2), element-wise

Mathematica, 101 bytes
(-1)^#⌈#/2⌉&@Nest[{a=#~IntegerExponent~2+1,#/2^a+1/2}~Join~{##2}&@@#&,{2Abs@#+Boole[#<=0]},#2-1]&

Similar to above (uses N instead of N0), but uses the inverse of the bijection f: N^2 -> N via f(a, b) = 2^(a - 1)(2b - 1)

You mean... there is no Mathematica built-in for that (when Alice has one)? I am speechless.

JavaScript, 155 bytes
f=k=>x=>(t=x<0?1+2*~x:2*x,h=y=>(g=(v,p=[])=>1/p[k-1]?v||t--?0:p.map(v=>v&1?~(v/2):v/2):[...Array(1+v)].map((_,i)=>g(v-i,[...p,i])).find(u=>u))(y)||h(y+1))(0)

f=k=>x=>(t=x<0?1+2*~x:2*x,h=y=>(g=(v,p=[])=>1/p[k-1]?v||t--?0:p.map(v=>v&1?~(v/2):v/2):[...Array(1+v)].map((_,i)=>g(v-i,[...p,i])).find(u=>u))(y)||h(y+1))(0)

k = <input id=k value=2>

from <input id=a value=-5>

to <input id=b value=5>

<button type="button" onclick="for(o.value='',i=+a.value;i<=b.value;i++)o.value+=[i,f(+k.value)(i)].join(':')+'\n';">generate</button>

<output id=o>

Prettify version:
k => x => {
  // Map input to non-negative integer
  if (x > 0) t = 2 * x; else t = 2 * -x - 1;
  // we try to generate all triples with sum of v
  g = (v, p = []) => {
    if (p.length === k) {
      if (v) return null;
      if (t--) return null;
      // if this is the t-th one we generate then we got it
      return p;
    }
    for (var i = 0; i <= v; i++) {
      var r = g(v-i, [...p, i]);
      if (r) return r;
    }
  }
  // try sum from 0 to infinity
  h = x => g(x) || h(x + 1);
  // map tuple of non-negative integers back
  return h(0).map(v => {
    if (v % 2) return -(v + 1) / 2
    else return v / 2;
  });
}

First, we map all integers to all non-negative integers one by one:

if n > 0 then result = n * 2
otherwise result = -n * 2 - 1

Second, we give all tuples with k-length non-negative integers an order:

calculate sum of all element, smaller one comes first
if sum is equal, compare from left to right, smaller one comes first
As a result, we got the map for all non-negative integers to tuples with k non-negative integers

Finally, map non-negative integers in tuple given in second step to all integers with similar formula in first step

I think x<0?~x-x:x+x saves 2 bytes.

Perl 6, 148 bytes
my@s=map ->\n{|grep {n==abs any |$_},(-n..n X -n..n)},^Inf;my&f={$_==1??+*!!do {my&g=f $_-1;my@v=map {.[0],|g .[1]},@s;->\n{@v[n>=0??2*n!!-1-2*n]}}}

Try it online!
Ungolfed:
sub rect($n) {
    grep ->[$x,$y] { abs($x|$y) == $n }, (-$n..$n X -$n..$n);
}

my @spiral = map { |rect($_) }, ^Inf;

sub f($k) {
    if ($k == 1) {
        -> $_ { $_ }
    } else {
        my &g = f($k-1);
        my @v = map -> [$x, $y] { $x, |g($y) }, @spiral;
        -> $_ { $_ >= 0 ?? @v[2*$_] !! @v[-1-2*$_] }
    }
}

Explanation:

rect($n) is a helper function that generates the coordinates of the integral points on the edge of a rectangle from coordinates (-$n,$n) to ($n, $n).
@spiral is a lazy, infinite list of the integral points on the edges of rectangles of increasing size, starting from 0.
f($k) returns a function which is a bijection from the integers to $k-tuples of integers.

If $k is 1, f returns the identity mapping -> $_ { $_ }.
Otherwise, &g is the recursively obtained mapping from the integers to $k-1-tuples of integers.
Then, we @spiral out from the origin, and at each point form a $k-tuple by taking the X-coordinate and the flattened result of calling g with the Y-coordinate.  This lazily generated mapping is stored in the array @v.
@v contains all $k-tuples starting with index 0, so to extend the indexing to the negative integers, we just map positive inputs to the even numbers and negative inputs to the odd numbers.  A function (closure) is returned which looks up elements of @v in this way.

05AB1E, 20 bytes
[D_#>3‰`<s])sô0ζεR3β

Try it online! Port of @Blckknght's answer. Inverse, 17 bytes:
[Z_#>3‰ø`<s])˜R3β

Try it online!

JavaScript, 112 bytes
k=>x=>(r=Array(k).fill(''),[...`${x<0?2*~x+1:2*x}`].map((c,i,s)=>r[(s.length-i)%k]+=c),r.map(v=>v&1?~(v/2):v/2))

convert to non-negative
(n*k+i)th digit to i-th number
convert back

@HermanLauenstein needn't reverse back?

I think x<0?~x-x:x+x saves 2 bytes.

-5 bytes using [...BT${x<0?~x-x:x+x}BT].reverse().map((c,i)=>r[i%k]+=c), (credit to @Neil for x<0?~x-x:x+x). .reverse() is used instead of (s.length-i) since it avoids the need of the extra parameter s to the first .map. There is no need to reverse back since the temporary array isn't used again. (I haven't tested it but it should probably work)

Another byte can be saved by replacing .fill('') with .fill(0), since a leading zero makes no difference (at least not when tested in Safari)

@HermanLauenstein Did you try .fill`` ? It might save another couple of bytes.

Jelly, 15 bytes
µ<1ạḤðŒRṗAS$Þ⁸ị

Try it online!
1-indexed.
Inverse:
AṀ×LŒRṗLAS$Þiµ:2NḂ}¡

Try it online!

license: Creative Commons - Attribution Share-Alike - https://creativecommons.org/licenses/by-sa/4.0/


text:
How to code colors in hex
Hexagonal tessellations, or tilings of the plane, are three-colorable -- meaning that using only three colors, such as Red, Blue, and Green, every hexagon can be colored without any two hexagons that share a border sharing a color. A partial example showing such a pattern.
Given a partial hexagonal tiling in ASCII (via STDIN, reading from a file, etc.), change the characters' colors (via ANSI codes, image manipulation, etc.) to fit this coloring. The twist is the middle of the hexagons (the *, below) are the three colors, and the lines between need to be a mix of their two corresponding hex's * colors. If the line is on the outside border, it should match the corresponding *.
For example, given the partial hexagonal tiling of
 / \ / \ / \ / \
| * | * | * | * |
 \ / \ / \ / \ /
  | * | * | * |
   \ / \ / \ /

suppose we decide to color the top-left hex * to be Red, and its two neighbors to be Blue and Green (going clockwise). Then the | line needs to be Magenta and the / line needs to be Yellow. If we keep coloring, we'll eventually end up with something like this (enlarged for clarity):

Or, for an input of
     / \
    | * |
   / \ /
  | * |
 / \ /
| * |
 \ /

you might color it like so (enlarged for clarity):

A few additional test cases (your code should be able to handle these):
 / \ / \
| * | * |
 \ / \ /
  | * |
 / \ / \
| * | * |
 \ / \ /

 / \
| * |
 \ / \
  | * |
 / \ /
| * |
 \ /

 / \
| * |
 \ /

Rules

The input is guaranteed to have at least one hexagon, and no input will have a "hole."
You don't need to start your coloring with Red, so long as you maintain the three-color rule.
If the partial tiling can be two-colored, you can do so without penalty (such as in the second example) - you don't necessarily need to extrapolate the partial tiling to a full tiling.
The hexagon centers * must be colored with either Red, Blue, or Green, while the lines between must be either Cyan, Yellow, or Magenta. For example, having a Magenta * is not allowed, and a Red | or \ or / must be on the outside border of the drawing. See Colors, below.
If your console doesn't have these exact colors, please use the closest approximation and specify in your answer what approximation you're using.
Leading or trailing whitespace, including trailing newlines, are acceptable so long as the characters line up.
The partial tiling can be input with space-padding to form a rectangle, if that makes it easier for your code.
Either a full program or a function are acceptable. If a function, you can return the output rather than printing it.
Output can be to the console, saved as an image, etc.
Standard loopholes are forbidden.
This is code-golf so all usual golfing rules apply, and the shortest code (in bytes) wins.

Colors and Color Mixtures:
The three available base colors are (with color codes in RGB decimal format):

Red (255,0,0)
Green (0,255,0)
Blue (0,0,255)

The combinations are:

Red and Green combine to make Yellow (255,255,0)
Blue and Green combine to make Cyan (0,255,255)
Red and Blue combine to make Magenta (255,0,255)

Can you add a test case with a hole please? Like the first (additional) one, but without the middle *

If extra whitespace is given at the end of lines or newlines at the end of the input, do they have to be preserved?

@H.PWiz Such a situation would never arise. No need to worry about it.

@HyperNeutrino No, that's purely your decision. Input/output whitespace formatting isn't the interesting part of this challenge.

Okay. Thanks. Also, will we ever have to handle empty input?

@HyperNeutrino Nope, you're guaranteed at least one hex in the input. I'll clarify.

JavaScript (ES6), 219 203 201 bytes

f=
s=>s.split`
`.map((b,i,a)=>b.replace(/./g,(c,j)=>`((a[x+i]||``)[b=y+j]==`*`&&15<<b%3*4)|(y<0?8<<9:g(x,y-2)),(g(0,2)|g(-1,1)|g(1,1)).toString(16).slice(1)}>${c}`)).join`
`
<input type=button value="Colourise!" onclick=i.innerHTML=f(i.textContent)>

 / \ / \
| * | * |
 \ / \ / \
  | * | * |
 / \ / \ / \
| * |   | * |
 \ / \ / \ / \
  | * | * | * |
 / \ / \ / \ /
| * | * |
 \ / \ /

Explanation: Each character is wrapped in a font tag to set its colour, which is calculated by checking each square, plus the squares two to the left and right, plus the four squares one away diagonally, for *s and if so combining the colours of all *s found. The * colours are chosen simply by taking their horizontal coordinate modulo 3 and shifting a bitmask appropriately. Edit: Saved 2 bytes by switching from #RRGGBB to #RGB colours.

You don't need to handle inner holes, if that makes a difference.

@AdmBorkBork No, I was just showing off.

"Colourise!" - You spelled this wrong.

@OldBunny2800 It's spelt correctly in my language...

@OldBunny2800 American isn't the only spelling-set that exists. There's British (a superset of English English), Australian (which for some reason includes New Zealand - perhaps it should be called Australasian) and Canadian (that place north of the majority of the USA), for instance.

@wizzwizz4 I'm dying. Thank you for that laugh.

I think you can remove the # from the colour specification to save a byte. You might also be able to (ab)use html's high tolerance for colour values to save some more bytes...

@Luke Removing the # doesn't seem to work, but you inspired me to switch to #RGB colour values to save two bytes.

JavaScript (ES6), 210 bytes (using HTML + CSS)
Similar to my canvas approach; locates all the *s in the input string and writes hexagons to the page in the form of absolutely positioned
 elements. Because mix-blend-mode is set to lighten, color addition is performed automatically when characters overlap.
s=>s.split`
`.map((r,y)=>[...r].map((c,x)=>c=='*'&&document.write(`
 / \\
| * |
 \\ /`)))

f=

s=>s.split`
`.map((r,y)=>[...r].map((c,x)=>c=='*'&&document.write(`
 / \\
| * |
 \\ /`)))

f(` / \\ / \\ / \\ / \\
| * | * | * | * |
 \\ / \\ / \\ / \\ /
  | * | * | * |
   \\ / \\ / \\ /`)

Python 2, 279 bytes
e=enumerate
x=input()
c=[[i,j]for i,t in e(x)for j,_ in e(t)if"*"==x[i][j]]
C=[[j%3*([i,j]in c)for j,_ in e(o)]for i,o in e(x)]
for J,K in c:
	for i in-1,0,1:q=2-(i&1);_=C[i+J];_[K+q]=_[K-q]=_[K-q]|C[J][K]
for i,o in e(x):print"".join("[%dm"%(30+C[i][j])+x[i][j]for j,_ in e(o))

Try it online!
Golfed and fixed thanks to user202729!
-27 bytes thanks to Mr. Xcoder
-24 bytes thanks to Jonathan Frech

337 bytes.

Also 2-abs(i) is 2-(i&1) in this context, 336 bytes.

@Mr.Xcoder Cool, thanks!

I think \033 can be \33 (saving one byte) or the actual \x1b character (saving three bytes).

298 bytes.

@JonathanFrech oh cool, thanks! :D

Line 1: e,x=enumerate,input()

@OldBunny2800 I think that's the same length. You swap two = and a ; for two , and a =.

Yeah, you're right.

Python 2, 346 331 bytes
e=enumerate
C='0132645'
def f(s):
 c={(i,j):[1+(i/2%2+j/4)%3*2]for i,l in e(s)for j,x in e(l)if'*'==x}
 for i,l in e(s):
  r=''
  for j,x in e(l):a=c.get((i,j),c.get((i-(x<'|'),j+[-1,1][x>'/']+(x>'z')),[]))+c.get((i+(x<'|'),j+[1,-1][x>'/']-(x>'z')),[])if' '<x else[0];r+='\033[3'+C[[sum(a)/len(a),6][set(a)=={5,1}]]+'m'+x
  print r

Try it online!

HTML (Canvas) + JavaScript (ES6), 13 + 251 = 264 bytes
Locates all the *s in the input string and paints an ASCII hexagon on the canvas at the corresponding positions. Because globalCompositeOperation='lighter', color addition is performed automatically when characters overlap.
HTML
<canvas id=c>

JavaScript
s=>{c.width=c.height=s.length
with(c.getContext`2d`)font='1px monospace',globalCompositeOperation='lighter',s.split`
`.map((r,y)=>[...r].map((c,x)=>c=='*'&&[` / \\`,`| * |`,` \\ /`].map((t,i)=>fillText(t,x,y+i),fillStyle=['red','lime','blue'][x%3])))}

A multiplier and additional scale() command were added to the snippet for visibility.

// Unscaled
/*
f=
s=>{c.width=c.height=s.length
with(c.getContext`2d`)font='1px monospace',globalCompositeOperation='lighter',s.split`
`.map((r,y)=>[...r].map((c,x)=>c=='*'&&[` / \\`,`| * |`,` \\ /`].map((t,i)=>fillText(t,x,y+i),fillStyle=['red','lime','blue'][x%3])))}
*/

// Scaled
let scaleFactor = 40

f=
s=>{c.width=c.height=s.length*scaleFactor
with(c.getContext`2d`)scale(scaleFactor,scaleFactor),font='1px monospace',globalCompositeOperation='lighter',s.split`
`.map((r,y)=>[...r].map((c,x)=>c=='*'&&[` / \\`,`| * |`,` \\ /`].map((t,i)=>fillText(t,x,y+i),fillStyle=['red','lime','blue'][x%3])))}

// Test
f(` / \\ / \\ / \\ / \\
| * | * | * | * |
 \\ / \\ / \\ / \\ /
  | * | * | * |
   \\ / \\ / \\ /`)
<canvas id=c>

Also see my CSS-based approach.

I don't believe this meets the required output:
https://i.stack.imgur.com/Pp3J0.png. The forward and backslashes are supposed to be the additive combinations of the colors of the hexagons they border, not separate.

@PatrickRoberts Hmm, looks to be an issue with inconsistent font widths (the positions are correct on my computer). I'll look into this later today.

Oh, I didn't realize there was a platform that was correct. If you update your answer with a screenshot, I'll revert my vote. Answers only need to work on at least one implementation, they don't need to be cross-platform.

MATLAB/Octave, 223 bytes
a=input('')';s=size(a);p=zeros([s 3]);[i,j]=ind2sub(s,find(a=='*'));
for f=1:nnz(i)
p((-2:2)+i(f),(-1:1)+j(f),mod(f+~mod(j(f)/2,2),3)+1)=1;end
for f=1:nnz(a)
[i,j]=ind2sub(s,f);text(i/s(1),1-j/s(2),a(i,j),'Co',p(i,j,:));end

In slightly neater code format:
a=input('')';                  %Grab input as 2D array
s=size(a);                     %Get input size
p=zeros([s 3]);                %Make empty colour matrix of matching size with RGB
[i,j]=ind2sub(s,find(a=='*')); %Find all *'s
for f=1:nnz(i)                 %For each *
    %Fill a 5x3 box centred at the * on the colour channel for this box
    %Overlapping regions between boxes will result in the correct mix.
    p((-2:2)+i(f),(-1:1)+j(f),mod(f+~mod(j(f)/2,2),3)+1)=1;
end
%Display as text on a figure
for f=1:nnz(a)
    [i,j]=ind2sub(s,f);
    text(i/s(1),1-j/s(2),a(i,j),'Co',p(i,j,:))
end

The input is taken as a 2D array, such as entering the following when prompted for input:
[' / \ / \ / \ / \ ';'| * | * | * | * |';' \ / \ / \ / \ / ';'  | * | * | * |  ';'   \ / \ / \ /   ']

MATLAB so far as I'm aware doesn't have the ability to output colours to the console (except for dirty Java hacks which I am discounting). As such the output is instead printed to a figure.
Colouring is achieved by finding the location of all *'s in the input, and then in an RGB colour array (p), a 5x3 box of 1's (255 in MATLAB colour representation) are written centred about the *. The box is written to the colour corresponding with the mod-3 index along each line, with even lines having the colour index shifted by an offset.
This produces a colour matrix where any boxes that overlap will result in the required mixed colour. The example above produces the following colour matrix.

The white and black regions are irrelevant because at those locations a space is printed meaning we don't actually see the incorrect colour.
Once the colour matrix is created, we display each character on a figure using the text command, setting the colour of the text to the corresponding entry in the colour matrix. The above example will display: