16
\$\begingroup\$

It is a well-known fact that you can colour a two-dimensional map with four colours in such a way that two countries with a common border always have different colours. There have already been enough challenges on this topic.

However, the prerequisite for this is that there must be no enclaves, i.e. non-contiguous areas that must be coloured in the same colour (otherwise, in the worst case, you would always need as many colours as countries, because each one could have an enclave in every other one).

In this task there is only one dimension, so without enclaves, you would get by with two colours. But, alas, the world and this challenge allow enclaves.

The task: Colour a one-dimensional map with as few colours as possible, so that adjacent countries always have different colours, but enclaves have the same colour as the rest of the country. Of course, there can be more than one optimal solution, but output only one.

Input: A list of whatever, e.g. a character string in which a certain character stands for a country.

Output: The corresponding "coloured" list, e.g. the corresponding character string in which a certain character stands for a certain colour.

Test data:

abcdddeefghhhi x2x222xx2x222x
abcdddeefgahhi 12122211231221
abcdadcbaaaeb1 12321232111321
#Aa#Bb#Ccabc#  1231321243241
#Aa#Bb#CcabC#  1231321323231

Test data for languages that do not support strings, but lists:

[5,6,3,8,8,8,9,9,1,12,2,2,2,17]   [9,2,9,2,2,2,9,9,2,9,2,2,2,9]
[5,6,3,8,8,8,9,9,1,12,5,2,2,17]   [1,2,1,2,2,2,1,1,2,3,1,2,2,1]
[5,6,3,8,5,8,3,6,5,5,5,9,6,1]     [1,2,3,2,1,2,3,2,1,1,1,3,2,1]
[1,2,3,1,4,5,1,6,7,3,5,7,1]       [1,2,3,1,3,2,1,2,4,3,2,4,1]
[1,2,3,1,4,5,1,6,7,3,5,6,1]       [1,2,3,1,3,2,1,3,2,3,2,3,1]
\$\endgroup\$
11
  • 1
    \$\begingroup\$ Can I output [3,2,3] for [1,2,3], aka not color in 1..n? \$\endgroup\$
    – l4m2
    Dec 1, 2023 at 7:39
  • 1
    \$\begingroup\$ @CommandMaster Of course, otherwise you could just output the input. ;) \$\endgroup\$ Dec 1, 2023 at 8:31
  • 2
    \$\begingroup\$ #Aa#Bb#Ccabc# is as short a string as I could make the greedy algorithm fail on (ca#cb#bcabc# vs greedy #Aa#Ab#Acabc#) \$\endgroup\$
    – att
    Dec 1, 2023 at 10:37
  • 1
    \$\begingroup\$ Aside: In this task there is only one dimension, so you would obviously get by with two colours. This is incorrect, should be something more like: normally. \$\endgroup\$
    – Noodle9
    Dec 1, 2023 at 11:49
  • 2
    \$\begingroup\$ Not necessary to add to the question but aedcbabec also fails for greedy algorithm. Might be easier to test due to its length. \$\endgroup\$
    – Tbw
    Dec 2, 2023 at 0:38

8 Answers 8

3
\$\begingroup\$

JavaScript (ES6), 121 bytes

Expects an array of characters, returns a string of digits.

f=(a,x)=>(g=([v,...b],m,p,o)=>v?(h=j=>j?h(j-1)||!(m[v]-j)&&p==v|j^m[p]&&g(b,{...m,[v]:j},v,[o]+j):0)(x):o)(a,g)||f(a,-~x)

Try it online!

Commented

f = (                 // f is a recursive function taking:
  a,                  //   a[] = input array
  x                   //   x = maximum color index, initially undefined
) =>                  //
( g = (               // g is a recursive function taking:
    [v,               //   v = next value from a[]
        ...b],        //   b[] = remaining values
    m, p, o           //   m = mapping, p = previous value, o = output
  ) =>                //
  v ?                 // if v is defined:
    ( h =             //   h is yet another recursive function taking:
      j =>            //     j = color index candidate
      j ?             //   if j is not 0:
        h(j - 1) ||   //     try a recursive call with j - 1
        !(            //     if either m[v] is undefined
          m[v] - j    //     or m[v] is equal to j
        ) &&          //     and
        p == v |      //     either p = v
        j ^ m[p] &&   //     or j is not equal to m[p],
        g(            //     then do a recursive call to g:
          b,          //       pass the remaining values
          { ...m,     //       build a new object m' with all properties
            [v]: j }, //       of m and a new property m'[v] = j
          v,          //       set the previous value to v
          [o] + j     //       append j to the output
        )             //     end of recursive call
      :               //   else:
        0             //     failure: return 0
    )(x)              //   initial call to h with j = x
  :                   // else:
    o                 //   success: return the output
)(a, g) ||            // initial call to g, using m = g
f(a, -~x)             // if it failed, try again with one more color
\$\endgroup\$
2
\$\begingroup\$

Python, 111 bytes

f=lambda s:min([f(s.replace(x,y))for x in s for y in s if y<x<x+y not in s+s[::-1]]+[s],key=lambda t:len({*t}))

Attempt This Online!

Takes and returns a string.

How?

Recursively replaces one colour a time for a non neighbouring one. Of all possible such replacements returns the best one as found recursively.

This would be very slow, so in the footer I inject the Python standard lib magic memoiser which doesn't change the outcome of a function but very much its speed.

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

Charcoal, 33 30 bytes

