R Notebook

Nejistoty a chyby měření

Ze zásilky kaprolaktamu bylo odebráno 10 vzorku a byl u nich stanoven bod tání. Vypočítejte průměrnou hodnotu bodu tání v zásilce a její směrodatnou odchylku.

Šíření chyb

Vypočítejte hustotu a její chybu pro látku, u níž byla opakovaným měřením stanovena hmotnost 6.824 (0.008) g a objem 3.03 (0.01) ml.

Na píst o průměru 200 (0.05) mm působí pára tlakem 8.2 (0.1) atm. Jakou silou působí pára na píst?

Vypočítejte koeficient viskozity roztoku glycerinu Stokesovou metodou

Vypočítejte koeficient viskozity roztoku glycerinu pomocí kapilárního viskozimetru.

Součin rozpustnosti stříbrné soli AgX má hodnotu Ks = 4.0 (0.4) x 10^-8. Jaká je chyba vypočtené rovnovážné koncentrace stříbrných iontů ve vode?

Nejistoty a korelace

Import dat

Export dat

Čísla dle Chemical Abstracts Service (CAS)

BCPC Compendium of Pesticide Common Names https://pesticidecompendium.bcpc.org formerly known as Alan Woods Compendium of Pesticide Common Names http://www.alanwood.net/pesticides

ChemicalIdentifierResolver(CIR) http://cactus.nci.nih.gov/chemical/

ChemicalIdentifierResolver(CIR) https://cactus.nci.nih.gov/chemical/structure

The smiles are as following:

          glyphosate 
OC(=O)CNC[P](O)(O)=O 

Chemical Translation Service (CTS) http://cts.fiehnlab.ucdavis.edu/

     XEFQLINVKFYRCS-UHFFFAOYSA-N BSYNRYMUTXBXSQ-UHFFFAOYSA-N
[1,] "C12H7Cl3O2"                "C9H8O4"                   
[2,] "289.54204"                 "180.15777"                

PubChem https://pubchem.ncbi.nlm.nih.gov/ CompoundID (CID) for a search query using PUG-REST https://pubchem.ncbi. nlm.nih.gov/

ETOX: Information System Ecotoxicology and Environmental Quality Targets https:// webetox.uba.de/webETOX/index.do

$Triclosan
[1] NA

$Aspirin
[1] NA

attr(,"class")
[1] "etox_basic" "list"      

Wikidata Item ID

Querying Q408646. OK (HTTP 200).
 Multiple found. Returning all.

Flavor percepts http://www.flavornet.org

Querying 75-07-0. OK (HTTP 200).
Querying 64-17-5. OK (HTTP 200).
Querying 109-66-0. OK (HTTP 200).
Querying 78-94-4. Not Found (HTTP 404).
Querying 78-93-3. OK (HTTP 200).

         75-07-0          64-17-5         109-66-0          78-94-4 
"pungent, ether"          "sweet"         "alkane"               NA 
         78-93-3 
         "ether" 

ChemIDPlus http://chem.sis.nlm.nih.gov/chemidplus http://cts.fiehnlab.ucdavis.edu/

50-00-0 
   0.35 

Query the OPSIN (Open Parser for Systematic IUPAC nomenclature) web service http://opsin.ch.cam.ac.uk/instructions.html

Querying Cyclopropane. OK (HTTP 200).
Querying Octane. OK (HTTP 200).

Acute toxicity data from U.S. EPA ECOTOX

[1] "C:/Program Files/R/R-4.1.1/library/PesticideLoadIndicator/extdata/products.xlsx"
NULL

as.character(3.14)
as.character(pi)

data <- c(-11, 21, 1.5, -31)
as.character(data)


## number of strings
length("BaCrO4")
length("How many characters?")
length(c("How", "many", "characters?"))

## number of charaters
nchar("BaCrO4")
nchar("How many characters?")
nchar(c("How", "many", "characters?"))

library(stringr)
str_length("BaCrO4")
str_length("How many characters?")
str_length(c("How", "many", "characters?"))

some_text = c("one", "two", "three", NA, "five")
str_length(some_text)
nchar(some_text)

some_factor = factor(c(1, 1, 1, 2, 2, 2), labels = c("good", "bad"))
some_factor
str_length(some_factor)
nchar(some_factor)


# Usporadani

set11 = c("today", "produced", "example", "beautiful", "a", "nicely")
# sort (decreasing order)
sort(set11)
# sort (increasing order)
sort(set11, decreasing = TRUE)


library(stringi)
stri_reverse("dna")
stri_reverse(set11)


