32
\$\begingroup\$

You may know the game The Six Degrees of Kevin Bacon, based on the conjecture that every actor in Hollywood can be connected to Kevin Bacon by no more than 6 "co-star" relations, so Kevin Bacon is supposedly the "best-connected" node in that graph. Your task will be to find the Kevin Bacon of a graph.

We will use positive integers to represent actors, and use a list of pairs which defines the relations of the graph (adjacency list). For example, [(1, 2), (2, 3)] defines that 1 has costarred with 2, and 2 has costarred with 3.

We will measure "connectedness" using average shortest path length:

  • The shortest path length is the number of steps in the shortest path between two given nodes. In the example graph above, the shortest (and also only) path between 1 and 3 is 1 -> 2 -> 3, which has path length 2
  • The average shortest path length of a node A is the mean of the shortest path lengths between A and each other node in the network

Your task is to, given an adjacency list, find the best-connected node in the graph. That is, find the node A such that this average is minimised, and output its number.

If there are multiple nodes with the same average shortest path length, you may output any of them.

Worked example

Consider the small graph:

    1-----2
   / \    |
  3---4   5

which would be represented by the adjacency list:

[(1, 2), (2, 5), (1, 3), (1, 4), (3, 4)]

Now we compute the shortest path length between each pair of nodes (ignoring the relations between nodes and themselves):

  |1 2 3 4 5
--+---------
1 |  1 1 1 2
2 |1   2 2 1
3 |1 2   1 3
4 |1 2 1   3
5 |2 1 3 3

For each node we can then compute the average of its path lengths to all the other nodes:

1 ~> 1.25  [  (1+1+1+2)/4 = 5/4 = 1.25  ]
2 ~> 1.5
3 ~> 1.75
4 ~> 1.75
5 ~> 2.25

So node 1 has the smallest average shortest path length, so the output is 1.

Rules

  • You may assume the input is non-empty, contains no self-referential pairs (like (3, 3)), and no duplicate edges (like [(3, 1), (1, 3)])
  • You may assume all nodes of the graph are connected somehow (for example, you don't have to handle [(1, 2), (3, 4), (5, 3)])
  • You may assume the set of integers used for node IDs is 1 to N (inclusive) for some N. For example, you don't have to handle [(1, 54), (54, 128)] nor [(2, 3), (2, 4)]
    • You may alternately choose to assume this range is 0 to N-1
  • You may use any standard I/O method
  • Standard loopholes are forbidden
  • This is , so the shortest code in bytes wins

Test cases

Input:  [(1, 2), (2, 5), (1, 3), (1, 4), (3, 4)]
Output: 1

Input:  [(1, 2), (2, 3), (3, 4), (4, 5)]
Output: 3

Input:  [(1, 2), (2, 3), (3, 4), (4, 1), (2, 5)]
Output: 2

Input:  [(1, 2)]
Output: 1 or 2

Input:  [(6, 1), (5, 2), (2, 1), (1, 5), (6, 3), (6, 4), (3, 4), (6, 2), (3, 7)]
Output: 6
\$\endgroup\$
12
  • \$\begingroup\$ Can the input be an adjacency matrix? \$\endgroup\$
    – Jonah
    Jan 7 at 16:15
  • 2
    \$\begingroup\$ Not that it matters, but the six-degrees rule probably works for any two reasonably prolific actors, I don't think Kevin Bacon is particularly unusual in that respect, he's just the standard example given for some reason. If you put all of IMDB as input into one of these programs, I don't think the "Kevin Bacon" would actually be Kevin Bacon. \$\endgroup\$ Jan 7 at 17:11
  • 2
    \$\begingroup\$ @DarrelHoffman Yes, the Wikipedia article has some more discussion on this. One source reports the true Kevin Bacon to be Christopher Lee (although I don't think that's using the same metric as this challenge) \$\endgroup\$
    – pxeger
    Jan 7 at 17:14
  • 1
    \$\begingroup\$ @JonathanAllan yes, that's fine. (That is actually what I meant by "you may output any [non-empty subset] of them", but I'll clarify it) \$\endgroup\$
    – pxeger
    Jan 8 at 6:44
  • 1
    \$\begingroup\$ I think Kevin Bacon is actually Paul Erdős. (Or at least he should be in this context.) \$\endgroup\$
    – Bass
    Jan 9 at 22:46

