https://gambitscheme.org/wiki/index.php?title=Programming_language_shootout:_spectral_norm&feed=atom&action=history
Programming language shootout: spectral norm - Revision history
2024-03-29T13:32:02Z
Revision history for this page on the wiki
MediaWiki 1.35.3
https://gambitscheme.org/wiki/index.php?title=Programming_language_shootout:_spectral_norm&diff=84&oldid=prev
Bjlucier: Fix totally screwed up earlier entry
2008-02-26T15:21:52Z
<p>Fix totally screwed up earlier entry</p>
<a href="https://gambitscheme.org/wiki/index.php?title=Programming_language_shootout:_spectral_norm&diff=84&oldid=74">Show changes</a>
Bjlucier
https://gambitscheme.org/wiki/index.php?title=Programming_language_shootout:_spectral_norm&diff=74&oldid=prev
Bjlucier: correct link to alioth
2008-02-22T22:05:38Z
<p>correct link to alioth</p>
<table class="diff diff-contentalign-left diff-editfont-monospace" data-mw="interface">
<col class="diff-marker" />
<col class="diff-content" />
<col class="diff-marker" />
<col class="diff-content" />
<tr class="diff-title" lang="en">
<td colspan="2" style="background-color: #fff; color: #202122; text-align: center;">← Older revision</td>
<td colspan="2" style="background-color: #fff; color: #202122; text-align: center;">Revision as of 22:05, 22 February 2008</td>
</tr><tr><td colspan="2" class="diff-lineno" id="mw-diff-left-l1" >Line 1:</td>
<td colspan="2" class="diff-lineno">Line 1:</td></tr>
<tr><td class='diff-marker'>−</td><td style="color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #ffe49c; vertical-align: top; white-space: pre-wrap;"><div>This is a Gambit implementation of the [http://shootout.alioth.debian.org/<del class="diffchange diffchange-inline">gp4</del>/benchmark.php?test=spectralnorm&lang=all spectral-norm] benchmark of the [[Programming language shootout|Computer Language Benchmarks Game]].</div></td><td class='diff-marker'>+</td><td style="color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #a3d3ff; vertical-align: top; white-space: pre-wrap;"><div>This is a Gambit implementation of the [http://shootout.alioth.debian.org/<ins class="diffchange diffchange-inline">gp4sandbox</ins>/benchmark.php?test=spectralnorm&lang=all spectral-norm] benchmark of the [[Programming language shootout|Computer Language Benchmarks Game]].</div></td></tr>
<tr><td class='diff-marker'> </td><td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"></td><td class='diff-marker'> </td><td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"></td></tr>
<tr><td class='diff-marker'> </td><td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"><div>==The program==</div></td><td class='diff-marker'> </td><td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"><div>==The program==</div></td></tr>
</table>
Bjlucier
https://gambitscheme.org/wiki/index.php?title=Programming_language_shootout:_spectral_norm&diff=60&oldid=prev
Bjlucier: Spectral norm benchmark from alioth
2008-02-22T21:44:59Z
<p>Spectral norm benchmark from alioth</p>
<p><b>New page</b></p><div>This is a Gambit implementation of the [http://shootout.alioth.debian.org/gp4/benchmark.php?test=spectralnorm&lang=all spectral-norm] benchmark of the [[Programming language shootout|Computer Language Benchmarks Game]].<br />
<br />
==The program==<br />
<pre><br />
#!gsi-script<br />
<br />
;; The Computer Language Benchmarks Game<br />
;; http://shootout.alioth.debian.org/<br />
;;<br />
;; Derived by Bradley Lucier from the Ikarus variant<br />
;; derived by Michael D. Adams from the MzScheme variant<br />
<br />
<br />
(declare (standard-bindings)(extended-bindings)(block)(fixnum)(not safe))<br />
<br />
(define-macro (unless test . body)<br />
`(if (not ,test)<br />
(begin<br />
,@body)))<br />
<br />
(define translation (make-vector 128))<br />
<br />
(for-each<br />
(lambda (from-to)<br />
(let* ([char (lambda (sym) (string-ref (symbol->string sym) 0))]<br />
[from (char (car from-to))]<br />
[to (char-upcase (char (cadr from-to)))])<br />
(vector-set! translation (char->integer from) to)<br />
(vector-set! translation (char->integer (char-upcase from)) to)))<br />
'([a t]<br />
[c g]<br />
[g c]<br />
[t a]<br />
[u a]<br />
[m k]<br />
[r y]<br />
[w w]<br />
[s s]<br />
[y R]<br />
[k M]<br />
[v b]<br />
[h d]<br />
[d h]<br />
[b v]<br />
[n n]))<br />
<br />
(define (put-whole-string s) (write-substring s 0 (string-length s)))<br />
<br />
(define (output lines)<br />
(if (> (length lines) 2)<br />
(let* ([pos (- (string-length (cadr lines)) (string-length (car lines)))]<br />
[put-first-half<br />
(lambda (s i) (write-substring s 0 i))]<br />
[put-second-half<br />
(lambda (s i) (write-substring s i (string-length s)))])<br />
(put-whole-string (car lines))<br />
(put-first-half (cadr lines) pos)<br />
(newline)<br />
(let loop ([l (cdr lines)])<br />
(cond<br />
[(null? (cdr l))<br />
(put-second-half (car l) pos)<br />
(newline)]<br />
[else<br />
(put-second-half (car l) pos)<br />
(put-first-half (cadr l) pos)<br />
(newline)<br />
(loop (cdr l))])))))<br />
<br />
(define (main . args)<br />
(let loop ([accum '()])<br />
(let ([l (read-line)])<br />
(if (eof-object? l)<br />
(output accum)<br />
(cond<br />
[(and (not (zero? (string-length l)))<br />
(eqv? #\> (string-ref l 0)))<br />
(output accum)<br />
(put-whole-string l)<br />
(newline)<br />
(loop '())]<br />
[else<br />
(let* ([len (string-length l)]<br />
[dest (make-string len)])<br />
(let loop ([i 0][j (- len 1)])<br />
(unless (= i len)<br />
(string-set! dest j<br />
(vector-ref translation<br />
(char->integer (string-ref l i))))<br />
(loop (+ i 1) (- j 1))))<br />
(loop (cons dest accum)))]))))<br />
(force-output))<br />
<br />
</pre><br />
==Compiling==<br />
<pre><br />
gsc spectral-norm<br />
</pre><br />
==Running==<br />
<pre><br />
gsi spectral-norm<br />
</pre></div>
Bjlucier