### Spojovani retezcu

toString(17.04)
toString(c(17.04, 1978))
toString(c("Bonjour", 123, TRUE, NA, log(exp(1))))


## paste

paste("This is",  "out of",   "examples.")
paste0("This is",  "out of",  "examples.") 
paste0("This is",  " out of",  " examples.")

a <- "acetic"
b <- "acid"
c <- "anhydride"

d1 <- paste(a, b, c); d1
d2 <- paste(a, b, c, sep = "-"); d2

paste("I", "love", "R", sep = "-")


str <- paste(c(1:3), "4", sep = ":")
print (str)

str <- paste(c(1:4), c(5:8), sep = "--")
print (str)

paste("X", 1:5, sep = ".")

paste(1:3, c("!", "?", "+"))
paste(1:3, c("!", "?", "+"), sep = "")
paste0(1:3, c("!", "?", "+"))
paste(1:3, c("!", "?", "+"), sep = "", collapse = "")
paste0(1:3, c("!", "?", "+"), collapse = "")

paste("The value of pi is", round(pi,3), "and value of e is", round(exp(1),3),".")


df <- data.frame(cation=c('sodium','mercury','iron','calcium'),
                 anion=c('acetate','sulphate','dioxide','oxalate'),
                 purity=c(0.99, 0.9, 0.999, 0.985))
df
df$name = paste(df$cation, df$anion)
df

library(stringr)
str_c("May", "The", "Force", "Be", "With", "You")


library(stringr)
str_c("May", "The", "Force", NULL, "Be", "With", "You", character(0))
paste("May", "The", "Force", NULL, "Be", "With", "You", character(0))

str_c("May", "The", "Force", "Be", "With", "You", sep = "_")

# str_join("May", "The", "Force", "Be", "With", "You", sep = "-") 
# analogicka fce k predchozi


## cat - pouze vypisuje retezec

cat("learn", "code", "tech", sep = ":")
str <- cat("learn", "code", "tech", sep = ":") # nelze ulozit do promenne
print (str) 

my_string = c("learn", "code", "tech")
cat(my_string, "with R")
cat(my_string, "with R", sep = " =) ")

cat(1:10, sep = "-")
cat(month.name[1:4], sep = " ")

cat(c(1:5), file ='sample.txt')
cat(my_string, "with R", file = "output.txt")
cat(11:20, sep = '\n', file = 'temp.csv')
readLines('temp.csv') # read the file temp.csv

cat("The value of pi is", round(pi,3), "and value of e is", round(exp(1),3),".")


## print - vypisuje vsechny formaty

print(df)
df

my_value <- 8235.675324 
my_value
print(my_value) 
print(my_value, digits = 5) 

print(c("learn", "code", "tech"))
paste(c("learn", "code", "tech"))
paste(c("learn", "code", "tech"), collapse=" ")
cat(c("learn", "code", "tech"))

my_string <- "This is \nthe example string" 
print(my_string)  
cat(my_string) 


### 

library(stringr)

str_dup("hola", 3)
str_dup("adios", 1:3)

words = c("lorem", "ipsum", "dolor", "sit", "amet")
str_dup(words, 2)
str_dup(words, 1:5)


####

format(c("A", "BB", "CCC"), width = 5, justify = "centre")
format(c("A", "BB", "CCC"), width = 5, justify = "left")
format(c("A", "BB", "CCC"), width = 5, justify = "right")
format(c("A", "BB", "CCC"), width = 5, justify = "none")

library(stringr)
str_pad("hola", width = 7)
str_pad("adios", width = 7, side = "both")
str_pad("hashtag", width = 8, pad = "#")
str_pad("hashtag", width = 9, side = "both", pad = "-")


##### editace ciselnych retezcu

## sprintf

# '%f' indicates 'fixed point' decimal notation
sprintf("%f", pi)
sprintf("%f", 123.45)
sprintf("%f", 123.456789)
# decimal notation with 3 decimal digits
sprintf("%.3f", pi)
sprintf("%.3f", 123.456789)
# 1 integer and 0 decimal digits
sprintf("%1.0f", pi)
sprintf("%1.0f", 123.456789)
# decimal notation with 3 decimal digits
sprintf("%5.1f", pi)
sprintf("%05.1f", pi)
sprintf("%6.1f", 123.456789)
sprintf("%06.1f", 123.456789)
# print with sign (positive)
sprintf("%+f", pi)
sprintf("%+f", 123.456789)
# prefix a space
sprintf("% f", pi)
sprintf("% f", 123.456789)
# left adjustment
sprintf("%-10f", pi)
sprintf("%-10f", 123.456)
# exponential decimal notation 'e'
sprintf("%e", pi)
sprintf("%e", 123.456789)
# exponential decimal notation 'E'
sprintf("%E", pi)
sprintf("%E", 123.456789)
# number of significant digits (6 by default)
sprintf("%g", pi)
sprintf("%g", 123.456789)


