# What k-Core is a Vertex In?

What is the best way to write a quick function which takes in a vertex (of some undirected graph), and gives the value of the k-Core's in which that vertex is in?

The obvious modification of kCoreComponents[Graph,k] using Intersection is either taking ages, since it needs to re-check the core composition for each vertex (I have over 7000), or spends ages "loading" after the script is complete.

• Please add context, and all code and data (perhaps a useful subset) necessary to recreate your problem. Also,KCoreComponents with a capital K... Commented Dec 11, 2017 at 15:40

The following seems pretty fast:

kcores[g_, v_] := With[{max = VertexDegree[g, v]},
DeleteCases[_->{}] @ Table[
i -> Select[KCoreComponents[g, i], Not@*FreeQ[v]],
{i,0,max}
]
]


Here is @kglr's example:

g = Graph[
{
1 <-> 2, 1 <-> 3, 1<-> 4, 2 <-> 3, 2 <-> 4, 3 <-> 4, 4 <-> 5, 5 <-> 6,
6 <-> 7, 6 <-> 8, 6 <-> 9, 7 <-> 8, 7 <-> 9, 8 <-> 9
}
];

kcores[g, 1]
kcores[g, 5]
kcores[g, 6]


{0 -> {{1, 2, 3, 4, 5, 6, 7, 8, 9}}, 1 -> {{1, 2, 3, 4, 5, 6, 7, 8, 9}}, 2 -> {{1, 2, 3, 4, 5, 6, 7, 8, 9}}, 3 -> {{1, 2, 3, 4}}}

{0 -> {{1, 2, 3, 4, 5, 6, 7, 8, 9}}, 1 -> {{1, 2, 3, 4, 5, 6, 7, 8, 9}}, 2 -> {{1, 2, 3, 4, 5, 6, 7, 8, 9}}}

{0 -> {{1, 2, 3, 4, 5, 6, 7, 8, 9}}, 1 -> {{1, 2, 3, 4, 5, 6, 7, 8, 9}}, 2 -> {{1, 2, 3, 4, 5, 6, 7, 8, 9}}, 3 -> {{6, 7, 8, 9}}}

And a large example:

g = RandomGraph[{10000, 50000}];
kcores[g, 1]; //AbsoluteTiming


{0.042289, Null}

Your question asked for the values of the k-cores (note the plural) in which that vertex is in, which is why my function returned a list of all the k-cores that a vertex lives in. Since you accepted the answer returning a single component for a specific value of k, here is a variation of my answer to do so:

kcore[g_, k_, v_] := SelectFirst[KCoreComponents[g, k], Not @* FreeQ[v]]


Let's compare kcore with the accepted answer:

g = RandomGraph[{10000, 50000}];

r1 = kcore[g, 5, 50]; //AbsoluteTiming
r2 = kCoreParent[g, 5, 50]; //AbsoluteTiming

r1 === r2


{0.006013, Null}

{0.42559, Null}

True

You did say you were interested in a quick solution.

• Nice, thank you
– apg
Commented Feb 26, 2018 at 11:12
ClearAll[kCoreParent]
kCoreParent[g_, k_, v_] := v /. Dispatch[Flatten[{Thread[# -> #, List, 1] & /@
KCoreComponents[g, k], _ :> {}}]]


Example:

g = Graph[{1 <-> 2, 1 <-> 3, 1<-> 4, 2 <-> 3, 2 <-> 4, 3 <-> 4, 4 <-> 5, 5 <-> 6,
6 <-> 7, 6 <-> 8, 6 <-> 9, 7 <-> 8, 7 <-> 9, 8 <-> 9},
GraphStyle -> "SmallNetwork", ImageSize -> 500]


KCoreComponents[g, 3]


{{6, 7, 8, 9}, {1, 2, 3, 4}}

kCoreParent[g, 3, 8]


{6, 7, 8, 9}

Grid[Prepend[{#, kCoreParent[g, 3, #]} & /@ {1, 5, 7}, {"  v  ",
"kCoreParent[g, 3, v]"}], Dividers -> All,
Alignment -> {Center, Center}, ItemStyle -> Directive["Panel", 20]]