Arturs Blog – Dies und das zum Thema Programmieren

28. April 202328. April 2023

Überprüfen, ob eine Liste aufsteigend sortiert ist

Ich lese gerade das Buch „Programming in Haskell“ und habe verschiedene Wege ausprobiert, um zu überprüfen, ob eine Liste aufsteigend sortiert ist.

Die einfachste und eleganteste Art, das zu überprüfen, ist es, die Liste zu sortieren und diese mit der ursprünglichen Liste zu vergleichen. Sind beide gleich, dann muss die ursprüngliche Liste logischerweise schon sortiert gewesen sein.

import Data.List (sort)
mysorted :: Ord a => [a] -> Bool
mysorted xs = xs == sort xs

import Data.List (sort)

mysorted :: Ord a => [a] -> Bool

mysorted xs = xs == sort xs

Eine andere Methode habe ich aus dem o.g. Buch entnommen. Sie benutzt List Comprehensions und erzeugt eine Liste von Tupeln mit jeweils dem ersten und dem folgenden Element und vergleicht diese miteinander.

Wenn z.B. die Liste [1, 2, 3, 4] mit zip bearbeitet wird, dann entsteht folgende Liste von Tupeln: [(1, 2), (2, 3), (3,4)]. Dann werden einfach die Tupelelemente verglichen und die Ergebnisse der Vergleiche and-verknüpt.

mysorted2 :: Ord a => [a] -> Bool
mysorted2 xs = and [f <= s | (f, s) <- zip xs (tail xs)]

1 2	mysorted2 :: Ord a => [a] -> Bool mysorted2 xs = and [f <= s \| (f, s) <- zip xs (tail xs)]

Diese Lösung finde ich sehr interessant und einfallsreich.

Ich habe mich gefragt, ob man das auch anders machen kann, so ähnlich wie man es in anderen Programmiersprachen machen würde. Das ist dabei herausgekommen.

mysorted3 :: Ord a => [a] -> Bool
mysorted3 (x : xs)
  | null xs = True
  | otherwise = (x <= head xs) && mysorted3 xs

mysorted3 :: Ord a => [a] -> Bool

mysorted3 (x : xs)

| null xs = True

| otherwise = (x <= head xs) && mysorted3 xs