## format

format(pi)
format(123.45)
format(123.456789)

format(123.45, nsmall = 5)
format(12.3456789, nsmall=2)
format(12.3456789, nsmall=7)
format(12.3, nsmall=3)

format(12.3456789, digits=2)
format(12.3456789, digits=5)
format(c(6, 13.1), digits = 2)

format(12.3456789, digits=5, nsmall = 6)
format(c(6, 13.1), digits = 2, nsmall = 2)

format(1/1:5, digits = 2)
format(format(1/1:5, digits = 2), width = 6, justify = "centre")


format(12345678, big.mark = ",") # oddeleni tisicu
format(1230, big.mark = ",")


## uvozovky ve vypisu retezce

my_string = "programming with data is fun"
print(my_string)
print(my_string, quote = FALSE)

noquote(my_string)

no_quotes = noquote(c("some", "quoted", "text", "!%^(&="))
no_quotes
no_quotes[2:3]

noquote(paste("I", "love", "R", sep = "-"))
noquote(cat("The value of pi is", round(pi,3), "and value of e is", round(exp(1),3),".")
)


dQuote(my_string)
sQuote(my_string)

x <- "2020-05-29 19:18:05"
dQuote(x)
sQuote(x)


########

substr(month.name, 1, 3)

substring(month.name, 1, 3)

strtrim(month.name, 3)


rs <- ("This is First R String Example")
strsplit(rs, split = " ")

rs <- ("This&is&First&R&String&Example")
strsplit(rs, split = "&")

a <- "Alabama-Alaska-Arizona-Arkansas-California"
strsplit(a, split = "-")

str = "Splitting sentence into words"
strsplit(str, " ")
unlist(strsplit(str, " "))


rs <- ("C21H22N2O2") # strychnin

strsplit(rs, split = "[0-9]+")[[1]]

strsplit(rs, split = "[A-Z]+")[[1]][-1]
strsplit(rs, "\\D+")[[1]][-1]
regmatches(rs, gregexpr("[[:digit:]]+", rs))
library(stringr)
str_extract_all(rs,"[0-9]+")[[1]]
library(strex)
str_extract_numbers(rs,decimals = FALSE)

rs <- ("C21H22N2O2")
strsplit(rs, split = "")

string_date<-c("2-07-2020","5-07-2020","6-07-2020",
               "7-07-2020","8-07-2020")
ssp = strsplit(string_date,split = "-"); ssp


# extract 'bcd'
substr("abcdef", start=2, stop=4)

substring("ABCDEF", 2, 4)

# extract each letter
substring("ABCDEF", 1:6, 1:6)


library(stringr)
lorem = "Lorem Ipsum"
substring(lorem, first = 1, last = 5)
str_sub(lorem, start = 1, end = 5)

str_sub("adios", 1:3)

resto = c("brasserie", "bistrot", "creperie", "bouchon")
substring(resto, first = -4, last = -1)
str_sub(resto, start = -4, end = -1)

str_sub(lorem, seq_len(nchar(lorem)))
substring(lorem, seq_len(nchar(lorem)))

str_sub(lorem,-2) 


### orezani mezer na koncich retezce

trimws(" This has trailing spaces.  ")

bad_text = c("This", " example ", "has several   ", "   whitespaces ")
trimws(bad_text)
library(stringr)
str_trim(bad_text, side = "left")
str_trim(bad_text, side = "right")
str_trim(bad_text, side = "both")


## replace
chartr(old = "All", new = "aLL", "All ChaRacterS in Upper Case") 
chartr("a", "A", "This is a boring string")
chartr("a", "0", "This is a bad example")

crazy = c("Here's to the crazy ones", "The misfits", "The rebels")
chartr("aei", "#!?", crazy)


x = c("may", "the", "force", "be", "with", "you")
substr(x, 2, 2) <- "#"
x
y = c("may", "the", "force", "be", "with", "you")
substr(y, 2, 3) <- ":)"
y

z = c("may", "the", "force", "be", "with", "you")
substr(z, 2, 3) <- c("#", "@")
z

text = c("more", "emotions", "are", "better", "than", "less")
substring(text, 1:3) <- c(" ", "zzz")
text


