Grundlagen der funktionsorientierten Programmierung mit SCHEME/Der Morsecode

Wiki-Quelltext dieser Seite.

<language>SchemeJS</language>
<code id="60ce1e9a0647d" hidden>
(define string-car
  (lambda (zk)
    (string-ref zk 0)))

(define string-cdr
  (lambda (zk)
    (substring zk 1 (string-length zk))))

(define  string-prefix?
  (lambda (zk tzk)
    (cond
      [(< (string-length zk) (string-length tzk)) #f]
      [(equal? (substring zk 0 (string-length tzk)) tzk) #t]
      [else
       #f])))
</code>

'''Autor: Kevin Andreas Schulze (2021)'''

Beliebige Texte werden als Morsecode ausgegeben.<br />
Weiterhin kann eine Zeichenkette, die einem syntaktisch korrekten Morsecode entspricht, zurück übersetzt werden.

== Übersetzer: Text --> Morsecode ==

<code id="60ce1e9a064ef">
(define kodierer
  (lambda (zk)
    (cond
      [(= (string-length zk) 0) ""]
      [(equal? (string-car (string-upcase zk)) #\A) (string-append "*-" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\B) (string-append "-***" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\C) (string-append "-*-*" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\D) (string-append "-**" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\E) (string-append "*" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\F) (string-append "**-*" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\G) (string-append "--*" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\H) (string-append "****" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\I) (string-append "**" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\J) (string-append "*---" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\K) (string-append "-*-" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\L) (string-append "*-**" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\M) (string-append "--" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\N) (string-append "-*" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\O) (string-append "---" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\P) (string-append "*--*" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\Q) (string-append "--*-" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\R) (string-append "*-*" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\S) (string-append "***" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\T) (string-append "-" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\U) (string-append "**-" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\V) (string-append "***-" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\W) (string-append "*--" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\X) (string-append "-**-" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\Y) (string-append "-*--" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\Z) (string-append "--**" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\Ä) (string-append "*-*-" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\Ö) (string-append "---*" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\Ü) (string-append "**--" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\ß) (string-append "***--**" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\1) (string-append "*----" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\2) (string-append "**---" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\3) (string-append "***--" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\4) (string-append "****-" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\5) (string-append "*****" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\6) (string-append "-****" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\7) (string-append "--***" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\8) (string-append "---**" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\9) (string-append "----*" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\0) (string-append "-----" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\?) (string-append "**--**" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\!) (string-append "-*-*--" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\.) (string-append "*-*-*-" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\:) (string-append "---***" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\,) (string-append "--**--" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\;) (string-append "-*-*-*" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\') (string-append "*----*" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\+) (string-append "*-*-*" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\-) (string-append "-****-" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\*) (string-append "-**-" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\/) (string-append "-**-*" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\=) (string-append "-***-" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\() (string-append "-*--*" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\)) (string-append "-*--*-" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\@) (string-append "*--*-*" " " (kodierer (string-cdr zk)))]
      [(equal? (string-car (string-upcase zk)) #\space) (string-append "  " (kodierer (string-cdr zk)))]
      [else (string-append "<Fehler>" (kodierer (string-cdr zk)))]
      )
    ))
</code>

== Übersetzer: Morsecode --> Text ==

<code id="60ce1e9a06553">
(define dekodierer
  (lambda (zk)
    (cond
      [(= (string-length zk) 0) ""]
      [(string-prefix? zk "*- ") (string-append "A" (dekodierer (substring zk 3 (string-length zk))))]
      [(string-prefix? zk "-*** ") (string-append "B" (dekodierer (substring zk 5 (string-length zk))))]
      [(string-prefix? zk "-*-* ") (string-append "C" (dekodierer (substring zk 5 (string-length zk))))]
      [(string-prefix? zk "-** ") (string-append "D" (dekodierer (substring zk 4 (string-length zk))))]
      [(string-prefix? zk "* ") (string-append "E" (dekodierer (substring zk 2 (string-length zk))))]
      [(string-prefix? zk "**-* ") (string-append "F" (dekodierer (substring zk 5 (string-length zk))))]
      [(string-prefix? zk "--* ") (string-append "G" (dekodierer (substring zk 4 (string-length zk))))]
      [(string-prefix? zk "**** ") (string-append "H" (dekodierer (substring zk 5 (string-length zk))))]
      [(string-prefix? zk "** ") (string-append "I" (dekodierer (substring zk 3 (string-length zk))))]
      [(string-prefix? zk "*--- ") (string-append "J" (dekodierer (substring zk 5 (string-length zk))))]
      [(string-prefix? zk "-*- ") (string-append "K" (dekodierer (substring zk 4 (string-length zk))))]
      [(string-prefix? zk "*-** ") (string-append "L" (dekodierer (substring zk 5 (string-length zk))))]
      [(string-prefix? zk "-- ") (string-append "M" (dekodierer (substring zk 3 (string-length zk))))]
      [(string-prefix? zk "-* ") (string-append "N" (dekodierer (substring zk 3 (string-length zk))))]
      [(string-prefix? zk "--- ") (string-append "O" (dekodierer (substring zk 4 (string-length zk))))]
      [(string-prefix? zk "*--* ") (string-append "P" (dekodierer (substring zk 5 (string-length zk))))]
      [(string-prefix? zk "--*- ") (string-append "Q" (dekodierer (substring zk 5 (string-length zk))))]
      [(string-prefix? zk "*-* ") (string-append "R" (dekodierer (substring zk 4 (string-length zk))))]
      [(string-prefix? zk "*** ") (string-append "S" (dekodierer (substring zk 4 (string-length zk))))]
      [(string-prefix? zk "- ") (string-append "T" (dekodierer (substring zk 2 (string-length zk))))]
      [(string-prefix? zk "**- ") (string-append "U" (dekodierer (substring zk 4 (string-length zk))))]
      [(string-prefix? zk "***- ") (string-append "V" (dekodierer (substring zk 5 (string-length zk))))]
      [(string-prefix? zk "*-- ") (string-append "W" (dekodierer (substring zk 4 (string-length zk))))]
      [(string-prefix? zk "-**- ") (string-append "X" (dekodierer (substring zk 5 (string-length zk))))]
      [(string-prefix? zk "-*-- ") (string-append "Y" (dekodierer (substring zk 5 (string-length zk))))]
      [(string-prefix? zk "--** ") (string-append "Z" (dekodierer (substring zk 5 (string-length zk))))]
      [(string-prefix? zk "*-*- ") (string-append "Ä" (dekodierer (substring zk 5 (string-length zk))))]
      [(string-prefix? zk "---* ") (string-append "Ö" (dekodierer (substring zk 5 (string-length zk))))]
      [(string-prefix? zk "**-- ") (string-append "Ü" (dekodierer (substring zk 5 (string-length zk))))]
      [(string-prefix? zk "***--** ") (string-append "ß" (dekodierer (substring zk 8 (string-length zk))))]
      [(string-prefix? zk "*---- ") (string-append "1" (dekodierer (substring zk 6 (string-length zk))))]
      [(string-prefix? zk "**--- ") (string-append "2" (dekodierer (substring zk 6 (string-length zk))))]
      [(string-prefix? zk "***-- ") (string-append "3" (dekodierer (substring zk 6 (string-length zk))))]
      [(string-prefix? zk "****- ") (string-append "4" (dekodierer (substring zk 6 (string-length zk))))]
      [(string-prefix? zk "***** ") (string-append "5" (dekodierer (substring zk 6 (string-length zk))))]
      [(string-prefix? zk "-**** ") (string-append "6" (dekodierer (substring zk 6 (string-length zk))))]
      [(string-prefix? zk "--*** ") (string-append "7" (dekodierer (substring zk 6 (string-length zk))))]
      [(string-prefix? zk "---** ") (string-append "8" (dekodierer (substring zk 6 (string-length zk))))]
      [(string-prefix? zk "----* ") (string-append "9" (dekodierer (substring zk 6 (string-length zk))))]
      [(string-prefix? zk "----- ") (string-append "0" (dekodierer (substring zk 6 (string-length zk))))]
      [(string-prefix? zk "**--** ") (string-append "?" (dekodierer (substring zk 7 (string-length zk))))]
      [(string-prefix? zk "-*-*-- ") (string-append "!" (dekodierer (substring zk 7 (string-length zk))))]
      [(string-prefix? zk "*-*-*- ") (string-append "." (dekodierer (substring zk 7 (string-length zk))))]
      [(string-prefix? zk "---*** ") (string-append ":" (dekodierer (substring zk 7 (string-length zk))))]
      [(string-prefix? zk "--**-- ") (string-append "," (dekodierer (substring zk 7 (string-length zk))))]
      [(string-prefix? zk "-*-*-* ") (string-append ";" (dekodierer (substring zk 7 (string-length zk))))]
      [(string-prefix? zk "*----* ") (string-append "'" (dekodierer (substring zk 7 (string-length zk))))]
      [(string-prefix? zk "*-*-* ") (string-append "+" (dekodierer (substring zk 6 (string-length zk))))]
      [(string-prefix? zk "-****- ") (string-append "-" (dekodierer (substring zk 7 (string-length zk))))]
      [(string-prefix? zk "-**- ") (string-append "*" (dekodierer (substring zk 5 (string-length zk))))]
      [(string-prefix? zk "-**-* ") (string-append "/" (dekodierer (substring zk 6 (string-length zk))))]
      [(string-prefix? zk "-***- ") (string-append "=" (dekodierer (substring zk 6 (string-length zk))))]
      [(string-prefix? zk "-*--* ") (string-append "(" (dekodierer (substring zk 6 (string-length zk))))]
      [(string-prefix? zk "-*--*- ") (string-append ")" (dekodierer (substring zk 7 (string-length zk))))]
      [(string-prefix? zk "*--*-* ") (string-append "@" (dekodierer (substring zk 7 (string-length zk))))]
      [(string-prefix? zk "  ") (string-append " " (dekodierer (substring zk 2 (string-length zk))))]
      [else (string-append "<Fehler>" (kodierer (string-cdr zk)))]
      )
    ))
</code>

== Testbeispiele ==

<code id="60ce25641d5e7">
(define morsen
  (lambda (a zk)
    (cond
      [(equal? a #\k) (kodierer zk)]
      [(equal? a #\d) (dekodierer zk)]
      [else "<Fehler>"])
    ))
</code>

'''Hinweise:'''

<pre>
Kodieren: #\k oder kodierer
Dekodieren: #\d oder dekodierer
Im Morsecode muss als letztes Zeichen ein Leerzeichen angegeben werden.
</pre>

<run id="60ce1e9a066c1">
(define zk "Franz jagt im komplett verwahrlosten Taxi quer durch Bayern!")
(morsen #\k zk)
</run>

<run id="60ce25641d6ce">
(morsen #\d (morsen #\k zk))
</run>

Zurück zum [[Grundlagen der funktionsorientierten Programmierung mit SCHEME/Der Algorithmusbegriff|Algorithmusbegriff]].