Problem set 6, problem 1.

Clear[amu,kMassInAMU,massOfPotassiumAtom,numberDensityOfPotassium,kF,massOfElectronInGrams,hbar,kb,ef, tf] ;

amu = WolframAlpha["1 amu in grams",{{"Result",1},"ComputableData"}]  ;

(* rho = WolframAlpha["density of potassium in grams/cm^3",{{"Result",1},"FormattedData"}] *)

Clear[ rho,kgPerM3ToGperCM3,gramsPerCm3 ]
(* => kg/m^3 : *) 
(*ChemicalData[ "Potassium" , "Density", "Units" ] *)
kgPerM3ToGperCM3 = 1/1000 ;
gramsPerCm3 = Quantity[ "Grams" ] /Quantity[ "Centimeter" ]^3 ;
rho = ChemicalData[ "Potassium" , "Density" ]  * kgPerM3ToGperCM3  gramsPerCm3  ;

(*ElementData[ "Properties" ]*)
kMassInAMU = ElementData[ "Potassium", "AtomicWeight" ] ;
(*ElementData[ "Potassium", "AtomicWeight", "Units" ]*)

massOfPotassiumAtom = kMassInAMU * amu  ;

numberDensityOfPotassium = rho / massOfPotassiumAtom ;

kF = (3 Pi^2 numberDensityOfPotassium)^(1/3)  ;

massOfElectronInGrams = WolframAlpha["mass of electron in grams",{{"Result",1},"ComputableData"}]  ;

hbar = (*Quantity[ "hbar" ] ;*)
WolframAlpha["hbar in erg seconds",{{"Result",1},"ComputableData"}]  ;

kb = WolframAlpha["Boltzmann constant in ergs per kelvin",{{"Result",1},"ComputableData"}] ;

ef= UnitConvert[ UnitSimplify[ hbar^2 kF^2/2 / massOfElectronInGrams  ], "Erg" ] ;

tf = ef / kb ;

Column[{
Row[{"1 amu = ", amu} ],
Row[{ "(Subscript[ρ, K]) = ", rho}],
Row[{"atomic mass of K = ", kMassInAMU }],
Row[{"(Subscript[m, e]) (mass of electron) = ", massOfElectronInGrams}],
Row[{Quantity[ "hbar" ], " = ", hbar }],
Row[{"(Subscript[k, B]) = ", kb}],

Row[{"(Subscript[m, K]), the mass of 1 Potassium atom = atomic mass of K * 1 amu = " , massOfPotassiumAtom}],
Row[ {"(Subscript[n, K]) = (Subscript[ρ, K])/ (Subscript[m, K]) (also number density of single presumed-free electron) = ", numberDensityOfPotassium}],
Row[{"(Subscript[k, F]) = (3 π^2 (Subscript[n, K]))^(1/3) = ", kF}],
Row[{"(Subscript[E, F]) = \!\(\*TemplateBox[{SuperscriptBox["\"\\!\\(\\*SubscriptBox[\\(k\\), \\(F\\)]\\)\"", "2"]},
"QuantityUnit",
DisplayFunction->(TooltipBox[
StyleBox[
RowBox[{#, "", 
StyleBox[
RowBox[{" ", 
RowBox[{
SuperscriptBox["\"ℏ\"", "2"]}]}], "QuantityUnitTraditionalLabel"]}], ShowStringCharacters -> False], "Unit: reduced Planck constants squared"]& ),
InterpretationFunction->(RowBox[{"Quantity", "[", 
RowBox[{#, ",", 
SuperscriptBox["\"ReducedPlanckConstant\"", "2"]}], "]"}]& )]\)/(2 (Subscript[m, e])) = ", ef}],
Row[{ "(Subscript[T, F]) = (Subscript[E, F])/(Subscript[k, B]) = ", tf}]
}]

part b.

Clear[ na , tfExperimental, ratio ]
na = WolframAlpha["avagadros number",{{"Result",1},"ComputableData"}] ;

tfExperimental = Pi^2 kb na / (2 * Quantity[ 2.08 10^(-3), "Joule/Kelvin^2"]) ;

ratio = tf / tfExperimental ;

Column[{
Row[{"(Subscript[N, A]) = ", na}],
Row[{"(Subscript[T, (Subscript[F, experimental])])= (((π^2) (Subscript[N, A]) (Subscript[k, B]))/(2 2.08`)) = ", tfExperimental}],
Row[{"(Subscript[T, F])/(Subscript[T, (Subscript[F, experimental])]) = ", ratio}]
} ]