fork download
copy 
  1. ; external sorting
  2.  
  3. (define (read-line . port)
  4.   (define (eat p c)
  5.     (if (and (not (eof-object? (peek-char p)))
  6.              (char=? (peek-char p) c))
  7.         (read-char p)))
  8.   (let ((p (if (null? port) (current-input-port) (car port))))
  9.     (let loop ((c (read-char p)) (line '()))
  10.       (cond ((eof-object? c) (if (null? line) c (list->string (reverse line))))
  11.             ((char=? #\newline c) (eat p #\return) (list->string (reverse line)))
  12.             ((char=? #\return c) (eat p #\newline) (list->string (reverse line)))
  13.             (else (loop (read-char p) (cons c line)))))))
  14.  
  15. (define (read-lines max-lines)
  16.   (let loop ((x (read-line)) (xs (list)) (k max-lines))
  17.     (if (or (zero? k) (eof-object? x))
  18.         (reverse xs)
  19.         (loop (read-line) (cons x xs) (- k 1)))))
  20.  
  21. (define (temp num)
  22.   (string-append
  23.     "./external-sort."
  24.     (number->string (get-process-id))
  25.     "."
  26.     (number->string num)))
  27.  
  28. (define max-lines 10000)
  29.  
  30. (define pq-empty '())
  31. (define pq-empty? null?)
  32.  
  33. (define (pq-first pq)
  34.   (if (null? pq)
  35.       (error 'pq-first "can't extract minimum from null queue")
  36.       (car pq)))
  37.  
  38. (define (pq-merge lt? p1 p2)
  39.   (cond ((null? p1) p2)
  40.         ((null? p2) p1)
  41.         ((lt? (car p2) (car p1))
  42.           (cons (car p2) (cons p1 (cdr p2))))
  43.         (else (cons (car p1) (cons p2 (cdr p1))))))
  44.  
  45. (define (pq-insert lt? x pq)
  46.   (pq-merge lt? (list x) pq))
  47.  
  48. (define (pq-merge-pairs lt? ps)
  49.   (cond ((null? ps) '())
  50.         ((null? (cdr ps)) (car ps))
  51.         (else (pq-merge lt? (pq-merge lt? (car ps) (cadr ps))
  52.                             (pq-merge-pairs lt? (cddr ps))))))
  53.  
  54. (define (pq-rest lt? pq)
  55.   (if (null? pq)
  56.       (error 'pq-rest "can't delete minimum from null queue")
  57.       (pq-merge-pairs lt? (cdr pq))))
  58.  
  59. (define (read-into-temps)
  60.   (let loop ((file-num 1))
  61.     (let ((lines (read-lines max-lines)))
  62.       (if (null? lines) (- file-num 1)
  63.         (let ((temp-file-name (temp file-num)))
  64.           (with-output-to-file temp-file-name
  65.             (lambda ()
  66.               (do ((lines (sort string<? lines) (cdr lines)))
  67.                   ((null? lines))
  68.                 (display (car lines)) (newline))))
  69.           (loop (+ file-num 1)))))))
  70.  
  71. (define (write-output num-files)
  72.   (define (lt? x y) (string<? (car x) (car y)))
  73.   (let loop ((num-files num-files) (pq pq-empty))
  74.     (if (positive? num-files)
  75.         (loop (- num-files 1)
  76.               (let ((p (open-input-file (temp num-files))))
  77.                 (pq-insert lt? (cons (read-line p) p) pq)))
  78.         (let loop ((pq pq))
  79.           (when (not (pq-empty? pq))
  80.             (let ((node (pq-first pq)))
  81.               (display (car node)) (newline)
  82.               (let ((next (read-line (cdr node))))
  83.                 (if (eof-object? next)
  84.                     (loop (pq-rest lt? pq))
  85.                     (loop (pq-insert
  86.                             lt?
  87.                             (cons next (cdr node))
  88.                             pq))))))))))
  89.  
  90. (define (x-sort in-file out-file)
  91.   (with-input-from-file in-file (lambda ()
  92.     (with-output-to-file out-file (lambda ()
  93.       (write-output (read-into-temps)))))))
  94.  
  95. ; (x-sort "bible.txt" "bbeil.txt")
Success #stdin #stdout 0s 7272KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 

	

		
	 
	
	
			

					
			
			
			
			
			
			
			
			

			
			
			
		

	
		
		

			

			                        







			
			

				

	
					
					 https://ideone.com/UiHBxT
					
					
					
					
					

												

												
						
						

					

					
					
					

						
language:

						
Scheme (chicken 4.13)

					

					

						
created:
								
						
8 years ago

					

					

						
visibility:

						

														 secret																					
							
							

								
							

						

					

										
										

					
					 Share or Embed source code
					
					
					
					

						
						
						
						
						
						
						
					

					
						
	
	
	
	
					
					
					
					
					 
					
					
					
					 
					
					
					
					
					
					

					

					

					
						
					

					


	
Discover > Sphere Engine API

	
The brand new service which powers Ideone!

	
	
Discover > IDE Widget

    
Widget for compiling and running the source code in a web browser!