10 Answers 10

12
\$\begingroup\$

BQN*, 53 45 bytesSBCS

{1+⊑⍒+˝+´(∨∨∨˝∘×⎉1‿∞)⍟n˜∨⟜⍉∨˝𝕩≡⌜1+⋈⌜˜n←↕⌈´∾𝕩}

Run online!

Theory:

Let \$k\$ be the maximum node id. Then the node IDs are \$\{1, 2, ..., k\}\$.
For the given adjacency list we can construct an adjancency matrix \$A=(a_{ij}) \in \{0,1\}^{k \times k}\$, where \$a_{ij} = 1\$ iff \$i=j\$ or node \$i\$ and node \$j\$ are adjacent.

The distance between two nodes in the graph is given by the smallest \$m\$, such \$A^m\$ has a non-zero entry at the position.†

Implementation:

∨⟜⍉∨˝𝕩≡⌜1+⋈⌜˜n←↕⌈´∾𝕩
Convert the adjacency list to a modified adjacency matrix \$A-I_k\$ with zeros on the diagonals. This part is a bit lengthy, maybe can be used?

(∨∨∨˝∘×⎉1‿∞)⍟n˜
Calculate \$A-I_k, \mathop{sign}(A^2), \mathop{sign}(A^3), \cdots, \mathop{sign}(A^{k-1})\$. In normal matrix multiplication you would use + instead of , but here we only care for zero / non-zero.

+˝+´
Sum the resulting \$k\$ matrices, then each row. This is some kind of inverse summed shortest path length. This could be converted to the average shortest path length, but that step is not necessary as the order is the same, but reversed.

1+⊑⍒
Get the 1-based index of the maximum value. Using 0-indexing for the node IDs would save two bytes.

*According to the documentation, in this situation the name can be pronounced bacon
†Slightly longer explanation can be found on Wikipedia

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

Wolfram Language (Mathematica), 46 bytes

-12 bytes thanks to @att.

g#&@@SortBy[##&@@@g,Tr[g~GraphDistance~#]&]

Try it online!

Takes input as a list of a <-> bs, e.g. {1 <-> 2, 2 <-> 5, 1 <-> 3, 1 <-> 4, 3 <-> 4}.

Sadly the GraphCenter built-in uses the maximal (instead of average) shortest path length.

\$\endgroup\$
1
  • 2
    \$\begingroup\$ 46 bytes \$\endgroup\$
    – att
    Jan 7 at 18:46
6
\$\begingroup\$

J, 72 71 73 bytes

