Remove["Global`*"];
(* This clears out any old variables *)

v={x,y,z};
w={r,θ,ϕ};
(* This defines the two sets of variables *)
 
c1=Cos[θ]; s1=Sin[θ];
c2=Cos[ϕ];   s2=Sin[ϕ];
(* These are just useful abbrviuations *)

x=r s1 c2;  y=r s1 s2; z= r c1; 
(* This is the basic dfinition of coordinates *)


dvw=Table[D[v[[i]],w[[j]]], {i, 1, 3}, {j, 1, 3}];
(* Compute deerivatives of the v coordinates with respeect to the w coordinates *)

dwv=Simplify[Inverse[dvw]];
(* Find deerivatives of the v coordinates with respeect to the w coordinates. These expressions are in terms of w variables *)

fv=Table[0, {i, 1, 3}];
Do[fv[[i]]=fv[[i]]+D[f[r,θ,ϕ], w[[j]]] dwv[[j,i]], {i, 1, 3}, {j, 1, 3}];
(* This computes the first derivatives of a function f with respect to the v coordinates, using the chain rule *)

fv2=Table[0, {i, 1, 3}];
Do[fv2[[i]]=fv2[[i]]+D[fv[[i]], w[[j]]] dwv[[j,i]], {i, 1, 3}, {j, 1, 3}];
(* This computes the second derivatives of a function f with respect to the v coordinates, using the chain rule *)

lapf=0;
Do[lapf=lapf+fv2[[i]], {i, 1, 3}];
lapf=Simplify[lapf];
(* This computes the required Laplacian *)

lapf