giovedì 28 marzo 2013

Una prova per visualizzare codici di programmi

Allora esiste questa pagina: hilite.me@ http://hilite.me/ proviamo

newLISP

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
#!/usr/bin/newlisp

(define (no-op , done st res)
 (set 'done nil)
 (set 'exitproc nil)
 (while (and (nil? done) (nil? exitproc) (set 'st (read-line df)))
  (cond
   ((starts-with st "$start") (set 'exitproc true))
   ((starts-with st "$end") (set 'done true)) 
  ) ; cond
 ) ; while
 
 done
) ; no-op

(define (l-remove-white st , p)
 (set 'p (st 0))
 (while (or (= p " ") (= p "\t"))
  (pop st)
  (set 'p (st 0))
 )
 st
) ; l-remove-white

(define (remove-white st)
 (set 'st (l-remove-white st))
 (set 'st (reverse st))
 (set 'st (l-remove-white st))
 (set 'st (reverse st))
) ; remove-white

(define (wait-for st, cmd, ok)
 (set 'st (remove-white (slice st 3)))
 (if (= numc nil) (set 'numc 20))
 (set 'cmd (append {wmctrl -l|grep '} st {'}))
 (set 'ok (exec cmd))
 (while (and (= (length ok) 0) (> numc 0))
  (dec numc)
  (sleep 1000)
  (set 'ok (exec cmd))
 )
 (= numc 0)
) ; wait-for

(define (x-run st)
 (cond
  ((starts-with st "*") (begin     ;; *
    (set 'st (remove-white (slice st 1)))
    (! st)
   ) ; begin
  )
  ((starts-with st "!") (begin     ;; !
    (set 'cmd (join (list "xdg-open " (rest st))))
    (! cmd)
   ) ; begin
  )
  ((starts-with st "&w") (begin     ;; &w 
    (set 'st (remove-white (slice st 2)))
    (set 'cmd (join (list "xdg-open http://" st)))
    (! cmd)
    (wait-for "Mozilla Firefox")
   ) ; begin
  )    
  ((starts-with st "&f") (begin     ;; &f
    (set 'st (real-path (remove-white (slice st 2))))
    (set 'cmd (join (list "xdg-open file://" st)))
    (! cmd)
    (wait-for "Mozilla Firefox")
   ) ; begin
  )    
  ((or (starts-with st "http")     ;; http
    (ends-with st ".com")      ;; .com
    (ends-with st ".it"))      ;; .it
     (begin 
     (set 'cmd (join (list "xdg-open " st)))
     (! cmd)
     (wait-for "Mozilla Firefox")
    ) ; begin
  )
  (true (! st))         ;; default
 ) ;; cond 

) ; x-run

(define (run-if st , p spec dm num lst ye)
 (pop st) ;; tolgo @
 (set 'p (find ":" st))
 (if (number? p)
  (begin
   (set 'spec (slice st 0 p))
   (set 'st (slice st (inc p)))
   (set 'dm (pop spec)) 
   (set 'neg (= (spec 0) "-"))
   (if neg (pop spec))
   (case dm
    ("d" (set 'num (nth 8 (now))))
    ("m" (set 'num (nth 2 (now))))
    (true (set 'num 0))
   )
   (set 'lst (parse spec ","))
   (set 'ye (number? (find (string num) lst)))
   (if (true? neg) (set 'ye (not ye)))
   (if (true? ye) 
    (x-run (remove-white st))
   )
  )
 ) ;; if 
) ; run-if

;; =================== main ====================
(set 'fname ((2 (main-args) ) 0))
(if (not (file? fname)) (exit))
 
(set 'df (open fname "read"))
(set 'done nil)
(while (and (nil? done) (set 'r (read-line df)))
 (set 'r (remove-white r))
 (set 'p (find ";;" r)) ; zappo i commenti
 (if (number? p) (set 'r (slice r 0 p)))
 (cond
  ((= (length r) 0)  (set 't nil))     ;; riga vuota

  ;; $ 
  ((starts-with r "$end") (set 'done true))  ;; $end
  ((starts-with r "$nop") (set 'done (no-op))) ;; $nop
  ((starts-with r "$start") (set 't nil))   ;; $start
  ((starts-with r "$w") (set 'done (wait-for r))) ;; $w
  
  ;; @
  ((starts-with r "@") (run-if r))     ;; @

  ;; cmd
  (true (x-run r))        ;; x-run cmd
 ) ;; cond 
) ;; while

; (set 'cmd (join (list "xdg-open " (rest r))))
; (set 'res (exec cmd))

(close df)
(exit)

AWK 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
# greatest common divisor
function gcd(m, n,    t) {
 # Euclid's method
 while (n != 0) {
  t = m
  m = n
  n = t % n
 }
 return m
}
 
# least common multiple
function lcm(m, n,    r) {
 if (m == 0 || n == 0)
  return 0
 r = m * n / gcd(m, n)
 return r < 0 ? -r : r
}
 
# Read two integers from each line of input.
# Print their least common multiple.
{ print lcm($1, $2) }

C 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
#include <stdio.h>
 
int gcd(int m, int n)
{
        int tmp;
        while(m) { tmp = m; m = n % m; n = tmp; }       
        return n;
}
 
int lcm(int m, int n)
{
        return m / gcd(m, n) * n;
}
 
int main()
{
        printf("lcm(35, 21) = %d\n", lcm(21,35));
        return 0;
}

C++ 
1
2
3
4
5
6
7
8
9
#include <boost/math/common_factor.hpp>
#include <iostream>
 
int main( ) {
   std::cout << "The least common multiple of 12 and 18 is " << 
      boost::math::lcm( 12 , 18 ) << " ,\n"
      << "and the greatest common divisor " << boost::math::gcd( 12 , 18 ) << " !" << std::endl ;
   return 0 ;
}

Go 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
package main
 
import (
    "fmt"
    "os"
)
 
func main() {
    file, err := os.Open("test.txt")
    if err != nil {
        // handle the error here
        return
    }
    defer file.Close()
    // get the file size
    stat, err := file.Stat()
    if err != nil {
        return
    }
    // read the file
    bs := make([]byte, stat.Size())
    _, err = file.Read(bs)
    if err != nil {
        return
    }
    str := string(bs)
    fmt.Println(str)
}

Haskell 
1
2
3
4
lcm :: (Integral a) => a -> a -> a
lcm _ 0 =  0
lcm 0 _ =  0
lcm x y =  abs ((x `quot` (gcd x y)) * y)

J No questo manca!

Perl 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
sub gcd {
 my ($a, $b) = @_;
 while ($a) { ($a, $b) = ($b % $a, $a) }
 $b
}
 
sub lcm {
 my ($a, $b) = @_;
 ($a && $b) and $a / gcd($a, $b) * $b or 0
}
 
print lcm(1001, 221);

PHP 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
echo lcm(12, 18) == 36;
 
function lcm($m, $n) {
    if ($m == 0 || $n == 0) return 0;
    $r = ($m * $n) / gcd($m, $n);
    return abs($r);
}
 
function gcd($a, $b) {
    while ($b != 0) {
        $t = $b;
        $b = $a % $b;
        $a = $t;
    }
    return $a;
}

Shell (bash) 
1
2
3
4
5
6
7
8
9
#!/bin/sh
echo dati = $*
echo -n "   media ="
echo "(+/ % #)" $* | j7
echo -n variance =
echo "(- (+/ % #))" $* | j7
echo -n std dev =
echo "([: %:@(+/ % #) *:@(- (+/ % #)))" $* | j7
echo ""

Tcl/tk 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
proc lcm {p q} {
    set m [expr {$p * $q}]
    if {!$m} {return 0}
    while 1 {
 set p [expr {$p % $q}]
 if {!$p} {return [expr {$m / $q}]}
 set q [expr {$q % $p}]
 if {!$q} {return [expr {$m / $p}]}
    }
}

A me sembra OK. Negli esempi vecchi non ho trasformato il TAB in 4 spazi e non mi sembra il caso di rifarli.
Pubblicato da Juhan alle 16:40 9 commenti
Etichette: ,
Iscriviti a: Post (Atom)