Hier benutze ich Guards (die Zeilen mit dem | (Pipesymbol). Wenn der Rest xs eine leere Liste ist (null xs) dann ist die Liste sortiert. Sonst ist die Liste sortiert, wenn das jeweils erste Element x kleiner oder gleich dem ersten Element der Restliste ist und wenn die Restliste auch sortiert ist (Rekursion).

Zu guter Letzt habe ich mich gefragt, ob man auch foldl benutzen kann, um die Sortiert-Eigenschaft einer Liste zu überprüfen. Man kann, aber es ist mir nur eine hässliche Lösung eingefallen.

mysorted4 :: Ord a => [a] -> Bool
mysorted4 xs = fst (foldl (\(a, b) c -> (a && (b <= c), c)) (True, head xs) xs)

1 2	mysorted4 :: Ord a => [a] -> Bool mysorted4 xs = fst (foldl (\(a, b) c -> (a && (b <= c), c)) (True, head xs) xs)

Foldl befeuert eine Funktion (hier Lambda) mit 2 Werten: zuerst mit dem Akkumulator und dann mit dem jeweiligen nächsten Listenelement. Die Herausforderung war hier, irgendwie das boolesche Ergebnis des Vergleichs und das vorherige Listenelement in den Akkumulatorwert zu packen. Ich mache das hier mit einem Tupel (Bool, Ord) und hole das Ergebnis mit fst ab.

Was hältst Du davon? Über Kommentare würde ich mich sehr freuen.

Und hier das ganze Programm zum Ausprobieren:

import Data.List (sort)

mysorted :: Ord a => [a] -> Bool
mysorted xs = xs == sort xs

mysorted2 :: Ord a => [a] -> Bool
mysorted2 xs = and [f <= s | (f, s) <- zip xs (tail xs)]

mysorted3 :: Ord a => [a] -> Bool
mysorted3 (x : xs)
  | null xs = True
  | otherwise = (x <= head xs) && mysorted3 xs

mysorted4 :: Ord a => [a] -> Bool
mysorted4 xs = fst (foldl (\(a, b) c -> (a && (b <= c), c)) (True, head xs) xs)

main :: IO ()
main = do
  print $ mysorted [1]
  print $ mysorted [1, 2, 3]
  print $ mysorted [1, 2, 5, 3]

  print $ mysorted2 [1]
  print $ mysorted2 [1, 2, 3]
  print $ mysorted2 [1, 2, 5, 3]

  print $ mysorted3 [1]
  print $ mysorted3 [1, 2, 3]
  print $ mysorted3 [1, 2, 5, 3]

  print $ mysorted4 [1]
  print $ mysorted4 [1, 2, 3]
  print $ mysorted4 [1, 2, 5, 3]

import Data.List (sort)

mysorted :: Ord a => [a] -> Bool

mysorted xs = xs == sort xs

mysorted2 :: Ord a => [a] -> Bool

mysorted2 xs = and [f <= s | (f, s) <- zip xs (tail xs)]

mysorted3 :: Ord a => [a] -> Bool

mysorted3 (x : xs)

| null xs = True

| otherwise = (x <= head xs) && mysorted3 xs

mysorted4 :: Ord a => [a] -> Bool

mysorted4 xs = fst (foldl (\(a, b) c -> (a && (b <= c), c)) (True, head xs) xs)

main :: IO ()

main = do

print $ mysorted [1]

print $ mysorted [1, 2, 3]

print $ mysorted [1, 2, 5, 3]

print $ mysorted2 [1]

print $ mysorted2 [1, 2, 3]

print $ mysorted2 [1, 2, 5, 3]

print $ mysorted3 [1]

print $ mysorted3 [1, 2, 3]

print $ mysorted3 [1, 2, 5, 3]

print $ mysorted4 [1]

print $ mysorted4 [1, 2, 3]

print $ mysorted4 [1, 2, 5, 3]

15. April 202315. April 2023

List Comprehension vs. Map/Lambda

Ich lese gerade das Buch „Get Programming with Haskell“ und erstelle kleine Übungsprogramme, um Haskell auszuprobieren.

Die Aufgabe, die ich hier beschreibe, ist es eine einfache Konsolenanwendung zu schreiben, die eine Multiplikationstabelle berechnet und ausgibt.

So etwas in z.B. Java zu implementieren ist sehr einfach, da man einfach zwei Schleifen ineinander schachteln kann. Da Haskell eine rein funktionale Sprache ist, gibt es leider keine einfachen Schleifen, geschweige denn veränderbare (Schleifen-)Variablen.

Ich stelle hier zwei verschiedene Lösungen vor: Eine mit Map/Lambda und eine mit List Comprehensions.

Zuerst die mit Map/Lambda:

import Text.Printf (printf)

row :: String -> Int -> String
row prefix r = prefix ++ mconcat (map (\c -> printf "%4d" (r * c)) [1 .. 10]) ++ "\n"

table :: String
table = row "    " 1 ++ mconcat (map (\r -> row (printf "%4d" r) r) [1 .. 10])

main :: IO ()
main = do
  putStr table

import Text.Printf (printf)

row :: String -> Int -> String

row prefix r = prefix ++ mconcat (map (\c -> printf "%4d" (r * c)) [1 .. 10]) ++ "\n"

table :: String

table = row " " 1 ++ mconcat (map (\r -> row (printf "%4d" r) r) [1 .. 10])

main :: IO ()

main = do

putStr table

Und hier die Version mit List Comprehensions:

import Text.Printf (printf)

row :: String -> Int -> String
row prefix r = prefix ++ mconcat [printf "%4d" (r * c) | c <- [1 .. 10]] ++ "\n"

table :: String
table = row "    " 1 ++ mconcat [row (printf "%4d" r) r | r <- [1 .. 10]]

main :: IO ()
main = do
  putStr table

import Text.Printf (printf)

row :: String -> Int -> String

row prefix r = prefix ++ mconcat [printf "%4d" (r * c) | c <- [1 .. 10]] ++ "\n"

table :: String

table = row " " 1 ++ mconcat [row (printf "%4d" r) r | r <- [1 .. 10]]

main :: IO ()

main = do

putStr table

Wie man sieht, unterscheiden sich die beiden Programme an den Stellen, an denen Listen erstellt werden. Der Codeabschnitt:

(map (\c -> printf "%4d" (r * c)) [1 .. 10])

1	(map (\c -> printf "%4d" (r * c)) [1 .. 10])

erstellt eine Liste bestehend aus 4 Zeichen breiten Strings, die die Ergebnisse der Multiplikation von r (Row) mit c (Column) als rechtsbündige Strings darstellen. Also [“ 1″, “ 2″,…,“ 10″]. Mit mconcat werden die Strings in dieser Liste dann zu einem einzigen String verkettet.

In der Version mit List Comprehension sieht der Codeabschnitt so aus:

[printf "%4d" (r * c) | c <- [1 .. 10]]

1	[printf "%4d" (r * c) \| c <- [1 .. 10]]

Mir persönlich gefällt die Version mit List Comprehension besser, da sie einfacher zu lesen ist und viel schöner und klarer aussieht.

26. Februar 202324. März 2023

CSV-Datei mit Tankstatistik in Rust auswerten

Seit wenigen Tagen beschäftige ich mich mit Rust und habe als Übung ein Programm erstellt, mit dem ich meine Tankstatistik auswerten kann. Die Daten habe ich mit meiner Android-App Tankstatistik gesammelt und exportiert.

Die Daten müssen in einer Datei „tanken.txt“ im Hauptverzeichnis des Rust-Programmes gespeichert werden und sehen wie folgt aus:

19.11.2022	112443	29	49,27
04.12.2022	112872	30,01	49,79
19.12.2022	113361	33	52,11
16.01.2023	113824	33,6	55,41
01.02.2023	114335	34	58,11
15.02.2023	114856	33	56,07

19.11.2022 112443 29 49,27

04.12.2022 112872 30,01 49,79

19.12.2022 113361 33 52,11

16.01.2023 113824 33,6 55,41

01.02.2023 114335 34 58,11

15.02.2023 114856 33 56,07

In der ersten Spalte steht das Tankdatum, in der zweiten der Kilometerstand, in der dritten die getankten Liter und in der vierten der Preis. Die beiden letzten Zahlen benutzen als Dezimalpunkt das Komma, damit man die Daten leichter in das deutschsprachige Excel importieren kann. Die Spalten sind mit dem Tabulatorzeichen (\t) getrennt. Die Daten können hier heruntergeladen werden.

tanken.txt Herunterladen

Das Rust-Programm besteht aus zwei Dateien „main.rs“ und „lib.rs“. Dabei benutzt das Hauptprogramm „main.rs“ die Funktionen aus der Bibliothek „lib.rs“.

Das Programm kann bei GitHub ausgecheckt werden.

Das Projekt verwendet einige Features von Rust wie Structs mit Datenfeldern und Implementierungen von Funktionen und Methoden, Collections wie Vec und HashMap, Closures, Iteratoren, Dateizugriffe, Sortieren und Tests.

Die Datei „lib.rs“ sieht wie folgt aus:

use std::collections::HashMap;
use std::fs::File;
use std::io::BufRead;
use std::io::BufReader;

#[derive(Debug)]
pub struct Date {
    pub day: u8,
    pub month: u8,
    pub year: u16,
}

impl Date {
    pub fn new(datetext: &str) -> Self {
        let mut split = datetext.split(".");
        Date {
            day: split.next().unwrap().parse().unwrap(),
            month: split.next().unwrap().parse().unwrap(),
            year: split.next().unwrap().parse().unwrap(),
        }
    }
}

#[derive(Debug)]
pub struct Record {
    pub date: Date,
    pub km: u32,
    pub liter: f32,
    pub costs: f32,
}

impl Record {
    pub fn new(line: &str) -> Record {
        let mut split = line.split("\t");
        Record {
            date: Date::new(split.next().unwrap()),
            km: split.next().unwrap().parse().unwrap(),
            liter: Self::parse_german(split.next().unwrap()),
            costs: Self::parse_german(split.next().unwrap()),
        }
    }

    fn parse_german(numtext: &str) -> f32 {
        numtext.replace(",", ".").parse().unwrap()
    }
}

#[derive(Debug)]
pub struct Statistics {
    data: Vec<Record>,
}

impl Statistics {
    pub fn new(filename: &str) -> Statistics {
        Statistics {
            data: Self::parse_file(filename),
        }
    }

    fn parse_file(filename: &str) -> Vec<Record> {
        let file = File::open(filename).unwrap();
        let mut stats: Vec<Record> = Vec::new();
        BufReader::new(file).lines().for_each(|line| {
            stats.push(Record::new(&line.unwrap()));
        });
        stats
    }

    pub fn get_years<F>(&self, f: F) -> Vec<(u16, f32)>
    where
        F: Fn(&Record) -> f32,
    {
        let mut map: HashMap<u16, f32> = HashMap::new();
        self.data.iter().for_each(|rec| {
            map.entry(rec.date.year)
                .and_modify(|v| *v = *v + f(rec))
                .or_insert(f(rec));
        });

        let mut years: Vec<(u16, f32)> = map.into_iter().collect();
        years.sort_by_key(|v| v.0);
        years
    }

    pub fn get_kilometers(&self) -> u32 {
        self.data.last().unwrap().km - self.data.first().unwrap().km
    }

    pub fn get_consumption(&self) -> f32 {
        let mut liter: f32 = self.data.iter().map(|r| r.liter).sum();
        liter -= self.data.last().unwrap().liter;
        liter / self.get_kilometers() as f32 * 100 as f32
    }
}

#[cfg(test)]
mod tests {
    use super::*;

    #[test]
    fn parse_date() {
        let d = Date::new("7.04.2022");
        assert_eq!(d.day, 7);
        assert_eq!(d.month, 4);
        assert_eq!(d.year, 2022);
    }

    #[test]
    fn parse_record() {
        let r = Record::new("7.04.2022\t100000\t90,5\t120,6");
        assert_eq!(r.date.day, 7);
        assert_eq!(r.date.month, 4);
        assert_eq!(r.date.year, 2022);
        assert_eq!(r.km, 100000);
        assert_eq!(r.liter, 90.5);
        assert_eq!(r.costs, 120.6);
    }
}

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

use std::collections::HashMap;

use std::fs::File;

use std::io::BufRead;

use std::io::BufReader;

#[derive(Debug)]

pub struct Date {

pub day: u8,

pub month: u8,

pub year: u16,

}

impl Date {

pub fn new(datetext: &str) -> Self {

let mut split = datetext.split(".");

Date {

day: split.next().unwrap().parse().unwrap(),

month: split.next().unwrap().parse().unwrap(),

year: split.next().unwrap().parse().unwrap(),

}

#[derive(Debug)]

pub struct Record {

pub date: Date,

pub km: u32,

pub liter: f32,

pub costs: f32,

}

impl Record {

pub fn new(line: &str) -> Record {

let mut split = line.split("\t");

Record {

date: Date::new(split.next().unwrap()),

km: split.next().unwrap().parse().unwrap(),

liter: Self::parse_german(split.next().unwrap()),

costs: Self::parse_german(split.next().unwrap()),

}

fn parse_german(numtext: &str) -> f32 {

numtext.replace(",", ".").parse().unwrap()

}

#[derive(Debug)]

pub struct Statistics {

data: Vec<Record>,

}

impl Statistics {

pub fn new(filename: &str) -> Statistics {

Statistics {

data: Self::parse_file(filename),

}

fn parse_file(filename: &str) -> Vec<Record> {

let file = File::open(filename).unwrap();

let mut stats: Vec<Record> = Vec::new();

BufReader::new(file).lines().for_each(|line| {

stats.push(Record::new(&line.unwrap()));

});

stats

}

pub fn get_years<F>(&self, f: F) -> Vec<(u16, f32)>

where

F: Fn(&Record) -> f32,

{

let mut map: HashMap<u16, f32> = HashMap::new();

self.data.iter().for_each(|rec| {

map.entry(rec.date.year)

.and_modify(|v| *v = *v + f(rec))

.or_insert(f(rec));

});

let mut years: Vec<(u16, f32)> = map.into_iter().collect();

years.sort_by_key(|v| v.0);

years

}

pub fn get_kilometers(&self) -> u32 {

self.data.last().unwrap().km - self.data.first().unwrap().km

}

pub fn get_consumption(&self) -> f32 {

let mut liter: f32 = self.data.iter().map(|r| r.liter).sum();

liter -= self.data.last().unwrap().liter;

liter / self.get_kilometers() as f32 * 100 as f32

}

#[cfg(test)]

mod tests {

use super::*;

#[test]

fn parse_date() {

let d = Date::new("7.04.2022");

assert_eq!(d.day, 7);

assert_eq!(d.month, 4);

assert_eq!(d.year, 2022);

}

#[test]

fn parse_record() {

let r = Record::new("7.04.2022\t100000\t90,5\t120,6");

assert_eq!(r.date.day, 7);

assert_eq!(r.date.month, 4);

assert_eq!(r.date.year, 2022);

assert_eq!(r.km, 100000);

assert_eq!(r.liter, 90.5);

assert_eq!(r.costs, 120.6);

}

Die Datei „main.rs“ sieht so aus:

use tanken::Statistics;

fn main() {
    let stats = Statistics::new("./tanken.txt");

    println!("Kosten pro Jahr:");
    println!("----------------");
    stats
        .get_years(|r| r.costs)
        .iter()
        .for_each(|(y, c)| println!("Jahr {}: {:>8.2} Euro.", y, c));

    println!();
    println!("Liter pro Jahr:");
    println!("---------------");
    stats
        .get_years(|r| r.liter)
        .iter()
        .for_each(|(y, c)| println!("Jahr {}: {:>8.2} Liter.", y, c));

    println!();
    println!("Gefahrene Kilometer: {}.", stats.get_kilometers());

    println!();
    println!("Verbrauch {:.2} Liter pro 100 km.", stats.get_consumption());
}

use tanken::Statistics;

fn main() {

let stats = Statistics::new("./tanken.txt");

println!("Kosten pro Jahr:");

println!("----------------");

stats

.get_years(|r| r.costs)

.iter()

.for_each(|(y, c)| println!("Jahr {}: {:>8.2} Euro.", y, c));

println!();

println!("Liter pro Jahr:");

println!("---------------");

stats

.get_years(|r| r.liter)

.iter()

.for_each(|(y, c)| println!("Jahr {}: {:>8.2} Liter.", y, c));

println!();

println!("Gefahrene Kilometer: {}.", stats.get_kilometers());

println!();

println!("Verbrauch {:.2} Liter pro 100 km.", stats.get_consumption());

}

Wenn Du das mal ausprobieren willst, dann erstelle in einem freien Verzeichnis das Projekt „tanken“ mit:

>cargo new tanken
>cd tanken

Kopiere dann die beiden Dateien „main.rs“ und „lib.rs“ in das „src“-Unterverzeichnis und die Datei „tanken.txt“ in das Hauptverzeichnis „tanken“. Jetzt kannst Du die Tests laufen lassen mit:

>cargo test

Und das Programm kannst Du laufen lassen mit:

>cargo run

Dann solltest Du folgendes sehen:

Viel Spaß!

13. November 202224. März 2023

Übersicht über Dateierweiterungen

Wenn man sich eine Übersicht über Dateierweiterungen in einem Verzeichnis und allen Unterverzeichnissen verschaffen möchte, kann man folgendes PowerShell-Skript verwenden: types.ps1.

param([string]$dir = ".")
$files = @()
Get-ChildItem $dir -Recurse -File | foreach{$files += $_}
$types = @{}
foreach($f in $files) {
    $filename = $f.Name;
    $dot = $filename.LastIndexOf('.')
    if ($dot -lt 0) {
        $ext = ""
    } else {
        $ext = $filename.Substring($dot)
    }
    if ($types.ContainsKey($ext)) {
        $types[$ext] += 1
    } else {
        $types[$ext] = 1
    }
}
$types.GetEnumerator() | Sort-Object -Property name

param([string]$dir = ".")

$files = @()

Get-ChildItem $dir -Recurse -File | foreach{$files += $_}

$types = @{}

foreach($f in $files) {

$filename = $f.Name;

$dot = $filename.LastIndexOf('.')

if ($dot -lt 0) {

$ext = ""

} else {

$ext = $filename.Substring($dot)

}

if ($types.ContainsKey($ext)) {

$types[$ext] += 1

} else {

$types[$ext] = 1

}

$types.GetEnumerator() | Sort-Object -Property name

Aufgerufen wird das Skript mit einer Pfadangabe z.B

powershell types.ps1 Dev

oder ohne einer Pfadangabe z.B.

powershell types.ps1

Wenn keine Pfadangabe angegeben wird, dann beginnt die Suche im aktuellen Verzeichnis. Das Ergebnis sieht dann z.B. so aus:

Mehr zu Powershell kannst Du hier finden:

9. November 20229. November 2022

Textzeilen mit PowerShell sortieren

PowerShell ist zwar eine objektorientierte Kommandozeile, aber man kann auch einfachen Text mit der PowerShell bearbeiten. Hier zeige ich, wie man eine einfache Mitgliederliste mit der PowerShell sortieren kann.

Als Ausgangsdatei in den Beispielen verwende ich die Datei „mitglieder.txt“ mit dem folgenden Inhalt:

Peter Müller
Andreas Schmidt
Georg Weiß
Stefan Bauer
Leo Meier

Peter Müller

Andreas Schmidt

Georg Weiß

Stefan Bauer

Leo Meier

Um diese Datei nach Vornamen zu sortieren und das Ergebnis in der Datei „mitglieder-sortiert.txt“ zu speichern, genügt folgender Befehl:

Get-Content mitglieder.txt | Sort-Object > mitglieder-sortiert.txt

1	Get-Content mitglieder.txt \| Sort-Object > mitglieder-sortiert.txt

Die Ergebnisdatei „mitglieder-sortiert.txt“ sieht danach so aus:

Andreas Schmidt
Georg Weiß
Leo Meier
Peter Müller
Stefan Bauer

Andreas Schmidt

Georg Weiß

Leo Meier

Peter Müller

Stefan Bauer

Das war einfach. Was ist aber, wenn wir nach den Nachnamen sortieren wollen?

Das müssen wir irgendwie dem Commandlet „Sort-Object“ sagen. Das tun wir, indem wir jede Zeile ($_) am Leerzeichen („\s+“) aufsplitten und das zweite Wort an „Sort-Object“ übergeben. (Die 1 steht für das zweite Wort, weil 0 für das erste Wort steht):

 Get-Content mitglieder.txt | Sort-Object { ($_ -Split "\s+")[1] } > mitgliedersortiert.txt

1	Get-Content mitglieder.txt \| Sort-Object { ($_ -Split "\s+")[1] } > mitgliedersortiert.txt

Die Ergebnisdatei „mitglieder-sortiert.txt“ sieht jetzt so aus:

Stefan Bauer
Leo Meier
Peter Müller
Andreas Schmidt
Georg Weiß

Stefan Bauer

Leo Meier

Peter Müller

Andreas Schmidt

Georg Weiß

Die beiden Sortierungen sind aufsteigend. Möchte man absteigend sortieren, dann muss man den Parameter „-Descending“ hinzufügen.

Get-Content mitglieder.txt | Sort-Object -Descending { ($_ -Split "\s+")[1] } > mitglieder-sortiert.txt

1	Get-Content mitglieder.txt \| Sort-Object -Descending { ($_ -Split "\s+")[1] } > mitglieder-sortiert.txt

Die Ergebnisdatei sieht dann so aus:

Georg Weiß
Andreas Schmidt
Peter Müller
Leo Meier
Stefan Bauer

Georg Weiß

Andreas Schmidt

Peter Müller

Leo Meier

Stefan Bauer

Soviel zum Sortieren von Textdateien mit der PowerShell. Wenn man PowerShell mit den Möglichkeiten von UNIX vergleicht, dann ist PowerShell sehr wortreich. Unter UNIX würde man folgendermaßen nach Nachnamen sortieren:

sort -k2 mitglieder.txt > mitglieder-sortiert.txt

1	sort -k2 mitglieder.txt > mitglieder-sortiert.txt

Daraus darf man aber nicht schlussfolgern, dass PowerShell irgendwie schlechter ist als die UNIX-Tools. UNIX ist nun mal alt und textorientiert und PowerShell zeigt ihre wahren Stärken beim Verarbeiten von objektorientierten Commandlets.

29. Oktober 202224. März 2023

Lösungen der Übungen zu Kapitel 5

Ich lese gerade das Buch „ANSI Common Lisp“ von Paul Graham und veröffentliche hier meine Lösungen zu den Übungen am Ende der Kapitel. Hier sind meine Lösungen zu Kapitel 5.

Übung 1:

;;; (a)
(defun exercise-1a-before (y)
  (let ((x (car y)))
    (cons x x)))

(exercise-1a-before '(a b c)) ; (A . A) 

(defun exercise-1a-after (y)
  ((lambda (x) (cons x x)) (car y)))

(exercise-1a-after '(a b c)) ; (A . A)

;;; (b)
(defun exercise-1b-before (x z)
  (let* ((w (car x))
         (y (+ w z)))
    (cons w y)))

(exercise-1b-before '(1 2 3) 5) ; (1 . 6)

(defun exercise-1b-after (x z)
  ((lambda (w) 
     ((lambda (y) (cons w y)) (+ w z)))
   (car x)))

(exercise-1b-after '(1 2 3) 5) ; (1 . 6)

;;; (a)

(defun exercise-1a-before (y)

(let ((x (car y)))

(cons x x)))

(exercise-1a-before '(a b c)) ; (A . A)

(defun exercise-1a-after (y)

((lambda (x) (cons x x)) (car y)))

(exercise-1a-after '(a b c)) ; (A . A)

;;; (b)

(defun exercise-1b-before (x z)

(let* ((w (car x))

(y (+ w z)))

(cons w y)))

(exercise-1b-before '(1 2 3) 5) ; (1 . 6)

(defun exercise-1b-after (x z)

((lambda (w)

((lambda (y) (cons w y)) (+ w z)))

(car x)))

(exercise-1b-after '(1 2 3) 5) ; (1 . 6)

Übung 2:

;;; Das Original
(defun mystery (x y)
  (if (null y)
      nil
      (if (eql (car y) x)
          0
          (let ((z (mystery x (cdr y))))
            (and z (+ z 1))))))

(mystery 'a '(b c a d e a a f a))

(mystery 'x '(b c d e a a f a))

;;; Lösung
(defun mystery-cond (x y)
  (cond ((null y) nil)
        ((eql (car y) x) 0)
        (t (let ((z (mystery x (cdr y))))
                   (and z (+ z 1))))))

(mystery-cond 'a '(b c a d e a a f a)) ; 2

(mystery 'x '(b c d e a a f a)) ; NIL

;;; Das Original

(defun mystery (x y)

(if (null y)

nil

(if (eql (car y) x)

(let ((z (mystery x (cdr y))))

(and z (+ z 1))))))

(mystery 'a '(b c a d e a a f a))

(mystery 'x '(b c d e a a f a))

;;; Lösung

(defun mystery-cond (x y)

(cond ((null y) nil)

((eql (car y) x) 0)

(t (let ((z (mystery x (cdr y))))

(and z (+ z 1))))))

(mystery-cond 'a '(b c a d e a a f a)) ; 2

(mystery 'x '(b c d e a a f a)) ; NIL

Übung 3:

(defun square-5 (x)
  (if (<= x 5)
      nil
      (* x x)))

(square-5 1) ; nil
(square-5 5) ; nil
(square-5 6) ; 36

(defun square-5 (x)

(if (<= x 5)

nil

(* x x)))

(square-5 1) ; nil

(square-5 5) ; nil

(square-5 6) ; 36

Übung 4:

;;; Original
(defconstant month #(0 31 59 90 120 151 181 212 243 273 304 334 365))

(defun leap? (y)
  (and (zerop (mod y 4))
       (or (zerop (mod y 400))
           (not (zerop (mod y 100))))))

(defun month-num (m y)
  (+ (svref month (- m 1))
     (if (and (> m 2) (leap? y)) 1 0)))

(month-num 1 2000) ; 0
(month-num 2 2000) ; 31
(month-num 3 2000) ; 68

;;; Lösung
(defun month-num-new (m y)
  (+ (case m
       (1 0)
       (2 31)
       (3 59)
       (4 90)
       (5 120)
       (6 151)
       (7 181)
       (8 212)
       (9 243)
       (10 273)
       (11 304)
       (12 334)
       (otherwise 365))
     (if (and (> m 2) (leap? y)) 1 0)))

(month-num-new 1 2000) ; 0
(month-num-new 2 2000) ; 31
(month-num-new 3 2000) ; 60
(month-num-new 4 2000) ; 91
(month-num-new 5 2000) ; 121
(month-num-new 6 2000) ; 152
(month-num-new 7 2000) ; 182
(month-num-new 8 2000) ; 213
(month-num-new 9 2000) ; 244
(month-num-new 10 2000) ; 274
(month-num-new 11 2000) ; 305
(month-num-new 12 2000) ; 335
(month-num-new 13 2000) ; 366

;;; Original

(defconstant month #(0 31 59 90 120 151 181 212 243 273 304 334 365))

(defun leap? (y)

(and (zerop (mod y 4))

(or (zerop (mod y 400))

(not (zerop (mod y 100))))))

(defun month-num (m y)

(+ (svref month (- m 1))

(if (and (> m 2) (leap? y)) 1 0)))

(month-num 1 2000) ; 0

(month-num 2 2000) ; 31

(month-num 3 2000) ; 68

;;; Lösung

(defun month-num-new (m y)

(+ (case m

(1 0)

(2 31)

(3 59)

(4 90)

(5 120)

(6 151)

(7 181)

(8 212)

(9 243)

(10 273)

(11 304)

(12 334)

(otherwise 365))

(if (and (> m 2) (leap? y)) 1 0)))

(month-num-new 1 2000) ; 0

(month-num-new 2 2000) ; 31

(month-num-new 3 2000) ; 60

(month-num-new 4 2000) ; 91

(month-num-new 5 2000) ; 121

(month-num-new 6 2000) ; 152

(month-num-new 7 2000) ; 182

(month-num-new 8 2000) ; 213

(month-num-new 9 2000) ; 244

(month-num-new 10 2000) ; 274

(month-num-new 11 2000) ; 305

(month-num-new 12 2000) ; 335

(month-num-new 13 2000) ; 366

Übung 5:

;;; Iterativ
(defun precedes-iter (el vec)
  (if (< (length vec) 2)
      nil
      (let ((result nil))
        (do ((i 1 (+ i 1))
             (e (aref vec 0) (aref vec i)))
            ((= i (length vec)) (reverse result))
          (if (equal el (aref vec i))
               (push e result))))))

(precedes-iter 1 #()) ; nil
(precedes-iter 1 #(1)) ; nil
(precedes-iter 1 #(1 2)) ; nil
(precedes-iter 1 #(2 1)) ; (2)
(precedes-iter 4 #(1 4 6 4)) ; (1 6)
(precedes-iter #\a "abracadabra") ; (#\r #\c #\d #\r)

;;; Rekursiv
(defun precedes-rec-internal (el vec i result)
  (if (= i (length vec))
      result
      (progn
        (if (equal el (aref vec i))
            (push (aref vec (- i 1)) result))
        (precedes-rec-internal el vec (+ i 1) result))))

(defun precedes-rec (el vec)
  (if (< (length vec) 2)
      nil
      (reverse (precedes-rec-internal el vec 1 nil))))

(precedes-rec 1 #()) ; nil
(precedes-rec 1 #(1)) ; nil
(precedes-rec 1 #(1 2)) ; nil
(precedes-rec 1 #(2 1)) ; (2)
(precedes-rec 4 #(1 4 6 4)) ; (1 6)
(precedes-rec #\a "abracadabra") ; (#\r #\c #\d #\r)

;;; Iterativ

(defun precedes-iter (el vec)

(if (< (length vec) 2)

nil

(let ((result nil))

(do ((i 1 (+ i 1))

(e (aref vec 0) (aref vec i)))

((= i (length vec)) (reverse result))

(if (equal el (aref vec i))

(push e result))))))

(precedes-iter 1 #()) ; nil

(precedes-iter 1 #(1)) ; nil

(precedes-iter 1 #(1 2)) ; nil

(precedes-iter 1 #(2 1)) ; (2)

(precedes-iter 4 #(1 4 6 4)) ; (1 6)

(precedes-iter #\a "abracadabra") ; (#\r #\c #\d #\r)

;;; Rekursiv

(defun precedes-rec-internal (el vec i result)

(if (= i (length vec))

result

(progn

(if (equal el (aref vec i))

(push (aref vec (- i 1)) result))

(precedes-rec-internal el vec (+ i 1) result))))

(defun precedes-rec (el vec)

(if (< (length vec) 2)

nil

(reverse (precedes-rec-internal el vec 1 nil))))

(precedes-rec 1 #()) ; nil

(precedes-rec 1 #(1)) ; nil

(precedes-rec 1 #(1 2)) ; nil

(precedes-rec 1 #(2 1)) ; (2)

(precedes-rec 4 #(1 4 6 4)) ; (1 6)

(precedes-rec #\a "abracadabra") ; (#\r #\c #\d #\r)

Übung 6:

;;; Iterativ
(defun intersperse-iter (el lst)
  (let ((len (length lst))
        (res nil)
        (ls lst))
    (if (< len 2)
        lst
        (do* ((i 1 (+ i 1))
             (ls ls (cdr ls))
             (e (car ls) (car ls)))
            ((= len i) (push e res))
          (push e res)
          (push el res)))
  (reverse res)))

(intersperse-iter '- '(a b c d)) ; (A - B - C - D)

;;; Rekursiv
(defun intersperse-rec (el lst)
  (if (null lst)
      nil
      (cons (car lst)
            (if (> (length lst) 1)
                (cons el (intersperse-rec el (cdr lst)))
                (car (cdr lst)))))))

(intersperse-rec '- '(a b c d)) ; (A - B - C - D)

;;; Iterativ

(defun intersperse-iter (el lst)

(let ((len (length lst))

(res nil)

(ls lst))

(if (< len 2)

lst

(do* ((i 1 (+ i 1))

(ls ls (cdr ls))

(e (car ls) (car ls)))

((= len i) (push e res))

(push e res)

(push el res)))

(reverse res)))

(intersperse-iter '- '(a b c d)) ; (A - B - C - D)

;;; Rekursiv

(defun intersperse-rec (el lst)

(if (null lst)

nil

(cons (car lst)

(if (> (length lst) 1)

(cons el (intersperse-rec el (cdr lst)))

(car (cdr lst)))))))

(intersperse-rec '- '(a b c d)) ; (A - B - C - D)

Übung 7:

;;; (a) Rekursiv
(defun num-diff-1-rec-internal (lst former)
  (cond ((null lst) t)
        ((= (- (car lst) former) 1)
         (num-diff-1-rec-internal (cdr lst) (car lst)))
        (t nil)))

(defun num-diff-1-rec (lst)
  (if (or (null lst) (null (cdr lst)))
      nil
      (num-diff-1-rec-internal (cdr lst) (car lst))))

(num-diff-1-rec nil) ; nil
(num-diff-1-rec '(2)) ; nil
(num-diff-1-rec '(2 3)) ; t
(num-diff-1-rec '(2 3 4 5 6)) ; t
(num-diff-1-rec '(2 3 5 6 7)) ; nil

;;; (b) Iterativ
(defun num-diff-1-iter (lst)
  (if (or (null lst) (null (cdr lst)))
      nil
      (do ((res t (and res (= (- (second lst) (first lst)) 1)))
           (lst lst (cdr lst)))
          ((null (cdr lst)) res))))
        
(num-diff-1-iter nil) ; nil
(num-diff-1-iter '(2)) ; nil
(num-diff-1-iter '(2 3)) ; t
(num-diff-1-iter '(2 3 4 5 6)) ; t
(num-diff-1-iter '(2 3 5 6 7)) ; nil

;;; (c) mapc return
(defun num-diff-1-mapc (lst)
  (if (or (null lst) (null (cdr lst)))
      nil
      (let ((former (first lst)))
        (mapc #'(lambda (next)
                  (progn
                    (if (/= (- next former) 1)
                        (return-from num-diff-1-mapc nil))
                    (setf former next)))
              (cdr lst))
        t)))
        
(num-diff-1-mapc nil) ; nil
(num-diff-1-mapc '(2)) ; nil
(num-diff-1-mapc '(2 3)) ; t
(num-diff-1-mapc '(2 3 4 5 6)) ; t
(num-diff-1-mapc '(2 3 5 6 7)) ; nil

;;; (a) Rekursiv

(defun num-diff-1-rec-internal (lst former)

(cond ((null lst) t)

((= (- (car lst) former) 1)

(num-diff-1-rec-internal (cdr lst) (car lst)))

(t nil)))

(defun num-diff-1-rec (lst)

(if (or (null lst) (null (cdr lst)))

nil

(num-diff-1-rec-internal (cdr lst) (car lst))))

(num-diff-1-rec nil) ; nil

(num-diff-1-rec '(2)) ; nil

(num-diff-1-rec '(2 3)) ; t

(num-diff-1-rec '(2 3 4 5 6)) ; t

(num-diff-1-rec '(2 3 5 6 7)) ; nil

;;; (b) Iterativ

(defun num-diff-1-iter (lst)

(if (or (null lst) (null (cdr lst)))

nil

(do ((res t (and res (= (- (second lst) (first lst)) 1)))

(lst lst (cdr lst)))

((null (cdr lst)) res))))

(num-diff-1-iter nil) ; nil

(num-diff-1-iter '(2)) ; nil

(num-diff-1-iter '(2 3)) ; t

(num-diff-1-iter '(2 3 4 5 6)) ; t

(num-diff-1-iter '(2 3 5 6 7)) ; nil

;;; (c) mapc return

(defun num-diff-1-mapc (lst)

(if (or (null lst) (null (cdr lst)))

nil

(let ((former (first lst)))

(mapc #'(lambda (next)

(progn

(if (/= (- next former) 1)

(return-from num-diff-1-mapc nil))

(setf former next)))

(cdr lst))

t)))

(num-diff-1-mapc nil) ; nil

(num-diff-1-mapc '(2)) ; nil

(num-diff-1-mapc '(2 3)) ; t

(num-diff-1-mapc '(2 3 4 5 6)) ; t

(num-diff-1-mapc '(2 3 5 6 7)) ; nil

Übung 8:

(defun maxmin-internal (vec len i max min)
  (if (= i len)
      (values max min)
      (let ((a (svref vec i)))
        (maxmin-internal
         vec
         len
         (+ i 1)
         (if (> a max) a max)
         (if (< a min) a min)))))


(defun maxmin (vec)
  (if (or (null vec) (zerop (length vec)))
      nil
      (let ((a (svref vec 0)))
        (maxmin-internal vec (length vec) 1 a a))))

(maxmin #(3 20 4 6 15 7 4 9 10)) ; 20, 3
(maxmin #(1)) ; 1, 1 
(maxmin #()) ; nil 
(maxmin nil) ; nil

(defun maxmin-internal (vec len i max min)

(if (= i len)

(values max min)

(let ((a (svref vec i)))

(maxmin-internal

vec

len

(+ i 1)

(if (> a max) a max)

(if (< a min) a min)))))

(defun maxmin (vec)

(if (or (null vec) (zerop (length vec)))

nil

(let ((a (svref vec 0)))

(maxmin-internal vec (length vec) 1 a a))))

(maxmin #(3 20 4 6 15 7 4 9 10)) ; 20, 3

(maxmin #(1)) ; 1, 1

(maxmin #()) ; nil

(maxmin nil) ; nil

Ein weiteres sehr gutes Buch zum Einstieg in Common Lisp ist das folgende:

29. Oktober 202224. März 2023

Lösungen der Übungen zu Kapitel 4

Ich lese gerade das Buch „ANSI Common Lisp“ von Paul Graham und veröffentliche hier meine Lösungen zu den Übungen am Ende der Kapitel. Hier sind meine Lösungen zu Kapitel 4.

Übung 1:

(defun quarter-turn (arr)
  (let* ((dims (array-dimensions arr))
         (ar (make-array dims :initial-element nil))
         (dim (car dims)))
    (do ((y 0 (+ y 1)))
        ((= y dim) ar)
      (do ((x 0 (+ x 1)))
          ((= x dim) nil)
        (setf (aref ar y x) (aref arr (- dim x 1) y))))))

(quarter-turn #2A((a b) (c d))) ; #2A((C A) (D B))
(quarter-turn #2A((c a) (d b))) ; #2A((D C) (B A))
(quarter-turn #2A((d c) (b a))) ; #2A((B D) (A C))
(quarter-turn #2A((b d) (a c))) ; #2A((A B) (C D))

(quarter-turn #2A((a b c) (d e f) (1 2 3))) ; #2A((1 D A) (2 E B) (3 F C))

(defun quarter-turn (arr)

(let* ((dims (array-dimensions arr))

(ar (make-array dims :initial-element nil))

(dim (car dims)))

(do ((y 0 (+ y 1)))

((= y dim) ar)

(do ((x 0 (+ x 1)))

((= x dim) nil)

(setf (aref ar y x) (aref arr (- dim x 1) y))))))

(quarter-turn #2A((a b) (c d))) ; #2A((C A) (D B))

(quarter-turn #2A((c a) (d b))) ; #2A((D C) (B A))

(quarter-turn #2A((d c) (b a))) ; #2A((B D) (A C))

(quarter-turn #2A((b d) (a c))) ; #2A((A B) (C D))

(quarter-turn #2A((a b c) (d e f) (1 2 3))) ; #2A((1 D A) (2 E B) (3 F C))

Übung 2:

(defun new-copy-list (lst)
  (reduce #'cons lst :from-end t :initial-value nil))

(new-copy-list '(a b c)) ; (a b c)

(defun new-reverse (lst)
  (reduce #'(lambda (a b) (cons b a)) lst :initial-value nil))

(new-reverse '(a b c d))

(defun new-copy-list (lst)

(reduce #'cons lst :from-end t :initial-value nil))

(new-copy-list '(a b c)) ; (a b c)

(defun new-reverse (lst)

(reduce #'(lambda (a b) (cons b a)) lst :initial-value nil))

(new-reverse '(a b c d))

Übung 6:

;;; (a)
(defun assoc-to-hash (lst)
  (let ((ht (make-hash-table)))
    (dolist (sl lst)
        (setf (gethash (car sl) ht) (cdr sl)))
    ht)
  )

;;; Test (a)
(setf trans '((+ . "add") (- . "subtract")
              (* . "multiply") (/ . "divide")))

trans

(setf ht (assoc-to-hash trans))
(gethash '- ht) ; "subtract", T
(gethash '+ ht) ; "add", T
(gethash '* ht) ; "multiply", T
(gethash '/ ht) ; "divide", T

;;; (b)
(defun hash-to-assoc (ht)
  (let ((lst nil))
    (maphash #'(lambda (k v) (setf lst (cons (cons k v) lst))) ht)
    lst))

;;; Test (b)
(setf ass (hash-to-assoc ht))
(assoc '- ass) ; (- . "subtract")
(assoc '+ ass) ; (+ . "add") 
(assoc '* ass) ; (* . "multiply")
(assoc '/ ass) ; (/ . "divide")
ass

;;; (a)

(defun assoc-to-hash (lst)

(let ((ht (make-hash-table)))

(dolist (sl lst)

(setf (gethash (car sl) ht) (cdr sl)))

ht)

)

;;; Test (a)

(setf trans '((+ . "add") (- . "subtract")

(* . "multiply") (/ . "divide")))

trans

(setf ht (assoc-to-hash trans))

(gethash '- ht) ; "subtract", T

(gethash '+ ht) ; "add", T

(gethash '* ht) ; "multiply", T

(gethash '/ ht) ; "divide", T

;;; (b)

(defun hash-to-assoc (ht)

(let ((lst nil))

(maphash #'(lambda (k v) (setf lst (cons (cons k v) lst))) ht)

lst))

;;; Test (b)

(setf ass (hash-to-assoc ht))

(assoc '- ass) ; (- . "subtract")

(assoc '+ ass) ; (+ . "add")

(assoc '* ass) ; (* . "multiply")

(assoc '/ ass) ; (/ . "divide")

ass

Ein weiteres sehr gutes Buch zum Einstieg in Common Lisp ist folgendes:

22. Oktober 202230. März 2023

Lösungen der Übungen zu Kapitel 3

Ich lese gerade das Buch „ANSI Common Lisp“ von Paul Graham und veröffentliche hier meine Lösungen zu den Übungen am Ende der Kapitel. Hier sind meine Lösungen zu Kapitel 3.

Übung 2:

(defun new-union (a b)
  (let ((ac (copy-list a)))
    (dolist (e b)
      (if (not (member e ac))
          (setf ac (append ac (list e)))))
    ac))
    
(union '(a b c) '(b a d)) ; (c b a d)

(new-union '(a b c) '(b a d)) ; (a b c d)

(defun new-union (a b)

(let ((ac (copy-list a)))

(dolist (e b)

(if (not (member e ac))

(setf ac (append ac (list e)))))

ac))

(union '(a b c) '(b a d)) ; (c b a d)

(new-union '(a b c) '(b a d)) ; (a b c d)

Übung 3:

(defun occurrences (lst)
  (let ((results (list (cons (car lst) 0)))
        (r nil))
    (dolist (elm lst)
      (setf r (assoc elm results))
      (if r
          (incf (cdr r))
          (push (cons elm 1) results)))
    (setf results (sort results #'(lambda (x y) (> (cdr x) (cdr y))))) 
    results))

(occurrences '(a b a d a c d c a))

(defun occurrences (lst)

(let ((results (list (cons (car lst) 0)))

(r nil))

(dolist (elm lst)

(setf r (assoc elm results))

(if r

(incf (cdr r))

(push (cons elm 1) results)))

(setf results (sort results #'(lambda (x y) (> (cdr x) (cdr y)))))

results))

(occurrences '(a b a d a c d c a))

Übung 4:

(member '(a ) '((a) (b)) :test #'equal)

;;; member benutzt zum Vergleich standardmäßig eql

(member '(a ) '((a) (b)) :test #'equal)

;;; member benutzt zum Vergleich standardmäßig eql

Übung 5:

;;; Recursion
(defun pos+rec-internal (lst n)
  (if (null lst)
      nil
      (cons (+ (car lst) n) (pos+rec-internal (cdr lst) (+ n 1)))))

(defun pos+rec (lst)
  (pos+rec-internal lst 0))

(pos+rec '(7 5 1 4))

;;; Itertiv
(defun pos+iter (lst)
  (let ((i 0)
        (results nil))
    (dolist (elem lst)
      (setf results (cons (+ i elem) results))
      (setf i (+ 1 i)))
    (reverse results)))
        
(pos+iter '(7 5 1 4))

;;; mapcar
(defun pos+map (lst)
  (let ((idx -1))
    (mapcar #'(lambda (x) (incf idx)
                      (+ idx x))
            lst)))

(pos+map '(7 5 1 4))

;;; Recursion

(defun pos+rec-internal (lst n)

(if (null lst)

nil

(cons (+ (car lst) n) (pos+rec-internal (cdr lst) (+ n 1)))))

(defun pos+rec (lst)

(pos+rec-internal lst 0))

(pos+rec '(7 5 1 4))

;;; Itertiv

(defun pos+iter (lst)

(let ((i 0)

(results nil))

(dolist (elem lst)

(setf results (cons (+ i elem) results))

(setf i (+ 1 i)))

(reverse results)))

(pos+iter '(7 5 1 4))

;;; mapcar

(defun pos+map (lst)

(let ((idx -1))

(mapcar #'(lambda (x) (incf idx)

(+ idx x))

lst)))

(pos+map '(7 5 1 4))

Übung 6:

(defun new-car (lst)
  (cdr lst))

(defun new-cdr (lst)
  (car lst))

(new-car '(1 2 3)) ; (2 3)

(new-cdr '(1 2 3)) ; 1

(defun new-cons (elm1 elm2)
  (cons elm1 elm2))

(new-cons 'a '(b c)) ; (a b c)

(defun new-list-internal (lst)
  (if (null (new-cdr lst))
      nil
      (new-cons (new-cdr lst) (new-list-internal (new-car lst)))))

(defun new-list (&rest lst)
  (new-list-internal (new-cons (new-cdr lst) (new-car lst))))

(new-list-internal '(a b c)) ; (a b c)

(new-list 'a 'b 'c) ; (a b c)

(defun new-length (lst)
  (if (null lst)
      0
      (+ 1 (new-length (new-car lst)))))

(new-length '(a b c d)) ; 4

(defun new-member (elm lst)
  (if (null lst)
      nil
      (if (eql elm (new-cdr lst))
          t
          (new-member elm (new-car lst)))))

(new-member 'a nil) ; nil
(new-member 'e '(a b c d)) ; nil
(new-member 'c '(a b c d)) ; t

(defun new-car (lst)

(cdr lst))

(defun new-cdr (lst)

(car lst))

(new-car '(1 2 3)) ; (2 3)

(new-cdr '(1 2 3)) ; 1

(defun new-cons (elm1 elm2)

(cons elm1 elm2))

(new-cons 'a '(b c)) ; (a b c)

(defun new-list-internal (lst)

(if (null (new-cdr lst))

nil

(new-cons (new-cdr lst) (new-list-internal (new-car lst)))))

(defun new-list (&rest lst)

(new-list-internal (new-cons (new-cdr lst) (new-car lst))))

(new-list-internal '(a b c)) ; (a b c)

(new-list 'a 'b 'c) ; (a b c)

(defun new-length (lst)

(if (null lst)

(+ 1 (new-length (new-car lst)))))

(new-length '(a b c d)) ; 4

(defun new-member (elm lst)

(if (null lst)

nil

(if (eql elm (new-cdr lst))

(new-member elm (new-car lst)))))

(new-member 'a nil) ; nil

(new-member 'e '(a b c d)) ; nil

(new-member 'c '(a b c d)) ; t

Übung 7:

(defun compress (x)
  (if (consp x)
      (compr (car x) 1 (cdr x))
      x))

(defun compr (elt n 1st)
  (if (null 1st)
      (list (n-elts elt n))
      (let ((next (car 1st)))
        (if (eql next elt)
            (compr elt (+ n 1) (cdr 1st))
            (cons (n-elts elt n)
                  (compr next 1 (cdr 1st)))))))

(defun n-elts (elt n)
  (if (> n 1)
      (cons n elt) ; list mit cons ersetzt
      elt))

(compress '(1 1 1 0 1 0 0 0 0 1)) ; ((3 . 1) 0 1 (4 . 0) 1)

(defun compress (x)

(if (consp x)

(compr (car x) 1 (cdr x))

x))

(defun compr (elt n 1st)

(if (null 1st)

(list (n-elts elt n))

(let ((next (car 1st)))

(if (eql next elt)

(compr elt (+ n 1) (cdr 1st))

(cons (n-elts elt n)

(compr next 1 (cdr 1st)))))))

(defun n-elts (elt n)

(if (> n 1)

(cons n elt) ; list mit cons ersetzt

elt))

(compress '(1 1 1 0 1 0 0 0 0 1)) ; ((3 . 1) 0 1 (4 . 0) 1)

Übung 8:

(defun showdots (lst)
  (if (null lst)
      (format t "NIL")
      (progn
        (format t "(~A . " (car lst))
        (showdots (cdr lst))
        (format t ")"))))


(showdots '(a b c)); (A . (B . (C . NIL)))
(showdots nil) ; NIL
(showdots '(a)) ; (A . NIL)

(defun showdots (lst)

(if (null lst)

(format t "NIL")

(progn

(format t "(~A . " (car lst))

(showdots (cdr lst))

(format t ")"))))

(showdots '(a b c)); (A . (B . (C . NIL)))

(showdots nil) ; NIL

(showdots '(a)) ; (A . NIL)

Ein weiteres sehr gutes Buch zum Einstieg in Common Lisp ist folgendes:

21. Oktober 202226. März 2023

Lösungen der Übungen zu Kapitel 2

Ich lese gerade das Buch „ANSI Common Lisp“ von Paul Graham und veröffentliche hier meine Lösungen zu den Übungen am Ende der Kapitel. Hier sind meine Lösungen zu Kapitel 2.

Übung 1:

(+ (- 5 1) (+ 3 7)) ; 14

(list 1 ( + 2 3)) ; (1 5)

(if (listp 1) (+1 2 ) (+ 3 4)) ; 7

(list (and (listp 3) t) (+ 1 2)) ; (nil 3)

(+ (- 5 1) (+ 3 7)) ; 14

(list 1 ( + 2 3)) ; (1 5)

(if (listp 1) (+1 2 ) (+ 3 4)) ; 7

(list (and (listp 3) t) (+ 1 2)) ; (nil 3)

Übung 2:

(cons 'a (cons 'b (cons 'c nil)))

(cons 'a (cons 'b '(c)))

(cons 'a '(b c))

(cons 'a (cons 'b (cons 'c nil)))

(cons 'a (cons 'b '(c)))

(cons 'a '(b c))

Übung 3:

(defun my-fourth (lst)
  (car (cdr (cdr (cdr lst)))))

(my-fourth '(1 2 3 4 5 6))

(defun my-fourth (lst)

(car (cdr (cdr (cdr lst)))))

(my-fourth '(1 2 3 4 5 6))

Übung 4:

(defun my-max (a b)
  (if (> a b) a b))

(my-max 2 1)

(defun my-max (a b)

(if (> a b) a b))

(my-max 2 1)

Übung 5a:

(defun enigma (x)
  (and (not (null x))
       (or (null (car x))
	   (enigma (cdr x)))))

(enigma nil) ; nil

(enigma '(a)) ; nil(defun enigma (x)
  (and (not (null x))
       (or (null (car x))
           (enigma (cdr x)))))

(enigma nil) ; nil

(enigma '(a)) ; nil

(enigma '(a b)) ; nil

(enigma '(nil a)) ; t

(enigma '(a nil b)); t

(enigma '(nil)); t

;;; d.h. Die Funktion gibt t zurück, wenn in der übergebenen
;;; Liste nil vorkommt, sonst nil

(defun enigma (x)

(and (not (null x))

(or (null (car x))

(enigma (cdr x)))))

(enigma nil) ; nil

(enigma '(a)) ; nil(defun enigma (x)

(and (not (null x))

(or (null (car x))

(enigma (cdr x)))))

(enigma nil) ; nil

(enigma '(a)) ; nil

(enigma '(a b)) ; nil

(enigma '(nil a)) ; t

(enigma '(a nil b)); t

(enigma '(nil)); t

;;; d.h. Die Funktion gibt t zurück, wenn in der übergebenen

;;; Liste nil vorkommt, sonst nil

Übung 5b:

(defun mystery (x y)
  (if (null y)
      nil
      (if (eql (car y) x)
          0
          (let ((z (mystery x (cdr y))))
            (and z (+ z 1))))))

(mystery 'a '(b c a d e a a f a))

(mystery 'x '(b c d e a a f a))

;;; wenn y keine Liste ist, dann nil
;;; wenn x in der Liste nicht vorkommt, dann auch nil
;;; sonst die Position vom ersten x in der Liste

(defun mystery (x y)

(if (null y)

nil

(if (eql (car y) x)

(let ((z (mystery x (cdr y))))

(and z (+ z 1))))))

(mystery 'a '(b c a d e a a f a))

(mystery 'x '(b c d e a a f a))

;;; wenn y keine Liste ist, dann nil

;;; wenn x in der Liste nicht vorkommt, dann auch nil

;;; sonst die Position vom ersten x in der Liste

Übung 6:

(car (car (cdr '(a (b c) d)))) ; x = car

(or 13 (/ 1 0)) ; x = or

(apply #'list 1 nil) ; x = apply

(car (car (cdr '(a (b c) d)))) ; x = car

(or 13 (/ 1 0)) ; x = or

(apply #'list 1 nil) ; x = apply

Übung 7:

(defun contains-list (lst)
  (if (null lst)
      nil
      (if (listp (car lst))
          t
          (contains-list (cdr lst)))))

(contains-list nil)

(contains-list '(a b c d))

(contains-list '(a (b c) d))

(defun contains-list (lst)

(if (null lst)

nil

(if (listp (car lst))

(contains-list (cdr lst)))))

(contains-list nil)

(contains-list '(a b c d))

(contains-list '(a (b c) d))

Übung 8a:

(defun print-dots-iter (n)
  (do ((i n (- i 1)))
      ((= i 0) 'done)
    (format t ".")))

(print-dots-iter 3)

(defun print-dots-rec (n)
  (if (zerop n)
      nil
      (progn
        (format t ".")
        (print-dots-rec (- n 1)))))

(print-dots-rec 3)

(defun print-dots-iter (n)

(do ((i n (- i 1)))

((= i 0) 'done)

(format t ".")))

(print-dots-iter 3)

(defun print-dots-rec (n)

(if (zerop n)

nil

(progn

(format t ".")

(print-dots-rec (- n 1)))))

(print-dots-rec 3)

Übung 8b:

(defun count-iter (x lst)
  (do ((counter 0))
      ((null lst) counter)
    (if (eql x (car lst))
        (setf counter (+ counter 1)))
    (setf lst (cdr lst))))

(count-iter 'a '(a b a c d a f g a))

(defun count-rec (x lst)
  (if (null lst)
      0
      (if (eql x (car lst))
          (+ 1 (count-rec x (cdr lst)))
          (count-rec x (cdr lst)))))

(count-rec 'a '(a b a c d a f g a))

(defun count-iter (x lst)

(do ((counter 0))

((null lst) counter)

(if (eql x (car lst))

(setf counter (+ counter 1)))

(setf lst (cdr lst))))

(count-iter 'a '(a b a c d a f g a))

(defun count-rec (x lst)

(if (null lst)

(if (eql x (car lst))

(+ 1 (count-rec x (cdr lst)))

(count-rec x (cdr lst)))))

(count-rec 'a '(a b a c d a f g a))

Übung 9:

(defun summit (lst)
  (setf lst (remove nil lst))
  (apply #' + lst))

(summit '(1 nil 2 nil nil 3))

;;; Die ursprüngliche Version hat nicht funktioniert
;;; weil remove eine neue liste zurück liefert
;;; und die ursprüngliche liste wird nicht verändert

(defun summit2 (lst)
  (if (null lst)
      0
      (let ((x (car lst)))
         (if (null x)
             (summit2 (cdr lst))
             (+ x (summit2 (cdr lst)))))))

(summit2 '(nil 1 2 3 nil 4 5 nil))

(summit2 nil)

;;; Es fehlte die Abbruchbedingung, wenn die Liste leer ist

(defun summit (lst)

(setf lst (remove nil lst))

(apply #' + lst))

(summit '(1 nil 2 nil nil 3))

;;; Die ursprüngliche Version hat nicht funktioniert

;;; weil remove eine neue liste zurück liefert

;;; und die ursprüngliche liste wird nicht verändert

(defun summit2 (lst)

(if (null lst)

(let ((x (car lst)))

(if (null x)

(summit2 (cdr lst))

(+ x (summit2 (cdr lst)))))))

(summit2 '(nil 1 2 3 nil 4 5 nil))

(summit2 nil)

;;; Es fehlte die Abbruchbedingung, wenn die Liste leer ist

Ein weiteres sehr gutes Buch zum Einstieg in Common Lisp ist folgendes:

4. Juni 202230. Oktober 2022

Einen String mit n-mal Zeichen erstellen

Wenn man z.B. in C++ Konsolenprogrammen eine lange Trennzeile ausgeben will dann kann man einen String erstellen mit einer definierten Anzahl eines Zeichens:

const std::string delimiter = std::string(40, '-');

1	const std::string delimiter = std::string(40, '-');

Damit erzeugt man einen String bestehend aus 40 mal das Zeichen – (Minus).