library(stringr)
lorem = "Lorem Ipsum"
str_sub(lorem, -1) <- "Nullam"
lorem

lorem = "Lorem Ipsum"
str_sub(lorem, 1, 5) <- "Nullam"
lorem

lorem = "Lorem Ipsum"
str_sub(lorem, c(1, 7), c(5, 8)) <- c("Nullam", "Enim")
lorem


## to lower case
tolower("BaCrO4")
tolower(c("aLL ChaRacterS in LoweR caSe", "ABCDE"))
casefold("aLL ChaRacterS in LoweR caSe")

## to upper case
toupper("BaCrO4")
toupper(c("All ChaRacterS in Upper Case", "abcde"))
casefold("All ChaRacterS in Upper Case", upper = TRUE)


### filtrovani

startsWith(month.name, "J")
endsWith(month.name, "ember")

myStrings <- paste(1:3, month.name, sep = ". ")
myStrings
# Is a pattern present (returns a logical vector)?
grepl("ember", myStrings)
# In which elements is a pattern present (returns indices)?
grep("ember", myStrings)
# In which elements is a pattern present (returns the values)?
grep("ember", myStrings, value = TRUE)

x1<-c("R is a programming language and programming software environment",
      "R is freely available under the GNU General Public License",
      "This programming language was named R")
grep("programming",x1,fixed=TRUE)


# Srovnani 2 retezcu
message1 <- "Pro"
message2 <- "Pro"
message3 <- "pRO"
message1 == message2
message1 == message3

# Hledani retezce v jinem retezci
str <- "Hello World!"
grepl("H", str)
grepl("Hello", str)
grepl("X", str)
grepl(message1, message2)
grepl(message1, message3)

identical(message1, message2)
identical(message1, message3)
identical(tolower(message1), tolower(message3))

message1[message1 %in% message2]
message1[message1 %in% message3]  
message1[tolower(message1) %in% tolower(message3)] 

vector1 <- c("hey", "hello", "greetings")
vector2 <- c("hey", "hello", "hi")
vector1[vector1 %in% vector2]


###

library(stringr)

change = c("Be the change", "you want to be")
# extract first word
word(change, 1)
# extract second word
word(change, 2)
# extract last word
word(change, -1)
# extract all but the first words
word(change, 2, -1)

word(change,start=1,end=2,sep=fixed(" "))


data <-  c('Ab_Cd-001234.txt','Ab_Cd-001234.txt')

gsub('.*-([0-9]+).*','\\1','Ab_Cd-001234.txt')
x <- c('Ab_Cd-001234.txt','Ab_Cd-001234.txt')
sub('.*-([0-9]+).*','\\1',x)

library(stringr)
regexp <- "[[:digit:]]+"
str_extract(data, regexp)

library(qdap)
genXtract("Ab_Cd-001234.txt", "-", ".txt")
x <- c('Ab_Cd-001234.txt','Ab_Cd-001234.txt')
genXtract(x, "-", ".txt")

library(tools)
sub(".*-", "", file_path_sans_ext(x))

library(gsubfn)
strapplyc(x, "-(\\d+)\\.", simplify = TRUE)
strapply(x, "-(\\d+)\\.", as.numeric, simplify = TRUE)


x <- c("a very nice character string")  
library(stringr)
str_replace(x, "c", "xxx")
str_replace_all(x, "c", "xxx")

x <- "aaabbb" 
sub("a", "c", x)  
gsub("a", "c", x)
sub("a|b", "c", x)
gsub("a|b", "c", x)  

x <- c("d", "a", "c", "abba") 
grep("a", x)
grepl("a", x)
grep("a|c", x)
grepl("a|c", x)

regexpr("a", x)
gregexpr("a", x)
regexec("a", x) 

x <- "example_xxx_string"
library(stringr)
str_sub(string = x, start = 8, end = 12)
str_sub(string = x, start = 8, end = 12) <- " character "  # Replace substring
x  

x <- "xxxxyxxyxaaaaaay"
x 
sub("y", "NEW", x) 
gsub("y", "NEW", x)

library(stringr)
str_replace(x, "y", "NEW")
str_replace_all(x, "y", "NEW")

Kvadraticke a kubicke rovnice

Velikost výslednice dvou navzajem kolmých sil je 34 N. Jaká je velikost skládaných sil, je-li jedna z nich o 14 N větší než druha?

[1] -30

Tlaková láhev s oxidem uhličitým obsahuje 10.0 kg plynu. Jaký objem zaujímá stlačený plyn, když při teplotě 30 °C je tlak v láhvi 13.17e-6 Pa? Výpočet proved’te pomocí van der Waalsovy rovnice.

