SATySFi：「サイゼリヤで1000円あれば最大何kcal摂れるのか」を解くパッケージ

saizeriya-test.saty

@require: stdja
@require: saizeriya
%@import: saizeriya

%------------------------------------------------- メニューデータ
let the-menu = [
(|calorie=130;cost=299;name=`彩りガーデンサラダ`|);
(|calorie=115;cost=349;name=`小エビのサラダ`|);
(|calorie=134;cost=299;name=`やわらかチキンのサラダ`|);
(|calorie=92;cost=299;name=`わかめサラダ`|);
(|calorie=196;cost=299;name=`イタリアンサラダ`|);
(|calorie=229;cost=599;name=`シーフードサラダ`|);
(|calorie=433;cost=599;name=`半熟卵とポークのサラダ`|);
(|calorie=142;cost=149;name=`コーンクリームスープ`|);
(|calorie=105;cost=149;name=`冷たいパンプキンスープ（季節限定）`|);
(|calorie=222;cost=299;name=`たっぷり野菜のミネストローネ（季節限定）`|);
(|calorie=59;cost=100;name=`削りたてペコリーノチーズ`|);
(|calorie=188;cost=169;name=`ミニフィセル`|);
(|calorie=252;cost=189;name=`ガーリックトースト`|);
(|calorie=374;cost=299;name=`辛味チキン`|);
(|calorie=221;cost=299;name=`アスパラガスのオーブン焼き（季節限定）`|);
(|calorie=215;cost=299;name=`ポップコーンシュリンプ`|);
(|calorie=256;cost=399;name=`エスカルゴのオーブン焼き`|);
(|calorie=164;cost=399;name=`ムール貝のガーリック焼き`|);
(|calorie=570;cost=399;name=`野菜ソースのグリルソーセージ`|);
(|calorie=393;cost=399;name=`チョリソー`|);
(|calorie=213;cost=199;name=`柔らか青豆の温サラダ`|);
(|calorie=138;cost=199;name=`ほうれん草のソテー`|);
(|calorie=80;cost=199;name=`キャベツとアンチョビのソテー`|);
(|calorie=366;cost=199;name=`ポテトのグリル`|);
(|calorie=52;cost=199;name=`セロリのピクルス（季節限定）`|);
(|calorie=138;cost=199;name=`真イカのパプリカソース`|);
(|calorie=214;cost=119;name=`フォッカチオ`|);
(|calorie=214;cost=139;name=`プチフォッカ`|);
(|calorie=107;cost=79;name=`セットプチフォッカ`|);
(|calorie=203;cost=299;name=`フレッシュチーズとトマトのサラダ`|);
(|calorie=406;cost=598;name=`フレッシュチーズとトマトのサラダ（Wサイズ）`|);
(|calorie=162;cost=399;name=`プロシュート`|);
(|calorie=324;cost=798;name=`プロシュート（Wサイズ）`|);
(|calorie=95;cost=299;name=`熟成ミラノサラミ`|);
(|calorie=190;cost=598;name=`熟成ミラノサラミ（Wサイズ）`|);
(|calorie=568;cost=399;name=`マルゲリータピザ`|);
(|calorie=646;cost=399;name=`パンチェッタのピザ`|);
(|calorie=610;cost=399;name=`野菜ときのこのピザ`|);
(|calorie=593;cost=499;name=`やわらかイカのアンチョビのピザ`|);
(|calorie=575;cost=499;name=`バッファローモッツァレラのピザ`|);
(|calorie=606;cost=499;name=`ミラノサラミのピザ`|);
(|calorie=521;cost=399;name=`ほうれん草のグラタン（季節限定）`|);
(|calorie=537;cost=499;name=`シーフードグラタン`|);
(|calorie=591;cost=399;name=`アラビアータ`|);
(|calorie=582;cost=399;name=`ミートソースボロニア風`|);
(|calorie=672;cost=468;name=`半熟卵のミートソースボロニア風`|);
(|calorie=560;cost=299;name=`アーリオ・オーリオ`|);
(|calorie=686;cost=399;name=`キャベツのペペロンチーノ`|);
(|calorie=605;cost=399;name=`タラコソースシシリー風`|);
(|calorie=686;cost=499;name=`スープ入りトマト味ボンゴレ（季節限定）`|);
(|calorie=700;cost=399;name=`パルマ風スパゲッティ`|);
(|calorie=610;cost=499;name=`イカの墨入りスパゲッティ`|);
(|calorie=865;cost=499;name=`カルボナーラ`|);
(|calorie=711;cost=499;name=`アスパラガスとエビのクリームスパゲッティ（季節限定）`|);
(|calorie=1182;cost=770;name=`アラビアータ（Wサイズ）`|);
(|calorie=1164;cost=770;name=`ミートソースボロニア風（Wサイズ）`|);
(|calorie=1120;cost=574;name=`アーリオ・オーリオ（Wサイズ）`|);
(|calorie=1372;cost=770;name=`キャベツのペペロンチーノ（Wサイズ）`|);
(|calorie=1210;cost=770;name=`タラコソースシシリー風（Wサイズ）`|);
(|calorie=1400;cost=770;name=`パルマ風スパゲッティ（Wサイズ）`|);
(|calorie=1220;cost=976;name=`イカの墨入りスパゲッティ（Wサイズ）`|);
(|calorie=1730;cost=976;name=`カルボナーラ（Wサイズ）`|);
(|calorie=1422;cost=976;name=`アスパラガスとエビのクリームスパゲッティ（季節限定）（Wサイズ）`|);
(|calorie=90;cost=69;name=`トッピング半熟卵`|);
(|calorie=542;cost=299;name=`ミラノ風ドリア`|);
(|calorie=632;cost=368;name=`半熟卵のミラノ風ドリア`|);
(|calorie=649;cost=378;name=`セットプチフォッカ付きミラノ風ドリア`|);
(|calorie=590;cost=399;name=`いろどり野菜のミラノ風ドリア`|);
(|calorie=624;cost=499;name=`エビとイカのドリア`|);
(|calorie=602;cost=599;name=`シーフードパエリア`|);
(|calorie=302;cost=399;name=`エビと野菜のトマトクリームリゾット`|);
(|calorie=638;cost=499;name=`ハヤシ＆ターメリックライス`|);
(|calorie=728;cost=568;name=`半熟卵のハヤシ＆ターメリックライス`|);
(|calorie=823;cost=599;name=`ミックスグリル`|);
(|calorie=514;cost=399;name=`ハンバーグステーキ`|);
(|calorie=628;cost=499;name=`デミグラスソースのハンバーグ`|);
(|calorie=585;cost=499;name=`野菜ソースのハンバーグ（ディアボラ風）`|);
(|calorie=633;cost=499;name=`イタリアンハンバーグ`|);
(|calorie=709;cost=599;name=`焼肉とハンバーグの盛合せ`|);
(|calorie=541;cost=499;name=`若鶏のグリル（ディアボラ風）`|);
(|calorie=588;cost=499;name=`柔らかチキンのチーズ焼き`|);
(|calorie=663;cost=599;name=`パンチェッタと若鶏のグリル`|);
(|calorie=621;cost=999;name=`リブステーキ`|);
(|calorie=303;cost=169;name=`ライス`|);
(|calorie=454;cost=219;name=`ラージライス`|);
(|calorie=151;cost=119;name=`スモールライス`|);
(|calorie=114;cost=199;name=`カプチーノ（アイスケーキ）（季節限定）`|);
(|calorie=131;cost=199;name=`ティラミス（アイスケーキ）`|);
(|calorie=246;cost=169;name=`シナモンフォッカチオ`|);
(|calorie=330;cost=399;name=`プリンとカプチーノの盛合せ`|);
(|calorie=347;cost=399;name=`プリンとティラミスの盛合せ`|);
(|calorie=346;cost=319;name=`ミルクアイスのせシナモンフォッカチオ`|);
(|calorie=100;cost=199;name=`ミルクジェラート`|);
(|calorie=127;cost=199;name=`シチリア産レモンのソルベ`|);
(|calorie=216;cost=249;name=`イタリアンプリン`|);
(|calorie=166;cost=299;name=`チョコレートケーキ`|);
(|calorie=162;cost=299;name=`コーヒーゼリー`|);
(|calorie=164;cost=369;name=`トリフアイスクリーム`|);
]
%------------------------------------------------- 本文
in

