How to find all the vertices in the graph with the maximum degree?

Question

Given the schedule, let's say

g = Graph[{x -> a, y -> c, a -> b, b -> c, a -> c, d -> c, a -> d, b -> d}, VertexLabels -> "Name"] 

How to find all the vertices in the graph with the maximum degree, i.e. list all the vertices with the largest number of edges and highlight them on the graph?

In this case, these would be the vertices {a,c} .

Answer 1

Here's an approach using DegreeCentrality :

 (* In[41]:= *) max = Pick[VertexList[g], DegreeCentrality[g], Max[DegreeCentrality[g]]] (* Out[41]= *) {a, c} (* In[42]:= *) HighlightGraph[g, max] 

Answer 2

You can usually select vertices by degree:

  HighlightGraph[g, Table[Style[VertexList[g][[i]], ColorData["TemperatureMap"][ VertexDegree[g][[i]]/Max[VertexDegree[g]]]], {i, VertexCount[g]}]] 

Answer 3

Here is what I tried

 HighlightGraph[g, Part[ VertexList@g , Flatten@Position [ VertexDegree@g , Max[ VertexDegree@g ]]]] 

Same thing with Pick

 HighlightGraph[g, Pick[ VertexList@g , VertexDegree@g , Max[ VertexDegree@g ]]]