Jake pH má roztok kyseliny mravenčí o koncentraci 8.5 x 10-4 mol/l?

Soustavy lineárních rovnic

Ze dvou slitin s 60% a 80% obsahem mědi se ma získat 40 kg slitiny se 75% obsahem mědi. Kolik kg každé slitiny je třeba použít? [10 a 30 kg]

library(rootSolve)
model <- function(x){
  F1 <- 0.6*x[1] + 0.8*x[2] - 30
  F2 <- x[1] + x[2] - 40
  c(F1 = F1, F2 = F2)}
ss <- multiroot(f = model, start = c(1, 1))
ss$root

[1]  9.999999 29.999998

### graficke reseni
# 0.6*m1 + 0.8*m2 = 40*0.75 => m1 = 40*0.75/0.6 - 0.8/0.6 * m2  => m1 = 50 - 1.33 * m2 
# m1 + m2 = 40  => m1 = 40 - m2
xx = seq(0,50,0.1)
yy = 50 - 1.33*xx
zz = 40 - xx
plot(xx, yy, type="l",col=2)
points(xx, zz, type="l",col=4)

plot(xx, yy, type="l",col=2,xlim=c(25,35),ylim=c(0,20))
points(xx, zz, type="l",col=4)

Do bazenu natece prutokem A za 3 h a prutokem B za 4 h celkem 2150 hl vody. Prutokem A za 4 h a prutokem B za 2 h by nateklo 1700 hl vody. Kolik hl vody natece prutokem A a kolik prutokem B za 1 hodinu? A 250 hl, B 350 hl

library(rootSolve)
model <- function(x){
  F1 <- 3*x[1] + 4*x[2] - 2150
  F2 <- 4*x[1] + 2*x[2] - 1700
  c(F1 = F1, F2 = F2)}
ss <- multiroot(f = model, start = c(1, 1))
ss$root

[1] 250 350

### graficke reseni
# 3*m1 + 4*m2 = 2150 => m2 = 2150/4 - 3/4 * m1  => m2 = 537.5 - 0.75 * m1
# 4*m1 + 2*m2 = 1700 => m2 = 1700/2 - 4/2 * m1 => m2 = 850 - 2 * m1
xx = seq(0,500,1)
yy = 537.5 - 0.75*xx
zz = 850 - 2*xx
plot(xx, yy, type="l",col=2)
points(xx, zz, type="l",col=4)

plot(xx, yy, type="l",col=2,xlim=c(200,300),ylim=c(300,400))
points(xx, zz, type="l",col=4)

diag(3)

     [,1] [,2] [,3]
[1,]    1    0    0
[2,]    0    1    0
[3,]    0    0    1

MM = diag(x = 1, nrow = 3, ncol = 3, names = TRUE)
diag(MM) <- 2
library(Rfast)

Warning: package ‘Rfast’ was built under R version 4.1.3
Loading required package: RcppZiggurat

Attaching package: ‘Rfast’

The following objects are masked from ‘package:Rfast2’:

    gammareg, gammaregs, multinom.reg

The following object is masked from ‘package:data.table’:

    transpose

The following objects are masked from ‘package:pracma’:

    Norm, Rank, squareform

The following object is masked from ‘package:matlib’:

    cholesky

Diag.matrix(3,v=1)

     [,1] [,2] [,3]
[1,]    1    0    0
[2,]    0    1    0
[3,]    0    0    1

Diag.fill(MM,v=0) 

     [,1] [,2] [,3]
[1,]    0    0    0
[2,]    0    0    0
[3,]    0    0    0

library(Matrix)

Warning: package ‘Matrix’ was built under R version 4.1.3

Attaching package: ‘Matrix’

The following objects are masked from ‘package:tidyr’:

    expand, pack, unpack

The following objects are masked from ‘package:pracma’:

    expm, lu, tril, triu

Diagonal(3, x = 1)

3 x 3 diagonal matrix of class "ddiMatrix"
     [,1] [,2] [,3]
[1,]    1    .    .
[2,]    .    1    .
[3,]    .    .    1

upper.tri(matrix(1, 3, 3))

      [,1]  [,2]  [,3]
[1,] FALSE  TRUE  TRUE
[2,] FALSE FALSE  TRUE
[3,] FALSE FALSE FALSE

round(upper.tri(matrix(1, 3, 3)))

     [,1] [,2] [,3]
[1,]    0    1    1
[2,]    0    0    1
[3,]    0    0    0

