TPC-H Benchmark
Implementing the TPC-H Benchmark in PicoLispIntroduction
This article explores the implementation of the TPC-H Benchmark™H within PicoLisp, illustrating how a minimalist Lisp dialect with integrated object database can model complex decision support workloads.The TPC Benchmark is a popular decision support benchmark. It consists of a suite of business oriented ad-hoc queries and concurrent data modifications.
The TPC-H specification and the benchmark's source code can be downloaded from https://software-lab.de/tpc-h.tgz.
Schema Modeling in PicoLisp
The PicoLisp implementation mirrors the official TPC-H schema by defining eight primary entity classes: +Region, +Nation, +Supplier, +Customer, +Part, +PartSupp, +Order, and +LineItem. Each entity class includes relational attributes typed to reflect database key constraints and data types:- +Key is a unique key,
- +Ref is a non-unique key,
- +List denotes lists of related entities,
- +Swap refers to data stored separately in database symbol values, loaded on demand.
Data Generation and Loading
TPC-H datasets are generated externally as .tbl files using standard TPC-H tools scaled by a specified factor (SF). PicoLisp imports these files sequentially through the dbgen function, which uses the creates function to manage a dual-process pipeline:- One process parses .tbl files, caching index tree roots to prevent premature garbage collection and improve performance.
- The other process reads parsed data and uses PicoLisp’s create function to instantiate database objects with accurate schema attributes.
This approach loads large interconnected datasets directly into PicoLisp’s native database, enabling efficient traversals and query preparations.
Import Performance
Importing SF10 data on an Intel Core Ultra 5 225 with with 32 GiB RAM takes 82 minutes, producing about 186 million database symbols. The process uses two cores concurrently with disk speed and memory impacting runtime.Query Implementation
All TPC-H queries are implemented as concise Lisp functions leveraging PicoLisp's powerful database traversal and iteration idioms:- The forall function iterates over matches generated by the high-level search function or, occasionally, the lower-level init function.
- enum and idx are used then to collect the found objects into sorted tree structures.
- Lisp’s functional programming features further filter, aggregate, and process these results.
This avoids explicit SQL joins by taking advantage of PicoLisp’s direct object references (+Link and +Joint), allowing queries to naturally traverse the schema graph with minimal boilerplate.
Benchmark Execution and Results
The go function runs all queries sequentially, measuring execution times per query and cumulatively. Sample output shows query durations and the total runtime (about 30 minutes at SF 10 on the stated hardware):tpc: (go) q1 [00:07] 452.562 sec q2 [00:01] 79.215 sec q3 [00:01] 63.572 sec q4 4.233 sec q5 21.458 sec q6 27.174 sec q7 [00:03] 197.125 sec q8 47.072 sec q9 [00:05] 312.301 sec q10 16.022 sec q11 4.104 sec q12 29.586 sec q13 [00:02] 165.042 sec q14 5.611 sec q15 24.571 sec q16 29.227 sec q17 2.285 sec q18 [00:02] 144.451 sec q19 51.849 sec q20 59.936 sec q21 [00:01] 71.537 sec q22 11.140 sec [00:30] 1831.728 sec
Performance Observations
The PicoLisp implementation emphasizes clarity, conciseness, and ease of expressing complex decision support queries rather than raw runtime speed.PicoLisp’s symbolic processing, functional idioms, and integrated object database provide a highly adaptable environment suited to prototype and experiment with TPC-H workloads.
Caching index tree roots during import enhances performance by maintaining access paths alive throughout loading, preventing premature garbage collection.
Query runtimes range broadly depending on complexity, demonstrating the system’s feasibility for decision support tasks with inherent transparency and minimal overhead for schema adaptations.
Conclusion
This work validates implementing the full TPC-H benchmark in PicoLisp as an effective demonstration of combining functional programming with native object databases for complex workloads.The concise Lisp framework facilitates rapid understanding and flexible modification of queries and schema.
Though not primarily aimed at maximizing raw performance, PicoLisp opens avenues for research, teaching, and prototyping beyond conventional database systems.
Here is the full source code of the TPC-H Benchmark:
# 17jan26 Software Lab. Alexander Burger
# https://www.tpc.org/tpch
# https://www.tpc.org/TPC_Documents_Current_Versions/pdf/TPC-H_v2.17.3.pdf
# Needs PicoLisp >= 25.7.27
(version (25 7 27))
(symbols T 'tpc 'pico)
(scl 6)
### E/R ###
# +----------+ +----------+
# | | | |
# | Region @---------* Nation |
# | | | |
# +----------+ +--O----O--+
# | |
# +-------+ +------+
# | |
# +--------+ +----*---+ +---*----+
# | | | | | |
# | Part | | Supp | | Cust |
# | | | | | |
# +-----@--+ +--O-----+ +-----O--+
# | | |
# +----+ +-----+ |
# | | |
# +-*--*-+ +--------+ +--*------+
# | | | | | |
# | PS O-------* Litm *-------@ Order |
# | | | | | |
# +------+ +--------+ +---------+
# Region
(class +Reg +Entity)
(rel nr (+Key +Number)) # RegionKey
(rel nm (+Key +String)) # Name
(rel nat (+List +Joint) reg (+Nat)) # Nations
(rel txt (+Swap +String)) # Comment
# Nation
(class +Nat +Entity)
(rel nr (+Key +Number)) # NationKey
(rel nm (+Key +String)) # Name
(rel reg (+Joint) nat (+Reg)) # Region
(rel txt (+Swap +String)) # Comment
# Supplier
(class +Supp +Entity)
(rel nr (+Key +Number)) # SuppKey
(rel nm (+String)) # Name
(rel adr (+Swap +String)) # Address
(rel nat (+Ref +Link) NIL (+Nat)) # Nation
(rel tel (+String)) # Phone
(rel bal (+Number) 2) # AcctBal
(rel txt (+Swap +String)) # Comment
# Customer
(class +Cust +Entity)
(rel nr (+Key +Number)) # CustKey
(rel nm (+String)) # Name
(rel adr (+Swap +String)) # Address
(rel nat (+Ref +Link) NIL (+Nat)) # Nation
(rel tel (+Fold +Ref +String)) # Phone
(rel bal (+Number) 2) # AcctBal
(rel mks (+Ref +String)) # Market segment
(rel txt (+Swap +String)) # Comment
# Part
(class +Part +Entity)
(rel nr (+Key +Number)) # PartKey
(rel nm (+List +Ref +String)) # Name
(rel mf (+String)) # Manufacturer
(rel br (+Ref +String)) # Brand
(rel typ (+List +String)) # Type
(rel siz (+Ref +Number)) # Size
(rel con (+Ref +String)) # Container
(rel pr (+Number) 2) # Retail price
(rel ps (+List +Joint) par (+PS)) # PartSupps
(rel txt (+Swap +String)) # Comment
# PartSupp
(class +PS +Entity)
(rel par (+Joint) ps (+Part)) # Part
(rel sup (+Aux +Ref +Link) # Supplier
(par)
NIL (+Supp) )
(rel avq (+Number)) # AvailQty
(rel sc (+Number) 2) # SupplyCost
(rel txt (+Swap +String)) # Comment
# Order
(class +Order +Entity)
(rel nr (+Key +Number)) # OrderKey
(rel cus (+Ref +Link) NIL (+Cust)) # Customer
(rel st (+String)) # Status
(rel tot (+Number) 2) # Total price
(rel dat (+Ref +Date)) # Order date
(rel op (+String)) # Order priority
(rel clk (+String)) # Clerk
(rel sp (+Number)) # Ship priority
(rel litm (+List +Joint) ord (+Litm)) # LineItems
(rel txt (+Swap +String)) # Comment
(dm lose> (Lst)
(mapc 'lose> (: litm))
(super Lst) )
# LineItem
(class +Litm +Entity)
(rel ord (+Joint) litm (+Order)) # Order
(rel ps (+Ref +Link) NIL (+PS)) # PartSupp
(rel qt (+Number)) # Quantity
(rel epr (+Number) 2) # Extended price
(rel dis (+Number) 2) # Discount
(rel tax (+Number) 2) # Tax
(rel rf (+String)) # Return flag
(rel ls (+String)) # Line status
(rel sd (+Ref +Date)) # Ship date
(rel cd (+Date)) # Commit date
(rel rd (+Ref +Date)) # Receipt date
(rel si (+Ref +String)) # Ship instruction
(rel sm (+String)) # Ship mode
(rel txt (+Swap +String)) # Comment
(dbs
(1 # 128
+Reg +Nat
+Supp +Cust +PS )
(2 +Part +Order +Litm) # 256
(3 # 512
(+Reg nr nm)
(+Nat nr nm)
(+Supp nr nat)
(+Cust nr nat)
(+Part nr siz) )
(4 # 1024
(+Cust tel mks)
(+Part nm br con)
(+PS sup)
(+Order nr cus dat)
(+Litm ps sd rd si) )
(1 # 128
(+Reg txt)
(+Nat txt)
(+Supp adr txt)
(+Cust adr txt)
(+Part txt)
(+PS txt)
(+Order txt)
(+Litm txt) ) )
(local) *SF
(de main ()
(pool "db/" *Dbs)
(setq *SF (format (opt))) )
# Gererate database
# https://clickhouse.com/docs/getting-started/example-datasets/tpch
#{
$ mkdir -p dat db res
$ git clone https://github.com/gregrahn/tpch-kit.git
$ (cd tpch-kit/dbgen; make && ./dbgen -s 10 && ./dbgen -s 10 -U 1 && mv *.tbl *.tbl.u? delete.? answers/* ../../dat/)
$ rm -rf .git* tpch-kit/
$ time pil misc/tpc-h.l -main 10 -dbgen -bye
$ tar cfz db.tgz db/
}#
(de creates (File . Args)
(let ((Trees Fun Typ Key Vars . Funs) Args)
(gc)
(pipe
(let Cache (mapcar root Trees)
(in File
(while (split (line) "|")
(pr (mapcar fun Funs (Fun @))) ) ) )
(create Typ Key Vars (rd)) ) ) )
(de dbgen ()
(when (lock)
(quit "Can't lock DB" @) )
(creates "dat/region.tbl" # 5
NIL prog
(+Reg) nr (nm txt)
format pack pack )
(creates "dat/nation.tbl" # 25
NIL prog
(+Nat) nr (nm reg txt)
format pack
((L) (fetch '(nr . +Reg) (format L)))
pack )
(creates "dat/supplier.tbl" # 1.0e5
((nr . +Nat)) prog
(+Supp) nr (nm adr nat tel bal txt)
format pack pack
((L) (fetch '(nr . +Nat) (format L)))
pack
((L) (format L *Scl))
pack )
(creates "dat/customer.tbl" # 1.5e6
((nr . +Nat)) prog
(+Cust) nr (nm adr nat tel bal mks txt)
format pack pack
((L) (fetch '(nr . +Nat) (format L)))
pack
((L) (format L *Scl))
pack pack )
(creates "dat/part.tbl" # 2.0e6
NIL prog
(+Part) nr (nm mf br typ siz con pr txt)
format
((L) (mapcar pack (split L " ")))
pack pack
((L) (mapcar pack (split L " ")))
format
pack
((L) (format L *Scl))
pack )
(creates "dat/partsupp.tbl" # 8.0e6
((nr . +Part) (nr . +Supp)) prog
(+PS) NIL (par sup avq sc txt)
((L) (fetch '(nr . +Part) (format L)))
((L) (fetch '(nr . +Supp) (format L)))
format
((L) (format L *Scl))
pack )
(creates "dat/orders.tbl" # 15e6
((nr . +Cust)) prog
(+Order) nr (cus st tot dat op clk sp txt)
format
((L) (fetch '(nr . +Cust) (format L)))
pack
((L) (format L *Scl))
((L) ($dat L "-"))
pack pack format pack )
(creates "dat/lineitem.tbl" # 60e6
((nr . +Supp) (nr . +Part) (sup . +PS))
((L)
(cons
(++ L)
(aux 'sup '+PS
(fetch '(nr . +Supp) (format (cadr L)))
(fetch '(nr . +Part) (format (car L))) )
(cdddr L) ) ) # Skip column 4
(+Litm) ord (ps qt epr dis tax rf ls sd cd rd si sm txt)
((L) (fetch '(nr . +Order) (format L))) # ord
prog # ps
format # qt
((L) (format L *Scl)) # epr
((L) (format L *Scl)) # dis
((L) (format L *Scl)) # tax
car # rf
car # ls
((L) ($dat L "-")) # sd
((L) ($dat L "-")) # cd
((L) ($dat L "-")) # rd
pack # si
pack # sm
pack ) ) # txt
# Run
#{
$ pil misc/tpc-h.l -main 10 +
}#
### Statistics ###
(de countEntities ()
(let (Fmt (-8 8) Sum 0)
(for X '(+Reg +Nat +Supp +Cust +Part +PS +Order +Litm)
(tab Fmt
X
(prog1 (get *DB X 0) (inc 'Sum @)) ) )
(tab Fmt NIL "--------")
(tab Fmt NIL Sum) ) )
### Utilities ###
(de accumulate (Var Key . @)
(if (assoc Key (val Var))
(map
'((L) (inc L (next)))
(cdr @) )
(push Var (cons Key (rest))) ) )
(de fmt2 (N)
(format (*/ N `(** 10 (- *Scl 2))) 2) )
(de prTable (Lst . Args)
(bind (car Args)
(for Line Lst
(when Line
(mapc set (car Args) Line)
(map
'(((Exe . Cdr))
(prin (eval Exe) (and Cdr "|")) )
(cdr Args) )
(prinl) ) ) ) )
(de 1month (Dat)
(cons
Dat
(let (D (date Dat) M (inc (cadr D))) # +1 month
(dec
(if (= M 13)
(date (inc (car D)) 1 1)
(date (car D) M 1) ) ) ) ) )
(de 3months (Dat)
(cons
Dat
(let (D (date Dat) M (+ 3 (cadr D))) # +3 months
(dec
(if (> M 12)
(date (inc (car D)) (- M 12) 1)
(date (car D) M 1) ) ) ) ) )
(de 1year (Dat)
(cons
Dat
(dec (date (inc (date Dat)) 1 1)) ) ) # December 31th
(de hasTxt (Txt Str1 Str2)
(and
(sub? Str1 Txt)
(sub? Str2 Txt (inc @@)) ) )
### Queries ###
(de q1 (Delta)
(let Res NIL
(forall
(search
(cons NIL (- (date 1998 12 1) Delta)) '((sd +Litm)) )
(accumulate 'Res (cons (: rf) (: ls))
1 # Cnt
(: qt)
(: epr)
(: dis)
(*/ (: epr) (- 1.0 (: dis)) 1.0)
(*/ (: epr) (- 1.0 (: dis)) (+ 1.0 (: tax)) `(sq 1.0)) ) )
(prTable (sort Res) (F Cnt Qt Epr Dis Disc Charge)
(car F)
(cdr F)
(format (* Qt 100) 2)
(fmt2 Epr)
(fmt2 Disc)
(fmt2 Charge)
(format (*/ Qt 100 Cnt) 2)
(fmt2 (*/ Epr Cnt))
(fmt2 (*/ Dis Cnt))
Cnt ) ) )
(de q2 (Size Type Region)
(let (Reg (db 'nm '+Reg Region) E NIL)
(forall
(search
Reg '((reg . nat) (nat +Supp) (sup +PS)) )
(let Var (enum 'E (: par nr))
(cond
((nand
(; Var 1 1 sc)
(>= (: sc) @) )
(set Var (list This)) )
((== (; Var 1 1 sc) (: sc))
(push Var This) ) ) ) )
(prTable
(head 100
(sort
(mapcan
'((L)
(extract
'((This) # +PS
(and
(== Size (: par siz))
(= Type (last (: par typ)))
(cons
(- (: sup bal))
(: sup nat nm)
(: sup nm)
(: par nr)
This ) ) )
(cdr L) ) )
(enum 'E) ) ) )
(Bal Nat Nm Nr This)
(fmt2 (- Bal))
Nm
Nat
Nr
(: par mf)
(: sup adr 0)
(: sup tel)
(: sup txt 0) ) ) )
(de q3 (Segm Dat)
(let L (need 10)
(forall (search Segm '((mks +Cust) (cus +Order)))
(let
(M (min L)
X
(cons
(sum
'((This)
(when (> (: sd) Dat (: ord dat))
(*/ (: epr) (- 1.0 (: dis)) 1.0) ) )
(: litm) )
(: dat)
This ) )
(when (> X M)
(del M 'L)
(push 'L X) ) ) )
(prTable (flip (sort L)) (Rev Dat This)
(: nr)
(fmt2 Rev)
(dat$ Dat "-")
(: sp) ) ) )
(de q4 (Dat)
(let A NIL
(forall (search (3months Dat) '((dat +Order)))
(and
(find
'((This) (> (: rd) (: cd)))
(: litm) )
(accu 'A (: op) 1) ) )
(prTable (sort A) (X Y) X Y) ) )
(de q5 (Region Dat)
(let (Reg (db 'nm '+Reg Region) A NIL)
(forall (search (1year Dat) '((dat +Order)))
(when (== Reg (: cus nat reg))
(let Nat (: cus nat)
(for This (: litm)
(when (== Nat (: ps sup nat))
(accu 'A Nat
(*/ (: epr) (- 1.0 (: dis)) 1.0) ) ) ) ) ) )
(prTable
(by '(((Nat . Rev)) (- Rev)) sort A)
(Nat Rev)
(; Nat nm)
(fmt2 Rev) ) ) )
(de q6 (Dat Dis Qt)
(let Rev 0
(forall (search (1year Dat) '((sd +Litm)))
(and
(>= (+ Dis 0.01) (: dis) (- Dis 0.01))
(> Qt (: qt))
(inc 'Rev (*/ (: epr) (: dis) 1.0)) ) )
(prinl (fmt2 Rev)) ) )
(de q7 (Nat1 Nat2)
(and
(setq Nat1 (db 'nm '+Nat Nat1))
(setq Nat2 (db 'nm '+Nat Nat2))
(let A NIL
(forall
(search
(cons (date 1995 1 1) (date 1996 12 31)) '((sd +Litm)) )
(let (Src (: ps sup nat) Dst (: ord cus nat))
(when
(or
(and (== Src Nat1) (== Dst Nat2))
(and (== Src Nat2) (== Dst Nat1)) )
(accu 'A (cons Src Dst (car (date (: sd))))
(*/ (: epr) (- 1.0 (: dis)) 1.0) ) ) ) )
(prTable
(sort
(mapcar
'(((X . Rev))
(list
(; X 1 nm) # Src
(; X 2 nm) # Dst
(cddr X) # Year
Rev ) )
A ) )
(Src Dst Y Rev)
Src
Dst
Y
(fmt2 Rev) ) ) ) )
(de q8 (Nation Region Type)
(let
(Nat (db 'nm '+Nat Nation)
Reg (db 'nm '+Reg Region)
Res NIL )
(forall
(search
(cons (date 1995 1 1) (date 1996 12 31)) '((dat +Order)) )
(when (== Reg (: cus nat reg))
(let Y (car (date (: dat)))
(for This (: litm)
(when (= Type (: ps par typ))
(let N (*/ (: epr) (- 1.0 (: dis)) 1.0)
(accumulate 'Res Y
N # Tot
(and (== Nat (: ps sup nat)) N) ) ) ) ) ) ) ) # Vol
(prTable (sort Res) (Y Tot Vol)
Y
(fmt2 (*/ Vol 1.0 Tot)) ) ) )
(de q9 (Color)
(let (A NIL X NIL)
(forall (search Color '((nm +Part) (par . ps) (ps +Litm)))
(accu 'A
(cons
(: ps sup nat nm)
(- (car (date (: ord dat)))) )
(-
(*/ (: epr) (- 1.0 (: dis)) 1.0)
(* (: ps sc) (: qt)) )
'X ) )
(prTable (sort A) (X Sum)
(car X)
(- (cdr X))
(fmt2 Sum) ) ) )
(de q10 (Dat)
(let E NIL
(forall (search (3months Dat) '((dat +Order) (ord . litm)))
(when (= "R" (: rf))
(inc
(enum 'E (id (: ord cus)))
(*/ (: epr) (- 1.0 (: dis)) 1.0) ) ) )
(prTable
(flip
(tail 20
(sort
(mapcar
'(((I . Rev)) (cons Rev (id I)))
(enum 'E) ) ) ) )
(Rev This)
(: nr)
(: nm)
(fmt2 Rev)
(fmt2 (: bal))
(: nat nm)
(: adr 0)
(: tel)
(: txt 0) ) ) )
(de q11 (Nation Div) # 1/100000 = 0.00001 (SF 10)
(let (Nat (db 'nm '+Nat Nation) E NIL)
(forall (search Nat '((nat +Supp) (sup +PS)))
(inc
(enum 'E (: par nr))
(* (: avq) (: sc)) ) )
(prTable
(flip
(by cdr sort
(extract
'(((Nr . Val) Min)
(and (> Val Min) (list Nr Val)) )
(setq E (enum 'E))
(*/ (sum cdr E) Div) ) ) )
(Nr Val) Nr (fmt2 Val) ) ) )
(de q12 (Modes Dat)
(let A (mapcar list Modes 0 0)
(forall (search (1year Dat) '((rd +Litm)))
(when
(and
(> (: rd) (: cd) (: sd))
(member (: sm) Modes) )
(inc
((if (member (: ord op) '("1-URGENT" "2-HIGH"))
cdr
cddr )
(assoc (: sm) A) ) ) ) )
(prTable A (Mode Hi Lo) Mode Hi Lo) ) )
(de q13 (Str1 Str2)
(let E NIL
(forall (init '(nr . +Cust))
(let Cnt 0
(forall (search This '((cus +Order)))
(unless (hasTxt (: txt 0) Str1 Str2)
(inc 'Cnt) ) )
(inc (enum 'E (inc Cnt))) ) ) # 0 -> 1
(prTable (flip (sort (enum 'E T))) (Dist Cnt)
(dec Cnt) # 1 -> 0
Dist ) ) )
(de q14 (Dat)
(let (Tot 0 Rev 0)
(forall (search (1month Dat) '((sd +Litm)))
(let N (*/ (: epr) (- 1.0 (: dis)) 1.0)
(inc 'Tot N)
(when (= "PROMO" (: ps par typ 1))
(inc 'Rev N) ) ) )
(prinl (fmt2 (*/ Rev 100.00 Tot))) ) )
(de q15 (Dat)
(let E NIL
(forall (search (3months Dat) '((sd +Litm)))
(inc
(enum 'E (id (: ps sup)))
(*/ (: epr) (- 1.0 (: dis)) 1.0) ) )
(prTable
(by '((This) (: nr)) sort
(let ((R . L) (max (group (enum 'E T))))
(mapcar '((I) (cons R (id I))) L) ) )
(Rev This)
(: nr)
(: nm)
(: adr 0)
(: tel)
(fmt2 Rev) ) ) )
(de q16 (Brand Type Sizes)
(let A NIL
(forall
(search
(cons (min Sizes) (max Sizes)) '((siz +Part)) )
(and
(memq (: siz) Sizes)
(<> Brand (: br))
(not (head Type (: typ)))
(for This (: ps)
(unless (hasTxt (: sup txt 0) "Customer" "Complaints")
(idx 'A
(cons
(cons
(: par br)
(: par typ)
(: par siz) )
(: sup) )
0 ) ) ) ) )
(prTable
(sort
(mapcar
'(((K . L)) (cons (- (length L)) K))
(group (idx 'A) T) ) )
(N Br Typ Siz)
Br
(glue " " Typ)
Siz
(- N) ) ) )
(de q17 (Brand Cont)
(let Sum 0
(forall
(search
Brand '((br +Part))
Cont '((con +Part)) )
(let (Avg 0 Cnt 0)
(forall (search This '((par . ps) (ps +Litm)))
(inc 'Avg (* 0.2 (: qt))) # 0.2 * Avg
(inc 'Cnt) )
(setq Avg (*/ Avg Cnt))
(forall (search This '((par . ps) (ps +Litm)))
(when (> Avg (* 1.0 (: qt)))
(inc 'Sum (: epr)) ) ) ) )
(prinl (fmt2 (*/ Sum 7))) ) )
(de q18 (Qt)
(let L (need 100)
(forall (search NIL '((nr +Order)))
(let Sum (sum get (: litm) 'qt)
(when (> Sum Qt)
(let
(M (min L)
X (cons (: tot) (: dat) Sum This) )
(when (> X M)
(del M 'L)
(push 'L X) ) ) ) ) )
(prTable (flip (sort L)) (Tot Dat Sum This)
(: cus nm)
(: cus nr)
(: nr)
(dat$ Dat "-")
(fmt2 Tot)
(format (* Sum 100) 2) ) ) )
(de q19 (Qt1 Qt2 Qt3 Br1 Br2 Br3)
(let Rev 0
(forall (search "DELIVER IN PERSON" '((si +Litm)))
(and
(member (: sm) '("AIR" "AIR REG"))
(or
(and
(>= (+ Qt1 10) (: qt) Qt1)
(= Br1 (: ps par br))
(>= 5 (: ps par siz) 1)
(member (: ps par con) '("SM CASE" "SM BOX" "SM PACK" "SM PKG")) )
(and
(>= (+ Qt2 10) (: qt) Qt2)
(= Br2 (: ps par br))
(>= 10 (: ps par siz) 1)
(member (: ps par con) '("MED BAG" "MED BOX" "MED PKG" "MED PACK")) )
(and
(>= (+ Qt3 10) (: qt) Qt3)
(= Br3 (: ps par br))
(>= 15 (: ps par siz) 1)
(member (: ps par con) '("LG CASE" "LG BOX" "LG PACK" "LG PKG")) ) )
(inc 'Rev
(*/ (: epr) (- 1.0 (: dis)) 1.0) ) ) )
(prinl (fmt2 Rev)) ) )
(de q20 (Color Dat Nation)
(let (Nat (db 'nm '+Nat Nation) E NIL)
(forall (search (1year Dat) '((sd +Litm)))
(and
(== Nat (: ps sup nat))
(= Color (: ps par nm 1))
(inc
(enum 'E (id (: ps sup)))
(: qt) ) ) )
(prTable
(sort
(make
(for X (enum 'E)
(with (id (car X))
(let Qt (*/ (cdr X) 2)
(when
(find
'((This)
(and
(= "forest" (: par nm 1))
(> (: avq) Qt) ) )
(collect 'sup '+PS This) )
(link (cons (: nm) This)) ) ) ) ) ) )
(Nm This) Nm (: adr 0) ) ) )
(de q21 (Nation)
(let (Nat (db 'nm '+Nat Nation) E NIL)
(forall
(search
Nat '((nat +Supp) (sup +PS) (ps +Litm)) )
(and
(> (: rd) (: cd))
(= "F" (: ord st))
(find n== (: ord litm) This)
(fully
'((This Up)
(or
(== This Up)
(>= (: cd) (: rd)) ) )
(: ord litm)
This )
(dec (enum 'E (id (: ps sup)))) ) )
(prTable
(sort
(mapcar
'(((N . I)) (cons N (; (id I) nm)))
(head 100 (sort (enum 'E T))) ) )
(Cnt Nm) Nm (- Cnt) ) ) )
(de q22 (Lst)
(let (Avg 0 Cnt O)
(for S Lst
(forall (search S '((tel +Cust)))
(when (gt0 (: bal))
(inc 'Avg (: bal))
(inc 'Cnt) ) ) )
(setq Avg (*/ Avg Cnt))
(for S (sort Lst)
(let (Sum 0 Cnt 0)
(forall (search S '((tel +Cust)))
(when
(and
(> (: bal) Avg)
(not (db 'cus '+Order This)) )
(inc 'Sum (: bal))
(inc 'Cnt) ) )
(prinl S "|" Cnt "|" (fmt2 Sum)) ) ) ) )
### Updates ###
(de u1 (File1 File2)
(in File1
(prune 0)
(dbSync)
(while (split (line) "|")
(new (db: +Order) '(+Order)
'nr (format (++ @))
'cus (fetch '(nr . +Cust) (format (++ @)))
'st (pack (++ @))
'tot (format (++ @) *Scl)
'dat ($dat (++ @) "-")
'op (pack (++ @))
'clk (pack (++ @))
'sp (format (++ @))
'txt (pack (car @)) )
(at (0 . 999)
(commit 'upd)
(prune 9)
(dbSync) ) ) )
(in File2
(while (split (line) "|")
(new (db: +Litm) '(+Litm)
'ord (fetch '(nr . +Order) (format (++ @)))
'ps
(let (Par (format (++ @)) Sup (format (++ @)))
(shift '@) # Skip column 4
(aux 'sup '+PS
(fetch '(nr . +Supp) Sup)
(fetch '(nr . +Part) Par) ) )
'qt (format (++ @))
'epr (format (++ @) *Scl)
'dis (format (++ @) *Scl)
'tax (format (++ @) *Scl)
'rf (car (++ @))
'ls (car (++ @))
'sd ($dat (++ @) "-")
'cd ($dat (++ @) "-")
'rd ($dat (++ @) "-")
'si (pack (++ @))
'sm (pack (++ @))
'txt (pack (car @)) )
(at (0 . 999)
(commit 'upd)
(prune 2)
(dbSync) ) )
(commit 'upd)
(prune) ) )
### Deletes ###
(de d1 (File)
(in File
(prune 0)
(dbSync)
(while (read)
(when (fetch '(nr . +Order) @)
(lose> @)
(at (0 . 999)
(commit 'upd)
(prune 2)
(dbSync) ) ) )
(commit 'upd)
(prune) ) )
### Run all benchmarks ###
(de go (Upd)
(bench
(if Upd
(for Exe
(quote
(u1 "dat/orders.tbl.u1" "dat/lineitem.tbl.u1")
(d1 "dat/delete.1") )
(gc 0)
(tty (printsp (car Exe)))
(bench (eval Exe)) )
(for Exe
(quote
(q1 90)
(q2 15 "BRASS" "EUROPE")
(q3 "BUILDING" (date 1995 3 15))
(q4 (date 1993 7 1))
(q5 "ASIA" (date 1994 1 1))
(q6 (date 1994 1 1) 0.06 24)
(q7 "FRANCE" "GERMANY")
(q8 "BRAZIL" "AMERICA" '("ECONOMY" "ANODIZED" "STEEL"))
(q9 "green")
(q10 (date 1993 10 1))
(q11 "GERMANY" (* *SF 10000))
(q12 '("MAIL" "SHIP") (date 1994 1 1))
(q13 "special" "requests")
(q14 (date 1994 9 1))
(q15 (date 1996 1 1))
(q16 "Brand#45" '("MEDIUM" "POLISHED") (49 14 23 45 19 3 36 9))
(q17 "Brand#23" "MED BOX")
(q18 300)
(q19 1 10 20 "Brand#12" "Brand#23" "Brand#34")
(q20 "forest" (date 1994 1 1) "CANADA")
(q21 "SAUDI ARABIA")
(q22 '("13" "31" "23" "29" "30" "18" "17")) )
(gc 0)
(tty (printsp (car Exe)))
(out (pack "res/" (car Exe) ".out")
(bench
(eval Exe) ) ) ) ) ) )
https://picolisp.com/wiki/?tpch
| 17jan26 | abu |