TESSERA Interactive Map
Explore geospatial embeddings from the GeoTessera foundation model directly in the browser. This notebook walks through a complete land-cover classification workflow:
- Draw a bounding box to select your region of interest
- Fetch and visualise GeoTessera embeddings with PCA
- Click on the map to place labelled training points
- Run k-nearest-neighbours classification
- View the classification overlay
#require "tessera-geotessera-jsoo";;
#require "tessera-viz-jsoo";;
#require "js_top_worker-widget-leaflet";;
Widget_leaflet.register ();;Select region of interest
Draw a rectangle on the map to select the area you want to classify. The map is centred on Cambridge, UK — navigate to any area of interest before drawing.
(* Shared state *)
let bbox : Geotessera.bbox option ref = ref None
let mosaic : (Linalg.mat * int * int) option ref = ref None
let projected : Linalg.mat option ref = ref None
let training_points : (float * float * int) list ref = ref []
let current_class = ref 0
let class_names = ref [| "water"; "land" |]
let class_colors = [| "#2196F3"; "#4CAF50"; "#FF9800"; "#9C27B0"; "#F44336";
"#00BCD4"; "#795548"; "#607D8B" |]
(* Downsample a mosaic to at most max_pixels, preserving aspect ratio *)
let downsample_mosaic mat ~h ~w ~max_pixels =
let n_pixels = h * w in
if n_pixels <= max_pixels then (mat, h, w)
else
let stride = int_of_float (ceil (sqrt (float_of_int n_pixels /. float_of_int max_pixels))) in
let h' = (h + stride - 1) / stride in
let w' = (w + stride - 1) / stride in
let out = Linalg.create_mat ~rows:(h' * w') ~cols:mat.Linalg.cols in
for i = 0 to h' - 1 do
for j = 0 to w' - 1 do
let si = min (i * stride) (h - 1) in
let sj = min (j * stride) (w - 1) in
let src = si * w + sj in
let dst = i * w' + j in
for f = 0 to mat.Linalg.cols - 1 do
Linalg.mat_set out dst f (Linalg.mat_get mat src f)
done
done
done;
(out, h', w')
let map_id = "tessera-map"
let status_view text =
let open Widget.View in
Element { tag = "div"; attrs = [Style ("padding", "8px"); Style ("font-family", "monospace")];
children = [Text text] }
let () = Widget.display ~id:"status" ~handlers:[] (status_view "Draw a rectangle on the map.")
let () =
Widget.display_managed ~id:map_id
~kind:"leaflet-map"
~config:{| {"center": [52.2, 0.12], "zoom": 13, "height": "500px"} |}
~handlers:[
"bbox_drawn", (fun v ->
match v with
| Some json ->
(* Parse bbox JSON: {"south":..,"west":..,"north":..,"east":..} *)
let s = Scanf.sscanf json
{| {"south":%f,"west":%f,"north":%f,"east":%f}|}
(fun s w n e -> Geotessera.{ min_lat = s; min_lon = w; max_lat = n; max_lon = e })
in
bbox := Some s;
Widget.update ~id:"status"
(status_view (Printf.sprintf "Selected: %.4f,%.4f to %.4f,%.4f — run next cell to fetch embeddings."
s.min_lat s.min_lon s.max_lat s.max_lon))
| None -> ());
"click", (fun v ->
match v with
| Some json ->
let lat, lng = Scanf.sscanf json {| {"lat":%f,"lng":%f}|} (fun a b -> (a, b)) in
(match !mosaic with
| None -> () (* ignore clicks before embeddings loaded *)
| Some _ ->
let cls = !current_class in
training_points := (lat, lng, cls) :: !training_points;
let color = class_colors.(cls mod Array.length class_colors) in
let label = (!class_names).(cls) in
Widget.command ~id:map_id "addMarker"
(Printf.sprintf {|{"lat":%f,"lng":%f,"color":"%s","label":"%s"}|}
lat lng color label);
Widget.update ~id:"status"
(status_view (Printf.sprintf "Added %s point at %.4f, %.4f (%d points total)"
label lat lng (List.length !training_points))))
| None -> ());
]
let () = Widget.command ~id:map_id "enableBboxDraw" ""Fetch embeddings and visualise
After drawing your bounding box, run this cell to fetch GeoTessera embeddings and display a PCA false-colour visualisation.
let () =
match !bbox with
| None -> Widget.update ~id:"status" (status_view "Error: draw a bounding box first!")
| Some b ->
Widget.update ~id:"status" (status_view "Fetching embeddings...");
let mat_full, h_full, w_full = Geotessera_jsoo.fetch_mosaic ~year:2024 b in
Widget.update ~id:"status"
(status_view (Printf.sprintf "Fetched %d×%d mosaic. Downsampling..." h_full w_full));
let mat, h, w = downsample_mosaic mat_full ~h:h_full ~w:w_full ~max_pixels:50_000 in
mosaic := Some (mat, h, w);
(* Compute actual mosaic bounds from tile grid (not user bbox) *)
let snap = Geotessera.snap_to_grid in
let mosaic_south = snap b.min_lat -. 0.05 in
let mosaic_north = snap b.max_lat +. 0.05 in
let mosaic_west = snap b.min_lon -. 0.05 in
let mosaic_east = snap b.max_lon +. 0.05 in
Widget.update ~id:"status"
(status_view (Printf.sprintf "Working at %d×%d (%d pixels). Computing PCA..." h w (h * w)));
(* PCA to 3 components for RGB visualisation *)
let pca = Linalg.pca_fit ~max_samples:5000 mat ~n_components:3 in
let proj = Linalg.pca_transform pca mat in
projected := Some proj;
let pca_img = Viz.pca_to_rgba ~width:w ~height:h proj in
let url = Viz_jsoo.to_data_url pca_img in
Widget.command ~id:map_id "addImageOverlay"
(Printf.sprintf {|{"url":"%s","bounds":[[%f,%f],[%f,%f]],"opacity":0.7}|}
url mosaic_south mosaic_west mosaic_north mosaic_east);
Widget.update ~id:"status"
(status_view "PCA overlay added. Click on the map to place training points, then run the classification cell.")Label training points
Click on the map to add training points. Use the buttons below to switch between classes before clicking.
let make_class_buttons () =
let open Widget.View in
let buttons = Array.to_list (Array.mapi (fun i name ->
let color = class_colors.(i mod Array.length class_colors) in
let border = if i = !current_class then "3px solid black" else "1px solid #ccc" in
Element { tag = "button";
attrs = [
Handler ("click", "class_" ^ string_of_int i);
Style ("margin", "4px");
Style ("padding", "8px 16px");
Style ("background", color);
Style ("color", "white");
Style ("border", border);
Style ("border-radius", "4px");
Style ("cursor", "pointer");
];
children = [Text name] }
) !class_names) in
Element { tag = "div";
attrs = [Style ("padding", "8px")];
children =
Element { tag = "b"; attrs = []; children = [Text "Active class: "] }
:: buttons
@ [Element { tag = "button";
attrs = [
Handler ("click", "add_class");
Style ("margin", "4px");
Style ("padding", "8px 16px");
Style ("border", "1px dashed #999");
Style ("border-radius", "4px");
Style ("cursor", "pointer");
];
children = [Text "+ Add class"] };
Element { tag = "button";
attrs = [
Handler ("click", "clear_points");
Style ("margin", "4px");
Style ("padding", "8px 16px");
Style ("border", "1px solid #ccc");
Style ("border-radius", "4px");
Style ("cursor", "pointer");
];
children = [Text "Clear all"] }]
}
let class_handler_list () =
let base = Array.to_list (Array.mapi (fun i _name ->
"class_" ^ string_of_int i, (fun (_v : string option) ->
current_class := i;
Widget.update ~id:"class-buttons" (make_class_buttons ()))
) !class_names) in
base @ [
"add_class", (fun _v ->
let n = Array.length !class_names in
let name = "class_" ^ string_of_int n in
class_names := Array.append !class_names [| name |];
current_class := n;
Widget.update ~id:"class-buttons" (make_class_buttons ()));
"clear_points", (fun _v ->
training_points := [];
Widget.command ~id:map_id "clearMarkers" "";
Widget.update ~id:"status" (status_view "Cleared all training points."));
]
let () =
Widget.display ~id:"class-buttons"
~handlers:(class_handler_list ())
(make_class_buttons ())Classify and display
Run this cell after placing training points to classify the entire region using k-nearest neighbours.
let () =
match !mosaic, !projected, !bbox with
| Some (mat, h, w), Some _proj, Some b ->
let points = !training_points in
if points = [] then
Widget.update ~id:"status" (status_view "Error: place some training points first!")
else begin
Widget.update ~id:"status"
(status_view (Printf.sprintf "Classifying with %d training points..." (List.length points)));
(* Compute actual mosaic bounds from tile grid *)
let snap = Geotessera.snap_to_grid in
let mosaic_south = snap b.min_lat -. 0.05 in
let mosaic_north = snap b.max_lat +. 0.05 in
let mosaic_west = snap b.min_lon -. 0.05 in
let mosaic_east = snap b.max_lon +. 0.05 in
(* Convert geo coords to pixel coords and extract embeddings *)
let n_train = List.length points in
let train_mat = Linalg.create_mat ~rows:n_train ~cols:mat.Linalg.cols in
let train_labels = Array.make n_train 0 in
List.iteri (fun i (lat, lng, cls) ->
(* Map lat/lng to pixel row/col using mosaic bounds *)
let row = int_of_float ((mosaic_north -. lat) /. (mosaic_north -. mosaic_south) *. float_of_int h) in
let col = int_of_float ((lng -. mosaic_west) /. (mosaic_east -. mosaic_west) *. float_of_int w) in
let row = max 0 (min (h - 1) row) in
let col = max 0 (min (w - 1) col) in
(* Copy embedding row *)
let src_offset = (row * w + col) * mat.Linalg.cols in
let dst_offset = i * mat.Linalg.cols in
for j = 0 to mat.Linalg.cols - 1 do
Bigarray.Array1.set train_mat.Linalg.data (dst_offset + j)
(Bigarray.Array1.get mat.Linalg.data (src_offset + j))
done;
train_labels.(i) <- cls
) points;
(* kNN classification *)
let model = Linalg.knn_fit ~embeddings:train_mat ~labels:train_labels in
let k = min 5 n_train in
let result = Linalg.knn_predict model ~k mat in
(* Build color map *)
let n_classes = Array.fold_left max 0 train_labels + 1 in
let colors = List.init n_classes (fun i ->
let hex = class_colors.(i mod Array.length class_colors) in
(i, Viz.color_of_hex hex)
) in
let class_img = Viz.classification_to_rgba
~predictions:result.Linalg.predictions
~colors ~width:w ~height:h () in
let class_url = Viz_jsoo.to_data_url class_img in
Widget.command ~id:map_id "addImageOverlay"
(Printf.sprintf {|{"url":"%s","bounds":[[%f,%f],[%f,%f]],"opacity":0.7}|}
class_url mosaic_south mosaic_west mosaic_north mosaic_east);
Widget.update ~id:"status"
(status_view (Printf.sprintf "Classification complete! %d classes, %d training points."
n_classes n_train))
end
| _ ->
Widget.update ~id:"status" (status_view "Error: fetch embeddings first!")