Return Styles: Pseud0ch, Terminal, Valhalla, NES, Geocities, Blue Moon. Entire thread

post you are run length encoding in lisp

Name: Anonymous 2014-10-05 3:18

critique mine pl0x:

(defun rle (str) ;run length encoding
(let ((i 0) c count out)
(while (< i (length str))
(if (eq c (elt str i))
(setq count (1+ count))
(when c
(setq out (append out (list (cons c count)))))
(setq c (elt str i))
(setq count 1))
(setq i (1+ i)))
(when c (setq out (append out (list (cons c count)))))
out))

Name: Anonymous 2014-10-05 7:27

Yeah. I remember implementing it to read old graphic formats. Although LZ is a lot better
https://github.com/saniv/gfx/blob/master/pcx.lisp

(defun pcx-rle-line (o s e)
(while (< (cdr s) e)
(let ((v (% s))
(c 1))
(while (and (< (cdr s) e) (= (% 0 s) v) (< c 63))
(% s)
(incf c))
(unless (and (= c 1) (/= (logand #xC0 v) #xC0))
(ser o (Count 1 (logior #xC0 c))))
(ser o (Value 1 v)))))

(defun pcx-derle-line (o s e)
(while (< (cdr o) e)
(let ((c (% s)))
(if (/= (logand c #xC0) #xC0)
(% o c)
(let ((c (logxor c #xC0))
(v (% s)))
(while (plusp c)
(% o v)
(decf c)))))))

Name: Anonymous 2014-10-05 8:59

rle :: (Eq a, Num b) => [a] -> [(b,a)]
rle [] = []
rle (x:xs) = encode' 1 x xs where
encode' n x [] = [(n,x)]
encode' n x (y:ys)
| x == y = encode' (n+1) x ys
| otherwise = (n,x) : encode' 1 y ys

Name: Anonymous 2014-10-05 14:31

>>2
i don't understand your code.

Name: Anonymous 2014-10-05 14:48

>>2
how would you improve my code? for one, it is inefficient because it continually checks the boundary case where there is no previous (character . count).

Name: Anonymous 2014-10-05 14:59

>>4
Nobody understands me. Can't even find a girlfriend.

>>5
how would you improve my code?
You can use arrays and declare types. But that would be a waste of time, unless you write production code, which would be used a lot.

Name: Anonymous 2014-10-05 15:05

>>6
how would you deal with the inefficiency of checking if there is no previous (char . count) to output? doing the test always seems slow.

Name: Anonymous 2014-10-05 15:24

>>7

Your code is horribly inefficient due to lists use and append. Double checking the condition is the least contributor.

Name: Anonymous 2014-10-05 15:26

>>8
oh yes i know that, but that is easier to fix. im more interested in the shape of the algorithm.

Name: Anonymous 2014-10-05 15:30

>>8
oh yes i know that, but that is easier to fix. im more interested in the shape of the algorithm.

Name: Anonymous 2014-10-05 15:35

>>9
you can catch bound check error or ensure that it wont happen, by keeping last two elements different

Name: Anonymous 2014-10-05 15:36

% rle.pro
rle([], []).
rle([H|T], [[X, H]|R]) :- rle(T, [[Y, H]|R]), Y > 0, X is Y + 1.
rle([H|T], [[1, H]|R]) :- rle(T, R).

rld([], []).
rld([H|T], [[X,H]|R]) :- X > 1, Y is X - 1, rld(T, [[Y,H]| R]).
rld([H|T], [[1,H]|R]) :- rld(T, R).

| ?- [rle].
compiling rle.pro for byte code...
yes

| ?- L = [a, a, a, b, c, c], rle(L, E), rld(L, E).
E = [[3,a], [1, b], [2, c]]
L = [a, a, a, b, c, c] ?
yes

Name: >>12 2014-10-05 15:38

Feature request for judeo-admin-sama: put a border around multi-line code blocks, so that you can tell the difference between two adjacent listings.

Name: Anonymous 2014-10-05 16:05

Symta version (based on Prolog one)
rle Xs =
| Ys = []
| while 1: case Xs [Z N%&Z @Zs] | [[N.size+1 Z] @!Ys]; Xs <= Zs
[Z @Zs] | [Z @!Ys]; Xs <= Zs
[] | leave Ys.flip

Name: Anonymous 2014-10-05 16:07

>>14
It does work, if you don't believe me.
http://postimg.org/image/r9uqc04ot/

Name: >>12 2014-10-05 16:09

>>12

I know pretty much no lisp, but here's the first step of translating it:

(defun reverse-rle (l e)
(cond
((eq l '()) e)
((eq (car l) (cdar e))
(rle (cdr l) (cons (cons (+ 1 (caar e)) (cdar e)) (cdr e))))
(t (rle (cdr l) (cons (cons 1 (car l)) e)))
)
)

Name: Anonymous 2014-10-05 16:10

>>15
lol still using emacs, that buggy slow ugly piece of shit?

Name: >>12 2014-10-05 16:11

>>16

Oops, I only changed the first occurrence of rle to reverse-rle.

Name: Anonymous 2014-10-05 16:23

>>17

I've no time writing my own text editor. And it would require Qt bindings.

Name: Anonymous 2014-10-05 16:34

>>15
Shalom!

Name: >>12 2014-10-05 16:49

>>16

(defun rle (l)
(cond ((eq l '()) '())
(t (let (e (rle (cdr l)))
(cond
((eq e '()) (cons (cons 1 (car l)) e))
((eq (car l) (cdar e)) (cons (cons (+ 1 (caar e)) (cdar e)) (cdr e)))
(t (cons (cons 1 (car l)) e)))))))

halp

It seems let doesn't do what I expect.

Name: Anonymous 2014-10-05 17:27

>>21
rle
(rle nil)
nil
(rle '(1))
((1 . 1))
(rle '(1 1))
((1 . 1))
(rle '(1 1 1))
((1 . 1))

nigger, what r u doin?

Name: >>12 2014-10-05 18:26

>>21

(defun rle (l)
(cond ((eq l '()) '())
- (t (let (e (rle (cdr l)))
+ (t (let ((e (rle (cdr l))))
(cond
((eq e '()) (cons (cons 1 (car l)) e))
((eq (car l) (cdar e)) (cons (cons (+ 1 (caar e)) (cdar e)) (cdr e)))
(t (cons (cons 1 (car l)) e)))))))

Fuck, I'm an idiot.

I just deepened the varlist of let, and it worked perfectly!

(rle '(a a a b c c))
((3 . a) (1 . b) (2 . c))

Name: >>12 2014-10-05 18:55

>>23

How should I format my lisp?

(defun rle (l)
(cond ((eq l nil) nil)
(t (let ((e (rle (cdr l))))
(cond
((eq e nil)
(cons (cons 1 (car l)) e))
((eq (car l) (cdar e))
(cons
(cons (+ 1 (caar e)) (cdar e))
(cdr e)))
(t
(cons (cons 1 (car l)) e)))))))

(defun rld (l)
(cond
((eq l nil) nil)
(t (cond
((> (caar l) 1)
(cons
(cdar l)
(rld (cons
(cons (- (caar l) 1)(cdar l))
(cdr l)))))
(t
(cons (cdar l) (rld (cdr l))))))))

Output:
(let ((l '(a a a b c c)))
(print (rle l))
(print (rld (rle l)))
nil
)

((3 . a) (1 . b) (2 . c))
(a a a b c c)
nil

Name: Anonymous 2014-10-05 19:14

>>24
do u guyz think my code is good enugh 4 production quality code?

Name: Anonymous 2014-10-05 19:16

have u read COMMON LISP: THE LANGUAGE by GAY L. STEELE?

Name: >>12 2014-10-05 19:31

>>25

Are you asking about mine ( >>24 ) or yours ( >> 1 )?

lisp
in production

>>1

If you really want to work iteratively, you should maintain a tail pointer so that append doesn't have to walk the whole list.

Name: etaoin !S/UJugsOl. 2014-10-05 20:38

why is lisp so fukken ugly?

Name: Anonymous 2014-10-05 20:45

>>28
Why is your anus so fukken ugly?

Name: etaoin !S/UJugsOl. 2014-10-05 20:46

(I forgot to re-add my name after clicking preview. Admin, please fix!)

>>28
Why is your anus so fukkin ugly?

Name: etaoin !S/UJugsOl. 2014-10-05 20:47

>>30
how did u steal my secret word u nigger

Name: etaoin !S/UJugsOl. 2014-10-05 20:50

Check my 25!

>>31
I shr don't know.

Name: etaoin !S/UJugsOl. 2014-10-05 20:51

>>32
do u have a tripcode cracker

Name: Anonymous 2014-10-05 20:54

(defun doubles? (d)
(if (= 0 (% (% d 100) 11)) t nil))

(doubles? 33)
t

Name: Anonymous 2014-10-05 20:57

>>33
do u have a tripcode, cracka?
No I don't, nigga!

>>34
I missed the doubles and did if(true){true}else{false}.

How embarrassing.

Name: shrdlu !dWVSk2pCPs 2014-10-05 20:59

>>35
dumbass nigger

Name: Anonymous 2014-10-05 21:15

bitstr = []
for(iter = 1:length(inp))
bitstr = [bitstr, bitget(inp(iter), 8:-1:1)];
endfor;
bitflip = bitstr(1:end-1) != bitstr(2:end);
bitind = [1:length(bitflip)]
bif = bitind(bitflip == 1)
bout = bif(1:end-1) .- bif(2:end)

Name: Anonymous 2014-10-06 4:19

>>12
sweet.

Name: etaoin !S/UJugsOl. 2014-10-06 5:39

i have improved my elisp version:

(defun rle (seq)
(let ((i 0) (count 0) char out)
(if (= (length seq) 0)
'()
(setq char (elt seq 0))
(while (< i (length seq))
(if (eq char (elt seq i))
(setq count (1+ count))
(push (cons char count) out)
(setq char (elt seq i)
count 1))
(setq i (1+ i)))
(nreverse (push (cons char count) out)))))
rle
(rle nil)
nil
(rle '(a))
((a . 1))
(rle '(a a))
((a . 2))
(rle '(a b))
((a . 1) (b . 1))
(rle '(a a b))
((a . 2) (b . 1))
(rle '(a a b b b c c c c d))
((a . 2) (b . 3) (c . 4) (d . 1))
(mapcar (lambda (cons) (cons (string (car cons))
(cdr cons)))
(rle "nigger"))
(("n" . 1) ("i" . 1) ("g" . 2) ("e" . 1) ("r" . 1))

Name: etaoin !S/UJugsOl. 2014-10-06 5:42

forgot code tag
(defun rle (str) ;run length encoding
(let ((i 0) c count out)
(while (< i (length str))
(if (eq c (elt str i))
(setq count (1+ count))
(when c
(setq out (append out (list (cons c count)))))
(setq c (elt str i))
(setq count 1))
(setq i (1+ i)))
(when c (setq out (append out (list (cons c count)))))
out))
Newer Posts
Don't change these.
Name: Email:
Entire Thread Thread List
All trademarks and copyrights on this site are owned by their respective parties. All comments and posts are the responsibility of their own posters.
- Tinychan + 2ch Mode + RSS -