1+[:(i.<./)1#.[:+/@(*#\)2-~/\0,[:+./ .*^:a:~@(+[:=#\)[:+/](-{.1:)"1@,|."1

Try it online!

Input: 1-indexed adjacency list.

Output: 1-indexed answer.

how

Consider:

1 2
2 5
1 3
1 4
3 4
  • [:+/](-{.1:)"1@,|."1 - Converts the adjacency list to an adjacency matrix. This was the hardest part to golf, and it's still long.

    • ]...,|."1 First we concatenate the list with a copy of itself, with each row reversed:

      1 2
      2 5
      1 3
      1 4
      3 4
      2 1
      5 2
      3 1
      4 1
      4 3
      
    • (-{.1:)"1 - Then we create matrices of each of those sizes, with a 1 in the bottom right corner. I'll display them boxed, before the automatic 0 fill, for clarity:

      ┌───┬─────────┬─────┬───────┬───────┬─┬───┬─┬─┬─────┐
      │0 1│0 0 0 0 0│0 0 1│0 0 0 1│0 0 0 0│0│0 0│0│0│0 0 0│
      │   │0 0 0 0 1│     │       │0 0 0 0│1│0 0│0│0│0 0 0│
      │   │         │     │       │0 0 0 1│ │0 0│1│0│0 0 0│
      │   │         │     │       │       │ │0 0│ │1│0 0 1│
      │   │         │     │       │       │ │0 1│ │ │     │
      └───┴─────────┴─────┴───────┴───────┴─┴───┴─┴─┴─────┘
      

      Once the fill is added it looks like:

      0 1 0 0 0
      0 0 0 0 0
      0 0 0 0 0
      0 0 0 0 0
      0 0 0 0 0
      
      0 0 0 0 0
      0 0 0 0 1
      0 0 0 0 0
      0 0 0 0 0
      0 0 0 0 0
      
      0 0 1 0 0
      0 0 0 0 0
      0 0 0 0 0
      0 0 0 0 0
      0 0 0 0 0
      .
      .
      .
      
    • [:+/ - Finally we sum the layers, giving us the adjacency matrix:

      0 1 1 1 0
      1 0 0 0 1
      1 0 0 1 0
      1 0 1 0 0
      0 1 0 0 0
      
  • (+[:=#\) Next we add the diagonal of ones (nodes are already connected to themselves).

    1 1 1 1 0
    1 1 0 0 1
    1 0 1 1 0
    1 0 1 1 0
    0 1 0 0 1
    
  • +./ .*^:a:~ Matrix "or multiply" with self, until we reach a fixed point, saving intermediate values. The additional ones added in iteration n represent nodes that can be reached in n hops.

  • 2-~/\0, We want to separate each iteration's contribution, so we take successive deltas, starting with a matrix of all zeros:

    1 1 1 1 0
    1 1 0 0 1
    1 0 1 1 0
    1 0 1 1 0
    0 1 0 0 1
    
    0 0 0 0 1
    0 0 1 1 0
    0 1 0 0 0
    0 1 0 0 0
    1 0 0 0 0
    
    0 0 0 0 0
    0 0 0 0 0
    0 0 0 0 1
    0 0 0 0 1
    0 0 1 1 0
    
  • (*#\) Multiply each of those values by its iteration number:

    1 1 1 1 0
    1 1 0 0 1
    1 0 1 1 0
    1 0 1 1 0
    0 1 0 0 1
    
    0 0 0 0 2
    0 0 2 2 0
    0 2 0 0 0
    0 2 0 0 0
    2 0 0 0 0
    
    0 0 0 0 0
    0 0 0 0 0
    0 0 0 0 3
    0 0 0 0 3
    0 0 3 3 0
    
  • +/@ And sum the layers:

    1 1 1 1 2
    1 1 2 2 1
    1 2 1 1 3
    1 2 1 1 3
    2 1 3 3 1
    
  • 1#. Then sum the rows:

    6 7 8 8 10
    
  • 1+[:(i.<./) Finally return the minimum value's index, plus 1:

    1
    
\$\endgroup\$
2
  • \$\begingroup\$ I think you'll have to include those 2 bytes. But nice answer! \$\endgroup\$
    – pxeger
    Jan 8 at 6:36
  • \$\begingroup\$ @pxeger Thanks. Updated. \$\endgroup\$
    – Jonah
    Jan 8 at 6:48
6
\$\begingroup\$

Python 3, 234 bytes

def f(l):
 m=1+max(map(max,l));g=eval(str([[m]*m]*m))
 for a,b in l:g[a][a]=g[b][b]=0;g[a][b]=g[b][a]=1
 for x in range(m**3):k=x%m;x//=m;j=x%m;i=x//m;g[j][k]=min(g[j][k],g[j][i]+g[i][k])
 return min((sum(g[i]),i)for i in range(m))[1]

Try it online!

Implementing simple Floyd-Warshall. This is my first time here. Any tips are welcome!

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

Jelly, 27 bytes

;©U;þ®ẎḢ⁼ṪƊƇƊLСŒṬ€ĖP€o/SİM

A monadic Link accepting the adjacency list specified that yields a list of all of the Kevin Bacons of that graph.

Try it online!

How?

We first produce lists of all pairs of nodes linked by 1, 2, 3, ... steps (up to 2p+1 where p is the number of pairs in the input, just for golfing purposes) - including redundancies and self-linked pairs.

Then we turn each of these into tables showing the number of steps taken, if possible, or zero if not - i.e. the first is 0 or 1 at each point, the second is 0 or 2 at each point, and so on.

We then reduce these by logical OR, giving us the shortest length table shown in the question with a leading diagonal filled with 2s (since we are guaranteed a fully-connected graph, we will always produce a 2 at this position in the second previous table by following a given pair and its reverse, and the logical OR will keep this value if we could do the same in more steps).

Then we sum the columns, inverse and find maximal indices (aligning with the guaranteed [1,n] node numbering).

;©U;þ®ẎḢ⁼ṪƊƇƊLСŒṬ€ĖP€o/SİM - Link: adjacency list, A
  U                         - reverse each pair in A
;                           - concatenate that to A
 ©                          - copy this to the register for later
              С            - collect up and repeat:
             L              - ...times: length (of the new list)
            Ɗ               - ...what: the last three links as a monad, f(current):
     ®                      -     use the register as the right argument of:
    þ                       -       (current) table (register) using:
   ;                        -         concatenation (e.g. [2,5];[1,2] -> [2,5,1,2])
      Ẏ                     -     tighten (from a table to a row-major order list)
           Ƈ                -     filter keep those for which:
          Ɗ                 -       last three links as a monad:
       Ḣ                    -         pop and yield head
         Ṫ                  -         pop and yield tail
        ⁼                   -         equal? (leaving the inner two
                                              e.g. [2,5,1,2] -> [5,1]
                                              which is kept since 2=2)
                  €         - for each:
                ŒṬ          -   make a table with 1s at the given coordinates)
                   Ė        - enumerate -> [[1,first],[2,second],...]
                    P€      - product of each
                      o/    - reduce by logical OR
                        S   - sum columns
                         İ  - inverse
                          M - maximal indices (1-indexed)
\$\endgroup\$
5
\$\begingroup\$

R, 120 113 111 107 106 102 bytes

Or R>=4.1, 95 bytes by replacing the word function with a \.

Edit: -7 bytes and -4 bytes thanks to @Giuseppe. -1 byte thanks to @Dominic van Essen. -4 bytes inpired by @Dominic van Essen's answer to related challenge.

function(v){A=diag(m<-max(v))
A[v]=1
C=B=A=A|t(A)
for(i in 2:m)B[(C=C%*%A)&!B]=i
order(colSums(B))[1]}

Try it online!

Straightforward approach:

  1. Calculate adjacency matrix A.
  2. Gradually increase powers of A (stored in C) to see when will appear the first non-zero entry for each pair of indices. (Where's built-in matrix power when you need one?)
  3. Store the distances in B.
  4. Find the column with the smallest sum.
\$\endgroup\$
5
  • \$\begingroup\$ 113 bytes \$\endgroup\$
    – Giuseppe
    Jan 7 at 20:46
  • \$\begingroup\$ @Giuseppe, thanks! I'm mad at myself for not remembering the first trick, but the second one is clever! \$\endgroup\$
    – pajonk
    Jan 7 at 20:57
  • 1
    \$\begingroup\$ Since the adjacency matrix A is all non-negative, I believe you can remove the >0. I'm also curious if you can remove the *0 but haven't tested it enough. \$\endgroup\$
    – Giuseppe
    Jan 8 at 0:06
  • \$\begingroup\$ @Giuseppe, you're right in both cases. Without the *0 A represents a graph with all vertices connected to themselves (loops), which doesn't affect minimal distances between other vertices. \$\endgroup\$
    – pajonk
    Jan 8 at 11:36
  • 2
    \$\begingroup\$ Cheap -1 byte \$\endgroup\$ Jan 8 at 19:40
4
\$\begingroup\$

05AB1E, 44 42 bytes

I guess crossed out 44 is no longer a thing with the new font. ;)

ZL©ε®yKδ‚εU怜€`ʒнXнåyθXθåyüå€àPP}€gß]OWk>

Takes advantage of the rule "You may assume the set of integers used for node IDs is positive and contiguous." to save some bytes, although it still feels pretty long..

Try it online or verify almost all test cases (the largest/last test case times out and is omitted in the test suite).

Explanation:

Z            # Get the flattened maximum of the (implicit) input-list of pairs
 L           # Pop and push a list in the range [1,max]
  ©          # Store it in variable `®` (without popping)
   ε         # Map over each integer:
    ®        #  Push the [1,max] list from variable `®` again
     yK      #  Remove the current integer from it
       δ     #  Map over each remaining integer:
        ‚    #   Pair it with the current integer
    ε        #  Map over each pair:
     U       #   Pop the current pair and store it in variable `X`
      æ      #   Get the powerset of the (implicit) input-list of pairs
       €œ    #   Get the permutations of each inner list
         €`  #   Flatten it one level down
     ʒ       #   Filter over this list of potential paths:
      н      #    Pop and push the first pair
       Xнå   #    Check if the first value of `X` is in this pair
      yθXθå  #    Do the same for the last pair and last value of `X`
      y      #    Then push the list of pairs again
       ü     #    For each overlapping pair of pairs:
        å    #     Check for both values in the second pair if it's in the first
             #    (this will result in an empty list for single-pair lists)
         ۈ  #    Check for each overlapping check if either is truthy
           P #    Check if all overlapping checks are truthy
      P      #    Check if all three checks are truthy
     }€g     #   After the filter: get the length of each valid path
        ß    #   Pop and push the minimum path-length
   ]         # Close both the inner and outer maps
    O        # Sum each inner list (shorter than the average)
     W       # Push the minimum sum (without popping the list)
      k      # Get the (first) 0-based index of this minimum
       >     # Increase it by 1 to make it a 1-based index
             # (after which this is output implicitly as result)
\$\endgroup\$
4
  • 2
    \$\begingroup\$ Crossed out 44 still looks like regular 44 to me... \$\endgroup\$
    – pxeger
    Jan 7 at 15:04
  • 1
    \$\begingroup\$ I keep up my chain of crossed out 44s, codegolf.stackexchange.com/a/239777/17602 being the latest. \$\endgroup\$
    – Neil
    Jan 7 at 17:36
  • \$\begingroup\$ @pxeger Browser dependent perhaps? For me it looks like this. Far different than what it was when I created that linked challenge. \$\endgroup\$ Jan 7 at 17:43
  • 1
    \$\begingroup\$ @KevinCruijssen I see the same thing as your screenshot on Chrome, but on Firefox the strikethrough lines up perfectly with the horizontal lines in the 4s. \$\endgroup\$
    – DLosc
    Jan 7 at 22:24
4
\$\begingroup\$

Charcoal, 82 81 bytes

≔⊕⌈Eθ⌈ιη≔EηEη∨⁼ιλ∨№θ⟦ιλ⟧№θ⟦λι⟧η≔Eηιζ≔EηιεFη«UMζEκ⊙η∧§κπ§ξνUMεEκ⁺짧ζλν»UMεΣιI⌕ε⌈ε

Try it online! Link is to verbose version of code. Explanation: Port of ovs's "Bacon" answer.

≔⊕⌈Eθ⌈ιη

Get the number of nodes.

≔EηEη∨⁼ιλ∨№θ⟦ιλ⟧№θ⟦λι⟧η

Calculate the adjacency matrix.

≔Eηιζ≔Eηιε

Create two shallow clones as we'll be mutating these.

Fη«

Repeat for each node, to ensure that all nodes are eventually reached.

UMζEκ⊙η∧§κπ§ξν

Update the first clone to the adjacency matrix at the next depth.

UMεEκ⁺짧ζλν

Add it to the second clone.

»UMεΣι

Sum the rows of the second clone.

I⌕ε⌈ε

Find the index of the largest sum.

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

Perl 5 List::Util, 174 bytes

sub{$S=99;sub D{$_[0]-$a?1+min map D(@$_),grep$_[0]==$$_[1]&&!$b{$$_[0]}++,@g:0}for$a(@a=uniq map@$_,@g=map{$_,[@$_[1,0]]}@_){$S=$s,$A=$a if$S>($s=sum map{%b=();D($_)}@a)}$A}

Try it online!

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

Python3, 276 bytes:

lambda g:min(enumerate(n:=[*{i for k in g for i in k}]),key=lambda x:sum(min(p(g,x[1],j))for j in n[:x[0]]+n[x[0]+1:])/float(len(n)-1))[1]
def p(g,s,e,c=[]):
 if s==e:yield len(c)
 else:
  for i in g:
   if s in i and(j:=[i[0],i[1]][s==i[0]])not in c:yield from p(g,j,e,c+[s])

Try it online!

\$\endgroup\$
2
  • 1
    \$\begingroup\$ (s==i[0]or s==i[1]) -> s in i[:2] \$\endgroup\$
    – pxeger
    Jan 7 at 18:54
  • \$\begingroup\$ You can also save a couple bytes with a var-args function: change c=[] to *c and c+[s] to *c,s \$\endgroup\$
    – pxeger
    Jan 7 at 18:55

Your Answer

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

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