The BMR Calculator without all the prose

bmr-calc-code-only.red

Red [
	Title:   "BMR (Basal Metabolic Rate) Calculator"
	Author:  "Gregg Irwin"
	File: 	 %bmr-calc.red
	Needs:	 View
	Comment: {
		An experiment in reactivity and data modeling.

		TBD: Caloric calcs based on activity level.

		References:
			https://doc.red-lang.org/reactivity.html
			https://en.wikipedia.org/wiki/Harris%E2%80%93Benedict_equation
			https://en.wikipedia.org/wiki/Basal_metabolic_rate
	}
]

;-------------------------------------------------------------------------------
; Generic functions

inch-to-cm: func [val][val * 2.54]
cm-to-inch: func [val][val / 2.54]
lb-to-kg:   func [val][val / 2.20462]
kg-to-lb:   func [val][val * 2.20462]

linear-interpolate: func [
    src-min  [number!]
    src-max  [number!]
    dest-min [number!]
    dest-max [number!]
    value    [number!]
][
    add dest-min ((value - src-min) / (src-max - src-min) * (dest-max - dest-min))
]

;-------------------------------------------------------------------------------
; Data Ranges

data-ranges: [									; Units are strictly informational
	height [from 100 to 250 cm]
	weight [from  45 to 160 kg]
	age    [from   5 to 125 years]
]

map-range: func [
	"Map slider val to semantic range"
	range [word!] "data-ranges key [height weight age]"
	val   [percent!]
	/local rng
][
	; With the extra level in the ranges data, the one-liner is a bit much.
	;  to integer! linear-interpolate 0% 100% data-ranges/:range/from data-ranges/:range/to val
	; Making it 2 lines seems worth it in this case.
	rng: data-ranges/:range
	; If we did this in multiple places, it would make sense to break
	; out the interpolation of 0-100% into a function. Not worth it now.
	to integer! linear-interpolate 0% 100% rng/from rng/to val
]

;-------------------------------------------------------------------------------
; Data Functions

to-height: function [
	"Convert a slider value to height data"
	val [percent!]
][
	cm: map-range 'height val
	inches: to integer! cm-to-inch cm
	reduce [
		'cm cm
		'in inches
		'ft-in reduce ['ft to integer! inches / 12  'in mod inches 12]
		'formed-imperial imp: rejoin [to integer! inches / 12 {'} mod inches 12 {"}]
		'formed-metric   met: rejoin [cm 'cm]
		'formed rejoin [imp " / " met]
	]
]

to-weight: function [
	"Convert a slider value to weight data"
	val [percent!]
][
	kg: map-range 'weight val
	lb: to integer! kg-to-lb kg
	reduce [
		'kg kg
		'lb lb
		'formed-imperial imp: rejoin [lb 'lb]
		'formed-metric   met: rejoin [kg 'kg]
		'formed rejoin [imp " / " met]
	]
]

to-age: function [
	"Convert a slider value to age data"
	val [percent!]
][
	yr: map-range 'age val
	;mo: round 12 * mod yr 1
	reduce [
		'yr yr
		;'yr-mo reduce ['yr round yr 'mo mo]
		'formed rejoin [yr " years"]
	]
]

;-------------------------------------------------------------------------------
; BMR Formulae

bmr-calc-1918: func [
	"The original Harris–Benedict equations published in 1918 and 1919"
	height [block!]
	weight [block!]
	age    [block!]
][
	;Women	BMR = 655.1 + ( 9.563 × weight in kg ) + ( 1.850 × height in cm ) – ( 4.676 × age in years )
	;Men	BMR =  66.5 + ( 13.75 × weight in kg ) + ( 5.003 × height in cm ) – ( 6.755 × age in years )
	reduce [
		'female to integer! (655.1 + (9.563 * weight/kg) + (1.850 * height/cm) - (4.676 * age/yr)) 'kcal/day
		'male   to integer! ( 66.5 + (13.75 * weight/kg) + (5.003 * height/cm) - (6.755 * age/yr)) 'kcal/day
	]
]

bmr-calc-1984: func [
	"The Harris–Benedict equations revised by Roza and Shizgal in 1984"
	height [block!]
	weight [block!]
	age    [block!]
][
	;Women	BMR = 447.593 + (9.247 × weight in kg) + (3.098 × height in cm) - (4.330 × age in years)
	;Men	BMR = 88.362 + (13.397 × weight in kg) + (4.799 × height in cm) - (5.677 × age in years)
	reduce [
		'female to integer! (447.593 + ( 9.247 * weight/kg) + (3.098 * height/cm) - (4.330 * age/yr)) 'kcal/day
		'male   to integer! ( 88.362 + (13.397 * weight/kg) + (4.799 * height/cm) - (5.677 * age/yr)) 'kcal/day
	]
]

bmr-calc-1990: func [
	"The Harris–Benedict equations revised by Mifflin and St Jeor in 1990"
	height [block!]
	weight [block!]
	age    [block!]
	/local base-bmr
][
	;Women	BMR = (10 × weight in kg) + (6,25 × height in cm) - (5 × age in years) - 161
	;Men	BMR = (10 × weight in kg) + (6,25 × height in cm) - (5 × age in years) + 5
	; The formula layout made it easy to see that there's a common
	; sub-expression in each.
	base-bmr: to integer! (10 * weight/kg) + (6.25 * height/cm) - (5 * age/yr)
	reduce [
		'female (base-bmr - 161) 'kcal/day
		'male   (base-bmr + 5)   'kcal/day
	]
]

;-------------------------------------------------------------------------------
; Data Structures

data: make reactor! [
	; Prime the fields from the middle of our value ranges. Empirical
	; choices for the defaults. They are magic numbers, duped in the 
	; UI code. For a larger app I would probably set up a defaults
	; structure for both to reference.
	height: to-height 50%
	weight: to-weight 30%
	age:    to-age    38%
	; Calculated results
	relate bmr-1918: [bmr-calc-1918 height weight age]
	relate bmr-1984: [bmr-calc-1984 height weight age]
	relate bmr-1990: [bmr-calc-1990 height weight age]
]


;-------------------------------------------------------------------------------
; UI

view [
	style label: text 50
	style out-lbl: text 75 right
	
	label "Height" sld-ht: slider 50%  out-lbl react [
		data/height: to-height sld-ht/data
		face/text: data/height/formed
	] return
	label "Weight" sld-wt: slider 30%  out-lbl react [
		data/weight: to-weight sld-wt/data
		face/text: data/weight/formed
	] return
	label "Age" sld-age: slider 38%  out-lbl react [
		data/age: to-age sld-age/data
		face/text: data/age/formed
	] return
	pad 0x15

; Make the output look something like this:
;				1918	1984	1990
;	Female								kcal/day
;	Male								kcal/day
	style cell: text 50 center
	style hdr:  cell bold

	label bold "Formula" hdr "1918" hdr "1984" hdr "1990" return
	label "Female"
		cell react [data/bmr-1918  face/text: form data/bmr-1918/female]
		cell react [data/bmr-1984  face/text: form data/bmr-1984/female]
		cell react [data/bmr-1990  face/text: form data/bmr-1990/female]
		label "kcal/day"
		return
	label "Male"
		cell react [data/bmr-1918  face/text: form data/bmr-1918/male]
		cell react [data/bmr-1984  face/text: form data/bmr-1984/male]
		cell react [data/bmr-1990  face/text: form data/bmr-1990/male]
		label "kcal/day"
		return

]