How to create a setlist where no two consecutive songs are in the same key

Question

This is a real problem I am trying to automate a solution to, so I'm happy to answer any questions or requests for clarification. Thanks in advance for reading, and for any thoughts you may have on this. :)

Edit: To distinguish from the possible duplicate question, I was hoping for Clojure-specific programs that are guaranteed to return the correct answer and leverage Clojure's core and combinatorics libraries... and people had the answers! Thank you.

The problem of finding key-valid setlists

I have a set of n songs (order doesn't matter).

Every song has exactly one key signature, or "key" for short, which must be one of the 12 strings "A" "A#" "B" "C" "C#" "D" "D#" "E" "F" "F#" "G" "G#".

Multiple songs can "be in the same key" (have the same integer assigned to them).

I need to return an ordered list of length n that contains every song, in an order such that no two consecutive songs are in the same key, if such a list can be found. (I'll call this a key-valid setlist). This is because it sounds a bit boring when you hear two songs back-to-back in the same key. It sounds a bit like they are two sections of one massive song.

; input 1, here given as a list but really an unordered set, not a key-valid setlist because there are a bunch of songs in the key of A consecutively:
[
    {:title "Deep House Track" :key "F#"}
    {:title "Breakup Song" :key "B"}
    {:title "Love Song" :key "A"}
    {:title "Inspirational Song" :key "A"}
    {:title "Summer Song" :key "A"}
    {:title "Summer Song" :key "A"}
    {:title "Power Ballad" :key "D"}
]

; output 1 will be:

[
    {:title "Love Song" :key "A"}
    {:title "Breakup Song" :key "B"}
    {:title "Inspirational Song" :key "A"}
    {:title "Power Ballad" :key "D"}
    {:title "Summer Song" :key "A"}
    {:title "Deep House Track" :key "F#"}
    {:title "Summer Song" :key "A"}
]

Obviously it's not always possible to find a key-valid setlist:

; input 2, with no solution:
[
    {:title "Love Song" key "A"}
    {:title "Inspirational Song" key "A"}
]

What I've tried

I've tried to write something that will use Clojure's group-by on the input to group by the key signature string (call the resulting map m) and then have a recursive function with an accumulator (where I will build up the final setlist) that tries to place a song from m into the accumulator in a valid position.

However I couldn't convince myself that this method would always find a solution if one exists.

Ideas

My idea above seemed plausible but may need the addition of backtracking. I don't know off the top of my head how to implement this.

Other ideas include treating this like sudoku and using a constraint-based method - I would be interested in a more declarative approach using core.logic if anyone knows how to do that.

Future considerations:

1. Using some kind of randomised strategy to find a solution faster.
2. Returning all possible key-valid setlists if any exist.
3. Adding another property to the songs e.g. tempo, that must follow a different rule (e.g. tempo must increase monotonically throughout the setlist)
4. Getting approximate solutions (i.e. with minimum number of consecutive songs in the same key), maybe only when no perfect solution can be found, or maybe when there are other constraints that need to be satisfied.

I'm trying to do this in Clojure (I thought the core.logic library might help) but obviously the algorithm can be done in any language.

Answer 1

Here's a way to do it using core.logic.

We'll define secondo (like firsto) to look at the second item of each pair of items in a collection in the next function.

(defn secondo [l s]
  (fresh [x]
    (resto l x)
    (firsto x s)))   

We'll define nonconseco to recursively check that there are no consecutive values:

(defn nonconseco [l]
  (conde
    [(== l ())]
    [(fresh [x] (== l (list x)))]
    [(fresh [lhead lsecond ltail]
       (conso lhead ltail l)
       (secondo l lsecond)
       (project [lhead lsecond] ;; project to get your map keys
         (!= (:key lhead) (:key lsecond)))
       (nonconseco ltail))]))

And a function to find the first permutation of coll that doesn't have any consecutive identical values:

(defn non-consecutive [coll]
  (first
    (run 1 [q]
      (permuteo coll q)
      (nonconseco q))))

This can be used on your sample input:

(non-consecutive
  [{:title "Deep House Track" :key "F#"}
   {:title "Breakup Song" :key "B"}
   {:title "Love Song" :key "A"}
   {:title "Inspirational Song" :key "A"}
   {:title "Summer Song" :key "A"}
   {:title "Power Ballad" :key "D"}])
=>
({:title "Love Song", :key "A"}
 {:title "Breakup Song", :key "B"}
 {:title "Inspirational Song", :key "A"}
 {:title "Deep House Track", :key "F#"}
 {:title "Summer Song", :key "A"}
 {:title "Power Ballad", :key "D"})

And here's a generic version of nonconseco that just looks at values, instead of :keys in a map:

(defn nonconseco [l]
  (conde
    [(== l ())]
    [(fresh [x] (== l (list x)))]
    [(fresh [lhead lsecond ltail]
       (conso lhead ltail l)
       (secondo l lsecond)
       (!= lhead lsecond)
       (nonconseco ltail))]))

 (non-consecutive [1 1 2 2 3 3 4 4 5 5 5])
 => (3 2 3 4 2 4 5 1 5 1 5)

Update: here's a faster version that uses a predicate function rather than relational logic:

(defn non-consecutive? [coll]
  (every? (partial apply not=) (partition 2 1 coll)))

Then use core.logic's pred to apply that predicate to the logic variable:

(run 10 [q]
  (permuteo coll q)
  (pred q non-consecutive?))