document (|
  title = {\SATySFi;でサイゼリヤ問題};
  author = {某ZR（アレ）};
  show-title = true;
  show-toc = false;
|) '<                                          
  +section{問題}<
    +p{
      予算1000円以内で，サイゼリヤで最大カロリーを摂取するような
      注文の仕方を求めよ。
      ただしサイゼリヤの料理のメニューは以下の通りとする。
    }
    +saizeriya-listing-menu(the-menu);
  >
  +section{解答}<
    +p{
      以下の通り。
    }
    +saizeriya-tabular-solution(the-menu)(1000);
  >
>

saizeriya.satyh

% saizeriya.satyh: ZR modules for the Saizeriya problem
%
% Copyright (c) 2019 Takayuki YATO (aka. "ZR")
%   GitHub:   https:%github.com/zr-tex8r
%   Twitter:  @zr_tex8r
% Distributed under the MIT License.
@require: color
@require: gr
@require: itemize
@require: list
@require: option
@require: table

%=========================================================== format settings

type saize-item = (|
  name    : string;
  calorie : int;
  cost    : int;
|)

% +saizeriya-listing-menu の書式
let saizeriya-format-itemize item =
  let name = embed-string item#name in
  let calo = embed-string (arabic item#calorie) in
  let cost = embed-string (arabic item#cost) in
  {#name;：#calo;kcal，#cost;円}

% +saizeriya-tabular-solution の書式
let saizeriya-tabular-header t =
  [t#c{名称}; t#c{カロリー／kcal}; t#c{価格／円}]
let saizeriya-tabular-row t item =
  let name = embed-string item#name in
  let calo = embed-string (arabic item#calorie) in
  let cost = embed-string (arabic item#cost) in
  [t#l name; t#r calo; t#r cost]
let saizeriya-tabular-total t tcalorie tcost =
  let calo = embed-string (arabic tcalorie) in
  let cost = embed-string (arabic tcost) in
  [t#c{合計}; t#r calo; t#r cost]

%=========================================================== helpers

let iota n =
  let-rec iter | 0 rs = rs
               | k rs = iter (k - 1) ((k - 1) :: rs) in
  iter n []

let list-sort comp xs =
  let-rec insert | y [] = [y]
                 | y (x::xs) =
    if comp y x then y::x::xs else x :: (insert y xs) in
  let-rec iter | [] rs = rs
               | (x::xs) rs = iter xs (insert x rs) in
  iter xs []

%=========================================================== module 'ZArray'
module ZArray : sig

type 'a t
val from-list : 'a list -> 'a t
val size : 'a t -> int
val get : 'a t -> int -> 'a option
val set : 'a t -> int -> 'a -> 'a t
val to-list : 'a t -> 'a list

end = struct

type 'a tree = Node of ('a tree) * ('a tree)
             | Leaf of 'a
type 'a t = Array of int * int * (('a tree) option)

let get-rank n =
  let-rec iter p r =
    if n <= p then r else iter (p * 2) (r + 1) in
  iter 1 0

let get-thres r =
  let-rec iter r t =
    if r <= 0 then t else iter (r - 1) (t * 2) in
  iter (r - 1) 1

let-rec xscan | x [] = (x, [])
              | x (y::ys) = (y, ys)

let-rec from-list | [] = Array (0, 0, None)
                  | ((xh::_) as xs) =
  let siz = List.length xs in
  let-rec iter | 0 xs =
    let (y, ys) = xscan xh xs in (ys, Leaf y)
               | r xs =
    let (ys, tr1) = iter (r - 1) xs in
    let (zs, tr2) = iter (r - 1) ys in
    (zs, Node (tr1, tr2))
  in
  let rank = get-rank siz in
  let (_, tr) = iter rank xs in
  Array (siz, get-thres rank, Some tr)

let size (Array (siz, _, _)) = siz

let-rec get | (Array (_, _, None)) _ = None
            | (Array (siz, thr, Some tr)) idx =
  let-rec iter | _ _ (Leaf v) = v
               | idx thr (Node (tr1, tr2)) =
    if idx < thr then iter idx (thr / 2) tr1
    else iter (idx - thr) (thr / 2) tr2
  in
  if 0 <= idx && idx < siz then Some (iter idx thr tr)
  else None

let-rec set | (Array (_, _, None) as ary) _ _ = ary
            | (Array (siz, thr, Some tr) as ary) idx v =
  let-rec iter | _ _ (Leaf _) = Leaf v
               | idx thr (Node (tr1, tr2)) =
    if idx < thr then Node (iter idx (thr / 2) tr1, tr2)
    else Node (tr1, iter (idx - thr) (thr / 2) tr2)
  in
  if 0 <= idx && idx < siz then Array (siz, thr, Some (iter idx thr tr))
  else ary
  
let-rec drop | _ [] = []
             | 0 xs = xs
             | k (x::xs) = drop (k - 1) xs

let-rec to-list | (Array (_, _, None)) = []
                | (Array (siz, _, Some tr)) =
  let-rec iter | acc (Leaf v) = v :: acc
               | acc (Node (tr1, tr2)) = iter (iter acc tr1) tr2 in
  let lst = iter [] tr in
  List.reverse (drop (List.length lst - siz) lst)

end
%=========================================================== module 'Saizeriya'
module Saizeriya : sig

val solve : saize-item list -> int -> saize-item list

end = struct

let array-fill n v =
  List.map (fun _ -> v) (iota n) |> ZArray.from-list
let array-get ary k =
  Option.from (-1) (ZArray.get ary k)
let nil-item
  = (| name = ` `; calorie = 0; cost = 0 |)

let optimize items badget =
  let-rec iiter | _ [] mcalos liidxs = (mcalos, liidxs)
                | iidx (itm::itms) mcalos liidxs =
    let (calo, cost) = (itm#calorie, itm#cost) in
    let-rec kiter k mcalos liidxs =
      if k >= cost then 
        let nmcalo = array-get mcalos (k - cost) + calo in
        if nmcalo > array-get mcalos k then
          kiter (k - 1) (ZArray.set mcalos k nmcalo)
              (ZArray.set liidxs k iidx)
        else kiter (k - 1) mcalos liidxs
      else iiter (iidx + 1) itms mcalos liidxs
    in
    kiter badget mcalos liidxs
  in
  iiter 0 items (array-fill (badget + 1) 0)
      (array-fill (badget + 1) (-1))

let get-items mcalos liidxs items badget =
  let-rec iter k sitms =
    let liidx = array-get liidxs k in
    if liidx >= 0 then
      let itm = Option.from nil-item (List.nth liidx items) in
      iter (k - itm#cost) (itm :: sitms)
    else sitms
  in
  iter badget []

let-rec solve | [] _ = []
              | items badget =
  let (mcalos, liidxs) = optimize items badget in
  let comp-item itm1 itm2 = itm1#calorie > itm2#calorie in
  let sitems = get-items mcalos liidxs items badget in
  list-sort comp-item sitems

end
%=========================================================== commands

let-block +saizeriya-listing-menu items =
  let proc item = Item (saizeriya-format-itemize item, []) in
  '<+listing?:(true)(Item ({}, List.map proc items));>

let-block ctx +saizeriya-tabular-solution items badget =
  let sitems = Saizeriya.solve items badget in
  let sum-of f = List.fold-left (+) 0 (List.map f sitems) in
  let cell-gen t = List.concat [
    [ saizeriya-tabular-header t ];
    List.map (saizeriya-tabular-row t) sitems;
    [ saizeriya-tabular-total t
          (sum-of (fun item -> item#calorie))
          (sum-of (fun item -> item#cost)) ];
  ] in
  let graph-gen xs ys =
    let (thin, thick) = (0.4pt, 0.8pt) in
    let (y0 :: y1 :: _, y9 :: y8 :: _) = (ys, List.reverse ys) in
    let (x0 :: x1 :: x2 :: x3 :: _) = xs in
    let hline w y = stroke w Color.black (Gr.line (x0, y) (x3, y)) in
    [
      hline thick y0;
      hline thin y1;
      hline thin y8;
      hline thick y9;
    ] in
  let ittab = {\tabular(cell-gen)(graph-gen);} in
  line-break true true ctx
      ((read-inline ctx ittab) ++ inline-fil)

%=========================================================== done
% EOF

参照：「サイゼリヤで1000円あれば最大何kcal摂れるのか」をSATySFiで解いてみた