upper.tri(MM)

      [,1]  [,2]  [,3]
[1,] FALSE  TRUE  TRUE
[2,] FALSE FALSE  TRUE
[3,] FALSE FALSE FALSE

MM[upper.tri(MM)] <- 0
lower.tri(matrix(1, 3, 3))

      [,1]  [,2]  [,3]
[1,] FALSE FALSE FALSE
[2,]  TRUE FALSE FALSE
[3,]  TRUE  TRUE FALSE

round(lower.tri(matrix(1, 3, 3)))

     [,1] [,2] [,3]
[1,]    0    0    0
[2,]    1    0    0
[3,]    1    1    0

lower.tri(MM)

      [,1]  [,2]  [,3]
[1,] FALSE FALSE FALSE
[2,]  TRUE FALSE FALSE
[3,]  TRUE  TRUE FALSE

MM[lower.tri(MM)] <- 0
library(gdata)

Warning: package ‘gdata’ was built under R version 4.1.3
Registered S3 method overwritten by 'gdata':
  method         from     
  reorder.factor DescTools
Warning in system(cmd, intern = intern, wait = wait | intern, show.output.on.console = wait,  :
  running command 'C:\WINDOWS\system32\cmd.exe /c ftype perl' had status 2
Warning in system(cmd, intern = intern, wait = wait | intern, show.output.on.console = wait,  :
  running command 'C:\WINDOWS\system32\cmd.exe /c ftype perl' had status 2
gdata: read.xls support for 'XLS' (Excel 97-2004) files
gdata: ENABLED.

gdata: Unable to load perl libaries needed by read.xls()
gdata: to support 'XLSX' (Excel 2007+) files.

gdata: Run the function 'installXLSXsupport()'
gdata: to automatically download and install the perl
gdata: libaries needed to support Excel XLS and XLSX formats.

Attaching package: ‘gdata’

The following objects are masked from ‘package:data.table’:

    first, last

The following object is masked from ‘package:sfsmisc’:

    last

The following object is masked from ‘package:stats’:

    nobs

The following object is masked from ‘package:utils’:

    object.size

The following object is masked from ‘package:base’:

    startsWith

upperTriangle(MM, diag=FALSE, byrow=FALSE)

[1] 0 0 0

upperTriangle(MM, diag=TRUE, byrow=FALSE)

[1] 2 0 2 0 0 2

upperTriangle(MM, diag=FALSE, byrow=FALSE) <- 1
MM

     [,1] [,2] [,3]
[1,]    2    1    1
[2,]    0    2    1
[3,]    0    0    2

lowerTriangle(MM, diag=FALSE, byrow=FALSE) 

[1] 0 0 0

lowerTriangle(MM, diag=FALSE, byrow=FALSE) <- 3
MM

     [,1] [,2] [,3]
[1,]    2    1    1
[2,]    3    2    1
[3,]    3    3    2

library(Rfast)
lower_tri(MM, suma = FALSE, diag = FALSE) 

[1] 3 3 3

upper_tri(MM, suma = FALSE, diag = FALSE) 

[1] 1 1 1

lower_tri.assign(MM, 1, diag = FALSE) 

              [,1]          [,2] [,3]
[1,]  2.000000e+00  1.000000e+00    1
[2,]  1.000000e+00  2.000000e+00    1
[3,] 8.753233e-314 1.434111e-311    2

upper_tri.assign(MM, 3, diag = FALSE)

     [,1] [,2]          [,3]
[1,]    2    3 8.753233e-314
[2,]    3    2 1.434111e-311
[3,]    3    3  2.000000e+00

library(Matrix) # v maticovem tvaru
tril(MM) # lower triangular

3 x 3 Matrix of class "dtrMatrix"
     [,1] [,2] [,3]
[1,]    2    .    .
[2,]    3    2    .
[3,]    3    3    2

triu(MM) # upper triangular

3 x 3 Matrix of class "dtrMatrix"
     [,1] [,2] [,3]
[1,]    2    1    1
[2,]    .    2    1
[3,]    .    .    2

Sestavte matici konstitučních koeficientů

Určete počet lineárně nezávislých reakcí v soustavě obsahující dané složky.

Gibbsovo stechiometricke pravidlo: maximální počet lineárně nezávislých reakcí r je menší nebo roven rozdílu počtu složek v systému (n) a hodnosti matice konstitučních koeficientů (h), v n-složkovém systému existuje n - h stechiometrických vztahů.

# pocet linearne nezavisl}ch reakcm
(r = length(form) - qr(M)$rank)

[1] 2

ge1

     [,1]
[1,]  0.5
[2,]  1.0
[3,]  0.5

Vyčíslete rovnici: KMnO4 + MnSO4 + H2O = MnO2 + K2SO4 + H2SO4

K = c(1, 0, 0, 0, -2, 0)
Mn = c(0, 1, 0, -1, 0, 0)
O = c(4, 4, 1, -2, -4, -4)
S = c(0, 1, 0, 0, -1, -1)
H = c(0, 0, 2, 0, 0, -2)

A = as.matrix(rbind(K, Mn, O, S, H))
colnames(A) = c("KMnO4", "MnSO4", "H2O", "MnO2", "K2SO4", "H2SO4")
B = c(rep(0,length(A[,1])))
C = cbind(A,B)
library(matlib)
c(R(A), R(cbind(A,B)))          # show ranks
all.equal(R(A), R(cbind(A,B)))  # consistent?
showEqn(A, B)
matlib::Solve(A, B)
GE2 = gaussianElimination(A, B, tol = sqrt(.Machine$double.eps), verbose = FALSE, latex = FALSE, fractions = TRUE)
as.character(GE2)
# cim nasobit koeficienty
nnv1 = 1/min(abs(as.numeric(GE2[,length(A[1,])])))
nnv = as.numeric(GE2[,length(A[1,])])*nnv1
NN = -1*(as.matrix(GE2)*nnv)[,c(1:(length(A[1,])-1))]
rownames(NN) = rownames(A)
colnames(NN) = colnames(A)[-length(colnames(A))]
apply(NN,2,sum)

Kolik 96% kyseliny sírové a kolik vody je potřeba na pripravu 1 l 78% kyseliny sírové?

GE1 = gaussianElimination(A, B, tol = sqrt(.Machine$double.eps), verbose = FALSE, latex = FALSE, fractions = FALSE)
NN = GE1[,3] # [l]
names(NN) = rownames(A)
NN

 H2SO4    H2O 
0.1875 0.8125 

library(Rlinsolve)
ls = lsolve.gs(A, B, xinit = NA, reltol = 1e-05, maxiter = 1000, adjsym = TRUE, verbose = TRUE)

* lsolve.gs : Initialiszed.
* lsolve.gs : A may not be symmetric.
* lsolve.gs : making it normal equation form via 'adjsym' flag.
* lsolve.gs : computations finished.

ls$x

          [,1]
[1,] 0.1875003
[2,] 0.8125000

library(cmna)
cgmmatrix(A, B, tol = 1e-06, maxiter = 100) # iterativematrix

[1] 0.1874999 0.8125000

solvematrix(A, B) # refmatrix

 H2SO4    H2O 
0.1875 0.8125 

Slitina A obsahuje 1.5 % Si, 1.4 % Mn, 0.4 % P a 0.3 % S. Slitina B obsahuje 0.5 % Si, 1.6 % Mn, 0.2 % P a 0.2 % S. Slitina C obsahuje 3 % Si, 0.5 % Mn, 0.5 % P a 0.05 % S. Kolik každé slitiny A, B, C je třeba na výrobu 100 kg slitiny obsahující 2 % Si, 1 % Mn, 0.4 % P a 0.15 % S?

sl1 = c(0.015, 0.014, 0.004, 0.003)
sl2 = c(0.005,0.016, 0.002, 0.002)
sl3 = c(0.03, 0.005, 0.005, 0.0005)
A = cbind(sl1, sl2, sl3); rownames(A) = c("Si","Mn","P","S")
B = c(0.02, 0.01, 0.004, 0.0015); names(B) = c("Si","Mn","P","S")
# B = c(2, 1, 0.4, 0.15); names(B) = c("Si","Mn","P","S")
library(matlib)
c(R(A), R(cbind(A,B)))          # show ranks, viz Frobeniova veta
all.equal(R(A), R(cbind(A,B)))  # consistent?
showEqn(A, B)
matlib::Solve(A, B)
limSolve::Solve(A, B)
GE1 = gaussianElimination(A, B, tol = sqrt(.Machine$double.eps), verbose = FALSE, latex = FALSE, fractions = FALSE)
GE1[,4]*100 # [kg]
library(Rlinsolve)
ls = lsolve.gs(A, B, xinit = NA, reltol = 1e-05, maxiter = 1000, adjsym = TRUE, verbose = TRUE)
ls$x

Kolik g 60% a kolik g 30% roztoku NaCl je treba smichat pri priprave 100 g 40% roztoku? 20 g 60% a a 80 g 35%

### matice

B = c(0.40*100,100) # [mg]
names(B) = c("60%","30%")
r1 = c(0.60,1) # [mg]
r2 = c(0.30,1) # [mg]
A = cbind(r1,r2)
colnames(A) = c("60%","30%")
rownames(A) = c("r30","r3")
det(A) # matice je regularni n = h

[1] 0.3

library(matlib)
c(R(A), R(cbind(A,B)))          # show ranks

[1] 2 2

all.equal(R(A), R(cbind(A,B)))  # consistent?

[1] TRUE

showEqn(A, B)

0.6*x1 + 0.3*x2  =   40 
  1*x1   + 1*x2  =  100 

matlib::Solve(A, B)

x1    =  33.33333333 
  x2  =  66.66666667 

limSolve::Solve(A, B)

     60%      30% 
33.33333 66.66667 

#
library(limSolve)

Attaching package: ‘limSolve’

The following object is masked from ‘package:matlib’:

    Solve

G <-matrix(ncol = 2, byrow = TRUE, data = c(1, 0, 0, 1)) 
H <- c(0, 0)
ldei(A, B, G = G, H = H)$X

     60%      30% 
33.33333 66.66667 

#
library(cmna) 
gdls(A, B, alpha = 0.05, tol = 1e-06, m = 1e+05) #  least squares with graident descent

        [,1]
60% 33.33405
30% 66.66587

jacobi(A, B, tol = 1e-06, maxiter = 100)  # iterativematrix

[1] 33.33333 66.66667

gaussseidel(A, B, tol = 1e-06, maxiter = 100) # iterativematrix

[1] 33.33333 66.66667

solvematrix(A, B) # refmatrix

     r30       r3 
33.33333 66.66667 

Ze dvou kovu o hustotach 7.4 g/cm3 a 8.2 g/cm3 je treba pripravit 0.5 kg slitiny o hustote 7.6 g/cm3. Kolik g kazdiho z kovu je k tomu potreba? 375 g lehciho a 125 g tezsiho

library(rootSolve)
model <- function(x){
  F1 <- 7.4*x[1] + 8.2*x[2] - 3800
  F2 <- x[1] + x[2] - 500
  c(F1 = F1, F2 = F2)}
ss <- multiroot(f = model, start = c(1, 1))
ss$root  # [kg]

### graficke reseni
# 7.4*m1 + 8.2*m2 = 0.5*7.6 => m1 = 3800/7.4 - 8.2/7.4 * m2  => m1 = 513.5 - 1.108 * m2 
# m1 + m2 = 500  => m1 = 500 - m2
xx = seq(0,500,1)
yy = 513.5 - 1.108*xx
zz = 500 - xx
plot(xx, yy, type="l",col=2)
points(xx, zz, type="l",col=4)
plot(xx, yy, type="l",col=2,xlim=c(100,150),ylim=c(350,400))
points(xx, zz, type="l",col=4)

### matice
B = c(7.6,1) # [mg]
names(B) = c("kov1","kov2")
r1 = c(7.4,1) # [mg]
r2 = c(8.2,1) # [mg]
A = cbind(r1,r2)
colnames(A) = c("kov1","kov2")
rownames(A) = c("7.4","8.2")
det(A) # matice je regularni n = h
library(matlib)
c(R(A), R(cbind(A,B)))          # show ranks
all.equal(R(A), R(cbind(A,B)))  # consistent?
showEqn(A, B)
rr = matlib::Solve(A, B)
read.table(text = rr[1], fill = TRUE)[[3]]*500 # [g]
read.table(text = rr[2], fill = TRUE)[[3]]*500 # [g]
rr = limSolve::Solve(A, B)
rr*500 # [g]
# 
library(limSolve)
G <-matrix(ncol = 2, byrow = TRUE, data = c(1, 0, 0, 1)) 
H <- c(0, 0)
rr = ldei(A, B, G = G, H = H)$X
rr*500 # [g]

V tepelné elektrárne mají zásobu uhlí, která vystací na 24 dní, bude-li v cinnosti pouze první blok, na 30 dní, bude-li v provozu pouze 2. blok a na 20 dní, bude-li v provozu pouze 3. blok. Na jak dloho vystací zásoba, budou-li v provozu vsechny bloky najednou?

library(Ryacas)

Attaching package: ‘Ryacas’

The following object is masked from ‘package:stats’:

    integrate

The following objects are masked from ‘package:base’:

    %*%, diag, diag<-, lower.tri, upper.tri

vr <- ysym("x/24 + x/30 + x/20 - 1") 
solve(vr, "x") 

{x==8}