Commit 9045909a authored by rokka's avatar rokka

ueb4

parent b7bbe1ac
File added
In der Vorlesung haben Sie die posn-Struktur kennengelernt. Wir möchten nun einige Funktionen auf dieser Struktur implementieren. Achten Sie dabei darauf, das Entwurfsrezept anzuwenden.
Dort wo die untenstehende Funktion einen Vektor erwarten, soll auch in der Signatur der Typ Vektor angegeben werden. Definieren Sie den Typ Vektor als Kommentar. Verwenden Sie hier die Struktur Posn wieder. Ein Vektor ist eine Posn-Struktur wobei die beiden Felder jeweils ein Number sind.
(vec-add v1 v2), die die übergebenen Vektoren addiert.
\ No newline at end of file
xquery version "1.0";
import module namespace aa='https://plt.bitbucket.io/autoassess' at 'DrRacketFunctions.xqy';
declare variable $funName := "vec-add";
declare variable $funParameterTypes := ("Vektor", "Vektor");
declare variable $funReturnType := "Vektor";
declare variable $funDecl := aa:funDecl($funName, count($funParameterTypes), true(), /drracket);
declare variable $consts := /drracket//paren/terminal[@value='define']/following-sibling::terminal[1]/attribute::value/string();
aa:assertPresent(
"Es ist nicht das korrekte Sprachniveau ('beginner') eingestellt oder Teachpacks fehlen ('universe', 'image').",
aa:studentLanguage("beginner", ('"image.rkt"', '"universe.rkt"'), /drracket)),
aa:assertTrue(
"Eckige Klammern sind nur für die Fälle von cond-Ausdrücken erlaubt.",
aa:squareParensOnlyInCond(/drracket)),
aa:assertTrue("Geben Sie Fälle von cond-Ausdrücken in eckigen Klammern an",
aa:condCasesSquare(/drracket)),
aa:assertPresent(
concat("Die Funktion ", $funName, " mit einem Parameter ist nicht definiert."),
$funDecl),
aa:assertPresent(
concat("Es sind keine Tests für die Function ", $funName, " definiert."),
aa:precedingTests($funDecl)),
aa:assertPresent(
concat("Es ist kein Kommentar für die Funktion ", $funName, " angegeben"),
aa:functionComment($funDecl)),
aa:assertTrue(
concat("Für die Funktion ", $funName, " ist die Signatur nicht oder nicht korrekt dokumentiert."),
aa:funDocMatchesSignature($funDecl,
$funParameterTypes, $funReturnType)),
aa:assertTrue(
concat("Die Dokumentation für die Funktion ", $funName, " enthält keine Beschreibung für alle parameter."),
aa:funDocContainsParams($funDecl)),
aa:assertPresent(
concat("Die Tests für die Funktion ", $funName, " verwenden keine als Konstanten definierten Beispielwerte."),
aa:precedingTests($funDecl)//terminal[@value=$consts]),
aa:assertTrue(
"Datentyp Vektor ist nicht korrekt als Kommentar definiert",
for $comment in //comment/text()
return matches($comment,
".*Vektor.*\(\s*make-posn\s*Number\s*Number\s*\).*", "s"))
\ No newline at end of file
module namespace aa='https://plt.bitbucket.io/autoassess';
declare function aa:assertPresent($msg as xs:string, $e as node()*)
{
if (fn:empty($e)) then (
<p>{$msg}</p>
)
else ()
};
declare function aa:assertNotPresent($msg as xs:string, $e as node()*)
{
if (fn:empty($e)) then ( )
else (
<p>{$msg}</p>
)
};
declare function aa:value-intersect( $arg1 as xs:anyAtomicType*, $arg2 as xs:anyAtomicType* ) as xs:anyAtomicType*
{
distinct-values($arg1[.=$arg2])
};
declare function aa:studentLanguage($level as xs:string, $reqTeachpacks as xs:string*, $r as element())
{
let $reader := $r/conf[@lang="#reader"]
let $lib := $reader/following-sibling::paren[1]/terminal[@value=concat('"htdp-', $level, '-reader.ss"')]
let $teachpacks := $lib/parent::node()/parent::node()/paren[2]//terminal[@value='teachpacks']/parent::node()
let $teachpacksSeq := aa:value-intersect($teachpacks/paren/paren/terminal[2]/attribute::value/string(), $reqTeachpacks)
let $teachpacksOrdered := for $item in $teachpacksSeq
order by $item
return $item
let $reqTeachpacksOrdered := for $item in $reqTeachpacks
order by $item
return $item
return if (deep-equal($teachpacksOrdered, $reqTeachpacksOrdered)) then (
$reader
)
else ()
};
declare function aa:funDecl($name as xs:string, $args as xs:integer, $onlyTopLevel as xs:boolean, $r as element()*)
{
let $functionNameDeclaration :=
if ($onlyTopLevel)
then ($r/paren/terminal[@value="define"]/following-sibling::paren/terminal[@value=$name])
else ($r//paren/terminal[@value="define"]/following-sibling::paren/terminal[@value=$name])
for $decl in $functionNameDeclaration
where (count($decl/following-sibling::terminal) = $args)
return $decl/parent::node()/parent::node()
};
declare function aa:funComment($funDecl as element()*)
{
$funDecl/preceding-sibling::*[1][self::comment]
};
declare function aa:funBody($funDecl as element()*)
{
$funDecl/paren[1]/following-sibling::*[not(self::comment)][1]
};
declare function aa:funCall($name as xs:string, $args as xs:integer, $r as element()*)
{
let $calls := $r//paren/terminal[@value=$name]
for $call in $calls
where (count($call/following-sibling::*[not(self::comment)]) = $args)
return $call/parent::node()
};
declare function aa:index-of-node($nodes as node()*, $nodeToFind as node()) as xs:integer*
{
for $seq in (1 to count($nodes))
return $seq[$nodes[$seq] is $nodeToFind]
};
declare function aa:precedingTests($progElemem as element()*) as element()*
{
let $test := $progElemem/preceding-sibling::*[1][self::paren]/terminal[starts-with(@value,"check-")]/parent::element()
return if (fn:empty($test)) then ()
else
((aa:precedingTests($test), $test))
};
declare function aa:functionComment($funDecl) as element()*
{
let $tests := aa:precedingTests($funDecl)
let $comment := if (fn:empty($tests))
then
($funDecl/preceding-sibling::*[1][self::comment])
else
(fn:head($tests)/preceding-sibling::*[1][self::comment])
return $comment
};
declare function aa:findFirstCall($name as xs:string, $progElem as element(), $includeSelf)
{
let $temp :=
if ($includeSelf)
then
(($progElem/descendant-or-self::paren/terminal[@value=$name])[1])
else
(($progElem/descendant::paren/terminal[@value=$name])[1])
return $temp/parent::paren
};
declare function aa:funDocMatchesSignature($funDecl as element()*, $parameterTypes as xs:string*, $returnType as xs:string) as xs:boolean
{
matches(aa:functionComment($funDecl)/text(),
concat(".*;\s*", string-join($parameterTypes, "\s*"), "\s*->\s*", $returnType, ".*"), "s")
};
declare function aa:funDocContainsParam($funDecl as element()*, $param as xs:string)
{
matches(aa:functionComment($funDecl)/text(),
concat("(^|[^\w*])", $param, "([^\w*]|$)"))
};
declare function aa:funDocContainsParams($funDecl as element()*)
{
let $undocumented :=
for $param in $funDecl/paren[1]/terminal[1]/following-sibling::terminal/@value
where not(aa:funDocContainsParam($funDecl, data($param)))
return $param
return empty($undocumented)
};
declare function aa:assertTrue($msg as xs:string, $pred)
{
if ($pred = true())
then ()
else (<p>{$msg}</p>)
};
declare function aa:squareParensOnlyInCond($r as element())
{
let $cond-cases := $r//paren/terminal[@value="cond"]/parent::paren/paren
let $square-parens := $r//paren[@type="square"]
let $violations :=
for $square-paren in $square-parens
return
if (empty(aa:index-of-node($cond-cases,$square-paren)))
then ($square-paren)
else ()
return empty($violations)
};
declare function aa:condCasesSquare($r as element())
{
let $cond-cases := $r//paren/terminal[@value="cond"]/parent::paren/paren
return
if (not(empty($cond-cases[@type="round"])))
then false()
else true()
};
declare function aa:enumTypeComment($r as node(), $typename as xs:string, $elements as xs:string*)
{
for $comment in ($r//comment/text())
where
matches($comment, concat(".*", $typename, ".*"))
and count($elements) = count(
for $keyword in $elements
where matches($comment, concat('.*;\s*-\s*', $keyword, '.*'))
return $keyword)
return $comment
};
declare function aa:enumTypeTests($funDecl as element()*, $elements as xs:string*)
{
let $tests := aa:precedingTests($funDecl)
return count($tests) >= count($elements)
and count($elements) = count(
for $element in $elements
where $tests//terminal[@value=$element]
return $element)
};
declare function aa:intervalTypeComment($r as node(), $typename as xs:string, $numOfIntervals, $constants as xs:string*)
{
for $comment in ($r//comment[contains(text(), $typename)])
let $cases := tokenize($comment, ".*;\s*-\s*")
return (count($cases) >= $numOfIntervals + 1)
and
count(for $const in $constants
where contains($comment, $const)
return $const) = count($constants)
};
declare function aa:intervalTypeTests($funDecl as element()*, $numOfTests, $constants as xs:string*)
{
let $tests := aa:precedingTests($funDecl)
return count($tests) >= $numOfTests
and count($constants) = count(
for $const in $constants
where $tests//terminal[@value=$const]
return $const)
};
declare function aa:sumTypeComment($r as node(), $typename as xs:string, $numOfIntervals, $constants as xs:string*)
{
for $comment in ($r//comment[contains(text(), $typename)])
let $cases := tokenize($comment, ".*;\s*-\s*")
return (count($cases) >= $numOfIntervals + 1)
and count($constants) = count(
for $const in $constants
where contains($comment, $const)
return $const)
};
(require "Test-Harness.rkt")
(define V00/aa (make-posn 0 0))
(define V11/aa (make-posn 1 1))
(define V22/aa (make-posn 2 2))
(define V01/aa (make-posn 0 1))
(define V10/aa (make-posn 1 0))
(assert/equal V00/aa (vec-add V00/aa V00/aa) "Addition von (0, 0) und (0, 0)")
(assert/equal V22/aa (vec-add V11/aa V11/aa) "Addition von (1, 1) und (1, 1)")
(assert/equal V11/aa (vec-add V10/aa V01/aa) "Addition von (1, 0) und (0, 1)")
(tear-down)
\ No newline at end of file
(require "Test-Harness.rkt")
(assert/equal 0 (preis 0) "Eintrittspreis für Person mit 0cm.")
(assert/equal 0 (preis 60) "Eintrittspreis für Person mit 60cm.")
(assert/equal 0 (preis 120) "Eintrittspreis für Person mit 120cm.")
(assert/equal 12 (preis 121) "Eintrittspreis für Person mit 121cm.")
(assert/equal 12 (preis 130) "Eintrittspreis für Person mit 130cm.")
(assert/equal 12 (preis 140) "Eintrittspreis für Person mit 140cm.")
(assert/equal 15 (preis 141) "Eintrittspreis für Person mit 141cm.")
(assert/equal 15 (preis 183) "Eintrittspreis für Person mit 183cm.")
(tear-down)
\ No newline at end of file
60
\ No newline at end of file
In der Vorlesung haben Sie die posn-Struktur kennengelernt. Wir möchten nun einige Funktionen auf dieser Struktur implementieren. Achten Sie dabei darauf, das Entwurfsrezept anzuwenden.
Dort wo die untenstehende Funktion einen Vektor erwarten, soll auch in der Signatur der Typ Vektor angegeben werden. Definieren Sie den Typ Vektor als Kommentar. Verwenden Sie hier die Struktur Posn wieder. Ein Vektor ist eine Posn-Struktur wobei die beiden Felder jeweils ein Number sind.
(vec-sub v1 v2), die die übergebenen Vektoren subtrahiert.
\ No newline at end of file
xquery version "1.0";
import module namespace aa='https://plt.bitbucket.io/autoassess' at 'DrRacketFunctions.xqy';
declare variable $funName := "vec-sub";
declare variable $funParameterTypes := ("Vektor", "Vektor");
declare variable $funReturnType := "Vektor";
declare variable $funDecl := aa:funDecl($funName, count($funParameterTypes), true(), /drracket);
declare variable $consts := /drracket//paren/terminal[@value='define']/following-sibling::terminal[1]/attribute::value/string();
aa:assertPresent(
"Es ist nicht das korrekte Sprachniveau ('beginner') eingestellt oder Teachpacks fehlen ('universe', 'image').",
aa:studentLanguage("beginner", ('"image.rkt"', '"universe.rkt"'), /drracket)),
aa:assertTrue(
"Eckige Klammern sind nur für die Fälle von cond-Ausdrücken erlaubt.",
aa:squareParensOnlyInCond(/drracket)),
aa:assertTrue("Geben Sie Fälle von cond-Ausdrücken in eckigen Klammern an",
aa:condCasesSquare(/drracket)),
aa:assertPresent(
concat("Die Funktion ", $funName, " mit einem Parameter ist nicht definiert."),
$funDecl),
aa:assertPresent(
concat("Es sind keine Tests für die Function ", $funName, " definiert."),
aa:precedingTests($funDecl)),
aa:assertPresent(
concat("Es ist kein Kommentar für die Funktion ", $funName, " angegeben"),
aa:functionComment($funDecl)),
aa:assertTrue(
concat("Für die Funktion ", $funName, " ist die Signatur nicht oder nicht korrekt dokumentiert."),
aa:funDocMatchesSignature($funDecl,
$funParameterTypes, $funReturnType)),
aa:assertTrue(
concat("Die Dokumentation für die Funktion ", $funName, " enthält keine Beschreibung für alle parameter."),
aa:funDocContainsParams($funDecl)),
aa:assertPresent(
concat("Die Tests für die Funktion ", $funName, " verwenden keine als Konstanten definierten Beispielwerte."),
aa:precedingTests($funDecl)//terminal[@value=$consts]),
aa:assertTrue(
"Datentyp Vektor ist nicht korrekt als Kommentar definiert",
for $comment in //comment/text()
return matches($comment,
".*Vektor.*\(\s*make-posn\s*Number\s*Number\s*\).*", "s"))
\ No newline at end of file
module namespace aa='https://plt.bitbucket.io/autoassess';
declare function aa:assertPresent($msg as xs:string, $e as node()*)
{
if (fn:empty($e)) then (
<p>{$msg}</p>
)
else ()
};
declare function aa:assertNotPresent($msg as xs:string, $e as node()*)
{
if (fn:empty($e)) then ( )
else (
<p>{$msg}</p>
)
};
declare function aa:value-intersect( $arg1 as xs:anyAtomicType*, $arg2 as xs:anyAtomicType* ) as xs:anyAtomicType*
{
distinct-values($arg1[.=$arg2])
};
declare function aa:studentLanguage($level as xs:string, $reqTeachpacks as xs:string*, $r as element())
{
let $reader := $r/conf[@lang="#reader"]
let $lib := $reader/following-sibling::paren[1]/terminal[@value=concat('"htdp-', $level, '-reader.ss"')]
let $teachpacks := $lib/parent::node()/parent::node()/paren[2]//terminal[@value='teachpacks']/parent::node()
let $teachpacksSeq := aa:value-intersect($teachpacks/paren/paren/terminal[2]/attribute::value/string(), $reqTeachpacks)
let $teachpacksOrdered := for $item in $teachpacksSeq
order by $item
return $item
let $reqTeachpacksOrdered := for $item in $reqTeachpacks
order by $item
return $item
return if (deep-equal($teachpacksOrdered, $reqTeachpacksOrdered)) then (
$reader
)
else ()
};
declare function aa:funDecl($name as xs:string, $args as xs:integer, $onlyTopLevel as xs:boolean, $r as element()*)
{
let $functionNameDeclaration :=
if ($onlyTopLevel)
then ($r/paren/terminal[@value="define"]/following-sibling::paren/terminal[@value=$name])
else ($r//paren/terminal[@value="define"]/following-sibling::paren/terminal[@value=$name])
for $decl in $functionNameDeclaration
where (count($decl/following-sibling::terminal) = $args)
return $decl/parent::node()/parent::node()
};
declare function aa:funComment($funDecl as element()*)
{
$funDecl/preceding-sibling::*[1][self::comment]
};
declare function aa:funBody($funDecl as element()*)
{
$funDecl/paren[1]/following-sibling::*[not(self::comment)][1]
};
declare function aa:funCall($name as xs:string, $args as xs:integer, $r as element()*)
{
let $calls := $r//paren/terminal[@value=$name]
for $call in $calls
where (count($call/following-sibling::*[not(self::comment)]) = $args)
return $call/parent::node()
};
declare function aa:index-of-node($nodes as node()*, $nodeToFind as node()) as xs:integer*
{
for $seq in (1 to count($nodes))
return $seq[$nodes[$seq] is $nodeToFind]
};
declare function aa:precedingTests($progElemem as element()*) as element()*
{
let $test := $progElemem/preceding-sibling::*[1][self::paren]/terminal[starts-with(@value,"check-")]/parent::element()
return if (fn:empty($test)) then ()
else
((aa:precedingTests($test), $test))
};
declare function aa:functionComment($funDecl) as element()*
{
let $tests := aa:precedingTests($funDecl)
let $comment := if (fn:empty($tests))
then
($funDecl/preceding-sibling::*[1][self::comment])
else
(fn:head($tests)/preceding-sibling::*[1][self::comment])
return $comment
};
declare function aa:findFirstCall($name as xs:string, $progElem as element(), $includeSelf)
{
let $temp :=
if ($includeSelf)
then
(($progElem/descendant-or-self::paren/terminal[@value=$name])[1])
else
(($progElem/descendant::paren/terminal[@value=$name])[1])
return $temp/parent::paren
};
declare function aa:funDocMatchesSignature($funDecl as element()*, $parameterTypes as xs:string*, $returnType as xs:string) as xs:boolean
{
matches(aa:functionComment($funDecl)/text(),
concat(".*;\s*", string-join($parameterTypes, "\s*"), "\s*->\s*", $returnType, ".*"), "s")
};
declare function aa:funDocContainsParam($funDecl as element()*, $param as xs:string)
{
matches(aa:functionComment($funDecl)/text(),
concat("(^|[^\w*])", $param, "([^\w*]|$)"))
};
declare function aa:funDocContainsParams($funDecl as element()*)
{
let $undocumented :=
for $param in $funDecl/paren[1]/terminal[1]/following-sibling::terminal/@value
where not(aa:funDocContainsParam($funDecl, data($param)))
return $param
return empty($undocumented)
};
declare function aa:assertTrue($msg as xs:string, $pred)
{
if ($pred = true())
then ()
else (<p>{$msg}</p>)
};
declare function aa:squareParensOnlyInCond($r as element())
{
let $cond-cases := $r//paren/terminal[@value="cond"]/parent::paren/paren
let $square-parens := $r//paren[@type="square"]
let $violations :=
for $square-paren in $square-parens
return
if (empty(aa:index-of-node($cond-cases,$square-paren)))
then ($square-paren)
else ()
return empty($violations)
};
declare function aa:condCasesSquare($r as element())
{
let $cond-cases := $r//paren/terminal[@value="cond"]/parent::paren/paren
return
if (not(empty($cond-cases[@type="round"])))
then false()
else true()
};
declare function aa:enumTypeComment($r as node(), $typename as xs:string, $elements as xs:string*)
{
for $comment in ($r//comment/text())
where
matches($comment, concat(".*", $typename, ".*"))
and count($elements) = count(
for $keyword in $elements
where matches($comment, concat('.*;\s*-\s*', $keyword, '.*'))
return $keyword)
return $comment
};
declare function aa:enumTypeTests($funDecl as element()*, $elements as xs:string*)
{
let $tests := aa:precedingTests($funDecl)
return count($tests) >= count($elements)
and count($elements) = count(
for $element in $elements
where $tests//terminal[@value=$element]
return $element)
};
declare function aa:intervalTypeComment($r as node(), $typename as xs:string, $numOfIntervals, $constants as xs:string*)
{
for $comment in ($r//comment[contains(text(), $typename)])
let $cases := tokenize($comment, ".*;\s*-\s*")
return (count($cases) >= $numOfIntervals + 1)
and
count(for $const in $constants
where contains($comment, $const)
return $const) = count($constants)
};
declare function aa:intervalTypeTests($funDecl as element()*, $numOfTests, $constants as xs:string*)
{
let $tests := aa:precedingTests($funDecl)
return count($tests) >= $numOfTests
and count($constants) = count(
for $const in $constants
where $tests//terminal[@value=$const]
return $const)
};
declare function aa:sumTypeComment($r as node(), $typename as xs:string, $numOfIntervals, $constants as xs:string*)
{
for $comment in ($r//comment[contains(text(), $typename)])
let $cases := tokenize($comment, ".*;\s*-\s*")
return (count($cases) >= $numOfIntervals + 1)
and count($constants) = count(
for $const in $constants
where contains($comment, $const)
return $const)
};
(require "Test-Harness.rkt")
(define V00/aa (make-posn 0 0))
(define V11/aa (make-posn 1 1))
(define V22/aa (make-posn 2 2))
(define V01/aa (make-posn 0 1))
(define V10/aa (make-posn 1 0))
(assert/equal V00/aa (vec-sub V00/aa V00/aa) "Subtraktion (0, 0) minus (0, 0)")
(assert/equal V11/aa (vec-sub V22/aa V11/aa) "Subtraktion (2, 2) minus (1, 1)")
(assert/equal V01/aa (vec-sub V11/aa V10/aa) "Subtraktion (1, 1) minus (1, 0)")
(tear-down)
\ No newline at end of file
(require "Test-Harness.rkt")
(assert/equal 0 (preis 0) "Eintrittspreis für Person mit 0cm.")
(assert/equal 0 (preis 60) "Eintrittspreis für Person mit 60cm.")
(assert/equal 0 (preis 120) "Eintrittspreis für Person mit 120cm.")
(assert/equal 12 (preis 121) "Eintrittspreis für Person mit 121cm.")
(assert/equal 12 (preis 130) "Eintrittspreis für Person mit 130cm.")
(assert/equal 12 (preis 140) "Eintrittspreis für Person mit 140cm.")
(assert/equal 15 (preis 141) "Eintrittspreis für Person mit 141cm.")
(assert/equal 15 (preis 183) "Eintrittspreis für Person mit 183cm.")
(tear-down)
\ No newline at end of file
60
\ No newline at end of file
In der Vorlesung haben Sie die posn-Struktur kennengelernt. Wir möchten nun einige Funktionen auf dieser Struktur implementieren. Achten Sie dabei darauf, das Entwurfsrezept anzuwenden.
Dort wo die untenstehende Funktion einen Vektor erwarten, soll auch in der Signatur der Typ Vektor angegeben werden. Definieren Sie den Typ Vektor als Kommentar. Verwenden Sie hier die Struktur Posn wieder. Ein Vektor ist eine Posn-Struktur wobei die beiden Felder jeweils ein Number sind.
(vec-skal-mult s v), die den übergebenen Vektor mit dem Skalar s multipliziert.
\ No newline at end of file
xquery version "1.0";
import module namespace aa='https://plt.bitbucket.io/autoassess' at 'DrRacketFunctions.xqy';
declare variable $funName := "vec-skal-mult";
declare variable $funParameterTypes := ("Vektor", "Number");
declare variable $funReturnType := "Vektor";
declare variable $funDecl := aa:funDecl($funName, count($funParameterTypes), true(), /drracket);
declare variable $consts := /drracket//paren/terminal[@value='define']/following-sibling::terminal[1]/attribute::value/string();
aa:assertPresent(
"Es ist nicht das korrekte Sprachniveau ('beginner') eingestellt oder Teachpacks fehlen ('universe', 'image').",