⊞υθFυFιFΦ⁻ικ¬№⁺ι⮌ι⁺κλ⊞υ⪫⪪ιλκ⊟υ

Try it online! Link is to verbose version of code. Exponentially slow, as it generates multiple copies of all legal colourings and then outputs one with the fewest colours, so test case is pretty short. Uses the input character set as the colour characters. Explanation:

⊞υθFυ

Start a breadth-first search for legal colourings.

FιFΦ⁻ικ¬№⁺ι⮌ι⁺κλ

Loop over all possible parings of countries that could be coloured with the same colour.

⊞υ⪫⪪ιλκ

Generate the resulting colouring and add it to the search list.

⊟υ

Output one of the colourings that uses the fewest colours.

41 38 bytes for a somewhat faster version that saves fewer duplicate colourings and can therefore handle one of the provided test cases:

⊞υθFυFιFEΦι›‹κλ№⁺ι⮌ι⁺κλ⪫⪪ιλκF¬№υλ⊞υλ⊟υ

Try it online! Link is to verbose version of code.

\$\endgroup\$
1
\$\begingroup\$

Python3, 318 bytes:

def f(s):
 q,F,T=[(s,'','',{})],0,''
 while q:
  s,S,L,d=q.pop(0)
  if''==s:
   if(T==''or len({*S})<F):F,T=len({*S}),S
   continue
  K=[*{*sum(d.values(),[])}]
  for i in d.get(s[0],K+[max(K+[0])+1]):
   if(''==S or S[-1]!=str(i)or s[0]==L)and(T==''or len({*S})<F):q=[(s[1:],S+str(i),s[0],{**d,s[0]:[i]})]+q
 return T

Try it online!

\$\endgroup\$
1
\$\begingroup\$

Haskell, 138 bytes

import Data.List
f x|b<-nub x,y<-[elemIndices j b!!0|j<-x]=[v|n<-[1..],t<-mapM id$[1..n]<$b,v<-[map(t!!)y],z y==z v]!!0
z=map length.group

Attempt This Online!

\$\endgroup\$
1
\$\begingroup\$

Jelly, 20 19 bytes

QŒcw@ÐḟŒBy€)Ẏ
WÇƬẎṪ

Try it online!

A pair of links called as a monad and taking a string and returning a string. Uses a subset of the input characters for output. In brief this iteratively finds all possible merges of characters in a breadth-first search. The last remaining group of possibilities will be the ones with most characters merged. Slow for the first two test cases as written so TIO link uses slightly shorter versions.

Explanation

QŒcw@Ðḟ;U$y€)Ẏ  # ‎⁡Helper link: takes a list of strings and for each one generates a list of strings with one pair of valid characters merged before joining these outer lists
            )   # ‎⁢For each string:
Q               # ‎⁣- Uniquify
 Œc             # ‎⁤- Combinations length 2
   w@Ðḟ         # ‎⁢⁡- Filter out those which are a substring of:
       ŒB       # ‎⁢⁢  - The string palindomised
          y€    # ‎⁢⁣- Use each of the remaining combinations to ‘translate’ the string
             Ẏ  # ‎⁢⁤Join outer lists
‎⁣⁡
WÇƬẎṪ           # ‎⁣⁢Main link: takes a string and returns the simplified string
W               # ‎⁣⁣Wrap in a list
 ÇƬ             # ‎⁣⁤Call the helper link until no further changes, collecting up intermediates
   Ẏ            # ‎⁤⁡Join outer lists
    Ṫ           # ‎⁤⁢Tail
💎

Created with the help of Luminespire.

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

Perl 5, 150 bytes

sub{$_=pop;sub L{pop=~s/(.)\1*/X.length$&/egr}@c=/./g;for$n(1..@c){for$t(0..$n**@c){$c{$_}=$t%$n,$t/=$n for@c;L($s=s/./$c{$&}/gr)eq L($_)&&return$s}}}

Try it online!

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

Scala

I was trying to rewrite @Ajax1234's Python answer in scala.

But the scala code fails on some cases. Any help would be appreciated.

Try it online!

object Main {
  def f(s: String): String = {
    var queue = List((s, "", ' ', Map[Char, List[Int]]()))
    var F = 0
    var T = ""

    while (queue.nonEmpty) {
      val (currentString, prevS, lastChar, dictionary) = queue.head
      queue = queue.tail

      if (currentString.isEmpty) {
        if (T.isEmpty || prevS.toSet.size < F) {
          F = prevS.toSet.size
          T = prevS
        }
      } else {
        val K = dictionary.values.flatten.toSet.toList
        for (i <- dictionary.getOrElse(currentString.head, K :+ (if (K.isEmpty) 0 else K.max + 1))) {
          if (prevS.isEmpty || prevS.last.toString != i.toString || currentString.head == lastChar) {
            if (T.isEmpty || prevS.toSet.size < F) {
              queue = (currentString.tail, prevS + i.toString, currentString.head, dictionary.updated(currentString.head, dictionary.getOrElse(currentString.head, List()) :+ i)) :: queue
            }
          }
        }
      }
    }

    T.split("").map(_.toInt+1).map(_.toString).mkString
  }

  def main(args: Array[String]): Unit = {
    println(f("abcdddeefghhhi"))
    //println(f("abcdddeefgahhi"))
    //println(f("abcdadcbaaaeb1"))
    println(f("#Aa#Bb#Ccabc#"))
    //println(f("#Aa#Bb#CcabC#"))
  }
}
\$\endgroup\$

Your Answer

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

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